Shiny中用downloadHandler保存Leaflet地图：保留数据点与底图匹配问题

1. 解决保存地图丢失数据点的问题 #

主面板展示的地图带有LifeStage分类样式配置，但原代码中create_current_map()会重新创建基础版mapview(dat)，没有复用这些样式，导致保存的地图缺失带样式的数据点图层。

修改方案：
将主面板的地图对象存入reactive变量，保存时直接复用该已配置好的地图，再调整视图参数即可。

2. 解决保存时底图不跟随当前显示的问题 #

前端切换底图是Leaflet的客户端交互，后端默认无法感知当前选中的底图。需要监听底图切换事件，把当前底图ID同步到后端，再在生成保存地图时指定该底图。

修改方案：
通过onRender给Leaflet地图添加底图切换监听事件，将选中的底图名称同步到后端；在创建保存用地图时，清除原有底图并添加当前选中的底图。

修改后的完整代码 #

library(shiny)
library(leaflet)
library(webshot2)
library(htmlwidgets)
library(mapview)

# 定义底图列表
basemap_list <- c("Esri.WorldStreetMap","Esri.WorldTopoMap","Esri.NatGeoWorldMap","USGS.USImageryTopo")

mapviewOptions(basemaps = basemap_list,
               raster.palette = grey.colors,
               vector.palette = colorRampPalette(c("snow", "cornflowerblue", "grey10")),
               na.color = "magenta",
               layers.control.pos = "topright")                           

