Anybody know how to set a default layer to show just one Overlay group first rather than all at once? For example, in the following if I just wanted to show 'Mex' initially and then let the viewer swap to 'GTM'?
library(raster)
library(leaflet)
#load in shapefiles
gtm <- getData('GADM', country = 'GTM', level = 0)
mex <- getData('GADM', country = 'MEX', level = 0)
leaflet() %>%
addTiles() %>%
addPolygons(data = gtm,
fillColor = 'red',
group = "gtm") %>%
addLegend(color = "red",
labels = gtm#data$GID_0,
group = "gtm") %>%
addPolygons(data = mex,
fillColor = 'blue',
group = "mex") %>%
addLegend(color = "blue",
labels = mex#data$GID_0,
group = "mex") %>%
addLayersControl(overlayGroups = c("gtm", "mex"),
options = layersControlOptions(collapsed = F),
)
Use function hideGroup to hide groups from code
addLayersControl(overlayGroups = c("gtm", "mex"),
options = layersControlOptions(collapsed = F)) %>%
hideGroup("mex")
See the official leaflet vignette under section Show/Hide Layers
Related
In the tiny example shown below, I have two features associated with each country (polygons) in the map, namely: randomA, randomB. Each feature has its own legend, so I armed a group named "randomA" containing the polygons coloured with feature randomA and its corresponding legend. I did the same for group "randomB". When the map is depicted, leaflet correctly shows or hides polygons for features "randomA" and "randomB". However legends are always shown stacked on the bottom right corner.
This is the code:
library(rgdal)
library(leaflet)
# From http://data.okfn.org/data/datasets/geo-boundaries-world-110m
countries <- readOGR("json/countries.geojson")
n <- nrow(countries)
# Add two random fields
set.seed(15)
countries#data$randomA <- rnorm(n, 1000, 250)
countries#data$randomB <- rnorm(n, 10000, 3000)
map <- leaflet(countries) %>% addTiles()
pal <- colorNumeric(
palette = "YlGnBu",
domain = countries$randomA
)
map <- map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~pal(randomA), group = "randomA"
) %>%
addLegend("bottomright", pal = pal, values = ~randomA,
title = "random A",
labFormat = labelFormat(prefix = "$"),
opacity = 1, group = "randomA"
)
qpal <- colorQuantile("RdYlBu", countries$gdp_md_est, n = 5)
map <- map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~qpal(randomB), group = "randomB"
) %>%
addLegend(
"bottomright",
pal = qpal,
values = ~randomB,
opacity = 1, group = "randomB"
)
# Finally control layers:
map <- map %>%
addLayersControl(
baseGroups = c("randomA", "randomB"),
position = "bottomleft",
options = layersControlOptions(collapsed = F)
)
map
A snapshot of the result is shown in the image below:
Also, in the actual problem I have to represent nine of these groups, so I wish I had all the legends in the same place.
Do you have any suggestion?
Try using overlay groups instead of base groups:
addLayersControl(
overlayGroups = c("randomA", "randomB"),
position = "bottomleft",
options = layersControlOptions(collapsed = F)
)
I'm trying to create a choropleth map in county level using leaflet R package and I actually do it. But when I check my data file and the hover text of any county I find that the values are not correct. For example check the Conejos county. Any explanation? Or a better way to process tha data and create this map without the mismatches?
Code:
library(raster)
library(leaflet)
library(tidyverse)
# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE) %>%
dplyr::select(COUNTY_NAME, Avg_yield)
### Check counties that exist in USA, but not in mydata
### Create a dummy data frame and bind it with mydata
mydata <- data.frame(COUNTY_NAME = setdiff(USA$NAME_2, mydata$COUNTY_NAME),
Avg_yield = NA,
stringsAsFactors = FALSE) %>%
bind_rows(mydata)
### Create a color palette
mypal <- colorNumeric(palette = "viridis", domain = mydata$Avg_yield)
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(data = USA, stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(mydata$Avg_yield),
popup = paste("Region: ", USA$NAME_2, "<br>",
"Avg_yield: ", mydata$Avg_yield, "<br>")) %>%
addLegend(position = "bottomleft", pal = mypal, values = mydata$Avg_yield,
title = "Avg_yield",
opacity = 1)
I'm building a leaflet map on R having multiple layers that are controlled by addLayersControl. Every layer as the same spatial information, so only the data associated to each polylines changes. The idea is to have a basic map, where the user decide which data field is display. I succeeded at making the map, however I noticed that the size of the html file produced is huge.
In my actual context, making the map with only one layer leads to a ~20mb file. However, if I add one field it gets to ~40mb and three layer ~60mb. So it seems to me that the html produced is loading the same shapefile 3 times instead of simply using one shapefile and linking it a data frame of some sort.
Am I stock with this behavior of leaflet or is there a way to file size inflation in my context? I may not have programmed my leaflet the better way...
I've made a reproducible example to show the problem. It uses a small shapefile so the size problem is not dramatic, however the point is the same, which is constantly doubling file size. Also, the example is lengthy, sorry about that, I could'n find a way to simplify it further.
Preparation:
# loading the libraries
library(sf)
library(leaflet)
library(htmlwidgets)
# preparing the shapefile
nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>%
st_transform(st_crs(4326))
# preparing the colors (not really important)
pal.area <- colorNumeric(palette = "inferno", domain = range(nc$AREA))
pal.perim <- colorNumeric(palette = "inferno", domain = range(nc$PERIMETER))
pal.cnty <- colorNumeric(palette = "inferno", domain = range(nc$CNTY_))
pal.sid74 <- colorNumeric(palette = "inferno", domain = range(nc$SID74))
Making the leaflet, this section is long, however it's simply 4 leaflet maps created one after another by adding one layer at a time. It's mostly copy-pasted work:
###
one_layer <- leaflet(data = nc) %>%
addTiles() %>%
addPolylines(fillColor = ~pal.area(AREA),
fill = TRUE,
opacity = 0.8,
group = "area") %>%
addLegend("bottomright",
pal = pal.area, values = ~AREA,
opacity = 1, group = "area"
)
###
###
two_layers <- leaflet(data = nc) %>%
addTiles() %>%
addPolylines(fillColor = ~pal.area(AREA),
fill = TRUE,
opacity = 0.8,
group = "area") %>%
addLegend("bottomright",
pal = pal.area, values = ~AREA,
opacity = 1, group = "area") %>%
addPolylines(fillColor = ~pal.perim(PERIMETER),
fill = TRUE,
opacity = 0.8,
group = "perim") %>%
addLegend("bottomright",
pal = pal.perim, values = ~PERIMETER,
opacity = 1, group = "perim"
) %>%
addLayersControl(
overlayGroups = c("area", "perim"), position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
)
###
###
three_layers <- leaflet(data = nc) %>%
addTiles() %>%
addPolylines(fillColor = ~pal.area(AREA),
fill = TRUE,
opacity = 0.8,
group = "area") %>%
addLegend("bottomright",
pal = pal.area, values = ~AREA,
opacity = 1, group = "area") %>%
addPolylines(fillColor = ~pal.perim(PERIMETER),
fill = TRUE,
opacity = 0.8,
group = "perim") %>%
addLegend("bottomright",
pal = pal.perim, values = ~PERIMETER,
opacity = 1, group = "perim"
) %>%
addPolylines(fillColor = ~pal.cnty(CNTY_),
fill = TRUE,
opacity = 0.8,
group = "cnty") %>%
addLegend("bottomright",
pal = pal.cnty, values = ~CNTY_,
opacity = 1, group = "cnty"
) %>%
addLayersControl(
overlayGroups = c("area", "perim", "cnty"), position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
) %>%
hideGroup(c("perim","cnty"))
###
###
four_layers <- leaflet(data = nc) %>%
addTiles() %>%
addPolylines(fillColor = ~pal.area(AREA),
fill = TRUE,
opacity = 0.8,
group = "area") %>%
addLegend("bottomright",
pal = pal.area, values = ~AREA,
opacity = 1, group = "area") %>%
addPolylines(fillColor = ~pal.perim(PERIMETER),
fill = TRUE,
opacity = 0.8,
group = "perim") %>%
addLegend("bottomright",
pal = pal.perim, values = ~PERIMETER,
opacity = 1, group = "perim"
) %>%
addPolylines(fillColor = ~pal.cnty(CNTY_),
fill = TRUE,
opacity = 0.8,
group = "cnty") %>%
addLegend("bottomright",
pal = pal.cnty, values = ~CNTY_,
opacity = 1, group = "cnty"
) %>%
addPolylines(fillColor = ~pal.sid74(SID74),
fill = TRUE,
opacity = 0.8,
group = "sid74") %>%
addLegend("bottomright",
pal = pal.sid74, values = ~SID74,
opacity = 1, group = "sid74"
) %>%
addLayersControl(
overlayGroups = c("area", "perim", "cnty", "sid74"), position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
) %>%
hideGroup(c("perim","cnty", "sid74"))
###
Then, you get 4 objects (maps) we can compare their size directly in R:
object.size(one_layer)
301864 bytes
object.size(two_layers)
531144 bytes
object.size(three_layers)
681872 bytes
object.size(four_layers)
828616 bytes
The size increase is constant and way higher that what we would expect if the only the data was added instead of all the spatial info. As a comparison, the initial shape which has 15 fields is of size:
object.size(nc)
135360 bytes
If we save the maps to HTML, the problem is even more visible:
saveWidget(one_layer, paste0(getwd(),"/temp_data/temp/one_layer.html"), selfcontained = F)
saveWidget(two_layers, paste0(getwd(),"/temp_data/temp/two_layers.html"), selfcontained = F)
saveWidget(three_layers, paste0(getwd(),"/temp_data/temp/three_layers.html"), selfcontained = F)
saveWidget(four_layers, paste0(getwd(),"/temp_data/temp/four_layers.html"), selfcontained = F)
file.info(list.files("temp_data/temp", pattern = ".html$", full.names = T))$size[c(2,4,3,1)] %>%
setNames(c("One Layer", "Two Layers", "Three Layers", "Four Layers")) %>%
barplot(ylab="size in Bytes")
It's clearly doubling in size.
So, to summarize, is there a way to get leaflet to not reproduced the spatial information when adding multiple fields of data to the same map?
I am making an R leaflet map (not Shiny) and I have two control groups, and based on the selection I would like a different legend to become visible. Currently I only manage to have both legends visible at all time.
Below is the code for the leaflet map, and the output can be seen in the image.
leaflet() %>% addSearchOSM() %>%
addProviderTiles(providers$CartoDB.Positron,
options = providerTileOptions(noWrap = TRUE),
group = "kaart") %>%
# addFullscreenControl() %>%
addCircleMarkers(data = table#data,
lat = ~lng,
lng = ~lat,
color = ~palverbruikplaats(Verbruiksplaats),
label = bepaalPopup(),
group = "Verbruikplaatscircles"
)%>%
addCircleMarkers(data = table#data,
lat = ~lng,
lng = ~lat,
color = ~palstatus(`Status omschrijving`),
label = bepaalPopup(),
group = "statuscircles"
)%>%
leaflet::addLegend("bottomleft", pal = palverbruikplaats, values = verbruikplaatsuniek, title = "Legenda") %>%
leaflet::addLegend("bottomleft", pal = palstatus, values = statusuniek, title = "Legenda") %>%
addLayersControl(baseGroups = c("Verbruikplaatscircles", "statuscircles"),
options = layersControlOptions(collapsed = FALSE))
In your addLayersControl did you mean to set the overlayGroups argument instead of baseGroups?
library(leaflet)
leaflet() %>%
addTiles(group = "OpenStreetMap") %>%
addCircleMarkers(runif(20, -75, -74), runif(20, 41, 42), group = "Markers1", color ="red") %>%
addMarkers(runif(20, -75, -74), runif(20, 41, 42), group = "Markers2") %>%
addLegend(values = 1, group = "Markers1", position = "bottomleft", labels = "1", colors= "red") %>%
addLegend(values = 2, group = "Markers2", position = "bottomleft", labels = "2" ,colors= "blue") %>%
addLayersControl(overlayGroups = c("Markers1", "Markers2"),
options = layersControlOptions(collapsed = FALSE))
what you need to do is, you need to make your legends values reactive
addLegend("bottomright", pal = pal, values = maindata#data[,req_var1()],
you can declare the req_var1() in server before calling
req_var1<-reactive({if(input$`Comparison Metric`=="Current Territory Factors vs GeoProxy Smoothing"){
paste(input$Curr2,"Curr",sep="_")
} else if(input$`Comparison Metric`=="Current Written Premium Vs Indicated Written Premium"){
paste(input$Curr2,"CWP",sep="_")
}
})
and also the pal can be declared as
pal1 <- reactive({if(input$ColorType=="Percentile"){
colorQuantile(
palette = "Spectral",
domain = tempdata()#data[,req_var1()],
probs = if(input$`Comparison Metric`=="Current Territory Factors vs GeoProxy Smoothing"){seq(0,1,by=0.25)
} else if(input$`Comparison Metric`=="Current Written Premium Vs Indicated Written Premium"){
seq(0,1,by=0.5)
}
## In case of Current written premium the variation is very less so while executing color mapping code is throwing error.
## This is because the some of quantiles values are not differentiable.
## So in colorQuantile function we have given two different prob values depending on metric selection.
)
} else if(input$ColorType=="Absolute Value"){colorNumeric(
palette = "Spectral",
domain = tempdata()#data[,req_var1()])
}else{print("Plese select Any one color map")}
})
There is a plug-in for Leaflet JS that allows to group the layers in the layer control. https://github.com/ismyrnow/Leaflet.groupedlayercontrol
This plug-in does not seem to exist for Leaflet R but I found this post saying that there is a way to use arbitraty Leaflet JS plug-in in Leaflet R.
https://gist.github.com/jcheng5/c084a59717f18e947a17955007dc5f92
I tried to apply this method to the Leaflet.groupedlayercontrol plug-in but did not succeed. Do you have any idea how I can possibly use this plug-in or any other way to group my layers in the layercontrol generated by Leaflet R? Thank you.
You definitely can do layer control in leafletR. If you version does not have it, then you need to update, probably from the most recent GITHUB version.
I am working on a map right now that has layer controls, see the photograph. Here is the code that makes it happen. As you can see each of the addPolygons has a group = " A Name" This is where you identify the layers in the check boxes on my image.
map<-leaflet()%>%
addTiles()%>%
addPolygons(data = plotMerge,
fillColor = ~pal(plotMerge$incomePerCapita),
color = "#000000", #this is an outline color
fillOpacity = 0.8,
group="Tract",
weight = 0.2,
popup=popup)%>%
addPolygons(data = countyPoly,
fillColor = "transparent",
color = "#000000", #this is an outline color
fillOpacity = 0.8,
group="County",
popup=countyPoly#data$NAME,
weight = 2)%>%
addPolygons(data = townPoly,
fillColor = "transparent",
color = "#000000", #this is an outline color
fillOpacity = 0.8,
group="Town",
weight = .8,
popup=townPoly#data$TOWN)%>%
addPolygons(data = rphnPoly,
fillColor = "transparent",
color = "#000000", #this is an outline color
fillOpacity = 0.8,
group="Public Health Region",
weight = .8,
popup=rphnPoly#data$PHN)%>%
addLegend(pal = pal,
values = plotMerge$incomePerCapita,
position = "bottomright",
title = "State-wide Income Percentiles",
labFormat = labelFormat(digits=1))%>%
addLayersControl(
overlayGroups =c("County", "Town", "Public Health Region", "Tract"),
options = layersControlOptions(collapsed=FALSE)
)
saveWidget(map, file="map1.html", selfcontained=FALSE)
Here is what it looks like:
You can also add other controls check it out here:
Leaflet R Hidden Layers
I know this is an old question but I didn't find a good answer elsewhere - this may help others in the future.
Here is a reprex with comments that explains the code:
#load library
library(tidyverse)
library(leaflet)
#load data
data("quakes")
#map all points
# quakes %>%
# leaflet() %>%
# addProviderTiles(providers$CartoDB.Positron) %>%
# addCircleMarkers(lng = ~long, lat = ~lat, radius = 1)
#create a grouping variable -- this can be whatever you want to filter by
quakes <- quakes %>%
mutate(groups = case_when(
stations < 30 ~ 1,
stations < 50 ~ 2,
TRUE ~ 3
))
#function to plot a map with layer selection
map_layers <- function() {
#number of groups
k <- n_distinct(quakes$groups)
#base map
map <- leaflet() %>%
addProviderTiles(providers$CartoDB.Positron)
#loop through all groups and add a layer one at a time
for (i in 1:k) {
map <- map %>%
addCircleMarkers(
data = quakes %>% filter(groups == i), group = as.character(i),
lng = ~long, lat = ~lat, radius = 1
)
}
#create layer control
map %>%
addLayersControl(
overlayGroups = c(1:k),
options = layersControlOptions(collapsed = FALSE)) %>%
hideGroup(as.character(c(2:k))) #hide all groups except the 1st one
}
#plot the map
map_layers()