R/runtime.R

In rbiogeme: Interface to 'Biogeme'

#' @importFrom stats coef logLik nobs setNames vcov
#' @importFrom utils capture.output
NULL

#' Configure the Python runtime used by rbiogeme
#'
#' Configuration must be performed before Python is initialized in the R
#' session. The default requirement is `biogeme==3.3.5`; use this function to
#' select a different compatible Biogeme requirement explicitly.
#'
#' `biogeme_config(python = ...)` selects an existing Python interpreter; it
#' does not install Biogeme into that interpreter. If `python` is omitted,
#' reticulate can provision the configured requirement in its managed
#' environment.
#'
#' @param python Optional Python executable. If `NULL`, reticulate selects the
#'   interpreter according to its normal configuration rules.
#' @param biogeme_requirement Python requirement passed to
#'   [reticulate::py_require()].
#' @param debug If `TRUE`, preserve the Python traceback in Biogeme error
#'   conditions.
#' @return The current configuration, invisibly when changes are requested and
#'   visibly otherwise.
#' @export
biogeme_config <- function(
    python = NULL,
    biogeme_requirement = NULL,
    debug = NULL
) {
  if (!is.null(python) || !is.null(biogeme_requirement)) {
    if (reticulate::py_available(initialize = FALSE)) {
      stop(
        "The Python runtime is already initialized; configure rbiogeme " ,
          "before constructing a model or calling biogeme_python().",
        call. = FALSE
      )
    }
  }

  if (!is.null(python)) {
    if (!is.character(python) || length(python) != 1L || is.na(python)) {
      stop("python must be a single non-missing character string.", call. = FALSE)
    }
    .biogeme_state$python <- python
  }

  if (!is.null(biogeme_requirement)) {
    if (!is.character(biogeme_requirement) ||
        length(biogeme_requirement) != 1L ||
        is.na(biogeme_requirement) ||
        !nzchar(biogeme_requirement)) {
      stop(
        "biogeme_requirement must be a single non-empty character string.",
        call. = FALSE
      )
    }
    .biogeme_state$requirement <- biogeme_requirement
  }

  if (!is.null(debug)) {
    if (!is.logical(debug) || length(debug) != 1L || is.na(debug)) {
      stop("debug must be one non-missing logical value.", call. = FALSE)
    }
    .biogeme_state$debug <- isTRUE(debug)
  }

  result <- list(
    python = .biogeme_state$python,
    biogeme_requirement = .biogeme_state$requirement,
    debug = isTRUE(.biogeme_state$debug)
  )
  if (!is.null(python) || !is.null(biogeme_requirement) || !is.null(debug)) {
    invisible(result)
  } else {
    result
  }
}

#' Initialize and return the Python interpreter used by rbiogeme
#'
#' @return A reticulate Python configuration object. If no interpreter was
#'   selected, reticulate may provision the configured native requirement in
#'   its managed environment.
#' @export
biogeme_python <- function() {
  tryCatch(
    {
      if (!reticulate::py_available(initialize = FALSE)) {
        if (!is.null(.biogeme_state$python)) {
          reticulate::use_python(.biogeme_state$python, required = TRUE)
        }
        reticulate::py_require(.biogeme_state$requirement)
      }
      reticulate::py_config()
    },
    error = function(error) {
      biogeme_rethrow(
        error,
        class = "biogeme_environment_error",
        operation = "Python environment initialization",
        suggestion = paste0(
          "check the Python executable and install ",
          .biogeme_state$requirement
        )
      )
    }
  )
}

#' Report the active R, Python, Biogeme, and numerical-library versions
#'
#' This function initializes the configured runtime. For a check that catches
#' initialization failures and returns an actionable status object, use
#' [biogeme_check()].
#'
#' @return A named list containing environment diagnostics.
#' @seealso [biogeme_check()], [biogeme_config()]
#' @export
biogeme_diagnostics <- function() {
  python_config <- biogeme_python()
  metadata <- reticulate::import("importlib.metadata", convert = TRUE)

  package_version <- function(package_name) {
    tryCatch(
      as.character(metadata$version(package_name)),
      error = function(...) NA_character_
    )
  }

  available <- function(module_name) {
    isTRUE(reticulate::py_module_available(module_name))
  }

  list(
    r_version = as.character(getRversion()),
    python = python_config$python,
    python_version = python_config$version_string,
    biogeme_requirement = .biogeme_state$requirement,
    packages = list(
      biogeme = package_version("biogeme"),
      numpy = package_version("numpy"),
      scipy = package_version("scipy"),
      jax = package_version("jax")
    ),
    modules_available = list(
      biogeme = available("biogeme"),
      numpy = available("numpy"),
      scipy = available("scipy"),
      jax = available("jax")
    )
  )
}

