Skip to content
Advertisement

R Shiny 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)

Advertisement

Answer

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

User contributions licensed under: CC BY-SA
8 People found this is helpful
Advertisement