R/052_atoms_affine_conv.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/affine/conv.py
## Convolve -- 1D discrete convolution (one arg must be constant)


Convolve <- new_class("Convolve", 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 conv} must be constant.")
    }
    ## Both must be vectors (n, 1)
    if (a@shape[2L] != 1L || b@shape[2L] != 1L) {
      cli_abort("{.fn conv} requires vector inputs (column vectors).")
    }
    ## Output length = len(a) + len(b) - 1
    out_len <- a@shape[1L] + b@shape[1L] - 1L
    shape <- c(out_len, 1L)

    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, Convolve) <- function(x) {
  c(x@args[[1L]]@shape[1L] + x@args[[2L]]@shape[1L] - 1L, 1L)
}

# -- sign: same as multiplication (CVXPY conv.py lines 100-103) ---
method(sign_from_args, Convolve) <- function(x) {
  mul_sign(x@args[[1L]], x@args[[2L]])
}

# -- monotonicity (CVXPY conv.py lines 105-113) ------------------
method(is_incr, Convolve) <- function(x, idx, ...) {
  is_nonneg(x@args[[1L]])
}
method(is_decr, Convolve) <- function(x, idx, ...) {
  is_nonpos(x@args[[1L]])
}

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

method(numeric_value, Convolve) <- function(x, values, ...) {
  a <- as.vector(values[[1L]])
  b <- as.vector(values[[2L]])
  ## R's convolve() uses Conj(FFT(y)), which gives cross-correlation
  ## instead of polynomial multiplication for complex inputs. Use FFT
  ## without conjugation for complex, R's convolve for real.
  if (is.complex(a) || is.complex(b)) {
    n <- length(a) + length(b) - 1L
    fa <- fft(c(a, rep(0+0i, n - length(a))))
    fb <- fft(c(b, rep(0+0i, n - length(b))))
    result <- fft(fa * fb, inverse = TRUE) / n
    ## Clean up near-zero imaginary parts if both inputs were real-ish
    matrix(result, ncol = 1L)
  } else {
    matrix(convolve(a, rev(b), type = "open"), ncol = 1L)
  }
}

# -- DPP: conv is NOT DPP when the kernel arg is parametric ------
## Same as Kron -- C++ get_conv_mat uses get_constant_data and cannot
## handle PARAM LinOp nodes. Return FALSE when the kernel has parameters.
method(is_dpp, Convolve) <- function(x) {
  cst_idx <- if (is_constant(x@args[[1L]])) 1L else 2L
  if (length(parameters(x@args[[cst_idx]])) > 0L) return(FALSE)
  with_dpp_scope(is_dcp(x))
}

method(graph_implementation, Convolve) <- function(x, arg_objs, shape, data = NULL, ...) {
  if (is_constant(x@args[[1L]])) {
    list(conv_linop(arg_objs[[1L]], arg_objs[[2L]], shape), list())
  } else {
    list(conv_linop(arg_objs[[2L]], arg_objs[[1L]], shape), list())
  }
}

#' 1D discrete convolution
#'
#' @param a An Expression (vector, one must be constant)
#' @param b An Expression (vector)
#' @returns A Convolve atom
#' @export
conv <- function(a, b) {
  Convolve(a, b)
}