Routes have too many transfers

[mpadge]

Example:

library(gtfsrouter)
packageVersion ("gtfsrouter")
#> [1] '0.0.4.8'
file.info ("vbb.zip")$mtime
#> [1] "2019-02-14 13:48:16 CET"
gtfs <- extract_gtfs("vbb.zip")
#> ▶ Unzipping GTFS archive
#> ✔ Unzipped GTFS archive
#> ▶ Extracting GTFS feed✔ Extracted GTFS feed 
#> ▶ Converting stop times to seconds✔ Converted stop times to seconds 
#> ▶ Converting transfer times to seconds✔ Converted transfer times to seconds
gtfs <- gtfs_timetable (gtfs, day = "Monday")
from <- "Berlin, Amalienstr"
to <- "Berlin, Heesestr"
start_time <- 11 * 3600
gtfs_route (gtfs, from = from, to = to, start_time = start_time)
#>   route_name                            trip_name
#> 1        284                 S+U Rathaus Steglitz
#> 2        284                 S+U Rathaus Steglitz
#> 3        284                 S+U Rathaus Steglitz
#> 4        284                 S+U Rathaus Steglitz
#> 5        X83 Berlin, Königin-Luise-Str./Clayallee
#> 6        284                 S+U Rathaus Steglitz
#> 7        284                 S+U Rathaus Steglitz
#> 8        284                 S+U Rathaus Steglitz
#> 9        284                 S+U Rathaus Steglitz
#>                                  stop_name arrival_time departure_time
#> 1                      Berlin, Amalienstr.     11:04:00       11:04:00
#> 2 Berlin, Kaiser-Wilhelm-Str./Seydlitzstr.     11:05:00       11:05:00
#> 3                      Berlin, Dillgesstr.     11:06:00       11:06:00
#> 4                  Berlin, Lankwitz Kirche     11:08:00       11:08:00
#> 5                      S Lankwitz (Berlin)     11:11:00       11:11:00
#> 6     Berlin, Steglitzer Damm/Bismarckstr.     11:16:00       11:16:00
#> 7                 Berlin, Neue Filandastr.     11:17:00       11:17:00
#> 8                      Berlin, Breite Str.     11:18:00       11:18:00
#> 9                        Berlin, Heesestr.     11:19:00       11:19:00

^{Created on 2020-10-25 by the reprex package (v0.3.0)}

That route should remain on route_name 284 the whole way, but changes to X83 for one stop before changing back again. That happens because the timetable for that section has the entry for the X83 service prior to the appropriate entry for the 284, and the route simply connects with first available service at all times. Function has to be fixed to avoid unnecessary transfers. Ping @AlexandraKapp

[mpadge]

That fixes gtfs_route(), but now re-opening to propagate same fix across to gtfs_isochrones().

[mpadge]

Results prior to that implementation (git hash ac00105), using internal code to directly access numbers of transfers, and starting at a station and time from which parallel trips exist and generate spurious/unnecessary transfers:

library(gtfsrouter)
gtfs <- extract_gtfs("vbb.zip")
#> ▶ Unzipping GTFS archive
#> ✔ Unzipped GTFS archive
#> ▶ Extracting GTFS feed✔ Extracted GTFS feed 
#> ▶ Converting stop times to seconds✔ Converted stop times to seconds 
#> ▶ Converting transfer times to seconds✔ Converted transfer times to seconds
gtfs <- gtfs_timetable (gtfs, day = "Monday")
from <- "Berlin, Amalienstr"
start_time <- 11 * 3600
end_time <- start_time + 15 * 60
#r <- gtfs_isochrone (gtfs, from = from, start_time = start_time, end_time = end_time)
# get numbers of transfers:
gtfs_cp <- data.table::copy (gtfs)
gtfs_cp$timetable <- gtfs_cp$timetable [departure_time >= start_time, ]
from_is_id <- FALSE
start_stns <- station_name_to_ids (from, gtfs_cp, from_is_id)
isotrips <- get_isotrips (gtfs_cp, start_stns, start_time, end_time)
vapply (isotrips$isotrips, function (i) {
             index <- seq (nrow (i)) [-1]
             length (which (i$trip_id [index - 1] != i$trip_id [index])) },
             integer (1))
#>  [1] 3 2 3 1 2 1 3 4 3 1 2 2 2 3 5 3 1 1 4 4 3 2

^{Created on 2020-10-26 by the reprex package (v0.3.0)}

After implementing the above commit:

library (gtfsrouter)
gtfs <- extract_gtfs("vbb.zip")
#> ▶ Unzipping GTFS archive
#> ✔ Unzipped GTFS archive
#> ▶ Extracting GTFS feed✔ Extracted GTFS feed 
#> ▶ Converting stop times to seconds✔ Converted stop times to seconds 
#> ▶ Converting transfer times to seconds✔ Converted transfer times to seconds
gtfs <- gtfs_timetable (gtfs, day = "Monday")
from <- "Berlin, Amalienstr"
start_time <- 11 * 3600
end_time <- start_time + 15 * 60
#r <- gtfs_isochrone (gtfs, from = from, start_time = start_time, end_time = end_time)
# get numbers of transfers:
gtfs_cp <- data.table::copy (gtfs)
gtfs_cp$timetable <- gtfs_cp$timetable [departure_time >= start_time, ]
from_is_id <- FALSE
start_stns <- station_name_to_ids (from, gtfs_cp, from_is_id)
isotrips <- get_isotrips (gtfs_cp, start_stns, start_time, end_time)
vapply (isotrips$isotrips, function (i) {
             index <- seq (nrow (i)) [-1]
             length (which (i$trip_id [index - 1] != i$trip_id [index])) },
             integer (1))
#>  [1] 2 2 2 1 0 1 2 0 1 2 1 1 1 1 1 1 1 1 3 2

^{Created on 2020-10-26 by the reprex package (v0.3.0)}