Home > database >  Create an arbitrary number of plots in shiny module
Create an arbitrary number of plots in shiny module

Time:07-12

I'm currently working on a shiny Module (to use an app already created) for different models. One of the difficulty is to adapt the module to work with different number of variables to plot. The names of the variable displayed in the app is an argument of the module. I've already use this example https://gist.github.com/wch/5436415 to write my code. Here is a reproductible example of what I've done so far.

modeleServer <- function(id,variables){
  moduleServer(id,function(input, output,session){
    ns <- session$ns
    # Insert the right number of plot output objects into the web page
    output$plots <- renderUI({
      plot_output_list <- lapply(1:length(variables), function(i) {
        ns <- session$ns
        box(title=paste("graphe de ",variables[i],sep=" "),status="info",width=6,
            plotOutput(ns(paste("plot", variables[i], sep=""))))
      })
      
      # Convert the list to a tagList - this is necessary for the list of items
      # to display properly.
      do.call(tagList, plot_output_list)
    }) 
    
    observe({
      
      for (i in (1:length(variables))) {
        # Need local so that each item gets its own number. Without it, the value
        # of i in the renderPlot() will be the same across all instances, because
        # of when the expression is evaluated.
        local({
          my_i <- i
          plotname <- paste("plot", variables[my_i], sep="")
          
          output[[plotname]] <- renderPlot({
            ggplot(airquality) 
              geom_line(aes(x=Day,y=airquality[[paste0(variables[i])]]),col='blue',size=0.4) 
              theme_classic() 
              scale_x_continuous(expand = c(0, 0), limits = c(0,NA))  
              scale_y_continuous(expand = c(0, 0), limits = c(0, NA)) 
              theme(legend.position = "none")  
              ggtitle(paste0("graphe de ",variables[i]))
          })
        })
      }
    })
  })
}

modeleUI <-function(id){
  ns <-NS(id)
  tagList(

    uiOutput(ns("plots"))
  )
}

library(shiny)
library(shinydashboard)
library(tidyverse)
# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("App using module"),
    modeleUI("test")
    
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  modeleServer(id="test",variables=c("Ozone","Wind"))
}

# Run the application 
shinyApp(ui = ui, server = server)

My problem is that the ggplots displayed are all the same (the last one created) even though there are different boxes created and I don't know what's wrong. Thanks for your suggestions !

CodePudding user response:

This works with lapply:

modeleServer <- function(id, variables) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    # Insert the right number of plot output objects into the web page
    output$plots <- renderUI({
      plot_output_list <- lapply(1:length(variables), function(i) {
        ns <- session$ns
        box(
          title = paste("graphe de ", variables[i], sep = " "), 
          status = "info", width = 6,
          plotOutput(ns(paste("plot", variables[i], sep = "")))
        )
      })
      
      # Convert the list to a tagList - this is necessary for the list of items
      # to display properly.
      do.call(tagList, plot_output_list)
    })
    
    lapply(1:length(variables), function(i){
      plotname <- paste("plot", variables[i], sep = "")
      
      output[[plotname]] <- renderPlot({
        ggplot(airquality)  
          geom_line(
            aes(x = Day, y = airquality[[paste0(variables[i])]]), 
            col = "blue", size = 0.4
          )  
          theme_classic()  
          scale_x_continuous(expand = c(0, 0), limits = c(0, NA))  
          scale_y_continuous(expand = c(0, 0), limits = c(0, NA))  
          theme(legend.position = "none")  
          ggtitle(paste0("graphe de ", variables[i]))
      })
    })

  })
  
}

I didn't try, but perhaps this also works with the loop and local. But in your code you use i instead of my_i.

  • Related