迭代绘图和数据分配

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的需要。在observe()正文中将filteredData()的结果保存为一个变量即可。现在这些ggplot调用看起来更“平常”。