Dynamically pass variable names as Y axis names in Multiple Y axis Plot

Question

Following the one of the answers to this question I want to create a multiple y axis graph on plotly .

I have created a shiny example and I would like the user to:

1. choose the variable to be on Y axis from a selectInput and pass variable name to the corresponding y axis
2. change the order and number of Y axes depending on the number and names of variable selected.

Here is my code with manually selected data for Y axis:

  library(shiny)
  library(plotly)

      data <- data.frame (
           Year = c(2010, 2011, 2012, 2013, 2014),
           Weight = c(56, 60, 67, 65, 70),
           Height = c(160, 165, 168, 171, 173),
           BMI = c(21.9, 22.0, 23.7, 22.2, 23.4),
           Girth = c(32, 33, 34, 34, 33)
          )



  ui <-  fluidPage(
             selectInput("variable", "Variable:",
                      c("Weight(Kg)","Height(cm)","BMI(kg/m2)", "Girth(cm)"),
                      multiple=TRUE),                   
             plotlyOutput(outputId = "Graph") )   
              
    
    
 server <- function(input, output) {
        output$Graph <-renderPlotly({
                          plot_ly(data, x = ~data$Year, type = 'scatter', mode = 'lines') %>%
                         add_lines(y = ~data[, 2], name='Weight(Kg)', line = list(color = "red")) %>%
                         add_lines(y = ~data[, 3], name='Height(cm)', yaxis='y2', line = list(color = "orange")) %>%
                         add_lines(y = ~data[, 4], name='BMI(kg/m2)', yaxis='y3', line = list(color = "darkgreen")) %>%     
  
                 layout(
                      xaxis = list(title = "time", domain = c(0.5,1)),
                     yaxis = list(title = 'Weight(Kg)', side = "left", color = "red", position = 0,
                            anchor = 'free'),
                     yaxis2 = list(title = 'Height(cm)', side = "left", color = "orange", 
                         overlaying = "y", anchor = 'free', position = 0.1),
                     yaxis3 = list(title = 'BMI(kg/m2)', side = "left", 
                             overlaying = "y", anchor = 'free', color = "darkgreen", position = 0.2),
                     yaxis4 = list(title = 'Y-axis 4', side = "left", 
                            overlaying = "y", anchor = 'free', color = "purple", position = 0.3),
                     yaxis5 = list(title = 'Y-axis 5',side = "left", 
                             overlaying = "y", anchor = 'free', color = "brown", position = 0.4),
                     showlegend = T
                   )

               })

        }
   shinyApp(server = server, ui = ui)

Answer 1

This should be close to what you want.

The main idea is that you can create a plot with separate commands:

p <- plotly(...)
p <- p %>% add_lines(...)
p <- p %>% add_lines(...)

The difficult part is how to apply the layout with a custom parameter name:

library(shiny)
library(plotly)

data <- data.frame (
  Year = c(2010, 2011, 2012, 2013, 2014),
  Weight = c(56, 60, 67, 65, 70),
  Height = c(160, 165, 168, 171, 173),
  BMI = c(21.9, 22.0, 23.7, 22.2, 23.4),
  Girth = c(32, 33, 34, 34, 33)
)

ui <-  fluidPage(
  selectInput("variable", "Variable:",
              c("Weight(Kg)" = "Weight","Height(cm)" = "Height","BMI(kg/m2)" = "BMI", "Girth(cm)" = "Girth"),
              multiple=TRUE),
  plotlyOutput(outputId = "Graph")
)

colors <- c("red", "orange", "purple", "darkgreen", "brown")

server <- function(input, output) {
  basePlot <- reactive({
    plot_ly(data, type = 'scatter', mode = 'lines') %>%
      layout(xaxis = list(title = "time", domain = c(0.5,1)), showlegend = TRUE)
  })

  output$Graph <- renderPlotly({
    p <- basePlot()
    for (i in seq_along(input$variable)) {
      variable <- input$variable[[i]]

      p <- p %>%
        add_lines(x = ~Year, y = as.formula(paste0("~", variable)), name = variable, yaxis = paste0("y", i), line = list(color = colors[i]))

      position <- 0.5 - (i - 1) * 0.1
      layoutArgs <- list(p, list(title = variable, side = "left", color = colors[i], overlaying = "y", anchor = 'free', position = position))
      names(layoutArgs) <- c("p", paste0("yaxis", i))

      p <- do.call(layout, layoutArgs)

    }
    p
  })

}
shinyApp(server = server, ui = ui)

This code does not work for the first axis. Here you need additional logic to call the parameter yaxis instead of yaxis1 and also drop the yaxis parameter from the add_lines call