R/023_expressions_leaf.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: expressions/leaf.py
## Leaf -- base class for Variable, Constant, Parameter


# -- Helper: build leaf attributes list with validation ----------------
# Called by Leaf, Variable, and Parameter constructors to avoid
# duplicating validation logic while each calling new_object() directly.

#' @keywords internal
.build_leaf_attrs <- function(shape, nonneg = FALSE, nonpos = FALSE,
                              complex = FALSE, imag = FALSE,
                              symmetric = FALSE, diag = FALSE,
                              PSD = FALSE, NSD = FALSE, hermitian = FALSE,
                              boolean = FALSE, integer = FALSE,
                              sparsity = FALSE, pos = FALSE, neg = FALSE,
                              bounds = NULL) {
  ## Validate square constraint for matrix attributes
  ## CVXPY SOURCE: leaf.py line 118-121
  if ((PSD || NSD || symmetric || diag || hermitian) &&
      (length(shape) != 2L || shape[1L] != shape[2L])) {
    cli_abort("Invalid dimensions ({paste(shape, collapse = ', ')}). Must be a square matrix.")
  }

  ## Validate bounds (CVXPY SOURCE: leaf.py _ensure_valid_bounds)
  if (!is.null(bounds)) {
    if (!is.list(bounds) || length(bounds) != 2L) {
      cli_abort("Bounds should be a list of two items.")
    }
    ## Promote NULL to -Inf/Inf, scalars to arrays matching shape
    n_elem <- prod(shape)
    if (is.null(bounds[[1L]])) {
      bounds[[1L]] <- rep(-Inf, n_elem)
    } else if (length(bounds[[1L]]) == 1L) {
      bounds[[1L]] <- rep(bounds[[1L]], n_elem)
    }
    if (is.null(bounds[[2L]])) {
      bounds[[2L]] <- rep(Inf, n_elem)
    } else if (length(bounds[[2L]]) == 1L) {
      bounds[[2L]] <- rep(bounds[[2L]], n_elem)
    }
    lb <- bounds[[1L]]; ub <- bounds[[2L]]
    if (any(is.nan(lb)) || any(is.nan(ub))) {
      cli_abort("NaN is not feasible as lower or upper bound.")
    }
    if (any(lb == Inf)) {
      cli_abort("Inf is not feasible as a lower bound.")
    }
    if (any(ub == -Inf)) {
      cli_abort("-Inf is not feasible as an upper bound.")
    }
    if (any(lb > ub)) {
      cli_abort("Invalid bounds: some upper bounds are less than corresponding lower bounds.")
    }
  }

  ## Build attributes list (mirrors CVXPY leaf.py line 124-130)
  list(
    nonneg = nonneg, nonpos = nonpos,
    pos = pos, neg = neg,
    complex = complex, imag = imag,
    symmetric = symmetric, diag = diag,
    PSD = PSD, NSD = NSD,
    hermitian = hermitian, boolean = boolean,
    integer = integer, sparsity = sparsity,
    bounds = bounds
  )
}

Leaf <- new_class("Leaf", parent = Expression, package = "CVXR",
  properties = list(
    .value      = new_property(class = class_any, default = NULL),
    attributes  = new_property(class = class_list, default = list())
  ),
  constructor = function(shape = c(1L, 1L), value = NULL,
                         nonneg = FALSE, nonpos = FALSE,
                         complex = FALSE, imag = FALSE,
                         symmetric = FALSE, diag = FALSE,
                         PSD = FALSE, NSD = FALSE, hermitian = FALSE,
                         boolean = FALSE, integer = FALSE,
                         sparsity = FALSE, pos = FALSE, neg = FALSE,
                         bounds = NULL, id = NULL) {
    shape <- validate_shape(shape)
    attrs <- .build_leaf_attrs(shape,
      nonneg = nonneg, nonpos = nonpos,
      complex = complex, imag = imag,
      symmetric = symmetric, diag = diag,
      PSD = PSD, NSD = NSD, hermitian = hermitian,
      boolean = boolean, integer = integer,
      sparsity = sparsity, pos = pos, neg = neg,
      bounds = bounds)

    if (is.null(id)) id <- next_expr_id()

    obj <- new_object(S7_object(),
      id = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      shape = shape,
      .value = NULL,
      attributes = attrs,
      args = list()
    )

    ## Assign value if provided (goes through validation)
    if (!is.null(value)) {
      value(obj) <- value
    }

    obj
  }
)

# -- is_pos: strictly positive (from attributes) -----------------------
## CVXPY SOURCE: leaf.py lines 271-273
method(is_pos, Leaf) <- function(x) isTRUE(x@attributes$pos)

