A reprex to illustrate the kinds of analyses currently possible:
library (dplyr)
library (ggplot2)
library (m4ra)
packageVersion ("m4ra")
#> [1] '0.0.1.121'
flist <- gsub ("^m4ra\\-", "", list.files ("~/.cache/R/m4ra/"))
cities <- gsub ("\\-[a-z0-9]{6}\\-(bicycle|foot|motorcar)\\.Rds$", "", flist)
cities <- unique (cities)
cities <- cities [cities != "helsinki"]
bike_car_ratio_one_city <- function (city) {
graph_f <- m4ra_load_cached_network (city, mode = "foot")
graph_f <- graph_f [graph_f$component == 1, ]
v_f <- dodgr::dodgr_vertices (graph_f)
graph_b <- m4ra_load_cached_network (city, mode = "bicycle")
graph_b <- graph_b [graph_b$component == 1, ]
v_b <- dodgr::dodgr_vertices (graph_b)
graph_c <- m4ra_load_cached_network (city, mode = "motorcar")
graph_c <- graph_c [graph_c$component == 1, ]
v_c <- dodgr::dodgr_vertices (graph_c)
# Get vertices common to all networks:
vert_count <- table (c (
unique (graph_f$.vx0),
unique (graph_b$.vx0),
unique (graph_c$.vx0)
))
verts_all <- names (vert_count) [which (vert_count == 3)]
v <- v_f [which (v_f$id %in% verts_all), ]
# Get central vertex:
i <- which.min ((v$x - mean (v$x)) ^ 2 + (v$y - mean (v$y)) ^ 2)
from <- v$id [i]
dat <- m4ra_bike_car_times (city = city, from = from)
areas <- m4ra_bike_car_ratio_areas (dat, ratio_lims = 1:20 / 4)
areas$city <- city
return (areas)
}
result_file <- "bike-car-ratio-results.Rds"
if (!file.exists (result_file)) {
result <- bike_car_ratio_one_city (city = cities [1])
count <- 2L
system.time ({
for (ci in cities [-1]) {
message (ci, " [", count, " / ", length (cities), "]")
count <- count + 1L
result <- rbind (result, bike_car_ratio_one_city (city = ci))
}
})
saveRDS (result, result_file)
}
result <- readRDS ("bike-car-ratio-results.Rds") |>
group_by (city) |>
filter (ratio <= 2) |>
mutate (label = c (rep (NA_character_, length (city) - 1L), city [1]))
ggplot (result, aes (x = ratio, y = area, colour = city)) +
geom_line () +
geom_label (aes (label = label), nudge_x = 0.35, size = 4) +
theme (legend.position = "none")
#> Warning: Removed 279 rows containing missing values (geom_label).
# Then summarise values at unit ratio, and slopes 1 -> 2:
x <- readRDS ("bike-car-ratio-results.Rds") |>
filter (ratio >= 1 & ratio <= 2) |>
transform (ratio = ratio - 1) |>
group_by (city) |>
do (
mod = lm (area ~ ratio, data = .)
) |>
mutate (
a1 = mod$model$area [1],
a2 = tail (mod$model$area, 1L),
intercept = summary (mod)$coefficient [1],
slope = summary (mod)$coefficient [2]
) |>
arrange (by = desc (intercept))
#> Warning in summary.lm(mod): essentially perfect fit: summary may be unreliable
#> Warning in summary.lm(mod): essentially perfect fit: summary may be unreliable
print (x, n = 100)
#> # A tibble: 40 × 6
#> # Rowwise:
#> city mod a1 a2 intercept slope
#> <chr> <list> <dbl> <dbl> <dbl> <dbl>
#> 1 hamburg <lm> 185. 1267. 190. 1096.
#> 2 paris <lm> 188. 188. 188. 0
#> 3 muenchen <lm> 91.2 488. 140. 371.
#> 4 aachen <lm> 106. 380. 137. 263.
#> 5 brussels <lm> 119. 123. 121. 2.90
#> 6 duesseldorf <lm> 129. 518. 114. 396.
#> 7 san-francisco <lm> 98.6 253. 103. 155.
#> 8 stuttgart <lm> 63.6 392. 86.3 340.
#> 9 zurich <lm> 45.9 171. 69.1 119.
#> 10 frankfurt <lm> 45.8 391. 64.9 332.
#> 11 dresden <lm> 57.1 506. 55.8 459.
#> 12 luxembourg <lm> 43.2 122. 54.9 77.9
#> 13 copenhagen <lm> 54.3 240. 54.7 205.
#> 14 essen <lm> 48.2 356. 54.3 331.
#> 15 karlsruhe <lm> 37.1 281. 29.7 250.
#> 16 nuernberg <lm> 35.9 297. 28.6 271.
#> 17 liege <lm> 16.7 135. 20.2 125.
#> 18 leipzig <lm> 26.5 461. 15.4 458.
#> 19 bielefeld <lm> 31.2 388. 10.5 369.
#> 20 mannheim <lm> 18.1 194. 9.96 186.
#> 21 leiden <lm> 6.52 41.6 9.79 36.1
#> 22 muenster <lm> 25.4 376. 9.43 343.
#> 23 ghent <lm> 44.3 398. 7.94 346.
#> 24 lausanne <lm> 6.82 79.5 7.46 68.6
#> 25 hannover <lm> 24.6 398. 5.69 370.
#> 26 basel <lm> 28.7 436. 5.60 414.
#> 27 honfluer <lm> 0.0574 27.8 0.893 28.1
#> 28 leuven <lm> 11.4 246. -0.491 244.
#> 29 rastede <lm> 0.282 16.9 -2.55 18.5
#> 30 antwerpen <lm> 1.37 99.1 -5.73 98.2
#> 31 tallinn <lm> 15.4 391. -8.39 412.
#> 32 freiburg <lm> 1.66 109. -9.55 109.
#> 33 bern <lm> 38.0 476. -11.8 439.
#> 34 san-sebastian <lm> 0.231 96.7 -14.5 96.1
#> 35 brugge <lm> 12.3 290. -21.4 265.
#> 36 halle <lm> 3.16 216. -22.3 205.
#> 37 mainz <lm> 21.6 417. -22.8 383.
#> 38 groningen <lm> 15.6 364. -28.9 338.
#> 39 minsk <lm> 6.43 314. -30.7 293.
#> 40 bremen <lm> 0 171. -33.1 164.
Created on 2022-10-21 with reprex v2.0.2
Those results summarise the areas of each city over which cycling from a roughly central point of the city remains raster than driving a car. The points are nevertheless effectively random, and so the comparisons between cities don't really say anything in that case, but the general principle of the analyses remains valid.
The values in the results are:
a1
= The actual observed area within which cycling takes same time as driving (ratio = 1)
a2
= The actual observed area within which cycling takes less than twice as long as driving (ratio = 2)
intercept
= The intercept of a linear regression fitted to values betwen ratios of 1 and 2
slope
= The slope of a linear regression fitted to values between ratios of 1 and 2