R/016_lin_ops_LinOp.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/lin_ops/LinOp.R
#####

## R-SPECIFIC: LinOp standalone functions wrapping C++ external pointers
##
## Replaces the old CVXcanon.LinOp() closure factory (20 closures + 1 list +
## 1 environment per call) with package-level standalone functions that take
## a raw XPtr as the first argument. Since build_lin_op_tree() creates one
## LinOp per node, this eliminates ~20 R objects per node.
##
## DIRECT `.Call`, NOT the generated wrapper (ADR D_PERF.6): these run once per
## LinOp per node, so the wrapper's ~0.42us of pure closure overhead is a real
## share of the work. Each site names its generated equivalent in a
## `## wrapper:` comment, because `.Call` is positional, matches nothing by
## name, honors no defaults, and Rcpp SILENTLY COERCES a wrong type -- an
## allocation and a copy, i.e. exactly the cost being avoided. Arguments must
## therefore already have the right type at the call. `scripts/validate_rcpp_bridge.R`
## checks each comment against the real signature.

## Package-level constant (was recreated per call in the old closure factory)
.LINOP_TYPES <- c(
  "VARIABLE", "PROMOTE", "MUL_EXPR", "RMUL_EXPR", "MUL_ELEM",
  "DIV", "SUM", "NEG", "INDEX", "TRANSPOSE", "SUM_ENTRIES",
  "TRACE", "RESHAPE_EXPR", "DIAG_VEC", "DIAG_MAT", "UPPER_TRI",
  "CONV", "HSTACK", "VSTACK", "SCALAR_CONST", "DENSE_CONST",
  "SPARSE_CONST", "NO_OP", "KRON", "KRON_L", "PARAM")

#' Create a new C++ LinOp external pointer
#' @return An external pointer to a C++ LinOp object.
#' @keywords internal
linop_new <- function() {
  ## wrapper: .LinOp__new()
  .Call("_CVXR_LinOp__new", PACKAGE = "CVXR")
}

#' Set the type of a LinOp
#' @param ptr External pointer to a LinOp.
#' @param type Character string -- one of \code{.LINOP_TYPES}.
#' @keywords internal
linop_set_type <- function(ptr, type) {
  index <- match(type, .LINOP_TYPES) - 1L   # integer: `match` returns integer
  ## wrapper: .LinOp__set_type(ptr, index)
  .Call("_CVXR_LinOp__set_type", ptr, index, PACKAGE = "CVXR")
}

#' Push a dimension to the LinOp size vector
#' @param ptr External pointer to a LinOp.
#' @param value Integer dimension value.
#' @keywords internal
linop_size_push_back <- function(ptr, value) {
  ## wrapper: .LinOp__size_push_back(ptr, value)
  .Call("_CVXR_LinOp__size_push_back", ptr, value, PACKAGE = "CVXR")
}

#' Append a child LinOp to the args list
#' @param ptr External pointer to the parent LinOp.
#' @param child_ptr External pointer to the child LinOp.
#' @keywords internal
linop_args_push_back <- function(ptr, child_ptr) {
  ## wrapper: .LinOp__args_push_back(ptr, child_ptr)
  .Call("_CVXR_LinOp__args_push_back", ptr, child_ptr, PACKAGE = "CVXR")
}

#' Set dense data on a LinOp
#' @param ptr External pointer to a LinOp.
#' @param value Dense matrix data.
#' @keywords internal
linop_set_dense_data <- function(ptr, value) {
  ## wrapper: .LinOp__set_dense_data(ptr, value)
  .Call("_CVXR_LinOp__set_dense_data", ptr, value, PACKAGE = "CVXR")
}

#' Set sparse data on a LinOp
#' @param ptr External pointer to a LinOp.
#' @param value Sparse matrix data (dgCMatrix or similar).
#' @keywords internal
linop_set_sparse_data <- function(ptr, value) {
  ## wrapper: .LinOp__set_sparse_data(ptr, value)
  .Call("_CVXR_LinOp__set_sparse_data", ptr, value, PACKAGE = "CVXR")
}

#' Set the data dimensionality on a LinOp
#' @param ptr External pointer to a LinOp.
#' @param value Integer dimensionality (0 = scalar, 2 = matrix).
#' @keywords internal
linop_set_data_ndim <- function(ptr, value) {
  ## wrapper: .LinOp__set_data_ndim(ptr, as.integer(value))
  .Call("_CVXR_LinOp__set_data_ndim", ptr, as.integer(value), PACKAGE = "CVXR")
}

#' Set a LinOp data sub-tree on a LinOp
#' @param ptr External pointer to the LinOp.
#' @param data_ptr External pointer to the data LinOp sub-tree.
#' @keywords internal
linop_set_linop_data <- function(ptr, data_ptr) {
  ## wrapper: .LinOp__set_linOp_data(ptr, data_ptr)
  .Call("_CVXR_LinOp__set_linOp_data", ptr, data_ptr, PACKAGE = "CVXR")
}

#' Push a slice (index vector) to a LinOp
#' @param ptr External pointer to a LinOp.
#' @param int_vector Integer vector of indices (0-based for C++).
#' @keywords internal
linop_slice_push_back <- function(ptr, int_vector) {
  ## wrapper: .LinOp__slice_push_back(ptr, int_vector)
  .Call("_CVXR_LinOp__slice_push_back", ptr, int_vector, PACKAGE = "CVXR")
}