R/077_atoms_elementwise_logic.R

In CVXR: Disciplined Convex Optimization

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

## CVXPY SOURCE: atoms/elementwise/logic.py
## Boolean logic atoms: Not, And, Or, Xor + implies/iff convenience functions


# -- Helper: check if argument is valid boolean logic input --------
.is_boolean_arg <- function(arg) {
  if (S7_inherits(arg, LogicExpression)) return(TRUE)
  if (S7_inherits(arg, Leaf) && isTRUE(arg@attributes$boolean)) return(TRUE)
  if (S7_inherits(arg, Constant)) {
    v <- value(arg)
    return(all(v == 0L | v == 1L))
  }
  FALSE
}

# ===================================================================
# LogicExpression -- abstract base class for boolean logic atoms
# ===================================================================

LogicExpression <- new_class("LogicExpression", parent = Elementwise,
  package = "CVXR",
  constructor = function(args, id = NULL) {
    if (is.null(id)) id <- next_expr_id()
    args <- lapply(args, as_expr)
    if (length(args) == 0L)
      cli_abort("No arguments given to {.cls LogicExpression}.")
    shape <- sum_shapes(lapply(args, function(a) a@shape))
    obj <- new_object(S7_object(),
      id     = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args   = args,
      shape  = shape
    )
    validate_arguments(obj)
    obj
  }
)

# -- validate_arguments --------------------------------------------
method(validate_arguments, LogicExpression) <- function(x) {
  ## Check broadcastable shapes (parent Elementwise validation)
  sum_shapes(lapply(x@args, function(a) a@shape))
  ## Check all args are boolean

  for (arg in x@args) {
    if (!.is_boolean_arg(arg)) {
      cli_abort(
        "All arguments to {.cls {class(x)[[1L]]}} must be boolean variables or LogicExpression instances."
      )
    }
  }
  invisible(NULL)
}

# -- sign: result is boolean (0 or 1), so nonneg ------------------
method(sign_from_args, LogicExpression) <- function(x) {
  list(is_nonneg = TRUE, is_nonpos = FALSE)
}

# -- curvature: both convex and concave (affine-like for DCP) -----
method(is_atom_convex, LogicExpression) <- function(x) TRUE
method(is_atom_concave, LogicExpression) <- function(x) TRUE

# -- monotonicity: default FALSE ----------------------------------
method(is_incr, LogicExpression) <- function(x, idx, ...) FALSE
method(is_decr, LogicExpression) <- function(x, idx, ...) FALSE

# ===================================================================
# Not -- logical NOT of a boolean expression
# ===================================================================

#' Logical NOT
#'
#' Returns `1 - x`, flipping 0 to 1 and 1 to 0.
#' Can also be written with the `!` operator: `!x`.
#'
#' @param x A boolean \link{Variable} or logic expression.
#' @param id Optional integer ID (internal use).
#' @returns A \code{Not} expression.
#' @seealso [And()], [Or()], [Xor()], [implies()], [iff()]
#' @examples
#' \dontrun{
#' x <- Variable(boolean = TRUE)
#' not_x <- !x          # operator syntax
#' not_x <- Not(x)      # functional syntax
#' }
#' @export
Not <- new_class("Not", parent = LogicExpression, package = "CVXR",
  constructor = function(x, id = NULL) {
    if (is.null(id)) id <- next_expr_id()
    x <- as_expr(x)
    shape <- x@shape
    obj <- new_object(S7_object(),
      id     = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args   = list(x),
      shape  = shape
    )
    validate_arguments(obj)
    obj
  }
)

# -- validate: exactly 1 arg --------------------------------------
method(validate_arguments, Not) <- function(x) {
  if (length(x@args) != 1L)
    cli_abort("{.cls Not} takes exactly 1 argument.")
  ## Parent validation (boolean check)
  for (arg in x@args) {
    if (!.is_boolean_arg(arg))
      cli_abort(
        "All arguments to {.cls Not} must be boolean variables or LogicExpression instances."
      )
  }
  invisible(NULL)
}

# -- monotonicity: decreasing (flips sign) ------------------------
method(is_decr, Not) <- function(x, idx, ...) TRUE

# -- numeric ------------------------------------------------------
method(numeric_value, Not) <- function(x, values, ...) {
  1 - values[[1L]]
}

