bike car ratios

[mpadge]

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