Add a download button to Shiny RMarkdown report?

Question

How do you add a "download PNG" button to a Shiny RMarkdown report? I gather that I'll need to use downloadHandler() but I can't find any info on passing the plot results to that function in an Rmarkdown document specifically (since there is no saved output e.g., output$plot <- renderPlot() like in regular Shiny). Below is an example which allows users to map a variable with different color palettes. Any advice would be much appreciated!

---

Example Report

knitr::opts_chunk$set(echo = TRUE)

# load libraries
library(tidyverse)
library(sf)
library(RColorBrewer)
library(nycgeo)

# save data
df <- nyc_boundaries(geography = "tract") 
df <- mutate(df, response_rate = sample(30:85, size = nrow(df), replace = TRUE))

# define palettes
viridis_pals <- c("Viridis" = "D",
                  "Magma" = "A",
                  "Inferno" = "B",
                  "Plasma" = "C")

brewer_pals <- c("Yellow-Orange-Red" = "YlOrRd",
                 "Yellow-Orange-Brown" = "YlOrBr",
                 "Yellow-Green-Blue" = "YlGnBu",
                 "Yellow-Green" = "YlGn",
                 "Reds",
                 "Red-Purple" = "RdPu",
                 "Purples",
                 "Purple-Red" = "PuRd",
                 "Purple-Blue-Green" = "PuBuGn",
                 "Purple-Blue" = "PuBu",
                 "Orange-Red" = "OrRd",
                 "Oranges",
                 "Greys",
                 "Greens",
                 "Green-Blue" = "GnBu",
                 "Blue-Purple" = "BuPu",
                 "Blue-Green" = "BuGn",
                 "Blues")

Interactive Map

selectInput("pal_type", label = "Palette Type", choices = c("Brewer","Viridis"))

renderUI({
  req(input$pal_type)
  if (input$pal_type == "Viridis") {
    selectInput("pal", label = "Color Palette", choices = viridis_pals)
  } else if (input$pal_type == "Brewer") {
    selectInput("pal", label = "Color Palette", choices = brewer_pals)
  }
})

renderPlot({
  req(input$pal)
  
  map <- ggplot() +
    geom_sf(data = df, aes(fill = response_rate), color = "darkgrey") +
    theme_void() +
    labs(x = NULL, y = NULL, 
         title = "A Fake Map")
  
  final_map <- if (input$pal %in% viridis_pals) {
    map + viridis::scale_fill_viridis("Fake Variable", 
                                      labels = scales::label_percent(scale = 1),
                                      option = input$pal, 
                                      alpha = 0.8)
  } else if (input$pal %in% brewer_pals) {
    map + scale_fill_gradientn("Fake Variable",
                               colors = brewer.pal(9, input$pal),
                               labels = scales::label_percent(scale = 1))
  }
  
  final_map
})

# reactively generate file name
file_name <- reactive({
  paste0("final_map_", input$pal, ".png")
})

# add download of plot
downloadHandler(
  filename = file_name(),
  content = function(file) {ggsave(file, plot())}
)

Answer 1

I figured out the solution!

• Change the plotting pipeline into a reactive: plot <- reactive({gglot() + ...})
• Call that reactive in a render plot to display the map: renderPlot({plot()})
• Pass that to the downloadHandler to download the plot: (downloadHandler(filename = function() {paste0("final_map_", input$pal, ".png")},content = function(file) {ggsave(file, plot())} ))

Working code below :)

---

knitr::opts_chunk$set(echo = TRUE)

# load libraries
library(tidyverse)
library(sf)
library(RColorBrewer)
library(nycgeo)

# save data
df <- nyc_boundaries(geography = "tract") 
df <- mutate(df, response_rate = sample(30:85, size = nrow(df), replace = TRUE))

# define palettes
viridis_pals <- c("Viridis" = "D",
                  "Magma" = "A",
                  "Inferno" = "B",
                  "Plasma" = "C")

brewer_pals <- c("Yellow-Orange-Red" = "YlOrRd",
                 "Yellow-Orange-Brown" = "YlOrBr",
                 "Yellow-Green-Blue" = "YlGnBu",
                 "Yellow-Green" = "YlGn",
                 "Reds",
                 "Red-Purple" = "RdPu",
                 "Purples",
                 "Purple-Red" = "PuRd",
                 "Purple-Blue-Green" = "PuBuGn",
                 "Purple-Blue" = "PuBu",
                 "Orange-Red" = "OrRd",
                 "Oranges",
                 "Greys",
                 "Greens",
                 "Green-Blue" = "GnBu",
                 "Blue-Purple" = "BuPu",
                 "Blue-Green" = "BuGn",
                 "Blues")

Interactive Map

selectInput("pal_type", label = "Palette Type", choices = c("Brewer","Viridis"))

renderUI({
  req(input$pal_type)
  if (input$pal_type == "Viridis") {
    selectInput("pal", label = "Color Palette", choices = viridis_pals)
  } else if (input$pal_type == "Brewer") {
    selectInput("pal", label = "Color Palette", choices = brewer_pals)
  }
})

plot <- reactive({
  req(input$pal)
  
  map <- ggplot() +
    geom_sf(data = df, aes(fill = response_rate), color = "darkgrey") +
    theme_void() +
    labs(x = NULL, y = NULL, 
         title = "A Fake Map")
  
  final_map <- if (input$pal %in% viridis_pals) {
    map + viridis::scale_fill_viridis("Fake Variable", 
                                      labels = scales::label_percent(scale = 1),
                                      option = input$pal, 
                                      alpha = 0.8)
  } else if (input$pal %in% brewer_pals) {
    map + scale_fill_gradientn("Fake Variable",
                               colors = brewer.pal(9, input$pal),
                               labels = scales::label_percent(scale = 1))
  }
  
  final_map
})

renderPlot({plot()})

# add download of plot
downloadHandler(
  filename = function() {paste0("final_map_", input$pal, ".png")},
  content = function(file) {ggsave(file, plot())}
)