R传单-显示/隐藏具有组图层的addControl()元素 [英] R leaflet - Show/Hide addControl() element with group layers

问题描述

我有一个传单地图，该地图使用HTML自定义图例并使用 addControl 函数添加(如下:

I have a leaflet map which uses a custom legend using HTML and added using the addControl function (following: Leaflet Legend for Custom Markers in R).

但是，我只希望在显示一组时显示图例，我尝试使用参数 group ="group name" ，该参数不适用于 addControl 功能.我也尝试使用 layerId 参数，但没有成功.

However, I only want the legend to show when one group is shown, I have tried using the argument group = "group name"which doesn't work with the addControl function. I've also tried using layerId arguments but without success.

有什么想法吗?

可复制的示例:

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"))

我希望 addControl html_legend元素仅在可见A组时可见.

Where I would like the addControl html_legend element to only be visible when Group A is visible.

推荐答案

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

Alright, now I think i understand your problem. Below is another example, which shows only the legend and control of the active groups. For that, I created 2 html_legends for group A and for group B.

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函数内部的磁柱过滤了地震数据.

When using the LayerId argument, it only shows 1 marker per group. If you want to see all markers, the LayerId argument should not be given. I made you another example. I think this should be right now :) I also create 2 icons and I am filtering the quakes data, based on the mag-column inside the renderLeaflet function, as you do in the icon assignment.

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传单-显示/隐藏具有组图层的addControl()元素的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！