在多 Y 轴图中动态传递变量名称作为 Y 轴名称

Question

按照to this question 的答案之一，我想在 plotly 上创建一个多 y 轴图。

我创建了一个闪亮的示例，我希望用户：

1. 从 selectInput 中选择要位于 Y 轴上的变量并将变量名称传递给相应的 y 轴
2. 根据所选变量的数量和名称更改 Y 轴的顺序和数量。

这是我手动选择 Y 轴数据的代码：

  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

这应该接近你想要的。

主要思想是您可以使用单独的命令创建绘图：

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

困难的部分是如何使用自定义参数名称应用布局：

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)

此代码不适用于第一个轴。在这里，您需要额外的逻辑来调用参数yaxis 而不是yaxis1，并从 add_lines 调用中删除 yaxis 参数