# -- Log-log DGP: Leaf is log-log convex/concave iff positive ---------
## CVXPY SOURCE: leaf.py lines 254-260
method(is_log_log_convex, Leaf) <- function(x) is_pos(x)
method(is_log_log_concave, Leaf) <- function(x) is_pos(x)

# -- Quadratic / PWL: leaves are always quadratic and piecewise-linear --
## CVXPY SOURCE: leaf.py lines 613-623
method(is_quadratic, Leaf) <- function(x) TRUE
method(has_quadratic_term, Leaf) <- function(x) FALSE
method(is_pwl, Leaf) <- function(x) TRUE

# -- Curvature: Leaves are always convex and concave (affine) ----------
## CVXPY SOURCE: leaf.py lines 246-252

method(is_convex, Leaf) <- function(x) TRUE
method(is_concave, Leaf) <- function(x) TRUE

# -- Sign queries from attributes --------------------------------------
## CVXPY SOURCE: leaf.py lines 262-269

method(is_nonneg, Leaf) <- function(x) {
  a <- x@attributes
  isTRUE(a$nonneg) || isTRUE(a$pos) || isTRUE(a$boolean)
}

method(is_nonpos, Leaf) <- function(x) {
  a <- x@attributes
  isTRUE(a$nonpos) || isTRUE(a$neg)
}

# -- Matrix property queries -------------------------------------------

## is_symmetric: scalar or relevant attributes
## CVXPY SOURCE: leaf.py lines 284-287
method(is_symmetric, Leaf) <- function(x) {
  expr_is_scalar(x) ||
    any(vapply(c("diag", "symmetric", "PSD", "NSD"),
               function(k) isTRUE(x@attributes[[k]]), logical(1)))
}

## is_psd / is_nsd: directly from attributes
## CVXPY SOURCE: leaf.py lines 601-607
method(is_psd, Leaf) <- function(x) isTRUE(x@attributes$PSD)
method(is_nsd, Leaf) <- function(x) isTRUE(x@attributes$NSD)

## is_complex / is_imag: from attributes
## CVXPY SOURCE: leaf.py lines 289-295
method(is_complex, Leaf) <- function(x) {
  a <- x@attributes
  isTRUE(a$complex) || isTRUE(a$imag) || isTRUE(a$hermitian)
}

method(is_imag, Leaf) <- function(x) isTRUE(x@attributes$imag)

## is_hermitian: from attributes
## CVXPY SOURCE: leaf.py lines 279-282
method(is_hermitian, Leaf) <- function(x) {
  (is_real(x) && is_symmetric(x)) ||
    isTRUE(x@attributes$hermitian) ||
    is_psd(x) || is_nsd(x)
}

# -- value / value<- --------------------------------------------------

## Value getter: check .cache first (reference semantics for constraints),
## then fall back to @.value (copy semantics).
## .cache is an environment (R reference type), so when constraint objects
## hold references to Variables, value updates propagate through the shared
## .cache environment even though R has copy-on-modify semantics for S7 props.
method(value, Leaf) <- function(x) {
  if (exists("leaf_value", envir = x@.cache, inherits = FALSE))
    return(x@.cache$leaf_value)
  x@.value
}

# -- Shared value validation (used by Leaf and Parameter value<-) ------
## Validates shape, projects onto attribute domain, checks tolerance.
## Returns the validated (converted) value or NULL.
.validate_leaf_value <- function(x, value) {
  if (is.null(value)) return(NULL)
  value <- intf_convert(value)
  val_shape <- intf_shape(value)
  if (!identical(as.integer(val_shape), as.integer(x@shape))) {
    cli_abort("Invalid dimensions ({paste(val_shape, collapse = ', ')}) for {.cls {class(x)[[1L]]}} value.")
  }
  ## Project and validate
  projected <- project(x, value)
  delta <- abs(value - projected)
  if (inherits(delta, "sparseMatrix")) {
    close_enough <- all(abs(delta@x) < SPARSE_PROJECTION_TOL)
  } else {
    if (isTRUE(x@attributes$PSD) || isTRUE(x@attributes$NSD)) {
      close_enough <- norm(delta, type = "2") <= PSD_NSD_PROJECTION_TOL
    } else {
      close_enough <- all(abs(delta) < GENERAL_PROJECTION_TOL)
    }
  }
  if (!close_enough) {
    attr_str <- .leaf_attr_str(x)
    cli_abort("{.cls {class(x)[[1L]]}} value must be {attr_str}.")
  }
  value
}

