swissmetro_one.R
In rbiogeme: Interface to 'Biogeme'

# Prepare the one-observation Swissmetro database used by b04 and b05.
#
# The native examples read swissmetro.dat and retain only observation index 0.
# This helper performs the same operation, defines the derived variables with
# native Biogeme expressions, and returns the database plus the expressions
# used by the model scripts.  It contains data preparation only; the model
# equations remain visible in each example script.

prepare_swissmetro_one_database <- function(data) {
  required <- c(
    "SM_CO", "TRAIN_CO", "CAR_CO", "TRAIN_TT", "SM_TT", "CAR_TT",
    "GA", "CAR_AV", "TRAIN_AV", "SM_AV", "SP", "CHOICE"
  )
  if (!is.data.frame(data) || any(!required %in% names(data))) {
    stop(
      "data must contain the Swissmetro columns: ",
      paste(required, collapse = ", "),
      call. = FALSE
    )
  }
  one_row <- data[1L, , drop = FALSE]
  database <- biogeme_database("swissmetro", one_row)

  # These definitions reproduce swissmetro_one.py.  The comparisons and
  # arithmetic stay symbolic until the complete database is compiled.
  ga <- variable("GA")
  sp <- variable("SP")
  derived <- list(
    SM_COST = variable("SM_CO") * (ga == 0),
    TRAIN_COST = variable("TRAIN_CO") * (ga == 0),
    CAR_AV_SP = variable("CAR_AV") * (sp != 0),
    TRAIN_AV_SP = variable("TRAIN_AV") * (sp != 0),
    TRAIN_TT_SCALED = variable("TRAIN_TT") / 100,
    TRAIN_COST_SCALED = variable("TRAIN_COST") / 100,
    SM_TT_SCALED = variable("SM_TT") / 100,
    SM_COST_SCALED = variable("SM_COST") / 100,
    CAR_TT_SCALED = variable("CAR_TT") / 100,
    CAR_CO_SCALED = variable("CAR_CO") / 100
  )
  for (name in names(derived)) {
    database <- biogeme_database_define_variable(database, name, derived[[name]])
  }
  list(
    database = database,
    choice = variable("CHOICE"),
    sm_av = variable("SM_AV"),
    car_av_sp = variable("CAR_AV_SP"),
    train_av_sp = variable("TRAIN_AV_SP"),
    sm_tt_scaled = variable("SM_TT_SCALED"),
    sm_cost_scaled = variable("SM_COST_SCALED"),
    train_tt_scaled = variable("TRAIN_TT_SCALED"),
    train_cost_scaled = variable("TRAIN_COST_SCALED"),
    car_tt_scaled = variable("CAR_TT_SCALED"),
    car_co_scaled = variable("CAR_CO_SCALED")
  )
}