Look up symbols as functions in across()

Closes #6545

R/across.R

@@ -177,15 +177,19 @@ across <- function(.cols,
   caller_env <- caller_env()
 
   .cols <- enquo(.cols)
+  fns_quo <- enquo(.fns)
 
   if (quo_is_missing(.cols)) {
     across_missing_cols_deprecate_warn()
     .cols <- quo_set_expr(.cols, expr(everything()))
   }
+
   if (is_missing(.fns)) {
     # Silent restoration to old defaults of `.fns` for now.
     # TODO: Escalate this to formal deprecation.
     .fns <- NULL
+  } else if (!is_function(.fns) && !is_list(.fns)) {
+    .fns <- quo_eval_fns(fns_quo)
   }
 
   if (!is_bool(.unpack) && !is_string(.unpack)) {
@@ -455,7 +459,7 @@ across_setup <- function(cols,
   )
 
   if (!inline) {
-    fns <- map(fns, as_function)
+    fns <- map(fns, as_function, call = quote(across()))
   }
 
   list(vars = vars, fns = fns, names = names, across_if_fn = across_if_fn)
@@ -648,7 +652,8 @@ expand_across <- function(quo) {
   cols <- as_quosure(cols, env)
 
   if (".fns" %in% names(expr)) {
-    fns <- eval_tidy(expr$.fns, mask, env = env)
+    fns <- as_quosure(expr$.fns, env)
+    fns <- quo_eval_fns(fns, mask, env = env)
   } else {
     # In the missing case, silently restore the old default of `NULL`.
     # TODO: Escalate this to formal deprecation.
@@ -845,3 +850,27 @@ apply_unpack_spec <- function(col, outer, spec, caller_env) {
   names(col) <- inner
   col
 }
+
+quo_eval_fns <- function(quo, data = NULL, env = caller_env()) {
+  if (!quo_is_symbol(quo)) {
+    return(eval_tidy(quo, data, env = env))
+  }
+
+  sym <- quo_get_expr(quo)
+  env <- quo_get_env(quo)
+  nm <- as_string(sym)
+
+  while (!identical(env, empty_env())) {
+    out <- env_get(env, nm, default = NULL)
+
+    if (is_function(out) || is_list(out) || is_formula(out)) {
+      return(out)
+    }
+
+    env <- env_parent(env)
+  }
+
+  # Triggers object not found error or evaluates to an object of the
+  # wrong type to be checked later on
+  eval_tidy(quo, quo_get_env(quo))
+}

tests/testthat/_snaps/across.md

@@ -473,3 +473,22 @@
         <dbl>
       1     1
 
+# symbols are looked up as list or functions (#6545)
+
+    Code
+      (expect_error(summarize(df, across(.fns = list(mean)))))
+    Output
+      <error/rlang_error>
+      Error in `summarize()`:
+      i In argument: `..1 = across(.fns = list(mean))`.
+      Caused by error:
+      ! attempt to select less than one element in integerOneIndex
+    Code
+      (expect_error(summarize(df, (across(.fns = list(mean))))))
+    Output
+      <error/rlang_error>
+      Error in `summarize()`:
+      i In argument: `..1 = (across(.fns = list(mean)))`.
+      Caused by error in `across()`:
+      ! Can't convert `X[[i]]`, an integer vector, to a function.
+

tests/testthat/test-across.R

@@ -1221,3 +1221,25 @@ test_that("group variables are in scope when passed in dots (#5832)", {
     exp
   )
 })
+
+test_that("symbols are looked up as list or functions (#6545)", {
+  df <- tibble(mean = 1:5)
+  exp <- summarise(df, across(.fns = function(x) mean(x)))
+
+  expect_equal(
+    summarise(df, across(.fns = mean)),
+    exp
+  )
+  expect_equal(
+    summarise(df, (across(.fns = mean))),
+    exp
+  )
+
+  expect_snapshot({
+    # This error is suboptimal because `mean` is looked up at
+    # expansion-time before group chunks are set up
+    (expect_error(summarize(df, across(.fns = list(mean)))))
+
+    (expect_error(summarize(df, (across(.fns = list(mean))))))
+  })
+})