R/246_reductions_solvers_nlp_solvers_diff_engine_c_problem.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/reductions/solvers/nlp_solvers/diff_engine/c_problem.R
#####

## CVXPY SOURCE: reductions/solvers/nlp_solvers/diff_engine/c_problem.py
## C_problem: wraps a sparsediff problem handle built from a CVXR Problem,
## exposing the value/gradient/Jacobian/Hessian oracle. Returned as an
## environment (reference semantics, like the Python object) with the handle
## and method closures.

## Constraint expression g(x), mirroring CVXPY's Constraint.expr: single-arg
## constraints (Zero/NonPos) -> the arg; two-arg (Equality/Inequality) -> the
## difference lhs - rhs. The NLP solve path lowers to Zero/NonPos (single arg),
## but this keeps the adapter robust to raw constraints too.
.de_constr_expr <- function(con) {
  if (length(con@args) == 1L) con@args[[1L]] else con@args[[1L]] - con@args[[2L]]
}

.de_C_problem <- function(problem, verbose = FALSE) {
  inverse_data <- InverseData(problem)
  vd <- .de_build_var_dict(inverse_data)
  pd <- .de_build_param_dict(problem, inverse_data)
  ctx <- list(var_dict = vd$var_dict, n_vars = vd$n_vars, param_dict = pd$param_dict)

  ## objective expression is the objective's single argument
  c_obj <- .de_convert_expr(problem@objective@args[[1L]], ctx)
  ## each constraint contributes its expression g(x)
  c_cons <- lapply(problem@constraints, function(con) .de_convert_expr(.de_constr_expr(con), ctx))

  prob <- sparsediff::sd_problem(c_obj, c_cons, verbose)

  ## Register parameters in problem-parameter order so theta lines up.
  params <- parameters(problem)
  if (length(params) > 0L) {
    handles <- lapply(params, function(p) {
      pid <- as.character(p@id)
      if (exists(pid, envir = pd$param_dict, inherits = FALSE)) {
        get(pid, envir = pd$param_dict, inherits = FALSE)
      } else NULL
    })
    keep <- !vapply(handles, is.null, logical(1L))
    if (any(keep)) {
      sparsediff::sd_register_params(prob, handles[keep])
      theta <- unlist(lapply(params[keep],
                             function(p) as.numeric(.de_to_dense(value(p)))))
      sparsediff::sd_update_params(prob, theta)
    }
  }

  ## Initialize the value/gradient machinery (forward + reverse).
  sparsediff::sd_init_derivatives(prob)

  cp <- new.env(parent = emptyenv())
  cp$prob         <- prob
  cp$inverse_data <- inverse_data
  cp$n_vars       <- vd$n_vars

  ## --- oracle methods (mirror C_problem) ---
  cp$update_params <- function(theta) sparsediff::sd_update_params(prob, theta)
  ## Fill COO sparsity once before querying sparsity / values.
  cp$init_jacobian_coo <- function() sparsediff::sd_init_jacobian_coo(prob)
  cp$init_hessian_coo_lower_tri <- function() sparsediff::sd_init_hessian_coo(prob)
  cp$objective_forward <- function(u) sparsediff::sd_objective_forward(prob, u)
  cp$constraint_forward <- function(u) sparsediff::sd_constraint_forward(prob, u)
  cp$gradient <- function() sparsediff::sd_gradient(prob)
  cp$jacobian_sparsity <- function() sparsediff::sd_jacobian_sparsity(prob)
  cp$jacobian_values <- function() sparsediff::sd_jacobian_values(prob)
  cp$hessian_sparsity <- function() sparsediff::sd_hessian_sparsity(prob)
  ## obj_factor * hess_f + sum_i lagrange[i] * hess_gi  (lower triangle).
  cp$hessian_values <- function(obj_factor, lagrange) {
    sparsediff::sd_hessian_values(prob, obj_factor, lagrange)
  }
  cp
}