R/085_atoms_elementwise_ceil.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/elementwise/ceil.py
## Ceil and Floor -- elementwise ceiling and floor atoms
## These are DQCP-only (quasiconvex AND quasiconcave, but NOT convex or concave)

# ===================================================================
# Ceil -- elementwise ceiling
# ===================================================================
## CVXPY SOURCE: ceil.py class ceil(Elementwise)

Ceil <- new_class("Ceil", parent = Elementwise, package = "CVXR",
  constructor = function(x) {
    if (FALSE) new_object(S7_object())  ## S7 static-check guard
    x <- as_expr(x)
    id <- next_expr_id()
    shape <- .shape(x)
    obj <- .fast_new(Ceil, S7_object(),
      id    = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args  = list(x),
      shape = shape
    )
    validate_arguments(obj)
    obj
  }
)

## numeric: ceiling with tolerance rounding
## CVXPY SOURCE: ceil.py numeric -- np.ceil(np.around(values[0], decimals))
method(numeric_value, Ceil) <- function(x, values, ...) {
  decimals <- as.integer(abs(log10(ATOM_EVAL_TOL)))
  ceiling(round(values[[1L]], digits = decimals))
}

## sign: preserves argument sign
## CVXPY SOURCE: ceil.py sign_from_args
method(sign_from_args, Ceil) <- function(x) {
  arg <- .args(x)[[1L]]
  if (is_nonneg(arg) && is_nonpos(arg)) {
    list(is_nonneg = TRUE, is_nonpos = TRUE)
  } else if (is_nonneg(arg)) {
    list(is_nonneg = TRUE, is_nonpos = FALSE)
  } else if (is_nonpos(arg)) {
    list(is_nonneg = FALSE, is_nonpos = TRUE)
  } else {
    list(is_nonneg = FALSE, is_nonpos = FALSE)
  }
}

## NOT convex, NOT concave
method(is_atom_convex, Ceil) <- function(x) FALSE
method(is_atom_concave, Ceil) <- function(x) FALSE

## NOT log-log
method(is_atom_log_log_convex, Ceil) <- function(x) FALSE
method(is_atom_log_log_concave, Ceil) <- function(x) FALSE

## Quasiconvex AND quasiconcave
method(is_atom_quasiconvex, Ceil) <- function(x) TRUE
method(is_atom_quasiconcave, Ceil) <- function(x) TRUE

## Monotone increasing
method(is_incr, Ceil) <- function(x, idx, ...) TRUE
method(is_decr, Ceil) <- function(x, idx, ...) FALSE

## Per-atom subgradient: zero almost everywhere (step function).
## CVXPY SOURCE: atoms/elementwise/ceil.py:88-101 (ceil._grad).
method(.grad, Ceil) <- function(x, values, ...) {
  rows <- as.integer(prod(.arg_shape(x)))
  cols <- as.integer(prod(.shape(x)))
  list(Matrix::sparseMatrix(
    i = integer(0), j = integer(0),
    x = numeric(0),
    dims = c(rows, cols),
    repr = "C"
  ))
}

## get_data: no extra data
method(get_data, Ceil) <- function(x) NULL

# ===================================================================
# Floor -- elementwise floor
# ===================================================================
## CVXPY SOURCE: ceil.py class floor(Elementwise)

Floor <- new_class("Floor", parent = Elementwise, package = "CVXR",
  constructor = function(x) {
    if (FALSE) new_object(S7_object())  ## S7 static-check guard
    x <- as_expr(x)
    id <- next_expr_id()
    shape <- .shape(x)
    obj <- .fast_new(Floor, S7_object(),
      id    = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args  = list(x),
      shape = shape
    )
    validate_arguments(obj)
    obj
  }
)

## numeric: floor with tolerance rounding
## CVXPY SOURCE: ceil.py:109-112 (CVXPY 1.9.2) -- `np.floor(np.around(...))`.
## Ceil already rounded first; floor did not, so a value a hair under an
## integer (3 - 1e-10, ordinary solver noise) floored to the integer BELOW.
## Both R's round() and numpy's around() break ties to even, so 2.5 -> 2.
method(numeric_value, Floor) <- function(x, values, ...) {
  decimals <- as.integer(abs(log10(ATOM_EVAL_TOL)))
  floor(round(values[[1L]], digits = decimals))
}

## sign: preserves argument sign
method(sign_from_args, Floor) <- function(x) {
  arg <- .args(x)[[1L]]
  if (is_nonneg(arg) && is_nonpos(arg)) {
    list(is_nonneg = TRUE, is_nonpos = TRUE)
  } else if (is_nonneg(arg)) {
    list(is_nonneg = TRUE, is_nonpos = FALSE)
  } else if (is_nonpos(arg)) {
    list(is_nonneg = FALSE, is_nonpos = TRUE)
  } else {
    list(is_nonneg = FALSE, is_nonpos = FALSE)
  }
}

## NOT convex, NOT concave
method(is_atom_convex, Floor) <- function(x) FALSE
method(is_atom_concave, Floor) <- function(x) FALSE

## NOT log-log
method(is_atom_log_log_convex, Floor) <- function(x) FALSE
method(is_atom_log_log_concave, Floor) <- function(x) FALSE

## Quasiconvex AND quasiconcave
method(is_atom_quasiconvex, Floor) <- function(x) TRUE
method(is_atom_quasiconcave, Floor) <- function(x) TRUE

## Monotone increasing
method(is_incr, Floor) <- function(x, idx, ...) TRUE
method(is_decr, Floor) <- function(x, idx, ...) FALSE

## Per-atom subgradient: zero almost everywhere (step function).
## CVXPY SOURCE: atoms/elementwise/ceil.py:166-180 (floor._grad).
method(.grad, Floor) <- function(x, values, ...) {
  rows <- as.integer(prod(.arg_shape(x)))
  cols <- as.integer(prod(.shape(x)))
  list(Matrix::sparseMatrix(
    i = integer(0), j = integer(0),
    x = numeric(0),
    dims = c(rows, cols),
    repr = "C"
  ))
}

## get_data: no extra data
method(get_data, Floor) <- function(x) NULL

# -- User-facing constructor functions -----------------------------

#' Elementwise Ceiling
#'
#' Returns the ceiling (smallest integer >= x) of each element.
#' This atom is quasiconvex and quasiconcave but NOT convex or concave,
#' so it can only be used in DQCP problems (solved with \code{qcp = TRUE}).
#'
#' @param x A CVXR expression.
#' @returns A \code{Ceil} expression.
#' @seealso \code{\link{floor_expr}}
#' @export
ceil_expr <- function(x) Ceil(x)

#' Elementwise Floor
#'
#' Returns the floor (largest integer <= x) of each element.
#' This atom is quasiconvex and quasiconcave but NOT convex or concave,
#' so it can only be used in DQCP problems (solved with \code{qcp = TRUE}).
#'
#' @param x A CVXR expression.
#' @returns A \code{Floor} expression.
#' @seealso \code{\link{ceil_expr}}
#' @export
floor_expr <- function(x) Floor(x)