How to display WMS legends based on layer groups in Leaflet for R?

Question

I'm trying to display WMS legends based on layer groups in Leaflet and Leaflet extras for R in Shiny. I am using input$map_groups as described here but it doesn't seem to work, any ideas on how to hide and toggle WMS legends?

Thanks,

Juan

library(shiny)
library(leaflet)
library(leaflet.extras)

# User Interface
ui <- bootstrapPage(
  tags$style(type="text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width="100%", height="100%")
)

##### Shiny function server side

  server = function(input, output, session) {

    output$map <- renderLeaflet({
        leaflet() %>% 
        addProviderTiles("CartoDB.DarkMatter", options = tileOptions(minZoom = 0))%>% 
        addTiles(urlTemplate ="http://dataportal-dev.aquacross.eu/geoserver/gwc/service/tms/1.0.0/general:g2015_simplified@EPSG:900913@png/{z}/{x}/{y}.png",
                options = tileOptions(noWrap = TRUE, tms = TRUE, opacity =0.9),group ="P1", layerId ="test")%>% 
        addTiles(urlTemplate ="http://dataportal-dev.aquacross.eu/geoserver/gwc/service/tms/1.0.0/general:country@EPSG:900913@png/{z}/{x}/{y}.png",
                  options = tileOptions(noWrap = TRUE, tms = TRUE, opacity =1),group ="P2", layerId ="test2")%>% 
      # addWMSLegend(position = "topright",uri='http://dataportal-dev.aquacross.eu/geoserver/wms?REQUEST=GetLegendGraphic&VERSION=1.0.0&FORMAT=image/png&WIDTH=50&HEIGHT=20&LAYER=g2015_simplified', layerId ="test")%>% 
      addLayersControl(
        baseGroups = c("P1", "P2"),
       options = layersControlOptions(collapsed =FALSE)
      )
      })

## This is an attempt to show WMS legend maps based in groups

      observeEvent(input$map_groups,{
        map <- leafletProxy("map") %>% clearControls()
        if (input$map_groups == 'P1')
        {
         map %>% addWMSLegend(position = "topright",uri='http://dataportal-dev.aquacross.eu/geoserver/wms?REQUEST=GetLegendGraphic&VERSION=1.0.0&FORMAT=image/png&WIDTH=20&HEIGHT=50&LAYER=g2015_simplified', layerId ="test")
         }
      else if (input$map_groups == 'P2')
        {
        map %>% addWMSLegend(position = "topright",uri='http://dataportal-dev.aquacross.eu/geoserver/wms?REQUEST=GetLegendGraphic&VERSION=1.0.0&FORMAT=image/png&WIDTH=20&HEIGHT=20&LAYER=topp:states', layerId ="test2")
        }
     })
 }

shinyApp(ui, server)

The idea is to hide and toggle WMS legends based on layer groups but I cannot find the way of doing it.. — arevaju, May 17 '17 at 09:07
I just edited the code, the idea is to display different WMS legends based on P1 and P2. — arevaju, May 17 '17 at 14:48

Samuel · Answer 1 · 2017-05-17T13:08:59.430

I played around with your code, and it seems that the addWMSLegend function does not work within an if statement. However, it works in the normal pipe idiom, but that is not what you want. The standard addLegend function works fine in an if statement as the following code shows. I have done some cleaning of your code as well.

library(shiny)
library(leaflet)
# devtools::install_github('bhaskarvk/leaflet.extras')
library(leaflet.extras)

link1 <- "http://dataportal-dev.aquacross.eu/geoserver/gwc/service/tms/1.0.0/general:g2015_simplified@EPSG:900913@png/{z}/{x}/{y}.png"
link2 <- "http://dataportal-dev.aquacross.eu/geoserver/gwc/service/tms/1.0.0/general:country@EPSG:900913@png/{z}/{x}/{y}.png"
link3 <- "http://dataportal-dev.aquacross.eu/geoserver/wms?REQUEST=GetLegendGraphic&VERSION=1.0.0&FORMAT=image/png&WIDTH=50&HEIGHT=20&LAYER=g2015_simplified"
link4 <- "http://dataportal-dev.aquacross.eu/geoserver/wms?REQUEST=GetLegendGraphic&VERSION=1.0.0&FORMAT=image/png&WIDTH=20&HEIGHT=50&LAYER=g2015_simplified"

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%")
)

server = function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>% 
      addProviderTiles("CartoDB.DarkMatter", options = tileOptions(minZoom = 0), group = "P0", layerId = "DM") %>%
      addTiles(urlTemplate = link1, options = tileOptions(noWrap = TRUE, tms = TRUE, opacity = 1), group = "P1", layerId = "test") %>%
      addTiles(urlTemplate = link2, options = tileOptions(noWrap = TRUE, tms = TRUE, opacity = 1), group = "P2", layerId = "test2") %>%
      addWMSLegend(uri = link3, position = "topleft", layerId = "legend") %>%
      addLayersControl(baseGroups = c("P0", "P1", "P2"), options = layersControlOptions(collapsed = FALSE))
  })

  observeEvent(input$map_groups, {
    map <- leafletProxy("map") %>% clearControls()
    if (input$map_groups == "P0") {
      map <- map %>% addLegend(
        layerId = "legend",
        title = "Legend",
        position = "topleft",
        values = c(1, 2),
        labels = c("Gray", "Black"),
        colors = c("gray", "black"))
    } else if (input$map_groups == "P1") {
      map <- map %>% addLegend(
        layerId  = "legend",
        title = "Legend",
        position = "topleft",
        values = c(1, 2),
        labels = c("Gray", "Lemonchiffon"),
        colors = c("gray", "lemonchiffon"))
      # map <- map %>% addWMSLegend(layerId = "legend", uri = link3, position = "topleft")
    } else if (input$map_groups == "P2") {
      map <- map %>% addLegend(
        layerId  = "legend", 
        title = "Legend", 
        position = "topleft", 
        values = c(1, 2), 
        labels = c("Gray", "Tan"), 
        colors = c("gray", "tan"))
    }
  })

}

shinyApp(ui, server)

Thanks! This works fine but the problem is that in this case I have basically to generate the WMS legends by hand and it can be quite time consuming with more complicated legends as I have. Perhaps the problem could be related to the "leafletProxy" function since addWMSLegend comes from leaflet.extras.. — arevaju, May 17 '17 at 14:35
Yeah, there seems to be some lack of interoperability between the `leaflet` and the `leaflet.extras` package. — Samuel, May 17 '17 at 14:51

How to display WMS legends based on layer groups in Leaflet for R?

1 Answers1