如何在Shiny App的可下载R Markdown中包含LeafletProxy地图？

问题背景 #

我正在开发一个包含Leaflet地图的Shiny应用，需要生成可下载的R Markdown报告，包含用户点击下载按钮时的当前地图状态。尝试用mapshot包截图并移除缩放控件，但在downloadHandler里无法正确访问地图：用leaflet('map')或leafletProxy('map')要么报错，要么生成空白图片。

修复后的完整代码 #

library(shiny)
library(leaflet)
library(rmarkdown)
library(mapview)
library(sf)
library(glue)  # 需显式加载glue包

locations <- data.frame(
  name = c("Location A", "Location B", "Location C", 
           "Location D", "Location E", "Location F", "Location G"),
  lat = c(-27.4698, -27.9997, -27.4533, -27.4743, -27.4699, -27.3846, -27.4495),
  lon = c(153.0251, 153.0147, 153.0350, 153.0282, 153.0157, 153.1173, 153.0336)
) 

locations_sf <- st_as_sf(locations, coords = c("lon", "lat"), crs = 4326)
locations_picker <- sort(locations$name)

ui <- fluidPage(
  pickerInput(
    inputId = "location_picker",
    label = "Select a location",
    choices = locations_picker,
    selected = locations_picker[1]  # 设置默认选中项，避免初始状态异常
  ),
  leafletOutput("map"),
  downloadButton(outputId = "download_button", label = "Download report")
)

server <- function(input, output) {
  # 用选中的地点名称作为响应式值，初始设为第一个地点
  selected_location <- reactiveVal(locations_picker[1])

  # 创建响应式的完整地图对象，而非仅初始对象
  reactive_map <- reactive({
    selected_data <- locations_sf %>% filter(name == selected_location())
    
    leaflet(options = leafletOptions(attributionControl = FALSE)) %>%
      addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
      setView(
        lng = st_coordinates(selected_data)[1],
        lat = st_coordinates(selected_data)[2],
        zoom = 20
      ) %>%
      addMarkers(
        data = selected_data,
        label = htmltools::HTML(paste0("<strong>Locality:</strong>", selected_data$name))
      )
  })

  # 渲染地图
  output$map <- renderLeaflet(reactive_map())

  # 更新选中地点的响应式值
  observeEvent(input$location_picker, {
    selected_location(input$location_picker)
  })

  output$download_button <- downloadHandler(
    filename = function() {
      paste0("Report for ", selected_location(), ".html")
    },
    content = function(file) {
      temp_dir <- tempdir()
      map_path <- file.path(temp_dir, "map.png")
      
      # 使用响应式的完整地图对象生成截图，而非leafletProxy
      mapshot2(reactive_map(), file = map_path, remove_controls = c("zoom", "attribution"))

      # 正确拼接Rmd内容，确保路径被解析为字符串
      rmd_content <- glue::glue("
      ---
      title: 'Report for {selected_location()}'
      output: html_document
      ---

      ## Leaflet map
      ![Map]({map_path})

      This is an example markdown.
      ")

      rmd_file <- file.path(temp_dir, "report.Rmd")
      writeLines(rmd_content, con = rmd_file)
      
      # 渲染时设置输出目录为临时目录，确保图片路径正确
      rmarkdown::render(rmd_file, output_format = "html_document", output_file = file,
                        output_dir = temp_dir)
    }
  )
}

shinyApp(ui = ui, server = server)

关键修复说明 #

• 用响应式完整地图对象替代leafletProxy：leafletProxy仅用于更新已渲染的地图，不是完整的leaflet对象，无法被mapshot识别。我们创建reactive_map()，每次选中地点变化时生成完整的地图对象，既用于渲染UI，也用于截图。
• 修复初始状态异常：将selected_location的初始值设为第一个地点，而非FALSE，避免初始渲染和下载时的数据过滤错误；同时给pickerInput设置默认选中项。
• 正确处理图片路径：在glue中直接解析map_path变量，确保Rmd里的图片路径是正确的字符串；渲染Rmd时指定output_dir为临时目录，保证报告能找到图片文件。
• 显式加载glue包：原代码中使用了glue但未加载，会导致报错。
• 移除指定控件：在mapshot2中通过remove_controls参数明确移除缩放和 attribution 控件，符合需求。

内容的提问来源于stack exchange，提问作者anorlondo