r - Saving Dynamically Generated Plots in Shiny

Question

so I have recently adapted some code that I found on StackOverflow to create a dynamic number of plots based on user input. However, I now cannot figure out how to save all of those dynamic plots in one file; when I use ggsave() in downloadHandler, it only saves the last plot generated, as the plots are created inside of a for loop, inside of an observe function. I have tried saving the for loop as a separate function and saving that instead of last plot, I have tried saving the observe() as a function and calling that inside ggsave(), but nothing works. Any idea how I can save all of the generated plots to one file?

ui <- fluidPanel(
    sidebarLayout(
      sidebarPanel(
      #this is the input widget for dataset selection
      selectInput(inputId = "dataset_selec",
                  label = "Choose which Dataset to explore:",
                  choices = list("NK AD Dataset (Zhang, 2020)", 
                                 "APPPS1 Dataset (Van Hove, 2019)",
                                 "Aging T Cell Dataset (Dulken, 2019)"),
                  selected = "APPPS1 Dataset (Van Hove, 2019)"))
      mainPanel(
        fluidRow(
                   column(4, 
                          textInput(inputId = "gene_fp", 
                                    label = "Enter gene(s) of interest here, separated by commas: ")
                          ),
                   column(4,
                          br(),
                          checkboxInput("split_fp", "Split the graph?")
                          ),
                   column(4, 
                          conditionalPanel(condition = "input.split_fp == true",
                                           #display choices to split by
                                           selectInput(inputId = "metadata_split_fp", 
                                                       label = "Choose how to split the Seurat data: ", 
                                                       choices = list("Genotype", "Timepoint")))
                          )
                 ),
                 
                 #ask users if they want to split the graphs
                
                 
                 br(),
                 fluidRow(
                   column(4, 
                          textInput("save_name_fp",
                                    label = "Enter a file name: ")
                          ),
                   column(4, 
                          conditionalPanel(condition = "input.save_name_fp.length > 0",
                                           selectInput("fp_device", 
                                                       label = "Select file type: ",
                                                       choices = list("PNG", "JPEG", "PDF", "TIFF",
                                                                      "BMP", "SVG")))
                          ),
                   column(4, 
                          br(),
                          conditionalPanel(condition = "input.save_name_fp.length > 0",
                                           downloadButton("fp_save", label = "Save Feature Plot"))
                          )
                 ),
                 #plot the actual plot
                 uiOutput("fp_plots")
                 )
        )
)





server <- function(input, output, session) {

    datasetInput <- reactive({
    switch(input$dataset_selec, 
           "NK AD Dataset (Zhang, 2020)" = nk_data, 
           "APPPS1 Dataset (Van Hove, 2019)" = appps1_data,
           "Aging T Cell Dataset (Dulken, 2019)" = tcellinfil_data)
    })

    output$fp_plots <- renderUI({
    
    #validate is to prevent an error message from being displayed when a gene hasn't been entered yet
    validate(
      need(input$gene_fp !="", "Please enter a gene.")
    )
      
    fp_genes <- input$gene_fp
    fp_genes <- gsub(" ", "", fp_genes)
    fp_genes <- unlist(strsplit(fp_genes, split = ","))
    n <- length(fp_genes)
    
    plot_output_list <- lapply(1:n, function(i) {
      plotname <- paste("plot", i, sep = "")
      if (input$split_fp == TRUE) {plotOutput(plotname, height = 580, width = 1100)}
      else {plotOutput(plotname, height = 580, width = 550)}
    })
    
    do.call(tagList, plot_output_list)
    
    
  })
  #Here, we take the input of genes, and turn it into a character vector, so that we can iterate 
  #over it. This needs to be under observe({}) because it involves an input. 
  #Next, we iterate through the list of genes using a for loop, and within that for loop we assign 
  #the plots that we want to be displayed to each plotname, which is also sequentially created within 
  #this for loop, and assign it to the tagList we generated earlier. Basically, we're adding objects to
  #list of names we made earlier. 
  #This needs to be under local({}) control, otherwise each graph doesn't get its own number, 
  #because of when renderPlot is evaluated
  observe({
    fp_genes <- input$gene_fp
    fp_genes <- gsub(" ", "", fp_genes)
    fp_genes <- unlist(strsplit(fp_genes, split = ","))
    for (i in 1:length(fp_genes)) {
      local({
        
        plotname <- paste("plot", i, sep = "")
        gene <- fp_genes[i]
        output[[plotname]] <- renderPlot({
          if (input$split_fp == TRUE) {FeaturePlot(datasetInput(), features = gene, split.by = input$metadata_split_fp)}
          else {FeaturePlot(datasetInput(), features = gene)}
        })
      })
    }
  })

  output$fp_save <- downloadHandler(
    filename = function() {
      paste(input$save_name_fp, tolower(input$fp_device), sep = ".")
    },
    content = function(file) {
      ggsave(file, device = tolower(input$fp_device))
    }
  )
}

