R/050_atoms_affine_kron.R

In CVXR: Disciplined Convex Optimization

#####
## DO NOT EDIT THIS FILE!! EDIT THE SOURCE INSTEAD: rsrc_tree/atoms/affine/kron.R
#####

## CVXPY SOURCE: atoms/affine/kron.py
## Kron -- Kronecker product (one arg must be constant)


Kron <- new_class("Kron", parent = AffAtom, package = "CVXR",
  constructor = function(a, b, id = NULL) {
    if (is.null(id)) id <- next_expr_id()
    a <- as_expr(a)
    b <- as_expr(b)
    ## At least one must be constant
    if (!is_constant(a) && !is_constant(b)) {
      cli_abort("At least one argument to {.fn kron} must be constant.")
    }
    shape <- c(a@shape[1L] * b@shape[1L], a@shape[2L] * b@shape[2L])

    obj <- new_object(S7_object(),
      id    = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args  = list(a, b),
      shape = shape
    )
    obj
  }
)

method(shape_from_args, Kron) <- function(x) {
  a <- x@args[[1L]]; b <- x@args[[2L]]
  c(a@shape[1L] * b@shape[1L], a@shape[2L] * b@shape[2L])
}

# -- sign: same as multiplication (CVXPY kron.py line 72-75) ------
method(sign_from_args, Kron) <- function(x) {
  mul_sign(x@args[[1L]], x@args[[2L]])
}

# -- monotonicity (CVXPY kron.py lines 77-87) --------------------
method(is_incr, Kron) <- function(x, idx, ...) {
  cst_loc <- if (is_constant(x@args[[1L]])) 1L else 2L
  is_nonneg(x@args[[cst_loc]])
}
method(is_decr, Kron) <- function(x, idx, ...) {
  cst_loc <- if (is_constant(x@args[[1L]])) 1L else 2L
  is_nonpos(x@args[[cst_loc]])
}

# -- log-log: affine (CVXPY kron.py) -----------------------------
method(is_atom_log_log_convex, Kron) <- function(x) TRUE
method(is_atom_log_log_concave, Kron) <- function(x) TRUE

method(numeric_value, Kron) <- function(x, values, ...) {
  kronecker(values[[1L]], values[[2L]])
}

# -- DPP: kron is NOT DPP when the "data" arg is parametric ------
## The C++ get_kron_mat/get_kron_l_mat handlers use get_constant_data()
## and cannot handle PARAM LinOp nodes. CVXPY has the same limitation
## (see comment in get_kronr_mat: "doesn't properly canonicalize ...
## Parameters"). Return FALSE when the constant arg has parameters.
method(is_dpp, Kron) <- function(x) {
  cst_idx <- if (is_constant(x@args[[1L]])) 1L else 2L
  cst_arg <- x@args[[cst_idx]]
  if (length(parameters(cst_arg)) > 0L) return(FALSE)
  ## Fall back to default DPP check for the non-constant arg
  with_dpp_scope(is_dcp(x))
}

method(graph_implementation, Kron) <- function(x, arg_objs, shape, data = NULL, ...) {
  ## Determine which arg is constant
  if (is_constant(x@args[[1L]])) {
    list(kron_r_linop(arg_objs[[1L]], arg_objs[[2L]], shape), list())
  } else {
    list(kron_l_linop(arg_objs[[1L]], arg_objs[[2L]], shape), list())
  }
}

#' Kronecker product of two expressions
#'
#' @param a An Expression (one must be constant)
#' @param b An Expression
#' @returns A Kron atom
#' @export
kron <- function(a, b) {
  Kron(a, b)
}