R/044_atoms_affine_add_expr.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/atoms/affine/add_expr.R
#####

## CVXPY SOURCE: atoms/affine/add_expr.py
## AddExpression -- the sum of any number of expressions


AddExpression <- new_class("AddExpression", parent = AffAtom, package = "CVXR",
  constructor = function(arg_groups) {
    ## NEW_OBJECT GUARD: S7's check_S7_constructor static-checks that the
    ## body contains a literal new_object() call.  This branch never runs;
    ## all actual construction goes through .fast_new (Lever 2 experiment).
    if (FALSE) new_object(S7_object())
    ## CVXPY SOURCE: add_expr.py lines 32-36
    ## Flattens nested AddExpressions so args is always a flat list.
    ## Optimized fast path for binary + (the common case from the Ops handler):
    ##   - Computes shape from just 2 inputs (.broadcast_2d) instead of iterating
    ##     over all k accumulated shapes (sum_shapes).  This reduces shape
    ##     computation from O(n^2) total to O(n) for chains of additions.
    ##   - Avoids vector()/unlist() overhead for the 2-arg case.
    if (length(arg_groups) == 2L) {
      g1 <- arg_groups[[1L]]
      g2 <- arg_groups[[2L]]
      if (!.s7_is(g1, Expression)) g1 <- as_expr(g1)
      if (!.s7_is(g2, Expression)) g2 <- as_expr(g2)
      is_add1 <- .s7_is(g1, AddExpression)
      is_add2 <- .s7_is(g2, AddExpression)
      if (is_add1 && !is_add2) {
        flat_args <- c(.args(g1), list(g2))
      } else if (!is_add1 && is_add2) {
        flat_args <- c(list(g1), .args(g2))
      } else if (is_add1 && is_add2) {
        flat_args <- c(.args(g1), .args(g2))
      } else {
        flat_args <- list(g1, g2)
      }
      ## Shape from 2 inputs: the existing AddExpr's shape already represents
      ## the broadcast of all its args, so .broadcast_2d is sufficient.
      shape <- .broadcast_2d(.shape(g1), .shape(g2))
      return(.fast_new(AddExpression, S7_object(),
        id    = next_expr_id(),
        .cache = new.env(parent = emptyenv()),
        args  = flat_args,
        shape = shape
      ))
    }
    ## General path for 1 or 3+ args
    n_groups <- length(arg_groups)
    flat_chunks <- vector("list", n_groups)
    for (i in seq_len(n_groups)) {
      group <- as_expr(arg_groups[[i]])
      if (.s7_is(group, AddExpression)) {
        flat_chunks[[i]] <- .args(group)
      } else {
        flat_chunks[[i]] <- list(group)
      }
    }
    flat_args <- unlist(flat_chunks, recursive = FALSE)
    if (is.null(flat_args)) flat_args <- list()
    if (length(flat_args) == 0L) {
      cli_abort("No arguments given to {.cls AddExpression}.")
    }
    shape <- sum_shapes(lapply(flat_args, function(a) .shape(a)))
    .fast_new(AddExpression, S7_object(),
      id    = next_expr_id(),
      .cache = new.env(parent = emptyenv()),
      args  = flat_args,
      shape = shape
    )
  }
)

# -- shape_from_args -------------------------------------------------
## CVXPY SOURCE: add_expr.py:86-97 (#3080). Broadcast each arg's bounds to the
## sum's shape, then add interval-wise.
method(bounds_from_args, AddExpression) <- function(x) {
  b <- get_bounds(.args(x)[[1L]])
  bb <- broadcast_bounds(b[[1L]], b[[2L]], .shape(x))
  lb <- bb[[1L]]; ub <- bb[[2L]]
  for (arg in .args(x)[-1L]) {
    ab <- get_bounds(arg)
    ab <- broadcast_bounds(ab[[1L]], ab[[2L]], .shape(x))
    s <- add_bounds(lb, ub, ab[[1L]], ab[[2L]])
    lb <- s[[1L]]; ub <- s[[2L]]
  }
  list(lb, ub)
}

## CVXPY SOURCE: add_expr.py lines 38-41

method(shape_from_args, AddExpression) <- function(x) {
  sum_shapes(lapply(.args(x), function(a) .shape(a)))
}

# -- sign_from_args --------------------------------------------------
## Inherits from AffAtom: sum_signs(args)

# -- numeric_value ---------------------------------------------------
## CVXPY SOURCE: add_expr.py lines 69-70 (reduce(op.add, values))

method(numeric_value, AddExpression) <- function(x, values, ...) {
  ## R doesn't broadcast matrices like numpy; promote shapes before reducing
  target_shape <- .shape(x)
  promoted <- lapply(values, .broadcast_numeric, target_shape = target_shape)
  Reduce(`+`, promoted)
}

# -- is_symmetric / is_hermitian -------------------------------------
## CVXPY SOURCE: add_expr.py lines 82-92

method(is_symmetric, AddExpression) <- function(x) {
  .shape(x)[1L] == .shape(x)[2L] &&
    .all_args(x, is_symmetric)
}

method(is_hermitian, AddExpression) <- function(x) {
  .shape(x)[1L] == .shape(x)[2L] &&
    .all_args(x, is_hermitian)
}

# -- graph_implementation --------------------------------------------
## CVXPY SOURCE: add_expr.py lines 119-141
## Promotes scalars to match result shape before summing.

method(graph_implementation, AddExpression) <- function(x, arg_objs, shape, data = NULL, ...) {
  for (i in seq_along(arg_objs)) {
    if (!identical(arg_objs[[i]]$shape, shape) && is_scalar_linop(arg_objs[[i]])) {
      arg_objs[[i]] <- promote_linop(arg_objs[[i]], shape)
    }
  }
  list(sum_expr_linop(arg_objs), list())
}

# -- expr_name -------------------------------------------------------
## CVXPY SOURCE: add_expr.py lines 51-55

## CVXPY SOURCE: add_expr.py lines 72-79
method(is_atom_log_log_convex, AddExpression) <- function(x) TRUE
method(is_atom_log_log_concave, AddExpression) <- function(x) FALSE

method(expr_name, AddExpression) <- function(x) {
  paste(vapply(.args(x), expr_name, character(1)), collapse = " + ")
}

## CVXPY SOURCE: atoms/affine/add_expr.py AddExpression.format_labeled.
method(format_labeled, AddExpression) <- function(x) {
  lbl <- label(x)
  if (!is.null(lbl)) return(lbl)
  paste(vapply(.args(x), format_labeled, character(1)), collapse = " + ")
}

# -- expr_copy: special handling for AddExpression -------------------
## CVXPY SOURCE: add_expr.py lines 96-117
## AddExpression constructor expects arg_groups (a list), not individual args.

method(expr_copy, AddExpression) <- function(x, args = NULL, id_objects = NULL) {
  ## Memo skipped when `id_objects` is NULL -- it could not hit. Same reasoning
  ## and the same measurement as method(expr_copy, Canonical); see
  ## utilities/canonical.R.
  if (!is.null(id_objects)) {
    key <- as.character(.id(x))
    if (exists(key, envir = id_objects, inherits = FALSE)) {
      return(get(key, envir = id_objects, inherits = FALSE))
    }
  }
  if (is.null(args)) args <- .args(x)
  result <- AddExpression(args)
  if (!is.null(id_objects)) assign(key, result, envir = id_objects)
  result
}