# To turn on warnings from tibble::`names<-()` local_options(lifecycle_verbosity = "warning") test_that("empty arrange() returns input", { df <- tibble(x = 1:10, y = 1:10) gf <- group_by(df, x) expect_identical(arrange(df), df) expect_identical(arrange(gf), gf) expect_identical(arrange(df, !!!list()), df) expect_identical(arrange(gf, !!!list()), gf) }) test_that("can sort empty data frame", { df <- tibble(a = numeric(0)) expect_equal(arrange(df, a), df) }) test_that("local arrange sorts missing values to end", { df <- data.frame(x = c(2, 1, NA)) expect_equal(df %>% arrange(x) %>% pull(), c(1, 2, NA)) expect_equal(df %>% arrange(desc(x)) %>% pull(), c(2, 1, NA)) }) test_that("arrange() gives meaningful errors", { expect_snapshot({ # duplicated column name (expect_error( tibble(x = 1, x = 1, .name_repair = "minimal") %>% arrange(x) )) # error in mutate() step (expect_error( tibble(x = 1) %>% arrange(y) )) (expect_error( tibble(x = 1) %>% arrange(rep(x, 2)) )) }) }) # column types ---------------------------------------------------------- test_that("arrange handles list columns (#282)", { # no intrinsic ordering df <- tibble(x = 1:3, y = list(3, 2, 1)) expect_equal(arrange(df, y), df) df <- tibble(x = 1:3, y = list(sum, mean, sd)) expect_equal(arrange(df, y), df) }) test_that("arrange handles raw columns (#1803)", { df <- tibble(x = 1:3, y = as.raw(3:1)) expect_equal(arrange(df, y), df[3:1, ]) }) test_that("arrange handles matrix columns", { df <- tibble(x = 1:3, y = matrix(6:1, ncol = 2)) expect_equal(arrange(df, y), df[3:1, ]) }) test_that("arrange handles data.frame columns (#3153)", { df <- tibble(x = 1:3, y = data.frame(z = 3:1)) expect_equal(arrange(df, y), tibble(x = 3:1, y = data.frame(z = 1:3))) }) test_that("arrange handles complex columns", { df <- tibble(x = 1:3, y = 3:1 + 2i) expect_equal(arrange(df, y), df[3:1, ]) }) test_that("arrange handles S4 classes (#1105)", { TestS4 <- suppressWarnings(setClass("TestS4", contains = "integer")) setMethod('[', 'TestS4', function(x, i, ...){ TestS4(unclass(x)[i, ...]) }) on.exit(removeClass("TestS4")) df <- tibble(x = 1:3, y = TestS4(3:1)) expect_equal(arrange(df, y), df[3:1, ]) }) test_that("arrange respects locale (#1280)", { df2 <- tibble(words = c("casa", "\u00e1rbol", "zona", "\u00f3rgano")) res <- df2 %>% arrange(words) expect_equal(res$words, sort(df2$words)) res <- df2 %>% arrange(desc(words)) expect_equal(res$words, sort(df2$words, decreasing = TRUE)) }) # data ---------------------------------------------------------------- test_that("arrange preserves input class", { df1 <- data.frame(x = 1:3, y = 3:1) df2 <- tibble(x = 1:3, y = 3:1) df3 <- df1 %>% group_by(x) expect_s3_class(arrange(df1, x), "data.frame", exact = TRUE) expect_s3_class(arrange(df2, x), "tbl_df") expect_s3_class(arrange(df3, x), "grouped_df") }) test_that("grouped arrange ignores group, unless requested with .by_group", { df <- data.frame(g = c(2, 1, 2, 1), x = 4:1) gf <- group_by(df, g) expect_equal(arrange(gf, x), gf[4:1, ,]) expect_equal(arrange(gf, x, .by_group = TRUE), gf[c(4, 2, 3, 1), ,]) }) test_that("arrange updates the grouping structure (#605)", { df <- tibble(g = c(2, 2, 1, 1), x = c(1, 3, 2, 4)) res <- df %>% group_by(g) %>% arrange(x) expect_s3_class(res, "grouped_df") expect_equal(group_rows(res), list_of(c(2L, 4L), c(1L, 3L))) }) test_that("arrange() supports across() (#4679)", { df <- tibble(x = c(1, 3, 2, 1), y = c(4, 3, 2, 1)) expect_identical( df %>% arrange(across()), df %>% arrange(x, y) ) expect_identical( df %>% arrange(across(.fns = desc)), df %>% arrange(desc(x), desc(y)) ) expect_identical( df %>% arrange(across(x)), df %>% arrange(x) ) expect_identical( df %>% arrange(across(y)), df %>% arrange(y) ) }) test_that("arrange() with empty dots still calls dplyr_row_slice()", { tbl <- new_tibble(list(x = 1), nrow = 1L) foo <- structure(tbl, class = c("foo_df", class(tbl))) local_methods( # `foo_df` always loses class when row slicing dplyr_row_slice.foo_df = function(data, i, ...) { out <- NextMethod() new_tibble(out, nrow = nrow(out)) } ) expect_s3_class(arrange(foo), class(tbl), exact = TRUE) expect_s3_class(arrange(foo, x), class(tbl), exact = TRUE) }) test_that("can arrange() with unruly class", { local_methods( `[.dplyr_foobar` = function(x, i, ...) new_dispatched_quux(vec_slice(x, i)), dplyr_row_slice.dplyr_foobar = function(x, i, ...) x[i, ] ) df <- foobar(data.frame(x = 1:3)) expect_identical( arrange(df, desc(x)), quux(data.frame(x = 3:1, dispatched = TRUE)) ) }) test_that("arrange() preserves the call stack on error (#5308)", { foobar <- function() stop("foo") stack <- NULL expect_error( withCallingHandlers( error = function(...) stack <<- sys.calls(), arrange(mtcars, foobar()) ) ) expect_true(some(stack, is_call, "foobar")) }) test_that("desc() inside arrange() checks the number of arguments (#5921)", { expect_snapshot({ df <- data.frame(x = 1, y = 2) (expect_error(arrange(df, desc(x, y)))) }) })
Generated by dwww version 1.15 on Sun Jun 16 13:28:41 CEST 2024.