# -- name ---------------------------------------------------------
method(expr_name, Not) <- function(x) {
  child <- x@args[[1L]]
  child_name <- expr_name(child)
  if (S7_inherits(child, NaryLogicExpression)) {
    paste0("!(", child_name, ")")
  } else {
    paste0("!", child_name)
  }
}

# ===================================================================
# NaryLogicExpression -- shared base for n-ary logic atoms
# ===================================================================

NaryLogicExpression <- new_class("NaryLogicExpression",
  parent = LogicExpression, package = "CVXR",
  constructor = function(args, id = NULL) {
    if (length(args) < 2L)
      cli_abort("N-ary logic expressions require at least 2 arguments.")
    if (is.null(id)) id <- next_expr_id()
    args <- lapply(args, as_expr)
    shape <- sum_shapes(lapply(args, function(a) a@shape))
    obj <- new_object(S7_object(),
      id     = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args   = args,
      shape  = shape
    )
    validate_arguments(obj)
    obj
  }
)

# -- validate: at least 2 args ------------------------------------
method(validate_arguments, NaryLogicExpression) <- function(x) {
  if (length(x@args) < 2L)
    cli_abort("N-ary logic expressions require at least 2 arguments.")
  ## Parent validation (boolean check)
  for (arg in x@args) {
    if (!.is_boolean_arg(arg))
      cli_abort(
        "All arguments to {.cls {class(x)[[1L]]}} must be boolean variables or LogicExpression instances."
      )
  }
  invisible(NULL)
}

# ===================================================================
# And -- logical AND of boolean expressions
# ===================================================================

#' Logical AND
#'
#' Returns 1 if and only if all arguments equal 1, and 0 otherwise.
#' For two operands, can also be written with the `&` operator: `x & y`.
#'
#' @param ... Two or more boolean \link{Variable}s or logic expressions.
#' @param id Optional integer ID (internal use).
#' @returns An \code{And} expression.
#' @seealso [Not()], [Or()], [Xor()], [implies()], [iff()]
#' @examples
#' \dontrun{
#' x <- Variable(boolean = TRUE)
#' y <- Variable(boolean = TRUE)
#' both <- x & y            # operator syntax
#' both <- And(x, y)        # functional syntax
#' all3 <- And(x, y, z)     # n-ary
#' }
#' @export
And <- new_class("And", parent = NaryLogicExpression, package = "CVXR",
  constructor = function(..., id = NULL) {
    args <- list(...)
    if (length(args) < 2L)
      cli_abort("{.cls And} requires at least 2 arguments.")
    if (is.null(id)) id <- next_expr_id()
    args <- lapply(args, as_expr)
    shape <- sum_shapes(lapply(args, function(a) a@shape))
    obj <- new_object(S7_object(),
      id     = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args   = args,
      shape  = shape
    )
    validate_arguments(obj)
    obj
  }
)

# -- monotonicity: increasing -------------------------------------
method(is_incr, And) <- function(x, idx, ...) TRUE

# -- numeric ------------------------------------------------------
method(numeric_value, And) <- function(x, values, ...) {
  Reduce(pmin, values)
}

# -- name ---------------------------------------------------------
method(expr_name, And) <- function(x) {
  parts <- vapply(x@args, function(a) {
    nm <- expr_name(a)
    if (S7_inherits(a, LogicExpression) &&
        (S7_inherits(a, Or) || S7_inherits(a, Xor))) {
      paste0("(", nm, ")")
    } else {
      nm
    }
  }, character(1))
  paste(parts, collapse = " & ")
}

# ===================================================================
# Or -- logical OR of boolean expressions
# ===================================================================

#' Logical OR
#'
#' Returns 1 if and only if at least one argument equals 1, and 0 otherwise.
#' For two operands, can also be written with the `|` operator: `x | y`.
#'
#' @param ... Two or more boolean \link{Variable}s or logic expressions.
#' @param id Optional integer ID (internal use).
#' @returns An \code{Or} expression.
#' @seealso [Not()], [And()], [Xor()], [implies()], [iff()]
#' @examples
#' \dontrun{
#' x <- Variable(boolean = TRUE)
#' y <- Variable(boolean = TRUE)
#' either <- x | y          # operator syntax
#' either <- Or(x, y)       # functional syntax
#' any3 <- Or(x, y, z)      # n-ary
#' }
#' @export
Or <- new_class("Or", parent = NaryLogicExpression, package = "CVXR",
  constructor = function(..., id = NULL) {
    args <- list(...)
    if (length(args) < 2L)
      cli_abort("{.cls Or} requires at least 2 arguments.")
    if (is.null(id)) id <- next_expr_id()
    args <- lapply(args, as_expr)
    shape <- sum_shapes(lapply(args, function(a) a@shape))
    obj <- new_object(S7_object(),
      id     = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args   = args,
      shape  = shape
    )
    validate_arguments(obj)
    obj
  }
)

