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).
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.
Do you have any ideas?
Reproducible example:
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"))
Where I would like the addControl
html_legend element to only be visible when Group A is visible.
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)
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)