Search code examples
javascriptrshinyr-leaflet

How to query a Web Map Service layer with a fake click?


I'm trying to display the information tooltip of a queryable WMS (Web Map Service) layer in a leaflet in Shiny. I need it to be performed in 2 different ways: 1/ clicking 2/ typing in coordinates.

With the MWE (R code) at the end of this post, a click anywhere on the WMS displays the tooltip , which is part of what I want (1/). I also need the user to have the possibility to type in their coordinates (I try with "-2.55,54"), and get that same tooltip when hitting the "Go!" button (2/), without having to actually click anywhere, and I have been unable to perform this. My strategy is to fake a click when the "Go!" button is hit, by indicating what should be clicked and where (Shiny.addCustomMessageHandler('fake_a_click', function(coords){ ... has to access the leaflet map, and click where indicated in argument coords on that leaflet map). I have tried several ways of doing that:

What am I doing wrong? How can I fake a click on the leaflet map so that the WMS tooltip shows?

library(magrittr)
library(shiny)

ui <- fluidPage(

    # Some .js
    tags$head(
       # Listen for messages
       tags$script("
              Shiny.addCustomMessageHandler('fake_a_click', function(coords){
                  let coords_split = coords.split(\",\");

                  //Get back lon and lat from the String
                  let lng = parseFloat(coords_split[0]);
                  let lat = parseFloat(coords_split[1]);

                  let map = $('#map_habitats');
                  //let map = L.map('map_habitats'); // Uncaught Error: Map container is already initialized.

                  // FAKE CLICK FIRST METHOD Uncaught TypeError: map.latLngToLayerPoint is not a function
                      map.fireEvent('click', {
                        latlng: L.latLng(lat, lng),
                        layerPoint: map.latLngToLayerPoint(L.latLng(lat, lng)),
                        containerPoint: map.latLngToContainerPoint(L.latLng(lat, lng))
                      });

                  // FAKE CLICK SECOND METHOD Uncaught TypeError: map.eachLayer is not a function
                      map.eachLayer( function(layer) {
                        layer.fireEvent('click', {
                            latlng: L.latLng(lat, lng),
                            layerPoint: layer.latLngToLayerPoint(L.latLng(lat, lng)),
                            containerPoint: layer.latLngToContainerPoint(L.latLng(lat, lng))
                      })
                  });

              });

            ")
        ),

        # Application title
        textInput("map_coords", "Coordinates (Lng, Lat)", placeholder = "Type in your coordinates here ...", width = "100%"),

        #validate button
        actionButton("map_validate", label = "Go!"),

        # Leaflet
        leaflet::leafletOutput("map_habitats")
)

# Define server logic required to draw a histogram
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()
    rv_habitat$coords <- list()

    output$map_habitats <- leaflet::renderLeaflet ({
        leaflet::leaflet() %>%
            leaflet::addProviderTiles("Esri.WorldImagery", group="Esri.WorldImagery", options = leaflet::providerTileOptions(zIndex=0)) %>%
            leaflet::setView( lng = -2.55,lat = 54, zoom=6) %>%
            leaflet.extras2::addWMS(
                wms_layer,
                layers = "LC.10m.GB", # Or "LC.10m.NI" for northern Ireland
                options = leaflet::WMSTileOptions(
                    format = "image/png",
                    version = "1.3.0",
                    transparent = T,
                    opacity = 0.5,# Add some transparency so that we can still see the satellite image
                    info_format = "application/vnd.ogc.gml"
                ),
                popupOptions = leaflet::popupOptions(maxWidth = 300, closeOnClick = T))
    })

    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()
                rv_habitat$coords$lng <- as.numeric(value2check[1])
                rv_habitat$coords$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")
            }
        }
    })
}

# Run the application
shinyApp(ui = ui, server = server)


Solution

  • The problem is that you cannot easily access the map object once it is rendered. You have to store it separately, which is difficult, b/c the object is created for you by leaflet.

    Good news though is that you can register an init hook, which is called whenever a new map is created. In this hook you can simply store the map object for later use. The solution is taken from this answer here: Find Leaflet map object after initialisation

    Once you have a proper map object, you can use the code you provided (maybe openPopup would work as well, but I am not at all familiär with the layers provided via addWMS, so I used your original code).

    library(magrittr)
    library(leaflet)
    library(leaflet.extras2)
    library(shiny)
    library(stringr)
    
    js <- HTML("
    // make sure we keep a reference to the map as part of mapsPlaceholder
    var mapsPlaceholder = [];
    
    $(function() {
       // Before map is being initialized.
       L.Map.addInitHook(function () {
         mapsPlaceholder.push(this); // Use whatever global scope variable you like.
       });
    })
    
    Shiny.addCustomMessageHandler('fake_a_click', function(coords) {
       let map = mapsPlaceholder[0];
       map.fireEvent('click', {
          latlng: L.latLng(coords.lat, coords.lng),
          layerPoint: map.latLngToLayerPoint(L.latLng(coords.lat, coords.lng)),
          containerPoint: map.latLngToContainerPoint(L.latLng(coords.lat, coords.lng))
       });
    })
    ")
    
    ui <- fluidPage(
       tags$head(tags$script(js)),
       textInput("map_coords", "Coordinates (Lng, Lat)", 
                 placeholder = "Type in your coordinates here ...", width = "100%"),
       actionButton("map_validate", label = "Go!"),
       leafletOutput("map_habitats")
    )
    
    # Define server logic required to draw a histogram
    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(lng = NULL, lat = NULL))
       
       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", # Or "LC.10m.NI" for northern Ireland
                options = WMSTileOptions(
                   format = "image/png",
                   version = "1.3.0",
                   transparent = TRUE,
                   opacity = 0.5,# Add some transparency so that we can still see the satellite image
                   info_format = "application/vnd.ogc.gml"
                ),
                popupOptions = popupOptions(maxWidth = 300, closeOnClick = T))
       })
       
       observeEvent(input$map_validate, ignoreInit  = TRUE, 
                    label = "Submit map coordinates", {
                       value2check <- str_split(input$map_coords, ",")[[1]] %>% 
                          as.numeric()
                       if (length(value2check) != 2){
                          updateTextInput(session, inputId = "map_coords", 
                                          value = "", 
                                          placeholder = "Type in 2 numeric values separated by a comma")
                       } else {
                          value2check <- value2check %>% 
                             set_names(c("lng", "lat")) 
                          if (!any(is.na(value2check))){
                             rv_habitat$coords <- as.list(value2check) 
                             session$sendCustomMessage("fake_a_click", as.list(value2check))
                          } else {
                             updateTextInput(session, inputId = "map_coords", value = "", 
                                             placeholder = "Type in 2 numeric values separated by a comma")
                          }
                       }
                    })
    }
    
    # Run the application
    shinyApp(ui = ui, server = server)
    

    Popup opens pers script rather than click