From 8a1cf557606eff76bbca004ec992f71f0eb2a940 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Wed, 24 Jun 2026 07:38:36 -0500
Subject: [PATCH] Implement `some()` and `every()` helpers
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

These are more efficient than `any`/`all` plus `vapply()` because they can early exit. Benchmarking confirms that they are faster even in the worst case scenario (`TRUE`/`FALSE` at last entry).

```R
x <- as.list(1:10)
bench::mark(
  # some() early-exits on first TRUE; any(vlapply) computes all
  some_early    = some(x, \(v) v > 0),
  any_vlapply   = any(vlapply(x, \(v) v > 0)),
  # worst case: no early exit possible
  every_full    = every(x, \(v) v > 0),
  all_vlapply   = all(vlapply(x, \(v) v > 0)),
  check = FALSE
)[1:4]

#>   expression       min   median `itr/sec`
#>   <bch:expr>  <bch:tm> <bch:tm>     <dbl>
#> 1 some_early  410.01ns 574.04ns  1157952.
#> 2 any_vlapply   2.38µs   2.91µs   313534.
#> 3 every_full    1.31µs   1.64µs   563264.
#> 4 all_vlapply   2.34µs   2.91µs   330469.
```
---
 R/class-spec.R       |  8 ++++----
 R/external-class.R   |  2 +-
 R/external-generic.R |  2 +-
 R/utils.R            | 16 ++++++++++++++++
 4 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index d65c1264..3367f8dd 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -332,7 +332,7 @@ class_inherits <- function(x, what) {
     S4 = isS4(x) && methods::is(x, what),
     S7 = inherits(x, "S7_object") && inherits(x, S7_class_name(what)),
     S7_base = what$class == base_class(x),
-    S7_union = any(vlapply(what$classes, class_inherits, x = x)),
+    S7_union = some(what$classes, class_inherits, x = x),
     S7_S3 = !isS4(x) && class_dispatch_extends(what$class, class(x)),
     S7_external = inherits(x, "S7_object") && inherits(x, what$class_name),
   )
@@ -351,10 +351,10 @@ class_extends <- function(child, parent) {
     FALSE
   } else if (is_union(child)) {
     # A union child extends `parent` only if every one of its members does.
-    all(vlapply(child$classes, class_extends, parent = parent))
+    every(child$classes, class_extends, parent = parent)
   } else if (is_union(parent)) {
     # A non-union child extends a union parent if it extends any of its members.
-    any(vlapply(parent$classes, class_extends, child = child))
+    some(parent$classes, class_extends, child = child)
   } else if (is.null(child) && !is.null(parent)) {
     # as a child, NULL can only extend NULL
     FALSE
@@ -439,7 +439,7 @@ drop_S7_object <- function(x) {
 }
 
 union_contains_any <- function(x) {
-  is_union(x) && any(vlapply(x$classes, is_class_any))
+  is_union(x) && some(x$classes, is_class_any)
 }
 
 # Suppress @className false positive
diff --git a/R/external-class.R b/R/external-class.R
index 405146f8..97c81bf7 100644
--- a/R/external-class.R
+++ b/R/external-class.R
@@ -94,7 +94,7 @@ dep_version_ok <- function(dep) {
 # Resolve signature if all external classes are availabe
 resolve_signature_available <- function(signature, package = NULL) {
   deps <- signature_deps(signature)
-  all_available <- all(vlapply(deps, dep_available))
+  all_available <- every(deps, dep_available)
 
   if (all_available) {
     signature <- resolve_signature(signature, package)
diff --git a/R/external-generic.R b/R/external-generic.R
index 2e896fec..089d1b71 100644
--- a/R/external-generic.R
+++ b/R/external-generic.R
@@ -94,7 +94,7 @@ registrar <- function(generic, signature, method, env) {
 
   function(...) {
     deps <- method_deps(generic, signature)
-    if (!all(vlapply(deps, dep_available))) {
+    if (!every(deps, dep_available)) {
       return(invisible())
     }
 
diff --git a/R/utils.R b/R/utils.R
index 59f7e648..cab73e2a 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -15,6 +15,22 @@ global_variables <- function(names) {
 vlapply <- function(X, FUN, ...) {
   vapply(X = X, FUN = FUN, FUN.VALUE = logical(1), ...)
 }
+every <- function(X, FUN, ...) {
+  for (x in X) {
+    if (!FUN(x, ...)) {
+      return(FALSE)
+    }
+  }
+  TRUE
+}
+some <- function(X, FUN, ...) {
+  for (x in X) {
+    if (FUN(x, ...)) {
+      return(TRUE)
+    }
+  }
+  FALSE
+}
 vcapply <- function(X, FUN, ...) {
   vapply(X = X, FUN = FUN, FUN.VALUE = character(1), ...)
 }