Something went wrong. Try again.
Distances on Directed Graphs in R
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307# script to generate `data/hampi.rda`
```{r load, echo = FALSE}library (magrittr)library (osmdata)``````{r}hampi <- opq ("hampi india") %>% add_osm_feature (key = "highway") %>% osmdata_sf (quiet = FALSE) %>% osm_poly2line () %>% extract2 ("osm_lines")```Then need to get rid of columns, especially the ones with Kannada names whichare non-UTF8```{r}nms <- c ("osm_id", "bicycle", "covered", "foot", "highway", "incline", "motorcar", "motorcycle", "motor_vehicle", "oneway", "surface", "tracktype", "tunnel", "width", "geometry")hampi <- hampi [, match (nms, names (hampi))]``````{r}usethis::use_data (hampi, overwrite = TRUE, compress = 'xz')```
# generate `data/weight_profiles`
additional values from OSRM profiles athttps://github.com/Project-OSRM/osrm-backend/blob/master/profiles/
```{r}library (magrittr)theurl <- "https://www.routino.org/xml/routino-profiles.xml"dat <- xml2::read_html (theurl) %>% rvest::html_nodes("profile") %>% xml2::as_list ()```
### initial routino profiles
```{r}weighting_profiles <- lapply (dat, function (i) { di <- i$preferences res <- lapply (di, function (j) c (attr (i, "name"), attr (j, "highway"), attr (j, "percent"))) do.call (rbind, res) })# Then add living_street, bridleway, and footway to all profiles# https://wiki.openstreetmap.org/wiki/Tag:highway%3Dliving_streetnms <- sapply (weighting_profiles, function (i) i [1, 1])
# living_street footway bridleway# "foot" 95 100 100# "horse" 80 100 100# "wheelchair" 95 100 50# "bicycle" 95 90 70# "moped" 60 0 0# "motorcycle" 50 0 0# "motorcar" 40 0 0# "goods" 30 0 0# "hgv" 30 0 0# "psv" 30 0 0
wt_ls <- c (95, 80, 95, 95, 60, 50, 40, 30, 30, 30) # living streetwt_br <- c (100, 100, 50, 70, 0, 0, 0, 0, 0, 0) # bridlewaywt_fw <- c (100, 100, 100, 90, 0, 0, 0, 0, 0, 0) # footwaywt_ped <- c (100, 20, 100, 80, 0, 0, 0, 0, 0, 0) # pedestriannames (wt_ls) <- names (wt_br) <- names (wt_fw) <- names (wt_ped) <- nmsnewrows <- data.frame ("living_street" = wt_ls, "bridleway" = wt_br, "footway" = wt_fw, "pedestrian" = wt_ped)weighting_profiles <- lapply (weighting_profiles, function (i) { newdat <- t (newrows [rownames (newrows) == i [1, 1], ]) newdat <- cbind (i [seq (ncol (newrows)), 1], rownames (newdat), newdat [, 1]) rbind (i, newdat) })
# plus all of the "link" types defaulting to same as parent entitieslinks <- c ("motorway", "trunk", "primary", "secondary", "tertiary")nms <- paste0 (links, "_link")weighting_profiles <- lapply (weighting_profiles, function (i) { index <- match (links, i [, 2]) newrows <- cbind (i [index, 1], nms, i [index, 3]) res <- rbind (i, newrows) rownames (res) <- rep ("preference", nrow (res)) return (res) })
weighting_profiles <- do.call (rbind, weighting_profiles)weighting_profiles <- data.frame (name = weighting_profiles [, 1], way = weighting_profiles [, 2], value = as.numeric (weighting_profiles [, 3]), stringsAsFactors = FALSE)
# bike: steps is set to 0, but here increased to 50; foot:steps = 80weighting_profiles$value [weighting_profiles$name == "bicycle" & weighting_profiles$way == "steps"] <- 50```
### speeds from OSRM
```{r}ways <- weighting_profiles$way [weighting_profiles$name == "foot"]speeds <- rep (NA, length (ways))weighting_profiles$max_speed <- NA_real_# car, from# https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/car.luaspeeds [ways == "motorway"] <- 90speeds [ways == "trunk"] <- 85speeds [ways == "primary"] <- 65speeds [ways == "secondary"] <- 55speeds [ways == "tertiary"] <- 40speeds [ways == "unclassified"] <- 25speeds [ways == "residential"] <- 25speeds [ways == "service"] <- 15speeds [ways == "track"] <- NA_real_speeds [ways == "cycleway"] <- NA_real_speeds [ways == "path"] <- NA_real_speeds [ways == "steps"] <- NA_real_speeds [ways == "ferry"] <- NA_real_speeds [ways == "living_street"] <- 10speeds [ways == "bridleway"] <- NA_real_speeds [ways == "footway"] <- NA_real_speeds [ways == "motorway_link"] <- 45speeds [ways == "trunk_link"] <- 40speeds [ways == "primary_link"] <- 30speeds [ways == "secondary_link"] <- 25speeds [ways == "tertiary_link"] <- 20
weighting_profiles$max_speed [weighting_profiles$name == "motorcar"] <- speedsweighting_profiles$max_speed [weighting_profiles$name == "goods"] <- speedsweighting_profiles$max_speed [weighting_profiles$name == "hgv"] <- speedsweighting_profiles$max_speed [weighting_profiles$name == "psv"] <- speedsweighting_profiles$max_speed [weighting_profiles$name == "motorcycle"] <- speeds
# moped; simply reduce max speeds to 50speeds [speeds > 50] <- 50weighting_profiles$max_speed [weighting_profiles$name == "moped"] <- speeds
# bicycle, from # https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/bicycle.luaspeeds <- rep (15, length (ways))speeds [ways == "motorway"] <- NA_real_speeds [ways == "trunk"] <- NA_real_speeds [ways == "motorway_link"] <- NA_real_speeds [ways == "trunk_link"] <- NA_real_speeds [ways == "track"] <- 12speeds [ways == "path"] <- 12speeds [ways == "steps"] <- 4speeds [ways == "bridleway"] <- 8speeds [ways == "footway"] <- 4speeds [ways == "pedestrian"] <- 4weighting_profiles$max_speed [weighting_profiles$name == "bicycle"] <- speeds
# wheelchairspeeds <- rep (5, length (ways))speeds [ways == "motorway"] <- NA_real_speeds [ways == "trunk"] <- NA_real_speeds [ways == "motorway_link"] <- NA_real_speeds [ways == "trunk_link"] <- NA_real_speeds [ways == "track"] <- 2speeds [ways == "steps"] <- NA_real_speeds [ways == "bridleway"] <- NA_real_speeds [ways == "footway"] <- 4speeds [ways == "pedestrian"] <- 4weighting_profiles$max_speed [weighting_profiles$name == "wheelchair"] <- speeds
# horsespeeds <- rep (6.4, length (ways))speeds [ways == "motorway"] <- NA_real_speeds [ways == "trunk"] <- NA_real_speeds [ways == "motorway_link"] <- NA_real_speeds [ways == "trunk_link"] <- NA_real_speeds [ways == "steps"] <- 2weighting_profiles$max_speed [weighting_profiles$name == "horse"] <- speeds
# footspeeds <- rep (5, length (ways))speeds [ways == "motorway"] <- NA_real_speeds [ways == "trunk"] <- NA_real_speeds [ways == "motorway_link"] <- NA_real_speeds [ways == "trunk_link"] <- NA_real_speeds [ways == "steps"] <- 2weighting_profiles$max_speed [weighting_profiles$name == "foot"] <- speeds```
### Surfaces
Max speeds for different kinds of surfaces, from OSRMhttps://github.com/Project-OSRM/osrm-backend/tree/master/profiles```{r}s <- rbind (c ("motorcar", "surface", "cement", 80), c ("motorcar", "surface", "compacted", 80), c ("motorcar", "surface", "fine_gravel", 80), c ("motorcar", "surface", "paving_stones", 60), c ("motorcar", "surface", "metal", 60), c ("motorcar", "surface", "bricks", 60), c ("motorcar", "surface", "grass", 40), c ("motorcar", "surface", "wood", 40), c ("motorcar", "surface", "sett", 40), c ("motorcar", "surface", "grass_paver", 40), c ("motorcar", "surface", "gravel", 40), c ("motorcar", "surface", "unpaved", 40), c ("motorcar", "surface", "ground", 40), c ("motorcar", "surface", "dirt", 40), c ("motorcar", "surface", "pebblestone", 40), c ("motorcar", "surface", "tartan", 40), c ("motorcar", "surface", "cobblestone", 30), c ("motorcar", "surface", "clay", 30), c ("motorcar", "surface", "earth", 20), c ("motorcar", "surface", "stone", 20), c ("motorcar", "surface", "rocky", 20), c ("motorcar", "surface", "sand", 20), c ("motorcar", "surface", "mud", 10),
c ("bicycle", "surface", "cobblestone:flattened", 10), c ("bicycle", "surface", "paving_stones", 10), c ("bicycle", "surface", "compacted", 10), c ("bicycle", "surface", "cobblestone", 6), c ("bicycle", "surface", "unpaved", 6), c ("bicycle", "surface", "fine_gravel", 6), c ("bicycle", "surface", "gravel", 6), c ("bicycle", "surface", "pebblestone", 6), c ("bicycle", "surface", "ground", 6), c ("bicycle", "surface", "dirt", 6), c ("bicycle", "surface", "earth", 6), c ("bicycle", "surface", "grass", 6), c ("bicycle", "surface", "mud", 3), c ("bicycle", "surface", "sand", 3), c ("bicycle", "surface", "sett", 10),
c ("foot", "surface", "fine_gravel", 4), c ("foot", "surface", "gravel", 4), c ("foot", "surface", "pebblestone", 4), c ("foot", "surface", "mud", 2), c ("foot", "surface", "sand", 2))surface_speeds <- data.frame ("name" = s [, 1], "key" = s [, 2], "value" = s [, 3], "max_speed" = as.numeric (s [, 4]), stringsAsFactors = FALSE) ```
### traffic light and turn penalties
These are calculated in OSRM based on turn angles. The `dodgr` algorithm usesturn ordering across traffic, and so only needs to implement a fixed trafficlight waiting time cost. The equivalent values can be obtained from the OSRMprofiles with a turn angle of 0 as:```{r traffic-light-penalties, eval = FALSE}traffic_light_penalty <- 2turn_duration = traffic_light_penaltyturn_bias <- 1.075 # carturn_duration <- turn_duration + 6.5 / turn_bias # = 8
# for both bike and car:turn_duration <- traffic_light_penalty # = 2```
```{r}nms <- unique (weighting_profiles$name)#nms <- c ("foot", "horse", "wheelchair", "bicycle", "moped", "motorcycle",# "motorcar", "goods", "hgv", "psv")traffic_lights <- rep (8, length (nms))traffic_lights [nms %in% c ("foot", "wheelchair", "bicycle")] <- 2turn_penalty <- rep (7.5, length (nms))turn_penalty [nms %in% c ("foot", "horse", "wheelchar")] <- 0turn_penalty [nms == "bicycle"] <- 6penalties <- data.frame ("name" = nms, "traffic_lights" = traffic_lights, "turn" = turn_penalty, stringsAsFactors = FALSE)penalties$restrictions <- TRUEindex <- which (penalties$name %in% c ("foot", "horse", "wheelchair", "bicycle"))penalties$restrictions [index] <- FALSE```
Note that the following link describes waiting times at traffic lights with anaverage value of 40s:http://dx.doi.org/10.1016/j.trb.2013.02.002see also National Assoc. City Transportation Officials guidelines:https://nacto.org/publication/urban-street-design-guide/intersection-design-elements/traffic-signals/signal-cycle-lengths/recommended "Short cycle length" of 60-90 seconds
### save the data:
```{r}# change percentage value to 0-1weighting_profiles$value <- weighting_profiles$value / 100weighting_profiles <- list ("weighting_profiles" = weighting_profiles, "surface_speeds" = surface_speeds, "penalties" = penalties)usethis::use_data (weighting_profiles, overwrite = TRUE, compress = 'xz')```