我试图根据Leaf中的图层组和Shiny中的R的Leaflet附加组件显示WMS图例。我正在使用输入$ map_groups,如here所述,但它似乎无法工作,有关如何隐藏和切换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)
答案 0 :(得分:0)
我玩了你的代码,似乎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)