#' Automatically prepare the native Biogeme runtime
#'
#' This is the recommended first command for a new user. With no `python`
#' argument, reticulate provisions an isolated managed environment containing
#' the configured Biogeme requirement when the runtime is first initialized.
#' If `python` is supplied, that existing interpreter is selected instead and
#' must already contain the requested Biogeme package. In both cases the
#' function returns the same actionable status object as [biogeme_check()].
#'
#' @param python Optional existing Python executable. If omitted, use the
#'   reticulate-managed environment when no user-managed environment has been
#'   selected.
#' @param biogeme_requirement Python requirement to provision or verify.
#'   Defaults to `biogeme==3.3.5`.
#' @param debug If `TRUE`, preserve the Python traceback in Biogeme error
#'   conditions.
#' @param verbose If `TRUE`, print the setup status and any corrective actions.
#' @return An object of class `biogeme_check`. Its `ready` element is `TRUE`
#'   when the runtime can be used for model operations.
#' @seealso [biogeme_check()], [biogeme_config()]
#' @export
biogeme_setup <- function(
    python = NULL,
    biogeme_requirement = NULL,
    debug = NULL,
    verbose = interactive()
) {
  if (!is.logical(verbose) || length(verbose) != 1L || is.na(verbose)) {
    stop("verbose must be one non-missing logical value.", call. = FALSE)
  }

  biogeme_config(
    python = python,
    biogeme_requirement = biogeme_requirement,
    debug = debug
  )

  force_managed <- is.null(python) &&
    is.null(.biogeme_state$python) &&
    !reticulate::py_available(initialize = FALSE) &&
    !nzchar(Sys.getenv("RETICULATE_PYTHON", unset = "")) &&
    !nzchar(Sys.getenv("RETICULATE_PYTHON_ENV", unset = "")) &&
    !nzchar(Sys.getenv("VIRTUAL_ENV", unset = "")) &&
    !nzchar(Sys.getenv("RETICULATE_USE_MANAGED_VENV", unset = ""))

  if (force_managed) {
    previous_managed_setting <- Sys.getenv(
      "RETICULATE_USE_MANAGED_VENV",
      unset = NA_character_
    )
    Sys.setenv(RETICULATE_USE_MANAGED_VENV = "yes")
    on.exit(
      if (is.na(previous_managed_setting)) {
        Sys.unsetenv("RETICULATE_USE_MANAGED_VENV")
      } else {
        Sys.setenv(RETICULATE_USE_MANAGED_VENV = previous_managed_setting)
      },
      add = TRUE
    )
  }

  result <- biogeme_check(verbose = FALSE)
  if (isTRUE(verbose)) {
    print(result)
  }
  invisible(result)
}

