迭代绘图和数据分配

Question

我有一个闪亮的应用程序，它会根据用户在 selectInput 字段中选择的条目数（multiple = TRUE）迭代地显示 textOutputs 和两个 ggplot 图形。

我的代码在选择 1 个条目时按预期工作，但在选择 2 个条目时会崩溃。我认为这是由于数据（filteredData）包含与用户选择的字段对应的所有数据值，其大小与绘图所调用的大小不同，它由用户选择索引。我正在寻找一种方法来索引数据（filteredData）。复制该问题的示例代码如下。

cylinder_choices <- as.character(unique(mtcars$cyl))


ui <- fluidPage(
    selectInput("cylinders", label = "Select Cylinders", choices = cylinder_choices, selected = , multiple = TRUE, selectize = TRUE),
    uiOutput("txt")
)

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

  #Filter the filtered data based on the CT Result
  filteredData <- reactive({
    m <- mtcars %>% filter(
      cyl %in% input$cylinders
    )
    m
  })


  output$txt <- renderUI({
    amt <- length(input$cylinders)
    if(!amt) return(NULL)
    tagList(lapply(1:amt, function(nr){
      tagList(
        column(2,
        h5(strong("Number of Cylinders:  "), textOutput(paste0("Cyl", nr), inline = TRUE))
        ),
        #PLOTS
        column(4,
               plotOutput(paste0("plot1_", nr))

        ),
        column(3),
        column(3,
               plotOutput(paste0("plot2_", nr))
        )
      )
    })
    )
  })

  # if selected value = 0 dont create a condPanel,...
  observe({
    amt <- length(input$cylinders)
    if(!amt) return(NULL)
    lapply(1:amt, function(nr){
      local({
        idx <- which(input$cylinders[nr] == filteredData()$cyl)


        output[[paste0("Cyl", nr)]] <- renderText({ as.character(unique(filteredData()$cyl[idx])) })

        output[[paste0("plot1_", nr)]] <- renderPlot({
          filteredData() %>%
            mutate(CYL = replace(cyl, cyl > 6, NA)) %>%
            ggplot(aes(x=mpg[idx], y=disp[idx], width=gear[idx], height=carb[idx])) +
            geom_tile(aes(fill = CYL), colour = "black", linetype = "solid") +
            geom_text(aes(label = cyl),colour="white", size = 6)+
            scale_fill_gradientn(colours = c("blue4", "turquoise1"),
                                 breaks=c(4, 6, Inf), limits = c(4,6),
                                 na.value = "red") +
            labs(x="MPG", y="Disp", title = paste0("Number of Cylinders = ", filteredData()$cyl[idx])) +
            theme(plot.title = element_text(hjust = 0.5, size=30), text = element_text(size=20))
        })


        output[[paste0("plot2_", nr)]] <- renderPlot({
          ggplot(data= filteredData(), aes(filteredData()$am[idx])) +
            geom_histogram(aes(fill = ..x..)) +
            labs(x="AM", y="Count", title = "Histogram of AM Values") +
            theme(plot.title = element_text(hjust = 0.5, size=30), text = element_text(size=20))
        })
      })
    }) 
  })

}

shinyApp(ui=ui, server=server)

Answer 1

这是一个改进的observe() 调用

  observe({
    amt <- length(input$cylinders)
    if(!amt) return(NULL)
    lapply(1:amt, function(nr){
      local({
        cyl_num <- input$cylinders[nr]
        plotdata <- filteredData() %>% filter(cyl == cyl_num)

        output[[paste0("Cyl", nr)]] <- renderText({ as.character(unique(plotdata$cyl)) })

        output[[paste0("plot1_", nr)]] <- renderPlot({
          plotdata %>%
            mutate(CYL = replace(cyl, cyl > 6, NA)) %>%
            ggplot(aes(x=mpg, y=disp, width=gear, height=carb)) +
            geom_tile(aes(fill = CYL), colour = "black", linetype = "solid") +
            geom_text(aes(label = cyl),colour="white", size = 6)+
            scale_fill_gradientn(colours = c("blue4", "turquoise1"),
                                 breaks=c(4, 6, Inf), limits = c(4,6),
                                 na.value = "red") +
            labs(x="MPG", y="Disp", title = paste0("Number of Cylinders = ", cyl_num)) +
            theme(plot.title = element_text(hjust = 0.5, size=30), text = element_text(size=20))
        })


        output[[paste0("plot2_", nr)]] <- renderPlot({
          ggplot(data= plotdata, aes(am)) +
            geom_histogram(aes(fill = ..x..)) +
            labs(x="AM", y="Count", title = "Histogram of AM Values") +
            theme(plot.title = element_text(hjust = 0.5, size=30), text = element_text(size=20))
       })
      })
    }) 
  })

aes() 期间的子集变得混乱，应该避免。在这里，我们获取一次数据并将其过滤到感兴趣的圆柱体。这消除了使用idx 的需要。可以将filteredData() 的结果只保存一次作为observe() 正文中的变量。现在这些 ggplot 调用看起来更“普通”了。