R/304_zzz_R_specific_grad_delta_attrs.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/zzz_R_specific/grad_delta_attrs.R
#####

## R-SPECIFIC: gradient / delta accessors on Leaf (Variable / Parameter).
##
## CVXPY assigns these directly as Python attributes:
##   variable.gradient = ...   parameter.gradient = ...
##   parameter.delta   = ...   variable.delta   = ...
## R has no free-form attribute assignment on S7 objects, so we expose
## getter/setter pairs that store the value on the existing `.cache`
## environment.
##
## Semantics (match CVXPY problem.py):
##   * gradient: starts NULL.  In Problem$backward(), a NULL gradient
##     on a Variable is treated as the all-ones vector (the default
##     "sum-of-x" loss); on a Parameter it is treated as zero (no
##     contribution from that parameter).
##   * delta: starts NULL.  In Problem$derivative(), a NULL delta on
##     a Parameter is treated as zero (no perturbation); on a
##     Variable it is set as a side-effect (the predicted change in
##     the variable's optimal value).

# -- gradient ----------------------------------------------------

#' Access the gradient of a Variable or Parameter
#'
#' Used by [psolve()] with `requires_grad = TRUE` and
#' `Problem$backward()`.  Stores a numeric array of the same shape as
#' the leaf, or `NULL` (the default).
#'
#' @param x A `Variable` or `Parameter`.
#' @returns The gradient (numeric array) or `NULL`.
#' @export
gradient <- function(x) {
  if (!.s7_is(x, Leaf)) {
    cli_abort("{.fn gradient} is only defined on a {.cls Variable} or {.cls Parameter}.")
  }
  x@.cache$gradient
}

#' @rdname gradient
#' @param value A numeric array of the same shape as `x`, or `NULL`.
#' @export
`gradient<-` <- function(x, value) {
  if (!.s7_is(x, Leaf)) {
    cli_abort("{.fn `gradient<-`} is only defined on a {.cls Variable} or {.cls Parameter}.")
  }
  if (!is.null(value)) {
    ## Keep complex: as.numeric() would silently DROP the imaginary part of a
    ## complex gradient/delta (ADR D_19.5). as.vector() preserves the type and
    ## flattens; the shape is restored by `dim(value) <- x@shape` below.
    value <- as.vector(value)
    if (length(value) != prod(x@shape)) {
      cli_abort(c(
        "{.arg value} length does not match the leaf's shape.",
        "i" = "Got {length(value)}; expected {prod(x@shape)}."
      ))
    }
    dim(value) <- x@shape
  }
  x@.cache$gradient <- value
  x
}

# -- delta -------------------------------------------------------

#' Access the perturbation `delta` of a Variable or Parameter
#'
#' Used by [psolve()] with `requires_grad = TRUE` and
#' `Problem$derivative()`.  On a `Parameter`, the user sets `delta`
#' to a perturbation of the parameter's value; `derivative()` then
#' reports the predicted change in each `Variable`'s optimal value
#' as `delta(variable)`.
#'
#' @param x A `Variable` or `Parameter`.
#' @returns The perturbation (numeric array) or `NULL`.
#' @export
delta <- function(x) {
  if (!.s7_is(x, Leaf)) {
    cli_abort("{.fn delta} is only defined on a {.cls Variable} or {.cls Parameter}.")
  }
  x@.cache$delta
}

#' @rdname delta
#' @param value A numeric array of the same shape as `x`, or `NULL`.
#' @export
`delta<-` <- function(x, value) {
  if (!.s7_is(x, Leaf)) {
    cli_abort("{.fn `delta<-`} is only defined on a {.cls Variable} or {.cls Parameter}.")
  }
  if (!is.null(value)) {
    ## Keep complex: as.numeric() would silently DROP the imaginary part of a
    ## complex gradient/delta (ADR D_19.5). as.vector() preserves the type and
    ## flattens; the shape is restored by `dim(value) <- x@shape` below.
    value <- as.vector(value)
    if (length(value) != prod(x@shape)) {
      cli_abort(c(
        "{.arg value} length does not match the leaf's shape.",
        "i" = "Got {length(value)}; expected {prod(x@shape)}."
      ))
    }
    dim(value) <- x@shape
  }
  x@.cache$delta <- value
  x
}