Make evaluation and expansion cases more consistent

And add a battery of tests to ensure we don't regress on this consistency

Author: DavisVaughan

NEWS.md

@@ -1,8 +1,12 @@
 # dplyr (development version)
 
-* `if_any()` now correctly returns `FALSE` when called without inputs, matching the behavior of `any()` (#7077).
+* `if_any()` and `if_all()` are now more consistent in all use cases (#7059, #7077, #7746, @jrwinget). In particular:
 
-* `if_any()` and `if_all()` now properly return logical vectors rather than the column itself when called with a single input (#7746).
+  * When called with zero inputs, `if_any()` returns `FALSE` and `if_all()` returns `TRUE`.
+
+  * When called with one input, both now return logical vectors rather than the original column.
+
+  * The result of applying `.fns` now must be a logical vector.
 
 * Empty `rowwise()` list-column elements now resolve to `logical()` rather than a random logical of length 1 (#7710).
 
@@ -101,10 +105,6 @@
 * Fixed an issue where duckplyr's ALTREP data frames were being materialized
   early due to internal usage of `ncol()` (#7049).
 
-* `if_any()` and `if_all()` are now fully consistent with `any()` and `all()`.
-  In particular, when called with empty inputs `if_any()` returns `FALSE` and
-  `if_all()` returns `TRUE` (#7059, @jrwinget).
-
 # dplyr 1.1.4
 
 * `join_by()` now allows its helper functions to be namespaced with `dplyr::`,

R/across.R

@@ -349,17 +349,71 @@ across <- function(.cols, .fns, ..., .names = NULL, .unpack = FALSE) {
 if_any <- function(.cols, .fns, ..., .names = NULL) {
   context_local("across_if_fn", "if_any")
   context_local("across_frame", current_env())
-  if_across("any", across({{ .cols }}, .fns, ..., .names = .names))
+  df <- across({{ .cols }}, .fns, ..., .names = .names)
+  x <- dplyr_new_list(df)
+  size <- vec_size(df)
+  dplyr_list_pany(x, size = size)
 }
+
 #' @rdname across
 #' @export
 if_all <- function(.cols, .fns, ..., .names = NULL) {
   context_local("across_if_fn", "if_all")
   context_local("across_frame", current_env())
-  if_across("all", across({{ .cols }}, .fns, ..., .names = .names))
+  df <- across({{ .cols }}, .fns, ..., .names = .names)
+  x <- dplyr_new_list(df)
+  size <- vec_size(df)
+  dplyr_list_pall(x, size = size)
 }
 
-if_across <- function(variant, df) {
+dplyr_list_pall <- function(
+  x,
+  ...,
+  size = NULL,
+  error_call = caller_env()
+) {
+  dplyr_list_pany_pall(x, "all", ..., size = size, error_call = error_call)
+}
+
+dplyr_list_pany <- function(
+  x,
+  ...,
+  size = NULL,
+  error_call = caller_env()
+) {
+  dplyr_list_pany_pall(x, "any", ..., size = size, error_call = error_call)
+}
+
+dplyr_list_pany_pall <- function(
+  x,
+  variant,
+  ...,
+  size = NULL,
+  error_call = caller_env()
+) {
+  check_dots_empty0(...)
+
+  obj_check_list(x, arg = "", call = error_call)
+
+  # Doesn't allow `NULL`, doesn't do type casting
+  for (i in seq_along(x)) {
+    check_logical(
+      x[[i]],
+      arg = (vec_names(x) %||% paste0("..", seq_len(vec_size(x))))[[i]],
+      call = error_call
+    )
+  }
+
+  # Doesn't do recycling, asserts that all inputs are the same size
+  if (is.null(size)) {
+    if (length(x) == 0L) {
+      size <- 0L
+    } else {
+      size <- vec_size(x[[1L]])
+    }
+  }
+  list_check_all_size(x, size, arg = "", call = error_call)
+
   switch(
     variant,
     any = {
@@ -373,9 +427,9 @@ if_across <- function(variant, df) {
     abort("Unreachable", .internal = TRUE)
   )
 
-  init <- vec_rep(init, times = vec_size(df))
+  init <- vec_rep(init, times = size)
 
-  reduce(df, op, .init = init)
+  reduce(x, op, .init = init)
 }
 
 #' Combine values from multiple columns
@@ -610,79 +664,68 @@ dplyr_quosures <- function(...) {
   quosures
 }
 
-# When mutate() or summarise() have an unnamed call to across() at the top level, e.g.
-# summarise(across(<...>)) or mutate(across(<...>))
-#
-# a call to top_across(<...>) is evaluated instead.
-# top_across() returns a flattened list of expressions along with some
-# information about the "current column" for each expression
-# in the "columns" attribute:
-#
-# For example with: summarise(across(c(x, y), mean, .names = "mean_{.col}")) top_across() will return
-# something like:
-#
-# structure(
-#   list(mean_x = expr(mean(x)), mean_y = expr(mean(y)))
-#   columns = c("x", "y")
-# )
-
-# Technically this always returns a single quosure but we wrap it in a
-# list to follow the pattern in `expand_across()`
+# Always guaranteed to be 1 quosure in, 1 quosure out, unlike `expand_across()`
 expand_if_across <- function(quo) {
-  quo_data <- attr(quo, "dplyr:::data")
-  if (!quo_is_call(quo, c("if_any", "if_all"), ns = c("", "dplyr"))) {
-    return(list(quo))
+  if (quo_is_call(quo, "if_any", ns = c("", "dplyr"))) {
+    variant <- "any"
+  } else if (quo_is_call(quo, "if_all", ns = c("", "dplyr"))) {
+    variant <- "all"
+  } else {
+    # Refuse to expand
+    return(quo)
   }
 
+  # `definition` is the same between the two for the purposes of `match.call()`
+  definition <- if_any
+
   call <- match.call(
-    definition = if_any,
+    definition = definition,
     call = quo_get_expr(quo),
     expand.dots = FALSE,
     envir = quo_get_env(quo)
   )
+
   if (!is_null(call$...)) {
-    return(list(quo))
+    # Refuse to expand
+    return(quo)
   }
 
-  if (is_call(call, "if_any")) {
-    op <- "|"
+  if (variant == "any") {
     if_fn <- "if_any"
-    empty <- FALSE
+    dplyr_fn <- "dplyr_list_pany"
   } else {
-    op <- "&"
     if_fn <- "if_all"
-    empty <- TRUE
+    dplyr_fn <- "dplyr_list_pall"
   }
 
+  # `expand_across()` will always expand at this point given that we bailed on
+  # `...` usage early on, which is the only case that would stop expansion.
+  #
+  # Set frame here for backtrace truncation. But override error call via
+  # `local_error_call()` so it refers to the function we're expanding, e.g.
+  # `if_any()` and not `expand_if_across()`.
   context_local("across_if_fn", if_fn)
-
-  # Set frame here for backtrace truncation. But override error call
-  # via `local_error_call()` so it refers to the function we're
-  # expanding, e.g. `if_any()` and not `expand_if_across()`.
   context_local("across_frame", current_env())
   local_error_call(call(if_fn))
-
   call[[1]] <- quote(across)
   quos <- expand_across(quo_set_expr(quo, call))
 
-  # Select all rows if there are no inputs for if_all(),
-  # but select no rows if there are no inputs for if_any().
-  if (!length(quos)) {
-    return(list(quo(!!empty)))
-  }
+  expr <- expr({
+    ns <- asNamespace("dplyr")
 
-  combine <- function(x, y) {
-    if (is_null(x)) {
-      y
-    } else {
-      call(op, x, y)
-    }
-  }
-  expr <- reduce(quos, combine, .init = NULL)
+    x <- list(!!!quos)
+
+    # In the evaluation path, `across()` automatically recycles to common size,
+    # so we must here as well for compatibility. `across()` also returns a 0
+    # col, 1 row data frame in the case of no inputs so that it will recycle to
+    # the group size, which we also do here.
+    size <- ns[["dplyr_list_size_common"]](x, absent = 1L, call = call(!!if_fn))
+    x <- ns[["dplyr_list_recycle_common"]](x, size = size, call = call(!!if_fn))
+
+    ns[[!!dplyr_fn]](x, size = size, error_call = call(!!if_fn))
+  })
 
-  # Use `as_quosure()` instead of `new_quosure()` to avoid rewrapping
-  # quosure in case of single input
-  list(as_quosure(expr, env = baseenv()))
+  new_quosure(expr, env = baseenv())
 }
 
 expand_across <- function(quo) {

R/filter.R

@@ -147,8 +147,16 @@ filter_rows <- function(
   mask <- DataMask$new(data, by, "filter", error_call = error_call)
   on.exit(mask$forget(), add = TRUE)
 
-  dots <- filter_expand(dots, mask = mask, error_call = error_call)
-  filter_eval(dots, mask = mask, error_call = error_call, user_env = user_env)
+  # 1:1 mapping between `dots` and `dots_expanded`
+  dots_expanded <- filter_expand(dots, mask = mask, error_call = error_call)
+
+  filter_eval(
+    dots = dots,
+    dots_expanded = dots_expanded,
+    mask = mask,
+    error_call = error_call,
+    user_env = user_env
+  )
 }
 
 check_filter <- function(dots, error_call = caller_env()) {
@@ -174,6 +182,7 @@ check_filter <- function(dots, error_call = caller_env()) {
 
 filter_expand <- function(dots, mask, error_call = caller_env()) {
   env_filter <- env()
+
   filter_expand_one <- function(dot, index) {
     env_filter$current_expression <- index
     dot <- expand_pick(dot, mask)
@@ -190,13 +199,15 @@ filter_expand <- function(dots, mask, error_call = caller_env()) {
     }
   )
 
-  dots <- list_flatten(dots)
-
   new_quosures(dots)
 }
 
+# We evaluate `dots_expanded` but report errors relative to `dots` so that
+# we show "In argument: `if_any(c(x, y), is.na)`" rather than its expanded form.
+# This works because `dots` and `dots_expanded` have a 1:1 mapping.
 filter_eval <- function(
   dots,
+  dots_expanded,
   mask,
   error_call = caller_env(),
   user_env = caller_env(2)
@@ -218,7 +229,7 @@ filter_eval <- function(
   )
 
   out <- withCallingHandlers(
-    mask$eval_all_filter(dots, env_filter),
+    mask$eval_all_filter(dots_expanded, env_filter),
     error = dplyr_error_handler(
       dots = dots,
       mask = mask,

R/vctrs.R

@@ -21,3 +21,28 @@ dplyr_vec_ptype_common <- function(chunks, name) {
     error = common_handler(name)
   )
 }
+
+# Version of `vec_size_common()` that takes a list.
+# Useful for delaying `!!!` when used within an `expr()` call.
+dplyr_list_size_common <- function(
+  x,
+  ...,
+  size = NULL,
+  absent = 0L,
+  call = caller_env()
+) {
+  check_dots_empty0(...)
+  vec_size_common(!!!x, .size = size, .absent = absent, .call = call)
+}
+
+# Version of `vec_recycle_common()` that takes a list.
+# Useful for delaying `!!!` when used within an `expr()` call.
+dplyr_list_recycle_common <- function(
+  x,
+  ...,
+  size = NULL,
+  call = caller_env()
+) {
+  check_dots_empty0(...)
+  vec_recycle_common(!!!x, .size = size, .call = call)
+}