R/108_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 (is.null(id)) id <- next_expr_id()
    X <- as_expr(X)
    W <- as_expr(W)
    shape <- c(1L, 1L)

    obj <- new_object(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 <- x@args[[2L]]
  X <- x@args[[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(x@args[[1L]])
  x_neg <- is_nonpos(x@args[[1L]])
  w_pos <- is_nonneg(x@args[[2L]])
  w_neg <- is_nonpos(x@args[[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(x@args[[2L]])
method(is_decr, Dotsort) <- function(x, idx, ...) is_nonpos(x@args[[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.")
}

#' 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)
}