pal <- colorFactor(palette = "Set1", domain = MFT_tidy$Parent_Organization)
popup_text <- paste(MFT_tidy$Facility_Name, "<br>",
"Facility_Phone:", MFT_tidy$Facility_Phone, "<br>",
"Vendor_Name:", MFT_tidy$Vendor_Name)
layer_groups <- c("OSM (default)", "Toner", "Positron", "NatGeoWorldMap")
leaflet(MFT_tidy, width = "100%") %>%
addTiles(group = "OSM (default)") %>%
addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
addProviderTiles(providers$CartoDB.Positron, group = "Positron") %>%
addProviderTiles(providers$OpenTopoMap, group = "OpenTopoMap") %>%
addProviderTiles(providers$Esri.NatGeoWorldMap, group = "NatGeoWorldMap") %>%
addCircleMarkers(lng = ~longitude, lat = ~latitude,
color = ~pal(Parent_Organization),
stroke = FALSE, fillOpacity = 1,
label = ~Facility_Name,
popup = popup_text,
clusterOptions = markerClusterOptions() ) %>%
addLegend(position = "topright", pal = pal,
values = ~Parent_Organization,
labels = ~Parent_Organization,
title = "Parent Organization",
opacity = 1) %>%
addLayersControl(baseGroups = c("OSM (default)", "Toner", "Positron",
"OpenTopoMap", "NatGeoWorldMap"),
position = "bottomright") %>%
addMeasure(
position = "bottomleft",
primaryLengthUnit = "meters",
primaryAreaUnit = "sqmeters",
activeColor = "#3D535D",
completedColor = "#7D4479") %>%
addEasyButton(easyButton(
icon = "fa-globe", title = "Zoom to Original Level",
onClick = JS("function(btn, map){ map.setZoom(6); }"))) %>%
addEasyButton(easyButton(
icon = "fa-crosshairs", title = "Locate Me",
onClick = JS("function(btn, map){ map.locate({setView: true}); }")))
The code I used to create the map is as above:
There are obvious something wrong with the weird display of legend. I do not know how to correct it. I really cannot find anything wrong in the addLegend function.
Possible duplicate.
Problem is not with the addLegend function, but rather the zoom in the browser. You can fix this by adjusting CSS on the legend
Copying #Adam's code:
ui <- bootstrapPage(
tags$style(type="text/css", "div.info.legend.leaflet-control br {clear: both;}"),
...
)
Related
{leaflet.extras2} implements the leaflet side-by-side plugin and provides this minimal example:
library(leaflet)
library(leaflet.extras2)
leaflet(quakes) %>%
addMapPane("left", zIndex = 0) %>%
addMapPane("right", zIndex = 0) %>%
addTiles(group = "base", layerId = "baseid",
options = pathOptions(pane = "right")) %>%
addProviderTiles(providers$CartoDB.DarkMatter, group="carto", layerId = "cartoid",
options = pathOptions(pane = "left")) %>%
addCircleMarkers(data = breweries91[1:15,], color = "blue", group = "blue",
options = pathOptions(pane = "left")) %>%
addCircleMarkers(data = breweries91[15:20,], color = "yellow", group = "yellow") %>%
addCircleMarkers(data = breweries91[15:30,], color = "red", group = "red",
options = pathOptions(pane = "right")) %>%
addLayersControl(overlayGroups = c("blue","red", "yellow")) %>%
addSidebyside(layerId = "sidecontrols",
rightId = "baseid",
leftId = "cartoid")
However, when adapting to two raster images, I encounter the error:
Error in addRasterImage(., r2, colors = pal2, options = pathOptions(pane = "right"), :
unused argument (options = pathOptions(pane = "right"))
Here is a reproducible example:
library(raster)
library(leaflet)
library(leaflet.extras2)
library(rcartocolor)
# example raster data
r1 <- r2 <- raster(system.file("external/test.grd", package = "raster"))
# color palettes
pal1 <- colorNumeric(carto_pal(name = "OrYel"),
values(r1), na.color = "transparent")
pal2 <- colorNumeric(carto_pal(name = "BluYl"),
values(r2), na.color = "transparent")
# side by side map
leaflet() %>%
addMapPane("left", zIndex = 0) %>%
addMapPane("right", zIndex = 0) %>%
addTiles(group = "base", layerId = "baseid",
options = pathOptions(pane = "right")) %>%
addTiles(group = "carto", layerId = "cartoid",
options = pathOptions(pane = "left")) %>%
addRasterImage(r1, colors = pal1,
options = pathOptions(pane = "right"), group = "r1") %>%
addRasterImage(r2, colors = pal2,
options = pathOptions(pane = "right"), group = "r2") %>%
addLayersControl(overlayGroups = c("r1", "r2")) %>%
addSidebyside(layerId = "sidecontrols",
rightId = "baseid",
leftId = "cartoid")
The solution is pointed here by #RexParsons.
You will need addRasterImage's options = leafletOptions(pane = "") that will be added to {leaflet} on next release.
Step 1: for now you can install raster-options:
remotes::install_github("rstudio/leaflet", ref="joe/feature/raster-options")
Step 2: Session -> Restart R
Step 3: add options = leafletOptions(pane = ""):
leaflet() |>
addMapPane("right", zIndex = 0) |>
addMapPane("left", zIndex = 0) |>
addTiles(group = "base", layerId = "baseid1", options = pathOptions(pane = "right")) |>
addTiles(group = "base", layerId = "baseid2", options = pathOptions(pane = "left")) |>
addRasterImage(x = r1, colors = pal1, options = leafletOptions(pane = "right"), group = "r1") |>
addRasterImage(x = r2, colors = pal2, options = leafletOptions(pane = "left"), group = "r2") |>
addLayersControl(overlayGroups = c("r1", "r2")) |>
addSidebyside(layerId = "sidecontrols",
rightId = "baseid1",
leftId = "baseid2")
Output:
Option 2 (with addProviderTiles):
leaflet() |>
addMapPane("right", zIndex = 0) |>
addMapPane("left", zIndex = 0) |>
addTiles(group = "base", layerId = "baseid", options = pathOptions(pane = "right")) |>
addProviderTiles(providers$CartoDB, group="carto", layerId = "cartoid", options = pathOptions(pane = "left")) |>
addRasterImage(x = r1, colors = pal1, options = leafletOptions(pane = "right"), group = "r1") |>
addRasterImage(x = r2, colors = pal2, options = leafletOptions(pane = "left"), group = "r2") |>
addLayersControl(overlayGroups = c("r1", "r2")) |>
addSidebyside(layerId = "sidecontrols",
rightId = "baseid",
leftId = "cartoid")
Output:
Does it work for you?
<-- Partial answer to the #oatmilkyway's question below -->
Someone need to find a way to (conditionally) add/remove the leaflet.extras2::addSidebyside's layerId's, as one of possible solutions (if already exists, please let me know).
leaflet() |>
addMapPane("right", zIndex = 0) |>
addMapPane("left", zIndex = 0) |>
addTiles(group = "Base map", layerId = "baseid1", options = pathOptions(pane = "right")) |>
addTiles(group = "Base map", layerId = "baseid2", options = pathOptions(pane = "left")) |>
addProviderTiles(provider = providers$Esri.WorldImagery, group = "Satellite map", layerId = "satelliteid1", options = pathOptions(pane = "right")) |>
addProviderTiles(provider = providers$Esri.WorldImagery, group = "Satellite map", layerId = "satelliteid2", options = pathOptions(pane = "left")) |>
addRasterImage(x = r1, colors = pal1, options = leafletOptions(pane = "right"), group = "raster image 1") |>
addRasterImage(x = r2, colors = pal2, options = leafletOptions(pane = "left"), group = "raster image 2") |>
addLayersControl(baseGroups = c("Base map", "Satellite map"),
overlayGroups = c("raster image 1", "raster image 2")) |>
addSidebyside(layerId = "sidecontrols2", rightId = "satelliteid1", leftId = "satelliteid2") |>
addSidebyside(layerId = "sidecontrols", rightId = "baseid1", leftId = "baseid2")
leaflet() |>
addMapPane("right", zIndex = 0) |>
addMapPane("left", zIndex = 0) |>
addTiles(group = "Base and Carto Positron maps", layerId = "baseid", options = pathOptions(pane = "right")) |>
addProviderTiles(provider = providers$CartoDB.Positron, group = "Base and Carto Positron maps", layerId = "cartoid", options = pathOptions(pane = "left")) |>
addProviderTiles(provider = providers$Esri.WorldImagery, group = "Satellite and Toner Lite maps", layerId = "satelliteid", options = pathOptions(pane = "right")) |>
addProviderTiles(provider = providers$Stamen.TonerLite, group = "Satellite and Toner Lite maps", layerId = "tonerlightid", options = pathOptions(pane = "left")) |>
addRasterImage(x = r1, colors = pal1, options = leafletOptions(pane = "right"), group = "raster image 1") |>
addRasterImage(x = r2, colors = pal2, options = leafletOptions(pane = "left"), group = "raster image 2") |>
addLayersControl(baseGroups = c("Base and Carto Positron maps", "Satellite and Toner Lite maps"),
overlayGroups = c("raster image 1", "raster image 2"),
options = layersControlOptions(collapsed = FALSE)) |>
addSidebyside(layerId = "sidecontrols2", rightId = "satelliteid", leftId = "tonerlightid") |>
addSidebyside(layerId = "sidecontrols", rightId = "baseid", leftId = "cartoid")
Output:
Although this is a clunky answer at best, I hope it may help you.
I would like to use the leaflet easyButton plugin to control the layers shown instead of the built in layer controls. Unfortunately I do not know JS, and have spent several hours trying to make sense of the leafletJS documentation to find the correct way to do this.
Here is a slimmed down version of the code I'm attempting. The onClick is clearly working since the alerts happen, but nothing changes with the layer being shown.
Each button should show ONLY that one layer and none of the others (as opposed to allowing multiple layers to be seen at once).
library(tidyverse)
library(sf)
library(tigris)
library(leaflet)
statemap <- states(cb = T)
statemap <- statemap %>%
filter(GEOID < 60) %>%
shift_geometry(geoid_column = "GEOID") %>%
st_transform("EPSG:4326")
leaflet(statemap) %>%
addPolygons(weight = 1.25, color = "#000000", opacity = 1,#444444
fillColor = "green",
layerId = "green") %>%
addPolygons(weight = 1.25, color = "#000000", opacity = 1,#444444
fillColor = "red",
layerId = "red") %>%
addPolygons(weight = 1.25, color = "#000000", opacity = 1,#444444
fillColor = "yellow",
layerId = "yellow") %>%
addEasyButtonBar(easyButton(icon = "fa-globe", title = "Drinking Water Standard",
onClick = JS("function(btn, map) {
alert(\"Green\");
map.clearLayers();
map.addLayer('green');
}")),
easyButton(icon = "fa-crosshairs", title = "Groundwater Standard",
onClick = JS("function(btn, map) {
alert(\"Yellow\");
map.clearLayers();
map.addLayer('yellow');
}")),
easyButton(icon = "fa-globe", title = "Surface Water Standard",
onClick = JS("function(btn, map) {
alert(\"Red\");
map.clearLayers();
map.addLayer('red');
}")))
You could use the existing functionality of the baseGroups argument in the addLayersControl() function and map the onClick event to the Easy Buttons.
The final onRender() function simply hides this layer control panel so people use the easy buttons instead.
Working example: https://rpubs.com/Jumble/leaflet_easybuttons_layer_control
library(tidyverse)
library(sf)
library(tigris)
library(leaflet)
statemap <- states(cb = T)
statemap <- statemap %>%
filter(GEOID < 60) %>%
shift_geometry(geoid_column = "GEOID") %>%
st_transform("EPSG:4326")
leaflet(statemap) %>%
addPolygons(weight = 1.25, color = "#000000", opacity = 1,#444444
fillColor = "green",
group = "green") %>%
addPolygons(weight = 1.25, color = "#000000", opacity = 1,#444444
fillColor = "red",
group = "red") %>%
addPolygons(weight = 1.25, color = "#000000", opacity = 1,#444444
fillColor = "yellow",
group = "yellow") %>%
addLayersControl(baseGroups = c("green", "red", "yellow"), options=layersControlOptions(collapsed = F)) %>%
addEasyButtonBar(easyButton(icon = "fa-globe", title = "Drinking Water Standard",
onClick = JS("function(btn, map) {
let layerControlElement = document.getElementsByClassName('leaflet-control-layers')[0];
layerControlElement.getElementsByTagName('input')[0].click();
}")),
easyButton(icon = "fa-crosshairs", title = "Groundwater Standard",
onClick = JS("function(btn, map) {
let layerControlElement = document.getElementsByClassName('leaflet-control-layers')[0];
layerControlElement.getElementsByTagName('input')[1].click();
}")),
easyButton(icon = "fa-globe", title = "Surface Water Standard",
onClick = JS("function(btn, map) {
let layerControlElement = document.getElementsByClassName('leaflet-control-layers')[0];
layerControlElement.getElementsByTagName('input')[2].click();
}"))) %>%
htmlwidgets::onRender("
function(el, x) {
document.getElementsByClassName('leaflet-control-layers')[0].style.display = 'none';
}")
I am trying to plot a map with multiple layers. However, when selecting the group I want to show in the controlLayer panel, it changes the map but not the legend. In fact, the 2 legends are always displayed together on the map, but I only want one of them at a time.
Here is the code I use :
leaflet(data) %>%
addProviderTiles("Esri.WorldStreetMap") %>%
addRasterImage(r, opacity = 1, colors = cb, group = "Predictions") %>%
addLegend(pal = cb, values = wind_speed_range, title = "Wind Speed", opacity = 1, group = "Predictions", position = "topright") %>%
addCircles(radius = ~ residual*7000, color = "black", fillColor = ~ cb(predictions), fillOpacity = 1, label = ~ paste(as.character(residual), " / ", as.character(vitesse_vent), " / ", as.character(predictions)), weight = 2, group = "Predictions") %>%
addRasterImage(raster_difference, opacity = 1, colors = cb_correction, group = "Corrections") %>%
addLegend(pal = cb_correction, values = correction_range, title = "Corrections", opacity = 1, group = "Corrections", position = "topright") %>%
addLayersControl(
baseGroups = c("Prédictions", "Corrections"),
options = layersControlOptions(collapsed = FALSE),
position = "topleft"
)
As you can see, I already tried the solution of this post. I also tried with overlayGroup instead of baseGroup, but the problem is still here.
The image below is what I get using this code :
You can clearly see the two legends.
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
In the following code, I would like to have a control button to initiate and stop the following events:
turns all overlayGroups off,
then turns the 1st overlayGroup on for 1 second
then turns all overlayGroups off for 1 second
then turns the 2nd overlayGroup on for 1 second
cycles until stopped.
library(leaflet)
icon.Union <- makeAwesomeIcon(icon = "chevron-down",
markerColor = "lightblue",
iconColor="#FFFF33",
library = "fa")
icon.Confederacy <- makeAwesomeIcon(icon = "chevron-down",
markerColor = "lightgray",
iconColor="#FFFFFF",
library = "fa")
lng = -98.5795;lat = 39.8283
leaflet() %>%
addTiles(group = "OSM") %>%
setView(lng,lat, zoom = 4.0) %>%
addAwesomeMarkers(
lng = -77.23667, lat = 39.80861,
label = "Gettysburg, PA",
group = "Union",
icon = icon.Union) %>%
addAwesomeMarkers(
lng = -88.32183, lat = 35.15068,
label = "Shiloh, TN",
group = "Union",
icon = icon.Union) %>%
addAwesomeMarkers(
lng = -79.8747, lat = 32.7523,
label = "Fort Sumter",
group = "Confederacy",
icon = icon.Confederacy) %>%
addLayersControl(baseGroups="OSM",
overlayGroups = c("Union", "Confederacy"),
options= layersControlOptions(collapsed=TRUE))
I want to avoid requiring repetitive clicking on radio buttons to accomplish this.
Any suggestion will be greatly appreciated.
Please have a look at the below example code, I would like to use the label direction (MyDirection), which is stored in df to have different label directions within my map.
I can set every label to a specific direction like direction = "top", but somehow its not working if I specify direction = ~MyDirection.
Any Idea/solution would be much appreciated.
Thanks in advance.
library(leaflet)
df <- read.csv(textConnection("
Name,Lat,Long,MyDirection
ANN,51.19,4.46277778,right
BAB,43.26306,-2.94972222,left
BCN,41.29694,2.07833333,top
BCN,41.29694,2.07833333,bottom
"))
#---Create Map----
m <- leaflet(df) %>%
addTiles(group = "OSM (default)") %>%
addCircles(~Long, ~Lat,
label = ~htmlEscape(Name),
labelOptions = labelOptions(noHide = T,
#direction = "top",
#direction = "bottom",
#direction = "left",
#direction = "right",
direction = ~MyDirection))
m
I would like to share my latest approach. I finally managed to set the label direction based on mydf$MyDirection. Instead of adding multiple layers, as i did in my previous example, I used the library "Purrr". This reduces the amount of layers tremendously.
Best Regards
#Libraries----
library(leaflet)
library(htmltools)
library(htmlwidgets)
library(purrr)
#---Data Input----
mydf <- read.csv(textConnection("
Facility,Lat,Long,MyDirection
ANN,51.19,4.46277778,right
BAB,43.26306,-2.94972222,left
BCN,41.29694,2.07833333,top
BCN2,41.29694,2.07833333,bottom
"))
#---Create Vector----
ob_Facility <- mydf %>%
split(., .$Facility)
#---Create Map----
m <- leaflet() %>%
addTiles()
#---Purrr Layers----
names(ob_Facility) %>%
purrr::walk(function(mydf) {
m <<- m %>%
addCircleMarkers(data=ob_Facility[[mydf]],
lng=~Long, lat=~Lat,
group = "Show All",
label = ~Facility,
labelOptions = labelOptions(noHide = T,direction = ~MyDirection))
})
#---Layers control----
m %>%
addLayersControl(
overlayGroups = "Show All",
options = layersControlOptions(collapsed = FALSE)
)%>%
#---Save as HTML File----
saveWidget('Example Go Live Date.html', selfcontained = TRUE)
Hello,
I have figured out a workaround with 4 Layers (top,bottom,left,right) and attached the same group name to each layer.
library(leaflet)
df <- read.csv(textConnection("
Name,Lat,Long,MyDirection
ANN,51.19,4.46277778,right
BAB,43.26306,-2.94972222,left
BCN,41.29694,2.07833333,top
BCN,41.29694,2.07833333,bottom
"))
#---Create 4 additional DFs (1 for each dirction)----
dfLeft = df[df$MyDirection == "left", ]
dfRight = df[df$MyDirection == "right", ]
dfTop = df[df$MyDirection == "top", ]
dfBottom = df[df$MyDirection == "bottom", ]
#---Create Map----
m <- leaflet(df) %>%
addTiles(group = "OSM (default)") %>%
addCircles(~dfLeft$Long, ~dfLeft$Lat, color = '#d40511',
label = ~htmlEscape(dfLeft$Name),
labelOptions = labelOptions(noHide = T,
direction = "left"),
group = "Show All")%>%
addCircles(~dfRight$Long, ~dfRight$Lat, color = '#d40511',
label = ~htmlEscape(dfRight$Name),
labelOptions = labelOptions(noHide = T,
direction = "right"),
group = "Show All")%>%
addCircles(~dfTop$Long, ~dfTop$Lat, color = '#d40511',
label = ~htmlEscape(dfTop$Name),
labelOptions = labelOptions(noHide = T, direction = "top",
offset = c(0, -2)),
group = "Show All")%>%
addCircles(~dfBottom$Long, ~dfBottom$Lat, color = '#d40511',
label = ~htmlEscape(dfBottom$Name),
labelOptions = labelOptions(noHide = T, direction = "bottom",
offset = c(0, 2)),
group = "Show All")
m