# -- monotonicity: increasing -------------------------------------
method(is_incr, Or) <- function(x, idx, ...) TRUE

# -- numeric ------------------------------------------------------
method(numeric_value, Or) <- function(x, values, ...) {
  Reduce(pmax, values)
}

# -- name ---------------------------------------------------------
method(expr_name, Or) <- function(x) {
  ## Or has lowest precedence; no children need parens
  parts <- vapply(x@args, expr_name, character(1))
  paste(parts, collapse = " | ")
}

# ===================================================================
# Xor -- logical XOR of boolean expressions
# ===================================================================

#' Logical XOR
#'
#' For two arguments: result is 1 iff exactly one is 1.
#' For n arguments: result is 1 iff an odd number are 1 (parity).
#'
#' Note: R's `^` operator is used for [power()], so `Xor` is functional syntax only.
#'
#' @param ... Two or more boolean \link{Variable}s or logic expressions.
#' @param id Optional integer ID (internal use).
#' @returns A \code{Xor} expression.
#' @seealso [Not()], [And()], [Or()], [implies()], [iff()]
#' @examples
#' \dontrun{
#' x <- Variable(boolean = TRUE)
#' y <- Variable(boolean = TRUE)
#' exclusive <- Xor(x, y)
#' }
#' @export
Xor <- new_class("Xor", parent = NaryLogicExpression, package = "CVXR",
  constructor = function(..., id = NULL) {
    args <- list(...)
    if (length(args) < 2L)
      cli_abort("{.cls Xor} requires at least 2 arguments.")
    if (is.null(id)) id <- next_expr_id()
    args <- lapply(args, as_expr)
    shape <- sum_shapes(lapply(args, function(a) a@shape))
    obj <- new_object(S7_object(),
      id     = as.integer(id),
      .cache = new.env(parent = emptyenv()),
      args   = args,
      shape  = shape
    )
    validate_arguments(obj)
    obj
  }
)

# -- numeric ------------------------------------------------------
method(numeric_value, Xor) <- function(x, values, ...) {
  Reduce(function(a, b) (a + b) %% 2, values)
}

# -- name ---------------------------------------------------------
method(expr_name, Xor) <- function(x) {
  parts <- vapply(x@args, function(a) {
    nm <- expr_name(a)
    ## Or has lower precedence than ^, so parenthesize it
    if (S7_inherits(a, Or)) {
      paste0("(", nm, ")")
    } else {
      nm
    }
  }, character(1))
  paste(parts, collapse = " XOR ")
}

# ===================================================================
# Convenience functions
# ===================================================================

#' Logical Implication
#'
#' Logical implication: x => y.
#' Returns 1 unless x = 1 and y = 0. Equivalent to `Or(Not(x), y)`.
#'
#' @param x,y Boolean \link{Variable}s or logic expressions.
#' @returns An \link{Or} expression representing \code{!x | y}.
#' @seealso [iff()], [Not()], [And()], [Or()], [Xor()]
#' @examples
#' \dontrun{
#' x <- Variable(boolean = TRUE)
#' y <- Variable(boolean = TRUE)
#' expr <- implies(x, y)
#' }
#' @export
implies <- function(x, y) {
  Or(Not(x), y)
}

#' Logical Biconditional
#'
#' Logical biconditional: x <=> y.
#' Returns 1 if and only if x and y have the same value.
#' Equivalent to `Not(Xor(x, y))`.
#'
#' @param x,y Boolean \link{Variable}s or logic expressions.
#' @returns A \link{Not} expression wrapping \link{Xor}.
#' @seealso [implies()], [Not()], [And()], [Or()], [Xor()]
#' @examples
#' \dontrun{
#' x <- Variable(boolean = TRUE)
#' y <- Variable(boolean = TRUE)
#' expr <- iff(x, y)
#' }
#' @export
iff <- function(x, y) {
  Not(Xor(x, y))
}