Generate dynamic number of plots based on factor levels of user input file-CodePudding

In a shiny app I would like to create separate plots for each factor level in a file that a user inputs. This factor may have anywhere from 2 to 10 levels. In the toy example this factor is plotGroup. I would like it to output as in the toy example below but have separate plots rather than facet. I have used this script as a guide but I am not able to figure out how to fit the reactive getData() function within this framework. https://gist.github.com/wch/5436415/

Data

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

Example app giving desired output using facets

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)

Example of trying using the gist link above. This gives an 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)

CodePudding user response：

There are two problems here. First, the data you shared shows that plotGroup is a character value, not a factor. This means that levels() will return NULL since it doesn't have any. Rather than levels(), you can use unique() to get the different values in that column.

The second problem is that your for loop needs to be in a reactive context. The easiest fix is just to wrap it in an observe block.

The server function should look like this

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