R/172_reductions_dcp2cone_canonicalizers_perspective_canon.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: reductions/dcp2cone/canonicalizers/perspective_canon.py
## perspective_canon -- reduce perspective atom to cone constraints
##
## Algorithm:
## 1. Build auxiliary problem: Minimize(f) or Maximize(f)
## 2. Build canonicalization chain (without solver)
## 3. Apply chain to get cone representation: A, b, q, d
## 4. Build perspective constraints: A*x_canon + s*b in K
## 5. Linear constraint: -q'*x_canon + t - s*d >= 0
## 6. Recover original variables via equality constraints


## CVXPY SOURCE: perspective_canon.py lines 27-94
perspective_canon <- function(expr, args) {
  f <- expr@.f
  is_convex_f <- is_convex(f)
  s <- args[[1L]]  # the scaling variable

  ## 1. Build auxiliary problem
  aux_obj <- if (is_convex_f) Minimize(f) else Maximize(f)
  aux_prob <- Problem(aux_obj)

  ## 2. Build chain: [EvalParams] + [FlipObjective] + Dcp2Cone + CvxAttr2Constr + ConeMatrixStuffing
  ## Match CVXPY: solver_opts={"use_quad_obj": False}, ignore_dpp=True
  reductions <- list()
  if (length(parameters(aux_prob)) > 0L) {
    reductions <- c(reductions, list(EvalParams()))
  }
  if (S7_inherits(aux_prob@objective, Maximize)) {
    reductions <- c(reductions, list(FlipObjective()))
  }
  reductions <- c(reductions, list(
    Dcp2Cone(quad_obj = FALSE),
    CvxAttr2Constr(),
    ConeMatrixStuffing(quad_obj = FALSE)
  ))
  chain <- Chain(reductions = reductions)

  ## 3. Apply chain
  result <- reduction_apply(chain, aux_prob)
  data <- result[[1L]]
  inverse_data_list <- result[[2L]]

  ## 4. Extract cone form
  q <- data[[SD_C]]                       # objective vector (x_length)
  d <- data[[SD_OFFSET]]                  # objective constant (scalar)
  A_mat <- data[[SD_A]]                   # constraint matrix (m x x_length)
  b_vec <- as.numeric(data[[SD_B]])       # constraint RHS (m)
  ordered_cons <- data[["constraints"]]   # ordered constraint objects
  x_length <- length(q)

  ## 5. Create new variables
  t_var <- Variable()                         # epigraph variable (scalar)
  x_canon <- Variable(c(x_length, 1L))       # flattened canonical variable

  ## 6. Build perspective constraints: A_slice %*% x_canon + s * b_slice in K
  ## Collect all constraints in chunks, flatten once at the end
  n_ordered <- length(ordered_cons)
  f_vars <- variables(f)
  ## Max chunks: n_ordered (cone) + 1 (linear) + length(f_vars) (variable recovery)
  constr_chunks <- vector("list", n_ordered + 1L + length(f_vars))
  chunk_idx <- 0L

  if (nrow(A_mat) > 0L) {
    row_i <- 1L
    for (ci in seq_len(n_ordered)) {
      con <- ordered_cons[[ci]]
      sz <- constr_size(con)
      ## Extract rows for this constraint
      A_slice <- A_mat[row_i:(row_i + sz - 1L), , drop = FALSE]
      b_slice <- b_vec[row_i:(row_i + sz - 1L)]
      ## z = A_slice %*% x_canon + s * b_slice
      ## Wrap sparse A_slice as Constant so S7 %*% dispatch works
      z <- Constant(A_slice) %*% x_canon + s * b_slice
      chunk_idx <- chunk_idx + 1L
      constr_chunks[[chunk_idx]] <- list(.form_cone_constraint(z, con))
      row_i <- row_i + sz
    }
  }

  ## 7. Linear constraint: -q' * x_canon + t - s * d >= 0
  q_row <- matrix(q, nrow = 1L)
  lin_constr <- (-(q_row %*% x_canon) + t_var - s * d >= 0)
  chunk_idx <- chunk_idx + 1L
  constr_chunks[[chunk_idx]] <- list(lin_constr)

  ## 8. Recover original variables
  ## Get var_id_to_col from ConeMatrixStuffing's inverse_data (last in list)
  cms_inv <- inverse_data_list[[length(inverse_data_list)]]
  var_offsets <- cms_inv@var_offsets

  ## Sort offsets to find end positions
  offsets_sorted <- sort(as.integer(unlist(var_offsets)))
  end_positions <- c(offsets_sorted[-1L], x_length)

  for (var in f_vars) {
    vid <- as.character(var@id)
    if (!is.null(var_offsets[[vid]])) {
      start_offset <- as.integer(var_offsets[[vid]])
      idx_in_sorted <- which(offsets_sorted == start_offset)
      end_offset <- end_positions[idx_in_sorted]

      start_idx <- start_offset + 1L  # R 1-based
      end_idx <- end_offset

      chunk_idx <- chunk_idx + 1L
      if (isTRUE(var@attributes$diag)) {
        ## Diagonal variable: diag(var) == x_canon slice
        constr_chunks[[chunk_idx]] <- list(
          DiagMat(var) == x_canon[start_idx:end_idx]
        )
      } else if (isTRUE(var@attributes$symmetric) && expr_size(var) > 1L) {
        ## Symmetric variable: upper triangle
        n <- var@shape[1L]
        inds <- which(upper.tri(matrix(0L, n, n), diag = TRUE))
        constr_chunks[[chunk_idx]] <- list(
          var[inds] == x_canon[start_idx:end_idx]
        )
      } else {
        ## General case: vectorize (column-major)
        var_vec <- Reshape(var, c(expr_size(var), 1L))
        constr_chunks[[chunk_idx]] <- list(
          var_vec == x_canon[start_idx:end_idx]
        )
      }
    }
  }

  new_constraints <- unlist(constr_chunks[seq_len(chunk_idx)], recursive = FALSE)
  if (is.null(new_constraints)) new_constraints <- list()

  ## 9. Return canonicalized expression and constraints
  canon_expr <- if (is_convex_f) t_var else -t_var
  list(canon_expr, new_constraints)
}

## Register S7 method dispatch
method(dcp_canonicalize, Perspective) <- perspective_canon
method(has_dcp_canon, Perspective) <- function(expr) TRUE