如何在R的宣传单中显示基于图层组的WMS图例？

Question

我正在尝试显示WMS图例的基础上，在宣传单和额外的R在闪亮的传单。我正在使用here描述的input$map_groups，但它似乎不起作用，有关于如何隐藏和切换here图例的想法吗？

谢谢,

胡安

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)