inst/examples/swissmetro/example_utils.R

In rbiogeme: Interface to 'Biogeme'

parse_swissmetro_arguments <- function(arguments, defaults = list()) {
  options <- defaults
  for (argument in arguments) {
    if (!startsWith(argument, "--") || !grepl("=", argument, fixed = TRUE)) {
      stop("Arguments must use the --name=value form: ", argument, call. = FALSE)
    }
    pieces <- strsplit(sub("^--", "", argument), "=", fixed = TRUE)[[1L]]
    key <- gsub("-", "_", pieces[[1L]], fixed = TRUE)
    value <- paste(pieces[-1L], collapse = "=")
    if (!nzchar(key)) stop("Argument names must not be empty.", call. = FALSE)
    options[[key]] <- value
  }
  options
}

example_flag <- function(value, default = FALSE) {
  if (is.null(value) || !nzchar(value)) return(default)
  value <- tolower(value)
  if (value %in% c("1", "true", "yes")) return(TRUE)
  if (value %in% c("0", "false", "no")) return(FALSE)
  stop("Logical options must be true or false.", call. = FALSE)
}

example_integer <- function(value, name) {
  result <- suppressWarnings(as.numeric(value))
  if (length(result) != 1L || is.na(result) || result < 1 || result != floor(result)) {
    stop(name, " must be a positive integer.", call. = FALSE)
  }
  as.integer(result)
}

prepare_swissmetro_example <- function(arguments, default_model) {
  options <- parse_swissmetro_arguments(
    arguments,
    defaults = list(
      data = Sys.getenv("RBIOGEME_SWISSMETRO_DATA", unset = ""),
      python = Sys.getenv("RBIOGEME_PYTHON", unset = ""),
      output = ""
    )
  )
  if (is.null(options$data) || !nzchar(options$data) || !file.exists(options$data)) {
    stop("Provide --data=/path/to/swissmetro.dat or set RBIOGEME_SWISSMETRO_DATA.", call. = FALSE)
  }
  if (!is.null(options$python) && nzchar(options$python)) {
    if (!file.exists(options$python)) {
      stop("The selected Python executable does not exist: ", options$python, call. = FALSE)
    }
    rbiogeme::biogeme_config(python = options$python)
  }
  if (is.null(options$output) || !nzchar(options$output)) {
    stop(
      "Provide --output=/path/to/output. Persistent native files are never "
        ,
      "written to the working directory by default.",
      call. = FALSE
    )
  }
  output <- normalizePath(path.expand(options$output), mustWork = FALSE)
  dir.create(output, recursive = TRUE, showWarnings = FALSE)
  data <- read.delim(options$data, check.names = FALSE, stringsAsFactors = FALSE)
  list(options = options, data = data, output = output)
}