R/191_reductions_chain.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/reductions/chain.R
#####

## CVXPY SOURCE: reductions/chain.py
## Chain -- sequence of reductions applied in order


# -- Chain class ---------------------------------------------------
## CVXPY SOURCE: chain.py lines 5-85

Chain <- new_class("Chain", parent = Reduction, package = "CVXR",
  properties = list(
    reductions = class_list
  ),
  constructor = function(reductions = list()) {
    if (FALSE) new_object(S7_object())  ## S7 static-check guard
    .fast_new(Chain, S7_object(),
      .cache     = new.env(parent = emptyenv()),
      reductions = reductions
    )
  }
)

## accepts: chain is valid if each reduction accepts the output of the previous
## CVXPY SOURCE: chain.py lines 30-52
method(reduction_accepts, Chain) <- function(x, problem, ...) {
  for (r in x@reductions) {
    if (!reduction_accepts(r, problem)) return(FALSE)
    result <- reduction_apply(r, problem)
    problem <- result[[1L]]
  }
  TRUE
}

## apply: apply each reduction in sequence
## CVXPY SOURCE: chain.py lines 54-78
method(reduction_apply, Chain) <- function(x, problem, ...) {
  inverse_data <- list()
  for (r in x@reductions) {
    result <- reduction_apply(r, problem)
    problem <- result[[1L]]
    inverse_data <- c(inverse_data, list(result[[2L]]))
  }
  list(problem, inverse_data)
}

## invert: apply inversions in reverse order
## CVXPY SOURCE: chain.py lines 80-85
method(reduction_invert, Chain) <- function(x, solution, inverse_data, ...) {
  for (i in rev(seq_along(x@reductions))) {
    solution <- reduction_invert(x@reductions[[i]], solution, inverse_data[[i]])
  }
  solution
}

## print
method(print, Chain) <- function(x, ...) {
  names <- vapply(x@reductions, function(r) short_class_name(r),
                  character(1L))
  cat(sprintf("Chain(%s)\n", paste(names, collapse = " -> ")))
  invisible(x)
}

# -- Leaf-id map composition (chain-level) -------------------------
## CVXPY SOURCE: chain.py:5-23 (_compose_id_map), 101-131
## (compose_var_id_map / compose_param_id_map).
##
## This is a COMPLETE, faithful port of chain.py's composition machinery -- it
## folds each reduction's var_id_map() / param_id_map() into one
## orig-id -> [final-id, ...] mapping, 1->many capable. NOT a V19-PARTIAL slice:
## the composition logic mirrors CVXPY exactly. Under CVXR's (deliberate,
## ADR-D_19.5) shared-id design, the #3147-part-B producers
## (cvx_attr2constr / complex2real / dgp2dcp) keep leaf ids rather than minting
## fresh ones, so every reduction's var_id_map()/param_id_map() returns the empty
## default and these compose to list(). That divergence lives in the PRODUCERS
## (reduction.R's lone V19-PARTIAL), not here.
##
## Why ported now (cheap insurance, no behavior change today): the CVXPY consumer
## idiom -- compose_var_id_map(chain)[[id]] %||% id -- now resolves to the
## original id under shared-id, exactly as it should. So any future CVXPY
## consumer port (e.g. a new canonicalizer) works verbatim WITHOUT first
## flipping the producers to fresh ids. Decouples consumer-ports from the
## deferred part-B producer flip. CVXR composes CONSTRAINT ids separately, via
## InverseData@cons_id_map (part A, see canonicalization.R) -- not a Chain method.
.compose_id_map <- function(step_maps) {
  result <- list()  ## orig-id (chr) -> chr vector of final ids
  for (step_map in step_maps) {
    ## Forward existing mappings through this step (1->many capable).
    if (length(result) > 0L) {
      result <- lapply(result, function(cur_ids) {
        unlist(lapply(cur_ids, function(cid) {
          nxt <- step_map[[cid]]
          if (is.null(nxt)) cid else as.character(nxt)
        }), use.names = FALSE)
      })
    }
    ## Add new mappings introduced by this reduction step.
    for (orig_id in setdiff(names(step_map), names(result))) {
      result[[orig_id]] <- as.character(step_map[[orig_id]])
    }
  }
  result
}

compose_var_id_map   <- new_generic("compose_var_id_map", "x",
                                    function(x) S7_dispatch())
compose_param_id_map <- new_generic("compose_param_id_map", "x",
                                    function(x) S7_dispatch())

method(compose_var_id_map, Chain) <- function(x) {
  .compose_id_map(lapply(x@reductions, var_id_map))
}
method(compose_param_id_map, Chain) <- function(x) {
  .compose_id_map(lapply(x@reductions, param_id_map))
}