基于一个或多个下拉值的动态图

Question

我正在尝试根据一个或多个选定的下拉值（在本例中为species）制作多个动态图（不知道会输出多少图）。

我确实成功地根据下拉列表绘制了图。例如，如果用户从下拉列表中选择两个 values/species，则显示两个图；如果选择一个 value/species，则显示一个图。

尽管绘图的数量与下拉列表值的数量相匹配，但如果选择了两个或更多下拉列表 values/species，则绘图会重复显示（仅当仅选择一个值时才有效）。任何建议都会有很大帮助。

以下代码使用 R 中的鸢尾花数据集。

image1 image2

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(tidyverse)
library(shinydashboard)

species = c("setosa", "versicolor", "virginica")

ui <- dashboardPage(
  dashboardHeader(title = "ddPCR"),
  
  sidebar <- dashboardSidebar(
    sidebarMenu(
      menuItem("General Overview", tabName = "tab1", icon = icon("dashboard"))
    )
  ),
  
  body <- dashboardBody(
    tabItems(
      tabItem(
        tabName = "tab1",
        uiOutput("species_dropdown"),
        DT::dataTableOutput("table1"),
        uiOutput("plots")
      )
    )
  )
)

server <- function(input, output) {
  
  output$species_dropdown <- renderUI({
    pickerInput(
      "var1",
      "Species:",
      choices = species,
      options = pickerOptions(
        actionsBox = T,
        header = "Close",
        liveSearch = T
      ),
      multiple = T
    )
  })
  
  filtered_data <- reactive({
    iris %>% 
      filter(Species %in% input$var1)
  })
  
  output$table1 <- DT::renderDataTable({
    req(input$var1)
    filtered_data()
  })
  
  # Insert the right number of plot output objects into the web page
  output$plots <- renderUI({
    req(input$var1)
    
    plot_output_list <- lapply(1:length(input$var1), function(i) {
      plotname <- paste("plot", i, sep="")
      plotOutput(plotname, height = 280, width = 250)
    })
    
    do.call(tagList, plot_output_list)
  })
  
  for (i in 1:length(species)) {
    local({
      plotname <- paste("plot", i, sep="")

      output[[plotname]] <- renderPlot({
        ggplot(filtered_data(), aes(x = Sepal.Length, y = Sepal.Width)) + 
          geom_point() +
          labs(title = paste(input$var1, sep = ""), x = "Sepal Length", y = "Sepal Width") 
      })
    })
  }
}

shinyApp(ui, server)

Answer 1

来自第 34 行 this 应用中的评论：

Need local so that each item gets its own number. Without it, the value of i in the renderPlot() will be the same across all instances, because of when the expression is evaluated.

所以你需要将 i 分配给一个局部变量，否则它对所有 renderPlots 都是相同的，因此你的图是相同的。此外，您的标题应该更改为输入索引，否则只有第一个元素用于标题参数，因为 paste 将 return 传递给列表时的列表，而标题只需要一个值。

完整应用：


library(shiny)
library(shinyWidgets)
library(ggplot2)
library(tidyverse)
library(shinydashboard)

species = c("setosa", "versicolor", "virginica")

ui <- dashboardPage(
  dashboardHeader(title = "ddPCR"),
  
  sidebar <- dashboardSidebar(
    sidebarMenu(
      menuItem("General Overview", tabName = "tab1", icon = icon("dashboard"))
    )
  ),
  
  body <- dashboardBody(
    tabItems(
      tabItem(
        tabName = "tab1",
        uiOutput("species_dropdown"),
        DT::dataTableOutput("table1"),
        uiOutput("plots")
      )
    )
  )
)

server <- function(input, output) {
  
  output$species_dropdown <- renderUI({
    pickerInput(
      "var1",
      "Species:",
      choices = species,
      options = pickerOptions(
        actionsBox = T,
        header = "Close",
        liveSearch = T
      ),
      multiple = T
    )
  })
  
  filtered_data <- reactive({
    iris %>% 
      filter(Species %in% input$var1)
  })
  
  output$table1 <- DT::renderDataTable({
    req(input$var1)
    filtered_data()
  })
  
  # Insert the right number of plot output objects into the web page
  output$plots <- renderUI({
    req(input$var1)
    
    plot_output_list <- lapply(1:length(input$var1), function(i) {
      plotname <- paste("plot", i, sep="")
      plotOutput(plotname, height = 280, width = 250)
    })
    
    do.call(tagList, plot_output_list)
  })
  
  for (i in 1:length(species)) {
    
    local({
      my_i <- i #crucial
      
      plotname <- paste("plot", my_i, sep="") # use my_i instead of i
      
      output[[plotname]] <- renderPlot({
        
        ggplot(filtered_data(), aes(x = Sepal.Length, y = Sepal.Width)) + 
          geom_point() +
          labs(title = paste(input$var1[my_i], sep = ""), x = "Sepal Length", y = "Sepal Width") # title needs input$var1 indexed as paste will return a list otherwise, in which case only a first element gets used for the title hence all titles are identical
        

      })
    })
  }
  
}

shinyApp(ui, server)

基于一个或多个下拉值的动态图

Dynamic Plots Based on One or More Dropdown Values

r

shiny

shinydashboard