如何在R Leaflet中实现悬停触发的独立信息展示面板？

要实现类似JS Leaflet示例的悬停信息面板，核心是监听Leaflet的鼠标悬停事件，动态筛选并展示对应区域的数据。以下是针对你现有代码的修改方案：

关键修改点 #

• 给多边形图层添加唯一标识，用于识别悬停的区域
• 监听鼠标悬停事件，获取当前悬停的区域ID
• 根据ID动态筛选数据，在面板中显示单条区域信息

修改后的完整代码 #

ui <- fillPage(tags$head(includeCSS("./shiny/www/styles.css")),
               title = "National Parks I've Visited",
               bootstrap = TRUE,
               leafletOutput("map", width = "100%", height = "100%"),
               absolutePanel(id = "info-panel",
                             class = "panel panel-default",
                             bottom = 75, 
                             left = 55, 
                             width = 250, 
                             fixed = TRUE, 
                             draggable = TRUE, 
                             height = "auto",
                             p(id = "info", class="info-title", "National Park Data"),
                             textOutput("demo_text", container = tags$h3)))

server <- function(input, output) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addPolygons(data = usa_base,
                  smoothFactor = 0.2,
                  fillColor = "#808080",
                  stroke = TRUE,
                  weight = 0.5,
                  opacity = 0.5,
                  color = "#808080",
                  highlightOptions = highlightOptions(
                    weight = 0.5,
                    color = "#000000",
                    fillOpacity = 0.7,
                    bringToFront = FALSE),
                  group = "Base Map") %>%  
      addPolygons(data = nps,
                  smoothFactor = 0.2,                 
                  fillColor =  ~nps_color(type),
                  fillOpacity = 1,
                  stroke = TRUE,
                  weight = 0.2,     
                  opacity = 0.5,                       
                  color = "#354f52",              
                  highlight = highlightOptions(
                    weight = 3,
                    color = "#fff",
                    fillOpacity = 0.8,
                    bringToFront = TRUE),
                  # 新增：给每个公园多边形绑定唯一ID（用公园名称作为标识）
                  layerId = ~PARKNAME,
                  group = "National Parks")  %>%
      addLayersControl(
        baseGroups = "Base Map",
        overlayGroups = "National Parks",
        options = layersControlOptions(collapsed = FALSE))  %>% 
      addLegend(pal = nps_color,
                values = nps$type,
                position = "bottomright",
                title = "National Land by Type")
  })
  
  # 响应鼠标悬停事件，获取当前悬停的公园
  current_park <- reactive({
    req(input$map_shape_mouseover)
    # 根据悬停的layerId筛选对应公园数据
    nps[nps$PARKNAME == input$map_shape_mouseover$id, ]
  })
  
  output$demo_text <- renderText ({
    # 判断是否有悬停的公园，无悬停时显示默认提示
    if (is.null(input$map_shape_mouseover)) {
      "鼠标悬停在公园区域查看详情"
    } else {
      park <- current_park()
      sprintf("%s 是一处%s。我%s去过这里。", park$PARKNAME, park$type, park$visited)
    }
  })
}

代码说明 #

• layerId = ~PARKNAME：为每个公园多边形绑定唯一标识，Shiny会通过这个ID识别当前悬停的区域
• input$map_shape_mouseover：Leaflet在Shiny中自动生成的悬停事件输入，包含当前悬停图层的id（即我们设置的PARKNAME）
• current_park响应式表达式：实时根据悬停ID筛选对应公园的数据，确保数据随悬停动作动态更新
• 悬停状态判断：当鼠标未悬停在任何公园区域时，显示友好提示文本，避免出现空值错误

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