如何在Leaflet中用六边形展示平均丰度而非计数？

需求：在Leaflet中以六边形形式展示abun字段的平均丰度；现有leaflet.extras2的addHexbin仅能统计六边形内的记录数，Leaflethex虽支持自定义字段计算但与Shiny集成存在侧边栏消失、无法配合leafletProxy等问题。

核心思路是在R后端先完成六边形分箱的统计计算（而非依赖前端插件的自动计数），得到每个六边形的中心坐标、丰度总和/均值，再用Leaflet绘制多边形，完美适配Shiny环境。

步骤1：准备工具包 #

加载用于分箱计算的hexbin包，以及Leaflet相关工具：

library(leaflet)
library(leaflet.extras2)
library(hexbin)
library(sp)

步骤2：后端计算六边形分箱统计量 #

用hexbin函数对经纬度分箱，同时计算每个分箱的abun总和、均值：

# 生成模拟数据
n <- 100000
df <- data.frame(lat = rnorm(n, 42.0285, .01),
                 lng = rnorm(n, -93.65, .01),
                 abun = rnorm(n, 20000, 1000))

# 执行六边形分箱（xbins参数控制分箱密度，值越大分箱越细）
hb <- hexbin(df$lng, df$lat, xbins = 30)

# 计算每个分箱的丰度总和、均值
hb$abun_sum <- tapply(df$abun, hb$cID, sum)
hb$abun_mean <- tapply(df$abun, hb$cID, mean)

# 将hexbin对象转换为Leaflet可识别的空间多边形
hex_polys <- hexPolygons(hb, IDs = hb$cID)
# 绑定统计字段到多边形属性
hex_polys@data <- cbind(hex_polys@data, 
                        abun_sum = hb$abun_sum,
                        abun_mean = hb$abun_mean)

步骤3：用Leaflet绘制六边形分箱图 #

使用addPolygons绘制计算好的六边形，自定义颜色映射（以均值为例）：

# 定义颜色映射规则
pal <- colorNumeric(c("purple","blue","green", "yellow"), 
                    domain = hex_polys@data$abun_mean)

leaflet(hex_polys) %>%
  addTiles() %>%
  addPolygons(
    fillColor = ~pal(abun_mean),
    color = "#333333", # 六边形边框颜色
    weight = 0.5,
    fillOpacity = 0.7,
    # 弹窗显示详细统计信息
    popup = ~paste0("平均丰度: ", round(abun_mean, 2), "<br>",
                    "总丰度: ", round(abun_sum, 2), "<br>",
                    "记录数: ", count)
  ) %>%
  addLegend(pal = pal, values = ~abun_mean, 
            title = "平均丰度", position = "bottomright")

Shiny适配说明 #

在Shiny中使用时，只需将计算好的hex_polys传入renderLeaflet，配合leafletProxy更新时，重新计算分箱数据再替换图层即可，不会出现集成异常：

# Shiny示例简化版
server <- function(input, output, session) {
  output$map <- renderLeaflet({
    # 可根据输入参数动态调整分箱规则或数据源
    leaflet(hex_polys) %>% addTiles() %>% addPolygons(fillColor = ~pal(abun_mean), ...)
  })
  
  # 动态更新逻辑
  observeEvent(input$update_btn, {
    # 重新计算分箱数据
    new_hb <- hexbin(updated_df$lng, updated_df$lat, xbins = input$xbins)
    new_hb$abun_mean <- tapply(updated_df$abun, new_hb$cID, mean)
    new_hex_polys <- hexPolygons(new_hb, IDs = new_hb$cID)
    new_hex_polys@data$abun_mean <- new_hb$abun_mean
    
    leafletProxy("map", session) %>%
      clearShapes() %>%
      addPolygons(data = new_hex_polys, fillColor = ~pal(abun_mean), ...)
  })
}

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