0
votes

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


1
@YBS how is that going to solve the problem? What I would do is maybe use something like patchwork or cowplot to construct an image and save it into a variable. You can then use this variable to plot it or save it to a file. - Roman Luštrik
Using lapply doesn't seem to change anything, but thanks for the suggestion. Roman could you provide an example? I've thought of doing this but can't figure out how to do it inside of the observe(for{}) loop, and return a savable object. - montyman14

1 Answers

0
votes

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)