R/099_atoms_sum_largest.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/sum_largest.py
## SumLargest -- sum of k largest entries


SumLargest <- new_class("SumLargest", parent = Atom, package = "CVXR",
  properties = list(
    k = new_property(class = class_numeric)
  ),
  constructor = function(x, k, id = NULL) {
    if (is.null(id)) id <- next_expr_id()
    x <- as_expr(x)
    k <- as.numeric(k)
    ## Shape is scalar (1, 1)
    shape <- c(1L, 1L)

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

# -- validate -----------------------------------------------------
method(validate_arguments, SumLargest) <- function(x) {
  if (x@k <= 0) {
    cli_abort("{.arg k} must be positive, got {.val {x@k}}.")
  }
  ## CVXPY: sum_largest has _allow_complex = False (default) --
  ## super().validate_arguments() rejects complex args
  if (.any_args(x, is_complex)) {
    cli_abort("Arguments to {.cls SumLargest} cannot be complex.")
  }
  invisible(NULL)
}

# -- shape --------------------------------------------------------
method(shape_from_args, SumLargest) <- function(x) c(1L, 1L)

# -- sign: same as arg --------------------------------------------
method(sign_from_args, SumLargest) <- function(x) {
  list(is_nonneg = is_nonneg(x@args[[1L]]),
       is_nonpos = is_nonpos(x@args[[1L]]))
}

# -- curvature: convex --------------------------------------------
method(is_atom_convex, SumLargest) <- function(x) TRUE
method(is_atom_concave, SumLargest) <- function(x) FALSE

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

# -- PWL ----------------------------------------------------------
method(is_pwl, SumLargest) <- function(x) is_pwl(x@args[[1L]])

# -- get_data -----------------------------------------------------
method(get_data, SumLargest) <- function(x) list(x@k)

# -- numeric ------------------------------------------------------
method(numeric_value, SumLargest) <- function(x, values, ...) {
  v <- as.numeric(values[[1L]])
  k <- x@k
  k_floor <- as.integer(floor(k))
  k_frac <- k - k_floor
  sorted <- sort(v, decreasing = TRUE)
  result <- sum(sorted[seq_len(k_floor)])
  if (k_frac > 0 && k_floor < length(sorted)) {
    result <- result + k_frac * sorted[k_floor + 1L]
  }
  matrix(result, 1L, 1L)
}

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

#' Sum of k largest entries
#'
#' @param x An Expression
#' @param k Number of largest entries to sum
#' @returns A SumLargest atom
#' @export
sum_largest <- function(x, k) {
  SumLargest(x, k)
}