R/224_reductions_dqcp2dcp_dqcp2dcp.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: reductions/dqcp2dcp/dqcp2dcp.py
## Dqcp2Dcp -- reduce DQCP problems to parameterized DCP for bisection

## -- Helper: separate constraints into lazy, real, filtering TRUE/FALSE --
## CVXPY SOURCE: dqcp2dcp.py _get_lazy_and_real_constraints()
## TRUE (redundant) constraints are dropped, FALSE (infeasible) constraints
## are replaced with an explicitly infeasible DCP constraint.
.dqcp_separate_constraints <- function(constraints) {
  n <- length(constraints)
  lazy_chunks <- vector("list", n)
  real_chunks <- vector("list", n)
  nl <- 0L; nr <- 0L
  for (i in seq_len(n)) {
    con <- constraints[[i]]
    if (identical(con, TRUE)) next  # redundant -- always satisfied
    if (identical(con, FALSE)) {
      ## Infeasible: add a contradiction constraint (1 <= 0)
      nr <- nr + 1L
      real_chunks[[nr]] <- list(Inequality(Constant(1), Constant(0)))
      next
    }
    if (is.function(con)) {
      nl <- nl + 1L
      lazy_chunks[[nl]] <- list(con)
    } else {
      nr <- nr + 1L
      real_chunks[[nr]] <- list(con)
    }
  }
  lazy <- unlist(lazy_chunks[seq_len(nl)], recursive = FALSE)
  real <- unlist(real_chunks[seq_len(nr)], recursive = FALSE)
  if (is.null(lazy)) lazy <- list()
  if (is.null(real)) real <- list()
  list(lazy = lazy, real = real)
}

# -- Dqcp2Dcp class -----------------------------------------------
## Inherits from Canonicalization but uses its own _canonicalize_constraint
## CVXPY SOURCE: dqcp2dcp.py class Dqcp2Dcp(Canonicalization)

Dqcp2Dcp <- new_class("Dqcp2Dcp", parent = Canonicalization, package = "CVXR",
  constructor = function() {
    new_object(S7_object(),
      .cache = new.env(parent = emptyenv())
    )
  }
)

## accepts: minimization DQCP problem
## CVXPY SOURCE: dqcp2dcp.py accepts()
method(reduction_accepts, Dqcp2Dcp) <- function(x, problem, ...) {
  S7_inherits(problem@objective, Minimize) && is_dqcp(problem)
}

## invert: map solution back to original variables
## CVXPY SOURCE: dqcp2dcp.py invert()
method(reduction_invert, Dqcp2Dcp) <- function(x, solution, inverse_data, ...) {
  pvars <- list()
  for (vid in names(inverse_data@id_map)) {
    if (vid %in% names(solution@primal_vars)) {
      pvars[[vid]] <- solution@primal_vars[[vid]]
    } else {
      pvars[[vid]] <- 0.0
    }
  }
  Solution(solution@status, solution@opt_val, pvars, list(), solution@attr)
}

