R/025_expressions_constants_constant.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/expressions/constants/constant.R
#####

## CVXPY SOURCE: expressions/constants/constant.py
## Constant -- a constant value in the expression tree

#' Create a Constant Expression
#'
#' Wraps a numeric value as a CVXR constant for use in optimization
#' expressions. Constants are typically created implicitly when combining
#' numeric values with CVXR expressions via arithmetic operators.
#'
#' @param value A numeric scalar, vector, matrix, or sparse matrix.
#' @param name Optional character string name.
#' @returns A \code{Constant} object (inherits from \code{Leaf} and
#'   \code{Expression}).
#'
#' @examples
#' c1 <- Constant(5)
#' c2 <- Constant(matrix(1:6, 2, 3))
#'
#' @export
Constant <- new_class("Constant", parent = Leaf, package = "CVXR",
  properties = list(
    .name   = new_property(class = class_character, default = ""),
    .sparse = new_property(class = class_logical, default = FALSE)
  ),
  constructor = function(value, name = NULL) {
    ## Convert and normalize
    sparse <- intf_is_sparse(value)
    value <- intf_convert(value)
    shape <- as.integer(intf_shape(value))

    id <- next_expr_id()

    if (is.null(name)) name <- ""

    obj <- new_object(S7_object(),
      id = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      shape = shape,
      .value = value,
      attributes = list(
        nonneg = FALSE, nonpos = FALSE,
        pos = FALSE, neg = FALSE,
        complex = FALSE, imag = FALSE,
        symmetric = FALSE, diag = FALSE,
        PSD = FALSE, NSD = FALSE,
        hermitian = FALSE, boolean = FALSE,
        integer = FALSE, sparsity = FALSE,
        bounds = NULL
      ),
      args = list(),
      .name = name,
      .sparse = sparse
    )
    obj
  }
)

# -- expr_name ---------------------------------------------------------
## CVXPY SOURCE: constant.py lines 85-97

method(expr_name, Constant) <- function(x) {
  if (nchar(x@.name) > 0L) return(x@.name)
  v <- x@.value
  if (is.matrix(v) && any(dim(v) > 1L)) {
    ## Abbreviated representation for matrices
    paste0("[", nrow(v), "x", ncol(v), " matrix]")
  } else {
    as.character(v[1L])
  }
}

# -- is_constant: always TRUE -----------------------------------------
## CVXPY SOURCE: constant.py line 104-105

method(is_constant, Constant) <- function(x) TRUE

# -- constants: returns self -------------------------------------------
## CVXPY SOURCE: constant.py lines 99-102

method(constants, Constant) <- function(x) list(x)

# -- value: read-only --------------------------------------------------
## CVXPY SOURCE: constant.py lines 107-111

method(value, Constant) <- function(x) x@.value

method(`value<-`, Constant) <- function(x, value) {
  cli_abort("Cannot set the value of a {.cls Constant}.")
}

# -- Complex queries: computed from value, cached ----------------------
## CVXPY SOURCE: constant.py lines 179-183, 172-177

method(is_complex, Constant) <- function(x) {
  cached <- cache_get(x, "is_complex")
  if (!cache_miss(cached)) return(cached)
  result <- is.complex(x@.value)
  cache_set(x, "is_complex", result)
  result
}

method(is_imag, Constant) <- function(x) {
  cached <- cache_get(x, "is_imag")
  if (!cache_miss(cached)) return(cached)
  v <- x@.value
  if (!is.complex(v)) {
    cache_set(x, "is_imag", FALSE)
    return(FALSE)
  }
  ## Imaginary: real part all ~zero, imaginary part has nonzero elements
  ## CVXPY SOURCE: interface/matrix_utilities.py is_complex() returns (is_real, is_imag)
  tol <- 1e-5
  real_max <- max(abs(Re(v)))
  imag_max <- max(abs(Im(v)))
  result <- (real_max < tol) && (imag_max >= tol)
  cache_set(x, "is_imag", result)
  result
}

# -- Hermitian / skew-symmetric: computed from value, cached -----------
## CVXPY SOURCE: constant.py lines 198-235

method(is_hermitian, Constant) <- function(x) {
  cached <- cache_get(x, "is_hermitian")
  if (!cache_miss(cached)) return(cached)
  if (expr_is_scalar(x) && is_real(x)) {
    cache_set(x, "is_hermitian", TRUE)
    return(TRUE)
  }
  if (length(x@shape) != 2L || x@shape[1L] != x@shape[2L]) {
    cache_set(x, "is_hermitian", FALSE)
    return(FALSE)
  }
  herm <- intf_is_hermitian(x@.value)
  cache_set(x, "is_hermitian", herm$is_hermitian)
  herm$is_hermitian
}

