R/049_atoms_affine_reshape.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/affine/reshape.py
## Reshape -- reshape an expression to a new shape
##
## Vectorizes the expression then unvectorizes into the new shape.
## Entries are stored in column-major (Fortran) order by default.
## R matrices are naturally column-major, so 'F' order is the default.


Reshape <- new_class("Reshape", parent = AffAtom, package = "CVXR",
  properties = list(
    order = class_character   # "F" or "C"
  ),
  constructor = function(expr, shape, order = "F") {
    if (FALSE) new_object(S7_object())  ## S7 static-check guard
    expr <- as_expr(expr)
    if (is.numeric(shape) && length(shape) == 1L) {
      shape <- c(as.integer(shape), 1L)
    }
    shape <- as.integer(shape)
    if (length(shape) > 2L) {
      cli_abort("Expressions of dimension greater than 2 are not supported.")
    }

    ## Handle -1 dimension inference
    ## CVXPY SOURCE: reshape.py lines 74-89
    if (any(shape == -1L)) {
      n_neg <- sum(shape == -1L)
      if (n_neg != 1L) {
        cli_abort("Only one dimension can be -1.")
      }
      total_size <- expr_size(expr)
      neg_idx <- which(shape == -1L)
      other_idx <- which(shape != -1L)
      if (length(other_idx) == 0L) {
        shape[neg_idx] <- total_size
      } else {
        specified <- shape[other_idx]
        if (specified <= 0L) {
          cli_abort("Specified dimension must be positive.")
        }
        inferred <- total_size %/% specified
        if (total_size %% specified != 0L) {
          cli_abort("Cannot reshape expression of size {total_size} into shape ({paste(shape, collapse = ', ')}).")
        }
        shape[neg_idx] <- inferred
      }
    }

    if (!is.character(order) || !(order %in% c("F", "C"))) {
      cli_abort("order must be {.val F} or {.val C}.")
    }

    ## Validate same number of elements
    old_size <- expr_size(expr)
    new_size <- as.integer(prod(shape))
    if (old_size != new_size) {
      cli_abort("Invalid reshape dimensions ({paste(shape, collapse = ', ')}): size {new_size} does not match expression size {old_size}.")
    }

    .fast_new(Reshape, S7_object(),
      id    = next_expr_id(),
      .cache = new.env(parent = emptyenv()),
      args  = list(expr),
      shape = shape,
      order = order
    )
  }
)

# -- shape_from_args --------------------------------------------------
## CVXPY SOURCE: reshape.py:104-107 (#3080). Reshape the arg's bounds, honoring
## the atom's element order ('F' = column-major / R-native, 'C' = row-major).
method(bounds_from_args, Reshape) <- function(x) {
  b <- get_bounds(.args(x)[[1L]])
  reshape_bounds(b[[1L]], b[[2L]], .shape(x), order = x@order)
}

## CVXPY SOURCE: reshape.py lines 117-120

method(shape_from_args, Reshape) <- function(x) .shape(x)

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

# -- is_atom_log_log_convex / concave ---------------------------------
## CVXPY SOURCE: reshape.py lines 91-99

method(is_atom_log_log_convex, Reshape) <- function(x) TRUE
method(is_atom_log_log_concave, Reshape) <- function(x) TRUE

# -- get_data ---------------------------------------------------------
## CVXPY SOURCE: reshape.py lines 122-125

method(get_data, Reshape) <- function(x) {
  list(.shape(x), x@order)
}

# -- numeric_value ---------------------------------------------------
## CVXPY SOURCE: reshape.py lines 101-105

method(numeric_value, Reshape) <- function(x, values, ...) {
  val <- values[[1L]]
  if (inherits(val, "sparseMatrix")) val <- as.matrix(val)
  if (!is.matrix(val)) val <- as.matrix(val)

  if (x@order == "F") {
    ## Column-major (R default)
    matrix(as.vector(val), nrow = .shape(x)[1L], ncol = .shape(x)[2L])
  } else {
    ## Row-major: read elements in C-order, fill target shape row-by-row
    matrix(as.vector(t(val)), nrow = .shape(x)[1L], ncol = .shape(x)[2L],
           byrow = TRUE)
  }
}