## apply: the main DQCP reduction
## CVXPY SOURCE: dqcp2dcp.py apply()
method(reduction_apply, Dqcp2Dcp) <- function(x, problem, ...) {
  ## Canonicalize all constraints -- collect chunks, flatten once
  n_cons <- length(problem@constraints)
  constr_chunks <- vector("list", n_cons)
  for (i in seq_len(n_cons)) {
    constr_chunks[[i]] <- .dqcp_canonicalize_constraint(problem@constraints[[i]])
  }
  constraints <- unlist(constr_chunks, recursive = FALSE)
  if (is.null(constraints)) constraints <- list()

  ## Separate lazy (callable), real, and boolean (TRUE/FALSE) constraints
  ## CVXPY SOURCE: dqcp2dcp.py _get_lazy_and_real_constraints()
  ## TRUE = redundant (always satisfied), FALSE = infeasible
  sep1 <- .dqcp_separate_constraints(constraints)
  lazy <- sep1$lazy
  real <- sep1$real

  ## Build feasibility problem
  feas_problem <- Problem(Minimize(0), real)
  feas_problem@.cache$lazy_constraints <- lazy

  ## Create parameter t bounded by objective sign
  objective <- problem@objective@args[[1L]]
  if (is_nonneg(objective)) {
    t_param <- Parameter(nonneg = TRUE)
  } else if (is_nonpos(objective)) {
    t_param <- Parameter(nonpos = TRUE)
  } else {
    t_param <- Parameter()
  }

  ## Add objective <= t constraint
  obj_constr <- .dqcp_canonicalize_constraint(Inequality(objective, t_param))
  constraints <- c(constraints, obj_constr)

  ## Re-separate
  sep2 <- .dqcp_separate_constraints(constraints)
  lazy2 <- sep2$lazy
  real2 <- sep2$real

  ## Build parameterized problem
  param_problem <- Problem(Minimize(0), real2)
  param_problem@.cache$lazy_constraints <- lazy2

  ## Store bisection data
  tighten <- .tighten_fns(objective)
  param_problem@.cache$bisection_data <- list(
    feas_problem = feas_problem,
    param = t_param,
    tighten_lower = tighten$lower,
    tighten_upper = tighten$upper
  )

  list(param_problem, InverseData(problem))
}

## Helper: canonicalize a single DQCP constraint
## CVXPY SOURCE: dqcp2dcp.py _canonicalize_constraint()
.dqcp_canonicalize_constraint <- function(constr) {
  ## DCP constraints: standard canonicalization
  if (is_dcp(constr)) {
    result <- .canonicalize_tree(constr)
    canon_constr <- result[[1L]]
    aux_constr <- result[[2L]]
    return(c(list(canon_constr), aux_constr))
  }

  ## Must be Inequality for DQCP non-DCP constraints
  if (!S7_inherits(constr, Inequality)) {
    cli_abort("Non-DCP constraint must be {.cls Inequality} in DQCP.")
  }

  lhs <- constr@args[[1L]]
  rhs <- constr@args[[2L]]

  ## CVXPY SOURCE: dqcp2dcp.py lines 174-182
  ## Taking inverses can yield +/- infinity; handle here.
  ## lhs <= rhs: if lhs == -Inf or rhs == Inf, constraint is redundant (TRUE).
  ## If lhs == Inf or rhs == -Inf, constraint is infeasible (FALSE).
  lhs_val <- tryCatch(value(lhs), error = function(e) NULL)
  rhs_val <- tryCatch(value(rhs), error = function(e) NULL)
  if (!is.null(lhs_val) && is.numeric(lhs_val) &&
      all(is.infinite(lhs_val) & lhs_val < 0)) {
    return(list(TRUE))
  }
  if (!is.null(rhs_val) && is.numeric(rhs_val) &&
      all(is.infinite(rhs_val) & rhs_val > 0)) {
    return(list(TRUE))
  }
  if (!is.null(lhs_val) && is.numeric(lhs_val) &&
      any(is.infinite(lhs_val) & lhs_val > 0)) {
    return(list(FALSE))
  }
  if (!is.null(rhs_val) && is.numeric(rhs_val) &&
      any(is.infinite(rhs_val) & rhs_val < 0)) {
    return(list(FALSE))
  }

  ## Short-circuit zero-valued expressions
  if (is_zero(lhs)) {
    return(.dqcp_canonicalize_constraint(Inequality(Constant(0), rhs)))
  }
  if (is_zero(rhs)) {
    return(.dqcp_canonicalize_constraint(Inequality(lhs, Constant(0))))
  }

  ## Case 1: quasiconvex LHS (not convex), constant RHS
  if (is_quasiconvex(lhs) && !is_convex(lhs)) {
    if (.dqcp_invertible(lhs)) {
      rhs_new <- .dqcp_inverse(lhs)(rhs)
      idx <- .non_const_idx(lhs)[1L]
      expr <- lhs@args[[idx]]
      if (is_incr(lhs, idx)) {
        return(.dqcp_canonicalize_constraint(Inequality(expr, rhs_new)))
      }
      ## decreasing
      return(.dqcp_canonicalize_constraint(Inequality(rhs_new, expr)))
    } else if (S7_inherits(lhs, Maximum) || S7_inherits(lhs, MaxEntries)) {
      ## Lower: each arg <= rhs
      result <- list()
      for (arg in lhs@args) {
        result <- c(result, .dqcp_canonicalize_constraint(Inequality(arg, rhs)))
      }
      return(result)
    } else {
      ## Sublevel set
      canon_args <- .dqcp_canon_args(lhs)
      lhs_copy <- expr_copy(lhs, args = canon_args[[1L]])
      sublevel <- .dqcp_sublevel(lhs_copy, t = rhs)
      return(c(sublevel, canon_args[[2L]]))
    }
  }

  ## Case 2: constant LHS, quasiconcave RHS
  if (is_quasiconcave(rhs) && !is_concave(rhs)) {
    if (.dqcp_invertible(rhs)) {
      lhs_new <- .dqcp_inverse(rhs)(lhs)
      idx <- .non_const_idx(rhs)[1L]
      expr <- rhs@args[[idx]]
      if (is_incr(rhs, idx)) {
        return(.dqcp_canonicalize_constraint(Inequality(lhs_new, expr)))
      }
      return(.dqcp_canonicalize_constraint(Inequality(expr, lhs_new)))
    } else if (S7_inherits(rhs, Minimum) || S7_inherits(rhs, MinEntries)) {
      result <- list()
      for (arg in rhs@args) {
        result <- c(result, .dqcp_canonicalize_constraint(Inequality(lhs, arg)))
      }
      return(result)
    } else {
      canon_args <- .dqcp_canon_args(rhs)
      rhs_copy <- expr_copy(rhs, args = canon_args[[1L]])
      superlevel <- .dqcp_superlevel(rhs_copy, t = lhs)
      return(c(superlevel, canon_args[[2L]]))
    }
  }

  cli_abort("Cannot canonicalize constraint in DQCP context.")
}

