Show layer in leaflet map in Shiny only when zoom level > 8 with LayersControl?

Question

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)

as per [my comment to this question](http://stackoverflow.com/q/41468538/5977215), I've not come across a method for reacting to 'layerControl' clicks. — SymbolixAU, Jan 15 '17 at 23:53

Tonio Liebrand · Accepted Answer · 2017-01-16T09:49:38.683

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)

very nice answer. Would be helpful if you added an explanation about what it's doing too. — SymbolixAU, Jan 16 '17 at 04:08
Nice solution! It works for the minimal example. But I couldn't bring it to work in a more complex app with other named input (e.g. checkboxInputs etc). What changes need to be done then? Does it matter, where I put the tags$head part in the UI? — needRhelp, Jan 16 '17 at 19:13
Hi @needRhelp. In the code above add after: "var inputs = document.getElementsByTagName("input");" a line of code "console.log(inputs)". Then run the app in the browser and check the log (F12 - Console JS) and find which index your "marker-input" has and take this index for the next line of code: "Shiny.onInputChange("marker", inputs[0].checked);" where you substitute 0 with the nex index. Hope that helps. — Tonio Liebrand, Jan 17 '17 at 08:53
Hi @TonioLiebrand. Works fine. I have one additional question: When the app starts, the marker is per default checked in the layerscontrol. Is there a simple way to change that, so that an entry is not checked in the layerscontrol on app start? — needRhelp, Jan 18 '17 at 20:29
@needRhelp, use `hideGroup` in your leaflet code. So it should look something like this: `addLayersControl(overlayGroups = ("marker")) %>% hideGroup("marker")` — Lauren, Jan 19 '17 at 15:04

Show layer in leaflet map in Shiny only when zoom level > 8 with LayersControl?

1 Answers1

Linked