#' Check whether rbiogeme is ready to run a model
#'
#' This is the runtime-only validation used by [biogeme_setup()] and is also
#' useful when the environment has already been configured. It initializes the
#' configured runtime, verifies the minimum R and Python versions, checks that
#' native Biogeme can be imported, and compares its version with the configured
#' requirement when that requirement pins an exact version. The check does not
#' construct or estimate a model.
#'
#' @param verbose If `TRUE`, print the check and its actionable messages.
#' @return An object of class `biogeme_check` with elements `ready`,
#'   `diagnostics`, and `issues`. `issues` is a data frame with columns
#'   `check`, `status`, `message`, and `action`.
#' @export
biogeme_check <- function(verbose = interactive()) {
  if (!is.logical(verbose) || length(verbose) != 1L || is.na(verbose)) {
    stop("verbose must be one non-missing logical value.", call. = FALSE)
  }

  diagnostics <- tryCatch(
    biogeme_diagnostics(),
    error = function(error) error
  )

  if (inherits(diagnostics, "error")) {
    issue <- data.frame(
      check = "Python and Biogeme runtime",
      status = "ERROR",
      message = conditionMessage(diagnostics),
      action = paste0(
        "Check the configured Python interpreter and install ",
        .biogeme_state$requirement,
        ". Then run biogeme_check() again."
      ),
      stringsAsFactors = FALSE
    )
    result <- structure(
      list(ready = FALSE, diagnostics = NULL, issues = issue),
      class = c("biogeme_check", "list")
    )
    if (isTRUE(verbose)) {
      print(result)
    }
    return(invisible(result))
  }

  issue_rows <- list()
  add_issue <- function(check, status, message, action) {
    issue_rows[[length(issue_rows) + 1L]] <<- data.frame(
      check = check,
      status = status,
      message = message,
      action = action,
      stringsAsFactors = FALSE
    )
  }

  if (getRversion() >= "4.3.0") {
    add_issue(
      "R version",
      "OK",
      paste0("R ", as.character(getRversion()), " is supported."),
      "No action required."
    )
  } else {
    add_issue(
      "R version",
      "ERROR",
      paste0("rbiogeme requires R 4.3.0 or later; found R ", getRversion(), "."),
      "Upgrade R and restart the R session."
    )
  }

  python_version <- as.character(
    if (is.null(diagnostics$python_version)) "" else diagnostics$python_version
  )
  python_version <- sub("^[Pp]ython[[:space:]]+", "", python_version)
  python_version <- sub("[^0-9.].*$", "", python_version)
  python_is_supported <- nzchar(python_version) &&
    tryCatch(utils::compareVersion(python_version, "3.12.0") >= 0, error = function(...) FALSE)
  if (python_is_supported) {
    add_issue(
      "Python version",
      "OK",
      paste0("Python ", python_version, " is supported."),
      "No action required."
    )
  } else {
    add_issue(
      "Python version",
      "ERROR",
      paste0(
        "rbiogeme requires Python 3.12 or later; found ",
        if (nzchar(python_version)) python_version else "an unknown version",
        "."
      ),
      "Select a Python 3.12+ interpreter with biogeme_config(python = ...)."
    )
  }

  biogeme_available <- isTRUE(diagnostics$modules_available$biogeme)
  installed_version <- as.character(
    if (is.null(diagnostics$packages$biogeme)) NA_character_ else
      diagnostics$packages$biogeme
  )
  expected_version <- biogeme_exact_requirement_version(.biogeme_state$requirement)
  if (!biogeme_available) {
    add_issue(
      "Biogeme import",
      "ERROR",
      "The active Python environment cannot import Biogeme.",
      paste0(
        "Install ", .biogeme_state$requirement,
        " in the active environment, then restart R."
      )
    )
  } else if (!is.null(expected_version) &&
      (is.na(installed_version) ||
        tryCatch(
          utils::compareVersion(installed_version, expected_version) != 0,
          error = function(...) TRUE
        ))) {
    add_issue(
      "Biogeme version",
      "ERROR",
      paste0(
        "The active environment has Biogeme ",
        if (is.na(installed_version)) "an unknown version" else installed_version,
        "; the configured requirement is biogeme==", expected_version, "."
      ),
      paste0(
        "Install biogeme==", expected_version,
        " in the selected environment, then restart R."
      )
    )
  } else {
    add_issue(
      "Biogeme import",
      "OK",
      paste0(
        "Biogeme ",
        if (is.na(installed_version)) "is importable" else installed_version,
        " is available."
      ),
      "No action required."
    )
  }

  issues <- do.call(rbind, issue_rows)
  result <- structure(
    list(
      ready = !any(issues$status == "ERROR"),
      diagnostics = diagnostics,
      issues = issues
    ),
    class = c("biogeme_check", "list")
  )
  if (isTRUE(verbose)) {
    print(result)
  }
  invisible(result)
}

#' @exportS3Method print biogeme_check
print.biogeme_check <- function(x, ...) {
  status <- if (isTRUE(x$ready)) "READY" else "NOT READY"
  cat("rbiogeme readiness check: ", status, "\n", sep = "")
  if (is.data.frame(x$issues) && nrow(x$issues) > 0L) {
    print(x$issues, row.names = FALSE)
  }
  invisible(x)
}

biogeme_exact_requirement_version <- function(requirement) {
  match <- regmatches(
    requirement,
    regexec(
    "^biogeme[[:space:]]*==[[:space:]]*([0-9]+([.][0-9]+)+)",
    requirement,
    ignore.case = TRUE
    )
  )[[1L]]
  if (length(match) < 2L || match[[2L]] == "") {
    return(NULL)
  }
  match[[2L]]
}

.biogeme_state <- new.env(parent = emptyenv())
.biogeme_state$python <- NULL
.biogeme_state$requirement <- "biogeme==3.3.5"
.biogeme_state$debug <- FALSE