method(`value<-`, Leaf) <- function(x, value) {
  validated <- .validate_leaf_value(x, value)
  x@.cache$leaf_value <- validated   # Reference-semantic store (shared with constraint refs)
  x@.value <- validated              # Copy-semantic store (for direct access)
  x
}

# -- save_leaf_value --------------------------------------------------
## CVXPY SOURCE: leaf.py lines 454-462
## Stores solver output WITHOUT validation/projection.
## Used by problem_unpack() after solving.

save_leaf_value <- function(x, val) {
  x@.cache$leaf_value <- val
  invisible(x)
}

# -- project ----------------------------------------------------------
## CVXPY SOURCE: leaf.py lines 373-451

method(project, Leaf) <- function(x, val, ...) {
  a <- x@attributes
  ## Real projection (skip if complex)
  if (!isTRUE(a$complex) && !isTRUE(a$imag)) {
    val <- Re(val)
  }
  ## Count active attributes (skip projection for >1 attribute)
  n_attr <- sum(vapply(a, function(v) !identical(v, FALSE) && !is.null(v), logical(1)))
  if (n_attr > 1L) return(val)

  if (isTRUE(a$nonpos) && isTRUE(a$nonneg)) {
    return(0 * val)
  } else if (isTRUE(a$nonpos) || isTRUE(a$neg)) {
    return(pmin(val, 0))
  } else if (isTRUE(a$nonneg) || isTRUE(a$pos)) {
    return(pmax(val, 0))
  } else if (isTRUE(a$boolean)) {
    return(round(pmin(pmax(val, 0), 1)))
  } else if (isTRUE(a$integer)) {
    return(round(val))
  } else if (isTRUE(a$symmetric) || isTRUE(a$PSD) || isTRUE(a$NSD)) {
    if (is.integer(val)) val <- as.double(val)
    val <- (val + t(val)) / 2
    if (isTRUE(a$symmetric)) return(val)
    ev <- .eigvalsh(val, only_values = FALSE)
    w <- ev$values
    V <- ev$vectors
    if (isTRUE(a$PSD)) {
      bad <- w < 0
      if (!any(bad)) return(val)
      w[bad] <- 0
    } else {
      ## NSD
      bad <- w > 0
      if (!any(bad)) return(val)
      w[bad] <- 0
    }
    return((V %*% diag(w, nrow = length(w))) %*% t(V))
  } else if (isTRUE(a$diag)) {
    d <- diag(val)
    return(Matrix::Diagonal(x = d))
  } else if (isTRUE(a$hermitian)) {
    return((val + t(Conj(val))) / 2)
  } else if (isTRUE(a$imag)) {
    ## CVXPY: np.imag(val) * 1j -- project onto purely imaginary
    return(Im(val) * 1i)
  } else if (isTRUE(a$complex)) {
    ## CVXPY: val.astype(complex) -- ensure complex type
    if (!is.complex(val)) val <- as.complex(val)
    return(val)
  }
  ## Bounds clamping
  ## CVXPY SOURCE: leaf.py lines 440-445 (project -> np.clip)
  if (!is.null(a$bounds) && is.list(a$bounds)) {
    lb <- a$bounds[[1L]]
    ub <- a$bounds[[2L]]
    val <- pmax(val, lb)
    val <- pmin(val, ub)
  }
  val
}

# -- Leaf collections default to empty --------------------------------
## CVXPY SOURCE: leaf.py lines 234-244

method(variables, Leaf) <- function(x) list()
method(parameters, Leaf) <- function(x) list()
method(constants, Leaf) <- function(x) list()
method(atoms, Leaf) <- function(x) list()

# -- domain: empty list (Constraints don't exist yet) -----------------
## CVXPY SOURCE: leaf.py lines 357-371
method(domain, Leaf) <- function(x) list()

# -- grad: default empty list -----------------------------------------
method(grad, Leaf) <- function(x) list()

# -- Helper to construct attribute error string ------------------------

.leaf_attr_str <- function(x) {
  a <- x@attributes
  if (isTRUE(a$nonneg)) "nonnegative"
  else if (isTRUE(a$pos)) "positive"
  else if (isTRUE(a$nonpos)) "nonpositive"
  else if (isTRUE(a$neg)) "negative"
  else if (isTRUE(a$diag)) "diagonal"
  else if (isTRUE(a$PSD)) "positive semidefinite"
  else if (isTRUE(a$NSD)) "negative semidefinite"
  else if (isTRUE(a$imag)) "imaginary"
  else if (isTRUE(a$symmetric)) "symmetric"
  else if (isTRUE(a$boolean)) "boolean"
  else if (isTRUE(a$integer)) "integer"
  else "real"
}