#' Arithmetic operations #' #' This generic provides a common double dispatch mechanism for all infix #' operators (`+`, `-`, `/`, `*`, `^`, `%%`, `%/%`, `!`, `&`, `|`). It is used #' to power the default arithmetic and boolean operators for [vctr]s objects, #' overcoming the limitations of the base [Ops] generic. #' #' `vec_arith_base()` is provided as a convenience for writing methods. It #' recycles `x` and `y` to common length then calls the base operator with the #' underlying [vec_data()]. #' #' `vec_arith()` is also used in `diff.vctrs_vctr()` method via `-`. #' #' @param op An arithmetic operator as a string #' @param x,y A pair of vectors. For `!`, unary `+` and unary `-`, `y` will be #' a sentinel object of class `MISSING`, as created by `MISSING()`. #' @inheritParams rlang::args_dots_empty #' #' @seealso [stop_incompatible_op()] for signalling that an arithmetic #' operation is not permitted/supported. #' @seealso See [vec_math()] for the equivalent for the unary mathematical #' functions. #' @export #' @keywords internal #' @examples #' d <- as.Date("2018-01-01") #' dt <- as.POSIXct("2018-01-02 12:00") #' t <- as.difftime(12, unit = "hours") #' #' vec_arith("-", dt, 1) #' vec_arith("-", dt, t) #' vec_arith("-", dt, d) #' #' vec_arith("+", dt, 86400) #' vec_arith("+", dt, t) #' vec_arith("+", t, t) #' #' vec_arith("/", t, t) #' vec_arith("/", t, 2) #' #' vec_arith("*", t, 2) vec_arith <- function(op, x, y, ...) { check_dots_empty0(...) UseMethod("vec_arith", x) } #' @export #' @rdname vec_arith vec_arith.default <- function(op, x, y, ...) { stop_incompatible_op(op, x, y) } # Atomic vectors ---------------------------------------------------------- #' @rdname vec_arith #' @export vec_arith.logical #' @method vec_arith logical #' @export vec_arith.logical <- function(op, x, y, ...) UseMethod("vec_arith.logical", y) #' @method vec_arith.logical default #' @export vec_arith.logical.default <- function(op, x, y, ...) { stop_incompatible_op(op, x, y) } #' @method vec_arith.logical logical #' @export vec_arith.logical.logical <- function(op, x, y, ...) vec_arith_base(op, x, y) #' @method vec_arith.logical numeric #' @export vec_arith.logical.numeric <- function(op, x, y, ...) vec_arith_base(op, x, y) #' @rdname vec_arith #' @export vec_arith.numeric #' @method vec_arith numeric #' @export vec_arith.numeric <- function(op, x, y, ...) UseMethod("vec_arith.numeric", y) #' @method vec_arith.numeric default #' @export vec_arith.numeric.default <- function(op, x, y, ...) { stop_incompatible_op(op, x, y) } #' @method vec_arith.numeric logical #' @export vec_arith.numeric.logical <- function(op, x, y, ...) vec_arith_base(op, x, y) #' @method vec_arith.numeric numeric #' @export vec_arith.numeric.numeric <- function(op, x, y, ...) vec_arith_base(op, x, y) # Helpers ----------------------------------------------------------------- #' @export #' @rdname vec_arith vec_arith_base <- function(op, x, y) { args <- vec_recycle_common(x, y) op_fn <- getExportedValue("base", op) op_fn(vec_data(args[[1L]]), vec_data(args[[2L]])) } #' @export #' @rdname vec_arith MISSING <- function() { structure(list(), class = "MISSING") }