Grouped layer control in Leaflet R - r

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

Related

R Leaflet layersControlOptions

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

How to fix geospatial mislabeling on leaflet map within R Shiny app?

I made the following map from a data frame that contains the number of parole of each state from the years 1995-2015 per 100,000 as well as the spatial information for each state. I want to incorporate it into r shiny app to have a slider to be able to choose the specific year and view it. I got the slider to work and change the data and when you first run it works and gives you the appropriate state and number. However, when you move around the slider the geospatial labels start moving around using the reactive and different states start getting different states labels. Like the following:
The slider starts at the year 2000 and as you can see the if I move it around it, in this case 2014, now we have florida being labeled as Montana.
All these was done within the R shiny app. This is the code I have below. I have my leaflet map fully created outside the server.
server <- function(input, output) {
#Set YEAR with Slider
state_parole_year <- reactive({
state_parole %>%
filter(year == year(input$year))
})
labels_year <- reactive({paste("Parole/100000 US Adults",
state_parole_year()$state, state_parole_year()$number_on_parole_per_100000_us_adult_residents)})
output$mymap <- renderLeaflet({
state_map %>%
addTiles()%>%
addPolygons(fillColor = ~ pal(state_parole_year()$number_on_parole_per_100000_us_adult_residents),
fillOpacity = 1,
color = "blue",
opacity = 0.1,
weight = 1,
highlight = highlightOptions(
weight = 3,
color = "blue",
fillOpacity = .2,
bringToFront = TRUE),
label = labels_year())
})
}
When I run the leaflet map outside of r shiny app and change the year manually by subsetting the csv it works perfectly. The problem occurs when I try to make the labels reactive to the slider. Does someone know how I can fix the problem? Thanks!
The problem is that you build the map on unfiltered data, then display it with filtered data. There is then a switch in factors.
A quick fix is to build your map on filtered data, directly in the server() function :
output$mymap <- renderLeaflet({
leaflet(data = state_parole_year()) %>%
addTiles() %>%
setView(lng = -80,
lat = 34.5,
zoom = 4) %>%
addPolygons(fillColor = ~ pal(state_parole$number_on_parole_per_100000_us_adult_residents),
fillOpacity = 1,
color = "blue",
opacity = 0.1,
weight = 1,
highlight = highlightOptions(
weight = 3,
color = "blue",
fillOpacity = .2,
bringToFront = TRUE),
label = labels) %>%
addLegend(
position = "topright",
pal = pal,
values = ~number_on_parole_per_100000_us_adult_residents,
title = "# of U.S. Adults on Parole/100000.",
opacity = 1) %>%
addTiles()%>%
addPolygons(fillColor = ~ pal(state_parole_year()$number_on_parole_per_100000_us_adult_residents),
fillOpacity = 1,
color = "blue",
opacity = 0.1,
weight = 1,
highlight = highlightOptions(
weight = 3,
color = "blue",
fillOpacity = .2,
bringToFront = TRUE),
label = ~labels_year())
})

R leaflet map - Change legends based on selected layer group

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

How to "addTiles" on top of "addPolygons" in R's Leaflet?