method(is_skew_symmetric, Constant) <- function(x) {
  cached <- cache_get(x, "is_skew_symmetric")
  if (!cache_miss(cached)) return(cached)
  ## Delegates to intf_is_skew_symmetric which errors on non-square (matches CVXPY)
  result <- intf_is_skew_symmetric(x@.value)
  cache_set(x, "is_skew_symmetric", result)
  result
}

# -- Sign queries: computed from value, cached -------------------------
## CVXPY SOURCE: constant.py lines 158-170, 211-222

method(is_nonneg, Constant) <- function(x) {
  cached <- cache_get(x, "is_nonneg")
  if (!cache_miss(cached)) return(cached)
  sgn <- intf_sign(x@.value)
  cache_set(x, "is_nonneg", sgn$is_nonneg)
  cache_set(x, "is_nonpos", sgn$is_nonpos)
  sgn$is_nonneg
}

method(is_nonpos, Constant) <- function(x) {
  cached <- cache_get(x, "is_nonpos")
  if (!cache_miss(cached)) return(cached)
  sgn <- intf_sign(x@.value)
  cache_set(x, "is_nonneg", sgn$is_nonneg)
  cache_set(x, "is_nonpos", sgn$is_nonpos)
  sgn$is_nonpos
}

# -- is_pos: strictly positive (all elements > 0), cached --------------
## CVXPY SOURCE: constant.py lines 113-123
method(is_pos, Constant) <- function(x) {
  cached <- cache_get(x, "is_pos")
  if (!cache_miss(cached)) return(cached)
  v <- x@.value
  if (is.complex(v)) {
    ## Complex values cannot be strictly positive
    result <- FALSE
  } else if (inherits(v, "sparseMatrix")) {
    ## Sparse constants are NOT elementwise positive (zeros present)
    result <- FALSE
  } else {
    result <- all(v > 0)
  }
  cache_set(x, "is_pos", result)
  result
}

# -- Symmetry: computed from value, cached -----------------------------
## CVXPY SOURCE: constant.py lines 186-196

method(is_symmetric, Constant) <- function(x) {
  cached <- cache_get(x, "is_symmetric")
  if (!cache_miss(cached)) return(cached)
  if (expr_is_scalar(x)) {
    cache_set(x, "is_symmetric", TRUE)
    return(TRUE)
  }
  if (length(x@shape) != 2L || x@shape[1L] != x@shape[2L]) {
    cache_set(x, "is_symmetric", FALSE)
    return(FALSE)
  }
  herm <- intf_is_hermitian(x@.value)
  cache_set(x, "is_symmetric", herm$is_symmetric)
  herm$is_symmetric
}

# -- PSD / NSD: computed from value, cached ----------------------------
## CVXPY SOURCE: constant.py lines 237-279

method(is_psd, Constant) <- function(x) {
  cached <- cache_get(x, "is_psd")
  if (!cache_miss(cached)) return(cached)
  ## Scalar cases
  if (expr_is_scalar(x)) {
    result <- is_nonneg(x)
    cache_set(x, "is_psd", result)
    return(result)
  }
  ## Must be square
  if (length(x@shape) != 2L || x@shape[1L] != x@shape[2L]) {
    cache_set(x, "is_psd", FALSE)
    return(FALSE)
  }
  ## Must be symmetric (real) or Hermitian (complex) -- matches CVXPY
  if (!is_hermitian(x)) {
    cache_set(x, "is_psd", FALSE)
    return(FALSE)
  }
  ## Eigenvalue test
  result <- intf_is_psd(x@.value, EIGVAL_TOL)
  cache_set(x, "is_psd", result)
  result
}

method(is_nsd, Constant) <- function(x) {
  cached <- cache_get(x, "is_nsd")
  if (!cache_miss(cached)) return(cached)
  if (expr_is_scalar(x)) {
    result <- is_nonpos(x)
    cache_set(x, "is_nsd", result)
    return(result)
  }
  if (length(x@shape) != 2L || x@shape[1L] != x@shape[2L]) {
    cache_set(x, "is_nsd", FALSE)
    return(FALSE)
  }
  if (!is_hermitian(x)) {
    cache_set(x, "is_nsd", FALSE)
    return(FALSE)
  }
  ## Eigenvalue test on negation
  result <- intf_is_psd(-x@.value, EIGVAL_TOL)
  cache_set(x, "is_nsd", result)
  result
}

# -- grad: empty (constants have no gradient w.r.t. variables) ---------
## CVXPY SOURCE: constant.py lines 126-134

method(grad, Constant) <- function(x) list()

# -- canonicalize ------------------------------------------------------
## CVXPY SOURCE: constant.py lines 142-149

method(canonicalize, Constant) <- function(x) {
  obj <- create_const(x@.value, x@shape, x@.sparse)
  list(obj, list())
}

# -- print -------------------------------------------------------------

method(print, Constant) <- function(x, ...) {
  cat(sprintf("Constant(%s, %s, (%s))\n",
              expr_curvature(x), expr_sign_str(x),
              paste(x@shape, collapse = ", ")))
  invisible(x)
}