## Helper: canonicalize args preserving sign attributes
## CVXPY SOURCE: dqcp2dcp.py _canon_args()
.dqcp_canon_args <- function(expr) {
  n_args <- length(expr@args)
  canon_args <- vector("list", n_args)
  constr_chunks <- vector("list", n_args)
  for (i in seq_len(n_args)) {
    result <- .dqcp_canonicalize_tree(expr@args[[i]])
    canon_arg <- result[[1L]]
    ## Preserve nonneg/nonpos attributes
    if (S7_inherits(canon_arg, Variable)) {
      if (is_nonneg(expr@args[[i]])) canon_arg@attributes[["nonneg"]] <- TRUE
      else if (is_nonpos(expr@args[[i]])) canon_arg@attributes[["nonpos"]] <- TRUE
    }
    canon_args[[i]] <- canon_arg
    constr_chunks[[i]] <- result[[2L]]
  }
  constrs <- unlist(constr_chunks, recursive = FALSE)
  if (is.null(constrs)) constrs <- list()
  list(canon_args, constrs)
}

## Helper: tree walk for DCP sub-expressions
## CVXPY SOURCE: dqcp2dcp.py _canonicalize_tree()
.dqcp_canonicalize_tree <- function(expr) {
  n_args <- length(expr@args)
  canon_args <- vector("list", n_args)
  constr_chunks <- vector("list", n_args + 1L)
  for (i in seq_len(n_args)) {
    result <- .dqcp_canonicalize_tree(expr@args[[i]])
    canon_args[[i]] <- result[[1L]]
    constr_chunks[[i]] <- result[[2L]]
  }
  node_result <- .canonicalize_expr(expr, canon_args)
  constr_chunks[[n_args + 1L]] <- node_result[[2L]]
  constrs <- unlist(constr_chunks, recursive = FALSE)
  if (is.null(constrs)) constrs <- list()
  list(node_result[[1L]], constrs)
}