# -- validate_arguments ----------------------------------------------
## CVXPY SOURCE: reshape.py lines 107-115
## Already validated in constructor; just re-check sizes

method(validate_arguments, Reshape) <- function(x) {
  old_size <- expr_size(.args(x)[[1L]])
  new_size <- as.integer(prod(.shape(x)))
  if (old_size != new_size) {
    cli_abort("Invalid reshape dimensions ({paste(x@shape, collapse = ', ')}).")
  }
  invisible(NULL)
}

# -- graph_implementation --------------------------------------------
## CVXPY SOURCE: reshape.py lines 127-155

method(graph_implementation, Reshape) <- function(x, arg_objs, shape, data = NULL, ...) {
  arg <- arg_objs[[1L]]
  order <- data[[2L]]
  if (order == "F") {
    list(reshape_linop(arg, shape), list())
  } else {
    ## C-order: transpose -> reshape(reversed) -> transpose
    arg_t <- transpose_linop(arg)
    if (length(shape) <= 1L) {
      list(reshape_linop(arg_t, shape), list())
    } else {
      result <- reshape_linop(arg_t, rev(shape))
      list(transpose_linop(result), list())
    }
  }
}

# -- expr_name --------------------------------------------------------

method(expr_name, Reshape) <- function(x) {
  sprintf("Reshape(%s, c(%s))", expr_name(.args(x)[[1L]]),
          paste(.shape(x), collapse = ", "))
}

method(format_labeled, Reshape) <- function(x) {
  lbl <- label(x); if (!is.null(lbl)) return(lbl)
  sprintf("Reshape(%s, c(%s))", format_labeled(.args(x)[[1L]]),
          paste(.shape(x), collapse = ", "))
}

# -- Convenience function ----------------------------------------------

#' Reshape an expression to a new shape
#'
#' @param x An Expression or numeric value.
#' @param dim Integer vector of length 2: the target shape c(nrow, ncol).
#'   A single integer is treated as c(dim, 1). Use -1 to infer a dimension.
#' @param order Character: "F" (column-major, default) or "C" (row-major).
#' @returns A Reshape expression.
#' @export
reshape_expr <- function(x, dim, order = "F") {
  Reshape(x, shape = dim, order = order)
}

#' Recursively flatten a nested list of expressions into one column vector
#'
#' @description
#' Flattens `x` into a single column vector. An Expression or numeric is
#' vectorized column-major; a list is flattened element by element and the
#' pieces stacked in order, recursively. This is what lets [vdot()] accept
#' nested lists: `vdot(list(a, b), c(1, 2))` is `a * 1 + b * 2`.
#'
#' @param x An Expression, a numeric value, or a (possibly nested) list of them.
#' @returns An Expression of shape `c(n, 1)`.
#' @seealso [vec()], [vdot()]
#' @examples
#' a <- Variable(); b <- Variable()
#' deep_flatten(list(a, b))
#' @export
deep_flatten <- function(x) {
  ## CVXPY SOURCE: atoms/affine/reshape.py:164-184
  ##
  ## R SHAPE TRAP -- the one place this is NOT a transliteration. Upstream
  ## flattens to a 1-D array and concatenates the pieces with hstack, because
  ## hstack of 1-D arrays is 1-D of the summed length. CVXR shapes are ALWAYS
  ## 2-D, so vec() yields an (n, 1) COLUMN, and hstack of columns would give an
  ## (n, k) matrix -- silently the wrong thing. The concatenation has to be
  ## vstack. Verified against cvxpy 1.9.2: deep_flatten(list(a, b)) has shape
  ## (2,) there and c(2, 1) here, and both carry the same entries in the same
  ## order.
  if (is.list(x)) {
    if (length(x) == 0L) {
      cli_abort("{.fn deep_flatten}: cannot flatten an empty list.")
    }
    parts <- lapply(x, deep_flatten)
    if (length(parts) == 1L) return(parts[[1L]])
    return(do.call(vstack, parts))
  }
  if (.s7_is(x, Expression) || is.numeric(x) || is.complex(x) || is.logical(x)) {
    return(vec(x))
  }
  cli_abort(c(
    "{.fn deep_flatten}: cannot flatten an object of class {.cls {class(x)[[1L]]}}.",
    i = "Expected an Expression, a numeric value, or a nested list of them."
  ))
}