R/066_atoms_elementwise_entr.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/elementwise/entr.py
## Entr -- elementwise entropy -x * log(x)


Entr <- new_class("Entr", parent = Elementwise, 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(Entr, S7_object(),
      id    = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args  = list(x),
      shape = shape
    )
    validate_arguments(obj)
    obj
  }
)

# -- sign: unknown ------------------------------------------------
method(sign_from_args, Entr) <- function(x) {
  list(is_nonneg = FALSE, is_nonpos = FALSE)
}

# -- curvature: concave -------------------------------------------
method(is_atom_convex, Entr) <- function(x) FALSE
method(is_atom_concave, Entr) <- function(x) TRUE

## CVXPY elementwise/entr.py: entr is smooth.
method(is_atom_smooth, Entr) <- function(x) TRUE

# -- monotonicity: not monotone -----------------------------------
method(is_incr, Entr) <- function(x, idx, ...) FALSE
method(is_decr, Entr) <- function(x, idx, ...) FALSE

# -- domain: arg >= 0 ---------------------------------------------
method(atom_domain, Entr) <- function(x) {
  list(.args(x)[[1L]] >= 0)
}

# -- numeric: -x * log(x) ----------------------------------------
method(numeric_value, Entr) <- function(x, values, ...) {
  v <- values[[1L]]
  ## -x * log(x), with 0*log(0) = 0
  result <- ifelse(v > 0, -v * log(v), ifelse(v == 0, 0, -Inf))
  result
}

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

# -- .grad: per-atom subgradient ----------------------------------
## CVXPY SOURCE: atoms/elementwise/entr.py:71-92 (entr._grad).
## d/dx entr(x) = -log(x) - 1; domain x > 0. NULL on boundary or below.
method(.grad, Entr) <- function(x, values, ...) {
  v <- values[[1L]]
  if (min(v) <= 0) return(list(NULL))
  rows <- as.integer(prod(.arg_shape(x)))
  cols <- as.integer(prod(.shape(x)))
  list(.elemwise_grad_to_diag(-log(v) - 1, rows, cols))
}

#' Create an entropy atom -x * log(x)
#'
#' @param x An Expression
#' @returns An Entr atom
#' @export
entr <- function(x) {
  Entr(x)
}