R/119_atoms_one_minus_pos.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/one_minus_pos.py
## OneMInusPos -- 1 - x with domain {x : 0 < x < 1}
## Log-log concave (F/T), sign always positive.


OneMInusPos <- new_class("OneMInusPos", parent = Atom, package = "CVXR",
  constructor = function(x, id = NULL) {
    if (FALSE) new_object(S7_object())  ## S7 static-check guard
    if (is.null(id)) id <- next_expr_id()
    x <- as_expr(x)
    shape <- .shape(x)

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

# -- shape ----------------------------------------------------------
method(shape_from_args, OneMInusPos) <- function(x) .arg_shape(x)

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

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

# -- log-log curvature: concave only (F/T) -------------------------
method(is_atom_log_log_convex, OneMInusPos) <- function(x) FALSE
method(is_atom_log_log_concave, OneMInusPos) <- function(x) TRUE

# -- monotonicity: decreasing --------------------------------------
method(is_incr, OneMInusPos) <- function(x, idx, ...) FALSE
method(is_decr, OneMInusPos) <- function(x, idx, ...) TRUE

# -- numeric --------------------------------------------------------
method(numeric_value, OneMInusPos) <- function(x, values, ...) {
  ones <- matrix(1, nrow = .shape(x)[1L], ncol = .shape(x)[2L])
  ones - values[[1L]]
}

# -- get_data -------------------------------------------------------
method(get_data, OneMInusPos) <- function(x) list()

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

# -- .grad: -I for the elementwise 1 - x case ---------------------
## CVXPY SOURCE: atoms/one_minus_pos.py:59-63 (one_minus_pos._grad).
## CVXPY returns a -I diagonal regardless of input value. This is
## consistent with the atom's DGP-context use (x > 0 always, so
## pos(x) = x and grad(1 - pos(x)) = -1 elementwise).
method(.grad, OneMInusPos) <- function(x, values, ...) {
  rows <- as.integer(prod(.arg_shape(x)))
  list(Matrix::sparseMatrix(
    i = seq_len(rows), j = seq_len(rows),
    x = rep(-1, rows),
    dims = c(rows, rows), repr = "C"
  ))
}

#' The difference 1 - x with domain (0, 1)
#'
#' Log-log concave atom for DGP. Solve with
#' \code{psolve(problem, gp = TRUE)}.
#'
#' @param x An Expression (elementwise in (0, 1))
#' @returns A OneMInusPos atom
#' @examples
#' x <- Variable(pos = TRUE)
#' prob <- Problem(Maximize(one_minus_pos(x)), list(x >= 0.1, x <= 0.5))
#' \dontrun{psolve(prob, gp = TRUE)}
#' @export
one_minus_pos <- function(x) {
  OneMInusPos(x)
}

#' The difference x - y with domain x > y > 0
#'
#' Equivalent to x * one_minus_pos(y / x).
#'
#' @param x An Expression (positive)
#' @param y An Expression (positive, elementwise less than x)
#' @returns A product expression
#' @export
diff_pos <- function(x, y) {
  x * one_minus_pos(y / x)
}