Create dynamic number of leaflet layergroups from geojson data - r

Question

intro
I am pretty agile in R, but my java skills are non-existent. Therefor I'm throwing myself at your mercy to answer this, hopefully not too complex, question (or I will have a hard time figuring out the answers ;-)).
Running the code below requires you to download three leaflet plugins from github (links in the comments inside the code). They should be placed in a folder ./script, relative to where you are running the code.
sample data
I have excel-sheets with multiple routes. For sake of simplicity, I already read in a file using the following code, so I do not have to share the excel-file online:
# read excel file
bestand <- "./data/CBM_Schuttorf_Buren.xlsx"
bladen <- readxl::excel_sheets(bestand)
xldata <- lapply(bladen, function(x) {
readxl::read_excel(path = bestand, sheet = x,
col_types = c(rep(c("numeric", "text"), 2), rep("numeric", 2)))
})
names(xldata) <- bladen
This results in the following object, which you will need to continue the code with
bladen <- c("A1L", "A1R")
xldata <- list(A1L = structure(list(route = c(1, 1, 2, 2, 2, 3, 3, 3),
routeType = c("stremming", "stremming", "omleiding", "omleiding",
"omleiding", "omleiding", "omleiding", "omleiding"), punt = c(1,
2, 1, 2, 3, 1, 2, 3), puntType = c("start", "eind", "start",
"via", "eind", "start", "via", "eind"), lat = c(52.341823,
52.284989, 52.340234, 52.193045, 52.302415, 52.349596, 52.193045,
52.302415), lon = c(7.254037, 6.74575, 7.271095, 7.102321,
6.715246, 7.258845, 7.102321, 6.715246)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -8L)), A1R = structure(list(
route = c(1, 1, 2, 2, 2, 3, 3, 3), routeType = c("stremming",
"stremming", "omleiding", "omleiding", "omleiding", "omleiding",
"omleiding", "omleiding"), punt = c(1, 2, 1, 2, 3, 1, 2,
3), puntType = c("start", "eind", "start", "via", "eind",
"start", "via", "eind"), lat = c(52.284267, 52.341886, 52.303024,
52.19279, 52.354846, 52.303024, 52.19279, 52.339145), lon = c(6.754951,
7.251379, 6.713831, 7.104181, 7.258402, 6.713831, 7.104181,
7.285606)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-8L)))
my problem
The sample data is a simplified issue. There are only two list entries, A1L and A1R. In my production data there will be many more entries.
What i want as a result, is a dynamic version of the code below. Here I hardcoded the Layergroups A1L and A1R everywhere. ButWhile this works as a proof-of-concept, this is not workable in production.
As mentioned before, I need the functionality of several leaflet pluging, so I relied heavily on the htmlwidgets::onRender()- funciton to get down what I need. This is also my Achilles-heel, since I am a complete n00b in javascript.
desired output
I am open for all suggestions that can replicate the results of the code below, without hardcoding the filtering/Layergroups..
note: the arrows on the end of the polyline only show when the leaflet is shown in the browser. They do not show inside the rstudio viewer (took me some frustration to find that one out ;-) )
click here for my output
my code
library(tidyverse)
library(readxl)
library(osrm)
library(leaflet)
library(geojsonsf)
# below commented out, xldata is already provided
# # read excel file
# bestand <- "./data/myfile.xlsx"
# bladen <- readxl::excel_sheets(bestand)
# xldata <- lapply(bladen, function(x) {
# readxl::read_excel(path = bestand, sheet = x,
# col_types = c(rep(c("numeric", "text"), 2), rep("numeric", 2)))
# })
# names(xldata) <- bladen
# split individual routes (will become polylines later on)
routes <- lapply(xldata, function(x) split(x, f = x$route))
# create real routes, using osm routing
df <-
dplyr::bind_rows(
lapply(seq.int(routes), function(i) {
dplyr::bind_rows(
lapply(seq.int(lengths(routes)[i]), function(j) {
temp <- osrmRoute(loc = as.data.frame(routes[[i]][[j]][, c("lon", "lat")]),
overview = "full", returnclass = "sf") %>%
mutate(naam = paste0(bladen[i], "_", routes[[i]][[j]][1,2], routes[[i]][[j]][1,1])) %>%
mutate(groep = bladen[i]) %>%
mutate(groepVol = paste0("groups.",bladen[i])) %>%
mutate(type = ifelse(grepl("stremming", naam), "stremming", "omleiding"))
}))
})
)
df
# get boundaries for map
grens <- sf::st_bbox(df) %>% as.vector()
# create named list of geojson routes
plotdata <- lapply(split(df, f = df$naam), sf_geojson)
# PLUGIN SECTION
# from: https://github.com/slutske22/leaflet-arrowheads
arrowHead <- htmlDependency(
"leaflet-arrowheads",
"0.1.2",
src = normalizePath(".\\script"),
#src = "./script",
script = "leaflet-arrowheads.js"
)
# from https://github.com/makinacorpus/Leaflet.GeometryUtil
geometryutil <- htmlDependency(
"leaflet.geometryutil",
"0.1.2",
src = normalizePath(".\\script"),
#src = "./script",
script = "leaflet.geometryutil.js"
)
registerPlugin <- function(map, plugin) {
map$dependencies <- c(map$dependencies, list(plugin))
map
}
# plot the map and layers
leaflet() %>%
#register plugins
registerPlugin(arrowHead) %>%
registerPlugin(geometryutil) %>%
# add basemap
addProviderTiles(providers$CartoDB.Positron) %>%
# set map boundaries
fitBounds( grens[1], grens[2], grens[3], grens[4]) %>%
onRender("function(el, x, data) {
// funciton to define line color based on
// feature.properties.type
function getColor(d) {
return d == 'stremming' ? 'red' :
d == 'omleiding' ? 'seagreen' :
'black';
}
// funciton to define line dash based on
// feature.properties.type
function getDash(d) {
return d == 'stremming' ? '20' :
d == 'omleiding' ? '' :
'';
}
// function to set style of polylines
function newstyle(feature) {
return {
color: getColor(feature.properties.type),
weight: 10,
opacity: 1,
dashArray: getDash(feature.properties.type),
fillOpacity: 0.7
};
}
///////////////////////////////////////
//would like to make the code below this dynamic
//based on the groep-property in the JSON object
//so A1L and A1R groups (and thereby the filtering)
//are read in directly from the data object df
///////////////////////////////////////
// filtering
function A1L(feature) {if (feature.properties.groep === 'A1L') return true}
function A1R(feature) {if (feature.properties.groep === 'A1R') return true}
// crteation of layergroups
var groups = {
A1L: new L.LayerGroup(),
A1R: new L.LayerGroup()
};
// create layers and add to groups
var A1L = L.geoJSON(data, {
filter: A1L,
style: newstyle,
arrowheads: {frequency: 'endonly', yawn: 45, size: '30px', fill: true}
})
.on('mouseover', function (e) {e.target.setStyle({weight: 15, opacity: 1 });})
.on('mouseout', function (e) {e.target.setStyle({weight: 10, opacity: 0.75});})
.addTo(groups.A1L);
var A1R = L.geoJSON(data, {
filter: A1R,
style: newstyle,
arrowheads: {frequency: 'endonly', yawn: 45, size: '30px', fill: true}
})
.on('mouseover', function (e) {e.target.setStyle({weight: 15, opacity: 1 });})
.on('mouseout', function (e) {e.target.setStyle({weight: 10, opacity: 0.75});})
.addTo(groups.A1R);
var baseLayers = {
'A1L': A1L,
'A1R': A1R
};
var layerControl = L.control.layers(baseLayers, null, {collapsed: false}).addTo(this);
baseLayers['A1L'].addTo(this);
}", data = sf_geojson(df))
what I have tried so far
I found something that might be the solution here, but I lack the java skills to:
see if this is indeed the way to go, and if so:
how can this be implementd inside my code.

