R/244_reductions_solvers_conic_solvers_ecos_conif.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: reductions/solvers/conic_solvers/ecos_conif.py
## ECOS conic solver interface
##
## ECOS supports Zero, NonNeg, SOC, and ExpCone constraints.
## Uses non-standard ExpCone ordering: (x, z, y) instead of (x, y, z).
## Convention: min c^T x  s.t.  Ax = b,  h - Gx in K
##
## R interface: ECOSolveR::ECOS_csolve()


# -- dims_to_solver_dict_ecos --------------------------------------
## CVXPY SOURCE: ecos_conif.py lines 25-31
## Convert ConeDims to ECOS's expected format.

dims_to_solver_dict_ecos <- function(cone_dims) {
  list(
    l = as.integer(cone_dims@nonneg),
    q = as.integer(cone_dims@soc),
    e = as.integer(cone_dims@exp)
  )
}

# -- ECOS_Solver class ---------------------------------------------
## CVXPY SOURCE: ecos_conif.py lines 34-153

ECOS_Solver <- new_class("ECOS_Solver", parent = ConicSolver, package = "CVXR",
  constructor = function() {
    new_object(S7_object(),
      .cache = new.env(parent = emptyenv()),
      MIP_CAPABLE = FALSE,
      BOUNDED_VARIABLES = FALSE,
      SUPPORTED_CONSTRAINTS = list(Zero, NonNeg, SOC, ExpCone),
      EXP_CONE_ORDER = c(0L, 2L, 1L),
      REQUIRES_CONSTR = FALSE
    )
  }
)

method(solver_name, ECOS_Solver) <- function(x) ECOS_SOLVER

# -- ECOS solve_via_data -------------------------------------------
## CVXPY SOURCE: ecos_conif.py lines 105-127

method(solve_via_data, ECOS_Solver) <- function(x, data, warm_start = FALSE, verbose = FALSE,
                                                 solver_opts = list(), ...) {
  if (!requireNamespace("ECOSolveR", quietly = TRUE)) {
    cli_abort("Package {.pkg ECOSolveR} is required but not installed.")
  }

  cones <- dims_to_solver_dict_ecos(data[[SD_DIMS]])

  ## Split solver data into eq (Zero) and ineq parts
  ## data[[SD_A]] = -formatted_A, data[[SD_B]] = formatted_b
  ## Zero rows are first, then ineq rows.
  zero_dim <- data[[SD_DIMS]]@zero
  total_rows <- nrow(data[[SD_A]])

  ## Equality constraints: A_eq * x = b_eq
  if (zero_dim > 0L) {
    A_eq <- data[[SD_A]][seq_len(zero_dim), , drop = FALSE]
    b_eq <- data[[SD_B]][seq_len(zero_dim)]
    ## Check for nnz == 0 edge case (ECOS bug)
    if (methods::is(A_eq, "sparseMatrix") && length(A_eq@x) == 0L &&
        prod(dim(A_eq)) > 0L) {
      cli_abort(c(
        "ECOS cannot handle sparse data with nnz == 0.",
        "i" = "This may indicate redundant constraints in the problem."
      ))
    }
  } else {
    A_eq <- NULL
    b_eq <- numeric(0)
  }

  ## Inequality constraints: G * x <= h  (in cone K)
  if (zero_dim < total_rows) {
    G <- data[[SD_A]][(zero_dim + 1L):total_rows, , drop = FALSE]
    h <- data[[SD_B]][(zero_dim + 1L):total_rows]
  } else {
    G <- NULL
    h <- numeric(0)
  }

  ## Ensure sparse matrices are dgCMatrix for ECOSolveR
  if (!is.null(G) && !inherits(G, "dgCMatrix")) {
    G <- methods::as(G, "dgCMatrix")
  }
  if (!is.null(A_eq) && !inherits(A_eq, "dgCMatrix")) {
    A_eq <- methods::as(A_eq, "dgCMatrix")
  }

  ## Build control list
  ## ECOSolveR uses UPPERCASE control names (FEASTOL, ABSTOL, ...),
  ## but CVXPY convention is lowercase (feastol, abstol, ...).
  ctrl <- ECOSolveR::ecos.control()
  ctrl[["VERBOSE"]] <- as.integer(verbose)
  for (opt_name in names(solver_opts)) {
    ctrl[[toupper(opt_name)]] <- solver_opts[[opt_name]]
  }

  ## Call ECOS
  result <- ECOSolveR::ECOS_csolve(
    c       = data[[SD_C]],
    G       = G,
    h       = h,
    dims    = cones,
    A       = A_eq,
    b       = b_eq,
    control = ctrl
  )

  result
}

# -- ECOS reduction_invert ----------------------------------------
## CVXPY SOURCE: ecos_conif.py lines 129-153

method(reduction_invert, ECOS_Solver) <- function(x, solution, inverse_data, ...) {
  attr_list <- list()

  ## Extract status from exit flag
  exit_flag <- solution$retcodes[["exitFlag"]]
  if (is.null(exit_flag)) exit_flag <- solution$retcodes[[1L]]
  status <- ECOS_STATUS_MAP[[as.character(exit_flag)]]
  if (is.null(status)) status <- SOLVER_ERROR

  ## Timing attributes
  if (!is.null(solution$timing[["tsolve"]]))
    attr_list[[RK_SOLVE_TIME]] <- solution$timing[["tsolve"]]
  if (!is.null(solution$timing[["tsetup"]]))
    attr_list[[RK_SETUP_TIME]] <- solution$timing[["tsetup"]]
  iter_val <- solution$retcodes[["iter"]]
  if (!is.null(iter_val))
    attr_list[[RK_NUM_ITERS]] <- iter_val

  if (status %in% SOLUTION_PRESENT) {
    primal_val <- solution$summary[["pcost"]]
    opt_val <- primal_val + inverse_data[[SD_OFFSET]]

    primal_vars <- list()
    primal_vars[[as.character(inverse_data[[SOLVER_VAR_ID]])]] <- solution$x

    ## Inequality duals from z
    dual_vars <- get_dual_values(
      solution$z,
      extract_dual_value,
      inverse_data[[SOLVER_NEQ_CONSTR]]
    )

    ## Permute ExpCone duals back to standard (x, y, z) order
    for (con in inverse_data[[SOLVER_NEQ_CONSTR]]) {
      if (S7_inherits(con, ExpCone)) {
        cid <- as.character(con@id)
        n_cones <- num_cones(con)
        perm <- expcone_permutor(n_cones, c(0L, 2L, 1L))
        dual_vars[[cid]] <- dual_vars[[cid]][perm]
      }
    }

    ## Equality duals from y
    eq_duals <- get_dual_values(
      solution$y,
      extract_dual_value,
      inverse_data[[SOLVER_EQ_CONSTR]]
    )
    dual_vars <- c(dual_vars, eq_duals)

    Solution(status, opt_val, primal_vars, dual_vars, attr_list)
  } else {
    failure_solution(status, attr_list)
  }
}

# -- print ---------------------------------------------------------

method(print, ECOS_Solver) <- function(x, ...) {
  cat("ECOS_Solver()\n")
  invisible(x)
}