Some functions of the accessibility
package, such as
floating_catchment_area()
and
gravity_access()
, use decay functions to continuously
discount the weight of opportunities as travel costs become larger. For
convenience, the package currently includes four decay functions
discussed in (Kwan 1998). See the
implemented functions below. Additionally, the package also allows users
to pass any custom decay function that converts travel cost
t_ij
to an impedance factor (see section 3).
Also known as ‘step’ decay function, commonly used in cumulative opportunity measures.
\[ \begin{aligned} f(t_{ij})= \left\{ \begin{array}{ll} 1 & \quad \text{for }t_{ij} \leq T \\ 0 & \quad \text{for }t_{ij} > T \end{array} \right.\\ \end{aligned} \]
Where \(t_{ij}\) is the travel cost
between origin i and destination j; and \(T\) is the cutoff
of maximum
travel cost.
\[ \begin{aligned} f(t_{ij})= \left\{ \begin{array}{ll} (1 - t_{ij}/ T) & \quad \text{for }t_{ij} \leq T \\ 0 & \quad \text{for }t_{ij} > T \end{array} \right.\\ \end{aligned} \]
Where \(t_{ij}\) is the travel cost
between origin i and destination j; and \(T\) is the cutoff
of maximum
travel cost.
\[ \begin{aligned} f(t_{ij})= e^{(-\beta t_{ij})} \end{aligned} \]
Where: \(t_{ij}\) is the travel cost
between origin i and destination j; and \(\beta\) is the decay_value
that tells the speed of decay.
\[ \begin{aligned} f(t_{ij})= \left\{ \begin{array}{ll} 1 & \quad \text{for } t_{ij}\leq 1 \\ t_{ij}^{-\beta} & \quad \text{for }t_{ij} > 1 \end{array} \right.\\ \end{aligned} \]
Where \(t_{ij}\) is the travel cost
between origin i and destination j; and \(\beta\) is the decay_value
that tells the speed of decay.
library(accessibility)
library(data.table)
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.1.3
# Generate inputs
<- 0:100
vec <- 0.2
decay_value <- 50
cutoff
# Return functions
<- decay_binary(cutoff=cutoff)
step <- decay_linear(cutoff=cutoff)
linear <- decay_exponential(decay_value=decay_value)
exponential <- decay_power(decay_value = decay_value)
power
<- data.table(minutes = vec,
df binary = step(vec),
linear = linear(vec),
exponential = exponential(vec),
inverse_power = power(vec)
)
# reshape the data to long format
<- data.table::melt.data.table(data = df,
df2 id.vars = 'minutes',
variable.name = 'decay_function',
value.name = 'impedance_factor')
# plot
ggplot() +
geom_line(data=df2, aes(x=minutes, y=impedance_factor, color=decay_function), show.legend = FALSE) +
facet_wrap(.~decay_function, ncol = 2) +
theme_minimal()
Let’s use the sample data available in the accessibility
package o demonstrate how you could use a custom decay function. Let’s
load the data first.
# load input data
<- system.file("extdata/ttm_bho.rds", package = "accessibility")
data_path <- readRDS(data_path)
ttm head(ttm)
#> from_id to_id travel_time population jobs schools
#> 1: 89a88cdb57bffff 89a88cdb57bffff 5.8 606 82 0
#> 2: 89a88cdb57bffff 89a88cdb597ffff 47.0 606 308 2
#> 3: 89a88cdb57bffff 89a88cdb5b3ffff 48.0 606 100 0
#> 4: 89a88cdb57bffff 89a88cdb5cfffff 47.0 606 109 0
#> 5: 89a88cdb57bffff 89a88cd909bffff 64.0 606 0 0
#> 6: 89a88cdb57bffff 89a88cd90b7ffff 59.0 606 480 0
Now let’s create a very simple custom decay function that uses a
parameter k
to convert the travel cost t_ij
between origin i
and destination j
into an
impedance factor.
# create custom decay function
<- function(k) {
custom_decay_fun <- function(t_ij) {
impedance <- 1 / t_ij ^ k
f return(f)
} }
You can use your custom_decay_fun()
inside the
floating_catchment_area()
and gravity_access()
functions like this:
# calculate gravity-based accessibility
<- gravity_access(
grav_custom data = ttm,
opportunity_col = 'jobs',
decay_function = custom_decay_fun(k=0.5),
travel_cost_col = 'travel_time',
by_col = 'from_id'
)
head(grav_custom)
#> from_id access
#> 1: 89a88cdb57bffff 73936.42
#> 2: 89a88cdb597ffff 72088.42
#> 3: 89a88cdb5b3ffff 74512.95
#> 4: 89a88cdb5cfffff 78470.00
#> 5: 89a88cd909bffff 74298.70
#> 6: 89a88cd90b7ffff 77323.59