Question

我有一个传单地图，它使用HTML自定义图例并使用addControl函数添加（以下：Leaflet Legend for Custom Markers in R）。

但是，我只想在显示一个组时显示图例，我尝试使用不适用于group = "group name"函数的参数addControl。我也试过使用layerId参数，但没有成功。

有什么想法吗？

可重复的例子：

library(leaflet)
# Sample Data
data(quakes)
quakes <- quakes[1:10,]

# Choose Icon:
leafIcons <- icons(
  iconUrl = ifelse(quakes$mag < 4.6,
               "http://leafletjs.com/docs/images/leaf-green.png",
               "http://leafletjs.com/docs/images/leaf-red.png"
 ),
  iconWidth = 38, iconHeight = 95,
  iconAnchorX = 22, iconAnchorY = 94)

html_legend <- "<img src='http://leafletjs.com/docs/images/leaf-
green.png'>green<br/>
<img src='http://leafletjs.com/docs/images/leaf-red.png'>red"

# Produce Map:
leaflet(data = quakes) %>% addTiles() %>%
  addMarkers(~long, ~lat, icon = leafIcons, group = "Group A") %>%
  addMarkers(~long, ~lat, icon = leafIcons, group = "Group B") %>%
  addControl(html = html_legend, position = "bottomleft") %>%
  addLayersControl(position = "topleft", overlayGroups = c("Group A","Group B"))

我希望{A}} html_legend元素仅在A组可见时才可见。

Answer 1

你是想尝试制作一个Shiny-App吗？我为Siny-App写了类似的东西，只显示了点击组的图例。

如果它不应该是一个闪亮的应用程序，你可以做这样的事情（你必须将传单地图分配给一个变量（在这种情况下是“地图”）。所以你可以调用它并在之后调整它。

map <- leaflet(data = quakes) %>% addTiles() %>%
  addMarkers(~long, ~lat, icon = leafIcons, group = "Group A") %>%
  addMarkers(~long, ~lat, icon = leafIcons, group = "Group B") %>%
  addControl(html = html_legend, position = "bottomleft") %>%
  addLayersControl(position = "topleft", overlayGroups = c("Group A","Group B"))

groups <- map$x$calls[[5]]$args[[2]]
activeGroup <- map$x$calls[[3]]$args[[5]]

if (any(activeGroup %in% "Group A")) {
  map %>% addLegend(title="Group A", position="bottomright", opacity=1, colors="red",
                           labels = "Group A")}

if (any(activeGroup %in% "Group B")) {
   map %>% addLegend(title="Group B", position="bottomright", opacity=1,colors="green",
                           labels = "Group B")}

groups-variable存储所有正在进行的组，而activeGroup存储此时处于活动状态的组。然后，您可以将它与一些if-else语句一起使用，以仅显示活动组的图例。

虽然它不会像普通的R脚本那样互动。您必须重复调用activeGroup-call，以检查哪些组仍处于活动状态。在Shiny中，将给出这种交互性。

您可以在一个有光泽的应用程序中实现：

ui <- fluidPage(
  leafletOutput("map")
)
server <- function(input, output, session){
  output$map <- renderLeaflet({
    map <- leaflet(data = quakes) %>% addTiles() %>%
      addMarkers(~long, ~lat, icon = leafIcons, group = "Group A") %>%
      addMarkers(~long, ~lat, icon = leafIcons, group = "Group B") %>%
      addControl(html = html_legend, position = "bottomleft")
      addLayersControl(position = "topleft", overlayGroups = c("Group A","Group B"))
    map
  })

  observe({
    map <- leafletProxy("map") %>% clearControls()

    if (any(input$map_groups %in% "Group A")) {
      map <- map %>% addLegend(title="Group A", position="bottomright", opacity=1, colors="red",labels = "Group A")}
    if (any(input$map_groups %in% "Group B")) {
      map <- map %>% addLegend(title="Group B", position="bottomright", opacity=1,colors="green",labels = "Group B")}
  })
}

shinyApp(ui, server)