dat <- structure(list(SampleDate = structure(c(18977, 18978, 18978, 
18978, 18978, 18978), class = "Date"), Survey = c("USFWS EDSM", 
"USFWS EDSM", "USFWS EDSM", "USFWS EDSM", "USFWS EDSM", "USFWS EDSM"
), LifeStage = c("Adult", "Adult", "Adult", "Adult", "Adult", 
"Adult"), lat = c(38.11429, 38.15312, 38.15312, 38.14925, 38.14925, 
38.14133), lon = c(-121.6875, -121.68261, -121.68261, -121.68401, 
-121.68401, -121.69331), ReleaseEvent = c("BY2021 1", "BY2021 1", 
"BY2021 1", "BY2021 1", "BY2021 1", "BY2021 1"), ReleaseMethod = c("Unknown", 
"Unknown", "Unknown", "Unknown", "Unknown", "Unknown"), Origin = c("hatchery", 
"wild", "wildAdult", "hatchery", "hatchery", "hatchery"), numb_fish = c(1, 
1, 1, 1, 1, 1), year = c(2021, 2021, 2021, 2021, 2021, 2021), 
    month = structure(c(18962, 18962, 18962, 18962, 18962, 18962
    ), class = "Date"), geometry = structure(list(structure(c(-121.6875, 
    38.11429), class = c("XY", "POINT", "sfg")), structure(c(-121.68261, 
    38.15312), class = c("XY", "POINT", "sfg")), structure(c(-121.68261, 
    38.15312), class = c("XY", "POINT", "sfg")), structure(c(-121.68401, 
    38.14925), class = c("XY", "POINT", "sfg")), structure(c(-121.68401, 
    38.14925), class = c("XY", "POINT", "sfg")), structure(c(-121.69331, 
    38.14133), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT", 
    "sfc"), precision = 0, bbox = structure(c(xmin = -121.69331, 
    ymin = 38.11429, xmax = -121.68261, ymax = 38.15312), class = "bbox"), crs = structure(list(
        input = "EPSG:4326", wkt = "GEOGCRS[\"WGS 84\",\n    ENSEMBLE[\"World Geodetic System 1984 ensemble\",\n        
        MEMBER[\"World Geodetic System 1984 (Transit)\"],\n        MEMBER[\"World Geodetic System 1984 (G730)\"],\n       
        MEMBER[\"World Geodetic System 1984 (G873)\"],\n        MEMBER[\"World Geodetic System 1984 (G1150)\"],\n        
        MEMBER[\"World Geodetic System 1984 (G1674)\"],\n        MEMBER[\"World Geodetic System 1984 (G1762)\"],\n        
        MEMBER[\"World Geodetic System 1984 (G2139)\"],\n        ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n            
        LENGTHUNIT[\"metre\",1]],\n        ENSEMBLEACCURACY[2.0]],\n    PRIMEM[\"Greenwich\",0,\n        
        ANGLEUNIT[\"degree\",0.0174532925199433]],\n    CS[ellipsoidal,2],\n        
        AXIS[\"geodetic latitude (Lat)\",north,\n            ORDER[1],\n            
        ANGLEUNIT[\"degree\",0.0174532925199433]],\n        AXIS[\"geodetic longitude (Lon)\",east,\n            
        ORDER[2],\n            ANGLEUNIT[\"degree\",0.0174532925199433]],\n    USAGE[\n        
        SCOPE[\"Horizontal component of 3D system.\"],\n        AREA[\"World.\"],\n        
        BBOX[-90,-180,90,180]],\n    ID[\"EPSG\",4326]]"), class = "crs"), n_empty = 0L)), row.names = c(NA, 
-6L), sf_column = "geometry", agr = structure(c(SampleDate = NA_integer_, 
Survey = NA_integer_, LifeStage = NA_integer_, lat = NA_integer_, 
lon = NA_integer_, ReleaseEvent = NA_integer_, ReleaseMethod = NA_integer_, 
Origin = NA_integer_, numb_fish = NA_integer_, year = NA_integer_, 
month = NA_integer_), levels = c("constant", "aggregate", "identity"
), class = "factor"), class = c("sf", "tbl_df", "tbl", "data.frame"
))

ui <- fluidPage(
  titlePanel("Download Leaflet/Mapview"),
  sidebarLayout(
    sidebarPanel(
      downloadButton("Download_map", "Download Map"),
      radioButtons(inputId = "format", label = "Map format:", choices = list("png", "pdf"))
    ),
    mainPanel(
      leafletOutput("map")
    )
  )
)

server <- function(input, output, session) {
  session$onSessionEnded(function() {
    stopApp()
  })
  
  # 存储当前选中的底图ID
  current_basemap <- reactiveVal(basemap_list[1])
  
  # 存储主面板的地图对象（带样式配置）
  main_map <- reactive({
    mapview(dat, zcol = "LifeStage", layer.name = "LifeStage", alpha = 0.2, cex = 4)@map %>%
      # 添加底图切换监听事件
      onRender("
        function(el, x) {
          this.on('baselayerchange', function(e) {
            Shiny.setInputValue('current_basemap', e.name);
          });
        }
      ")
  })
  
  output$map <- renderLeaflet({
    main_map()
  })
  
  # 创建保存用的地图：复用主面板的地图配置，调整视图+底图
  create_current_map <- function() {
    bounds <- input$map_bounds
    zoom <- input$map_zoom
    center <- input$map_center
    
    if (is.null(bounds) || is.null(zoom) || is.null(center)) {
      lng <- -121.94192
      lat <- 38.06202
      zoom_level <- 10
    } else {
      lng <- center$lng
      lat <- center$lat
      zoom_level <- zoom
    }
    
    # 更新当前底图
    if (!is.null(input$current_basemap)) {
      current_basemap(input$current_basemap)
    }
    
    # 基于主面板的地图，替换底图并调整视图
    main_map() %>%
      # 清除原有底图
      clearTiles() %>%
      # 添加当前选中的底图
      addProviderTiles(current_basemap()) %>%
      setView(lng = lng, lat = lat, zoom = zoom_level)
  }
  
  output$Download_map <- downloadHandler(
    filename = function() {
      paste("myMAP", input$format, sep = ".")
    },
    content = function(file) {
      mapview::mapshot(create_current_map(), file = file)
    }
  )
  
}
# Run the application 
shinyApp(ui = ui, server = server)

关键改动说明 #

1. 数据点保存问题：
   • 用reactive变量main_map存储主面板带样式的地图对象，保存时直接复用，避免重新创建无样式的基础版地图。
2. 底图同步问题：
   • 新增current_basemap存储当前选中的底图ID；
   • 通过onRender给Leaflet地图添加baselayerchange事件监听，将前端切换的底图名称同步到后端；
   • 在create_current_map()中，先清除原有底图，再添加当前选中的底图，确保保存的地图与主面板显示一致。

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