R/055_atoms_affine_hstack.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/affine/hstack.py
## HStack -- horizontal concatenation of expressions


HStack <- new_class("HStack", parent = AffAtom, package = "CVXR",
  constructor = function(..., id = NULL) {
    if (FALSE) new_object(S7_object())  ## S7 static-check guard
    if (is.null(id)) id <- next_expr_id()
    ## hstack.py:25 takes one positional list; a keyword is a TypeError. R's
    ## variadic convention labels operands by name (`cbind(a = x, b = y)`,
    ## `do.call(hstack, split(...))`), so names are dropped here and the
    ## wrapper takes cbind's option formal. Recorded deviation, better-in-r.
    all_args <- lapply(unname(list(...)), as_expr)
    if (length(all_args) == 0L) {
      cli_abort("{.cls HStack} requires at least one argument.")
    }
    ## Compute shape: same rows, sum of cols
    rows <- .shape(all_args[[1L]])[1L]
    total_cols <- 0L
    for (arg in all_args) {
      if (.shape(arg)[1L] != rows) {
        cli_abort("All arguments to {.fn hstack} must have the same number of rows.")
      }
      total_cols <- total_cols + .shape(arg)[2L]
    }
    shape <- c(rows, total_cols)

    obj <- .fast_new(HStack, S7_object(),
      id    = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args  = all_args,
      shape = shape
    )
    obj
  }
)

method(shape_from_args, HStack) <- function(x) {
  rows <- .arg_shape(x)[1L]
  total_cols <- sum(vapply(.args(x), function(a) .shape(a)[2L], integer(1)))
  c(rows, total_cols)
}

# -- log-log: affine (CVXPY hstack.py) ---------------------------
method(is_atom_log_log_convex, HStack) <- function(x) TRUE
method(is_atom_log_log_concave, HStack) <- function(x) TRUE

method(numeric_value, HStack) <- function(x, values, ...) {
  do.call(cbind, values)
}

method(graph_implementation, HStack) <- function(x, arg_objs, shape, data = NULL, ...) {
  list(hstack_linop(arg_objs, shape), list())
}

#' Horizontal concatenation of expressions
#'
#' Named operands are accepted, as in `cbind()`, and the names are dropped.
#'
#' @param ... Expressions (same number of rows)
#' @param deparse.level Accepted for compatibility with `cbind()`; expressions
#'   have no dimnames, so it has no effect
#' @returns An HStack atom
#' @export
hstack <- function(..., deparse.level = 1) {
  HStack(...)
}