在闪亮的图中添加动态数量的轨迹

Question

有人要求将动态数量的跟踪数添加到plot_ly绘图中。这是基于最近的问题已被删除。我希望下面的答案可以帮助其他正在寻找类似情况的答案的人。

Answer 1

如上所述，这是我早期答案在这里的重复。

但是， @ybs的方法过于复杂，我想提供直接比较的可能性。使用data.frame以ggplot或plotly是首选的方法（使用eg data.table ::融化从宽到长）。这样，我们可以使用plot_ly's split，name或color参数参数以基于数据创建多个跟踪：

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)

Answer 2

一种方法是通过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)