Shiny应用中Leaflet多多边形合并导出Shapefile/GeoJson的问题

核心思路是用reactiveVal维护所有绘制完成的多边形sf对象列表，每次新增多边形时将其转换为sf格式并追加到列表中，最后通过dplyr::bind_rows合并所有多边形为单个sf对象，实现批量导出。

修改后的完整代码 #

library(sf)
library(dplyr)
library(shiny)
library(leaflet)
library(shinyalert)
library(leaflet.extras)

ui <- fluidPage(
  fluidRow(
    column(width = 2,
           br(),
           h4("Control Panel"),
           hr(),
           textInput(inputId = "name", label = "Feature/Polygon Name:"),
           hr(),
           radioButtons(inputId = "filetype", label = "Output Type:", choices = c("Shapefile","GEOJson"), selected = NULL),
           textInput(inputId = "filename", value = "", label = "Filename:"),
           actionButton("download","Download Shape")
           ),
    column(width = 10, leafletOutput("map", width = "98%", height = 1000))
  )
)

server <- function(input, output, session) {

  # 初始化响应式列表，存储所有绘制的多边形sf对象
  all_polygons <- reactiveVal(list())

  output$map <- renderLeaflet({
    leaflet() %>%
      setView(lng = -117.88111674347516, lat = 33.6953612425539, zoom = 12) %>%
      addProviderTiles(providers$Esri.WorldImagery, options = providerTileOptions(noWrap = TRUE)) %>%
      addDrawToolbar(
        polylineOptions = FALSE,
        circleOptions = FALSE,
        markerOptions = FALSE,
        rectangleOptions = FALSE,
        circleMarkerOptions = FALSE
      ) # 只保留多边形绘制工具
  })
  
  # 监听新绘制的多边形，转换为sf并追加到列表
  observeEvent(input$map_draw_new_feature, {
    req(input$map_draw_new_feature, input$name)
    
    # 提取多边形坐标并转换为sf对象
    polygon_coords <- input$map_draw_new_feature$geometry$coordinates[[1]]
    longitude <- lapply(polygon_coords, `[[`, 1)
    latitude <- lapply(polygon_coords, `[[`, 2)
    
    new_polygon <- st_as_sf(tibble(lon = longitude, lat = latitude),
                            coords = c("lon", "lat"),
                            crs = 4326) %>%
      summarise(geometry = st_combine(geometry)) %>%
      st_cast("POLYGON") %>%
      mutate(Name = input$name)
    
    # 追加到已有列表
    current_list <- all_polygons()
    current_list[[length(current_list) + 1]] <- new_polygon
    all_polygons(current_list)
  })
  
  # 合并所有多边形为单个sf对象
  combined_polygons <- reactive({
    req(length(all_polygons()) > 0)
    bind_rows(all_polygons())
  })
  
  observeEvent(input$download,{
    req(combined_polygons(), input$filename)
    
    output_path <- paste0("output\\", input$filename)
    if(input$filetype == "Shapefile"){
      st_write(combined_polygons(), paste0(output_path, ".shp"), delete_layer = TRUE)
    } else {
      st_write(combined_polygons(), paste0(output_path, ".geojson"), delete_layer = TRUE)
    }
    
    shinyalert(
      title = "文件已生成",
      text = "可返回地图继续操作",
      size = "s", 
      closeOnEsc = TRUE,
      closeOnClickOutside = FALSE,
      html = FALSE,
      type = "info",
      showConfirmButton = TRUE,
      showCancelButton = FALSE,
      confirmButtonText = "OK",
      confirmButtonCol = "#113A72",
      timer = 0,
      imageUrl = "",
      animation = TRUE
    )
  })
  
}

shinyApp(ui = ui, server = server)

关键修改点说明 #

• 维护多边形列表：用all_polygons <- reactiveVal(list())创建响应式列表，存储每个绘制完成的多边形sf对象，避免丢失历史绘制数据。
• 新增多边形处理：通过observeEvent监听input$map_draw_new_feature，将新绘制的多边形转换为带名称的sf对象后，追加到列表中。
• 合并多边形：用combined_polygons响应式对象，通过bind_rows合并列表中所有sf对象，确保导出时是单个包含多个多边形的图层（每行对应一个多边形）。
• 导出逻辑优化：移除原代码中重复的导出语句，使用合并后的combined_polygons()进行导出，同时添加req()确保必要输入存在时才执行导出。
• 绘制工具限制：在addDrawToolbar中关闭其他绘制工具，只保留多边形绘制，避免误操作。

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