反復プロットとデータ割り当て

Question

私は、multiple = TRUEのselectInputフィールドでユーザーが選択したエントリの数に基づいて、textOutputsと2つの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

はここaes()が乱雑取得し、避けるべきである

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)) 
     }) 
     }) 
    }) 
    }) 

サブセット中に改善observe()呼び出します。ここではデータを一度取得し、関心のあるシリンダにフィルタリングします。これにより、idxを使用する必要がなくなります。 filteredData()の結果をobserve()本文内の変数として1回だけ保存しても問題ありません。今、これらのggplot呼び出しは、もっと「普通」に見えます。