diff --git a/NAMESPACE b/NAMESPACE
index df6778dd2..e7f76ca53 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -569,6 +569,8 @@ export(vec_math_base)
export(vec_names)
export(vec_names2)
export(vec_order)
+export(vec_pall)
+export(vec_pany)
export(vec_proxy)
export(vec_proxy_compare)
export(vec_proxy_equal)
diff --git a/NEWS.md b/NEWS.md
index aa83bc011..9880135d4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,9 @@
# vctrs (development version)
+* New `vec_pany()` and `vec_pall()` parallel variants of `any()` and `all()`
+ (in the same way that `pmin()` and `pmax()` are parallel variants of `min()`
+ and `max()`) (#1675).
+
* `vec_c(outer = c(inner = 1))` now produces correct error messages (#522).
* If a data frame is returned as the proxy from `vec_proxy_equal()`,
diff --git a/R/parallel.R b/R/parallel.R
new file mode 100644
index 000000000..cd351db81
--- /dev/null
+++ b/R/parallel.R
@@ -0,0 +1,57 @@
+#' Parallel `any()` and `all()`
+#'
+#' @description
+#' These functions are variants of [any()] and [all()] that work in parallel on
+#' multiple inputs at once. They work similarly to how [pmin()] and [pmax()] are
+#' parallel variants of [min()] and [max()].
+#'
+#' @details
+#' `vec_pany()` and `vec_pall()` are consistent with [any()] and [all()] when
+#' there are no inputs to process in parallel:
+#'
+#' - `any()` returns `FALSE` with no inputs. Similarly, `vec_pany(.size = 1)`
+#' and `vec_pany(NA, .na_rm = TRUE)` both return `FALSE`.
+#'
+#' - `all()` returns `TRUE` with no inputs. Similarly, `vec_pall(.size = 1)`
+#' and `vec_pall(NA, .na_rm = TRUE)` both return `TRUE`.
+#'
+#' @param ... Logical vectors. These will be [recycled][vector_recycling_rules]
+#' to their common size.
+#'
+#' @param .na_rm Should missing values be removed?
+#'
+#' @param .size An optional output size that overrides the common size of the
+#' inputs in `...`.
+#'
+#' @name parallel-operators
+#'
+#' @examples
+#' x <- c(TRUE, FALSE, NA, TRUE, NA)
+#' y <- c(FALSE, FALSE, TRUE, TRUE, NA)
+#'
+#' vec_pany(x, y)
+#' vec_pall(x, y)
+#'
+#' # Missing values can be removed from the computation
+#' vec_pany(x, y, .na_rm = TRUE)
+#' vec_pall(x, y, .na_rm = TRUE)
+#'
+#' # Same empty behavior as `any()` and `all()`
+#' vec_pany(.size = 1)
+#' any()
+#'
+#' vec_pall(.size = 1)
+#' all()
+NULL
+
+#' @rdname parallel-operators
+#' @export
+vec_pany <- function(..., .na_rm = FALSE, .size = NULL) {
+ .Call(ffi_vec_pany, list2(...), .na_rm, .size, environment())
+}
+
+#' @rdname parallel-operators
+#' @export
+vec_pall <- function(..., .na_rm = FALSE, .size = NULL) {
+ .Call(ffi_vec_pall, list2(...), .na_rm, .size, environment())
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index ce18047fd..35777a2b5 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -9,7 +9,7 @@ template:
includes:
in_header: |
-
+
reference:
- title: User FAQ
@@ -93,6 +93,10 @@ reference:
- vec_seq_along
- vec_identify_runs
+- title: Reducers
+ contents:
+ - vec_pall
+
- title: New classes
contents:
- list_of
diff --git a/man/parallel-operators.Rd b/man/parallel-operators.Rd
new file mode 100644
index 000000000..20e3b6c72
--- /dev/null
+++ b/man/parallel-operators.Rd
@@ -0,0 +1,54 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/parallel.R
+\name{parallel-operators}
+\alias{parallel-operators}
+\alias{vec_pany}
+\alias{vec_pall}
+\title{Parallel \code{any()} and \code{all()}}
+\usage{
+vec_pany(..., .na_rm = FALSE, .size = NULL)
+
+vec_pall(..., .na_rm = FALSE, .size = NULL)
+}
+\arguments{
+\item{...}{Logical vectors. These will be \link[=vector_recycling_rules]{recycled}
+to their common size.}
+
+\item{.na_rm}{Should missing values be removed?}
+
+\item{.size}{An optional output size that overrides the common size of the
+inputs in \code{...}.}
+}
+\description{
+These functions are variants of \code{\link[=any]{any()}} and \code{\link[=all]{all()}} that work in parallel on
+multiple inputs at once. They work similarly to how \code{\link[=pmin]{pmin()}} and \code{\link[=pmax]{pmax()}} are
+parallel variants of \code{\link[=min]{min()}} and \code{\link[=max]{max()}}.
+}
+\details{
+\code{vec_pany()} and \code{vec_pall()} are consistent with \code{\link[=any]{any()}} and \code{\link[=all]{all()}} when
+there are no inputs to process in parallel:
+\itemize{
+\item \code{any()} returns \code{FALSE} with no inputs. Similarly, \code{vec_pany(.size = 1)}
+and \code{vec_pany(NA, .na_rm = TRUE)} both return \code{FALSE}.
+\item \code{all()} returns \code{TRUE} with no inputs. Similarly, \code{vec_pall(.size = 1)}
+and \code{vec_pall(NA, .na_rm = TRUE)} both return \code{TRUE}.
+}
+}
+\examples{
+x <- c(TRUE, FALSE, NA, TRUE, NA)
+y <- c(FALSE, FALSE, TRUE, TRUE, NA)
+
+vec_pany(x, y)
+vec_pall(x, y)
+
+# Missing values can be removed from the computation
+vec_pany(x, y, .na_rm = TRUE)
+vec_pall(x, y, .na_rm = TRUE)
+
+# Same empty behavior as `any()` and `all()`
+vec_pany(.size = 1)
+any()
+
+vec_pall(.size = 1)
+all()
+}
diff --git a/src/decl/parallel-decl.h b/src/decl/parallel-decl.h
new file mode 100644
index 000000000..1289eb85a
--- /dev/null
+++ b/src/decl/parallel-decl.h
@@ -0,0 +1,43 @@
+static inline
+r_obj* ffi_vec_p(r_obj* xs,
+ r_obj* ffi_na_rm,
+ r_obj* ffi_size,
+ r_obj* frame,
+ enum vctrs_parallel parallel);
+
+static
+r_obj* vec_p(r_obj* xs,
+ bool na_rm,
+ r_ssize size,
+ enum vctrs_parallel parallel,
+ struct r_lazy call);
+
+static inline
+void vec_pall_init(const int* v_x, bool na_rm, r_ssize size, int* v_out);
+static inline
+void vec_pany_init(const int* v_x, bool na_rm, r_ssize size, int* v_out);
+
+static inline
+void vec_pall_fill(const int* v_x, bool na_rm, r_ssize size, int* v_out);
+static inline
+void vec_pany_fill(const int* v_x, bool na_rm, r_ssize size, int* v_out);
+
+static inline
+void vec_pall_init_na_rm(const int* v_x, r_ssize size, int* v_out);
+static inline
+void vec_pall_fill_na_rm(const int* v_x, r_ssize size, int* v_out);
+
+static inline
+void vec_pany_init_na_rm(const int* v_x, r_ssize size, int* v_out);
+static inline
+void vec_pany_fill_na_rm(const int* v_x, r_ssize size, int* v_out);
+
+static inline
+void vec_pall_init_na_keep(const int* v_x, r_ssize size, int* v_out);
+static inline
+void vec_pall_fill_na_keep(const int* v_x, r_ssize size, int* v_out);
+
+static inline
+void vec_pany_init_na_keep(const int* v_x, r_ssize size, int* v_out);
+static inline
+void vec_pany_fill_na_keep(const int* v_x, r_ssize size, int* v_out);
diff --git a/src/init.c b/src/init.c
index 3ce079ec0..bf4fae79e 100644
--- a/src/init.c
+++ b/src/init.c
@@ -150,6 +150,8 @@ extern r_obj* ffi_list_all_vectors(r_obj*, r_obj*);
extern r_obj* ffi_list_check_all_vectors(r_obj*, r_obj*);
extern r_obj* ffi_as_short_length(r_obj*, r_obj*);
extern r_obj* ffi_s3_get_method(r_obj*, r_obj*, r_obj*);
+extern r_obj* ffi_vec_pall(r_obj*, r_obj*, r_obj*, r_obj*);
+extern r_obj* ffi_vec_pany(r_obj*, r_obj*, r_obj*, r_obj*);
// Maturing
@@ -321,6 +323,8 @@ static const R_CallMethodDef CallEntries[] = {
{"ffi_list_check_all_vectors", (DL_FUNC) &ffi_list_check_all_vectors, 2},
{"ffi_as_short_length", (DL_FUNC) &ffi_as_short_length, 2},
{"ffi_s3_get_method", (DL_FUNC) &ffi_s3_get_method, 3},
+ {"ffi_vec_pall", (DL_FUNC) &ffi_vec_pall, 4},
+ {"ffi_vec_pany", (DL_FUNC) &ffi_vec_pany, 4},
{"ffi_exp_vec_cast", (DL_FUNC) &exp_vec_cast, 2},
{NULL, NULL, 0}
};
diff --git a/src/parallel.c b/src/parallel.c
new file mode 100644
index 000000000..f8b2df5d0
--- /dev/null
+++ b/src/parallel.c
@@ -0,0 +1,259 @@
+#include "vctrs.h"
+
+enum vctrs_parallel {
+ VCTRS_PARALLEL_all = 0,
+ VCTRS_PARALLEL_any = 1
+};
+
+#include "decl/parallel-decl.h"
+
+// -----------------------------------------------------------------------------
+
+r_obj* ffi_vec_pall(r_obj* xs, r_obj* ffi_na_rm, r_obj* ffi_size, r_obj* frame) {
+ return ffi_vec_p(xs, ffi_na_rm, ffi_size, frame, VCTRS_PARALLEL_all);
+}
+r_obj* ffi_vec_pany(r_obj* xs, r_obj* ffi_na_rm, r_obj* ffi_size, r_obj* frame) {
+ return ffi_vec_p(xs, ffi_na_rm, ffi_size, frame, VCTRS_PARALLEL_any);
+}
+
+static inline
+r_obj* ffi_vec_p(r_obj* xs,
+ r_obj* ffi_na_rm,
+ r_obj* ffi_size,
+ r_obj* frame,
+ enum vctrs_parallel parallel) {
+ struct r_lazy call = { .x = frame, .env = r_null };
+
+ const bool na_rm = r_arg_as_bool(ffi_na_rm, ".na_rm");
+
+ r_ssize size = -1;
+ if (ffi_size == r_null) {
+ size = vec_check_size_common(xs, 0, vec_args.empty, call);
+ } else {
+ size = vec_as_short_length(ffi_size, vec_args.dot_size, call);
+ }
+
+ return vec_p(xs, na_rm, size, parallel, call);
+}
+
+// -----------------------------------------------------------------------------
+
+static
+r_obj* vec_p(r_obj* xs,
+ bool na_rm,
+ r_ssize size,
+ enum vctrs_parallel parallel,
+ struct r_lazy call) {
+ xs = KEEP(vec_cast_common(xs, r_globals.empty_lgl, vec_args.empty, call));
+
+ const struct size_common_opts recycle_opts = {
+ .p_arg = vec_args.empty,
+ .call = call
+ };
+ xs = KEEP(vec_recycle_common_opts(xs, size, &recycle_opts));
+
+ r_obj* out = KEEP(r_alloc_logical(size));
+ int* v_out = r_lgl_begin(out);
+
+ const r_ssize n = r_length(xs);
+ r_obj* const* v_xs = r_list_cbegin(xs);
+
+ if (n == 0) {
+ switch (parallel) {
+ case VCTRS_PARALLEL_all: r_p_lgl_fill(v_out, 1, size); break;
+ case VCTRS_PARALLEL_any: r_p_lgl_fill(v_out, 0, size); break;
+ }
+ } else {
+ r_obj* x = v_xs[0];
+ const int* v_x = r_lgl_begin(x);
+
+ switch (parallel) {
+ case VCTRS_PARALLEL_all: vec_pall_init(v_x, na_rm, size, v_out); break;
+ case VCTRS_PARALLEL_any: vec_pany_init(v_x, na_rm, size, v_out); break;
+ }
+ }
+
+ for (r_ssize i = 1; i < n; ++i) {
+ r_obj* x = v_xs[i];
+ const int* v_x = r_lgl_begin(x);
+
+ switch (parallel) {
+ case VCTRS_PARALLEL_all: vec_pall_fill(v_x, na_rm, size, v_out); break;
+ case VCTRS_PARALLEL_any: vec_pany_fill(v_x, na_rm, size, v_out); break;
+ }
+ }
+
+ FREE(3);
+ return out;
+}
+
+// -----------------------------------------------------------------------------
+
+static inline
+void vec_pall_init(const int* v_x, bool na_rm, r_ssize size, int* v_out) {
+ if (na_rm) {
+ vec_pall_init_na_rm(v_x, size, v_out);
+ } else {
+ vec_pall_init_na_keep(v_x, size, v_out);
+ }
+}
+static inline
+void vec_pany_init(const int* v_x, bool na_rm, r_ssize size, int* v_out) {
+ if (na_rm) {
+ vec_pany_init_na_rm(v_x, size, v_out);
+ } else {
+ vec_pany_init_na_keep(v_x, size, v_out);
+ }
+}
+
+static inline
+void vec_pall_fill(const int* v_x, bool na_rm, r_ssize size, int* v_out) {
+ if (na_rm) {
+ vec_pall_fill_na_rm(v_x, size, v_out);
+ } else {
+ vec_pall_fill_na_keep(v_x, size, v_out);
+ }
+}
+static inline
+void vec_pany_fill(const int* v_x, bool na_rm, r_ssize size, int* v_out) {
+ if (na_rm) {
+ vec_pany_fill_na_rm(v_x, size, v_out);
+ } else {
+ vec_pany_fill_na_keep(v_x, size, v_out);
+ }
+}
+
+// -----------------------------------------------------------------------------
+
+/*
+ * Each of these implementations has been highly optimized to be completely
+ * branchless. Additionally, we are careful to ensure that the access of both
+ * `v_out[i]` and `v_x[i]` is mandatory at each iteration rather than
+ * conditional (i.e. `v_out[i] && v_x[i]` vs `elt_out && elt_x`). Conditional
+ * access of `v_x[i]` in particular can destroy performance here, as it prevents
+ * the compiler from heavily optimizing the actual computation.
+ *
+ * Additionally, the implementations of pall/pany have been designed to be as
+ * symmetrical as possible to increase code clarity. For example,
+ * `vec_pall_fill_na_rm()` and `vec_pany_fill_na_rm()` are symmetrical, as are
+ * the two fill variants of `*_na_keep()`.
+ *
+ * A nice property of these implementations is that they don't rely on
+ * assumptions about two's complement, bitwise operations, or the underlying
+ * value of `NA_LOGICAL` in any way, making them as portable as possible.
+ */
+
+/*
+ * Never need to worry about `N && *`, because the initialization takes care
+ * of missing values in the first input, and they are never propagated after
+ * that.
+ *
+ * F && F == F
+ * F && T == F
+ * F && N == F
+ *
+ * T && F == F
+ * T && T == T
+ * T && N == T
+ */
+static inline
+void vec_pall_init_na_rm(const int* v_x, r_ssize size, int* v_out) {
+ for (r_ssize i = 0; i < size; ++i) {
+ v_out[i] = (bool) v_x[i];
+ }
+}
+static inline
+void vec_pall_fill_na_rm(const int* v_x, r_ssize size, int* v_out) {
+ for (r_ssize i = 0; i < size; ++i) {
+ const int elt_out = v_out[i];
+ const int elt_x = v_x[i];
+ v_out[i] = elt_out && elt_x;
+ }
+}
+
+/*
+ * Never need to worry about `N || *`, because the initialization takes care
+ * of missing values in the first input, and they are never propagated after
+ * that.
+ *
+ * F || F == F
+ * F || T == T
+ * F || N == F
+ *
+ * T || F == T
+ * T || T == T
+ * T || N == T
+ */
+static inline
+void vec_pany_init_na_rm(const int* v_x, r_ssize size, int* v_out) {
+ for (r_ssize i = 0; i < size; ++i) {
+ const int elt = v_x[i];
+ v_out[i] = (elt != r_globals.na_lgl) * elt;
+ }
+}
+static inline
+void vec_pany_fill_na_rm(const int* v_x, r_ssize size, int* v_out) {
+ for (r_ssize i = 0; i < size; ++i) {
+ const int elt_out = v_out[i];
+ const int elt_x = v_x[i];
+ v_out[i] = (elt_out == 1) || (elt_x == 1);
+ }
+}
+
+/*
+ * F && F == F
+ * F && T == F
+ * F && N == F
+ *
+ * T && F == F
+ * T && T == T
+ * T && N == N
+ *
+ * N && F == F
+ * N && T == N
+ * N && N == N
+ */
+static inline
+void vec_pall_init_na_keep(const int* v_x, r_ssize size, int* v_out) {
+ memcpy(v_out, v_x, sizeof(*v_out) * size);
+}
+static inline
+void vec_pall_fill_na_keep(const int* v_x, r_ssize size, int* v_out) {
+ for (r_ssize i = 0; i < size; ++i) {
+ const int elt_out = v_out[i];
+ const int elt_x = v_x[i];
+
+ const bool any_false = !elt_out || !elt_x;
+ const bool equal = elt_out == elt_x;
+ v_out[i] = !any_false * (equal * elt_out + !equal * r_globals.na_lgl);
+ }
+}
+
+/*
+ * F || F == F
+ * F || T == T
+ * F || N == N
+ *
+ * T || F == T
+ * T || T == T
+ * T || N == T
+ *
+ * N || F == N
+ * N || T == T
+ * N || N == N
+ */
+static inline
+void vec_pany_init_na_keep(const int* v_x, r_ssize size, int* v_out) {
+ memcpy(v_out, v_x, sizeof(*v_out) * size);
+}
+static inline
+void vec_pany_fill_na_keep(const int* v_x, r_ssize size, int* v_out) {
+ for (r_ssize i = 0; i < size; ++i) {
+ const int elt_out = v_out[i];
+ const int elt_x = v_x[i];
+
+ const bool any_true = (elt_out == 1) || (elt_x == 1);
+ const bool equal = elt_out == elt_x;
+ v_out[i] = any_true + !any_true * (equal * elt_out + !equal * r_globals.na_lgl);
+ }
+}
diff --git a/tests/testthat/_snaps/parallel.md b/tests/testthat/_snaps/parallel.md
new file mode 100644
index 000000000..a382977d1
--- /dev/null
+++ b/tests/testthat/_snaps/parallel.md
@@ -0,0 +1,155 @@
+# casts inputs to logical
+
+ Code
+ vec_pall(1.5)
+ Condition
+ Error in `vec_pall()`:
+ ! Can't convert from `..1` to due to loss of precision.
+ * Locations: 1
+
+---
+
+ Code
+ vec_pany(1.5)
+ Condition
+ Error in `vec_pany()`:
+ ! Can't convert from `..1` to due to loss of precision.
+ * Locations: 1
+
+# recycles inputs to common size
+
+ Code
+ vec_pall(c(TRUE, FALSE), c(TRUE, TRUE, TRUE))
+ Condition
+ Error in `vec_pall()`:
+ ! Can't recycle `..1` (size 2) to match `..2` (size 3).
+
+---
+
+ Code
+ vec_pany(c(TRUE, FALSE), c(TRUE, TRUE, TRUE))
+ Condition
+ Error in `vec_pany()`:
+ ! Can't recycle `..1` (size 2) to match `..2` (size 3).
+
+# respects `.size`
+
+ Code
+ vec_pall(c(TRUE, FALSE), .size = 3L)
+ Condition
+ Error in `vec_pall()`:
+ ! Can't recycle `..1` (size 2) to size 3.
+
+# validates `.na_rm`
+
+ Code
+ vec_pall(.na_rm = c(TRUE, FALSE))
+ Condition
+ Error in `vec_pall()`:
+ ! `.na_rm` must be `TRUE` or `FALSE`.
+
+---
+
+ Code
+ vec_pany(.na_rm = c(TRUE, FALSE))
+ Condition
+ Error in `vec_pany()`:
+ ! `.na_rm` must be `TRUE` or `FALSE`.
+
+---
+
+ Code
+ vec_pall(.na_rm = 1)
+ Condition
+ Error in `vec_pall()`:
+ ! `.na_rm` must be `TRUE` or `FALSE`.
+
+---
+
+ Code
+ vec_pany(.na_rm = 1)
+ Condition
+ Error in `vec_pany()`:
+ ! `.na_rm` must be `TRUE` or `FALSE`.
+
+---
+
+ Code
+ vec_pall(.na_rm = NA)
+ Condition
+ Error in `vec_pall()`:
+ ! `.na_rm` must be `TRUE` or `FALSE`.
+
+---
+
+ Code
+ vec_pany(.na_rm = NA)
+ Condition
+ Error in `vec_pany()`:
+ ! `.na_rm` must be `TRUE` or `FALSE`.
+
+# validates `.size`
+
+ Code
+ vec_pall(.size = c(1, 2))
+ Condition
+ Error in `vec_pall()`:
+ ! `.size` must be a single number, not a double vector of length 2.
+
+---
+
+ Code
+ vec_pany(.size = c(1, 2))
+ Condition
+ Error in `vec_pany()`:
+ ! `.size` must be a single number, not a double vector of length 2.
+
+---
+
+ Code
+ vec_pall(.size = 1.5)
+ Condition
+ Error in `vec_pall()`:
+ ! `.size` must be a whole number, not a fractional number.
+
+---
+
+ Code
+ vec_pany(.size = 1.5)
+ Condition
+ Error in `vec_pany()`:
+ ! `.size` must be a whole number, not a fractional number.
+
+---
+
+ Code
+ vec_pall(.size = NA_integer_)
+ Condition
+ Error in `vec_pall()`:
+ ! `.size` must be a single number, not an integer `NA`.
+
+---
+
+ Code
+ vec_pany(.size = NA_integer_)
+ Condition
+ Error in `vec_pany()`:
+ ! `.size` must be a single number, not an integer `NA`.
+
+# names are used in errors
+
+ Code
+ vec_pall(x = 1.5)
+ Condition
+ Error in `vec_pall()`:
+ ! Can't convert from `x` to due to loss of precision.
+ * Locations: 1
+
+---
+
+ Code
+ vec_pany(x = c(TRUE, FALSE), y = logical())
+ Condition
+ Error in `vec_pany()`:
+ ! Can't recycle `x` (size 2) to match `y` (size 0).
+
diff --git a/tests/testthat/test-parallel.R b/tests/testthat/test-parallel.R
new file mode 100644
index 000000000..bd37d257a
--- /dev/null
+++ b/tests/testthat/test-parallel.R
@@ -0,0 +1,121 @@
+test_that("9 possible variations of each combination are right", {
+ N <- NA
+
+ expect_identical(vec_pall(T, T, .na_rm = F), T)
+ expect_identical(vec_pall(T, F, .na_rm = F), F)
+ expect_identical(vec_pall(T, N, .na_rm = F), N)
+ expect_identical(vec_pall(F, T, .na_rm = F), F)
+ expect_identical(vec_pall(F, F, .na_rm = F), F)
+ expect_identical(vec_pall(F, N, .na_rm = F), F)
+ expect_identical(vec_pall(N, T, .na_rm = F), N)
+ expect_identical(vec_pall(N, F, .na_rm = F), F)
+ expect_identical(vec_pall(N, N, .na_rm = F), N)
+
+ expect_identical(vec_pall(T, T, .na_rm = T), T)
+ expect_identical(vec_pall(T, F, .na_rm = T), F)
+ expect_identical(vec_pall(T, N, .na_rm = T), T)
+ expect_identical(vec_pall(F, T, .na_rm = T), F)
+ expect_identical(vec_pall(F, F, .na_rm = T), F)
+ expect_identical(vec_pall(F, N, .na_rm = T), F)
+ expect_identical(vec_pall(N, T, .na_rm = T), T)
+ expect_identical(vec_pall(N, F, .na_rm = T), F)
+ expect_identical(vec_pall(N, N, .na_rm = T), T)
+
+ expect_identical(vec_pany(T, T, .na_rm = F), T)
+ expect_identical(vec_pany(T, F, .na_rm = F), T)
+ expect_identical(vec_pany(T, N, .na_rm = F), T)
+ expect_identical(vec_pany(F, T, .na_rm = F), T)
+ expect_identical(vec_pany(F, F, .na_rm = F), F)
+ expect_identical(vec_pany(F, N, .na_rm = F), N)
+ expect_identical(vec_pany(N, T, .na_rm = F), T)
+ expect_identical(vec_pany(N, F, .na_rm = F), N)
+ expect_identical(vec_pany(N, N, .na_rm = F), N)
+
+ expect_identical(vec_pany(T, T, .na_rm = T), T)
+ expect_identical(vec_pany(T, F, .na_rm = T), T)
+ expect_identical(vec_pany(T, N, .na_rm = T), T)
+ expect_identical(vec_pany(F, T, .na_rm = T), T)
+ expect_identical(vec_pany(F, F, .na_rm = T), F)
+ expect_identical(vec_pany(F, N, .na_rm = T), F)
+ expect_identical(vec_pany(N, T, .na_rm = T), T)
+ expect_identical(vec_pany(N, F, .na_rm = T), F)
+ expect_identical(vec_pany(N, N, .na_rm = T), F)
+})
+
+test_that("works with empty inputs", {
+ expect_identical(vec_pall(logical(), logical()), logical())
+ expect_identical(vec_pany(logical(), logical()), logical())
+})
+
+test_that("works with no inputs", {
+ expect_identical(vec_pall(), logical())
+ expect_identical(vec_pany(), logical())
+})
+
+test_that("works with no inputs and specified `.size`", {
+ expect_identical(vec_pall(.size = 3), c(TRUE, TRUE, TRUE))
+ expect_identical(vec_pany(.size = 3), c(FALSE, FALSE, FALSE))
+})
+
+test_that("casts inputs to logical", {
+ expect_identical(vec_pall(1, 1, c(1, 0)), c(TRUE, FALSE))
+ expect_identical(vec_pany(0, 0, c(1, 0)), c(TRUE, FALSE))
+
+ expect_snapshot(error = TRUE, {
+ vec_pall(1.5)
+ })
+ expect_snapshot(error = TRUE, {
+ vec_pany(1.5)
+ })
+})
+
+test_that("recycles inputs to common size", {
+ expect_identical(vec_pall(TRUE, c(FALSE, TRUE)), c(FALSE, TRUE))
+ expect_identical(vec_pany(TRUE, c(FALSE, TRUE)), c(TRUE, TRUE))
+
+ expect_snapshot(error = TRUE, {
+ vec_pall(c(TRUE, FALSE), c(TRUE, TRUE, TRUE))
+ })
+ expect_snapshot(error = TRUE, {
+ vec_pany(c(TRUE, FALSE), c(TRUE, TRUE, TRUE))
+ })
+})
+
+test_that("respects `.size`", {
+ expect_identical(vec_pall(TRUE, .size = 3), c(TRUE, TRUE, TRUE))
+
+ expect_snapshot(error = TRUE, {
+ vec_pall(c(TRUE, FALSE), .size = 3L)
+ })
+})
+
+test_that("validates `.na_rm`", {
+ expect_snapshot(error = TRUE, vec_pall(.na_rm = c(TRUE, FALSE)))
+ expect_snapshot(error = TRUE, vec_pany(.na_rm = c(TRUE, FALSE)))
+
+ expect_snapshot(error = TRUE, vec_pall(.na_rm = 1))
+ expect_snapshot(error = TRUE, vec_pany(.na_rm = 1))
+
+ expect_snapshot(error = TRUE, vec_pall(.na_rm = NA))
+ expect_snapshot(error = TRUE, vec_pany(.na_rm = NA))
+})
+
+test_that("validates `.size`", {
+ expect_snapshot(error = TRUE, vec_pall(.size = c(1, 2)))
+ expect_snapshot(error = TRUE, vec_pany(.size = c(1, 2)))
+
+ expect_snapshot(error = TRUE, vec_pall(.size = 1.5))
+ expect_snapshot(error = TRUE, vec_pany(.size = 1.5))
+
+ expect_snapshot(error = TRUE, vec_pall(.size = NA_integer_))
+ expect_snapshot(error = TRUE, vec_pany(.size = NA_integer_))
+})
+
+test_that("names are used in errors", {
+ expect_snapshot(error = TRUE, {
+ vec_pall(x = 1.5)
+ })
+ expect_snapshot(error = TRUE, {
+ vec_pany(x = c(TRUE, FALSE), y = logical())
+ })
+})