I am working on building weighted cycle networks in R. In addition to the physical distance of each road segment, I want to incorporate other factors (such as road type, traffic stress, or bike infrastructure) to assign weights to each road segment. Ideally, these weights will influence route prioritisation in the network analysis.
I initially considered using the dodgr package, but it seems to lack support for assigning individual weighting scores to each edge in the network. Are there any R packages that allow me to build networks where each edge can be assigned a custom weight based on various attributes, and then perform route analysis prioritising these weights?
The data is hosted here
# import libraries
library(sf)
library(dplyr)
library(tidyverse)
library(tmap)
library(dodgr)
library(here)
# read in cycleable roads
edges <- st_read(here::here('data', 'sf_bike_london.gpkg'), layer = "edges") %>% st_transform(., 27700)
# Create a new 'road_score' column based on the 'highway' quality
edges <- edges %>%
mutate(road_score = case_when(
highway == 'motorway' ~ 0,
highway == 'trunk' ~ 0.3,
highway == 'primary' ~ 0.7,
highway == 'secondary' ~ 0.8,
highway == 'tertiary' ~ 0.9,
highway == 'unclassified' ~ 0.9,
highway == 'residential' ~ 0.9,
highway == 'service' ~ 0.9,
highway == 'services' ~ 0.9,
highway == 'track' ~ 0.9,
highway == 'cycleway' ~ 1,
highway == 'cycleway way' ~ 1,
highway == 'path' ~ 0.9,
highway == 'steps' ~ 0.5,
highway == 'ferry' ~ 0.2,
highway == 'living_street' ~ 0.95,
highway == 'bridleway' ~ 0.7,
highway == 'footway' ~ 0.9,
highway == 'pedestrian' ~ 0.8,
highway == 'motorway_link' ~ 0,
highway == 'trunk_link' ~ 0.3,
highway == 'primary_link' ~ 0.7,
highway == 'secondary_link' ~ 0.8,
highway == 'tertiary_link' ~ 0.9,
highway == 'track' ~ 0.9,
highway == 'road' ~ 0.5,
highway == 'no' ~ 0,
highway == 'elevator' ~ 0.7,
highway == 'proposed' ~ 0.5,
highway == 'busway' ~ 0, # bus only
highway == 'raceway' ~ 0, # race track for motorised racing
highway == 'corridor' ~ 0.7,
highway == 'rest_area' ~ 0.8,
highway == 'construction' ~ 0,
highway == 'disused' ~ 0,
TRUE ~ NA_real_ # Assign NA for all other values
))
# check NA values - there are 0 values
sum(is.na(edges$road_score))
# define a function
lane_score <- function(lanes) {
score <- ifelse(lanes > 4, 0.2,
ifelse(lanes == 4, 0.4, NA))
return(score)
}
# create lts column
edges$lts <- NA
# apply the function
edges <- edges %>%
mutate(
lts = if_else(
is.na(lts), # Apply only if lts is NA
lane_score(lanes), # Apply speed_score function
lts # Keep the original lts value if it's not NA
)
)
# final weight
edges <- edges %>%
mutate(value = road_score * lts)
# first 5 rows
head(edges)
Simple feature collection with 6 features and 45 fields
Geometry type: LINESTRING
Dimension: XY
Bounding box: xmin: 524912.4 ymin: 190203 xmax: 526326 ymax: 192518
Projected CRS: OSGB36 / British National Grid
access area bicycle bridge busway cycleway est_width foot footway highway int_ref
1 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> primary <NA>
2 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> primary <NA>
3 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> primary <NA>
4 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> primary <NA>
5 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> primary <NA>
6 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> primary <NA>
junction lanes lit maxspeed motorcar motorroad motor_vehicle name oneway
1 <NA> <NA> yes 30 mph <NA> <NA> <NA> Ballards Lane <NA>
2 <NA> <NA> yes 30 mph <NA> <NA> <NA> High Road <NA>
3 <NA> <NA> yes 30 mph <NA> <NA> <NA> High Road <NA>
4 <NA> <NA> yes 30 mph <NA> <NA> <NA> East End Road <NA>
5 <NA> <NA> yes 30 mph <NA> <NA> <NA> East End Road <NA>
6 <NA> <NA> yes 30 mph <NA> <NA> <NA> East End Road <NA>
overtaking path passing_places psv ref service segregated sidewalk smoothness
1 <NA> <NA> <NA> <NA> A598 <NA> <NA> right <NA>
2 <NA> <NA> <NA> <NA> A1000 <NA> <NA> both <NA>
3 <NA> <NA> <NA> <NA> A1000 <NA> <NA> both <NA>
4 <NA> <NA> <NA> <NA> A504 <NA> <NA> <NA> <NA>
5 <NA> <NA> <NA> <NA> A504 <NA> <NA> <NA> <NA>
6 <NA> <NA> <NA> <NA> A504 <NA> <NA> <NA> <NA>
surface tracktype tunnel turn width id timestamp version tags
1 asphalt <NA> <NA> <NA> <NA> 74 1680812417 10 {"visible":false}
2 <NA> <NA> <NA> <NA> <NA> 75 1690031606 12 {"visible":false}
3 <NA> <NA> <NA> <NA> <NA> 75 1690031606 12 {"visible":false}
4 <NA> <NA> <NA> <NA> <NA> 79 1501177066 28 {"visible":false}
5 <NA> <NA> <NA> <NA> <NA> 79 1501177066 28 {"visible":false}
6 <NA> <NA> <NA> <NA> <NA> 79 1501177066 28 {"visible":false}
osm_type u v length geom road_score lts
1 way 196101 2121445348 18.112 LINESTRING (525236.4 190755... 0.7 0.6
2 way 196055 1030634587 54.719 LINESTRING (526324.4 192518... 0.7 0.6
3 way 1030634587 196056 6.789 LINESTRING (526325.7 192463... 0.7 0.6
4 way 196108 574308734 20.641 LINESTRING (524912.4 190235... 0.7 0.6
5 way 574308734 573668313 18.927 LINESTRING (524927.1 190220... 0.7 0.6
6 way 573668313 574308735 16.053 LINESTRING (524943.4 190211... 0.7 0.6
value
1 0.42
2 0.42
3 0.42
4 0.42
5 0.42
6 0.42
This is what I have done so far. Any suggestion will be much appreciated.
2