R/109_atoms_prod.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/prod.py
## Prod -- product of entries along an axis (AxisAtom)
## Log-log affine (T/T), neither convex nor concave.


Prod <- new_class("Prod", parent = AxisAtom, package = "CVXR",
  constructor = function(x, axis = NULL, keepdims = FALSE, id = NULL) {
    if (is.null(id)) id <- next_expr_id()
    x <- as_expr(x)
    if (!is.null(axis)) axis <- as.integer(axis)
    keepdims <- as.logical(keepdims)
    shape <- .axis_shape(x@shape, axis, keepdims)

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

# -- sign -----------------------------------------------------------
method(sign_from_args, Prod) <- function(x) {
  list(is_nonneg = is_nonneg(x@args[[1L]]), is_nonpos = FALSE)
}

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

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

# -- monotonicity ---------------------------------------------------
method(is_incr, Prod) <- function(x, idx, ...) is_nonneg(x@args[[1L]])
method(is_decr, Prod) <- function(x, idx, ...) FALSE

# -- numeric --------------------------------------------------------
method(numeric_value, Prod) <- function(x, values, ...) {
  v <- values[[1L]]
  ax <- x@axis
  kd <- x@keepdims
  if (is.null(ax)) {
    result <- prod(v)
    matrix(result, 1L, 1L)
  } else if (ax == 2L) {
    result <- apply(v, 2L, prod)
    if (kd) matrix(result, nrow = 1L) else matrix(result, nrow = 1L)
  } else {
    result <- apply(v, 1L, prod)
    if (kd) matrix(result, ncol = 1L) else matrix(result, ncol = 1L)
  }
}

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

#' Product of entries along an axis
#'
#' Used in DGP (geometric programming) context. Solve with
#' \code{psolve(problem, gp = TRUE)}.
#'
#' @param x An Expression
#' @param axis NULL (all), 1 (row-wise), or 2 (column-wise)
#' @param keepdims Whether to keep reduced dimensions
#' @returns A Prod atom
#' @examples
#' x <- Variable(3, pos = TRUE)
#' prob <- Problem(Minimize(prod_entries(x)), list(x >= 2))
#' \dontrun{psolve(prob, gp = TRUE)}
#' @export
prod_entries <- function(x, axis = NULL, keepdims = FALSE) {
  Prod(x, axis, keepdims)
}