R语言Leaflet实现点击多边形高亮（替代悬停效果）

完整Shiny应用代码 #

library(shiny)
library(rnaturalearth)
library(rnaturalearthdata)
library(leaflet)
library(tidyverse)
library(sf)

# 数据准备
world <- ne_countries(scale = "medium", returnclass = "sf")
africa <- world %>% filter(continent == "Africa")
bbox <- st_bbox(africa$geometry) %>% as.vector()

ui <- fluidPage(
  leafletOutput("map")
)

server <- function(input, output, session) {
  # 存储当前选中的国家ID
  selected_country <- reactiveVal(NULL)
  
  output$map <- renderLeaflet({
    leaflet(data = africa) %>%
      setView(lng = (bbox[1] + bbox[3])/2, lat = (bbox[2] + bbox[4])/2, zoom = 3) %>% 
      addPolygons(
        fillColor = "#D3D3D3",
        color = "black",
        weight = 1,
        opacity = 1.0,
        fillOpacity = 1.0,
        layerId = ~geounit,
        label = ~geounit,
        labelOptions = labelOptions(
          style = list("font-weight" = "normal",
                       padding = "3px 8px",
                       textsize = "15px",
                       direction = "auto" )
        ),
        # 点击时更新选中的国家ID
        onClick = ~selected_country(geounit)
      ) %>%
      fitBounds(bbox[1], bbox[2], bbox[3], bbox[4]) %>%
      setMaxBounds(bbox[1], bbox[2], bbox[3], bbox[4])
  })
  
  # 根据选中状态更新地图样式
  observeEvent(selected_country(), {
    proxy <- leafletProxy("map", data = africa)
    
    # 所有多边形恢复初始样式
    proxy %>% setStyle(
      style = list(fillColor = "#D3D3D3", weight = 1)
    )
    
    # 高亮当前选中的多边形
    if (!is.null(selected_country())) {
      proxy %>% setStyle(
        layerId = selected_country(),
        style = list(fillColor = "yellow", weight = 2, bringToFront = TRUE)
      )
    }
  })
}

shinyApp(ui, server)

关键实现逻辑 #

• 跟踪选中状态：用reactiveVal创建变量记录当前点击的多边形ID，每次点击时更新这个值。
• 批量重置样式：每次选中新多边形时，先通过setStyle把所有多边形恢复为初始的灰色填充和细边框。
• 高亮选中项：针对当前选中的多边形，单独设置黄色填充、加粗边框，并将其置于图层最上方。
• 高效更新：使用leafletProxy仅修改样式，无需重绘整个地图，保证交互流畅。

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