R/019_interface_matrix_utilities.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/interface/matrix_utilities.R
#####

## CVXPY SOURCE: interface/matrix_utilities.py
## R-side matrix interface utilities

# -- Convert values to canonical R matrix form -------------------------
## CVXPY equivalent: intf.convert() / DEFAULT_INTF.const_to_matrix()

#' Convert a value to a numeric matrix or sparse matrix
#'
#' Normalizes R values so the rest of CVXR can assume a consistent type.
#' Scalars -> 1x1 matrix, vectors -> column matrix, logical -> numeric.
#' Sparse matrices are kept sparse.
#'
#' @param val A numeric scalar, vector, matrix, or Matrix object
#' @returns A matrix or dgCMatrix
#' @keywords internal
intf_convert <- function(val) {
  if (inherits(val, "sparseVector")) {
    ## Convert sparseVector to sparse column matrix
    n <- length(val)
    idx <- val@i
    vals <- val@x
    return(Matrix::sparseMatrix(i = idx, j = rep(1L, length(idx)),
                                x = vals, dims = c(n, 1L)))
  }
  if (inherits(val, "sparseMatrix")) {
    ## Keep sparse matrices sparse, but ensure numeric (not logical)
    if (is.logical(val@x)) {
      val <- as(val, "dgCMatrix")
    }
    return(val)
  }
  if (is.logical(val)) {
    val <- as.numeric(val)
  }
  ## Complex values: preserve complex type (do NOT coerce to double)
  if (is.complex(val)) {
    if (!is.matrix(val)) {
      if (length(val) == 1L) {
        val <- matrix(val, 1L, 1L)
      } else {
        val <- matrix(val, ncol = 1L)
      }
    }
    return(val)
  }
  if (is.numeric(val) && !is.matrix(val)) {
    if (length(val) == 1L) {
      val <- matrix(val, 1L, 1L)
    } else {
      ## Vector -> column matrix (Fortran-order, matching CVXPY)
      val <- matrix(val, ncol = 1L)
    }
  }
  if (is.matrix(val)) {
    if (!is.numeric(val)) {
      storage.mode(val) <- "double"
    }
    return(val)
  }
  if (inherits(val, "Matrix")) {
    return(as.matrix(val))
  }
  cli_abort("Cannot convert object of class {.cls {class(val)}} to a CVXR matrix.")
}

# -- Shape of a value --------------------------------------------------
## CVXPY equivalent: intf.shape()

#' Get the shape of a value as an integer vector c(nrow, ncol)
#' @param val A numeric scalar, vector, matrix, or Matrix object
#' @returns Integer vector of length 2
#' @keywords internal
intf_shape <- function(val) {
  if (is.matrix(val) || inherits(val, "Matrix")) {
    return(c(nrow(val), ncol(val)))
  }
  if (length(val) == 1L) {
    return(c(1L, 1L))
  }
  ## Vector
  c(length(val), 1L)
}

# -- Sign of a value --------------------------------------------------
## CVXPY equivalent: intf.sign()

#' Determine the sign of a numeric value
#' @param val A numeric matrix or sparse matrix
#' @returns List with \code{is_nonneg} (logical) and \code{is_nonpos} (logical)
#' @keywords internal
intf_sign <- function(val) {
  ## Handle empty values (0-element)
  if (length(val) == 0L) {
    return(list(is_nonneg = TRUE, is_nonpos = TRUE))
  }
  ## Complex values have no sign ordering
  ## CVXPY SOURCE: constant.py _compute_attr() sets nonneg=nonpos=False for complex
  if (is.complex(val)) {
    return(list(is_nonneg = FALSE, is_nonpos = FALSE))
  }
  if (inherits(val, "sparseMatrix")) {
    ## Pattern matrices (ngCMatrix etc.) have no @x slot -- treat as all zeros
    if (!.hasSlot(val, "x") || length(val@x) == 0L) {
      return(list(is_nonneg = TRUE, is_nonpos = TRUE))
    }
    vals <- val@x
  } else {
    vals <- as.numeric(val)
  }
  ## NaN -> treat as unknown sign (neither nonneg nor nonpos)
  if (anyNA(vals)) {
    return(list(is_nonneg = FALSE, is_nonpos = FALSE))
  }
  mx <- max(vals)
  mn <- min(vals)
  list(is_nonneg = (mn >= 0), is_nonpos = (mx <= 0))
}

# -- Is sparse? --------------------------------------------------------
## CVXPY equivalent: intf.is_sparse()

#' Check if a value is a sparse matrix
#' @param val A value
#' @returns Logical
#' @keywords internal
intf_is_sparse <- function(val) {
  inherits(val, "sparseMatrix")
}

# -- Hermitian / symmetric check ---------------------------------------
## CVXPY equivalent: intf.is_hermitian()

#' Check if a matrix is symmetric (and Hermitian for real case)
#' @param val A numeric matrix or sparse matrix
#' @returns List with \code{is_symmetric} (logical) and \code{is_hermitian} (logical)
#' @keywords internal
intf_is_hermitian <- function(val) {
  ## Complex case: "symmetric" always means "real symmetric" in CVXPY,
  ## so is_symmetric is always FALSE for complex matrices.
  ## CVXPY SOURCE: interface/matrix_utilities.py lines 278-296
  if (is.complex(val)) {
    is_symm <- FALSE
    if (inherits(val, "sparseMatrix")) {
      ## Use Matrix::isSymmetric explicitly to avoid S4 dispatch issues
      is_herm <- Matrix::isSymmetric(val, tol = 1e-10)
    } else {
      is_herm <- isTRUE(all.equal(val, Conj(t(val)), tolerance = 1e-10))
    }
    return(list(is_symmetric = is_symm, is_hermitian = is_herm))
  }
  ## Real case: symmetric == hermitian
  ## Use Matrix::isSymmetric for sparse matrices to avoid S4 dispatch issues
  ## (ddiMatrix, dsCMatrix etc. can fail with base::isSymmetric when S7 is loaded)
  if (inherits(val, "Matrix")) {
    is_symm <- Matrix::isSymmetric(val, tol = 1e-10)
  } else {
    is_symm <- isSymmetric(val, tol = 1e-10)
  }
  list(is_symmetric = is_symm, is_hermitian = is_symm)
}

# -- Skew-symmetric check ---------------------------------------------
## CVXPY SOURCE: interface/matrix_utilities.py is_skew_symmetric()

#' Check if a matrix is skew-symmetric (A + A^T == 0)
#' @param val A numeric matrix or sparse matrix
#' @returns Logical scalar
#' @keywords internal
intf_is_skew_symmetric <- function(val) {
  ## Non-square: error (matches CVXPY)
  if (nrow(val) != ncol(val)) {
    cli_abort("Skew-symmetry requires a square matrix.")
  }
  ## Complex matrices: skew-symmetric not defined in CVXPY (returns False)
  if (is.complex(val)) return(FALSE)
  if (inherits(val, "sparseMatrix")) {
    isTRUE(all.equal(val, -Matrix::t(val), tolerance = 1e-10))
  } else {
    isTRUE(all.equal(val, -t(val), tolerance = 1e-10))
  }
}

# -- PSD check via eigenvalues -----------------------------------------
## CVXPY equivalent: utilities/linalg.py::is_psd_within_tol

#' Check if a symmetric matrix is PSD within tolerance
#' @param val A symmetric numeric matrix
#' @param tol Eigenvalue tolerance
#' @returns Logical
#' @keywords internal
intf_is_psd <- function(val, tol = EIGVAL_TOL) {
  ev <- .eigvalsh(val, only_values = TRUE)$values
  all(ev >= -tol)
}