将动态数量的迹线添加到闪亮的图中

Add dynamic number of traces to a plot in shiny

有人要求向 plot_ly 图中添加动态轨迹数。这是基于已删除的最近 question。我希望下面的答案可以帮助正在寻找类似情况答案的其他人。

一种方法是 select 通过 selectInput 可以包含在时间序列中的所有变量。然后绘制旁边有复选标记的那些。完整代码。

library(shiny)
library(shinydashboard)
library(DT)
library(plotly)
library(gapminder)
library(tidyr)

dfa <- gapminder[,c(1,3,4)]

df <- dfa %>% pivot_wider(names_from = country, values_from = lifeExp)

cols <- colnames(df)[-1]

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("col","Pick a column for y-axis to plot, if ticked in checkbox below", choices = cols, selected = cols[1], multiple = TRUE),
    checkboxGroupInput("chk", "Display Plot", choices = cols[1]) 
  ),
  dashboardBody(
    tabsetPanel(id="tabs",
                tabPanel("Plot data" , plotlyOutput("tseries"))
    ))
)

server <- function(input, output, session) {

  observeEvent(input$col, {
    
    updateCheckboxGroupInput(session, "chk","Select item to plot", choices = input$col)
    
  })
  
  output$tseries <- renderPlotly({

    if (is.null(input$chk)) { ### nothing selected to plot
      fig <- NULL
    }else {
      n <- length(input$chk)
      lapply(1:n, function(i) {
        if (i==1){ ### one item plot
          fig <<- plot_ly(df, type = 'scatter', mode = 'lines') %>%
            add_trace(x = ~year, y = ~.data[[input$chk[1]]], showlegend = F)
        }else { ### additional items to plot
          fig <<- fig %>%  add_trace(x = ~year, y = ~.data[[input$chk[i]]], showlegend = F)
        }
      })
      
    }

    fig
  })

}

shinyApp(ui, server)

如上所述,这是我之前回答的副本

但是,@YBS 的方法过于复杂,我想提供直接比较的可能性。对 ggplotplotly 使用长格式的 data.frame 是首选方法(例如使用 data.table::melt 将宽格式转换为长格式)。这样我们就可以使用 plot_lysplitnamecolor 参数根据数据创建多个跟踪:

library(shiny)
library(shinydashboard)
library(plotly)
library(gapminder)

DF <- gapminder[, c(1, 3, 4)]

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectizeInput(
      "col",
      "Pick a column for y-axis to plot, if ticked in checkbox below",
      choices = NULL,
      selected = NULL,
      multiple = TRUE
    ),
    checkboxGroupInput("chk", "Display Plot", choices = DF$country[1])
  ),
  dashboardBody(tabsetPanel(id = "tabs",
                            tabPanel(
                              "Plot data" , plotlyOutput("tseries")
                            )))
)

server <- function(input, output, session) {
  freezeReactiveValue(input, "col")
  
  # server-side selectize for improved performance
  updateSelectizeInput(
    session,
    "col",
    choices = DF$country,
    selected = DF$country[1],
    server = TRUE
  )
  
  observeEvent(input$col, {
    updateCheckboxGroupInput(
      session,
      "chk",
      "Select item to plot",
      choices = input$col,
      selected = input$col
    )
  })
  
  output$tseries <- renderPlotly({
    if (is.null(input$chk)) {
      plotly_empty(type = 'scatter', mode = 'lines')
    } else {
      plot_ly(
        DF[DF$country %in% input$chk, ],
        type = 'scatter',
        mode = 'lines',
        x = ~ year,
        y = ~ lifeExp,
        split = ~ country
      )
    }
  })
}

shinyApp(ui, server)