基于一个或多个下拉值的动态绘图 [英] Dynamic Plots Based on One or More Dropdown 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)

推荐答案

第34行this应用中的评论：

需要本地，以便每个项目都有自己的编号。没有它，它的价值 在所有实例中，renderPlot()中的i的值将相同，因为 计算表达式的时间。

因此，您需要将i赋给一个局部变量，否则它对于所有renderPlot都是相同的，因此您的绘图是相同的。此外，应该更改标题以索引输入，否则只有第一个元素用于标题参数，因为当向其传递列表时，粘贴将返回一个列表，而标题只需要一个值。

完整应用：

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)

这篇关于基于一个或多个下拉值的动态绘图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！