In ATFutures/gtfs-router: Routing with 'GTFS' (General Transit Feed Specification) Data
# Necessary for CRAN to avoid CPU / elapsed time ratios being too high
nthr <- data.table::setDTthreads (1)
GTFS feeds may include a table of possible transfers between stops, and
potentially between specific connecting services. There feeds are nevertheless
optional, and many feeds omit transfer tables, making them difficult if not
impossible to use for routing. The gtfsrouter package includes a function,
gtfs_transfer_table(),
which calculates and inserts a transfer table into a feed.
Basic Usage
This function can also be demonstrated with the very small feed included with
this package, by first running
berlin_gtfs_to_zip()
to create the feed in the temporary directory of the current R session.
library (gtfsrouter)
f <- berlin_gtfs_to_zip ()
gtfs <- extract_gtfs (f, quiet = TRUE)
The transfers table of the feed looks like this:
gtfs$transfers
A transfers table is required for successful routing between different
services, like with the following code:
gtfs_route (
gtfs,
from = "Friedrichstr.",
to = "Rosenthaler Platz",
start_time = 12 * 3600,
day = "Monday"
)
That trip requires a transfer, and is possible because the feed has a table
specifying the possibility of transferring at the "S+U Gesundbrunnen Bhf"
station. Removing the transfers table demonstrates what typically happens when
attempting to calculate routes on feeds which lack this information:
gtfs$transfers <- NULL
gtfs_route (
gtfs,
from = "Friedrichstr.",
to = "Rosenthaler Platz",
start_time = 12 * 3600,
day = "Monday"
)
No transfer is able to be make, and so no route is found. The
gtfs_transfer_table()
function
automatically calculates and adds a transfer table to a feed, enabling it once
again to be used to generate routes:
gtfs <- gtfs_transfer_table (gtfs, d_limit = 200)
gtfs_route (
gtfs,
from = "Friedrichstr.",
to = "Rosenthaler Platz",
start_time = 12 * 3600,
day = "Monday"
)
That route is considerably faster than the original one, because it utilises
a transfer (at "S+U Alexanderplatz") which is not in the original transfers
table. That particular transfer highlights the most important caveat to using the
gtfs_transfer_table()
function:
that tables may and often will still require some degree of manual checking and
adjustment to make them usable, as demonstrated in the following section.
Extending transfer tables
The above example first removed the transfer table by setting gtfs$transfers
<- NULL. Applying the gtfs_transfer_table()
function
to a feed which already has a transfer table will extend that table by adding
any additional transfers within the specified distance (see
below). Any transfers already present in the transfers
table will be retained as is, and the table will be extended by adding any new
transfers not present in the original table.
Transfers are calculated based on distance alone, and do not utilise any
information on routes or trips. Some feeds, such as the example Berlin feed
included with this
package,
include transfer information between specific routes and services, resulting in
a transfers table in which station pairs are repeated numerous times for
distinct combinations of routes and services:
gtfs <- extract_gtfs (f, quiet = TRUE) # 'f' is the location generated above
nrow (gtfs$transfers)
length (which (!duplicated (gtfs$transfers [, c ("from_stop_id", "to_stop_id")])))
n0 <- nrow (gtfs$transfers)
n1 <- length (which (!duplicated (gtfs$transfers [, c ("from_stop_id", "to_stop_id")])))
The table only has r format (n1, big.mark = ",") unique pairs of from and
to stops, yet details r format (n0, big.mark = ",") possibles ways of
transferring between these stops. Removing and re-generating these transfers
gives the following results:
gtfs$transfers <- NULL
gtfs <- gtfs_transfer_table (gtfs)
nrow (gtfs$transfers)
The gtfs_transfer_table()
function
generates r nrow (gtfs$transfers) - n1 additional transfers not present in
the original feed, but as stated contains no information on transfers between
specific routes or trips. Alternatively, using the function to extend the
existing table, rather than re-generate it, gives the following result:
gtfs <- extract_gtfs (f, quiet = TRUE)
gtfs <- gtfs_transfer_table (gtfs)
nrow (gtfs$transfers)
Note that each call to
gtfs_transfer_table()
will only extend the table through adding any transfers not present in the
previous table, and that no transfers will be removed. The following code uses
the d_limit parameter described below to calculate
transfer tables for increasing maximal transfer distances.
gtfs <- extract_gtfs (f, quiet = TRUE)
vapply (0:10, function (i) {
gtfs <- gtfs_transfer_table (gtfs, d_limit = i * 100)
return (nrow (gtfs$transfers))
}, integer (1))
The transfer table increases in size with each call, and retains all transfers
generated from all previous calls. Because each call involves extending the
transfer table, the table at each stage may be used for routing with transfers
out to each specified distance. Subsequently reducing the transfer distance
would then not be appropriate, as the table would still retain all transfers at
previously-calculated (longer) distances:
gtfs <- gtfs_transfer_table (gtfs, d_limit = 100)
nrow (gtfs$transfers)
In this case, the table would first have to be removed (gtfs$transfers <-
NULL), and the recalculated at the specified distance.
gtfs$transfers <- NULL
gtfs <- gtfs_transfer_table (gtfs, d_limit = 100)
nrow (gtfs$transfers)
Modifying transfer tables
This section demonstrates that transfer tables generated using the
gtfs_transfer_table()
function
often need to be manually modified to ensure sensible results. The second route
generated above after using the gtfs_transfer_table()
function
includes a transfer at "S+U Alexanderplatz" from a route named "S7" to one
named "U8". This train station is in fact one of the largest stations in
Berlin, with the "S" routes using elevated platforms above ground, and the "U"
denoting underground. The "U8" in particular is quite a long way underground,
and while transfer in the indicated time of just under three minutes may be
theoretically possible, it would likely require running, and ought not be
generally presumed to reflect a viable transfer.
Note further that the actual locations of these stations can be extracted with
the following lines:
r <- gtfs_route (
gtfs,
from = "Friedrichstr.",
to = "Rosenthaler Platz",
start_time = 12 * 3600,
day = "Monday",
include_ids = TRUE
)
stns <- r$stop_id [3:4] # the transfer station IDs
gtfs$stops [match (stns, gtfs$stops$stop_id), ]
The distance between them is:
s <- gtfs$stops [match (stns, gtfs$stops$stop_id), ]
as.numeric (geodist::geodist (s [1, ], s [2, ]))
The transfer table algorithm presumes a pedestrian speed of 4km / hour, which
is 1.11 m/s, meaning this distance should be able to be covered in just over
50 seconds. In reality, it would be impossible to run between these two stops
in 50 seconds, primarily because of a need to traverse 3 or 4 vertical levels.
We now demonstrate how to add more realistic transfer times, by adding
additional time penalties for transferring between underground and overground
services, to reflect the extra time required to travel up or down between
stops. The sample feed included with this package only has "U" and "S" routes.
The following code demonstrates how to use this distinction to add additional
time penalties to the transfers table. The first step is to find the trip_id
values of all "S" and "U" services, which is itself a two-step procedure to
first extract route_id values and then match these to trip_id values.
Procedures may vary between feeds, but in the case of Berlin, the routes are
all identified by their route_short_name, as follows:
S_routes <- gtfs$routes$route_id [grep ("^S", gtfs$routes$route_short_name)]
U_routes <- gtfs$routes$route_id [grep ("^U", gtfs$routes$route_short_name)]
S_trips <- gtfs$trips$trip_id [which (gtfs$trips$route_id %in% S_routes)]
U_trips <- gtfs$trips$trip_id [which (gtfs$trips$route_id %in% U_routes)]
The following code then uses those trip_id values to extract all
corresponding stops.
S_stops <- gtfs$stop_times$stop_id [which (gtfs$stop_times$trip_id %in% S_trips)]
S_stops <- unique (S_stops)
U_stops <- gtfs$stop_times$stop_id [which (gtfs$stop_times$trip_id %in% U_trips)]
U_stops <- unique (U_stops)
Although in Berlin the stops for "U" and "S" services are strictly separated,
this may not be the case for all other feeds. It might, for example, be useful
to remove stops which are used by both types of services, leaving stops that
can only serve as transfers between different kinds of services. The following
two lines suffice for that:
S_stops <- S_stops [which (!S_stops %in% U_stops)]
U_stops <- U_stops [which (!U_stops %in% S_stops)]
All we then need to do is to add additional transfers times for any transfers
between these two sets of stops, arbitrarily choosing here a value of
2 minutes:
index <- which ((gtfs$transfers$from_stop_id %in% S_stops &
gtfs$transfers$to_stop_id %in% U_stops) |
(gtfs$transfers$from_stop_id %in% U_stops &
gtfs$transfers$to_stop_id %in% S_stops))
gtfs$transfers$min_transfer_time [index] <-
gtfs$transfers$min_transfer_time [index] + 120
Our route query then returns the following:
gtfs_route (
gtfs,
from = "Friedrichstr.",
to = "Rosenthaler Platz",
start_time = 12 * 3600,
day = "Monday"
)
The route follows exactly the same connections, but now allows a far more
realistic time of just over 5 minutes for the transfer at Alexanderplatz.
This exemplifies that, while the gtfs_transfer_table()
function
can "automatically" generate transfer tables, these will often still need
manual tweaking and adjustment to reflect the unique characteristics of any
given system.
Transfer distances {#transfer-distances}
The gtfs_transfer_table()
function
includes an additional parameter, d_limit, quantifying the maximum
permissible walking distance between transfers, with a default value of 200
metres. Increasing this value generates greater numbers of possible transfers,
as the following code illustrates, starting by removing and re-creating the
transfer table, followed by adding the additional penalties for transfers
between the two types of services, this time constructed as a function for easy
re-use:
gtfs$transfers <- NULL
gtfs <- gtfs_transfer_table (gtfs, d_limit = 500)
transfer_penalties <- function (gtfs, penalty = 120) {
S_routes <- gtfs$routes$route_id [grep ("^S", gtfs$routes$route_short_name)]
U_routes <- gtfs$routes$route_id [grep ("^U", gtfs$routes$route_short_name)]
S_trips <- gtfs$trips$trip_id [which (gtfs$trips$route_id %in% S_routes)]
U_trips <- gtfs$trips$trip_id [which (gtfs$trips$route_id %in% U_routes)]
S_stops <- gtfs$stop_times$stop_id [which (gtfs$stop_times$trip_id %in% S_trips)]
S_stops <- unique (S_stops)
U_stops <- gtfs$stop_times$stop_id [which (gtfs$stop_times$trip_id %in% U_trips)]
U_stops <- unique (U_stops)
S_stops <- S_stops [which (!S_stops %in% U_stops)]
U_stops <- U_stops [which (!U_stops %in% S_stops)]
index <- which ((gtfs$transfers$from_stop_id %in% S_stops &
gtfs$transfers$to_stop_id %in% U_stops) |
(gtfs$transfers$from_stop_id %in% U_stops &
gtfs$transfers$to_stop_id %in% S_stops))
gtfs$transfers$min_transfer_time [index] <-
gtfs$transfers$min_transfer_time [index] + 120
return (gtfs)
}
gtfs <- transfer_penalties (gtfs)
Submitting the same routing query now gives the following:
gtfs_route (
gtfs,
from = "Friedrichstr.",
to = "Rosenthaler Platz",
start_time = 12 * 3600,
day = "Monday"
)
The route departs and arrives at the same time, but now includes an additional
walking transfer over a distance which can be calculated by repeating the lines
above:
r <- gtfs_route (
gtfs,
from = "Friedrichstr.",
to = "Rosenthaler Platz",
start_time = 12 * 3600,
day = "Monday",
include_ids = TRUE
)
s <- gtfs$stops [match (r$stop_id [2:3], gtfs$stops$stop_id), ]
as.numeric (geodist::geodist (s [1, ], s [2, ]))
At a speed of 1.11m/s, this would take just under 6 minutes. With the
additional penalty of 2 minutes for transferring from an "S" to a "U" service,
this transfer would require just under 8 minutes, which is less than the time
given in the route of just over 8.5 minutes. This demonstrates how increasing
maximal walking distances increases numbers of possible transfers.
The following code shows the sizes of transfer tables as a function of maximal
walking distances:
d_limit <- 1:20 * 100
n <- vapply (d_limit, function (i) {
gtfs$transfer <- NULL
gtfs <- gtfs_transfer_table (gtfs, d_limit = i)
nrow (gtfs$transfers)
}, integer (1))
d_limit <- d_limit / 1000 # in km
n <- n / 1000 # in thousands
plot (
d_limit, n,
type = "l", col = "red", lwd = 2,
xlab = "Maximal transfer distance",
ylab = "Number of transfers (1000s)"
)
The line is initially flat because this number (around 3,300) is the number of
transfers possible between stops which have identical spatial locations (and so
a distance of 0.0). Numbers of transfers can never be less than this number.
The following section delves further into the effect of this distance limit,
though examining the result of
gtfs_traveltimes()
for different distance limits.
Transfer distances and travel times
The preceding result might be sensibly interpreted to reflect something like
a plausible upper limit for a transfer, with a distance of 370 metres, plus
a vertical transfer between underground and overground services, expected to be
covered in under 8.5 minutes. This might -- and indeed likely should -- in turn
be considered to demonstrate how this d_limit parameter, along with any
additional manual adjustments applied to transfer tables, like the
transfer_penalties() function constructed above, need to be carefully
considered with regard to concrete knowledge of a particular system.
The gtfsrouter package is nevertheless not intended to be used only to
generate individual routing queries, but also includes the
gtfs_traveltimes()
function
designed to enable efficient estimation of travel times anywhere in a system
from any nominated station. The result of this function will obviously be
influenced by the transfers table, and in particular by the maximal walking
distance used to construct transfer tables with the gtfs_transfer_table()
function.
The effect of different distances can also be examined using the internal data
set provided with this package. The following function generates travel times
for a given d_limit a random sample of starting stations:
library (dplyr)
library (hms) # 'parse_hms' function
travel_times_d_limit <- function (gtfs, from, d_limit = 200) {
gtfs$transfers <- NULL
gtfs <- gtfs_transfer_table (gtfs, d_limit = d_limit)
gtfs <- transfer_penalties (gtfs)
start_time_limits <- 12:13 * 3600
get_one_times <- function (gtfs, from, start_time_limits) {
x <- gtfs_traveltimes (
gtfs,
from = from,
start_time_limits = start_time_limits,
quiet = TRUE
)
ret <- NULL
if (nrow (x) > 0) {
# Convert duration to minutes:
dur <- as.integer (parse_hms (x$duration)) / 60
ret <- data.frame (
from = from,
to = x$stop_id,
duration = dur
)
}
return (ret)
}
res <- lapply (from, function (i) {
get_one_times (gtfs, i, start_time_limits)
})
res <- do.call (rbind, res) %>%
group_by (from, to) %>%
summarise (duration = mean (duration), .groups = "drop")
res$d_limit <- d_limit
return (res)
}
This function returns travel times from all stations listed in from to all
other (reachable) stations for the specified value of d_limit. The following
lines then compare these travel times between identical origin and
destination stations for a range of distance limits.
set.seed (10L)
from <- sample (gtfs$stops$stop_name, size = 10)
d_limit <- 1:10 * 100
x <- lapply (d_limit, function (i) {
travel_times_d_limit (gtfs, from = from, d_limit = i)
})
xall <- do.call (rbind, x) [, c ("from", "to")]
xall <- xall [which (!duplicated (xall)), ]
for (i in seq_along (x)) {
y <- left_join (xall, x [[i]], by = c ("from", "to"))
xall [paste0 ("d_", x [[i]]$d_limit [1])] <- y$duration
}
index <- which (xall$d_1000 != xall$d_100)
# record number of stations for which travel times did not change:
nsame <- nrow (xall) - length (index)
xall <- xall [index, ]
# travel times only:
times <- xall %>% select (!c ("from", "to"))
# differences with each increase in d_limit:
times <- t (apply (times, 1, function (i) {
diff (i)
}))
times <- data.frame (t = as.vector (times))
library (ggplot2)
ggplot (times, aes (x = t)) +
stat_bin (bins = 30, col = "red", fill = "orange") +
scale_y_log10 () +
xlab ("time difference (minutes)")
And these additional transfer possibilities can make a significant difference
to estimated travel times. Note, however, that the travel times only changed
for r length (index) stations, while the value of nsame value recording
numbers of stations for which travel times did not change was
r format (nsame, big.mark = ","). Travel times may also increase as
additional transfers may be used to reduce numbers of connecting services
required for a particular trip, and the algorithm generally searches for
connections with minimal numbers of transfers.
The following code the quantifies the overall effect of these reductions in
travel times, measured as the linear reduction in comparison with travel times
calculated using the original transfers table provided with the feed. The
function also returns the proportion of all stations for which travel times
were affected by the modified transfer table.
transfer_difference <- function (gtfs,
nsamples = 10,
d_limit = 200,
day = "Monday",
start_time_limits = 12:13 * 3600) {
g1 <- data.table::copy (gtfs)
g1 <- gtfs_timetable (g1, day = day)
g2 <- data.table::copy (gtfs)
g2 <- gtfs_transfer_table (g2, d_limit = d_limit, quiet = TRUE)
g2 <- gtfs_timetable (g2, day = day)
get1 <- function (gtfs, gtfs2, start_time_limits) {
from <- sample (gtfs$stops$stop_name, size = 1)
x1 <- gtfs_traveltimes (
gtfs,
from = from,
start_time_limits = start_time_limits,
quiet = TRUE
)
x2 <- gtfs_traveltimes (
gtfs2,
from = from,
start_time_limits = start_time_limits,
quiet = TRUE
)
if (nrow (x1) == 0L | nrow (x2) == 0L) {
return (rep (NA, 2))
}
x2 <- data.frame (
stop_id = x2$stop_id,
duration2 = x2$duration
)
x2 <- dplyr::left_join (x1, x2, by = "stop_id")
dat <- data.frame (
x = as.integer (parse_hms (x2$duration)) / 60,
y = as.integer (parse_hms (x2$duration2)) / 60
)
mod <- lm (y ~ x + 0, data = dat)
return (c (
prop = length (which (dat$x != dat$y)) / nrow (dat),
change = as.numeric (mod$coefficients)
))
}
vapply (seq (nsamples), function (i) {
get1 (g1, g2, start_time_limits)
},
numeric (2),
USE.NAMES = FALSE
)
}
That function can then be used to loop over a range of values of d_limit, and
to examine the results with the following code:
d_limit <- 1:10 * 100
set.seed (1L)
d <- lapply (d_limit, function (i) {
transfer_difference (
gtfs,
nsamples = 20,
d_limit = i,
day = "Monday",
start_time_limits = 12:13 * 3600
)
})
d <- lapply (seq_along (d_limit), function (i) {
data.frame (
d_limit = d_limit [i],
prop = d [[i]] [1, ],
change = d [[i]] [2, ]
)
})
d <- do.call (rbind, d)
ggplot (d, aes (x = d_limit, y = change)) +
geom_point (pch = 19, col = "orange") +
geom_smooth (method = "loess", formula = "y ~ x")
That result shows that travel times do decrease with increasing limits of
maximal transfer distance, although the overall effect is very minimal. The
object d also records the proportion of station pairs for which modifications
to the transfers table actually changed travel times, which in this case
amounts to a mean value of r round (mean (d$prop, na.rm = TRUE), digits = 4),
clearly revealing that very few trips actually change.
A more realistic example
The following results apply the code given above to the full feed for
Stuttgart, Germany, showing what might more typically be expected as the
d_limit parameter is increased.
d <- list ()
# 1
d [[1]] <- rbind (
c (
0.04787234, 0.3024283, 0.2137809, 0.4226190, 0.4782609, 0,
0.1996497, 0.0324826, 0.3122142, 0.1051136, 0.1330166,
0.1755486, 0.3659229, NA, 0.2471751, 0.03344482,
0.3617021, 0.3400000, NA, 0.05964215
),
c (
0.97835370, 0.9045062, 0.9552470, 0.8157467, 0.8343242, 1,
0.8956478, 0.9857173, 0.9197187, 0.9813956, 0.9488823,
0.9505516, 0.8601199, NA, 0.9367492, 0.99126114,
0.8190608, 0.9064265, NA, 0.97887272
)
)
# 2
d [[2]] <- rbind (
c (
0.2675343, 0.3167203, 0.4016824, 0.3119881, 0.3680556,
0.09902913, 0.1257367, 0.1349578, 0.1366906, 0.4723442,
0.2439614, 0.2401575, 0.2959184, 0.1376147, 0.4624113,
0.1189189, 0.2706450, 0.1621622, 0.01632653, 0.3847584
),
c (
0.9333812, 0.8716062, 0.8790074, 0.9153534, 0.8889449,
0.97546764, 0.9747218, 0.9620882, 0.9235575, 0.8427352,
0.8973988, 0.8534331, 0.8745992, 0.9666719, 0.8746626,
0.9395889, 0.9442811, 0.9733787, 0.99658716, 0.8350441
)
)
# 3
d [[3]] <- rbind (
c (
0.4449339, 0.3257576, 0.08494208, 0.07758621, 0.2345679,
0.009615385, 0.1959877, 0.06282723, 0.05785124, 0.4670588,
0.0562500, 0.1203704, 0.1000000, 0.1720779, 0.4771167,
0.4372331, 0.2102273, 0.1291449, 0.4567901, 0
),
c (
0.8480413, 0.8881877, 0.97683839, 0.95861325, 0.8839587,
0.990835401, 0.9353503, 0.97107607, 0.97832732, 0.8946960,
0.9568263, 0.9783830, 0.9800815, 0.9538397, 0.8978858,
0.8865221, 0.9256468, 0.9507978, 0.8657352, 1
)
)
# 4
d [[4]] <- rbind (
c (
0.7241379, 0.2611807, 0.2901961, 0.02531646, 0.5215054,
0.2336735, 0.5795779, 0.1518987, NA, 0.0625000, NA, 0,
0.6513274, 0.4292683, 0.3418573, 0.1452703, 0.2619543,
0.4628450, 0.2417375, 0.3950216
),
c (
0.7022668, 0.9451780, 0.8701041, 0.98733569, 0.8588725,
0.9451916, 0.8372441, 0.9076009, NA, 0.9842143, NA, 1,
0.7893403, 0.9412012, 0.9203506, 0.9627622, 0.9228610,
0.8665221, 0.9418134, 0.9021016
)
)
# 5
d [[5]] <- rbind (
c (
0.7239508, 0.8513952, 0.1402439, 0.1448468, 0.4007092,
0.09883721, 0.08634538, 0.2936747, 0.7217235, 0.5807783,
0.7090415, 0.1440678, 0.4746581, 0.2164179, 0.05633803,
0.3898587, NA, 0.1363636, 0.6066116, 0.2217195
),
c (
0.8041968, 0.7696561, 0.9385228, 0.9466528, 0.8734857,
0.97151782, 0.97918464, 0.9076568, 0.7783634, 0.8431704,
0.7343155, 0.9412296, 0.8566643, 0.9716889, 0.99403550,
0.9124251, NA, 0.9785596, 0.8332798, 0.9380071
)
)
# 6
d [[6]] <- rbind (
c (
0.4354430, 0.6561666, 0.2995392, NA, 0.3553922, 0.3404826,
0.2711864, 0.2535433, 0.4971098, 0.6451231, 0.117378, 0,
0.6751592, 0.4408353, 0.6392199, 0.5826598, NA, 0.1823770,
0.2105263, 0.1016043
),
c (
0.7925198, 0.8567067, 0.9134449, NA, 0.8825668, 0.9020107,
0.9247888, 0.9654961, 0.8274002, 0.7975106, 0.979065, 1,
0.7964435, 0.8632960, 0.8738289, 0.7831721, NA, 0.9436972,
0.9274683, 0.9744991
)
)
# 7
d [[7]] <- rbind (
c (
0.5275288, 0.8809990, 0.2042254, 0.2562101, 0, 0.3214286,
0.3479730, 0.2478032, 0.3501229, 0.5036298, 0.0560000,
0.7117819, 0.4114833, 0.2748092, 0.1865342, 0.2213115,
0.1674208, 0.3247863, 0.01388889, 0.2974013
),
c (
0.8974057, 0.7428764, 0.9503437, 0.9217992, 1, 0.9228010,
0.9036412, 0.9161946, 0.9596850, 0.8494607, 0.9632148,
0.7661997, 0.8901800, 0.9080806, 0.9574235, 0.9429245,
0.9445154, 0.9383823, 0.99440270, 0.9226305
)
)
# 8
d [[8]] <- rbind (
c (
0.4239291, 0.6470588, 0.4225146, 0.2475728, 0.4358491,
0.4682081, 0.8519306, 0.5047619, 0.03007519, 0.4723404,
0.1925676, 0.2028470, 0.5584677, 0.2478386, 0.06122449, 0,
0.1219512, 0.6993865, 0.3742455, NA
),
c (
0.9030931, 0.8842219, 0.8946512, 0.9000109, 0.8482130,
0.9018473, 0.7631321, 0.6506485, 0.98723649, 0.8749593,
0.9249907, 0.9497207, 0.8826570, 0.9193413, 0.97003127, 1,
0.8942574, 0.8027865, 0.8630442, NA
)
)
# 9
d [[9]] <- rbind (
c (
0.1160991, 0.4269663, 0.2256858, 0.3259604, 0.7434613,
0.3766376, 0.3615819, 0.5671642, 0.1721311, 0.7014749,
0.1000000, 0.07798165, 0.1622276, 0.4407583, 0.3865188,
0.2470309, 0.3603175, 0.1516588, 0.3102310, 0.4602133
),
c (
0.9666432, 0.7528710, 0.9193014, 0.9227199, 0.7834500,
0.8515732, 0.8863982, 0.8002182, 0.9434899, 0.7971016,
0.9594046, 0.98316892, 0.9457987, 0.8288464, 0.9053315,
0.8986293, 0.8698507, 0.9590871, 0.8651403, 0.8851207
)
)
# 10
d [[10]] <- rbind (
c (
0.3747811, NA, 0.4325744, NA, 0.7301301, 0.06694561,
0.2693267, 0.2651163, 0.5702840, 0.5865947, 0.6845638,
0.1111111, 0.5206897, NA, 0.2322275, 0.2739726,
0.03968254, 0.1763367, 0.9158513, 0.3980100
),
c (
0.8318046, NA, 0.8894870, NA, 0.8242255, 0.97770335,
0.8996235, 0.8986981, 0.8131951, 0.8357680, 0.8225032,
0.8502140, 0.8353131, NA, 0.9366721, 0.8817567,
0.99278373, 0.9559705, 0.6732793, 0.8348557
)
)
d <- lapply (seq_along (d_limit), function (i) {
data.frame (
d_limit = d_limit [i],
prop = d [[i]] [1, ],
change = d [[i]] [2, ]
)
})
d <- do.call (rbind, d)
ggplot (d, aes (x = d_limit, y = change)) +
geom_point (pch = 19, col = "orange") +
geom_smooth (method = "loess", formula = "y ~ x")
The decrease in travel times in this case approaches 15% as transfers are
implemented with walks of up to 1km, although values are highly variable
depending on starting stations. The equivalent proportion of stops for which
these transfers actually change travel times is shown in the following graph:
ggplot (d, aes (x = d_limit, y = prop)) +
geom_point (pch = 19, col = "orange") +
geom_smooth (method = "loess", formula = "y ~ x")
While travel times to most stops still remain unaffected, the proportion
affected does increase to a large minority of around 30-40% as transfer
distances approach 1km.
data.table::setDTthreads (nthr)
ATFutures/gtfs-router documentation built on Feb. 20, 2025, 4:11 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Necessary for CRAN to avoid CPU / elapsed time ratios being too high nthr <- data.table::setDTthreads (1)
GTFS feeds may include a table of possible transfers between stops, and
potentially between specific connecting services. There feeds are nevertheless
optional, and many feeds omit transfer tables, making them difficult if not
impossible to use for routing. The gtfsrouter package includes a function,
gtfs_transfer_table(),
which calculates and inserts a transfer table into a feed.
Basic Usage
This function can also be demonstrated with the very small feed included with
this package, by first running
berlin_gtfs_to_zip()
to create the feed in the temporary directory of the current R session.
library (gtfsrouter) f <- berlin_gtfs_to_zip () gtfs <- extract_gtfs (f, quiet = TRUE)
The transfers table of the feed looks like this:
gtfs$transfers
A transfers table is required for successful routing between different services, like with the following code:
gtfs_route ( gtfs, from = "Friedrichstr.", to = "Rosenthaler Platz", start_time = 12 * 3600, day = "Monday" )
That trip requires a transfer, and is possible because the feed has a table specifying the possibility of transferring at the "S+U Gesundbrunnen Bhf" station. Removing the transfers table demonstrates what typically happens when attempting to calculate routes on feeds which lack this information:
gtfs$transfers <- NULL gtfs_route ( gtfs, from = "Friedrichstr.", to = "Rosenthaler Platz", start_time = 12 * 3600, day = "Monday" )
No transfer is able to be make, and so no route is found. The
gtfs_transfer_table()
function
automatically calculates and adds a transfer table to a feed, enabling it once
again to be used to generate routes:
gtfs <- gtfs_transfer_table (gtfs, d_limit = 200) gtfs_route ( gtfs, from = "Friedrichstr.", to = "Rosenthaler Platz", start_time = 12 * 3600, day = "Monday" )
That route is considerably faster than the original one, because it utilises
a transfer (at "S+U Alexanderplatz") which is not in the original transfers
table. That particular transfer highlights the most important caveat to using the
gtfs_transfer_table()
function:
that tables may and often will still require some degree of manual checking and
adjustment to make them usable, as demonstrated in the following section.
Extending transfer tables
The above example first removed the transfer table by setting gtfs$transfers
<- NULL. Applying the gtfs_transfer_table()
function
to a feed which already has a transfer table will extend that table by adding
any additional transfers within the specified distance (see
below). Any transfers already present in the transfers
table will be retained as is, and the table will be extended by adding any new
transfers not present in the original table.
Transfers are calculated based on distance alone, and do not utilise any information on routes or trips. Some feeds, such as the example Berlin feed included with this package, include transfer information between specific routes and services, resulting in a transfers table in which station pairs are repeated numerous times for distinct combinations of routes and services:
gtfs <- extract_gtfs (f, quiet = TRUE) # 'f' is the location generated above nrow (gtfs$transfers) length (which (!duplicated (gtfs$transfers [, c ("from_stop_id", "to_stop_id")])))
n0 <- nrow (gtfs$transfers) n1 <- length (which (!duplicated (gtfs$transfers [, c ("from_stop_id", "to_stop_id")])))
The table only has r format (n1, big.mark = ",") unique pairs of from and
to stops, yet details r format (n0, big.mark = ",") possibles ways of
transferring between these stops. Removing and re-generating these transfers
gives the following results:
gtfs$transfers <- NULL gtfs <- gtfs_transfer_table (gtfs) nrow (gtfs$transfers)
The gtfs_transfer_table()
function
generates r nrow (gtfs$transfers) - n1 additional transfers not present in
the original feed, but as stated contains no information on transfers between
specific routes or trips. Alternatively, using the function to extend the
existing table, rather than re-generate it, gives the following result:
gtfs <- extract_gtfs (f, quiet = TRUE) gtfs <- gtfs_transfer_table (gtfs) nrow (gtfs$transfers)
Note that each call to
gtfs_transfer_table()
will only extend the table through adding any transfers not present in the
previous table, and that no transfers will be removed. The following code uses
the d_limit parameter described below to calculate
transfer tables for increasing maximal transfer distances.
gtfs <- extract_gtfs (f, quiet = TRUE) vapply (0:10, function (i) { gtfs <- gtfs_transfer_table (gtfs, d_limit = i * 100) return (nrow (gtfs$transfers)) }, integer (1))
The transfer table increases in size with each call, and retains all transfers generated from all previous calls. Because each call involves extending the transfer table, the table at each stage may be used for routing with transfers out to each specified distance. Subsequently reducing the transfer distance would then not be appropriate, as the table would still retain all transfers at previously-calculated (longer) distances:
gtfs <- gtfs_transfer_table (gtfs, d_limit = 100) nrow (gtfs$transfers)
In this case, the table would first have to be removed (gtfs$transfers <-
NULL), and the recalculated at the specified distance.
gtfs$transfers <- NULL gtfs <- gtfs_transfer_table (gtfs, d_limit = 100) nrow (gtfs$transfers)
Modifying transfer tables
This section demonstrates that transfer tables generated using the
gtfs_transfer_table()
function
often need to be manually modified to ensure sensible results. The second route
generated above after using the gtfs_transfer_table()
function
includes a transfer at "S+U Alexanderplatz" from a route named "S7" to one
named "U8". This train station is in fact one of the largest stations in
Berlin, with the "S" routes using elevated platforms above ground, and the "U"
denoting underground. The "U8" in particular is quite a long way underground,
and while transfer in the indicated time of just under three minutes may be
theoretically possible, it would likely require running, and ought not be
generally presumed to reflect a viable transfer.
Note further that the actual locations of these stations can be extracted with the following lines:
r <- gtfs_route ( gtfs, from = "Friedrichstr.", to = "Rosenthaler Platz", start_time = 12 * 3600, day = "Monday", include_ids = TRUE ) stns <- r$stop_id [3:4] # the transfer station IDs gtfs$stops [match (stns, gtfs$stops$stop_id), ]
The distance between them is:
s <- gtfs$stops [match (stns, gtfs$stops$stop_id), ] as.numeric (geodist::geodist (s [1, ], s [2, ]))
The transfer table algorithm presumes a pedestrian speed of 4km / hour, which is 1.11 m/s, meaning this distance should be able to be covered in just over 50 seconds. In reality, it would be impossible to run between these two stops in 50 seconds, primarily because of a need to traverse 3 or 4 vertical levels.
We now demonstrate how to add more realistic transfer times, by adding
additional time penalties for transferring between underground and overground
services, to reflect the extra time required to travel up or down between
stops. The sample feed included with this package only has "U" and "S" routes.
The following code demonstrates how to use this distinction to add additional
time penalties to the transfers table. The first step is to find the trip_id
values of all "S" and "U" services, which is itself a two-step procedure to
first extract route_id values and then match these to trip_id values.
Procedures may vary between feeds, but in the case of Berlin, the routes are
all identified by their route_short_name, as follows:
S_routes <- gtfs$routes$route_id [grep ("^S", gtfs$routes$route_short_name)] U_routes <- gtfs$routes$route_id [grep ("^U", gtfs$routes$route_short_name)] S_trips <- gtfs$trips$trip_id [which (gtfs$trips$route_id %in% S_routes)] U_trips <- gtfs$trips$trip_id [which (gtfs$trips$route_id %in% U_routes)]
The following code then uses those trip_id values to extract all
corresponding stops.
S_stops <- gtfs$stop_times$stop_id [which (gtfs$stop_times$trip_id %in% S_trips)] S_stops <- unique (S_stops) U_stops <- gtfs$stop_times$stop_id [which (gtfs$stop_times$trip_id %in% U_trips)] U_stops <- unique (U_stops)
Although in Berlin the stops for "U" and "S" services are strictly separated, this may not be the case for all other feeds. It might, for example, be useful to remove stops which are used by both types of services, leaving stops that can only serve as transfers between different kinds of services. The following two lines suffice for that:
S_stops <- S_stops [which (!S_stops %in% U_stops)] U_stops <- U_stops [which (!U_stops %in% S_stops)]
All we then need to do is to add additional transfers times for any transfers between these two sets of stops, arbitrarily choosing here a value of 2 minutes:
index <- which ((gtfs$transfers$from_stop_id %in% S_stops & gtfs$transfers$to_stop_id %in% U_stops) | (gtfs$transfers$from_stop_id %in% U_stops & gtfs$transfers$to_stop_id %in% S_stops)) gtfs$transfers$min_transfer_time [index] <- gtfs$transfers$min_transfer_time [index] + 120
Our route query then returns the following:
gtfs_route ( gtfs, from = "Friedrichstr.", to = "Rosenthaler Platz", start_time = 12 * 3600, day = "Monday" )
The route follows exactly the same connections, but now allows a far more
realistic time of just over 5 minutes for the transfer at Alexanderplatz.
This exemplifies that, while the gtfs_transfer_table()
function
can "automatically" generate transfer tables, these will often still need
manual tweaking and adjustment to reflect the unique characteristics of any
given system.
Transfer distances {#transfer-distances}
The gtfs_transfer_table()
function
includes an additional parameter, d_limit, quantifying the maximum
permissible walking distance between transfers, with a default value of 200
metres. Increasing this value generates greater numbers of possible transfers,
as the following code illustrates, starting by removing and re-creating the
transfer table, followed by adding the additional penalties for transfers
between the two types of services, this time constructed as a function for easy
re-use:
gtfs$transfers <- NULL gtfs <- gtfs_transfer_table (gtfs, d_limit = 500) transfer_penalties <- function (gtfs, penalty = 120) { S_routes <- gtfs$routes$route_id [grep ("^S", gtfs$routes$route_short_name)] U_routes <- gtfs$routes$route_id [grep ("^U", gtfs$routes$route_short_name)] S_trips <- gtfs$trips$trip_id [which (gtfs$trips$route_id %in% S_routes)] U_trips <- gtfs$trips$trip_id [which (gtfs$trips$route_id %in% U_routes)] S_stops <- gtfs$stop_times$stop_id [which (gtfs$stop_times$trip_id %in% S_trips)] S_stops <- unique (S_stops) U_stops <- gtfs$stop_times$stop_id [which (gtfs$stop_times$trip_id %in% U_trips)] U_stops <- unique (U_stops) S_stops <- S_stops [which (!S_stops %in% U_stops)] U_stops <- U_stops [which (!U_stops %in% S_stops)] index <- which ((gtfs$transfers$from_stop_id %in% S_stops & gtfs$transfers$to_stop_id %in% U_stops) | (gtfs$transfers$from_stop_id %in% U_stops & gtfs$transfers$to_stop_id %in% S_stops)) gtfs$transfers$min_transfer_time [index] <- gtfs$transfers$min_transfer_time [index] + 120 return (gtfs) } gtfs <- transfer_penalties (gtfs)
Submitting the same routing query now gives the following:
gtfs_route ( gtfs, from = "Friedrichstr.", to = "Rosenthaler Platz", start_time = 12 * 3600, day = "Monday" )
The route departs and arrives at the same time, but now includes an additional walking transfer over a distance which can be calculated by repeating the lines above:
r <- gtfs_route ( gtfs, from = "Friedrichstr.", to = "Rosenthaler Platz", start_time = 12 * 3600, day = "Monday", include_ids = TRUE ) s <- gtfs$stops [match (r$stop_id [2:3], gtfs$stops$stop_id), ] as.numeric (geodist::geodist (s [1, ], s [2, ]))
At a speed of 1.11m/s, this would take just under 6 minutes. With the additional penalty of 2 minutes for transferring from an "S" to a "U" service, this transfer would require just under 8 minutes, which is less than the time given in the route of just over 8.5 minutes. This demonstrates how increasing maximal walking distances increases numbers of possible transfers.
The following code shows the sizes of transfer tables as a function of maximal walking distances:
d_limit <- 1:20 * 100 n <- vapply (d_limit, function (i) { gtfs$transfer <- NULL gtfs <- gtfs_transfer_table (gtfs, d_limit = i) nrow (gtfs$transfers) }, integer (1)) d_limit <- d_limit / 1000 # in km n <- n / 1000 # in thousands plot ( d_limit, n, type = "l", col = "red", lwd = 2, xlab = "Maximal transfer distance", ylab = "Number of transfers (1000s)" )
The line is initially flat because this number (around 3,300) is the number of transfers possible between stops which have identical spatial locations (and so a distance of 0.0). Numbers of transfers can never be less than this number.
The following section delves further into the effect of this distance limit,
though examining the result of
gtfs_traveltimes()
for different distance limits.
Transfer distances and travel times
The preceding result might be sensibly interpreted to reflect something like
a plausible upper limit for a transfer, with a distance of 370 metres, plus
a vertical transfer between underground and overground services, expected to be
covered in under 8.5 minutes. This might -- and indeed likely should -- in turn
be considered to demonstrate how this d_limit parameter, along with any
additional manual adjustments applied to transfer tables, like the
transfer_penalties() function constructed above, need to be carefully
considered with regard to concrete knowledge of a particular system.
The gtfsrouter package is nevertheless not intended to be used only to
generate individual routing queries, but also includes the
gtfs_traveltimes()
function
designed to enable efficient estimation of travel times anywhere in a system
from any nominated station. The result of this function will obviously be
influenced by the transfers table, and in particular by the maximal walking
distance used to construct transfer tables with the gtfs_transfer_table()
function.
The effect of different distances can also be examined using the internal data
set provided with this package. The following function generates travel times
for a given d_limit a random sample of starting stations:
library (dplyr) library (hms) # 'parse_hms' function travel_times_d_limit <- function (gtfs, from, d_limit = 200) { gtfs$transfers <- NULL gtfs <- gtfs_transfer_table (gtfs, d_limit = d_limit) gtfs <- transfer_penalties (gtfs) start_time_limits <- 12:13 * 3600 get_one_times <- function (gtfs, from, start_time_limits) { x <- gtfs_traveltimes ( gtfs, from = from, start_time_limits = start_time_limits, quiet = TRUE ) ret <- NULL if (nrow (x) > 0) { # Convert duration to minutes: dur <- as.integer (parse_hms (x$duration)) / 60 ret <- data.frame ( from = from, to = x$stop_id, duration = dur ) } return (ret) } res <- lapply (from, function (i) { get_one_times (gtfs, i, start_time_limits) }) res <- do.call (rbind, res) %>% group_by (from, to) %>% summarise (duration = mean (duration), .groups = "drop") res$d_limit <- d_limit return (res) }
This function returns travel times from all stations listed in from to all
other (reachable) stations for the specified value of d_limit. The following
lines then compare these travel times between identical origin and
destination stations for a range of distance limits.
set.seed (10L) from <- sample (gtfs$stops$stop_name, size = 10) d_limit <- 1:10 * 100 x <- lapply (d_limit, function (i) { travel_times_d_limit (gtfs, from = from, d_limit = i) }) xall <- do.call (rbind, x) [, c ("from", "to")] xall <- xall [which (!duplicated (xall)), ] for (i in seq_along (x)) { y <- left_join (xall, x [[i]], by = c ("from", "to")) xall [paste0 ("d_", x [[i]]$d_limit [1])] <- y$duration } index <- which (xall$d_1000 != xall$d_100) # record number of stations for which travel times did not change: nsame <- nrow (xall) - length (index) xall <- xall [index, ] # travel times only: times <- xall %>% select (!c ("from", "to")) # differences with each increase in d_limit: times <- t (apply (times, 1, function (i) { diff (i) })) times <- data.frame (t = as.vector (times)) library (ggplot2) ggplot (times, aes (x = t)) + stat_bin (bins = 30, col = "red", fill = "orange") + scale_y_log10 () + xlab ("time difference (minutes)")
And these additional transfer possibilities can make a significant difference
to estimated travel times. Note, however, that the travel times only changed
for r length (index) stations, while the value of nsame value recording
numbers of stations for which travel times did not change was
r format (nsame, big.mark = ","). Travel times may also increase as
additional transfers may be used to reduce numbers of connecting services
required for a particular trip, and the algorithm generally searches for
connections with minimal numbers of transfers.
The following code the quantifies the overall effect of these reductions in travel times, measured as the linear reduction in comparison with travel times calculated using the original transfers table provided with the feed. The function also returns the proportion of all stations for which travel times were affected by the modified transfer table.
transfer_difference <- function (gtfs, nsamples = 10, d_limit = 200, day = "Monday", start_time_limits = 12:13 * 3600) { g1 <- data.table::copy (gtfs) g1 <- gtfs_timetable (g1, day = day) g2 <- data.table::copy (gtfs) g2 <- gtfs_transfer_table (g2, d_limit = d_limit, quiet = TRUE) g2 <- gtfs_timetable (g2, day = day) get1 <- function (gtfs, gtfs2, start_time_limits) { from <- sample (gtfs$stops$stop_name, size = 1) x1 <- gtfs_traveltimes ( gtfs, from = from, start_time_limits = start_time_limits, quiet = TRUE ) x2 <- gtfs_traveltimes ( gtfs2, from = from, start_time_limits = start_time_limits, quiet = TRUE ) if (nrow (x1) == 0L | nrow (x2) == 0L) { return (rep (NA, 2)) } x2 <- data.frame ( stop_id = x2$stop_id, duration2 = x2$duration ) x2 <- dplyr::left_join (x1, x2, by = "stop_id") dat <- data.frame ( x = as.integer (parse_hms (x2$duration)) / 60, y = as.integer (parse_hms (x2$duration2)) / 60 ) mod <- lm (y ~ x + 0, data = dat) return (c ( prop = length (which (dat$x != dat$y)) / nrow (dat), change = as.numeric (mod$coefficients) )) } vapply (seq (nsamples), function (i) { get1 (g1, g2, start_time_limits) }, numeric (2), USE.NAMES = FALSE ) }
That function can then be used to loop over a range of values of d_limit, and
to examine the results with the following code:
d_limit <- 1:10 * 100 set.seed (1L) d <- lapply (d_limit, function (i) { transfer_difference ( gtfs, nsamples = 20, d_limit = i, day = "Monday", start_time_limits = 12:13 * 3600 ) }) d <- lapply (seq_along (d_limit), function (i) { data.frame ( d_limit = d_limit [i], prop = d [[i]] [1, ], change = d [[i]] [2, ] ) }) d <- do.call (rbind, d) ggplot (d, aes (x = d_limit, y = change)) + geom_point (pch = 19, col = "orange") + geom_smooth (method = "loess", formula = "y ~ x")
That result shows that travel times do decrease with increasing limits of
maximal transfer distance, although the overall effect is very minimal. The
object d also records the proportion of station pairs for which modifications
to the transfers table actually changed travel times, which in this case
amounts to a mean value of r round (mean (d$prop, na.rm = TRUE), digits = 4),
clearly revealing that very few trips actually change.
A more realistic example
The following results apply the code given above to the full feed for
Stuttgart, Germany, showing what might more typically be expected as the
d_limit parameter is increased.
d <- list () # 1 d [[1]] <- rbind ( c ( 0.04787234, 0.3024283, 0.2137809, 0.4226190, 0.4782609, 0, 0.1996497, 0.0324826, 0.3122142, 0.1051136, 0.1330166, 0.1755486, 0.3659229, NA, 0.2471751, 0.03344482, 0.3617021, 0.3400000, NA, 0.05964215 ), c ( 0.97835370, 0.9045062, 0.9552470, 0.8157467, 0.8343242, 1, 0.8956478, 0.9857173, 0.9197187, 0.9813956, 0.9488823, 0.9505516, 0.8601199, NA, 0.9367492, 0.99126114, 0.8190608, 0.9064265, NA, 0.97887272 ) ) # 2 d [[2]] <- rbind ( c ( 0.2675343, 0.3167203, 0.4016824, 0.3119881, 0.3680556, 0.09902913, 0.1257367, 0.1349578, 0.1366906, 0.4723442, 0.2439614, 0.2401575, 0.2959184, 0.1376147, 0.4624113, 0.1189189, 0.2706450, 0.1621622, 0.01632653, 0.3847584 ), c ( 0.9333812, 0.8716062, 0.8790074, 0.9153534, 0.8889449, 0.97546764, 0.9747218, 0.9620882, 0.9235575, 0.8427352, 0.8973988, 0.8534331, 0.8745992, 0.9666719, 0.8746626, 0.9395889, 0.9442811, 0.9733787, 0.99658716, 0.8350441 ) ) # 3 d [[3]] <- rbind ( c ( 0.4449339, 0.3257576, 0.08494208, 0.07758621, 0.2345679, 0.009615385, 0.1959877, 0.06282723, 0.05785124, 0.4670588, 0.0562500, 0.1203704, 0.1000000, 0.1720779, 0.4771167, 0.4372331, 0.2102273, 0.1291449, 0.4567901, 0 ), c ( 0.8480413, 0.8881877, 0.97683839, 0.95861325, 0.8839587, 0.990835401, 0.9353503, 0.97107607, 0.97832732, 0.8946960, 0.9568263, 0.9783830, 0.9800815, 0.9538397, 0.8978858, 0.8865221, 0.9256468, 0.9507978, 0.8657352, 1 ) ) # 4 d [[4]] <- rbind ( c ( 0.7241379, 0.2611807, 0.2901961, 0.02531646, 0.5215054, 0.2336735, 0.5795779, 0.1518987, NA, 0.0625000, NA, 0, 0.6513274, 0.4292683, 0.3418573, 0.1452703, 0.2619543, 0.4628450, 0.2417375, 0.3950216 ), c ( 0.7022668, 0.9451780, 0.8701041, 0.98733569, 0.8588725, 0.9451916, 0.8372441, 0.9076009, NA, 0.9842143, NA, 1, 0.7893403, 0.9412012, 0.9203506, 0.9627622, 0.9228610, 0.8665221, 0.9418134, 0.9021016 ) ) # 5 d [[5]] <- rbind ( c ( 0.7239508, 0.8513952, 0.1402439, 0.1448468, 0.4007092, 0.09883721, 0.08634538, 0.2936747, 0.7217235, 0.5807783, 0.7090415, 0.1440678, 0.4746581, 0.2164179, 0.05633803, 0.3898587, NA, 0.1363636, 0.6066116, 0.2217195 ), c ( 0.8041968, 0.7696561, 0.9385228, 0.9466528, 0.8734857, 0.97151782, 0.97918464, 0.9076568, 0.7783634, 0.8431704, 0.7343155, 0.9412296, 0.8566643, 0.9716889, 0.99403550, 0.9124251, NA, 0.9785596, 0.8332798, 0.9380071 ) ) # 6 d [[6]] <- rbind ( c ( 0.4354430, 0.6561666, 0.2995392, NA, 0.3553922, 0.3404826, 0.2711864, 0.2535433, 0.4971098, 0.6451231, 0.117378, 0, 0.6751592, 0.4408353, 0.6392199, 0.5826598, NA, 0.1823770, 0.2105263, 0.1016043 ), c ( 0.7925198, 0.8567067, 0.9134449, NA, 0.8825668, 0.9020107, 0.9247888, 0.9654961, 0.8274002, 0.7975106, 0.979065, 1, 0.7964435, 0.8632960, 0.8738289, 0.7831721, NA, 0.9436972, 0.9274683, 0.9744991 ) ) # 7 d [[7]] <- rbind ( c ( 0.5275288, 0.8809990, 0.2042254, 0.2562101, 0, 0.3214286, 0.3479730, 0.2478032, 0.3501229, 0.5036298, 0.0560000, 0.7117819, 0.4114833, 0.2748092, 0.1865342, 0.2213115, 0.1674208, 0.3247863, 0.01388889, 0.2974013 ), c ( 0.8974057, 0.7428764, 0.9503437, 0.9217992, 1, 0.9228010, 0.9036412, 0.9161946, 0.9596850, 0.8494607, 0.9632148, 0.7661997, 0.8901800, 0.9080806, 0.9574235, 0.9429245, 0.9445154, 0.9383823, 0.99440270, 0.9226305 ) ) # 8 d [[8]] <- rbind ( c ( 0.4239291, 0.6470588, 0.4225146, 0.2475728, 0.4358491, 0.4682081, 0.8519306, 0.5047619, 0.03007519, 0.4723404, 0.1925676, 0.2028470, 0.5584677, 0.2478386, 0.06122449, 0, 0.1219512, 0.6993865, 0.3742455, NA ), c ( 0.9030931, 0.8842219, 0.8946512, 0.9000109, 0.8482130, 0.9018473, 0.7631321, 0.6506485, 0.98723649, 0.8749593, 0.9249907, 0.9497207, 0.8826570, 0.9193413, 0.97003127, 1, 0.8942574, 0.8027865, 0.8630442, NA ) ) # 9 d [[9]] <- rbind ( c ( 0.1160991, 0.4269663, 0.2256858, 0.3259604, 0.7434613, 0.3766376, 0.3615819, 0.5671642, 0.1721311, 0.7014749, 0.1000000, 0.07798165, 0.1622276, 0.4407583, 0.3865188, 0.2470309, 0.3603175, 0.1516588, 0.3102310, 0.4602133 ), c ( 0.9666432, 0.7528710, 0.9193014, 0.9227199, 0.7834500, 0.8515732, 0.8863982, 0.8002182, 0.9434899, 0.7971016, 0.9594046, 0.98316892, 0.9457987, 0.8288464, 0.9053315, 0.8986293, 0.8698507, 0.9590871, 0.8651403, 0.8851207 ) ) # 10 d [[10]] <- rbind ( c ( 0.3747811, NA, 0.4325744, NA, 0.7301301, 0.06694561, 0.2693267, 0.2651163, 0.5702840, 0.5865947, 0.6845638, 0.1111111, 0.5206897, NA, 0.2322275, 0.2739726, 0.03968254, 0.1763367, 0.9158513, 0.3980100 ), c ( 0.8318046, NA, 0.8894870, NA, 0.8242255, 0.97770335, 0.8996235, 0.8986981, 0.8131951, 0.8357680, 0.8225032, 0.8502140, 0.8353131, NA, 0.9366721, 0.8817567, 0.99278373, 0.9559705, 0.6732793, 0.8348557 ) ) d <- lapply (seq_along (d_limit), function (i) { data.frame ( d_limit = d_limit [i], prop = d [[i]] [1, ], change = d [[i]] [2, ] ) }) d <- do.call (rbind, d) ggplot (d, aes (x = d_limit, y = change)) + geom_point (pch = 19, col = "orange") + geom_smooth (method = "loess", formula = "y ~ x")
The decrease in travel times in this case approaches 15% as transfers are implemented with walks of up to 1km, although values are highly variable depending on starting stations. The equivalent proportion of stops for which these transfers actually change travel times is shown in the following graph:
ggplot (d, aes (x = d_limit, y = prop)) + geom_point (pch = 19, col = "orange") + geom_smooth (method = "loess", formula = "y ~ x")
While travel times to most stops still remain unaffected, the proportion affected does increase to a large minority of around 30-40% as transfer distances approach 1km.
data.table::setDTthreads (nthr)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.