R/181_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()) {
    new_object(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)
}