Search code examples
rshinytidyverseshinyjs

Select current plot and download to file


How can I save the current plot that is displayed on the mainPanel? I am having trouble pointing the correct graphic to the download Handler. This is what I have:

library(shiny)
library(ggplot2)
library(tidyverse)
library(shinythemes)
library(plotly)
library(scales)
library(shinyWidgets)
library(shinydashboard)
library(shinyjs)

# Define input choices
type <- c("first", "second")
#Data for lambda
table <- structure(list(year = 1991:2010, lambda = c(0.68854, 0.75545, 
                                                     1.63359, 1.22282, 1.70744, 1.09692, 0.51159, 1.3904, 1.09132, 
                                                     0.59846, 0.43055, 0.80135, 0.69027, 0.65646, 0.95485, 1.04818, 
                                                     0.67859, 1.00461, 1.16665, 1.28203)), row.names = c(NA, -20L), class = "data.frame")


ui <- fluidPage(
  useShinyjs(), # to initialise shinyjs
  navbarPage("Test",
             windowTitle = "A Test",
             sidebarPanel(
               h3(""),
               
               #Dropdown to select the desired kind of graphic
               selectInput(inputId = "graphtype",
                           label = "Graphic",
                           choices = type,
                           selected = "first"),
               
               disabled( #start as disabled
                 checkboxInput("Fixed","Fixed Y axes", FALSE))),
             downloadButton('downloadPlot', 'Download Plot'),
             
             #Graphic Area mainPanel. Graphic on top and table right below it
             mainPanel(plotOutput("plot"),
                       dataTableOutput("mytable"))
  ))

###################################################################################################

server<- function (input, output, session) {
  session$onSessionEnded(function() {
    stopApp()
  })  
  
  #Plot data
  output$plot <- renderPlot({
    xlabels <- 1991:2011
    switch(input$graphtype,
           "first" = {
             disable("Fixed")
           print(ggplot(table,aes(year,lambda)) + geom_line(size=1.5,colour="blue") + geom_point(colour="orange",size=4) + 
                scale_x_continuous("",breaks = xlabels) + 
                theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) + 
                labs(x="",y="test",title= paste0("Population growth rate of Fish "))) 
           },
           {
             enable("Fixed")
           if(input$Fixed == FALSE){
             "second" <- print(ggplot(table,aes(year,lambda)) + geom_line(size=1.5,colour="red") + geom_point(colour="green",size=4) + 
                        scale_x_continuous("",breaks = xlabels) +
                        theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) + 
                        labs(x="",y="fish test",title= paste0("Population growth")))
             
           }
             else{
             "second" <- print(ggplot(table,aes(year,lambda)) + geom_line(size=1.5,colour="yellow") + geom_point(colour="green",size=4) + 
                                scale_x_continuous("",breaks = xlabels) + 
                                theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) + 
                                labs(x="",y="fish test",title= paste0("Population growth")))
             
           }
           } 
           
           
    )
    output$downloadPlot <- downloadHandler(
     filename = "plot.png" ,
    content = function(file) {
     ggsave(plot(), filename = file)
    })    
    
  })
  
  
}
shinyApp(ui = ui, server = server)

Solution

  • One option would be to move your plotting code to a reactive. This way you could print your plot inside renderPlot but also pass the plot to the ggsave inside the downloadHandler. Additionally I cleaned up the code to switch between the plots a little bit.

    Note: I moved the download button to the sidebar because otherwise it would not work. Also, I made the code more minimal by removing all the unnecessary packages and code.

    library(shiny)
    library(ggplot2)
    
    # Define input choices
    type <- c("first", "second")
    # Data for lambda
    table <- structure(list(year = 1991:2010, lambda = c(
      0.68854, 0.75545,
      1.63359, 1.22282, 1.70744, 1.09692, 0.51159, 1.3904, 1.09132,
      0.59846, 0.43055, 0.80135, 0.69027, 0.65646, 0.95485, 1.04818,
      0.67859, 1.00461, 1.16665, 1.28203
    )), row.names = c(NA, -20L), class = "data.frame")
    
    
    ui <- fluidPage(
      sidebarPanel(
        h3(""),
    
        # Dropdown to select the desired kind of graphic
        selectInput(
          inputId = "graphtype",
          label = "Graphic",
          choices = type,
          selected = "first"
        ),
        checkboxInput("Fixed", "Fixed Y axes", FALSE),
        downloadButton("downloadPlot", "Download Plot")
      ),
      # Graphic Area mainPanel. Graphic on top and table right below it
      mainPanel(
        plotOutput("plot"),
        dataTableOutput("mytable")
      )
    )
    
    ###################################################################################################
    
    server <- function(input, output, session) {
      session$onSessionEnded(function() {
        stopApp()
      })
    
      # Plot data
      create_plot <- reactive({
        xlabels <- 1991:2011
        if (input$graphtype == "first") {
          ggplot(table, aes(year, lambda)) +
            geom_line(size = 1.5, colour = "blue") +
            geom_point(colour = "orange", size = 4) +
            scale_x_continuous("", breaks = xlabels) +
            theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) +
            labs(x = "", y = "test", title = paste0("Population growth rate of Fish "))
        } else {
          if (!input$Fixed) {
            ggplot(table, aes(year, lambda)) +
              geom_line(size = 1.5, colour = "red") +
              geom_point(colour = "green", size = 4) +
              scale_x_continuous("", breaks = xlabels) +
              theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) +
              labs(x = "", y = "fish test", title = paste0("Population growth"))
          } else {
            ggplot(table, aes(year, lambda)) +
              geom_line(size = 1.5, colour = "yellow") +
              geom_point(colour = "green", size = 4) +
              scale_x_continuous("", breaks = xlabels) +
              theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) +
              labs(x = "", y = "fish test", title = paste0("Population growth"))
          }
        }
      })
    
      output$plot <- renderPlot({
        create_plot()
      })
    
      output$downloadPlot <- downloadHandler(
        filename = function() "plot.png",
        content = function(file) {
          ggsave(create_plot(), filename = file)
        }
      )
    }
    shinyApp(ui = ui, server = server)
    

    enter image description here