1# across ------------------------------------------------------------------ 2 3test_that("across() works on one column data.frame", { 4 df <- data.frame(x = 1) 5 6 out <- df %>% mutate(across()) 7 expect_equal(out, df) 8}) 9 10test_that("across() does not select grouping variables", { 11 df <- data.frame(g = 1, x = 1) 12 13 out <- df %>% group_by(g) %>% summarise(x = across(everything())) %>% pull() 14 expect_equal(out, tibble(x = 1)) 15}) 16 17test_that("across() correctly names output columns", { 18 gf <- tibble(x = 1, y = 2, z = 3, s = "") %>% group_by(x) 19 20 expect_named( 21 summarise(gf, across()), 22 c("x", "y", "z", "s") 23 ) 24 expect_named( 25 summarise(gf, across(.names = "id_{.col}")), 26 c("x", "id_y", "id_z", "id_s") 27 ) 28 expect_named( 29 summarise(gf, across(where(is.numeric), mean)), 30 c("x", "y", "z") 31 ) 32 expect_named( 33 summarise(gf, across(where(is.numeric), mean, .names = "mean_{.col}")), 34 c("x", "mean_y", "mean_z") 35 ) 36 expect_named( 37 summarise(gf, across(where(is.numeric), list(mean = mean, sum = sum))), 38 c("x", "y_mean", "y_sum", "z_mean", "z_sum") 39 ) 40 expect_named( 41 summarise(gf, across(where(is.numeric), list(mean = mean, sum))), 42 c("x", "y_mean", "y_2", "z_mean", "z_2") 43 ) 44 expect_named( 45 summarise(gf, across(where(is.numeric), list(mean, sum = sum))), 46 c("x", "y_1", "y_sum", "z_1", "z_sum") 47 ) 48 expect_named( 49 summarise(gf, across(where(is.numeric), list(mean, sum))), 50 c("x", "y_1", "y_2", "z_1", "z_2") 51 ) 52 expect_named( 53 summarise(gf, across(where(is.numeric), list(mean = mean, sum = sum), .names = "{.fn}_{.col}")), 54 c("x", "mean_y", "sum_y", "mean_z", "sum_z") 55 ) 56}) 57 58test_that("across() result locations are aligned with column names (#4967)", { 59 df <- tibble(x = 1:2, y = c("a", "b")) 60 expect <- tibble(x_cls = "integer", x_type = TRUE, y_cls = "character", y_type = FALSE) 61 62 x <- summarise(df, across(everything(), list(cls = class, type = is.numeric))) 63 64 expect_identical(x, expect) 65}) 66 67test_that("across() passes ... to functions", { 68 df <- tibble(x = c(1, NA)) 69 expect_equal( 70 summarise(df, across(everything(), mean, na.rm = TRUE)), 71 tibble(x = 1) 72 ) 73 expect_equal( 74 summarise(df, across(everything(), list(mean = mean, median = median), na.rm = TRUE)), 75 tibble(x_mean = 1, x_median = 1) 76 ) 77}) 78 79test_that("across() passes unnamed arguments following .fns as ... (#4965)", { 80 df <- tibble(x = 1) 81 expect_equal(mutate(df, across(x, `+`, 1)), tibble(x = 2)) 82}) 83 84test_that("across() avoids simple argument name collisions with ... (#4965)", { 85 df <- tibble(x = c(1, 2)) 86 expect_equal(summarize(df, across(x, tail, n = 1)), tibble(x = 2)) 87}) 88 89test_that("across() works sequentially (#4907)", { 90 df <- tibble(a = 1) 91 expect_equal( 92 mutate(df, x = ncol(across(where(is.numeric))), y = ncol(across(where(is.numeric)))), 93 tibble(a = 1, x = 1L, y = 2L) 94 ) 95 expect_equal( 96 mutate(df, a = "x", y = ncol(across(where(is.numeric)))), 97 tibble(a = "x", y = 0L) 98 ) 99 expect_equal( 100 mutate(df, x = 1, y = ncol(across(where(is.numeric)))), 101 tibble(a = 1, x = 1, y = 2L) 102 ) 103}) 104 105test_that("across() retains original ordering", { 106 df <- tibble(a = 1, b = 2) 107 expect_named(mutate(df, a = 2, x = across())$x, c("a", "b")) 108}) 109 110test_that("across() gives meaningful messages", { 111 expect_snapshot(error = TRUE, 112 tibble(x = 1) %>% 113 summarise(res = across(where(is.numeric), 42)) 114 ) 115 expect_snapshot(error = TRUE, across()) 116 expect_snapshot(error = TRUE, c_across()) 117}) 118 119test_that("monitoring cache - across() can be used twice in the same expression", { 120 df <- tibble(a = 1, b = 2) 121 expect_equal( 122 mutate(df, x = ncol(across(where(is.numeric))) + ncol(across(a))), 123 tibble(a = 1, b = 2, x = 3) 124 ) 125}) 126 127test_that("monitoring cache - across() can be used in separate expressions", { 128 df <- tibble(a = 1, b = 2) 129 expect_equal( 130 mutate(df, x = ncol(across(where(is.numeric))), y = ncol(across(a))), 131 tibble(a = 1, b = 2, x = 2, y = 1) 132 ) 133}) 134 135test_that("monitoring cache - across() usage can depend on the group id", { 136 df <- tibble(g = 1:2, a = 1:2, b = 3:4) 137 df <- group_by(df, g) 138 139 switcher <- function() { 140 if_else(cur_group_id() == 1L, across(a)$a, across(b)$b) 141 } 142 143 expect <- df 144 expect$x <- c(1L, 4L) 145 146 expect_equal( 147 mutate(df, x = switcher()), 148 expect 149 ) 150}) 151 152test_that("monitoring cache - across() internal cache key depends on all inputs", { 153 df <- tibble(g = rep(1:2, each = 2), a = 1:4) 154 df <- group_by(df, g) 155 156 expect_identical( 157 mutate(df, tibble(x = across(where(is.numeric), mean)$a, y = across(where(is.numeric), max)$a)), 158 mutate(df, x = mean(a), y = max(a)) 159 ) 160}) 161 162test_that("across() rejects non vectors", { 163 expect_error( 164 data.frame(x = 1) %>% summarise(across(everything(), ~sym("foo"))) 165 ) 166}) 167 168test_that("across() uses tidy recycling rules", { 169 expect_equal( 170 data.frame(x = 1, y = 2) %>% summarise(across(everything(), ~rep(42, .))), 171 data.frame(x = rep(42, 2), y = rep(42, 2)) 172 ) 173 174 expect_error( 175 data.frame(x = 2, y = 3) %>% summarise(across(everything(), ~rep(42, .))) 176 ) 177}) 178 179test_that("across(<empty set>) returns a data frame with 1 row (#5204)", { 180 df <- tibble(x = 1:42) 181 expect_equal( 182 mutate(df, across(c(), as.factor)), 183 df 184 ) 185 expect_equal( 186 mutate(df, y = across(c(), as.factor))$y, 187 tibble::new_tibble(list(), nrow = 42) 188 ) 189 mutate(df, { 190 res <- across(c(), as.factor) 191 expect_equal(nrow(res), 1L) 192 res 193 }) 194}) 195 196test_that("across(.names=) can use local variables in addition to {col} and {fn}", { 197 res <- local({ 198 prefix <- "MEAN" 199 data.frame(x = 42) %>% 200 summarise(across(everything(), mean, .names = "{prefix}_{.col}")) 201 }) 202 expect_identical(res, data.frame(MEAN_x = 42)) 203}) 204 205test_that("across() uses environment from the current quosure (#5460)", { 206 # If the data frame `y` is selected, causes a subscript conversion 207 # error since it is fractional 208 df <- data.frame(x = 1, y = 2.4) 209 y <- "x" 210 expect_equal(df %>% summarise(across(all_of(y), mean)), data.frame(x = 1)) 211 expect_equal(df %>% mutate(across(all_of(y), mean)), df) 212 expect_equal(df %>% filter(if_all(all_of(y), ~ .x < 2)), df) 213 214 # Inherited case 215 expect_error(df %>% summarise(local(across(all_of(y), mean)))) 216 217 expect_equal( 218 df %>% summarise(summarise(cur_data(), across(all_of(y), mean))), 219 df %>% summarise(across(all_of(y), mean)) 220 ) 221}) 222 223test_that("across() sees columns in the recursive case (#5498)", { 224 df <- tibble( 225 vars = list("foo"), 226 data = list(data.frame(foo = 1, bar = 2)) 227 ) 228 229 out <- df %>% mutate(data = purrr::map2(data, vars, ~ { 230 .x %>% mutate(across(all_of(.y), ~ NA)) 231 })) 232 exp <- tibble( 233 vars = list("foo"), 234 data = list(data.frame(foo = NA, bar = 2)) 235 ) 236 expect_identical(out, exp) 237 238 out <- df %>% mutate(data = purrr::map2(data, vars, ~ { 239 local({ 240 .y <- "bar" 241 .x %>% mutate(across(all_of(.y), ~ NA)) 242 }) 243 })) 244 exp <- tibble( 245 vars = list("foo"), 246 data = list(data.frame(foo = 1, bar = NA)) 247 ) 248 expect_identical(out, exp) 249}) 250 251test_that("across() works with empty data frames (#5523)", { 252 expect_equal( 253 mutate(tibble(), across()), 254 tibble() 255 ) 256}) 257 258test_that("lambdas in mutate() + across() can use columns", { 259 df <- tibble(x = 2, y = 4, z = 8) 260 expect_identical( 261 df %>% mutate(data.frame(x = x / y, y = y / y, z = z / y)), 262 df %>% mutate(across(everything(), ~ .x / y)) 263 ) 264 expect_identical( 265 df %>% mutate(data.frame(x = x / y, y = y / y, z = z / y)), 266 df %>% mutate(+across(everything(), ~ .x / y)) 267 ) 268 269 expect_identical( 270 df %>% mutate(data.frame(x = x / y, y = y / y, z = z / y)), 271 df %>% mutate(across(everything(), ~ .x / .data$y)) 272 ) 273 expect_identical( 274 df %>% mutate(data.frame(x = x / y, y = y / y, z = z / y)), 275 df %>% mutate(+across(everything(), ~ .x / .data$y)) 276 ) 277}) 278 279test_that("lambdas in summarise() + across() can use columns", { 280 df <- tibble(x = 2, y = 4, z = 8) 281 expect_identical( 282 df %>% summarise(data.frame(x = x / y, y = y / y, z = z / y)), 283 df %>% summarise(across(everything(), ~ .x / y)) 284 ) 285 expect_identical( 286 df %>% summarise(data.frame(x = x / y, y = y / y, z = z / y)), 287 df %>% summarise(+across(everything(), ~ .x / y)) 288 ) 289 290 expect_identical( 291 df %>% summarise(data.frame(x = x / y, y = y / y, z = z / y)), 292 df %>% summarise(across(everything(), ~ .x / .data$y)) 293 ) 294 expect_identical( 295 df %>% summarise(data.frame(x = x / y, y = y / y, z = z / y)), 296 df %>% summarise(+across(everything(), ~ .x / .data$y)) 297 ) 298}) 299 300test_that("lambdas in mutate() + across() can use columns in follow up expressions (#5717)", { 301 df <- tibble(x = 2, y = 4, z = 8) 302 expect_identical( 303 df %>% mutate(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), 304 df %>% mutate(a = 2, across(c(x, y, z), ~ .x / y)) 305 ) 306 expect_identical( 307 df %>% mutate(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), 308 df %>% mutate(a = 2, +across(c(x, y, z), ~ .x / y)) 309 ) 310 311 expect_identical( 312 df %>% mutate(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), 313 df %>% mutate(a = 2, across(c(x, y, z), ~ .x / .data$y)) 314 ) 315 expect_identical( 316 df %>% mutate(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), 317 df %>% mutate(a = 2, +across(c(x, y, z), ~ .x / .data$y)) 318 ) 319}) 320 321test_that("lambdas in summarise() + across() can use columns in follow up expressions (#5717)", { 322 df <- tibble(x = 2, y = 4, z = 8) 323 expect_identical( 324 df %>% summarise(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), 325 df %>% summarise(a = 2, across(c(x, y, z), ~ .x / y)) 326 ) 327 expect_identical( 328 df %>% summarise(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), 329 df %>% summarise(a = 2, +across(c(x, y, z), ~ .x / y)) 330 ) 331 332 expect_identical( 333 df %>% summarise(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), 334 df %>% summarise(a = 2, across(c(x, y, z), ~ .x / .data$y)) 335 ) 336 expect_identical( 337 df %>% summarise(a = 2, data.frame(x = x / y, y = y / y, z = z / y)), 338 df %>% summarise(a = 2, +across(c(x, y, z), ~ .x / .data$y)) 339 ) 340}) 341 342test_that("functions defined inline can use columns (#5734)", { 343 df <- data.frame(x = 1, y = 2) 344 expect_equal( 345 df %>% mutate(across('x', function(.x) .x / y)) %>% pull(x), 346 0.5 347 ) 348}) 349 350test_that("if_any() and if_all() do not enforce logical", { 351 # We used to coerce to logical using vctrs. Now we use base 352 # semantics because we expand `if_all(x:y)` to `x & y`. 353 d <- data.frame(x = 10, y = 10) 354 expect_equal(filter(d, if_all(x:y, identity)), d) 355 expect_equal(filter(d, if_any(x:y, identity)), d) 356 357 expect_equal( 358 mutate(d, ok = if_any(x:y, identity)), 359 mutate(d, ok = TRUE) 360 ) 361 expect_equal( 362 mutate(d, ok = if_all(x:y, identity)), 363 mutate(d, ok = TRUE) 364 ) 365}) 366 367test_that("if_any() and if_all() can be used in mutate() (#5709)", { 368 d <- data.frame(x = c(1, 5, 10, 10), y = c(0, 0, 0, 10), z = c(10, 5, 1, 10)) 369 res <- d %>% 370 mutate( 371 any = if_any(x:z, ~ . > 8), 372 all = if_all(x:z, ~ . > 8) 373 ) 374 expect_equal(res$any, c(TRUE, FALSE, TRUE, TRUE)) 375 expect_equal(res$all, c(FALSE, FALSE, FALSE, TRUE)) 376}) 377 378test_that("across() caching not confused when used from if_any() and if_all() (#5782)", { 379 res <- data.frame(x = 1:3) %>% 380 mutate( 381 any = if_any(x, ~ . >= 2) + if_any(x, ~ . >= 3), 382 all = if_all(x, ~ . >= 2) + if_all(x, ~ . >= 3) 383 ) 384 expect_equal(res$any, c(0, 1, 2)) 385 expect_equal(res$all, c(0, 1, 2)) 386}) 387 388test_that("if_any() and if_all() respect filter()-like NA handling", { 389 df <- expand.grid( 390 x = c(TRUE, FALSE, NA), y = c(TRUE, FALSE, NA) 391 ) 392 expect_identical( 393 filter(df, x & y), 394 filter(df, if_all(c(x,y), identity)) 395 ) 396 expect_identical( 397 filter(df, x | y), 398 filter(df, if_any(c(x,y), identity)) 399 ) 400}) 401 402test_that("if_any() and if_all() aborts when predicate mistakingly used in .cols= (#5732)", { 403 df <- data.frame(x = 1:10, y = 1:10) 404 expect_snapshot({ 405 # expanded case 406 (expect_error(filter(df, if_any(~ .x > 5)))) 407 (expect_error(filter(df, if_all(~ .x > 5)))) 408 409 # non expanded case 410 (expect_error(filter(df, !if_any(~ .x > 5)))) 411 (expect_error(filter(df, !if_all(~ .x > 5)))) 412 }) 413}) 414 415test_that("across() correctly reset column", { 416 expect_error(cur_column()) 417 res <- data.frame(x = 1) %>% 418 summarise( 419 a = { expect_error(cur_column()); 2}, 420 across(x, ~{ expect_equal(cur_column(), "x"); 3}, .names = "b"), # top_across() 421 c = { expect_error(cur_column()); 4}, 422 force(across(x, ~{ expect_equal(cur_column(), "x"); 5}, .names = "d")), # across() 423 e = { expect_error(cur_column()); 6} 424 ) 425 expect_equal(res, data.frame(a = 2, b = 3, c = 4, d = 5, e = 6)) 426 expect_error(cur_column()) 427 428 res <- data.frame(x = 1) %>% 429 mutate( 430 a = { expect_error(cur_column()); 2}, 431 across(x, ~{ expect_equal(cur_column(), "x"); 3}, .names = "b"), # top_across() 432 c = { expect_error(cur_column()); 4}, 433 force(across(x, ~{ expect_equal(cur_column(), "x"); 5}, .names = "d")), # across() 434 e = { expect_error(cur_column()); 6} 435 ) 436 expect_equal(res, data.frame(x = 1, a = 2, b = 3, c = 4, d = 5, e = 6)) 437 expect_error(cur_column()) 438}) 439 440test_that("top_across() evaluates ... with promise semantics (#5813)", { 441 df <- tibble(x = tibble(foo = 1), y = tibble(foo = 2)) 442 443 res <- mutate(df, across( 444 everything(), 445 mutate, 446 foo = foo + 1 447 )) 448 expect_equal(res$x$foo, 2) 449 expect_equal(res$y$foo, 3) 450 451 # Can omit dots 452 res <- mutate(df, across( 453 everything(), 454 list 455 )) 456 expect_equal(res$x[[1]]$foo, 1) 457 expect_equal(res$y[[1]]$foo, 2) 458 459 # Dots are evaluated only once 460 new_counter <- function() { 461 n <- 0L 462 function() { 463 n <<- n + 1L 464 n 465 } 466 } 467 counter <- new_counter() 468 list_second <- function(...) { 469 list(..2) 470 } 471 res <- mutate(df, across( 472 everything(), 473 list_second, 474 counter() 475 )) 476 expect_equal(res$x[[1]], 1) 477 expect_equal(res$y[[1]], 1) 478}) 479 480test_that("group variables are in scope (#5832)", { 481 f <- function(x, z) x + z 482 gdf <- data.frame(x = 1:2, y = 3:4, g = 1:2) %>% group_by(g) 483 exp <- gdf %>% summarise(x = f(x, z = y)) 484 485 expect_equal( 486 gdf %>% summarise(across(x, ~ f(.x, z = y))), 487 exp 488 ) 489 490 expect_equal( 491 gdf %>% summarise(across(x, f, z = y)), 492 exp 493 ) 494 495 expect_equal( 496 gdf %>% summarise((across(x, ~ f(.x, z = y)))), 497 exp 498 ) 499 500 expect_equal( 501 gdf %>% summarise((across(x, f, z = y))), 502 exp 503 ) 504}) 505 506test_that("arguments in dots are evaluated once per group", { 507 set.seed(0) 508 out <- data.frame(g = 1:3, var = NA) %>% 509 group_by(g) %>% 510 mutate(across(var, function(x, y) y, rnorm(1))) %>% 511 pull(var) 512 513 set.seed(0) 514 expect_equal(out, rnorm(3)) 515}) 516 517test_that("can pass quosure through `across()`", { 518 summarise_mean <- function(data, vars) { 519 data %>% summarise(across({{ vars }}, mean)) 520 } 521 gdf <- data.frame(g = c(1, 1, 2), x = 1:3) %>% group_by(g) 522 523 expect_equal( 524 gdf %>% summarise_mean(where(is.numeric)), 525 summarise(gdf, x = mean(x)) 526 ) 527}) 528 529test_that("across() inlines formulas", { 530 env <- env() 531 f <- ~ toupper(.x) 532 533 expect_equal( 534 as_across_fn_call(f, quote(foo), env, env), 535 new_quosure(quote(toupper(foo)), f_env(f)) 536 ) 537 538 f <- ~ list(.x, ., .x) 539 expect_equal( 540 as_across_fn_call(f, quote(foo), env, env), 541 new_quosure(quote(list(foo, foo, foo)), f_env(f)) 542 ) 543}) 544 545test_that("across() uses local formula environment (#5881)", { 546 f <- local({ 547 prefix <- "foo" 548 ~ paste(prefix, .x) 549 }) 550 df <- tibble(x = "x") 551 expect_equal( 552 mutate(df, across(x, f)), 553 tibble(x = "foo x") 554 ) 555 expect_equal( 556 mutate(df, across(x, list(f = f))), 557 tibble(x = "x", x_f = "foo x") 558 ) 559 560 local({ 561 # local() here is not necessary, it's just in case the 562 # code is run directly without the test_that() 563 prefix <- "foo" 564 expect_equal( 565 mutate(df, across(x, ~paste(prefix, .x))), 566 tibble(x = "foo x") 567 ) 568 expect_equal( 569 mutate(df, across(x, list(f = ~paste(prefix, .x)))), 570 tibble(x = "x", x_f = "foo x") 571 ) 572 }) 573}) 574 575test_that("unevaluated formulas (currently) fail", { 576 df <- tibble(x = "x") 577 expect_error( 578 mutate(df, across(x, quote(~ paste("foo", .x)))) 579 ) 580}) 581 582test_that("across() can access lexical scope (#5862)", { 583 f_across <- function(data, cols, fn) { 584 data %>% 585 summarise( 586 across({{ cols }}, fn) 587 ) 588 } 589 590 df <- data.frame(x = 1:10, y = 1:10) 591 expect_equal( 592 f_across(df, c(x, y), mean), 593 summarise(df, across(c(x, y), mean)) 594 ) 595}) 596 597test_that("if_any() and if_all() expansions deal with no inputs or single inputs", { 598 d <- data.frame(x = 1) 599 600 # No inputs 601 expect_equal( 602 filter(d, if_any(starts_with("c"), ~ FALSE)), 603 filter(d) 604 ) 605 expect_equal( 606 filter(d, if_all(starts_with("c"), ~ FALSE)), 607 filter(d) 608 ) 609 610 # Single inputs 611 expect_equal( 612 filter(d, if_any(x, ~ FALSE)), 613 filter(d, FALSE) 614 ) 615 expect_equal( 616 filter(d, if_all(x, ~ FALSE)), 617 filter(d, FALSE) 618 ) 619}) 620 621test_that("if_any() and if_all() wrapped deal with no inputs or single inputs", { 622 d <- data.frame(x = 1) 623 624 # No inputs 625 expect_equal( 626 filter(d, (if_any(starts_with("c"), ~ FALSE))), 627 filter(d) 628 ) 629 expect_equal( 630 filter(d, (if_all(starts_with("c"), ~ FALSE))), 631 filter(d) 632 ) 633 634 # Single inputs 635 expect_equal( 636 filter(d, (if_any(x, ~ FALSE))), 637 filter(d, FALSE) 638 ) 639 expect_equal( 640 filter(d, (if_all(x, ~ FALSE))), 641 filter(d, FALSE) 642 ) 643}) 644 645test_that("expanded if_any() finds local data", { 646 limit <- 7 647 df <- data.frame(x = 1:10, y = 10:1) 648 649 expect_identical( 650 filter(df, if_any(everything(), ~ .x > limit)), 651 filter(df, x > limit | y > limit) 652 ) 653}) 654 655test_that("across() can use named selections", { 656 df <- data.frame(x = 1, y = 2) 657 658 # no fns 659 expect_equal( 660 df %>% summarise(across(c(a = x, b = y))), 661 data.frame(a = 1, b = 2) 662 ) 663 expect_equal( 664 df %>% summarise(across(all_of(c(a = "x", b = "y")))), 665 data.frame(a = 1, b = 2) 666 ) 667 668 # no fns, non expanded 669 expect_equal( 670 df %>% summarise((across(c(a = x, b = y)))), 671 data.frame(a = 1, b = 2) 672 ) 673 expect_equal( 674 df %>% summarise((across(all_of(c(a = "x", b = "y"))))), 675 data.frame(a = 1, b = 2) 676 ) 677 678 # one fn 679 expect_equal( 680 df %>% summarise(across(c(a = x, b = y), mean)), 681 data.frame(a = 1, b = 2) 682 ) 683 expect_equal( 684 df %>% summarise(across(all_of(c(a = "x", b = "y")), mean)), 685 data.frame(a = 1, b = 2) 686 ) 687 688 # one fn - non expanded 689 expect_equal( 690 df %>% summarise((across(c(a = x, b = y), mean))), 691 data.frame(a = 1, b = 2) 692 ) 693 expect_equal( 694 df %>% summarise((across(all_of(c(a = "x", b = "y")), mean))), 695 data.frame(a = 1, b = 2) 696 ) 697 698 # multiple fns 699 expect_equal( 700 df %>% summarise(across(c(a = x, b = y), list(mean = mean, sum = sum))), 701 data.frame(a_mean = 1, a_sum = 1, b_mean = 2, b_sum = 2) 702 ) 703 expect_equal( 704 df %>% summarise(across(all_of(c(a = "x", b = "y")), list(mean = mean, sum = sum))), 705 data.frame(a_mean = 1, a_sum = 1, b_mean = 2, b_sum = 2) 706 ) 707 708 # multiple fns - non expanded 709 expect_equal( 710 df %>% summarise((across(c(a = x, b = y), list(mean = mean, sum = sum)))), 711 data.frame(a_mean = 1, a_sum = 1, b_mean = 2, b_sum = 2) 712 ) 713 expect_equal( 714 df %>% summarise((across(all_of(c(a = "x", b = "y")), list(mean = mean, sum = sum)))), 715 data.frame(a_mean = 1, a_sum = 1, b_mean = 2, b_sum = 2) 716 ) 717}) 718 719test_that("expr_subtitute() stops at lambdas (#5896)", { 720 expect_identical( 721 expr_substitute(expr(map(.x, ~mean(.x))), quote(.x), quote(a)), 722 expr(map(a, ~mean(.x))) 723 ) 724 expect_identical( 725 expr_substitute(expr(map(.x, function(.x) mean(.x))), quote(.x), quote(a)), 726 expr(map(a, function(.x) mean(.x))) 727 ) 728}) 729 730test_that("expr_subtitute() keeps at double-sided formula (#5894)", { 731 expect_identical( 732 expr_substitute(expr(case_when(.x < 5 ~ 5, TRUE ~ .x)), quote(.x), quote(a)), 733 expr(case_when(a < 5 ~ 5, TRUE ~ a)) 734 ) 735 736 expect_identical( 737 expr_substitute(expr(case_when(. < 5 ~ 5, TRUE ~ .)), quote(.), quote(a)), 738 expr(case_when(a < 5 ~ 5, TRUE ~ a)) 739 ) 740}) 741 742# c_across ---------------------------------------------------------------- 743 744test_that("selects and combines columns", { 745 df <- data.frame(x = 1:2, y = 3:4) 746 out <- df %>% summarise(z = list(c_across(x:y))) 747 expect_equal(out$z, list(1:4)) 748}) 749 750test_that("key_deparse() collapses (#5883)", { 751 expect_equal( 752 length(key_deparse(quo(all_of(c("aaaaaaaaaaaaaaaaaa", "bbbbbbbbbbbbbbb", "cccccccccccccc", "ddddddddddddddddddd"))))), 753 1 754 ) 755}) 756