根据用户输入文件的因子水平生成动态数量的图

Question

在 shiny 应用程序中，我想为用户输入的文件中的每个因子水平创建单独的图。 这个因素可能有 2 到 10+ 个级别。 在玩具示例中，这个因素是plotGroup 。 我希望它像下面的玩具示例一样为 output，但有单独的图而不是小平面。 我已将此脚本用作指南，但我无法弄清楚如何在此框架内适应反应式 getData() function。 https://gist.github.com/wch/5436415/

数据

structure(list(plotGroup = c("A", "A", "A", "A", "B", "B", "B", 
"B", "C", "C", "C", "C"), xGroup = c("D", "D", "E", "E", "D", 
"D", "E", "E", "D", "D", "E", "E"), yVar = c(5L, 8L, 1L, 6L, 
3L, 4L, 9L, 5L, 8L, 7L, 5L, 3L)), class = "data.frame", row.names = c(NA, 
-12L))

使用构面给出所需 output 的示例应用程序

library(shiny)
library(data.table)
library(ggplot2)
library(dplyr)

ui <- fluidPage(
  
  headerPanel("Dynamic number of plots"),
  
  sidebarPanel(
    fileInput("fileIn", 
              "Load input file",
              multiple = F)
  ),
  
  mainPanel(
    plotOutput("plot1")
  )
)

server <- function(input, output) {
  
  getData <- reactive({
    req(input$fileIn)
    dataIn <- as.data.frame(fread(input$fileIn$datapath))
    return(dataIn)
  })
  
  output$plot1 <- renderPlot({
    getData() %>%
    ggplot(aes(x = xGroup, y = yVar)) +
      facet_wrap(~plotGroup) + geom_point()
  })
  
}

shinyApp(ui, server)

尝试使用上面的要点链接的示例。 这给出了一个Operation not allowed without an active reactive context error。

library(shiny)
library(data.table)
library(ggplot2)
library(dplyr)

ui <- fluidPage(
  
  headerPanel("Dynamic number of plots"),
  
  sidebarPanel(
    fileInput("fileIn", 
              "Load input file",
              multiple = F)
  ),
  
  mainPanel(
    uiOutput("plot1")
  )
)

server <- function(input, output) {
  
  getData <- reactive({
    req(input$fileIn)
    dataIn <- as.data.frame(fread(input$fileIn$datapath))
    return(dataIn)
  })
  
  output$plot1 <- renderUI({
    plotOutputList <- lapply(levels(getData()$plotGroup),
                             function(i){
                               plotname <- paste("plot", i, sep = "_")
                               plotOutput(plotname)
                             })
    do.call(tagList, plotOutputList)
  })
  
  for(i in levels(getData()$plotGroup)){
    local({
      iCurrent <- i
      plotname <- paste("plot", iCurrent, sep = "_")
      
      output[[plotname]] <- renderPlot({
        getData() %>%
          filter(plotGroup == iCurrent) %>%
        ggplot(aes(x = xGroup, y = yVar)) +
          geom_point()
      })
    })
  }
}

shinyApp(ui, server)

Answer 1

这里有两个问题。 首先，您共享的数据表明plotGroup是一个字符值，而不是一个因素。 这意味着levels()将返回 NULL，因为它没有。 您可以使用unique()来获取该列中的不同值，而不是levels() 。

第二个问题是您的for循环需要处于反应性上下文中。 最简单的修复方法就是将它包装在一个observe块中。

服务器 function 应该是这样的

server <- function(input, output) {
  
  getData <- reactive({
    return(data)
  })
  
  output$plot1 <- renderUI({
    plotOutputList <- lapply(unique(getData()$plotGroup),
                             function(i){
                               plotname <- paste("plot", i, sep = "_")
                               plotOutput(plotname)
                             })
    do.call(tagList, plotOutputList)
  })
  
  observe({
    for(i in unique(getData()$plotGroup)){
    local({
      iCurrent <- i
      plotname <- paste("plot", iCurrent, sep = "_")
      
      output[[plotname]] <- renderPlot({
        getData() %>%
          filter(plotGroup == iCurrent) %>%
          ggplot(aes(x = xGroup, y = yVar)) +
          geom_point()
      })
    })
  }})
}