I want to show a layer only when its clicked in the LayersControl and the zoom level is greater than a certain number, e.g. 8. One of the reasons is, that some expensive computations must be performed to get the layer coordinates. I want to use the layerscontrol and not an extra input button (for optical reasons).
Is there a way to retrieve the value, if the layer button is clicked in the layerscontrol?
Here is a simple example (not working):
library(leaflet)
library(shiny)
ui <- fluidPage(
leafletOutput("map", width = "100%", height = "700")
)
server <- function(input, output){
output$map <- renderLeaflet({
leaflet() %>% addTiles() %>% setView(10.4, 50.3, 7) %>%
addLayersControl(overlayGroups = c("marker"),
options = layersControlOptions(collapsed = FALSE))
})
observe({
# if (input$marker == TRUE){ # how to get value if layercontrol is clicked?
if (input$map_zoom > 8) {
leafletProxy("map") %>% addMarkers(lng = 10.5, lat = 50, group = "marker")
}
# }
})
}
shinyApp(ui = ui, server = server)
Here is a first running version. Maybe smdy comes up with sthg "cleaner" :).
Here a small explanation:
Challenge 1: input$marker does not exist as shiny input.
Open your app (in a browser), make a right click on the marker input you are interested in and select "Inspect Element" or the equivilant label in your browser. You will see the code of that input.
So why cant you access it. To see the difference to the kind of input you know from shiny, create a textinput
or sthg and make "inspect element" as well. You see that the shiny-inputs have an id,....the marker input does not
Challenge 2: Access input that does not have an id:
(From here on you should know how to send messages from JS to R and back: A very good article you will find here: https://ryouready.wordpress.com/2013/11/20/sending-data-from-client-to-server-and-back-using-shiny/)
How to access the input: Well, thats basically just finding the right snippet via google. In the end this: document.getElementsByTagName("input")
.
(Attention: From here on I assume you only have one input)
And know it gets a bit tricky. Try to access
this input. Via console.log()
you can print to javascript console (and open it in the running app via "F12" --> Console (JS).)
You can print this input as HtMLCollection but can not access it, which can be very confusing.
Challenge 3: Access HTMLCollection
The reason (in short) why you can not access it is that the JS code is called before the "DOM" is build. It would work totally fine if the script is called after "<body></body>
". But thats not that easy with plain vanilla shiny. You can try window.onload()
or document.ready()
.
What is the most reliable for me so far is to use: session$onFlushed() and trigger to send the JSCode within that function from R to "JS".
(And then send the value as an input back to R via Shiny.onInputChange("marker", inputs[0].checked)
; ) --> This will produce the desired "input$marker".
However, this function only fires once, which is totally right behaviour. But you wont have updates when you click the button.
Challenge 4: Update input$marker
Well the pretty version would be to have a function .onclicked()
/ a listener for the input. Maybe somebody could find a solution. I tried a workaround in shiny, that i tell shiny to constantly get value of the input via autoInvalidate()
.
Challenge 5:
Well, not that difficult, because it is shiny only, but for sake of completeness. Given the provided code in the question, the marker will stay when loaded once. Not sure if you want it to stay or to be removed once your zooming criteria is not met.
Anyway, if you want it to disappear, %>% clearMarkers()
is your friend.
library(leaflet)
library(shiny)
getInputwithJS <- '
Shiny.addCustomMessageHandler("findInput",
function(message) {
var inputs = document.getElementsByTagName("input");
Shiny.onInputChange("marker", inputs[0].checked);
}
);
'
ui <- fluidPage(
leafletOutput("map", width = "100%", height = "700"),
tags$head(tags$script(HTML(getInputwithJS)))
)
server <- function(input, output, session){
global <- reactiveValues(DOMRdy = FALSE)
output$map <- renderLeaflet({
leaflet() %>% addTiles() %>% setView(10.4, 50.3, 7) %>%
addLayersControl(overlayGroups = c("marker"),
options = layersControlOptions(collapsed = FALSE))
})
autoInvalidate <- reactiveTimer(1)
observe({
autoInvalidate()
if(global$DOMRdy){
session$sendCustomMessage(type = "findInput", message = "")
}
})
session$onFlushed(function() {
global$DOMRdy <- TRUE
})
observe({
if (!is.null(input$marker)){
if (input$marker == TRUE){ # how to get value if layercontrol is clicked?
if (input$map_zoom > 8) {
leafletProxy("map") %>% addMarkers(lng = 10.5, lat = 50, group = "marker")
}else{
leafletProxy("map") %>% clearMarkers()
}
}
}
})
}
shinyApp(ui = ui, server = server)