在Leaflet中利用点击事件动态展示分组求和结果

问题 #

开发Shiny应用时，已实现点击多边形切换填充色功能，但数据表格仅显示初始的fill分组求和结果，无法实时反映用户点击后的颜色状态变化。

解决方案 #

核心是同步更新反应式数据中的填充色状态，让表格计算基于最新的颜色数据：

• 每次点击多边形时，不仅更新地图视觉效果，同时修改反应式对象rv$df中的fill字段，使其与当前显示的颜色一致
• 直接基于rv$df生成表格，无需额外维护冗余数据，避免数据不同步
• 合并两个点击事件逻辑，通过判断当前分组来决定颜色切换方向

修改后的完整代码 #

library(sf)
library(DT)
library(leaflet)
library(shiny)
library(tidyverse)

nc <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = T) %>% 
  st_transform(4326) %>% 
  select(NAME, geometry, id = CNTY_ID) %>% 
  mutate(x = rnorm(n = nrow(.), mean = 100, sd = 20),
         fill = sample(c("green", "red"), n(), replace = T),
         fill_2 = if_else(fill == "green", "red", "green"))

# 点击切换颜色的工具函数
change_color <- function(map, id_to_remove, data, colour, new_group){
  leafletProxy(map) %>%
    removeShape(id_to_remove) %>% 
    addPolygons(
      data = data,
      layerId = data$id,
      group = new_group,
      fillColor = colour, 
      color = "black", 
      weight = 1,
      fillOpacity = 1)
}

## UI部分
ui <- fluidPage(
  leafletOutput("map"),
  DT::dataTableOutput("table")
)

## Server部分
server <- function(input,output,session){
  
  # 仅维护一份核心反应式数据
  rv <- reactiveValues(df = nc)
  
  # 初始化地图视图
  output$map <- renderLeaflet({
    leaflet() %>% 
      setView(-79.99, 35.52, zoom = 7)
  })
  
  # 初始化绘制所有多边形
  observe({
    data <- rv$df
    leafletProxy("map") %>%
      addPolygons(
        data = data,
        weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill, 
        layerId = data$id, 
        group = "unclicked_poly") 
  })
  
  # 合并点击事件：同步处理地图视觉更新与数据状态修改
  observeEvent(input$map_shape_click, {
    clicked_id <- input$map_shape_click$id
    current_group <- input$map_shape_click$group
    data <- rv$df[rv$df$id == clicked_id, ]
    
    if(current_group == "unclicked_poly"){
      # 第一次点击：切换为fill_2，同步更新反应式数据
      rv$df$fill[rv$df$id == clicked_id] <- data$fill_2
      change_color(map = "map", 
                   id_to_remove = clicked_id, 
                   data = data, 
                   colour = ~fill_2, 
                   new_group = "clicked1_poly")
    } else if(current_group == "clicked1_poly"){
      # 再次点击：切换回原fill，同步更新反应式数据
      rv$df$fill[rv$df$id == clicked_id] <- if_else(data$fill_2 == "green", "red", "green")
      leafletProxy("map") %>%
        removeShape(clicked_id) %>% 
        addPolygons(
          data = data,
          weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill,
          layerId = data$id,
          group = "unclicked_poly")
    }
  })
  
  # 基于最新反应式数据生成动态表格
  output$table <- DT::renderDataTable({
    rv$df %>% 
      st_drop_geometry() %>%  # 移除几何列，避免表格加载报错
      group_by(fill) %>% 
      summarise(x = sum(x, na.rm = T))
  })
  
}

shinyApp(ui, server)

关键修改说明 #

1. 精简反应式数据：移除冗余的df.tab，仅维护rv$df一份核心数据，确保地图与表格数据源完全一致
2. 数据状态同步：每次点击时修改rv$df$fill的值，让反应式数据与地图显示的颜色状态保持同步
3. 表格生成优化：用st_drop_geometry()移除sf对象的几何列，避免DT表格加载时出现格式错误
4. 事件逻辑合并：将两个独立的点击事件合并为一个，通过当前分组判断切换方向，代码更简洁易维护

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