R/116_atoms_dotsort.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/dotsort.py
## Dotsort -- weighted sorted dot product: <sort(vec(X)), sort(vec(W))>


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

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

## Validate: W must be constant, size(W) <= size(X)
method(validate_arguments, Dotsort) <- function(x) {
  W <- .args(x)[[2L]]
  X <- .args(x)[[1L]]
  if (!is_constant(W)) {
    cli_abort("The {.arg W} argument to {.fn dotsort} must be constant.")
  }
  if (expr_size(X) < expr_size(W)) {
    cli_abort("The size of {.arg W} must be less than or equal to the size of {.arg X}.")
  }
  invisible(NULL)
}

## Shape: scalar
method(shape_from_args, Dotsort) <- function(x) c(1L, 1L)

## Sign
method(sign_from_args, Dotsort) <- function(x) {
  x_pos <- is_nonneg(.args(x)[[1L]])
  x_neg <- is_nonpos(.args(x)[[1L]])
  w_pos <- is_nonneg(.args(x)[[2L]])
  w_neg <- is_nonpos(.args(x)[[2L]])
  list(
    is_nonneg = (x_pos && w_pos) || (x_neg && w_neg),
    is_nonpos = (x_neg && w_pos) || (x_pos && w_neg)
  )
}

## Curvature: convex
method(is_atom_convex, Dotsort) <- function(x) TRUE
method(is_atom_concave, Dotsort) <- function(x) FALSE

## Monotonicity: increasing if W nonneg, decreasing if W nonpos
method(is_incr, Dotsort) <- function(x, idx, ...) is_nonneg(.args(x)[[2L]])
method(is_decr, Dotsort) <- function(x, idx, ...) is_nonpos(.args(x)[[2L]])

## PWL
method(is_pwl, Dotsort) <- function(x) TRUE

## get_data
method(get_data, Dotsort) <- function(x) NULL

## numeric
method(numeric_value, Dotsort) <- function(x, values, ...) {
  xv <- as.numeric(values[[1L]])
  wv <- as.numeric(values[[2L]])
  ## Pad w with zeros if shorter
  w_padded <- numeric(length(xv))
  w_padded[seq_along(wv)] <- wv
  matrix(sum(sort(xv) * sort(w_padded)), 1L, 1L)
}

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

# -- .grad: per-atom subgradient ----------------------------------
## CVXPY SOURCE: atoms/dotsort.py:66-83 (dotsort._grad).
## The j-th largest of w is placed at the index of the j-th largest of x.
## i.e. grad[order(x)[j]] = sort(w_padded)[j]; remaining entries are 0.
## sort() in R defaults to increasing order, matching np.sort().
method(.grad, Dotsort) <- function(x, values, ...) {
  xv <- as.numeric(values[[1L]])      # column-major flatten
  wv <- as.numeric(values[[2L]])
  n  <- length(xv)
  ## Pad w with zeros to length(x), as in CVXPY's _get_args_from_values.
  w_padded <- numeric(n)
  w_padded[seq_along(wv)] <- wv
  indices  <- order(xv)               # 1-based ordering
  sorted_w <- sort(w_padded)
  list(Matrix::sparseMatrix(
    i = indices,
    j = rep_len(1L, n),
    x = sorted_w,
    dims = c(n, 1L),
    repr = "C"
  ))
}

#' Weighted sorted dot product
#'
#' @description
#' Computes `<sort(vec(X)), sort(vec(W))>` where X is an expression and W is a
#' constant. A generalization of `sum_largest` and `sum_smallest`.
#'
#' @param X An Expression or numeric value.
#' @param W A constant numeric vector or matrix.
#' @returns A scalar convex Expression.
#' @export
dotsort <- function(X, W) {
  Dotsort(X, W)
}