How do you set the layer order in R's leaflet package so that tiles show up on top of polygons filled with color?
Here's what I've got so far:
require(leaflet)
require(acs)
require(tigris)
require(rgdal)
census.income.end.year = 2015
county = 17
nd.counties=acs.fetch(geography=geo.make(state="ND", county=county),
table.number="B01003", endyear = 2015)
tracts <- tigris::tracts(state = 'ND', county = county, cb=FALSE, year = 2015)
# create a geographic set to grab tabular data (acs)
geo<-geo.make(state=c("ND"),
county = county,
tract="*")
# add in median income
median.income <- acs.fetch(endyear = census.income.end.year,
geography = geo,
variable = c("B19013_001"))
income_df <- data.frame(paste0(as.character(median.income#geography$state),
str_pad(as.character(median.income#geography$county), 3, 'left', '0'),
str_pad(as.character(median.income#geography$tract), 5, 'left', '0')),
median.income#estimate)
rownames(income_df)<-1:nrow(income_df)
names(income_df)<-c("GEOID", "hhincome")
income_merged <- geo_join(tracts, income_df, "GEOID", "GEOID")
income_merged <- spTransform(income_merged, CRS("+init=epsg:4326"))
qpal <- colorQuantile("plasma", income_df$hhincome, n = 4)
leaflet() %>%
setView( -96.7898, 46.8772, zoom=11) %>%
addPolygons(data = income_merged,
fillColor = qpal(income_merged$hhincome),
fillOpacity = 1,
weight = 0.3) %>%
addProviderTiles(providers$Hydda.RoadsAndLabels)
Ultimately, I'ld like to do this with addTiles (instead of addProviderTiles as in the above code) using a custom MapBox, but I can't figure out how to make that reproducible for this example... given that you need a key to access custom MapBox tiles (BTW, I've created a custom MapBox tile that should be transparent except for roads and labels, so the underlying polygons should "show thru.")
Here is one way to do add a tile on top of a circle with the non-R version of leaflet: http://jsfiddle.net/dcu9pz2w/, but I don't see how to make that work in my context. I think adding "panes" may be the way to go, but I don't see that functionality in R leaflet. Also, I explored z-index values, but that seemed to be a dead end.
Any help is much appreciated!
R leaflet now includes addMapPane function. The solution to this problem is to first set up pane order and then add tiles/polygons. Reproducible example:
library(leaflet)
library(geojsonio)
# get polygon data
# https://github.com/simonepri/geo-maps/blob/master/info/countries-land.md
world <- geojson_read(
"https://github.com/simonepri/geo-maps/releases/download/v0.6.0/countries-land-10km.geo.json",
what = "sp"
)
# generate random values
world#data$value <- runif(nrow(world#data))
# get color palette
color_pal <- colorNumeric(palette = "YlOrRd", domain = NULL)
# get leaflet map
leaflet() %>%
setView(lat = 50, lng = 15, zoom = 4) %>%
addMapPane("background_map", zIndex = 410) %>% # Level 1: bottom
addMapPane("polygons", zIndex = 420) %>% # Level 2: middle
addMapPane("labels", zIndex = 430) %>% # Level 3: top
addProviderTiles(
providers$Esri.WorldTerrain,
options = pathOptions(pane = "background_map")
) %>%
addPolygons(
data = world, stroke = FALSE, smoothFactor = 0.2,
fillOpacity = 0.6, fillColor = ~color_pal(value),
options = pathOptions(pane = "polygons")
) %>%
addProviderTiles(
providers$Stamen.TonerLabels,
options = pathOptions(pane = "labels")
)

Change color of leaflet marker

Is there anyway to change the color of leaflet marker base on the value of some variable. In the following map, for example, I wish to assign marker color based on mag variable:
library(leaflet)
data(quakes)
# Show first 20 rows from the `quakes` dataset
leaflet(data = quakes[1:20,]) %>% addTiles() %>%
addMarkers(~long, ~lat, popup = ~as.character(mag))
I often use the circle markers because you can change both the size and color based on other variables. For example, I have created a binned variable from a continuous using the following code:
# first cut the continuous variable into bins
# these bins are now factors
last$BeatHomeLvl <- cut(last$BeatHome,
c(0,.5,1,2,3,5,100), include.lowest = T,
labels = c('<.5x', '.5-1x', '1-2x', '2-3x', '3-5x','5x+'))
# then assign a palette to this using colorFactor
# in this case it goes from red for the smaller values to yellow and green
# standard stoplight for bad, good, and best
beatCol <- colorFactor(palette = 'RdYlGn', last$BeatHomeLvl)
When you plot it, I use the code for circle markers. The radius/area of the circle is based on the actual value of the factor and then color is assigned according to the bins.
m1 <- leaflet() %>%
addTiles() %>%
addProviderTiles(providers$OpenStreetMap, group = 'Open SM') %>%
addProviderTiles(providers$Stamen.Toner, group = 'Toner') %>%
addProviderTiles(providers$Esri.NatGeoWorldMap, group = 'NG World') %>%
setView(lng = -72, lat = 41, zoom = 8) %>%
addCircleMarkers(data = Jun, lat = ~Lat, lng = ~Lon,
color = ~beatCol(BeatHomeLvl), popup = Jun$Popup,
radius = ~sqrt(BeatHome*50), group = 'Home - Jun') %>%
At the end of your code add a legend. I added some formatting.
addLegend('bottomright', pal = beatCol, values = last$BeatHomeLvl,
title = 'Compare Home<br>Quote Count to<br>3Mos State Avg',
opacity = 1)
This gives you color-coded and sized circles based on a variable and a nice legend.
As far as I know, you need to assign an image file to one level of icon. For instance, if you have three levels in magnitude in the earthquake data, you need to create an icon list with three image paths. Then, you can have three different colors in markers. At least, the following example is getting closer to what you want. I edited a png file and created three png files. You need to specify the paths of the file when you make an icon list.
library(dplyr)
library(leaflet)
mutate(quakes, group = cut(mag, breaks = c(0, 5, 6, Inf), labels = c("blue", "green", "orange"))) -> mydf
### I edit this png file and created my own marker.
### https://raw.githubusercontent.com/lvoogdt/Leaflet.awesome-markers/master/dist/images/markers-soft.png
quakeIcons <- iconList(blue = makeIcon("/Users/jazzurro/Documents/Stack Overflow/blue.png", iconWidth = 24, iconHeight =32),
green = makeIcon("/Users/jazzurro/Documents/Stack Overflow/green.png", iconWidth = 24, iconHeight =32),
orange = makeIcon("/Users/jazzurro/Documents/Stack Overflow/orange.png", iconWidth = 24, iconHeight =32))
leaflet(data = mydf[1:100,]) %>%
addTiles() %>%
addMarkers(icon = ~quakeIcons[group])
This one worked for me:
Source: https://github.com/bhaskarvk/leaflet/blob/master/inst/examples/awesomeMarkers.R
library(leaflet)
icon.glyphicon <- makeAwesomeIcon(icon= 'flag', markerColor = 'blue', iconColor = 'black')
icon.fa <- makeAwesomeIcon(icon = 'flag', markerColor = 'red', library='fa', iconColor = 'black')
icon.ion <- makeAwesomeIcon(icon = 'home', markerColor = 'green', library='ion')
# Marker + Label
leaflet() %>% addTiles() %>%
addAwesomeMarkers(
lng=-118.456554, lat=34.078039,
label='This is a label',
icon = icon.glyphicon)
leaflet() %>% addTiles() %>%
addAwesomeMarkers(
lng=-118.456554, lat=34.078039,
label='This is a label',
icon = icon.fa)
leaflet() %>% addTiles() %>%
addAwesomeMarkers(
lng=-118.456554, lat=34.078039,
label='This is a label',
icon = icon.ion)
# Marker + Static Label using custom label options
leaflet() %>% addTiles() %>%
addAwesomeMarkers(
lng=-118.456554, lat=34.078039,
label='This is a static label',
labelOptions = labelOptions(noHide = T),
icon = icon.fa)
Why not use vector markers based on svg (here is one example implementation - https://github.com/hiasinho/Leaflet.vector-markers) that you can apply any fill color you want to? Instead of having to create a large amount of static image files. Some code involved, yes, but a lot more flexible.
L.Marker uses images (one for the marker, one for the shadow) so that's not possible. You can however use your own images, there's a good write up on the topic among the tutorials on the Leaflet site:
http://leafletjs.com/examples/custom-icons.html

Resources