Rのリーフレットのレイヤーグループに基づいてWMS凡例を表示するにはどうすればよいですか？

Question

ShinyのRのリーフレットとリーフレットのエクストラにレイヤーグループに基づいてWMSの凡例を表示しようとしています。私はhereと記述されているように入力$ 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)