My shiny app generates a number of useful graphs. I would like to allow the user to download the graphs in various formats.

I have done this before for a single graph using How to save plots that are made in a shiny app as a guide. However, I am ending up creating more repeated code for each additional plot. I am not a programmer, but it really seems like I should be able to write one function to do this since I am just passing parameters to downloadHandler and ggsave, but I can't figure it out.

The MRE below represents a page with, say, ten different graphs. Is there a way to write a single function that receives the plot ID from a button (like a tag or something?) and the format from the selectInput to pass those parameters to downloadHandler and ggsave to save each of those graphs in the selected format? The function at the bottom shows my thinking, but I don't know where to go from here or if that is even the right direction.

Thanks!

library(shiny)
library(ggplot2)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30)
        ),

        # Show plots and download buttons
        mainPanel(
           plotOutput("distPlot"),
           fluidRow(
               column(3,
                      downloadButton("dl_plot1")
               ),
               column(3,
                      selectInput("plot1_format",label = "Format",choices = c("SVG","PDF","JPEG","PNG"),width = "75px")
                      )
           ),
           plotOutput("scat_plot"),
           column(3,
                  downloadButton("dl_plot2")
           ),
           column(3,
                  selectInput("plot2_format",label = "Format",choices = c("SVG","PDF","JPEG","PNG"),width = "75px")
           )
        )
    )
)

# Define server logic required to draw a histogram and scatterplot
server <- function(input, output) {

    output$distPlot <- renderPlot({
        x    <- faithful$waiting
        binwidth<-(max(x)-min(x))/input$bins

        p<-ggplot(faithful,aes(waiting)) 
            geom_histogram(binwidth = binwidth)
        p
    })
    output$scat_plot<-renderPlot({
        p<-ggplot(faithful,aes(x=waiting,y=eruptions)) 
            geom_point()
        p
    })
    
    downloadPlot <- function(plot_name,file_name,file_format){#concept code
      downloadHandler(
        filename=function() { paste0(file_name,".",file_format)},
        content=function(file){
          ggsave(file,plot=plot_name,device=file_format)
        }
      )
    }
}

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

CodePudding user response：

To achieve your desired result without duplicating code you could (or have to) use a Shiny module. Basically a module is a pair of an UI function and a server function. For more on modules I would suggest to have a look at e.g. Mastering shiny, ch. 19.

In the code below I use a module to take care of the download part. The job of downloadButtonUI and downloadSelectUI is to add a download button and a selectInput for the file format. The downloadServer does the hard work and saves the plot in the desired format.

Note: Besides the download module I moved the code for the plots to reactives so that the plots could be passed to the downloadHandler or the download module.

library(shiny)
library(ggplot2)

# Download Module
downloaButtondUI <- function(id) {
  downloadButton(NS(id, "dl_plot"))
}
downloadSelectUI <- function(id) {
  selectInput(NS(id, "format"), label = "Format", choices = c("SVG", "PDF", "JPEG", "PNG"), width = "75px")
}
downloadServer <- function(id, plot) {
  moduleServer(id, function(input, output, session) {
    output$dl_plot <- downloadHandler(
      filename = function() {
        file_format <- tolower(input$format)
        paste0(id, ".", file_format)
      },
      content = function(file) {
        ggsave(file, plot = plot)
      }
    )
  })
}

# Define UI for application that draws a histogram
ui <- fluidPage(
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
        "Number of bins:",
        min = 1,
        max = 50,
        value = 30
      )
    ),
    # Show plots and download buttons
    mainPanel(
      plotOutput("distPlot"),
      fluidRow(
        column(3, downloaButtondUI("distPlot")),
        column(3, downloadSelectUI("distPlot"))
      ),
      plotOutput("scat_plot"),
      fluidRow(
        column(3, downloaButtondUI("scatPlot")),
        column(3, downloadSelectUI("scatPlot"))
      ),
    )
  )
)

server <- function(input, output) {
  dist_plot <- reactive({
    p <- ggplot(faithful, aes(waiting))  
      geom_histogram(bins = input$bins)
    p
  })
  scat_plot <- reactive({
    p <- ggplot(faithful, aes(x = waiting, y = eruptions))  
      geom_point()
    p
  })
  output$distPlot <- renderPlot({
    dist_plot()
  })
  output$scat_plot <- renderPlot({
    scat_plot()
  })

  downloadServer("distPlot", dist_plot())
  downloadServer("scatPlot", scat_plot())
}

# Run the application
shinyApp(ui = ui, server = server)
#> 
#> Listening on http://127.0.0.1:4092