question from:https://stackoverflow.com/questions/66066695/saving-dynamically-generated-plots-in-shiny

Answer 1

Create a list of plots, use grid.arrange to save it in a format you wish, and then save it. Perhaps you can adapt this code.

library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)

mean_data <- data.frame(
  Name = c(paste0("Group_", LETTERS[1:20])),
  matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))

sd_data <- data.frame(
  Name = c(paste0("Group_", LETTERS[1:20])),
  matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))

# Prepare dataset.
#   1. Bind mean and sd data
#   2. Reshape
data <- bind_rows(list(
  mean = mean_data,
  sd = sd_data
), .id = "stat")
data_mean_sd1 <- data %>%
  pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
  pivot_wider(names_from = "stat", values_from = "value")
###
ui <- fluidPage(

  pageWithSidebar(
    headerPanel("Gene_FPKM Value Barplot"),
    sidebarPanel(
      selectInput(
        "selectGeneSymbol",
        "Select Gene Symbol:",
        choices = unique(data_mean_sd1$Gene),
        multiple =F,
        width = 400,
        selected = 1 #"Igfbp7"
      ),
      selectInput(
        "selectGeneSymbol2",
        "Select Gene Symbol2:",
        choices = unique(data_mean_sd1$Gene),
        multiple =F,
        width = 400,
        selected = 1 #"Igfbp7"
      ),
      selectInput("fp_device",
                  label = "Select file type: ",
                  choices = list("PNG", "JPEG", "PDF", "TIFF","BMP", "SVG")
                  ),
      actionButton(inputId = "plot1", label = "FPKM"),
      actionButton(inputId = "plot2", label = "logFC"),
      actionButton(inputId = "all",label = "logFC&FPKM"),br(),
      downloadButton("fp_save", label = "Save Feature Plot")
    ),
    mainPanel(
      uiOutput("all")
    )
  )

)

server <- function(input, output, session) {

  plot_data1 <- reactive({
    subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
  })

  plot_data2 <- reactive({
    subset(data_mean_sd1, Gene %in% input$selectGeneSymbol2)
  })

  global <- reactiveValues(out = NULL)

  observeEvent(input$plot1, {
    global$out <- plotOutput("plot1", height=750)
  })

  observeEvent(input$plot2, {
    global$out <- plotOutput("plot2", height=750)
  })

  observeEvent(input$all, {
    global$out <- plotOutput("plot3", height=1150)
  })

  output$all <- renderUI({
    global$out
  })

  p1 <- eventReactive(list(input$plot1,
                       input$all), {
    ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
      geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
      geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
      theme_classic2() +
      rotate_x_text(angle = 45) +
      theme(legend.position = "none") +
      labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
      theme(plot.title = element_text(hjust = 0.5)) +
      theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
      theme(axis.text.x=element_text(vjust=1,size=12))
      })

  p2 <- eventReactive(list(input$plot2,
                       input$all), {
    ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
      geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
      geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
      theme_classic2() +
      rotate_x_text(angle = 45) +
      theme(legend.position = "none") +
      labs(title = input$selectGeneSymbol2, x = NULL, y = "FPKM_value") +
      theme(plot.title = element_text(hjust = 0.5)) +
      theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
      theme(axis.text.x=element_text(vjust=1,size=12))
    })
  
  #plotlist <- do.call(tagList, list(p1(),p2()))

  output$plot1 <- renderPlot({ p1() })
  output$plot2 <- renderPlot({ p2() })
  output$plot3 <- renderPlot({ grid.arrange(p1(),p2(), ncol=1) })
  
  observe({
    plots <- list(p1(),p2())
    myplots <- do.call(grid.arrange, c(plots, ncol = 1))
    
    output$fp_save <- downloadHandler(
      filename = function() {
        paste("myplots", tolower(input$fp_device), sep = ".")
      },
      content = function(file) {
        ggsave(file, plot=myplots, device = tolower(input$fp_device))
      }
    )
    
  })

}

# Create Shiny app ----
shinyApp(ui = ui, server = server)