make R shiny to show multiple plots

Question

I have the following code, which produces a plot based on the user inputs. if, for example, the user selects three x variables, three plots shall be produced in the output. However, at the moment, only the plot relevant to the last selection is only produced.

library(dplyr)
library(ggplot2)
library(shiny)

plt_func <- function(x,y){
  plt_list <- list()
  for (X_var in x){
    plt_list[[X_var]] <- mtcars %>% ggplot(aes(get(X_var), get(y)))+
      geom_point() + 
      labs(x = X_var, y = y)
  }
  
  return(plt_list)
}



ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectizeInput(inputId = "x",label = "X", choices = names(mtcars), multiple = T),
                 selectInput(inputId = "y",label = "Y", choices = names(mtcars),multiple = F),
                 actionButton("plot", label = "Plot")),
    mainPanel(
      plotOutput("finalplot")
    )
  )
)

server <- function(input, output, session) {
  
plt <- eventReactive(input$plot, {
  req(input$x, input$y)
  x <- input$x
  y <- input$y
  
  do.call(plt_func, list(x,y))
  
})

output$finalplot <- renderPlot({
  plt()
})

}

shinyApp(ui, server)

Here is a screenshot of the output:

I wonder how I should tackle this issue.

Answer 1

To me, the easiest way to solve this problem is to create a module that will manage a single plot and then create the required number of instances of the module in the main server function. You can read more about Shiny modules here.

A Shiny module consists of two functions, a UI function and a server function. These are paired by the fact that they share a common ID. The ID is used to distinguish different instances of the same module. Namespacing (the ns function) is used to distinguish instances of the same widget in different instances of the module.

The module UI function is straightforward. It simply creates a plotOutput:

plotUI <- function(id) {
  ns <- NS(id)
  
  plotOutput(ns("plot"))
}

The module server function takes three parameters: an id and the names of the x and y variables to plot.

plotServer <- function(id, Xvar, Yvar) {
  moduleServer(
    id,
    function(input, output, session) {
      output$plot <- renderPlot({
        req(Xvar)

        mtcars %>% 
          ggplot(aes(get(Xvar), get(Yvar))) +
            geom_point() + 
            labs(x = Xvar, y = Yvar)
      })
    }
  )
}

The main UI function creates the sidebar menu (there's no need for a Plot actionButton as Shiny's reactivity makes sure everything gets updated at the correct time) and a main panel that consists only of a uiOutput.

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput(inputId = "x",label = "X", choices = names(mtcars), multiple = T),
      selectInput(inputId = "y",label = "Y", choices = names(mtcars), multiple = F)
    ),
    mainPanel(
      uiOutput("plotUI")
    )
  )
)

The main server function is where the magic happens. Every time there's a change to input$x or input$y, new instances of the module UI and server functions are created. One for each selection in input$x. The id for each module is simply an integer. The appropriate column names are passed to each instance of the module server function. A call to renderUI creates the UI for each instance of the module.

server <- function(input, output, session) {
  output$plotUI <- renderUI({
    ns <- session$ns
    tagList(
      lapply(1:length(input$x),
        function(i) {
          plotUI(paste0("plot", i))
        }
      )
    )
  })
  
  observeEvent(c(input$x, input$y), {
    plotServerList <- lapply(
      1:length(input$x),
      function(i) {
        plotServer(paste0("plot", i), input$x[i], input$y)
      }
    )
  })
}

Putting it all together:

library(dplyr)
library(ggplot2)
library(shiny)

# Plot module UI function
plotUI <- function(id) {
  ns <- NS(id)
  
  plotOutput(ns("plot"))
}

# Plot module server function
plotServer <- function(id, Xvar, Yvar) {
  moduleServer(
    id,
    function(input, output, session) {
      output$plot <- renderPlot({
        req(Xvar)

        mtcars %>% 
          ggplot(aes(get(Xvar), get(Yvar))) +
            geom_point() + 
            labs(x = Xvar, y = Yvar)
      })
    }
  )
}

# Main UI
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput(inputId = "x",label = "X", choices = names(mtcars), multiple = T),
      selectInput(inputId = "y",label = "Y", choices = names(mtcars), multiple = F)
    ),
    mainPanel(
      uiOutput("plotUI")
    )
  )
)

# Main server
server <- function(input, output, session) {
  output$plotUI <- renderUI({
    ns <- session$ns
    tagList(
      lapply(1:length(input$x),
        function(i) {
          plotUI(paste0("plot", i))
        }
      )
    )
  })
  
  observeEvent(c(input$x, input$y), {
    plotServerList <- lapply(
      1:length(input$x),
      function(i) {
        plotServer(paste0("plot", i), input$x[i], input$y)
      }
    )
  })
}

shinyApp(ui, server)