Distances on Directed Graphs in R
mpadge.tngl.sh
1# script to generate `data/hampi.rda`
2
3```{r load, echo = FALSE}
4library (magrittr)
5library (osmdata)
6```
7```{r}
8hampi <- opq ("hampi india") %>%
9 add_osm_feature (key = "highway") %>%
10 osmdata_sf (quiet = FALSE) %>%
11 osm_poly2line () %>%
12 extract2 ("osm_lines")
13```
14Then need to get rid of columns, especially the ones with Kannada names which
15are non-UTF8
16```{r}
17nms <- c ("osm_id", "bicycle", "covered", "foot", "highway", "incline",
18 "motorcar", "motorcycle", "motor_vehicle", "oneway", "surface",
19 "tracktype", "tunnel", "width", "geometry")
20hampi <- hampi [, match (nms, names (hampi))]
21```
22```{r}
23usethis::use_data (hampi, overwrite = TRUE, compress = 'xz')
24```
25
26# generate `data/weight_profiles`
27
28additional values from OSRM profiles at
29https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/
30
31```{r}
32library (magrittr)
33theurl <- "https://www.routino.org/xml/routino-profiles.xml"
34dat <- xml2::read_html (theurl) %>%
35 rvest::html_nodes("profile") %>%
36 xml2::as_list ()
37```
38
39### initial routino profiles
40
41```{r}
42weighting_profiles <- lapply (dat, function (i) {
43 di <- i$preferences
44 res <- lapply (di, function (j)
45 c (attr (i, "name"),
46 attr (j, "highway"),
47 attr (j, "percent")))
48 do.call (rbind, res)
49 })
50# Then add living_street, bridleway, and footway to all profiles
51# https://wiki.openstreetmap.org/wiki/Tag:highway%3Dliving_street
52nms <- sapply (weighting_profiles, function (i) i [1, 1])
53
54# living_street footway bridleway
55# "foot" 95 100 100
56# "horse" 80 100 100
57# "wheelchair" 95 100 50
58# "bicycle" 95 90 70
59# "moped" 60 0 0
60# "motorcycle" 50 0 0
61# "motorcar" 40 0 0
62# "goods" 30 0 0
63# "hgv" 30 0 0
64# "psv" 30 0 0
65
66wt_ls <- c (95, 80, 95, 95, 60, 50, 40, 30, 30, 30) # living street
67wt_br <- c (100, 100, 50, 70, 0, 0, 0, 0, 0, 0) # bridleway
68wt_fw <- c (100, 100, 100, 90, 0, 0, 0, 0, 0, 0) # footway
69wt_ped <- c (100, 20, 100, 80, 0, 0, 0, 0, 0, 0) # pedestrian
70names (wt_ls) <- names (wt_br) <- names (wt_fw) <- names (wt_ped) <- nms
71newrows <- data.frame ("living_street" = wt_ls,
72 "bridleway" = wt_br,
73 "footway" = wt_fw,
74 "pedestrian" = wt_ped)
75weighting_profiles <- lapply (weighting_profiles, function (i) {
76 newdat <- t (newrows [rownames (newrows) == i [1, 1], ])
77 newdat <- cbind (i [seq (ncol (newrows)), 1],
78 rownames (newdat),
79 newdat [, 1])
80 rbind (i, newdat)
81 })
82
83# plus all of the "link" types defaulting to same as parent entities
84links <- c ("motorway", "trunk", "primary", "secondary", "tertiary")
85nms <- paste0 (links, "_link")
86weighting_profiles <- lapply (weighting_profiles, function (i)
87 {
88 index <- match (links, i [, 2])
89 newrows <- cbind (i [index, 1],
90 nms,
91 i [index, 3])
92 res <- rbind (i, newrows)
93 rownames (res) <- rep ("preference",
94 nrow (res))
95 return (res)
96 })
97
98weighting_profiles <- do.call (rbind, weighting_profiles)
99weighting_profiles <- data.frame (name = weighting_profiles [, 1],
100 way = weighting_profiles [, 2],
101 value = as.numeric (weighting_profiles [, 3]),
102 stringsAsFactors = FALSE)
103
104# bike: steps is set to 0, but here increased to 50; foot:steps = 80
105weighting_profiles$value [weighting_profiles$name == "bicycle" &
106 weighting_profiles$way == "steps"] <- 50
107```
108
109### speeds from OSRM
110
111```{r}
112ways <- weighting_profiles$way [weighting_profiles$name == "foot"]
113speeds <- rep (NA, length (ways))
114weighting_profiles$max_speed <- NA_real_
115# car, from
116# https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/car.lua
117speeds [ways == "motorway"] <- 90
118speeds [ways == "trunk"] <- 85
119speeds [ways == "primary"] <- 65
120speeds [ways == "secondary"] <- 55
121speeds [ways == "tertiary"] <- 40
122speeds [ways == "unclassified"] <- 25
123speeds [ways == "residential"] <- 25
124speeds [ways == "service"] <- 15
125speeds [ways == "track"] <- NA_real_
126speeds [ways == "cycleway"] <- NA_real_
127speeds [ways == "path"] <- NA_real_
128speeds [ways == "steps"] <- NA_real_
129speeds [ways == "ferry"] <- NA_real_
130speeds [ways == "living_street"] <- 10
131speeds [ways == "bridleway"] <- NA_real_
132speeds [ways == "footway"] <- NA_real_
133speeds [ways == "motorway_link"] <- 45
134speeds [ways == "trunk_link"] <- 40
135speeds [ways == "primary_link"] <- 30
136speeds [ways == "secondary_link"] <- 25
137speeds [ways == "tertiary_link"] <- 20
138
139weighting_profiles$max_speed [weighting_profiles$name == "motorcar"] <- speeds
140weighting_profiles$max_speed [weighting_profiles$name == "goods"] <- speeds
141weighting_profiles$max_speed [weighting_profiles$name == "hgv"] <- speeds
142weighting_profiles$max_speed [weighting_profiles$name == "psv"] <- speeds
143weighting_profiles$max_speed [weighting_profiles$name == "motorcycle"] <- speeds
144
145# moped; simply reduce max speeds to 50
146speeds [speeds > 50] <- 50
147weighting_profiles$max_speed [weighting_profiles$name == "moped"] <- speeds
148
149# bicycle, from
150# https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/bicycle.lua
151speeds <- rep (15, length (ways))
152speeds [ways == "motorway"] <- NA_real_
153speeds [ways == "trunk"] <- NA_real_
154speeds [ways == "motorway_link"] <- NA_real_
155speeds [ways == "trunk_link"] <- NA_real_
156speeds [ways == "track"] <- 12
157speeds [ways == "path"] <- 12
158speeds [ways == "steps"] <- 4
159speeds [ways == "bridleway"] <- 8
160speeds [ways == "footway"] <- 4
161speeds [ways == "pedestrian"] <- 4
162weighting_profiles$max_speed [weighting_profiles$name == "bicycle"] <- speeds
163
164# wheelchair
165speeds <- rep (5, length (ways))
166speeds [ways == "motorway"] <- NA_real_
167speeds [ways == "trunk"] <- NA_real_
168speeds [ways == "motorway_link"] <- NA_real_
169speeds [ways == "trunk_link"] <- NA_real_
170speeds [ways == "track"] <- 2
171speeds [ways == "steps"] <- NA_real_
172speeds [ways == "bridleway"] <- NA_real_
173speeds [ways == "footway"] <- 4
174speeds [ways == "pedestrian"] <- 4
175weighting_profiles$max_speed [weighting_profiles$name == "wheelchair"] <- speeds
176
177# horse
178speeds <- rep (6.4, length (ways))
179speeds [ways == "motorway"] <- NA_real_
180speeds [ways == "trunk"] <- NA_real_
181speeds [ways == "motorway_link"] <- NA_real_
182speeds [ways == "trunk_link"] <- NA_real_
183speeds [ways == "steps"] <- 2
184weighting_profiles$max_speed [weighting_profiles$name == "horse"] <- speeds
185
186# foot
187speeds <- rep (5, length (ways))
188speeds [ways == "motorway"] <- NA_real_
189speeds [ways == "trunk"] <- NA_real_
190speeds [ways == "motorway_link"] <- NA_real_
191speeds [ways == "trunk_link"] <- NA_real_
192speeds [ways == "steps"] <- 2
193weighting_profiles$max_speed [weighting_profiles$name == "foot"] <- speeds
194```
195
196
197### Surfaces
198
199Max speeds for different kinds of surfaces, from OSRM
200https://github.com/Project-OSRM/osrm-backend/tree/master/profiles
201```{r}
202s <- rbind (c ("motorcar", "surface", "cement", 80),
203 c ("motorcar", "surface", "compacted", 80),
204 c ("motorcar", "surface", "fine_gravel", 80),
205 c ("motorcar", "surface", "paving_stones", 60),
206 c ("motorcar", "surface", "metal", 60),
207 c ("motorcar", "surface", "bricks", 60),
208 c ("motorcar", "surface", "grass", 40),
209 c ("motorcar", "surface", "wood", 40),
210 c ("motorcar", "surface", "sett", 40),
211 c ("motorcar", "surface", "grass_paver", 40),
212 c ("motorcar", "surface", "gravel", 40),
213 c ("motorcar", "surface", "unpaved", 40),
214 c ("motorcar", "surface", "ground", 40),
215 c ("motorcar", "surface", "dirt", 40),
216 c ("motorcar", "surface", "pebblestone", 40),
217 c ("motorcar", "surface", "tartan", 40),
218 c ("motorcar", "surface", "cobblestone", 30),
219 c ("motorcar", "surface", "clay", 30),
220 c ("motorcar", "surface", "earth", 20),
221 c ("motorcar", "surface", "stone", 20),
222 c ("motorcar", "surface", "rocky", 20),
223 c ("motorcar", "surface", "sand", 20),
224 c ("motorcar", "surface", "mud", 10),
225
226 c ("bicycle", "surface", "cobblestone:flattened", 10),
227 c ("bicycle", "surface", "paving_stones", 10),
228 c ("bicycle", "surface", "compacted", 10),
229 c ("bicycle", "surface", "cobblestone", 6),
230 c ("bicycle", "surface", "unpaved", 6),
231 c ("bicycle", "surface", "fine_gravel", 6),
232 c ("bicycle", "surface", "gravel", 6),
233 c ("bicycle", "surface", "pebblestone", 6),
234 c ("bicycle", "surface", "ground", 6),
235 c ("bicycle", "surface", "dirt", 6),
236 c ("bicycle", "surface", "earth", 6),
237 c ("bicycle", "surface", "grass", 6),
238 c ("bicycle", "surface", "mud", 3),
239 c ("bicycle", "surface", "sand", 3),
240 c ("bicycle", "surface", "sett", 10),
241
242 c ("foot", "surface", "fine_gravel", 4),
243 c ("foot", "surface", "gravel", 4),
244 c ("foot", "surface", "pebblestone", 4),
245 c ("foot", "surface", "mud", 2),
246 c ("foot", "surface", "sand", 2))
247surface_speeds <- data.frame ("name" = s [, 1],
248 "key" = s [, 2],
249 "value" = s [, 3],
250 "max_speed" = as.numeric (s [, 4]),
251 stringsAsFactors = FALSE)
252
253```
254
255### traffic light and turn penalties
256
257These are calculated in OSRM based on turn angles. The `dodgr` algorithm uses
258turn ordering across traffic, and so only needs to implement a fixed traffic
259light waiting time cost. The equivalent values can be obtained from the OSRM
260profiles with a turn angle of 0 as:
261```{r traffic-light-penalties, eval = FALSE}
262traffic_light_penalty <- 2
263turn_duration = traffic_light_penalty
264turn_bias <- 1.075 # car
265turn_duration <- turn_duration + 6.5 / turn_bias # = 8
266
267# for both bike and car:
268turn_duration <- traffic_light_penalty # = 2
269```
270
271```{r}
272nms <- unique (weighting_profiles$name)
273#nms <- c ("foot", "horse", "wheelchair", "bicycle", "moped", "motorcycle",
274# "motorcar", "goods", "hgv", "psv")
275traffic_lights <- rep (8, length (nms))
276traffic_lights [nms %in% c ("foot", "wheelchair", "bicycle")] <- 2
277turn_penalty <- rep (7.5, length (nms))
278turn_penalty [nms %in% c ("foot", "horse", "wheelchar")] <- 0
279turn_penalty [nms == "bicycle"] <- 6
280penalties <- data.frame ("name" = nms,
281 "traffic_lights" = traffic_lights,
282 "turn" = turn_penalty,
283 stringsAsFactors = FALSE)
284penalties$restrictions <- TRUE
285index <- which (penalties$name %in%
286 c ("foot", "horse", "wheelchair", "bicycle"))
287penalties$restrictions [index] <- FALSE
288```
289
290Note that the following link describes waiting times at traffic lights with an
291average value of 40s:
292http://dx.doi.org/10.1016/j.trb.2013.02.002
293see also National Assoc. City Transportation Officials guidelines:
294https://nacto.org/publication/urban-street-design-guide/intersection-design-elements/traffic-signals/signal-cycle-lengths/
295recommended "Short cycle length" of 60-90 seconds
296
297### save the data:
298
299```{r}
300# change percentage value to 0-1
301weighting_profiles$value <- weighting_profiles$value / 100
302weighting_profiles <- list ("weighting_profiles" = weighting_profiles,
303 "surface_speeds" = surface_speeds,
304 "penalties" = penalties)
305usethis::use_data (weighting_profiles, overwrite = TRUE, compress = 'xz')
306```