如何通过模拟点击在Shiny Leaflet中查询WMS图层信息

问题根源 #

你之前尝试获取地图实例的方式都存在错误：

• L.map('map_habitats')会尝试重新初始化地图容器，但该容器已被Shiny的Leaflet组件初始化，因此抛出"容器已初始化"的错误；
• $('#map_habitats')得到的是jQuery封装的DOM元素，并非Leaflet的Map实例，自然无法调用latLngToLayerPoint、eachLayer这类Leaflet专属方法。

正确解决方案 #

Shiny中的Leaflet实例由htmlwidgets管理，正确获取已初始化地图对象的方法是htmlwidgets.find("#map_habitats").getMap()。触发地图的click事件后，WMS图层的弹窗逻辑会自动响应，无需遍历所有图层。

另外注意：Leaflet 1.0+版本已弃用fireEvent，改用fire方法触发事件。

修正后的完整代码 #

library(magrittr)
library(shiny)
library(leaflet)
library(leaflet.extras2)

ui <- fluidPage(
    tags$head(
        tags$script("
            Shiny.addCustomMessageHandler('fake_a_click', function(coords){
                let coords_split = coords.split(',');
                let lng = parseFloat(coords_split[0]);
                let lat = parseFloat(coords_split[1]);
                
                // 正确获取已初始化的Leaflet地图实例
                let map = htmlwidgets.find('#map_habitats').getMap();
                
                // 构造点击事件所需参数
                let latlng = L.latLng(lat, lng);
                let layerPoint = map.latLngToLayerPoint(latlng);
                let containerPoint = map.latLngToContainerPoint(latlng);
                
                // 触发地图的click事件，WMS图层会自动响应并弹出提示框
                map.fire('click', {
                    latlng: latlng,
                    layerPoint: layerPoint,
                    containerPoint: containerPoint,
                    originalEvent: { preventDefault: () => {} } // 避免潜在的事件处理报错
                });
            });
        ")
    ),
    textInput("map_coords", "Coordinates (Lng, Lat)", placeholder = "Type in your coordinates here ...", width = "100%"),
    actionButton("map_validate", label = "Go!"),
    leafletOutput("map_habitats")
)

server <- function(input, output, session) {
    wms_layer <- "https://catalogue.ceh.ac.uk/maps/51bcb92a-dd88-4034-ba65-a9d432dd632a?request=getCapabilities&service=WMS&cache=false&"

    rv_habitat <- reactiveValues(coords = list())

    output$map_habitats <- renderLeaflet ({
        leaflet() %>%
            addProviderTiles("Esri.WorldImagery", group="Esri.WorldImagery", options = providerTileOptions(zIndex=0)) %>%
            setView(lng = -2.55, lat = 54, zoom=6) %>%
            addWMS(
                wms_layer,
                layers = "LC.10m.GB",
                options = WMSTileOptions(
                    format = "image/png",
                    version = "1.3.0",
                    transparent = TRUE,
                    opacity = 0.5,
                    info_format = "application/vnd.ogc.gml"
                ),
                popupOptions = popupOptions(maxWidth = 300, closeOnClick = TRUE)
            )
    })

    observeEvent(input$map_validate, ignoreInit = TRUE, label = "Submit map coordinates",{
        value2check <- stringr::str_split(input$map_coords, pattern=",")[[1]]
        if(length(value2check)!=2){
            updateTextInput(session, inputId = "map_coords", value = "", placeholder = "Type in 2 numeric values separated by a comma")
        }else{
            if((!is.na(as.numeric(value2check[1]))) & (!is.na(as.numeric(value2check[2])))){
                rv_habitat$coords <- list(
                    lng = as.numeric(value2check[1]),
                    lat = as.numeric(value2check[2])
                )
                coords_to_pass <- paste(rv_habitat$coords$lng, rv_habitat$coords$lat, sep = ",")
                session$sendCustomMessage("fake_a_click", coords_to_pass)
            }else{
                updateTextInput(session, inputId = "map_coords", value = "", placeholder = "Type in 2 numeric values separated by a comma")
            }
        }
    })
}

shinyApp(ui = ui, server = server)

额外说明 #

• 触发地图click事件后，WMS图层会自动执行GetFeatureInfo请求并弹出提示框，效果和手动点击地图完全一致；
• 添加originalEvent: { preventDefault: () => {} }是为了避免部分Leaflet插件处理事件时因找不到originalEvent而报错，属于健壮性优化。

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