Cycling weightings compared

Preprocessing of data

library(openrouteservice)
library(leaflet)

load("recommendended-bike-1000.Rda")

n = 1000

lapply(res, function(routes) {
  sapply(routes, function(x) x$features[[1]]$properties$summary$distance/1000) 
}) %>% data.frame -> distance

lapply(res, function(routes) {
  sapply(routes, function(x) x$features[[1]]$properties$summary$duration)
}) %>% data.frame -> duration

lapply(res, function(routes) {
  sapply(routes, function(x) x$features[[1]]$properties$ascent) 
}) %>% data.frame -> ascent

lapply(res, function(routes) {
  lapply(routes, function(x) {
    x = x$features[[1]]$properties$extras$suitability$summary
    values = sapply(x, `[[`, "value") 
    amount = sapply(x, `[[`, "amount")
    v = rep(0, 8)
    v[values-2] <- amount
    v
  })
}) %>% lapply(function(routes) {
  sapply(routes, function(v) {
    sum(0:7 * v/100)
  })
}) %>% data.frame -> suitability

Route characteristics

range(distance$fastest)

## [1]   0.2914 499.2697

hist(distance$fastest, xlim = c(0, 500), breaks = 50)

Suitability

compare <- function(what, ref, f) {
  sapply(lapply(what[setdiff(names(what), ref)], f, what[ref]), sum)
}

Number of routes that have a better suitability index compared to GraphHopper’s fastest…

compare(suitability, "fastest", `>`)

## recommended     reduced      scaled         new 
##         770         800         822         977

.. and a worse suitability.

compare(suitability, "fastest", `<`)

## recommended     reduced      scaled         new 
##         156         112         133           2

Even though current recommended is a better choice than fastest, all the other alternatives seem to perform better with the proposed new being the best.

But how do actually compare the other weightings to new?

compare(suitability, "new", `<`)

##     fastest recommended     reduced      scaled 
##         977         964         964         950

compare(suitability, "new", `>`)

##     fastest recommended     reduced      scaled 
##           2           8           6          27

Routes which become worse with the new weighting.

(worse_suitability <- which(suitability$new < suitability$fastest | suitability$new < suitability$recommended))

##  [1] 10 20 24 29 41 47 55 57 60 95

Ascent

Total ascent values generated across routes.

sapply(ascent, sum)

##     fastest recommended     reduced      scaled         new 
##     2635474     2657401     2654994     2662721     2641841

new is second best even though it produces the longest routes.

sapply(distance, sum)

##     fastest recommended     reduced      scaled         new 
##    252690.6    254094.9    253885.3    255409.7    273227.8

Number of routes that have a lower ascent (better) compared to GraphHopper’s fastest …

compare(ascent, "fastest", `<`)

## recommended     reduced      scaled         new 
##         225         224         294         451

… and higher ascent (worse).

compare(ascent, "fastest", `>`)

## recommended     reduced      scaled         new 
##         693         684         657         521

Again, the new weighting seems to be the best alternative to fastest.

Summary

Percentage of recommended routes which are worse than fastest in terms of both suitability and ascent.

sum(ascent$recommended > ascent$fastest & suitability$recommended < suitability$fastest) / n * 100

## [1] 11.3

Percentage of new routes which are worse than fastest in terms of both suitability and ascent.

sum(ascent$new > ascent$fastest & suitability$new < suitability$fastest) / n * 100

## [1] 0.1

Percentage of new routes which are worse than recommended in terms of both suitability and ascent.

sum(ascent$new > ascent$recommended & suitability$new < suitability$recommended)  / n * 100

## [1] 0.6