R/114_atoms_gmatmul.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/gmatmul.py
## Gmatmul -- geometric matrix multiplication A o X
## A is stored as a property (not an arg) to prevent DGP log-transformation.
## Log-log affine (T/T), sign always positive.


Gmatmul <- new_class("Gmatmul", parent = Atom, package = "CVXR",
  properties = list(
    A = class_any  ## constant matrix (stored as Constant, not an arg)
  ),
  constructor = function(A, X, id = NULL) {
    if (is.null(id)) id <- next_expr_id()
    A <- as_expr(A)
    X <- as_expr(X)
    ## Shape: matrix multiplication shape A %*% X
    shape <- c(A@shape[1L], X@shape[2L])

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

# -- validate -------------------------------------------------------
method(validate_arguments, Gmatmul) <- function(x) {
  if (!is_constant(x@A)) {
    cli_abort("{.fn gmatmul} requires that {.arg A} be constant.")
  }
  if (!is_pos(x@args[[1L]])) {
    cli_abort("{.fn gmatmul} requires that {.arg X} be positive.")
  }
  ## Check dimension compatibility
  if (x@A@shape[2L] != x@args[[1L]]@shape[1L]) {
    cli_abort("Incompatible dimensions: A is {x@A@shape[1L]}x{x@A@shape[2L]} but X is {x@args[[1L]]@shape[1L]}x{x@args[[1L]]@shape[2L]}.")
  }
  invisible(NULL)
}

# -- shape ----------------------------------------------------------
method(shape_from_args, Gmatmul) <- function(x) {
  c(x@A@shape[1L], x@args[[1L]]@shape[2L])
}

# -- sign: always positive -----------------------------------------
method(sign_from_args, Gmatmul) <- function(x) {
  list(is_nonneg = TRUE, is_nonpos = FALSE)
}

# -- curvature: neither convex nor concave --------------------------
method(is_atom_convex, Gmatmul) <- function(x) FALSE
method(is_atom_concave, Gmatmul) <- function(x) FALSE

# -- log-log curvature: affine (T/T) -------------------------------
method(is_atom_log_log_convex, Gmatmul) <- function(x) TRUE
method(is_atom_log_log_concave, Gmatmul) <- function(x) {
  is_atom_log_log_convex(x)
}

# -- monotonicity ---------------------------------------------------
method(is_incr, Gmatmul) <- function(x, idx, ...) is_nonneg(x@A)
method(is_decr, Gmatmul) <- function(x, idx, ...) is_nonpos(x@A)

# -- get_data: A is data, not an arg -------------------------------
method(get_data, Gmatmul) <- function(x) list(x@A)

# -- numeric --------------------------------------------------------
method(numeric_value, Gmatmul) <- function(x, values, ...) {
  A_val <- as.matrix(value(x@A))
  logX <- log(values[[1L]])
  exp(A_val %*% logX)
}

# -- graph_implementation: stub -------------------------------------
method(graph_implementation, Gmatmul) <- function(x, arg_objs, shape, data = NULL, ...) {
  cli_abort("graph_implementation for {.cls Gmatmul} not yet implemented.")
}

#' Geometric matrix multiplication A diamond X
#'
#' Computes the geometric matrix product where (A diamond X)_ij = prod_k X_kj^A_ik.
#' Log-log affine atom for DGP. Solve with
#' \code{psolve(problem, gp = TRUE)}.
#'
#' @param A A constant matrix
#' @param X An Expression (positive matrix)
#' @returns A Gmatmul atom
#' @examples
#' x <- Variable(2, pos = TRUE)
#' A <- matrix(c(1, 0, 0, 1), 2, 2)
#' prob <- Problem(Minimize(sum(gmatmul(A, x))), list(x >= 0.5))
#' \dontrun{psolve(prob, gp = TRUE)}
#' @export
gmatmul <- function(A, X) {
  Gmatmul(A, X)
}