R/merge_vbz_files.R

In lucasjamar/VBZtools: Tools for analyzing Zurich public transport data

#' @title Merge CSVs from VBZ export
#' @description Merge CSVs from VBZ export. Correctly determine dates and times by using anydate to avoid errors between CET/CEST.
#' @import data.table
#' @import anytime
#' @import stringr
#' @importFrom lubridate seconds
#' @import fst
#' @param import_folder Folder where data is located
#' @param export_folder Folder to export dataset
#' @return FST file of VBZ passenger data combined together
#' @export

merge_vbz_files <- function(import_folder, export_folder) {

  # Clean folder names
  import_folder <- clean_folder(import_folder)

  if (is.null(export_folder)) {
    export_folder <- import_folder
  } else {
    export_folder <- clean_folder(export_folder)
  }

  files <- list.files(path = import_folder, pattern = "*.csv")
  df_names <- stringr::str_remove_all(files, ".csv")
  df_names <- stringr::str_to_lower(df_names)
  df_names <- make.names(df_names)
  files <- paste0(import_folder, files)

  # Load all files
  list2env(lapply(
    setNames(files, df_names),
    fread,
    logical01 = TRUE,
    stringsAsFactors = TRUE,
    encoding = "Latin-1"
  ),
  envir = .GlobalEnv
  )

  linie_columns <- c("Linienname", "Linienname_Fahrgastauskunft")
  haltestellen_columns <- c("Haltestellen_Id", "Haltestellenlangname")

  # Merge all necessary files and necessary columns
  dt <- zaehl_haltestelle
  rm(zaehl_haltestelle)
  dt[zaehl_fahrt, on = .(Zaehl_Fahrt_Id), names(zaehl_fahrt) := mget(names(zaehl_fahrt))]
  dt[fahrzeug, on = .(Fahrzeug_Id), names(fahrzeug) := mget(names(fahrzeug))]
  dt[vehicle_clean, on = .(Fahrzeugtyp_Id), names(vehicle_clean) := mget(names(vehicle_clean))]
  dt[teillinien, on = .(Teillinien_Id), Richtung := Richtung]
  dt[linie, on = .(Linien_Id), (linie_columns) := mget(linie_columns)]
  dt[haltestellen, on = .(Nachf_HST_ID = Haltestellen_Id), paste0(haltestellen_columns, "_naechste") := mget(haltestellen_columns)]
  dt[haltestellen, on = .(Haltestellen_Id), (haltestellen_columns) := mget(haltestellen_columns)]

  # Remove unnecessary dataframes
  rm(
    zaehl_fahrt,
    fahrzeug,
    teillinien,
    fahrzeitprofile,
    umlauf,
    tagtyp,
    linie,
    abfahrt,
    fahrzeugtyp,
    vehicle_clean,
    haltestellen,
    stops,
    export,
    hoch_haltestelle,
    hoch_kalender,
    liku,
    strecken,
    fahrzeiten,
    t_fahrzeuge
  )

  keep_columns <- c(
    "Zaehl_Fahrt_Id",
    "Haltestellen_Id",
    "Ist_Fahrzeit",
    "Ist_Wartezeit",
    "Einsteiger",
    "Aussteiger",
    "Besetzung",
    "IST_AN",
    "IST_AB",
    "Datum",
    "Richtung",
    "Ist_Abfahrtszeit",
    "Ist_Ankunftszeit",
    "Fahrzeug_Id",
    "FZG",
    "Fahrzeugtypname",
    "Sitzplaetze",
    "Kap_2m2",
    "Haltestellen_Id_naechste",
    "Haltestellenlangname_naechste",
    "Linienname_Fahrgastauskunft",
    "Haltestellenlangname",
    "n_tueren"
  )

  # Keep only certain columns
  dt[, names(dt)[!names(dt) %in% keep_columns] := NULL]

  # Convert date times
  dt[, Datum := anytime::anydate(Datum)]
  # Trip start and end times are given in seconds since minute
  dt[, Ist_Abfahrtszeit := Datum + lubridate::seconds(Ist_Abfahrtszeit)]
  dt[, Ist_Ankunftszeit := Datum + lubridate::seconds(Ist_Ankunftszeit)]
  # However their value can be > 86400 so date is not the true date
  dt[, Datum := anytime::anydate(Ist_Abfahrtszeit)]
  # We use the true date to determine the arrival and departure times at stops. Use anytime due to summer time change issues.
  dt[, IST_AN := paste(Datum, IST_AN)]
  dt[, IST_AB := paste(Datum, IST_AB)]
  dt[, IST_AN := anytime::anytime(IST_AN)]
  dt[, IST_AB := anytime::anytime(IST_AB)]
  dt[IST_AN < Ist_Abfahrtszeit, IST_AN := IST_AN + lubridate::days(1)]
  dt[IST_AB < Ist_Abfahrtszeit, IST_AB := IST_AB + lubridate::days(1)]

  # Add sitting categories
  dt[Besetzung <= Sitzplaetze / 2, Besetzung_Kategorie := "Low"]
  dt[Besetzung > Sitzplaetze / 2 & Besetzung <= Kap_2m2 / 2, Besetzung_Kategorie := "Medium"]
  dt[Besetzung > Kap_2m2 / 2, Besetzung_Kategorie := "High"]
  dt[, Belastungs_Faktor := Besetzung / (Kap_2m2 * 0.5)]

  fst::write_fst(dt, paste0(export_folder,"vbz_stage1.fst"))
}