Estimates UK Rail stations usage

estimates_rail_stations_usage.R

################################################################################
# UK * Estimates of rail station usage: passenger entries, exits, interchanges #
################################################################################
# ORR: https://dataportal.orr.gov.uk/statistics/usage/estimates-of-station-usage
# NLC: National Location Code, TLC: 3-letters Code, LTA: London Travelcard Area, NRR: Network Rail Region, SRS: Strategic Route Section

dmpkg.funs::load_pkgs('data.table', 'sf')

vars <- c('101' = 'full', '102' = 'reduced', '103' = 'season', '105' = 'total', '109' = 'interchanges')

# Stations + Data 2020
y <- fread(
        'https://dataportal.orr.gov.uk/media/1909/table-1410-passenger-entries-and-exits-and-interchanges-by-station.csv', 
        select = c(1:5, 9, 14, 15, 22:24, 26, 27),
        col.names = c('name', 'X101', 'X102', 'X103', 'X105', 'X109', 'NLC', 'TLC', 'xe', 'yn', 'owner', 'LTA', 'NRR'),
        na.strings = ':'
)

y <- y[NRR != 'Non-NR']
vc <- names(y)[grepl('X', names(y))]
y[, (vc) := lapply(.SD, \(x) as.numeric(gsub(',', '', x))), .SDcols = vc]
y[, is_lta := 1][is.na(LTA), is_lta := 0][, LTA := NULL]
y <- y[order(NLC)]

ys <- dd_df2spat(y[, !grep('^X', names(y), value = TRUE), with = FALSE ], 'NLC', 'xe', 'yn', 'sf', TRUE)
ys <- ys |> st_join(dmpkg.bnduk::OA, join = st_within)

yx <- ys |> subset(is.na(OA))
yxc <- yx |> st_buffer(dst) |> st_contains(dmpkg.bnduk::OA)
ym <- leaflet() |> addTiles()
for(idx in 1:length(yxc))
    ym <- ym |>
        addPolygons(
            data = dmpkg.bnduk::OA[yxc[[idx]],],
            label = ~OA
        ) |>
        addMarkers(
          data = yx[idx,],
          label = ~paste(NLC, '-', name)
        )
ym
  
ys$OA[ys$NLC == 5892] <- 'E00116811' 
ys$OA[ys$NLC == 5541] <- 'E00087549' 
ys$OA[ys$NLC == 5542] <- 'E00087549' 
ys$OA[ys$NLC == 5540] <- 'E00174448' 
ys$OA[ys$NLC == 5112] <- 'E00000024' 

saveRDS(ys, './estimates_rail_stations_usage/stations')

yd <- data.table(
          year = 2020,
          melt(y[, c('NLC', grep('^X', names(y), value = TRUE)), with = FALSE ], id.vars = 'NLC')
)

# Data 2019
tmpf <- tempfile()
download.file('https://dataportal.orr.gov.uk/media/2023/estimates-of-station-usage-2019-20.ods', destfile = tmpf)
y <- as.data.table(readODS::read_ods(tmpf, 1, skip = 5))
unlink(tmpf)
y <- y[, c(2:5, 9, 14)][NLC %in% ys$NLC]
setnames(y, c('X101', 'X102', 'X103', 'X105', 'X109', 'NLC'))
yd <- rbindlist(list(
          yd,
          data.table(
              year = 2019,
              melt(y[, c('NLC', grep('^X', names(y), value = TRUE)), with = FALSE ], id.vars = 'NLC')
          )
))

# Data 2018
tmpf <- tempfile()
download.file('https://dataportal.orr.gov.uk/media/1667/table-1410-estimates-of-station-usage-2018-19.ods', destfile = tmpf)
y <- as.data.table(readODS::read_ods(tmpf, 3))
unlink(tmpf)
y <- y[, c(1, 17:20, 22)][NLC %in% ys$NLC]
setnames(y, c('NLC', 'X101', 'X102', 'X103', 'X105', 'X109'))
yd <- rbindlist(list(
          yd,
          data.table(
              year = 2018,
              melt(y[, c('NLC', grep('^X', names(y), value = TRUE)), with = FALSE ], id.vars = 'NLC')
          )
))

# Data 2017
tmpf <- tempfile()
download.file('https://dataportal.orr.gov.uk/media/1220/table-1410-estimates-of-station-usage-2017-18.ods', destfile = tmpf)
y <- as.data.table(readODS::read_ods(tmpf, 3))
unlink(tmpf)
y <- y[, c(1, 13, 14, 17:20, 22)][NLC %in% ys$NLC]
y[y == 'n/a'] <- NA
setnames(y, c('NLC', 'SRS', 'SRSn', 'X101', 'X102', 'X103', 'X105', 'X109'))
ys <- ys |> merge(y[, .(NLC, SRS, SRSn)], all.x = TRUE)
saveRDS(ys, './estimates_rail_stations_usage/stations')
fwrite( cbind(st_drop_geometry(ys), st_coordinates(ys)) |> setnames(c('X', 'Y'), c('x_lon', 'y_lat')), './estimates_rail_stations_usage/stations.csv')

y[, c('SRS', 'SRSn') := NULL]
yd <- rbindlist(list(
          yd,
          data.table(
              year = 2017,
              melt(y[, c('NLC', grep('^X', names(y), value = TRUE)), with = FALSE ], id.vars = 'NLC')
          )
))

# Timeseries total + Innterchanges 
tmpf <- tempfile()
download.file('https://dataportal.orr.gov.uk/media/1908/table-1415-time-series-of-passenger-entries-and-exits-and-interchanges-by-station.ods', destfile = tmpf)
y <- as.data.table(readODS::read_ods(tmpf, 2, skip = 3))
y <- y[, c(4, 7:26)][NLC %in% ys$NLC]
names(y) <- substr(names(y), 1, 4)
yd <- rbindlist(list( yd, melt(y, id.vars = 'NLC', variable.name = 'year', variable.factor = FALSE)[, variable := 'X105'] ), use.names = TRUE)
y <- as.data.table(readODS::read_ods(tmpf, 3, skip = 3))
y <- y[, c(4, 7:26)][NLC %in% ys$NLC]
names(y) <- substr(names(y), 1, 4)
yd <- rbindlist(list( yd, melt(y, id.vars = 'NLC', variable.name = 'year', variable.factor = FALSE)[, variable := 'X109'] ), use.names = TRUE)
unlink(tmpf)

# save
yd <- yd[!(is.na(value) | value == ':' | value == 0)][, `:=`( year = as.integer(year), NLC = as.integer(NLC), value = as.integer(value) )]
saveRDS(yd, './estimates_rail_stations_usage/data')
fwrite(yd, './estimates_rail_stations_usage/data.csv')

# end
rm(list = ls())
gc()

stations.csv