Answer 2

好吧，好吧，现在我觉得我理解你的问题。下面是另一个示例，仅显示活动组的图例和控件。为此，我为A组和B组创建了2个html_legends。

library(shiny)
library(leaflet)

html_legend_A <- "<img src='http://leafletjs.com/docs/images/leaf-green.png'>green<br/>"
html_legend_B <- "<img src='http://leafletjs.com/docs/images/leaf-red.png'>red<br/>"

ui <- fluidPage(
  leafletOutput("map")
)
server <- function(input, output, session){
  output$map <- renderLeaflet({
    map <- leaflet(data = quakes) %>% addTiles() %>%
      addMarkers(~long, ~lat, icon = leafIcons, group = "Group A", layerId = "A") %>%
      addMarkers(~long, ~lat, icon = leafIcons, group = "Group B", layerId = "B") %>%
      addLayersControl(position = "topleft", overlayGroups = c("Group A","Group B"))
    map
  })

  observe({
    map <- leafletProxy("map") %>% clearControls()
    if (any(input$map_groups %in% "Group A")) {
      map <- map %>% 
        addControl(html = html_legend_A, layerId = "A", position = "bottomleft") %>% 
        addLegend(title="Group A", position="bottomright", opacity=1, colors="green",labels = "Group A")}
    if (any(input$map_groups %in% "Group B")) {
      map <- map %>% 
        addControl(html = html_legend_B, layerId = "B", position = "bottomleft") %>% 
        addLegend(title="Group B", position="bottomright", opacity=1,colors="red",labels = "Group B")}
  })
}

shinyApp(ui, server)

使用LayerId参数时，每组只显示1个标记。如果要查看所有标记，则不应给出LayerId参数。我做了另一个例子。我认为这应该是正确的:)我还创建了2个图标，我正在基于renderLeaflet函数中的mag列过滤地震数据，就像在图标分配中一样。

library(shiny)
library(leaflet)

data(quakes)
quakes <- quakes[1:10,]

leafIcons_A <- icons(
  iconUrl = "https://leafletjs.com/examples/custom-icons/leaf-green.png",
  iconWidth = 38, iconHeight = 95,
  iconAnchorX = 22, iconAnchorY = 94)
leafIcons_B <- icons(
  iconUrl = "https://leafletjs.com/examples/custom-icons/leaf-red.png",
  iconWidth = 38, iconHeight = 95,
  iconAnchorX = 22, iconAnchorY = 94)

html_legend_A <- "<img src='https://leafletjs.com/examples/custom-icons/leaf-green.png'>green<br/>"
html_legend_B <- "<img src='https://leafletjs.com/examples/custom-icons/leaf-red.png'>red<br/>"

ui <- fluidPage(
  leafletOutput("map")
)
server <- function(input, output, session){
  output$map <- renderLeaflet({
    dataA <- quakes[quakes$mag < 4.6,]
    dataB <- quakes[quakes$mag > 4.6,]

    map <- leaflet() %>% addTiles() %>%
      addMarkers(dataA$long, dataA$lat, icon = leafIcons_A, group = "Group A") %>%
      addMarkers(dataB$long, dataB$lat, icon = leafIcons_B, group = "Group B") %>%
      addLayersControl(position = "topleft", overlayGroups = c("Group A","Group B"))
    map
  })

  observe({
    map <- leafletProxy("map") %>% clearControls()
    if (any(input$map_groups %in% "Group A")) {
      map <- map %>%
        addControl(html = html_legend_A, position = "bottomleft") %>%
        addLegend(title="Group A", position="bottomright", opacity=1, colors="green",labels = "Group A")}
    if (any(input$map_groups %in% "Group B")) {
      map <- map %>%
        addControl(html = html_legend_B, position = "bottomleft") %>%
        addLegend(title="Group B", position="bottomright", opacity=1,colors="red",labels = "Group B")}
  })
}

shinyApp(ui, server)

R leaflet - 使用组图层显示/隐藏addControl（）元素

2 个答案: