How to hide/toggle legends based on addLayerControl() in Leaflet for R
In case anyone is looking at this in the future, there's a new viable method.
If you're using the development/Github version of the leaflet package, addLegend() now supports the group and layerId arguments.
(Run the command devtools::install_github('rstudio/leaflet') to install)
Even the latest CRAN version (1.1.0) supports layerID.
Assuming you go with the development version, the following code should work:
leaflet() %>%
#Polygon Layers
addPolygons(data = exampleDataOne, group = "Group A") %>%
addPolygons(data = exampleDataTwo, group = "Group B") %>%
#Legend Layers
addLegend(values = exampleValuesOne, group = "Group A",
position = "bottomright") %>%
addLegend(values = exampleValuesTwo, group = "Group B",
position = "bottomright") %>%
#Layers Control
addLayersControl(overlayGroups = c("Group A","Group B"),
options = layersControlOptions(collapsed = FALSE))
This should have the desired effect of only displaying a legend when the corresponding layer is active.
One potential issue is that by default, all leaflet layers are active. If you have overlapping polygons, this can lead to a less visually appealing map. And, if you have multiple legends, this will also be an issue.
What you can do is use the hideGroup() function.
If you wanted to have only Group A from the above example active at start, you could add
%>% hideGroup("Group B")
to the end of the code block above.
How to show/hide legend with control layer panel with leaflet?
Code
Unfortunately, you did not provide a reprex, so I show it with a made up example:
library(leaflet)
cities1 <- data.frame(City = factor(c("Boston", "Hartford",
"New York City", "Philadelphia", "Pittsburgh", "Providence")),
Lat = c(42.3601, 41.7627, 40.7127, 39.95, 40.4397, 41.8236),
Long = c(-71.0589, -72.6743, -74.0059, -75.1667, -79.9764, -71.4222),
Pop = c(645966L, 125017L, 8406000L, 1553000L, 305841L, 177994L),
Type = factor(c("C", "D", "A", "A", "B", "C")))
cities2 <- data.frame(City = factor(c("Baltimore", "Ithaca", "Wareham")),
Lat = c(39.299236, 42.443962, 41.761452),
Long = c(-76.609383, -76.501884, -70.719734),
Pop = c(609032L, 30569L, 22666L),
Type = factor(letters[1:3]))
pal1 <- colorFactor("viridis", domain = cities1$Type)
pal2 <- colorFactor("Set1", domain = cities2$Type)
leaflet(cities1) %>%
addTiles() %>%
addCircles(data = cities1, lng = ~Long, lat = ~Lat, weight = 1, group="one",
radius = ~sqrt(Pop) * 30, popup = ~City, color = ~pal1(Type), opacity = .9
) %>%
addLegend(pal = pal1, values = ~Type, group = "one", layerId = "one") %>%
addCircles(data = cities2, lng = ~Long, lat = ~Lat, weight = 1, group = "two",
radius = ~sqrt(Pop) * 30, popup = ~City, color = ~pal2(Type), opacity = .9
) %>%
addLegend(pal = pal2, values = ~Type, data = cities2, group = "two", layerId = "two") %>%
addLayersControl(
baseGroups = c("one", "two"),
options = layersControlOptions(collapsed = FALSE),
position = "topleft"
) %>%
htmlwidgets::onRender("
function() {
var map = this;
var legends = map.controls._controlsById;
function addActualLegend() {
var sel = $('.leaflet-control-layers-base').find('input[type=\"radio\"]:checked').siblings('span').text().trim();
$.each(map.controls._controlsById, (nm) => map.removeControl(map.controls.get(nm)));
map.addControl(legends[sel]);
}
$('.leaflet-control-layers-base').on('click', addActualLegend);
addActualLegend();
}")
Explanation
You can define some custom JavaScript which reacts upon the changes of the radio buttons. When they change, I basically delete all controls and add the selected. In order for this to work, I need to save a copy of the controls first. This is of course a bit hackish (especially since I am accessing the "private" _controlsById slot of the map), but from my quick scan of the leaflet API I did not find a better entry point.
Screenshot
Is it possible to switch between multiple legends when switching between base groups?
It seems legends in baseGroups won't remove/re-added as if in overlayGroups, which can be further proved by the persistence of legends even after calling hideGroup("var1").
A crude workaround can be adding an event handler to hide/unhide legends according to the current selected group of baseGroups using group = "<groupName>" as a key, and nothing else should need to be changed. For example:
htmlwidgets::onRender("
function(el, x) {
var updateLegend = function () {
var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1);
document.querySelectorAll('.legend').forEach(a => a.hidden=true);
document.querySelectorAll('.legend').forEach(l => {
if (l.children[0].children[0].innerText == selectedGroup) l.hidden=false;
});
};
updateLegend();
this.on('baselayerchange', e => updateLegend());
}")
Demo
Source of Demo
require(leaflet)
data <- data.frame(long = c(-93.2, -93, -93.5), lat = c(44.9, 45, 44.9),
var1 = c(1,2,3), var2 = c(10, 9, 1))
pal1 <- colorNumeric(palette = "Blues", domain = data$var1)
pal2 <- colorNumeric(palette = "Reds", domain = data$var2)
leaflet(data) %>%
addCircleMarkers(color = ~pal1(var1), group = "var1") %>%
addCircleMarkers(color = ~pal2(var2), group = "var2") %>%
addLegend(pal = pal1, values = ~var1, group = "var1") %>%
addLegend(pal = pal2, values = ~var2, group = "var2") %>%
addLayersControl(baseGroups = c("var1", "var2"),
position = "topleft",
options = layersControlOptions(collapsed=F)) %>%
htmlwidgets::onRender("
function(el, x) {
var updateLegend = function () {
var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1);
document.querySelectorAll('.legend').forEach(a => a.hidden=true);
document.querySelectorAll('.legend').forEach(l => {
if (l.children[0].children[0].innerText == selectedGroup) l.hidden=false;
});
};
updateLegend();
this.on('baselayerchange', e => updateLegend());
}")
Making selectizeInput reactive to show/hide markers on Leaflet Shiny R
Try this
library(leaflet)
library(shiny)
library(shinydashboard)
library(dplyr)
#Data Sample
long <- c(-96.72363, -96.72880, -96.72700)
lat <- c(17.06167, 17.06200, 17.06170 )
name <- c("jim", "grant", "pablo")
food <- c("tacos", "burger", "elote")
df <- data.frame(long, lat, name, food)
#subsets
palette <- colorFactor(palette = c("blue", "green", "black"),
domain = df$food)
tacos <- dplyr::filter(df, grepl("tacos", food))
burger <- dplyr::filter(df, grepl("burger", food))
elote <- dplyr::filter(df, grepl("elote", food))
ui <-fluidPage(
titlePanel(title = "Street Food Oaxaca"),
sidebarLayout(
sidebarPanel(
selectizeInput("food","Select a Type:",
choices = unique(df$food),
selected = food[1],
multiple = TRUE)),
mainPanel(h3("Map"), leafletOutput("m", width = "800", height = "600"))
)
)
#server
server <- function(input, output, session){
df1 <- eventReactive(input$food, {
df %>% dplyr::filter(food %in% input$food)
})
output$m = renderLeaflet({
leaflet(data = df1()) %>%
setView(lng = -96.725, lat = 17.0618, zoom =14)%>%
addTiles() %>%
addCircleMarkers( # layerId = input$food,
# data = input$food,
~long,
~lat,
#group = input$food,
#popup = ~as.character(name),
radius = 2,
color = ~palette(input$food),
fillOpacity = 0.5) %>%
# addCircleMarkers( layerId = burger,
# data = burger,
# ~long,
# ~lat,
# group = 'burger',
# popup = ~as.character(name),
# radius = 2,
# color = ~palette(food),
# fillOpacity = 0.5) %>%
# addCircleMarkers( layerId = elote,
# data = elote,
# ~long,
# ~lat,
# group = 'elote',
# popup = ~as.character(name),
# radius = 2,
# color = ~palette(food),
# fillOpacity = 0.5) %>%
# addPolygons(data = poly,
# ~long,
# ~lat,
# weight = 3,
# color = "red",
# group = "Restricted Zone" ,
# popup = "Restricted Zone")
addLayersControl(
overlayGroups = c("tacos","burger","elote", "Restricted Zone"),
options = layersControlOptions(collapsed = TRUE)
)
})
}
#Run the application
shinyApp(ui = ui , server = server)
R leaflet - Show/Hide addControl() element with group layers
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)
How to turn off the layer display of addLayersControl first when launching the shiny app
If I understand correctly you need to add %>% hideGroup("Group B") after addLayersControl(position = "topleft", overlayGroups = c("Group A","Group B")) as below:
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")) %>%
hideGroup("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)
Related Topics
R Create Function to Add Water Year Column
Is the Plyr Package for R Not Available for R Version 3.0.2
How to Force Seasonality from Auto.Arima
Update() Inside a Function Only Searches the Global Environment
Subset a Data Frame Based on Value Pairs Stored in Independent Ordered Vectors
Saving a File to Sharepoint with R
Including Images in R-Package Documentation (.Rd) Files
Inline R Code in Yaml for Rmarkdown Doesn't Run
R Data.Table Join: SQL "Select *" Alike Syntax in Joined Tables
How to Write a Data-Frame with One Column a List to a File
Installing R Studio with Anaconda
Adding Multiple Shadows/Rectangles to Ggplot2 Graph
Can You More Clearly Explain Lazy Evaluation in R Function Operators
Visualizing Two or More Data Points Where They Overlap (Ggplot R)
Syntax Highlighting for Python Chunks Does Not Work
Search for Corresponding Node in a Regression Tree Using Rpart
Usemethod("Predict"):No Applicable Method for 'Predict' Applied to an Object of Class "Train"