# across ------------------------------------------------------------------ test_that("across() works on one column data.frame", { df <- data.frame(x = 1) out <- df |> mutate(across(everything(), identity)) expect_equal(out, df) }) test_that("across() does not select grouping variables", { df <- data.frame(g = 1, x = 1) out <- df |> group_by(g) |> summarise(x = across(everything(), identity)) |> pull() expect_equal(out, tibble(x = 1)) }) test_that("across() correctly names output columns", { gf <- tibble(x = 1, y = 2, z = 3, s = "") |> group_by(x) expect_named( summarise(gf, across(everything(), identity)), c("x", "y", "z", "s") ) expect_named( summarise(gf, across(everything(), identity, .names = "id_{.col}")), c("x", "id_y", "id_z", "id_s") ) expect_named( summarise(gf, across(where(is.numeric), mean)), c("x", "y", "z") ) expect_named( summarise(gf, across(where(is.numeric), mean, .names = "mean_{.col}")), c("x", "mean_y", "mean_z") ) expect_named( summarise(gf, across(where(is.numeric), list(mean = mean, sum = sum))), c("x", "y_mean", "y_sum", "z_mean", "z_sum") ) expect_named( summarise(gf, across(where(is.numeric), list(mean = mean, sum))), c("x", "y_mean", "y_2", "z_mean", "z_2") ) expect_named( summarise(gf, across(where(is.numeric), list(mean, sum = sum))), c("x", "y_1", "y_sum", "z_1", "z_sum") ) expect_named( summarise(gf, across(where(is.numeric), list(mean, sum))), c("x", "y_1", "y_2", "z_1", "z_2") ) expect_named( summarise( gf, across( where(is.numeric), list(mean = mean, sum = sum), .names = "{.fn}_{.col}" ) ), c("x", "mean_y", "sum_y", "mean_z", "sum_z") ) }) test_that("across(.unpack =) can unpack data frame columns", { fn1 <- function(x) { tibble(a = x, b = x + 1) } fn2 <- function(x) { tibble(c = -x, d = x - 1) } df <- tibble(x = 1:2, y = 3:4) out <- mutate(df, across(x:y, list(one = fn1, two = fn2), .unpack = TRUE)) expect <- tibble( x = 1:2, y = 3:4, x_one_a = x, x_one_b = x + 1, x_two_c = -x, x_two_d = x - 1, y_one_a = y, y_one_b = y + 1, y_two_c = -y, y_two_d = y - 1 ) expect_identical(out, expect) }) test_that("across(.unpack =) allows a glue specification for `.unpack`", { fn <- function(x) { tibble(a = x, b = x + 1) } df <- tibble(x = 1) out <- mutate(df, across(x, fn, .unpack = "{outer}.{inner}")) expect_named(out, c("x", "x.a", "x.b")) # Can use variables from caller env out <- local({ name <- "name" mutate(df, across(x, fn, .unpack = "{name}.{inner}")) }) expect_named(out, c("x", "name.a", "name.b")) }) test_that("across(.unpack =) skips unpacking non-df-cols", { fn <- function(x) { tibble(a = x, b = x + 1) } df <- tibble(x = 1) out <- mutate(df, across(x, list(fn = fn, double = ~ .x * 2), .unpack = TRUE)) expect <- tibble(x = 1, x_fn_a = 1, x_fn_b = 2, x_double = 2) expect_identical(out, expect) }) test_that("across(.unpack =) uses the result of `.names` as `{outer}`", { fn <- function(x) { tibble(a = x, b = x + 1) } df <- tibble(x = 1, y = 2) out <- df |> mutate(across( x:y, list(f = fn), .names = "{.col}.{.fn}", .unpack = "{inner}.{outer}" )) expect_named(out, c("x", "y", "a.x.f", "b.x.f", "a.y.f", "b.y.f")) }) test_that("across(.unpack =) errors if the unpacked data frame has non-unique names", { fn <- function(x) { tibble(a = x, b = x) } df <- tibble(x = 1, y = 2) expect_snapshot(error = TRUE, { mutate(df, across(x:y, fn, .unpack = "{outer}")) }) }) test_that("`.unpack` is validated", { df <- tibble(x = 1) expect_snapshot(error = TRUE, { summarise(df, across(x, mean, .unpack = 1)) }) expect_snapshot(error = TRUE, { summarise(df, across(x, mean, .unpack = c("x", "y"))) }) expect_snapshot(error = TRUE, { summarise(df, across(x, mean, .unpack = NA)) }) }) test_that("across() result locations are aligned with column names (#4967)", { df <- tibble(x = 1:2, y = c("a", "b")) expect <- tibble( x_cls = "integer", x_type = TRUE, y_cls = "character", y_type = FALSE ) x <- summarise(df, across(everything(), list(cls = class, type = is.numeric))) expect_identical(x, expect) }) test_that("across() works sequentially (#4907)", { df <- tibble(a = 1) expect_equal( mutate( df, x = df_n_col(across(where(is.numeric), identity)), y = df_n_col(across(where(is.numeric), identity)) ), tibble(a = 1, x = 1L, y = 2L) ) expect_equal( mutate(df, a = "x", y = df_n_col(across(where(is.numeric), identity))), tibble(a = "x", y = 0L) ) expect_equal( mutate(df, x = 1, y = df_n_col(across(where(is.numeric), identity))), tibble(a = 1, x = 1, y = 2L) ) }) test_that("across() retains original ordering", { df <- tibble(a = 1, b = 2) expect_named( mutate(df, a = 2, x = across(everything(), identity))$x, c("a", "b") ) }) test_that("across() throws meaningful error with failure during expansion (#6534)", { df <- tibble(g = 1, x = 1, y = 2, z = 3) gdf <- group_by(df, g) fn <- function() { stop("oh no!") } # Ends up failing inside the `fn()` call, which gets evaluated # during `across()` expansion but outside any group context expect_snapshot(error = TRUE, { summarise(df, across(everything(), fn())) }) expect_snapshot(error = TRUE, { summarise(df, across(everything(), fn()), .by = g) }) expect_snapshot(error = TRUE, { summarise(gdf, across(everything(), fn())) }) }) test_that("across() gives meaningful messages", { expect_snapshot({ # expanding (expect_error( tibble(x = 1) |> summarise(across(where(is.numeric), 42)) )) (expect_error( tibble(x = 1) |> summarise(across(y, mean)) )) # computing (expect_error( tibble(x = 1) |> summarise(res = across(where(is.numeric), 42)) )) (expect_error( tibble(x = 1) |> summarise(z = across(y, mean)) )) (expect_error( tibble(x = 1) |> summarise(res = sum(if_any(where(is.numeric), 42))) )) (expect_error( tibble(x = 1) |> summarise(res = sum(if_all(~ mean(.x)))) )) (expect_error( tibble(x = 1) |> summarise(res = sum(if_any(~ mean(.x)))) )) (expect_error(across())) (expect_error(c_across())) # problem while computing error_fn <- function(.) { if (all(. > 10)) { rlang::abort("too small", call = call("error_fn")) } else { 42 } } (expect_error( # expanding tibble(x = 1:10, y = 11:20) |> summarise(across(everything(), error_fn)) )) (expect_error( # expanding tibble(x = 1:10, y = 11:20) |> mutate(across(everything(), error_fn)) )) (expect_error( # evaluating tibble(x = 1:10, y = 11:20) |> summarise(force(across(everything(), error_fn))) )) (expect_error( # evaluating tibble(x = 1:10, y = 11:20) |> mutate(force(across(everything(), error_fn))) )) # name issue (expect_error( tibble(x = 1) |> summarise(across(everything(), list(f = mean, f = mean))) )) }) }) test_that("monitoring cache - across() can be used twice in the same expression", { df <- tibble(a = 1, b = 2) expect_equal( mutate( df, x = df_n_col(across(where(is.numeric), identity)) + df_n_col(across(a, identity)) ), tibble(a = 1, b = 2, x = 3) ) }) test_that("monitoring cache - across() can be used in separate expressions", { df <- tibble(a = 1, b = 2) expect_equal( mutate( df, x = df_n_col(across(where(is.numeric), identity)), y = df_n_col(across(a, identity)) ), tibble(a = 1, b = 2, x = 2, y = 1) ) }) test_that("monitoring cache - across() usage can depend on the group id", { df <- tibble(g = 1:2, a = 1:2, b = 3:4) df <- group_by(df, g) switcher <- function() { if_else(cur_group_id() == 1L, across(a, identity)$a, across(b, identity)$b) } expect <- df expect$x <- c(1L, 4L) expect_equal( mutate(df, x = switcher()), expect ) }) test_that("monitoring cache - across() internal cache key depends on all inputs", { df <- tibble(g = rep(1:2, each = 2), a = 1:4) df <- group_by(df, g) expect_identical( mutate( df, tibble( x = across(where(is.numeric), mean)$a, y = across(where(is.numeric), max)$a ) ), mutate(df, x = mean(a), y = max(a)) ) }) test_that("across() rejects non vectors", { expect_error( data.frame(x = 1) |> summarise(across(everything(), ~ sym("foo"))) ) }) test_that("across() uses tidy recycling rules", { expect_equal( data.frame(x = 1, y = 2) |> reframe(across(everything(), ~ rep(42, .))), data.frame(x = rep(42, 2), y = rep(42, 2)) ) expect_error( data.frame(x = 2, y = 3) |> reframe(across(everything(), ~ rep(42, .))) ) }) test_that("across() returns a data frame with 1 row (#5204)", { df <- tibble(x = 1:42) expect_equal( mutate(df, across(c(), as.factor)), df ) expect_equal( mutate(df, y = across(c(), as.factor))$y, tibble::new_tibble(list(), nrow = 42) ) mutate(df, { res <- across(c(), as.factor) expect_equal(nrow(res), 1L) res }) }) test_that("across(.names=) can use local variables in addition to {col} and {fn}", { res <- local({ prefix <- "MEAN" data.frame(x = 42) |> summarise(across(everything(), mean, .names = "{prefix}_{.col}")) }) expect_identical(res, data.frame(MEAN_x = 42)) }) test_that("across(.unpack=) can use local variables in addition to {outer} and {inner}", { fn <- function(x) { tibble(x = x, y = x + 1) } res <- local({ prefix <- "FN" data.frame(col1 = 42, col2 = 24) |> summarise(across(everything(), fn, .unpack = "{prefix}_{outer}_{inner}")) }) expect_identical( res, data.frame( FN_col1_x = 42, FN_col1_y = 43, FN_col2_x = 24, FN_col2_y = 25 ) ) }) test_that("across() uses environment from the current quosure (#5460)", { # If the data frame `y` is selected, causes a subscript conversion # error since it is fractional df <- data.frame(x = 1, y = 2.4) y <- "x" expect_equal(df |> summarise(across(all_of(y), mean)), data.frame(x = 1)) expect_equal(df |> mutate(across(all_of(y), mean)), df) expect_equal(df |> filter(if_all(all_of(y), ~ .x < 2)), df) # Inherited case expect_error(df |> summarise(local(across(all_of(y), mean)))) expect_equal( df |> summarise(summarise(pick(everything()), across(all_of(y), mean))), df |> summarise(across(all_of(y), mean)) ) }) test_that("across() sees columns in the recursive case (#5498)", { skip_if_not_installed("purrr") df <- tibble( vars = list("foo"), data = list(data.frame(foo = 1, bar = 2)) ) out <- df |> mutate( data = purrr::map2(data, vars, function(.x, .y) { .x |> mutate(across(all_of(.y), ~NA)) }) ) exp <- tibble( vars = list("foo"), data = list(data.frame(foo = NA, bar = 2)) ) expect_identical(out, exp) out <- df |> mutate( data = purrr::map2(data, vars, function(.x, .y) { local({ .y <- "bar" .x |> mutate(across(all_of(.y), ~NA)) }) }) ) exp <- tibble( vars = list("foo"), data = list(data.frame(foo = 1, bar = NA)) ) expect_identical(out, exp) }) test_that("across() works with empty data frames (#5523)", { expect_equal( mutate(tibble(), across(everything(), identity)), tibble() ) }) test_that("lambdas in mutate() + across() can use columns", { df <- tibble(x = 2, y = 4, z = 8) expect_identical( df |> mutate(data.frame(x = x / y, y = y / y, z = z / y)), df |> mutate(across(everything(), ~ .x / y)) ) expect_identical( df |> mutate(data.frame(x = x / y, y = y / y, z = z / y)), df |> mutate(+across(everything(), ~ .x / y)) ) expect_identical( df |> mutate(data.frame(x = x / y, y = y / y, z = z / y)), df |> mutate(across(everything(), ~ .x / .data$y)) ) expect_identical( df |> mutate(data.frame(x = x / y, y = y / y, z = z / y)), df |> mutate(+across(everything(), ~ .x / .data$y)) ) }) test_that("lambdas in summarise() + across() can use columns", { df <- tibble(x = 2, y = 4, z = 8) expect_identical( df |> summarise(data.frame(x = x / y, y = y / y, z = z / y)), df |> summarise(across(everything(), ~ .x / y)) ) expect_identical( df |> summarise(data.frame(x = x / y, y = y / y, z = z / y)), df |> summarise(+across(everything(), ~ .x / y)) ) expect_identical( df |> summarise(data.frame(x = x / y, y = y / y, z = z / y)), df |> summarise(across(everything(), ~ .x / .data$y)) ) expect_identical( df |> summarise(data.frame(x = x / y, y = y / y, z = z / y)), df |> summarise(+across(everything(), ~ .x / .data$y)) ) }) test_that("lambdas in mutate() + across() can use columns in follow up expressions (#5717)", { df <- tibble(x = 2, y = 4, z = 8) expect_identical( df |> mutate(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), df |> mutate(a = 2, across(c(x, y, z), ~ .x / y)) ) expect_identical( df |> mutate(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), df |> mutate(a = 2, +across(c(x, y, z), ~ .x / y)) ) expect_identical( df |> mutate(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), df |> mutate(a = 2, across(c(x, y, z), ~ .x / .data$y)) ) expect_identical( df |> mutate(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), df |> mutate(a = 2, +across(c(x, y, z), ~ .x / .data$y)) ) }) test_that("lambdas in summarise() + across() can use columns in follow up expressions (#5717)", { df <- tibble(x = 2, y = 4, z = 8) expect_identical( df |> summarise(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), df |> summarise(a = 2, across(c(x, y, z), ~ .x / y)) ) expect_identical( df |> summarise(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), df |> summarise(a = 2, +across(c(x, y, z), ~ .x / y)) ) expect_identical( df |> summarise(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), df |> summarise(a = 2, across(c(x, y, z), ~ .x / .data$y)) ) expect_identical( df |> summarise(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), df |> summarise(a = 2, +across(c(x, y, z), ~ .x / .data$y)) ) }) test_that("functions defined inline can use columns (#5734)", { df <- data.frame(x = 1, y = 2) expect_equal( df |> mutate(across('x', function(.x) .x / y)) |> pull(x), 0.5 ) }) test_that("if_any() and if_all() can be used in mutate() (#5709)", { d <- data.frame(x = c(1, 5, 10, 10), y = c(0, 0, 0, 10), z = c(10, 5, 1, 10)) res <- d |> mutate( any = if_any(x:z, ~ . > 8), all = if_all(x:z, ~ . > 8) ) expect_equal(res$any, c(TRUE, FALSE, TRUE, TRUE)) expect_equal(res$all, c(FALSE, FALSE, FALSE, TRUE)) }) test_that("across() caching not confused when used from if_any() and if_all() (#5782)", { res <- data.frame(x = 1:3) |> mutate( any = if_any(x, ~ . >= 2) + if_any(x, ~ . >= 3), all = if_all(x, ~ . >= 2) + if_all(x, ~ . >= 3) ) expect_equal(res$any, c(0, 1, 2)) expect_equal(res$all, c(0, 1, 2)) }) test_that("if_any() and if_all() respect filter()-like NA handling", { df <- expand.grid( x = c(TRUE, FALSE, NA), y = c(TRUE, FALSE, NA) ) expect_identical( filter(df, x & y), filter(df, if_all(c(x, y), identity)) ) expect_identical( filter(df, x | y), filter(df, if_any(c(x, y), identity)) ) }) test_that("if_any() and if_all() aborts when predicate mistakingly used in .cols= (#5732)", { df <- data.frame(x = 1:10, y = 1:10) expect_snapshot({ # expanded case (expect_error(filter(df, if_any(~ .x > 5)))) (expect_error(filter(df, if_all(~ .x > 5)))) # non expanded case (expect_error(filter(df, !if_any(~ .x > 5)))) (expect_error(filter(df, !if_all(~ .x > 5)))) }) }) test_that("across() correctly reset column", { expect_error(cur_column()) res <- data.frame(x = 1) |> summarise( a = { expect_error(cur_column()) 2 }, across( x, ~ { expect_equal(cur_column(), "x") 3 }, .names = "b" ), # top_across() c = { expect_error(cur_column()) 4 }, force(across( x, ~ { expect_equal(cur_column(), "x") 5 }, .names = "d" )), # across() e = { expect_error(cur_column()) 6 } ) expect_equal(res, data.frame(a = 2, b = 3, c = 4, d = 5, e = 6)) expect_error(cur_column()) res <- data.frame(x = 1) |> mutate( a = { expect_error(cur_column()) 2 }, # top_across() across( x, ~ { expect_equal(cur_column(), "x") 3 }, .names = "b" ), c = { expect_error(cur_column()) 4 }, # across() force(across( x, ~ { expect_equal(cur_column(), "x") 5 }, .names = "d" )), e = { expect_error(cur_column()) 6 } ) expect_equal(res, data.frame(x = 1, a = 2, b = 3, c = 4, d = 5, e = 6)) expect_error(cur_column()) }) test_that("across() can omit dots", { df <- tibble(x = tibble(foo = 1), y = tibble(foo = 2)) # top res <- mutate( df, across( everything(), list ) ) expect_equal(res$x[[1]]$foo, 1) expect_equal(res$y[[1]]$foo, 2) # not top res <- mutate( df, force(across( everything(), list )) ) expect_equal(res$x[[1]]$foo, 1) expect_equal(res$y[[1]]$foo, 2) }) test_that("group variables are in scope (#5832)", { f <- function(x, z) x + z gdf <- data.frame(x = 1:2, y = 3:4, g = 1:2) |> group_by(g) exp <- gdf |> summarise(x = f(x, z = y)) expect_equal( gdf |> summarise(across(x, ~ f(.x, z = y))), exp ) expect_equal( gdf |> summarise(across(x, ~ f(.x, z = y))), exp ) }) test_that("can pass quosure through `across()`", { summarise_mean <- function(data, vars) { data |> summarise(across({{ vars }}, mean)) } gdf <- data.frame(g = c(1, 1, 2), x = 1:3) |> group_by(g) expect_equal( gdf |> summarise_mean(where(is.numeric)), summarise(gdf, x = mean(x)) ) }) test_that("across() inlines formulas", { # Env of captured quosure passed to `as_across_fn_call()`. The # unevaluated lambdas should inherit from that env after inlining. env <- env() lambda <- quo_eval_fns(quo(function(x) fn(x)), mask = env) out <- as_across_fn_call(lambda, quote(var), env, env) expect_equal(out, new_quosure(quote(fn(var)), env)) formula <- quo_eval_fns(quo(~ fn(.x)), mask = env) out <- as_across_fn_call(formula, quote(var), env, env) expect_equal(out, new_quosure(quote(fn(var)), env)) # Evaluated formulas preserve their own env f <- local(~ fn(.x)) fn <- quo_eval_fns(quo(!!f), mask = env) out <- as_across_fn_call(fn, quote(var), env, env) expect_equal(get_env(f), get_env(fn)) expect_equal(out, new_quosure(call2(fn, quote(var)), env)) # Inlining is disabled for complex lambda calls fn <- quo_eval_fns(quo(function(x, y) x), mask = env) out <- as_across_fn_call(fn, quote(var), env, env) expect_equal(out, new_quosure(call2(fn, quote(var)), env)) # Formulas are converted to functions expect_rlang_lambda <- function(fn) { expect_s3_class(fn, "rlang_lambda_function") out <- as_across_fn_call(fn, quote(var), env, env) expect_equal(out, new_quosure(call2(fn, quote(var)), env)) } out <- quo_eval_fns(quo(~.y), mask = env) expect_rlang_lambda(out) out <- quo_eval_fns(quo(list(~.y)), mask = env) expect_type(out, "list") map(out, expect_rlang_lambda) # All formula-lambda arguments are interpolated fn <- quo_eval_fns(quo(~ list(.x, ., .x)), mask = env) out <- as_across_fn_call(fn, quote(var), env, env) expect_equal( out, new_quosure(quote(list(var, var, var)), f_env(f)) ) }) test_that("inlined and non inlined lambdas work", { df <- data.frame(foo = 1:2, bar = 100:101) exp <- data.frame(foo = c(101.5, 102.5), bar = c(200.5, 201.5)) expect_equal(df |> mutate(across(1:2, function(x) x + mean(bar))), exp) expect_equal(df |> mutate((across(1:2, function(x) x + mean(bar)))), exp) expect_equal(df |> mutate(across(1:2, ~ .x + mean(bar))), exp) expect_equal(df |> mutate((across(1:2, ~ .x + mean(bar)))), exp) expect_equal(df |> mutate(across(1:2, ~ ..1 + mean(bar))), exp) expect_equal(df |> mutate((across(1:2, ~ ..1 + mean(bar)))), exp) # Message generated by base R changed skip_if_not_installed("base", "3.6.0") expect_snapshot({ (expect_error(df |> mutate(across(1:2, ~ .y + mean(bar))))) (expect_error(df |> mutate((across(1:2, ~ .y + mean(bar)))))) }) }) test_that("list of lambdas work", { df <- data.frame(foo = 1:2, bar = 100:101) exp <- cbind( df, data.frame(foo_1 = c(101.5, 102.5), bar_1 = c(200.5, 201.5)) ) expect_equal(df |> mutate(across(1:2, list(function(x) x + mean(bar)))), exp) expect_equal( df |> mutate((across(1:2, list(function(x) x + mean(bar))))), exp ) expect_equal(df |> mutate(across(1:2, list(~ .x + mean(bar)))), exp) expect_equal(df |> mutate((across(1:2, list(~ .x + mean(bar))))), exp) }) test_that("anonymous function `.fns` can access the `.data` pronoun even when not inlined", { df <- tibble(x = 1:2, y = 3:4) # Can't access it here, `fn()`'s environment doesn't know about `.data` fn <- function(col) { .data[["x"]] } expect_snapshot(error = TRUE, { mutate(df, across(y, fn)) }) # Can access it with inlinable quosures out <- mutate( df, across(y, function(col) { .data[["x"]] }) ) expect_identical(out$y, out$x) # Can access it with non-inlinable quosures out <- mutate( df, across(y, function(col) { return(.data[["x"]]) }) ) expect_identical(out$y, out$x) }) test_that("across() uses local formula environment (#5881)", { f <- local({ prefix <- "foo" ~ paste(prefix, .x) }) df <- tibble(x = "x") expect_equal( mutate(df, across(x, f)), tibble(x = "foo x") ) expect_equal( mutate(df, across(x, list(f = f))), tibble(x = "x", x_f = "foo x") ) local({ # local() here is not necessary, it's just in case the # code is run directly without the test_that() prefix <- "foo" expect_equal( mutate(df, across(x, ~ paste(prefix, .x))), tibble(x = "foo x") ) expect_equal( mutate(df, across(x, list(f = ~ paste(prefix, .x)))), tibble(x = "x", x_f = "foo x") ) }) expect_equal( data.frame(x = 1) |> mutate(across(1, list(f = local(~ . + 1)))), data.frame(x = 1, x_f = 2) ) expect_equal( data.frame(x = 1) |> mutate(across( 1, local({ `_local_var` <- 1 ~ . + `_local_var` }) )), data.frame(x = 2) ) }) test_that("unevaluated formulas (currently) fail", { df <- tibble(x = "x") expect_error( mutate(df, across(x, quote(~ paste("foo", .x)))) ) }) test_that("across() can access lexical scope (#5862)", { f_across <- function(data, cols, fn) { data |> summarise( across({{ cols }}, fn) ) } df <- data.frame(x = 1:10, y = 1:10) expect_equal( f_across(df, c(x, y), mean), summarise(df, across(c(x, y), mean)) ) }) test_that("across() allows renaming in `.cols` (#6895)", { df <- tibble(x = 1, y = 2, z = 3) cols <- set_names(c("x", "y"), c("a", "b")) expect_identical( mutate(df, across(all_of(cols), identity)), mutate(df, a = x, b = y) ) expect_identical( mutate(df, (across(all_of(cols), identity))), mutate(df, a = x, b = y) ) expect_identical( mutate(df, across(all_of(cols), identity, .names = "{.col}_name")), mutate(df, a_name = x, b_name = y) ) expect_identical( mutate(df, (across(all_of(cols), identity, .names = "{.col}_name"))), mutate(df, a_name = x, b_name = y) ) }) test_that("if_any() and if_all() expansions deal with no inputs or single inputs", { d <- data.frame(x = 1) # No inputs expect_equal( filter(d, if_any(starts_with("c"), ~FALSE)), filter(d, FALSE) ) expect_equal( filter(d, if_all(starts_with("c"), ~FALSE)), filter(d) ) # Single inputs expect_equal( filter(d, if_any(x, ~FALSE)), filter(d, FALSE) ) expect_equal( filter(d, if_all(x, ~FALSE)), filter(d, FALSE) ) }) test_that("if_any() on zero-column selection behaves like any() (#7059, #7077)", { tbl <- tibble( x1 = 1:5, x2 = c(-1, 4, 5, 4, 1), y = c(1, 4, 2, 4, 9), ) expect_equal( filter(tbl, if_any(c(), ~FALSE)), filter(tbl, FALSE) ) expect_equal( filter(tbl, if_any(c(), ~TRUE)), filter(tbl, FALSE) ) expect_equal( pull(mutate(tbl, z = if_any(c(), ~FALSE)), z), rep(FALSE, nrow(tbl)) ) expect_equal( pull(mutate(tbl, z = if_any(c(), ~TRUE)), z), rep(FALSE, nrow(tbl)) ) }) test_that("if_all() on zero-column selection behaves like all() (#7059, #7077)", { tbl <- tibble( x1 = 1:5, x2 = c(-1, 4, 5, 4, 1), y = c(1, 4, 2, 4, 9), ) expect_equal( filter(tbl, if_all(c(), ~FALSE)), filter(tbl, TRUE) ) expect_equal( filter(tbl, if_all(c(), ~TRUE)), filter(tbl, TRUE) ) expect_equal( pull(mutate(tbl, z = if_all(c(), ~FALSE)), z), rep(TRUE, nrow(tbl)) ) expect_equal( pull(mutate(tbl, z = if_all(c(), ~TRUE)), z), rep(TRUE, nrow(tbl)) ) }) test_that("if_any() and if_all() wrapped deal with no inputs or single inputs", { d <- data.frame(x = 1) # No inputs expect_equal( filter(d, (if_any(starts_with("c"), ~FALSE))), filter(d, FALSE) ) expect_equal( filter(d, (if_all(starts_with("c"), ~FALSE))), filter(d, TRUE) ) # Single inputs expect_equal( filter(d, (if_any(x, ~FALSE))), filter(d, FALSE) ) expect_equal( filter(d, (if_all(x, ~FALSE))), filter(d, FALSE) ) expect_equal( filter(d, (if_any(x, ~TRUE))), filter(d, TRUE) ) expect_equal( filter(d, (if_all(x, ~TRUE))), filter(d, TRUE) ) }) test_that("expanded if_any() finds local data", { limit <- 7 df <- data.frame(x = 1:10, y = 10:1) expect_identical( filter(df, if_any(everything(), ~ .x > limit)), filter(df, x > limit | y > limit) ) }) test_that("across() can use named selections", { df <- data.frame(x = 1, y = 2) # no fns expect_equal( df |> summarise(across(c(a = x, b = y))), data.frame(a = 1, b = 2) ) expect_equal( df |> summarise(across(all_of(c(a = "x", b = "y")))), data.frame(a = 1, b = 2) ) # no fns, non expanded expect_equal( df |> summarise((across(c(a = x, b = y)))), data.frame(a = 1, b = 2) ) expect_equal( df |> summarise((across(all_of(c(a = "x", b = "y"))))), data.frame(a = 1, b = 2) ) # one fn expect_equal( df |> summarise(across(c(a = x, b = y), mean)), data.frame(a = 1, b = 2) ) expect_equal( df |> summarise(across(all_of(c(a = "x", b = "y")), mean)), data.frame(a = 1, b = 2) ) # one fn - non expanded expect_equal( df |> summarise((across(c(a = x, b = y), mean))), data.frame(a = 1, b = 2) ) expect_equal( df |> summarise((across(all_of(c(a = "x", b = "y")), mean))), data.frame(a = 1, b = 2) ) # multiple fns expect_equal( df |> summarise(across(c(a = x, b = y), list(mean = mean, sum = sum))), data.frame(a_mean = 1, a_sum = 1, b_mean = 2, b_sum = 2) ) expect_equal( df |> summarise(across( all_of(c(a = "x", b = "y")), list(mean = mean, sum = sum) )), data.frame(a_mean = 1, a_sum = 1, b_mean = 2, b_sum = 2) ) # multiple fns - non expanded expect_equal( df |> summarise((across(c(a = x, b = y), list(mean = mean, sum = sum)))), data.frame(a_mean = 1, a_sum = 1, b_mean = 2, b_sum = 2) ) expect_equal( df |> summarise( (across(all_of(c(a = "x", b = "y")), list(mean = mean, sum = sum))) ), data.frame(a_mean = 1, a_sum = 1, b_mean = 2, b_sum = 2) ) }) test_that("expr_subtitute() stops at lambdas (#5896)", { expect_identical( expr_substitute(expr(map(.x, ~ mean(.x))), quote(.x), quote(a)), expr(map(a, ~ mean(.x))) ) expect_identical( expr_substitute(expr(map(.x, function(.x) mean(.x))), quote(.x), quote(a)), expr(map(a, function(.x) mean(.x))) ) }) test_that("expr_subtitute() keeps at double-sided formula (#5894)", { expect_identical( expr_substitute( expr(case_when(.x < 5 ~ 5, .default = .x)), quote(.x), quote(a) ), expr(case_when(a < 5 ~ 5, .default = a)) ) expect_identical( expr_substitute( expr(case_when(. < 5 ~ 5, .default = .)), quote(.), quote(a) ), expr(case_when(a < 5 ~ 5, .default = a)) ) }) test_that("across() predicates operate on whole data", { df <- tibble( x = c(1, 1, 2), g = c(1, 1, 2) ) out <- df |> mutate(across(where(~ n_distinct(.x) > 1), ~ .x + 10)) exp <- tibble( x = c(11, 11, 12), g = c(11, 11, 12) ) expect_equal(out, exp) out <- df |> group_by(g) |> mutate(across(where(~ n_distinct(.x) > 1), ~ .x + 10)) exp <- tibble( x = c(11, 11, 12), g = c(1, 1, 2) ) |> group_by(g) expect_equal(out, exp) }) test_that("expand_across() expands lambdas", { quo <- quo(across(c(cyl, am), ~ identity(.x))) quo <- new_dplyr_quosure( quo, name = quo, is_named = FALSE, index = 1 ) by <- compute_by(by = NULL, data = mtcars, error_call = call("caller")) DataMask$new(mtcars, by, "mutate", call("caller")) expect_equal( map(expand_across(quo), quo_get_expr), exprs( cyl = identity(cyl), am = identity(am) ) ) }) test_that("expand_if_across() expands lambdas", { quo <- quo(if_any(c(cyl, am), ~ . > 4)) quo <- new_dplyr_quosure( quo, name = quo, is_named = FALSE, index = 1 ) by <- compute_by(by = NULL, data = mtcars, error_call = call("caller")) DataMask$new(mtcars, by, "mutate", call("caller")) quo <- expand_if_across(quo) # We just need to look for something we know we insert into the expression. # `expect_snapshot()` doesn't seem to play nicely with covr on CI here, the # expression captured seems to contain `covr:::count()` calls. expect_true( grepl( "asNamespace", paste0(expr_deparse(quo_squash(quo)), collapse = " ") ) ) }) test_that("rowwise() preserves list-cols iff no `.fns` (#5951, #6264)", { # TODO: Deprecate this behavior in favor of `pick()`, which doesn't preserve # list-cols but is well-defined as pure macro expansion. rf <- rowwise(tibble(x = list(1:2, 3:5))) # Need to unchop so works like mutate(rf, x = length(x)) out <- mutate(rf, across(everything(), length)) expect_equal(out$x, c(2, 3)) # Need to preserve to create valid data frame out <- mutate(rf, across = list(across(everything()))) expect_equal( out$across, list( tibble(x = list(1:2)), tibble(x = list(3:5)) ) ) }) test_that("`across()` recycle `.fns` results to common size", { df <- tibble( x = c(TRUE, FALSE, TRUE), y = c(1L, 2L, 3L) ) # The `.fns` results are recycled within just the `across()` inputs first, not # immediately to the whole group size. The returned data frame from `across()` # is what is then recycled to the whole group size. fn <- function(x) { if (is.logical(x)) { x } else { TRUE } } expect_identical( mutate(df, across(c(x, y), fn)), tibble(x = df$x, y = rep(TRUE, times = nrow(df))) ) expect_identical( mutate(df, (across(c(x, y), fn))), tibble(x = df$x, y = rep(TRUE, times = nrow(df))) ) # Not forcing the result of `.fns` to immediately recycle to the group size is # useful for niche cases where you want to compute something with `across()` # but it isn't actually what you return fn <- function(x) { c(mean(x), median(x)) } expect_identical( mutate(df, { # Maybe your `across()` call returns something of length 2 values <- across(c(x, y), fn) # But then you manipulate it to return something compatible with the group size new_tibble(map(values, max)) }), tibble(x = c(1, 1, 1), y = c(2, 2, 2)) ) # Unrecyclable expect_snapshot(error = TRUE, { # TODO: This error is bad mutate(df, across(c(x, y), fn)) }) expect_snapshot(error = TRUE, { mutate(df, (across(c(x, y), fn))) }) }) test_that("`if_any()` and `if_all()` have consistent behavior across `filter()` and `mutate()`", { # Tests a full suite comparing: # - `filter()` vs `mutate()` # - `filter()`'s evaluation vs expansion models # - With and without `.fns` # `w` and `x` cover all combinations of `|` and `&` df <- data.frame( w = c(TRUE, FALSE, NA, TRUE, FALSE, TRUE, FALSE, NA, NA), x = c(TRUE, FALSE, NA, FALSE, TRUE, NA, NA, TRUE, FALSE), y = 1:9, z = 10:18, g = c("a", "b", "a", "b", "b", "a", "c", "a", "a") ) # Zero inputs expect_identical( filter(df, if_any(c())), filter(df, FALSE) ) expect_identical( filter(df, (if_any(c()))), filter(df, FALSE) ) expect_identical( mutate(df, a = if_any(c())), mutate(df, a = FALSE) ) expect_identical( filter(df, if_any(c(), identity)), filter(df, FALSE) ) expect_identical( filter(df, (if_any(c(), identity))), filter(df, FALSE) ) expect_identical( mutate(df, a = if_any(c(), identity)), mutate(df, a = FALSE) ) expect_identical( filter(df, if_all(c())), filter(df, TRUE) ) expect_identical( filter(df, (if_all(c()))), filter(df, TRUE) ) expect_identical( mutate(df, a = if_all(c())), mutate(df, a = TRUE) ) expect_identical( filter(df, if_all(c(), identity)), filter(df, TRUE) ) expect_identical( filter(df, (if_all(c(), identity))), filter(df, TRUE) ) expect_identical( mutate(df, a = if_all(c(), identity)), mutate(df, a = TRUE) ) # One input expect_identical( filter(df, if_any(w)), filter(df, w) ) expect_identical( filter(df, (if_any(w))), filter(df, w) ) expect_identical( mutate(df, a = if_any(w)), mutate(df, a = w) ) expect_identical( filter(df, if_any(w, identity)), filter(df, w) ) expect_identical( filter(df, (if_any(w, identity))), filter(df, w) ) expect_identical( mutate(df, a = if_any(w, identity)), mutate(df, a = w) ) expect_identical( filter(df, if_all(w)), filter(df, w) ) expect_identical( filter(df, (if_all(w))), filter(df, w) ) expect_identical( mutate(df, a = if_all(w)), mutate(df, a = w) ) expect_identical( filter(df, if_all(w, identity)), filter(df, w) ) expect_identical( filter(df, (if_all(w, identity))), filter(df, w) ) expect_identical( mutate(df, a = if_all(w, identity)), mutate(df, a = w) ) # Two inputs expect_identical( filter(df, if_any(c(w, x))), filter(df, w | x) ) expect_identical( filter(df, (if_any(c(w, x)))), filter(df, w | x) ) expect_identical( mutate(df, a = if_any(c(w, x))), mutate(df, a = w | x) ) expect_identical( filter(df, if_any(c(w, x), identity)), filter(df, w | x) ) expect_identical( filter(df, (if_any(c(w, x), identity))), filter(df, w | x) ) expect_identical( mutate(df, a = if_any(c(w, x), identity)), mutate(df, a = w | x) ) expect_identical( filter(df, if_all(c(w, x))), filter(df, w & x) ) expect_identical( filter(df, (if_all(c(w, x)))), filter(df, w & x) ) expect_identical( mutate(df, a = if_all(c(w, x))), mutate(df, a = w & x) ) expect_identical( filter(df, if_all(c(w, x), identity)), filter(df, w & x) ) expect_identical( filter(df, (if_all(c(w, x), identity))), filter(df, w & x) ) expect_identical( mutate(df, a = if_all(c(w, x), identity)), mutate(df, a = w & x) ) # Two inputs (grouped) expect_identical( filter(df, if_any(c(w, x)), .by = g), filter(df, w | x, .by = g) ) expect_identical( filter(df, (if_any(c(w, x))), .by = g), filter(df, w | x, .by = g) ) expect_identical( mutate(df, a = if_any(c(w, x)), .by = g), mutate(df, a = w | x, .by = g) ) expect_identical( filter(df, if_any(c(w, x), identity), .by = g), filter(df, w | x, .by = g) ) expect_identical( filter(df, (if_any(c(w, x), identity)), .by = g), filter(df, w | x, .by = g) ) expect_identical( mutate(df, a = if_any(c(w, x), identity), .by = g), mutate(df, a = w | x, .by = g) ) expect_identical( filter(df, if_all(c(w, x)), .by = g), filter(df, w & x, .by = g) ) expect_identical( filter(df, (if_all(c(w, x))), .by = g), filter(df, w & x, .by = g) ) expect_identical( mutate(df, a = if_all(c(w, x)), .by = g), mutate(df, a = w & x, .by = g) ) expect_identical( filter(df, if_all(c(w, x), identity), .by = g), filter(df, w & x, .by = g) ) expect_identical( filter(df, (if_all(c(w, x), identity)), .by = g), filter(df, w & x, .by = g) ) expect_identical( mutate(df, a = if_all(c(w, x), identity), .by = g), mutate(df, a = w & x, .by = g) ) # One non-logical input (all error) expect_snapshot(error = TRUE, filter(df, if_any(y))) expect_snapshot(error = TRUE, filter(df, (if_any(y)))) expect_snapshot(error = TRUE, mutate(df, a = if_any(y))) expect_snapshot(error = TRUE, filter(df, if_any(y, identity))) expect_snapshot(error = TRUE, filter(df, (if_any(y, identity)))) expect_snapshot(error = TRUE, mutate(df, a = if_any(y, identity))) expect_snapshot(error = TRUE, filter(df, if_all(y))) expect_snapshot(error = TRUE, filter(df, (if_all(y)))) expect_snapshot(error = TRUE, mutate(df, a = if_all(y))) expect_snapshot(error = TRUE, filter(df, if_all(y, identity))) expect_snapshot(error = TRUE, filter(df, (if_all(y, identity)))) expect_snapshot(error = TRUE, mutate(df, a = if_all(y, identity))) # Two non-logical inputs (all error) expect_snapshot(error = TRUE, filter(df, if_any(c(y, z)))) expect_snapshot(error = TRUE, filter(df, (if_any(c(y, z))))) expect_snapshot(error = TRUE, mutate(df, a = if_any(c(y, z)))) expect_snapshot(error = TRUE, filter(df, if_any(c(y, z), identity))) expect_snapshot(error = TRUE, filter(df, (if_any(c(y, z), identity)))) expect_snapshot(error = TRUE, mutate(df, a = if_any(c(y, z), identity))) expect_snapshot(error = TRUE, filter(df, if_all(c(y, z)))) expect_snapshot(error = TRUE, filter(df, (if_all(c(y, z))))) expect_snapshot(error = TRUE, mutate(df, a = if_all(c(y, z)))) expect_snapshot(error = TRUE, filter(df, if_all(c(y, z), identity))) expect_snapshot(error = TRUE, filter(df, (if_all(c(y, z), identity)))) expect_snapshot(error = TRUE, mutate(df, a = if_all(c(y, z), identity))) # Two non-logical inputs (grouped) (all error) expect_snapshot(error = TRUE, { filter(df, if_any(c(y, z)), .by = g) }) expect_snapshot(error = TRUE, { filter(df, (if_any(c(y, z))), .by = g) }) expect_snapshot(error = TRUE, { mutate(df, a = if_any(c(y, z)), .by = g) }) expect_snapshot(error = TRUE, { filter(df, if_any(c(y, z), identity), .by = g) }) expect_snapshot(error = TRUE, { filter(df, (if_any(c(y, z), identity)), .by = g) }) expect_snapshot(error = TRUE, { mutate(df, a = if_any(c(y, z), identity), .by = g) }) expect_snapshot(error = TRUE, { filter(df, if_all(c(y, z)), .by = g) }) expect_snapshot(error = TRUE, { filter(df, (if_all(c(y, z))), .by = g) }) expect_snapshot(error = TRUE, { mutate(df, a = if_all(c(y, z)), .by = g) }) expect_snapshot(error = TRUE, { filter(df, if_all(c(y, z), identity), .by = g) }) expect_snapshot(error = TRUE, { filter(df, (if_all(c(y, z), identity)), .by = g) }) expect_snapshot(error = TRUE, { mutate(df, a = if_all(c(y, z), identity), .by = g) }) }) test_that("`if_any()` and `if_all()` recycle `.fns` results to common size", { df <- data.frame( x = c(TRUE, FALSE, NA), y = c(1L, 2L, 3L) ) # `.fns` results recycle. Both `across()` and `if_any()`/`if_all()` recycle to # a common size amongst their inputs (here, size 1), then that data frame is # recycled to the group size. fn <- function(x) { if (is.logical(x)) { c(TRUE, FALSE, TRUE) } else { TRUE } } expect_identical( filter(df, if_any(c(x, y), fn)), filter(df, TRUE) ) expect_identical( filter(df, (if_any(c(x, y), fn))), filter(df, TRUE) ) expect_identical( mutate(df, a = if_any(c(x, y), fn)), mutate(df, a = TRUE) ) expect_identical( filter(df, if_all(c(x, y), fn)), filter(df, c(TRUE, FALSE, TRUE)) ) expect_identical( filter(df, (if_all(c(x, y), fn))), filter(df, c(TRUE, FALSE, TRUE)) ) expect_identical( mutate(df, a = if_all(c(x, y), fn)), mutate(df, a = c(TRUE, FALSE, TRUE)) ) # Unrecyclable (all error, can't recycle to group size) # It is correct that these show `..1` in the error for `filter()`. The error # is about recycling of the result of `if_any()`, i.e. the data frame in the # 1st argument slot. fn <- function(x) c(TRUE, FALSE) expect_snapshot(error = TRUE, filter(df, if_any(c(x, y), fn))) expect_snapshot(error = TRUE, filter(df, (if_any(c(x, y), fn)))) expect_snapshot(error = TRUE, mutate(df, a = if_any(c(x, y), fn))) expect_snapshot(error = TRUE, filter(df, if_all(c(x, y), fn))) expect_snapshot(error = TRUE, filter(df, (if_all(c(x, y), fn)))) expect_snapshot(error = TRUE, mutate(df, a = if_all(c(x, y), fn))) }) # c_across ---------------------------------------------------------------- test_that("selects and combines columns", { df <- data.frame(x = 1:2, y = 3:4) out <- df |> summarise(z = list(c_across(x:y))) expect_equal(out$z, list(1:4)) }) test_that("can't rename during selection (#6522)", { df <- tibble(x = 1) expect_snapshot(error = TRUE, { mutate(df, z = c_across(c(y = x))) }) }) test_that("can't explicitly select grouping columns (#6522)", { # Related to removing the mask layer from the quosure environments df <- tibble(g = 1, x = 2) gdf <- group_by(df, g) expect_snapshot(error = TRUE, { mutate(gdf, y = c_across(g)) }) }) test_that("`all_of()` is evaluated in the correct environment (#6522)", { # Related to removing the mask layer from the quosure environments df <- tibble(x = 1, y = 2) # We expect an "object not found" error, but we don't control that # so we aren't going to snapshot it, especially since the call reported # by those kinds of errors changed in R 4.3. expect_error(mutate(df, z = c_across(all_of(y)))) y <- "x" expect <- df[["x"]] out <- mutate(df, z = c_across(all_of(y))) expect_identical(out$z, expect) }) # cols deprecation -------------------------------------------------------- test_that("across() applies old `.cols = everything()` default with a warning", { local_options(lifecycle_verbosity = "warning") df <- tibble(g = c(1, 2), x = c(1, 2), y = c(3, 4)) gdf <- group_by(df, g) times_two <- function(x) x * 2 # Expansion path expect_snapshot(out <- mutate(df, across(.fns = times_two))) expect_identical(out$g, df$g * 2) expect_identical(out$x, df$x * 2) expect_identical(out$y, df$y * 2) expect_snapshot(out <- mutate(gdf, across(.fns = times_two))) expect_identical(out$g, df$g) expect_identical(out$x, df$x * 2) expect_identical(out$y, df$y * 2) # Evaluation path expect_snapshot(out <- mutate(df, (across(.fns = times_two)))) expect_identical(out$g, df$g * 2) expect_identical(out$x, df$x * 2) expect_identical(out$y, df$y * 2) expect_snapshot(out <- mutate(gdf, (across(.fns = times_two)))) expect_identical(out$g, df$g) expect_identical(out$x, df$x * 2) expect_identical(out$y, df$y * 2) }) test_that("if_any() and if_all() apply old `.cols = everything()` default with a warning", { local_options(lifecycle_verbosity = "warning") df <- tibble(x = c(TRUE, FALSE, TRUE), y = c(FALSE, FALSE, TRUE)) gdf <- mutate(df, g = c(1, 1, 2), .before = 1) gdf <- group_by(gdf, g) # Expansion path expect_snapshot(out <- filter(df, if_any())) expect_identical(out, df[c(1, 3), ]) expect_snapshot(out <- filter(gdf, if_any())) expect_identical(out, gdf[c(1, 3), ]) expect_snapshot(out <- filter(df, if_all())) expect_identical(out, df[3, ]) expect_snapshot(out <- filter(gdf, if_all())) expect_identical(out, gdf[3, ]) # Evaluation path expect_snapshot(out <- filter(df, (if_any()))) expect_identical(out, df[c(1, 3), ]) expect_snapshot(out <- filter(gdf, (if_any()))) expect_identical(out, gdf[c(1, 3), ]) expect_snapshot(out <- filter(df, (if_all()))) expect_identical(out, df[3, ]) expect_snapshot(out <- filter(gdf, (if_all()))) expect_identical(out, gdf[3, ]) }) test_that("c_across() applies old `cols = everything()` default with a warning", { local_options(lifecycle_verbosity = "warning") df <- tibble(x = c(1, 3), y = c(2, 4)) df <- rowwise(df) # Will see 2 warnings because verbosity option forces it to warn every time expect_snapshot(out <- mutate(df, z = sum(c_across()))) expect_identical(out$z, c(3, 7)) }) # fns deprecation --------------------------------------------------------- test_that("across() applies old `.fns = NULL` default", { df <- tibble(x = 1, y = 2) # Expansion path out <- mutate(df, z = across(everything())) expect_identical(out$z, df) # Evaluation path out <- mutate(df, z = (across(everything()))) expect_identical(out$z, df) }) test_that("if_any() and if_all() apply old `.fns = NULL` default", { df <- tibble(x = c(TRUE, FALSE, TRUE), y = c(FALSE, FALSE, TRUE)) # Expansion path expect_identical(filter(df, if_any(everything())), df[c(1, 3), ]) expect_identical(filter(df, if_all(everything())), df[3, ]) # Evaluation path expect_identical(filter(df, (if_any(everything()))), df[c(1, 3), ]) expect_identical(filter(df, (if_all(everything()))), df[3, ]) }) test_that("across errors with non-empty dots and no `.fns` supplied (#6638)", { df <- tibble(x = 1) expect_snapshot( error = TRUE, mutate(df, across(x, .funs = ~ . * 1000)) ) }) # dots -------------------------------------------------------------------- test_that("across(...) is deprecated", { df <- tibble(x = c(1, NA)) expect_snapshot(summarise(df, across(everything(), mean, na.rm = TRUE))) }) test_that("across() passes ... to functions", { options(lifecycle_verbosity = "quiet") df <- tibble(x = c(1, NA)) expect_equal( summarise(df, across(everything(), mean, na.rm = TRUE)), tibble(x = 1) ) expect_equal( summarise( df, across(everything(), list(mean = mean, median = median), na.rm = TRUE) ), tibble(x_mean = 1, x_median = 1) ) }) test_that("across() passes unnamed arguments following .fns as ... (#4965)", { options(lifecycle_verbosity = "quiet") df <- tibble(x = 1) expect_equal(mutate(df, across(x, `+`, 1)), tibble(x = 2)) }) test_that("across() avoids simple argument name collisions with ... (#4965)", { options(lifecycle_verbosity = "quiet") df <- tibble(x = c(1, 2)) expect_equal(summarize(df, across(x, tail, n = 1)), tibble(x = 2)) }) test_that("across() evaluates ... with promise semantics (#5813)", { options(lifecycle_verbosity = "quiet") df <- tibble(x = tibble(foo = 1), y = tibble(foo = 2)) res <- mutate( df, across(everything(), mutate, foo = foo + 1) ) expect_equal(res$x$foo, 2) expect_equal(res$y$foo, 3) # Dots are evaluated only once new_counter <- function() { n <- 0L function() { n <<- n + 1L n } } counter <- new_counter() list_second <- function(...) { list(..2) } res <- mutate( df, across(everything(), list_second, counter()) ) expect_equal(res$x[[1]], 1) expect_equal(res$y[[1]], 1) }) test_that("arguments in dots are evaluated once per group", { options(lifecycle_verbosity = "quiet") set.seed(0) out <- data.frame(g = 1:3, var = NA) |> group_by(g) |> mutate(across(var, function(x, y) y, rnorm(1))) |> pull(var) set.seed(0) expect_equal(out, rnorm(3)) }) test_that("group variables are in scope when passed in dots (#5832)", { options(lifecycle_verbosity = "quiet") f <- function(x, z) x + z gdf <- data.frame(x = 1:2, y = 3:4, g = 1:2) |> group_by(g) exp <- gdf |> summarise(x = f(x, z = y)) expect_equal( gdf |> summarise(across(x, f, z = y)), exp ) expect_equal( gdf |> summarise((across(x, f, z = y))), exp ) }) test_that("symbols are looked up as list or functions (#6545)", { df <- tibble(mean = 1:5) exp <- summarise(df, across(everything(), function(x) mean(x))) expect_equal( summarise(df, across(everything(), mean)), exp ) expect_equal( summarise(df, (across(everything(), mean))), exp ) exp <- summarise(df, across(everything(), list(function(x) mean(x)))) expect_equal( summarize(df, across(everything(), list(mean))), exp ) expect_equal( summarize(df, (across(everything(), list(mean)))), exp ) }) test_that("non-inlinable but maskable lambdas give precedence to function arguments", { df <- data.frame( foo = 1, bar = "a" ) out <- mutate(df, across(1:2, function(foo) return(foo))) expect_equal(out, df) }) test_that("maskable lambdas can refer to their lexical environment", { foo <- "OK" df <- tibble(bar = "a") # Non-inlinable expect_equal( mutate(df, across(1, function(x) return(paste(x, foo)))), tibble(bar = "a OK") ) expect_equal( mutate(df, across(1, ~ return(paste(.x, foo)))), tibble(bar = "a OK") ) # Inlinable expect_equal( mutate(df, across(1, function(x) paste(x, foo))), tibble(bar = "a OK") ) expect_equal( mutate(df, across(1, ~ paste(.x, foo))), tibble(bar = "a OK") ) })