Reputation: 107
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:
let map = L.map('map_habitats');
cannot be used as it raises an Uncaught Error: Map container is already initialized
let map = $('#map_habitats');
seems to allow me to access to the map, however I cannot apply functions on it just after. Then, how to access properly map
?// FAKE CLICK FIRST METHOD
and // FAKE CLICK SECOND METHOD
) both raise respectively Uncaught TypeError: map.latLngToLayerPoint is not a function
and Uncaught TypeError: map.eachLayer is not a function
. Then what can I do on map to simulate a click? This means that at the moment, I cannot try any of the solutions there : Leaflet: How can I simulate a mouse click? fireevent('click') does not trigger the popup ; Emulate click on leaflet map item . I also tried unsuccessfully to work with hmtlwidgets::onRender
Manipulate existing Leaflet map in a shiny app with javascript using shinyjsWhat 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)
Upvotes: 1
Views: 394
Reputation: 20329
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)
Upvotes: 2