Answer 1

After >1 day of fruitless effort, I finally found an answer I could work with.
It is now working as desired, here is my answer for anyone looking for this possibility (and I found some in the past 24 h ;-) )
# plot the map and layers
leaflet() %>%
#register plugins
registerPlugin(arrowHead) %>%
registerPlugin(geometryutil) %>%
registerPlugin(groupedlayercontrol) %>%
# add basemap
addProviderTiles(providers$CartoDB.Positron) %>%
# set map boundaries
fitBounds( grens[1], grens[2], grens[3], grens[4]) %>%
onRender("function(el, x, data) {
// read data from the named list passd to onRender
// data.name_from_list
var routes = data.routes;
var groups = data.groups;
var types = groups;
// function to define line color based on
// feature.properties.type
function getColor(d) {
return d == 'stremming' ? 'red' :
d == 'omleiding' ? 'seagreen' :
'black';
}
// funciton to define line dash based on
// feature.properties.type
function getDash(d) {
return d == 'stremming' ? '20' :
d == 'omleiding' ? '' :
'';
}
// function to set style of polylines
function newstyle(feature) {
return {
color: getColor(feature.properties.type),
weight: 10,
opacity: 1,
dashArray: getDash(feature.properties.type),
fillOpacity: 0.7
};
}
// layerControl optioesn for groupedOverlays
var options = {
exclusiveGroups: ['Stremming'],
groupCheckboxes: false,
collapsed: false
};
// add empty layercontrol
var layerControl = L.control.groupedLayers(null, null, options).addTo(this);
// iterate over types, filter by that type, and format the layer for that feature type
types.forEach(function(type) {
var layer = L.geoJson(routes, {
filter: function(feature, layer) {
return feature.properties.groep == type;
},
style: newstyle,
arrowheads: {frequency: 'endonly', yawn: 45, size: '30px', fill: true}
})
.on('mouseover', function (e) {e.target.setStyle({weight: 15, opacity: 1 });})
.on('mouseout', function (e) {e.target.setStyle({weight: 10, opacity: 0.75});})
// all done with the layer, add it to the control
layerControl.addOverlay(layer, type, 'Stremming');
});
}", data = list(routes = sf_geojson(df), groups = bladen))