Home > Enterprise >  Select current plot and download to file
Select current plot and download to file

Time:06-28

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)

CodePudding user response:

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

  • Related