R/044_atoms_affine_diag.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/affine/diag.py
## DiagVec -- vector to diagonal matrix (with off-diagonal offset k)
## DiagMat -- matrix diagonal to vector (with off-diagonal offset k)

#' Vector to Diagonal Matrix
#'
#' Constructs a diagonal matrix from a column vector. If \code{k != 0},
#' the vector is placed on the \code{k}-th super- or sub-diagonal.
#'
#' @param x A CVXR expression (column vector).
#' @param k Integer diagonal offset. \code{k = 0} (default) is the main
#'   diagonal, \code{k > 0} is above, \code{k < 0} is below.
#' @param id Optional integer ID.
#' @returns A \code{DiagVec} expression of shape
#'   \code{c(n + abs(k), n + abs(k))}.
#' @seealso \code{\link{DiagMat}}
#' @export
DiagVec <- new_class("DiagVec", parent = AffAtom, package = "CVXR",
  properties = list(
    k = new_property(class = class_integer)
  ),
  constructor = function(x, k = 0L, id = NULL) {
    if (is.null(id)) id <- next_expr_id()
    x <- as_expr(x)
    k <- as.integer(k)
    ## x must be a vector (n, 1) -> diagonal (n + abs(k), n + abs(k))
    n <- x@shape[1L] + abs(k)
    shape <- c(n, n)

    obj <- new_object(S7_object(),
      id    = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args  = list(x),
      shape = shape,
      k     = k
    )
    validate_arguments(obj)
    obj
  }
)

method(validate_arguments, DiagVec) <- function(x) {
  arg <- x@args[[1L]]
  if (arg@shape[2L] != 1L) {
    cli_abort("{.cls DiagVec} requires a column vector, got shape ({arg@shape[1L]}, {arg@shape[2L]}).")
  }
  invisible(NULL)
}

## CVXPY: diag.py lines 90-94
method(shape_from_args, DiagVec) <- function(x) {
  n <- x@args[[1L]]@shape[1L] + abs(x@k)
  c(n, n)
}

## CVXPY: diag.py lines 96-104
method(is_symmetric, DiagVec) <- function(x) x@k == 0L
method(is_hermitian, DiagVec) <- function(x) x@k == 0L

## CVXPY: diag.py lines 106-114
method(is_psd, DiagVec) <- function(x) is_nonneg(x) && x@k == 0L
method(is_nsd, DiagVec) <- function(x) is_nonpos(x) && x@k == 0L

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

# -- get_data ------------------------------------------------------
## CVXPY: diag.py lines 64-65
method(get_data, DiagVec) <- function(x) list(x@k)

method(numeric_value, DiagVec) <- function(x, values, ...) {
  ## CVXPY: np.diag(values[0], k=self.k)
  v <- as.vector(values[[1L]])
  zero <- if (is.complex(v)) 0+0i else 0
  m <- matrix(zero, nrow = x@shape[1L], ncol = x@shape[2L])
  n <- length(v)
  if (x@k >= 0L) {
    for (i in seq_len(n)) m[i, i + x@k] <- v[i]
  } else {
    for (i in seq_len(n)) m[i - x@k, i] <- v[i]
  }
  m
}

method(graph_implementation, DiagVec) <- function(x, arg_objs, shape, data = NULL, ...) {
  list(diag_vec_linop(arg_objs[[1L]], x@k), list())
}

# ------------------------------------------------------------------

#' Extract Diagonal from a Matrix
#'
#' Extracts the \code{k}-th diagonal of a square matrix as a column vector.
#'
#' @param x A CVXR expression (square matrix).
#' @param k Integer diagonal offset. \code{k = 0} (default) is the main
#'   diagonal, \code{k > 0} is above, \code{k < 0} is below.
#' @param id Optional integer ID.
#' @returns A \code{DiagMat} expression of shape
#'   \code{c(n - abs(k), 1)}.
#' @seealso \code{\link{DiagVec}}
#' @export
DiagMat <- new_class("DiagMat", parent = AffAtom, package = "CVXR",
  properties = list(
    k = new_property(class = class_integer)
  ),
  constructor = function(x, k = 0L, id = NULL) {
    if (is.null(id)) id <- next_expr_id()
    x <- as_expr(x)
    k <- as.integer(k)
    ## x must be square (n, n) -> vector (n - abs(k), 1)
    n <- x@shape[1L] - abs(k)
    shape <- c(n, 1L)

    obj <- new_object(S7_object(),
      id    = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args  = list(x),
      shape = shape,
      k     = k
    )
    validate_arguments(obj)
    obj
  }
)

method(validate_arguments, DiagMat) <- function(x) {
  arg <- x@args[[1L]]
  if (arg@shape[1L] != arg@shape[2L]) {
    cli_abort("{.cls DiagMat} requires a square matrix, got shape ({arg@shape[1L]}, {arg@shape[2L]}).")
  }
  if (abs(x@k) >= arg@shape[1L]) {
    cli_abort("Offset {.val {x@k}} out of bounds for {arg@shape[1L]}x{arg@shape[2L]} matrix.")
  }
  invisible(NULL)
}

## CVXPY: diag.py lines 172-176
method(shape_from_args, DiagMat) <- function(x) {
  c(x@args[[1L]]@shape[1L] - abs(x@k), 1L)
}

## CVXPY: diag.py lines 178-180
method(is_nonneg, DiagMat) <- function(x) {
  (is_nonneg(x@args[[1L]]) || is_psd(x@args[[1L]])) && x@k == 0L
}

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

# -- get_data ------------------------------------------------------
## CVXPY: diag.py lines 146-147
method(get_data, DiagMat) <- function(x) list(x@k)

method(numeric_value, DiagMat) <- function(x, values, ...) {
  ## CVXPY: np.diag(values[0], k=self.k)
  m <- values[[1L]]
  n <- nrow(m) - abs(x@k)
  v <- if (is.complex(m)) complex(n) else numeric(n)
  if (x@k >= 0L) {
    for (i in seq_len(n)) v[i] <- m[i, i + x@k]
  } else {
    for (i in seq_len(n)) v[i] <- m[i - x@k, i]
  }
  matrix(v, ncol = 1L)
}

method(graph_implementation, DiagMat) <- function(x, arg_objs, shape, data = NULL, ...) {
  list(diag_mat_linop(arg_objs[[1L]], x@k), list())
}