inst/examples/swissmetro/plot_b28_parameter_overrides.R

In rbiogeme: Interface to 'Biogeme'

#!/usr/bin/env Rscript

# b28. Explicit parameter overrides
#
# This example mirrors plot_b28_parameter_overrides.py. It first builds an
# ordinary Swissmetro MNL expression, then applies two native preprocessing
# overrides: b_cost becomes a fixed Beta with a supplied value and asc_train
# becomes Numeric(0), removing it from the estimated parameter vector.

library(rbiogeme)

# prepare_swissmetro_example() is defined in example_utils.R. It parses the
# command line, validates the data/Python paths, configures the bridge, reads
# the data, and creates a fresh output directory. It does not define the model.
script_path <- commandArgs(trailingOnly = FALSE)
script_path <- sub("^--file=", "", script_path[startsWith(script_path, "--file=")][[1L]])
source(file.path(dirname(normalizePath(script_path)), "example_utils.R"))

build_b28_parameter_overrides_model <- function(database) {
  # These ordinary Beta definitions match the native pre-override expression.
  asc_car <- biogeme_beta("asc_car", start = 0)
  asc_train <- biogeme_beta("asc_train", start = 0)
  b_time <- biogeme_beta("b_time", start = 0)
  b_cost <- biogeme_beta("b_cost", start = 0)

  v_train <- asc_train + b_time * variable("TRAIN_TT_SCALED") +
    b_cost * variable("TRAIN_COST_SCALED")
  v_swissmetro <- b_time * variable("SM_TT_SCALED") +
    b_cost * variable("SM_COST_SCALED")
  v_car <- asc_car + b_time * variable("CAR_TT_SCALED") +
    b_cost * variable("CAR_CO_SCALED")
  log_probability <- logit_log_probability(
    utilities = list(`1` = v_train, `2` = v_swissmetro, `3` = v_car),
    availability = list(
      `1` = variable("TRAIN_AV_SP"),
      `2` = variable("SM_AV"),
      `3` = variable("CAR_AV_SP")
    ),
    alternative = variable("CHOICE")
  )

  # parameter_overrides is passed to the native ParameterOverrides and
  # apply_parameter_overrides APIs during bridge compilation. R does not
  # rewrite or numerically evaluate the expression tree itself.
  overrides <- list(
    b_cost = biogeme_beta("b_cost", start = -1, lower = -10, upper = 0, fixed = TRUE),
    asc_train = 0
  )

  biogeme_model(
    database = database,
    formula = log_probability,
    parameter_overrides = overrides,
    control = biogeme_control(
    output_directory = prepared$output,
      model_name = "b28_parameter_overrides",
      generate_html = FALSE,
      generate_yaml = FALSE,
      save_iterations = FALSE
    )
  )
}

prepared <- prepare_swissmetro_example(
  commandArgs(trailingOnly = TRUE),
  default_model = "b28_parameter_overrides"
)

database <- swissmetro_data(prepared$data)
model <- build_b28_parameter_overrides_model(database)
fit <- estimate(
  model,
  model_name = "b28_parameter_overrides",
  control = model$control
)

print(summary(fit))
print(coef(fit))

invisible(fit)