# 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 which are 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 at https://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_street nms <- 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 street wt_br <- c (100, 100, 50, 70, 0, 0, 0, 0, 0, 0) # bridleway wt_fw <- c (100, 100, 100, 90, 0, 0, 0, 0, 0, 0) # footway wt_ped <- c (100, 20, 100, 80, 0, 0, 0, 0, 0, 0) # pedestrian names (wt_ls) <- names (wt_br) <- names (wt_fw) <- names (wt_ped) <- nms newrows <- 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 entities links <- 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 = 80 weighting_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.lua speeds [ways == "motorway"] <- 90 speeds [ways == "trunk"] <- 85 speeds [ways == "primary"] <- 65 speeds [ways == "secondary"] <- 55 speeds [ways == "tertiary"] <- 40 speeds [ways == "unclassified"] <- 25 speeds [ways == "residential"] <- 25 speeds [ways == "service"] <- 15 speeds [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"] <- 10 speeds [ways == "bridleway"] <- NA_real_ speeds [ways == "footway"] <- NA_real_ speeds [ways == "motorway_link"] <- 45 speeds [ways == "trunk_link"] <- 40 speeds [ways == "primary_link"] <- 30 speeds [ways == "secondary_link"] <- 25 speeds [ways == "tertiary_link"] <- 20 weighting_profiles$max_speed [weighting_profiles$name == "motorcar"] <- speeds weighting_profiles$max_speed [weighting_profiles$name == "goods"] <- speeds weighting_profiles$max_speed [weighting_profiles$name == "hgv"] <- speeds weighting_profiles$max_speed [weighting_profiles$name == "psv"] <- speeds weighting_profiles$max_speed [weighting_profiles$name == "motorcycle"] <- speeds # moped; simply reduce max speeds to 50 speeds [speeds > 50] <- 50 weighting_profiles$max_speed [weighting_profiles$name == "moped"] <- speeds # bicycle, from # https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/bicycle.lua speeds <- 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"] <- 12 speeds [ways == "path"] <- 12 speeds [ways == "steps"] <- 4 speeds [ways == "bridleway"] <- 8 speeds [ways == "footway"] <- 4 speeds [ways == "pedestrian"] <- 4 weighting_profiles$max_speed [weighting_profiles$name == "bicycle"] <- speeds # wheelchair speeds <- 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"] <- 2 speeds [ways == "steps"] <- NA_real_ speeds [ways == "bridleway"] <- NA_real_ speeds [ways == "footway"] <- 4 speeds [ways == "pedestrian"] <- 4 weighting_profiles$max_speed [weighting_profiles$name == "wheelchair"] <- speeds # horse speeds <- 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"] <- 2 weighting_profiles$max_speed [weighting_profiles$name == "horse"] <- speeds # foot speeds <- 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"] <- 2 weighting_profiles$max_speed [weighting_profiles$name == "foot"] <- speeds ``` ### Surfaces Max speeds for different kinds of surfaces, from OSRM https://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 uses turn ordering across traffic, and so only needs to implement a fixed traffic light waiting time cost. The equivalent values can be obtained from the OSRM profiles with a turn angle of 0 as: ```{r traffic-light-penalties, eval = FALSE} traffic_light_penalty <- 2 turn_duration = traffic_light_penalty turn_bias <- 1.075 # car turn_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")] <- 2 turn_penalty <- rep (7.5, length (nms)) turn_penalty [nms %in% c ("foot", "horse", "wheelchar")] <- 0 turn_penalty [nms == "bicycle"] <- 6 penalties <- data.frame ("name" = nms, "traffic_lights" = traffic_lights, "turn" = turn_penalty, stringsAsFactors = FALSE) penalties$restrictions <- TRUE index <- 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 an average value of 40s: http://dx.doi.org/10.1016/j.trb.2013.02.002 see 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-1 weighting_profiles$value <- weighting_profiles$value / 100 weighting_profiles <- list ("weighting_profiles" = weighting_profiles, "surface_speeds" = surface_speeds, "penalties" = penalties) usethis::use_data (weighting_profiles, overwrite = TRUE, compress = 'xz') ```