如何在Shiny应用的Leaflet地图中使用clusterOptions实现标记聚类

核心问题原因 #

1. 初始化地图时开启了preferCanvas = TRUE，而Leaflet的marker聚类插件依赖SVG渲染，二者存在兼容冲突
2. 每次筛选条件变化重新渲染标记时，没有清除上一次的旧标记和聚类图层，新老图层叠加导致聚类逻辑失效
3. 自定义聚类图标缺少宽高配置，默认样式会导致聚类计数显示异常
4. 重复调用addTiles()加载底图，干扰图层渲染顺序

修改后完整可运行代码 #

library(leaflet)
library(shiny)
# 默认开启聚类版本
simple <- FALSE 

col_feed_con_raw_01_coords <- data.frame(
  lng = rep(sample(seq(from=-101, to=-99,by=.4), 100, replace = T),3),
  lat = rep(sample(seq(from=39, to=41,  by=.4), 100, replace=T),3),
  service_type = sample(LETTERS[1:4], 300, replace = T)
)
ser_types <- sort(unique(col_feed_con_raw_01_coords$service_type))
colorList4  <- c('forestgreen', '#ee0000', 'orange', 'cornflowerblue')

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
    checkboxGroupInput("service_type", "Choose service:",
      choiceNames  = ser_types,
      choiceValues = 1:4,
      selected = 1:4
    ),
    checkboxInput("allnone", "All/None", value=TRUE)
  )
)
server <- function(input, output, session) {
  print(paste0("Running in: ",
    isolate(session$clientData$url_hostname),":",
    isolate(session$clientData$url_port))
  )
  observeEvent(input$allnone,{
    if(input$allnone){
      updateCheckboxGroupInput(session,"service_type",selected = 1:4)
    } else {
      updateCheckboxGroupInput(session,"service_type",
        choiceNames=ser_types,
        choiceValues = 1:4,
        selected = NULL)
    }
  })
  filteredColors <- reactive({
    colorList4[as.numeric(input$service_type) ]
  })
  filteredService <- reactive({
    ser_types[as.numeric(input$service_type) ]
  })
  filteredData <- reactive({
    col_feed_con_raw_01_coords[col_feed_con_raw_01_coords$service_type %in% filteredService(), ]
  })
  mycolors <- reactive({
    colorFactor(palette = filteredColors(), filteredService())
  })
  output$map <- renderLeaflet({
    # 关闭preferCanvas，适配聚类插件的SVG渲染
    leaflet(options = leafletOptions(preferCanvas = FALSE))  %>%
      addTiles(options = providerTileOptions(
        updateWhenZooming = FALSE,
        updateWhenIdle = FALSE)
      ) %>% 
      setView(lng = -100, lat = 40, zoom = 9)
  })
  observe({
    if(length(input$service_type) > 0 ) {
      pal <- mycolors()
      if(simple){
        leafletProxy("map",data = filteredData()) %>% 
          # 先清除旧图层
          clearMarkers() %>% 
          clearMarkerClusters() %>% 
          addCircleMarkers(~lng, ~lat,
            radius = 10,
            fillColor = ~pal(service_type),
            stroke = FALSE,
            fillOpacity = 0.7
          )
      }
      if(!simple){
        leafletProxy("map",data = filteredData())  %>% 
          # 先清除旧图层
          clearMarkers() %>% 
          clearMarkerClusters() %>% 
          addCircleMarkers(~lng, ~lat,
            clusterOptions = markerClusterOptions(
              iconCreateFunction=JS("function (cluster) {
                var childCount = cluster.getChildCount();
                if (childCount < 100) {
                  c = 'rgba(255, 150, 150, 0.5);'
                } else if (childCount < 500) {
                  c = 'rgba(255, 100, 100, 0.5);'
                } else {
                  c = 'rgba(255, 50, 50, 0.5);'
                }
                return new L.DivIcon({ 
                  html: '<div style=\"background-color:'+c+'\"><span>' + childCount + '</span></div>',
                  className: 'marker-cluster',
                  // 补充图标大小配置
                  iconSize: new L.Point(40, 40)
                });
              }"),
              spiderfyOnMaxZoom = TRUE
            ),
            fillColor   = ~pal(service_type),
            stroke      = FALSE,
            fillOpacity = 0.7
          )
      }
    } else {
      # 没有选中服务类型时清空所有图层
      leafletProxy("map") %>% 
        clearMarkers() %>% 
        clearMarkerClusters() %>% 
        clearControls()
    }
  })
  observe({
    proxy <- leafletProxy("map")
    proxy %>% clearControls()
    if(length(input$service_type)>0){
      pal <- mycolors()
      proxy %>% addLegend('bottomright',
        pal = pal,
        values = filteredService(),
        title = 'Services:',
        opacity = 1
      )
    }
  })
}
shinyApp(ui, server)

关键修改说明 #

• 初始化地图时关闭preferCanvas参数，匹配marker聚类插件的SVG渲染要求
• 每次更新标记前调用clearMarkers()、clearMarkerClusters()清除旧图层，避免图层叠加冲突
• 移除proxy中重复的addTiles()调用，避免底图重复加载干扰渲染
• 给自定义聚类DivIcon补充iconSize配置，确保聚类计数显示正常
• 补充了无筛选选项时的图层清空逻辑，避免残留旧数据
• 优化了图例渲染逻辑，避免无筛选选项时出现报错

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