R/002_zzz_R_specific_globals.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/zzz_R_specific/globals.R
#####

## CVXPY SOURCE: (R-specific, no direct CVXPY equivalent)
## Global state and package-level initialization


## Global expression ID counter
## Uses an environment for mutable state (R-idiomatic)
.cvxr_env <- new.env(parent = emptyenv())
.cvxr_env$next_id <- 1L
.cvxr_env$excluded_solvers <- character(0)

## -- Class name cache ------------------------------------------------
## S7 class names are "CVXR::ClassName".  Many hot paths need just "ClassName"
## for canon-method lookup, constraint grouping, format_constraints dispatch, etc.
## Instead of calling sub("^.*::", "", class(x)[[1L]]) on every access (regex),
## we cache the mapping.  ~100 distinct classes -> tiny env, O(1) amortized.
.class_name_cache <- new.env(hash = TRUE, parent = emptyenv())

#' Get the short (unqualified) class name of an S7 object
#'
#' Strips the "CVXR::" package prefix from S7 class names, with caching.
#' @param x An S7 object, or a character string (full class name)
#' @return Character(1) -- the bare class name
#' @noRd
short_class_name <- function(x) {
  if (is.character(x)) {
    full <- x
  } else {
    full <- class(x)[[1L]]
  }
  short <- .class_name_cache[[full]]
  if (!is.null(short)) return(short)
  short <- sub("^.*::", "", full)
  .class_name_cache[[full]] <- short
  short
}

#' Check if object inherits from any class in a list
#'
#' Lazy for-loop: stops at first match. Used for checking constraints
#' against SUPPORTED_CONSTRAINTS (which holds S7 class objects).
#' @param x An S7 object
#' @param classes A list of S7 class objects
#' @return logical(1)
#' @noRd
.inherits_any <- function(x, classes) {
  for (cls in classes) if (S7_inherits(x, cls)) return(TRUE)
  FALSE
}

#' Generate a unique expression ID
#' @return Integer ID
#' @noRd
next_expr_id <- function() {
  id <- .cvxr_env$next_id
  .cvxr_env$next_id <- id + 1L
  id
}

#' Reset the expression ID counter (for testing)
#' @noRd
reset_expr_id <- function() {
  .cvxr_env$next_id <- 1L
}

#' .onLoad hook: register S7 methods and operator dispatch
#' @noRd
.onLoad <- function(libname, pkgname) {
  S7::methods_register()
  ## Register S3 Ops group handler for arithmetic operators (+, -, *, /, ^, ==, <=, >=)
  registerS3method("Ops", "CVXR::Expression", .cvxr_Ops_handler)
  ## Ensure CVXR wins when combined with other classes (e.g., Matrix)
  registerS3method("chooseOpsMethod", "CVXR::Expression",
                   .cvxr_chooseOpsMethod)
  ## Register S3 Math group handler (abs, exp, log, sqrt, cumsum, ...)
  registerS3method("Math", "CVXR::Expression", .cvxr_Math_handler)
  ## Register S3 Summary group handler (sum, max, min, ...)
  registerS3method("Summary", "CVXR::Expression", .cvxr_Summary_handler)
  ## Register S3 Ops group handler for Problem arithmetic (+, -, *, /)
  registerS3method("Ops", "CVXR::Problem", .problem_Ops_handler)
  ## Register solve() S3 method for Problem objects
  registerS3method("solve", "CVXR::Problem", .cvxr_solve_Problem)
  ## Register diff() S3 method for Expression objects
  registerS3method("diff", "CVXR::Expression", .cvxr_diff_Expression)
  ## Register print method for cvxr_result (backward-compat solve() return)
  registerS3method("print", "cvxr_result", print.cvxr_result)
  ## Register dim() for nrow()/ncol() support on Expressions
  registerS3method("dim", "CVXR::Expression", .cvxr_dim_Expression)
  ## Register as.character() for Expression string conversion
  registerS3method("as.character", "CVXR::Expression", .cvxr_as_character_Expression)
  ## Register Complex S3 group handler for Re(), Im(), Conj()
  registerS3method("Complex", "CVXR::Expression", .cvxr_Complex_handler)
}

## S3 solve method for Problem -- dispatches to psolve(), returns cvxr_result
.cvxr_solve_Problem <- function(a, b, ...) {
  cli_inform(
    c("i" = "In a future CVXR release, {.fn solve} will return the optimal value directly (like {.fn psolve}).",
      "i" = "The {.code $getValue()}/{.code $getDualValue()} interface will be removed.",
      "i" = "New API: {.code psolve(prob)}, then {.code value(x)}, {.code dual_value(constr)}, {.code status(prob)}."),
    .frequency = "once",
    .frequency_id = "cvxr_solve_api_change"
  )
  psolve(a, ...)
  ss <- solver_stats(a)
  solver_nm <- if (!is.null(ss)) ss@solver_name else "unknown"
  .make_cvxr_result(a, solver_nm)
}