如何在Shiny-Leaflet中实现鼠标悬停显示栅格值？

针对你遇到的Leaflet Shiny应用中栅格悬停显示值的问题，以下是两种可行的实现方案，均能兼容leafletProxy且避免性能问题：

方案一：使用leaflet.extras2包（推荐） #

leaflet.extras2是Leaflet官方扩展的补充包，其addImageQuery函数原生支持leafletProxy，可直接实现栅格悬停/点击显示值的功能，无需手动编写JS或转换大量空间数据。

完整代码 #

library(leaflet)
library(shiny)
library(dplyr)
library(sf)
library(raster)
library(leaflet.extras2)

ui <- fluidPage(
  fluidRow(
    leafletOutput("map", width = 700, height = 700)
  ),
  fluidRow(
    actionButton(inputId = "Action", label = "加载栅格")
  )
)

server <- function(input, output) {
  # 渲染基础地图
  output$map <- renderLeaflet({
    leaflet() %>%
      addProviderTiles("OpenStreetMap.France") %>%
      setView(lat = 46.7, lng = 2, zoom = 6)
  })

  # 点击按钮加载栅格并绑定悬停查询
  observeEvent(input$Action, {
    # 生成示例栅格（与原逻辑一致）
    pointSF <- st_sfc(st_point(c(2.5, 45.9)), crs = 4326)
    buffer <- st_buffer(pointSF, dist = 200000)
    
    grid <- st_make_grid(
      buffer,
      square = TRUE,
      cellsize = c(0.1,0.1),
      what = "centers"
    ) %>%
      st_as_sf() %>%
      cbind(., st_coordinates(.)) %>%
      st_drop_geometry() %>%
      mutate(Z = runif(nrow(.))) %>%
      rename(x = X, y = Y, z = Z)
    
    rast <- raster::rasterFromXYZ(grid, crs = 4326)
    
    # 通过leafletProxy更新地图
    leafletProxy("map") %>%
      addRasterImage(rast, layerId = "target_raster") %>%
      addImageQuery(
        layerId = "target_raster",
        type = "mousemove", # 悬停触发，可选"click"改为点击触发
        prefix = "栅格值: ",
        digits = 3, # 控制小数显示位数
        position = "topright"
      )
  })
}

shinyApp(ui, server)

关键说明 #

• 给栅格图层设置layerId，确保addImageQuery精准绑定目标图层，避免多图层冲突
• type参数可切换为click实现点击显示值，digits用于控制数值精度
• 该方案性能优异，无需处理大量空间转换，完全兼容leafletProxy

方案二：纯Shiny原生实现（无额外依赖） #

若不想引入新包，可利用Shiny的鼠标位置输入和栅格查询API，动态生成悬停弹窗：

完整代码 #

library(leaflet)
library(shiny)
library(dplyr)
library(sf)
library(raster)

ui <- fluidPage(
  fluidRow(
    leafletOutput("map", width = 700, height = 700)
  ),
  fluidRow(
    actionButton(inputId = "Action", label = "加载栅格")
  )
)

server <- function(input, output) {
  # 用reactiveVal存储栅格对象，供后续查询使用
  current_raster <- reactiveVal(NULL)
  
  # 渲染基础地图
  output$map <- renderLeaflet({
    leaflet() %>%
      addProviderTiles("OpenStreetMap.France") %>%
      setView(lat = 46.7, lng = 2, zoom = 6)
  })

  # 点击按钮加载栅格
  observeEvent(input$Action, {
    # 生成示例栅格（与原逻辑一致）
    pointSF <- st_sfc(st_point(c(2.5, 45.9)), crs = 4326)
    buffer <- st_buffer(pointSF, dist = 200000)
    
    grid <- st_make_grid(
      buffer,
      square = TRUE,
      cellsize = c(0.1,0.1),
      what = "centers"
    ) %>%
      st_as_sf() %>%
      cbind(., st_coordinates(.)) %>%
      st_drop_geometry() %>%
      mutate(Z = runif(nrow(.))) %>%
      rename(x = X, y = Y, z = Z)
    
    rast <- raster::rasterFromXYZ(grid, crs = 4326)
    
    current_raster(rast)
    
    # 更新地图添加栅格
    leafletProxy("map") %>%
      addRasterImage(rast, layerId = "target_raster")
  })

  # 鼠标悬停时动态查询并显示栅格值
  observeEvent(input$map_mousemove, {
    req(current_raster()) # 确保栅格已加载
    
    mouse_coords <- input$map_mousemove
    # 查询当前鼠标坐标对应的栅格值
    raster_val <- raster::extract(current_raster(), matrix(c(mouse_coords$lng, mouse_coords$lat), ncol = 2))
    
    if (!is.na(raster_val)) {
      # 显示弹窗
      leafletProxy("map") %>%
        clearPopups() %>%
        addPopups(
          lng = mouse_coords$lng,
          lat = mouse_coords$lat,
          popup = paste0("栅格值: ", round(raster_val, 3)),
          options = popupOptions(closeButton = FALSE)
        )
    } else {
      # 离开栅格区域时清除弹窗
      leafletProxy("map") %>%
        clearPopups()
    }
  })
}

shinyApp(ui, server)

关键说明 #

• 用reactiveVal存储栅格对象，避免重复生成
• 通过input$map_mousemove获取实时鼠标坐标，调用raster::extract查询值
• 动态添加/清除弹窗，实现悬停显示效果，完全基于Shiny和Leaflet原生API

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