如何根据 Leaflet for R 中的图层组显示 WMS 图例？

Question

我正在尝试根据 Leaflet 中的图层组和 Shiny 中 R 的 Leaflet extras 显示 WMS 图例。我正在使用here 描述的 input$map_groups 但它似乎不起作用，关于如何隐藏和切换 WMS 图例的任何想法？

谢谢，

胡安

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)

Answer 1

我玩过你的代码，似乎addWMSLegend 函数在if 语句中不起作用。但是，它可以在正常的管道成语中使用，但这不是您想要的。标准的addLegend 函数在if 语句中可以正常工作，如以下代码所示。我也对您的代码进行了一些清理。

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)