迭代繪圖和數據分配

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調用看起來更「平常」。