【问题标题】：Add a download button to Shiny RMarkdown report?向 Shiny RMarkdown 报告添加下载按钮？
【发布时间】：2020-08-28 16:28:52
【问题描述】：

如何在 Shiny RMarkdown 报告中添加“下载 PNG”按钮？我收集到我需要使用 downloadHandler() 但我找不到任何关于将绘图结果传递给 Rmarkdown 文档中的函数的信息（因为没有保存的输出，例如 output$plot

示例报告

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

互动地图

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

【问题讨论】：

为此，您需要执行以下两项操作之一：(1) 将您的绘图代码更改为始终生成 PNG，然后从 renderPlot 更改为静态图片链接；或 (2) 在您的 renderPlot 中，在您返回 final_map 之前，使用 ggsave 将其保存为 PNG，然后在您的下载处理程序中使用该路径。
或者你也可以推荐"右击图片并选择*"图片另存为..."。
嘿@r2evans，我想出了另一个解决方案，将绘图管道更改为反应式 (plot())，使用 renderPlot(plot()) 在报告上显示，然后传递 plot()到downloadHandler...它的工作原理！

标签： r shiny r-markdown

【解决方案1】：

我想出了解决办法！

将绘图管道更改为反应式：plot <- reactive({gglot() + ...})
在渲染图中调用该响应式以显示地图：renderPlot({plot()})
将其传递给 downloadHandler 以下载情节：(downloadHandler(filename = function() {paste0("final_map_", input$pal, ".png")},content = function(file) {ggsave(file, plot())} ))

下面的工作代码:)

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

互动地图

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

【讨论】：