test_that("match & %in% basics work", { x = as.integer64(2:5) y = as.integer64(3:6) expect_identical(match(x, y), c(NA, 1:3)) expect_identical(match(y, x), c(2:4, NA)) expect_identical(match(2:5, y), c(NA, 1:3)) expect_identical(match(as.numeric(2:5), y), c(NA, 1:3)) expect_identical(match(y, 2:5), c(2:4, NA)) expect_identical(match(y, as.numeric(2:5)), c(2:4, NA)) expect_identical(match(x, y, nomatch=0L), 0:3) expect_identical(x %in% y, c(FALSE, TRUE, TRUE, TRUE)) expect_identical(y %in% x, c(TRUE, TRUE, TRUE, FALSE)) expect_identical(x %in% 3:6, c(FALSE, TRUE, TRUE, TRUE)) expect_identical(x %in% c(3.0, 4.0, 5.0, 6.0), c(FALSE, TRUE, TRUE, TRUE)) expect_identical(match(integer64(), as.integer64(1L)), integer()) expect_identical(match(as.integer64(1L), integer64()), NA_integer_) expect_identical(match(as.integer64(1L), integer64(), nomatch = 0L), 0L) x_nm <- as.integer64(c(1L, 3L)) table_nm <- as.integer64(2:4) expect_identical(match(x_nm, table_nm, nomatch = -1L), c(-1L, 2L)) # nolint next: scalar_in_linter. Testing '%in%'. expect_identical(integer64() %in% 1L, integer() %in% 1L) expect_identical(as.integer64(1L) %in% double(), 1L %in% double()) }) test_that("Different method= for match() and %in% work", { x = as.integer64(2:5) y = as.integer64(3:6) expected = c(NA_integer_, 1:3) expect_identical(match(x, y, method="hashpos"), expected) expect_identical(match(x, y, method="hashrev"), expected) expect_identical(match(x, y, method="sortorderpos"), expected) expect_error(match(x, y, method="_unknown_"), "'arg' should be one of", fixed=TRUE) expect_identical(match(x, y, method="orderpos"), expected) # NB: %in% is quite a bit different; while there's a public API to # `%in%.integer64`, likely, there shouldn't be (it's strange to export # an S3 method like is currently done). The tests are designed to tickle # the different methods through the public API only; this makes them # prone to winding up testing something totally different later. I think # that's fine; now that we have coverage tests up, any refactor that bumps # around what exactly the following tests are covering, will show up in the PR. # method="hashrin" used when x is "short" but table is "long" x = as.integer64(seq_len(10L)) table = as.integer64(seq_len(2.0**16.0 * 2.0/3.0 + 10.0)) # invert condition for bx>=16, 10.0 arbitrary buffer expect_identical(x %in% table, rep(TRUE, 10L)) }) test_that("match.integer64: automatic method selection without cache", { # hashrev path: short x, long table nx <- 10L ny <- 2L^16L x <- as.integer64(1:nx) table <- as.integer64(1:ny) # As of this writing, this should invoke hashrev expect_identical(match(x, table), 1:nx) # hashpos path: long x, short table x_long_match <- as.integer64(1:ny) table_short_match <- as.integer64(1:nx) # As of this writing, this should use hashpos expect_identical(match(x_long_match[1:nx], table_short_match), 1:nx) expect_identical(match(x_long_match[(nx+1L):(nx+10L)], table_short_match), rep(NA_integer_, 10L)) }) test_that("%in%.integer64: automatic method selection without cache", { # hashrin path: short x, long table nx <- 10L ny <- 2L^16L x <- as.integer64(1:nx) table <- as.integer64(1:ny) # As of this writing, this should use hashrin expect_identical(x %in% table, rep(TRUE, nx)) # hashfin path: long x, short table x_long_in <- as.integer64(1:ny) table_short_in <- as.integer64(1:nx) # As of this writing, this should use hashfin. expect_identical(x_long_in[1:nx] %in% table_short_in, rep(TRUE, nx)) expect_identical(x_long_in[(nx+1L):(nx+10L)] %in% table_short_in, rep(FALSE, 10L)) }) test_that("match.integer64: cache-based method selection", { x <- as.integer64(c(1L, 3L, 5L)) table <- as.integer64(c(2L, 4L, 3L, 1L)) # hashcache hashcache(table) expect_identical(match(x, table), c(4L, 3L, NA_integer_)) remcache(table) # sortordercache sortordercache(table) expect_identical(match(x, table), c(4L, 3L, NA_integer_)) remcache(table) # ordercache ordercache(table) expect_identical(match(x, table), c(4L, 3L, NA_integer_)) remcache(table) }) test_that("%in%.integer64: cache-based method selection", { x <- as.integer64(c(1L, 3L, 5L)) table <- as.integer64(c(2L, 4L, 3L, 1L)) expected_in <- c(TRUE, TRUE, FALSE) # hashcache hashcache(table) expect_identical(x %in% table, expected_in) remcache(table) # sortcache sortcache(table) expect_identical(x %in% table, expected_in) remcache(table) # ordercache ordercache(table) expect_identical(x %in% table, expected_in) remcache(table) }) test_that("match.integer64: nunique argument", { x <- as.integer64(c(1L, 3L, 5L)) table <- as.integer64(c(2L, 4L, 3L, 1L, 3L)) expect_identical(match(x, table, nunique = 4L), c(4L, 3L, NA_integer_)) }) test_that("%in%.integer64: nunique argument", { x <- as.integer64(c(1L, 3L, 5L)) table <- as.integer64(c(2L, 4L, 3L, 1L, 3L)) expect_identical(x %in% table, c(TRUE, TRUE, FALSE)) }) test_that("%in%.integer64: with NA values", { x <- as.integer64(c(1L, NA, 3L)) table <- as.integer64(c(NA, 2L, 1L)) expect_identical(x %in% table, c(TRUE, TRUE, FALSE)) }) test_that("duplicated, unique, table methods work", { x = as.integer64(1:3) expect_identical(duplicated(x), rep(FALSE, 3L)) expect_identical(unique(x), x) expect_identical(table(x), table(x = 1:3)) x = as.integer64(rep(1L, 3L)) expect_identical(duplicated(x), c(FALSE, TRUE, TRUE)) expect_identical(unique(x), x[1L]) expect_identical(table(x), table(x = rep(1L, 3L))) x = as.integer64(c(1L, 2L, 1L)) expect_identical(duplicated(x), c(FALSE, FALSE, TRUE)) expect_identical(unique(x), x[1:2]) expect_identical(table(x), table(x = c(1L, 2L, 1L))) x = as.integer64(c(1L, 1L, 2L)) expect_identical(duplicated(x), c(FALSE, TRUE, FALSE)) expect_identical(unique(x), x[c(1L, 3L)]) expect_identical(table(x), table(x = c(1L, 1L, 2L))) x = c(132724613L, -2143220989L) expect_identical(table(x=as.integer64(x)), table(x)) expect_identical(table(x, y=lim.integer64()), table(x=as.character(x), y=as.character(lim.integer64()))) expect_identical(table(y=lim.integer64(), x), table(y=as.character(lim.integer64()), x=as.character(x))) x = as.integer64(c(1L, 1L, 2L)) expect_error(duplicated(x, method="_unknown_"), "'arg' should be one of", fixed=TRUE) expect_error(unique(x, method="_unknown_"), "'arg' should be one of", fixed=TRUE) }) test_that("exclude, useNA arguments work for integer64 method of table", { a32 = c(1L, 1L, 2L) a64 = as.integer64(a32) c = c(2L, NA, 4L) expect_identical( table(a=a64, b=1:3, c=c, exclude=1L, useNA="no"), table(a=a32, b=1:3, c=c, exclude=1L, useNA="no") ) skip_unless_r("> 3.5.0") # unclear what's going on expect_identical( table(a=a64, b=1:3, c=c, exclude=1L, useNA="ifany"), table(a=a32, b=1:3, c=c, exclude=1L, useNA="ifany") ) expect_identical( table(a=a64, b=1:3, c=c, exclude=1L, useNA="always"), table(a=a32, b=1:3, c=c, exclude=1L, useNA="always") ) }) test_that("our overwrite of table() is consistent with base::table", { expect_identical(table(NULL), base::table(NULL)) expect_identical(table(a=NULL), base::table(a=NULL)) expect_identical(table(NULL, NULL), base::table(NULL, NULL)) expect_identical(table(a=NULL, b=NULL), base::table(a=NULL, b=NULL)) expect_identical(table(integer(), NULL), base::table(integer(), NULL)) expect_identical(table(a=integer(), b=NULL), base::table(a=integer(), b=NULL)) expect_same_error(table(1L, NULL), base::table(1L, NULL)) expect_same_error(table(a=1L, b=NULL), base::table(a=1L, b=NULL)) skip_unless_r("> 3.5.0") # unclear what's going on expected_result = withr::with_seed(1L, base::table( exclude = sample.int(10L, 1L), useNA = sample(c("no", "ifany", "always"), 1L), deparse.level = sample.int(2L, 1L), sample.int(10L) )) expect_identical( withr::with_seed(1L, table( exclude = sample.int(10L, 1L), useNA = sample(c("no", "ifany", "always"), 1L), deparse.level = sample.int(2L, 1L), sample(as.integer64(1:10)) )), expected_result ) expect_identical( withr::with_seed(1L, table( exclude = sample.int(10L, 1L), useNA = sample(c("no", "ifany", "always"), 1L), deparse.level = sample.int(2L, 1L), sample.int(10L) )), expected_result ) expected_result = withr::with_seed(1L, base::table( exclude = sample.int(10L, 1L), deparse.level = sample.int(2L, 1L), sample.int(10L) )) expect_identical( withr::with_seed(1L, table( exclude = sample.int(10L, 1L), deparse.level = sample.int(2L, 1L), sample(as.integer64(1:10)) )), expected_result ) expect_identical( withr::with_seed(1L, table( exclude = sample.int(10L, 1L), deparse.level = sample.int(2L, 1L), sample.int(10L) )), expected_result ) expected_result = withr::with_seed(1L, base::table( exclude = sample.int(10L, 1L), useNA = sample(c("no", "ifany", "always"), 1L), sample.int(10L) )) expect_identical( withr::with_seed(1L, table( exclude = sample.int(10L, 1L), useNA = sample(c("no", "ifany", "always"), 1L), sample(as.integer64(1:10)) )), expected_result ) expect_identical( withr::with_seed(1L, table( exclude = sample.int(10L, 1L), useNA = sample(c("no", "ifany", "always"), 1L), sample.int(10L) )), expected_result ) expected_result = withr::with_seed(1L, base::table(useNA=sample(c("no", "ifany", "always"), 1L), sample.int(10L))) expect_identical( withr::with_seed(1L, table(useNA=sample(c("no", "ifany", "always"), 1L), sample(as.integer64(1:10)))), expected_result ) expect_identical( withr::with_seed(1L, table(useNA=sample(c("no", "ifany", "always"), 1L), sample.int(10L))), expected_result ) }) test_that("different method= for duplicated, unique work", { x = as.integer64(c(1L, 2L, 1L)) exp_dup = c(FALSE, FALSE, TRUE) exp_unq = x[1:2] expect_identical(duplicated(x, method="hashdup"), exp_dup) expect_identical(unique(x, method="hashmapuni"), exp_unq) expect_identical(unique(x, method="hashuni"), exp_unq) expect_identical(duplicated(x, method="sortorderdup"), exp_dup) expect_identical(unique(x, method="sortorderuni"), exp_unq) expect_identical(unique(x, method="sortuni"), exp_unq) expect_identical(duplicated(x, method="orderdup"), exp_dup) expect_identical(unique(x, method="orderuni"), exp_unq) }) test_that("more coercion works", { expect_identical(as.factor(as.integer64(2:4)), factor(2:4)) expect_identical(as.ordered(as.integer64(2:4)), as.ordered(2:4)) expect_identical(as.integer64(factor(2:11)), as.integer64(1:10)) # NB: _not_ 2:11! }) test_that("sorting methods work", { x = as.integer64(c(10L, 4L, 8L)) x_rank = c(3.0, 1.0, 2.0) expect_identical(rank(x), x_rank) expect_identical(rank(x, method="orderrnk"), x_rank) x = as.integer64(1:100) q = as.integer64(c(1L, 26L, 50L, 75L, 100L)) expect_identical(quantile(x, names=FALSE), q) expect_identical(median(x), q[3L]) names(q) = c('0%', '25%', '50%', '75%', '100%') expect_identical(quantile(x), q) expect_identical(quantile(x, 0.2, names=FALSE), as.integer64(21L)) expect_error(quantile(x, type=7L), "only.*qtile.*supported") expect_error(quantile(NA_integer64_), "missing values not allowed") x = as.integer64(1:100) q = as.integer64(c(1L, 26L, 50L, 75L, 100L)) names(q) = c('0%', '25%', '50%', '75%', '100%') expect_identical(qtile(x, method="sortqtl"), q) expect_identical(qtile(x, method="orderqtl"), q) x = as.integer64(c(1L, 1L, 2L, 3L, 2L, 4L)) x_tiepos = c(1L, 2L, 3L, 5L) expect_identical(tiepos(x), x_tiepos) expect_identical(tiepos(x, method="ordertie"), x_tiepos) expect_error(rank(x, method="_unknown_"), "'arg' should be one of", fixed=TRUE) expect_error(qtile(x, method="_unknown_"), "'arg' should be one of", fixed=TRUE) expect_error(tiepos(x, method="_unknown_"), "'arg' should be one of", fixed=TRUE) }) test_that("missing and empty inputs to median() are handled correctly", { expect_identical(median(NA_integer64_, na.rm=FALSE), NA_integer64_) expect_identical(median(NA_integer64_, na.rm=TRUE), NA_integer64_) expect_identical(median(integer64()), NA_integer64_) x = as.integer64(c(NA, 1L)) expect_identical(median(x, na.rm=FALSE), NA_integer64_) expect_identical(median(x, na.rm=TRUE), as.integer64(1L)) x = as.integer64(c(NA, NA)) expect_identical(median(x, na.rm=FALSE), NA_integer64_) expect_identical(median(x, na.rm=TRUE), NA_integer64_) }) # These tests were previously kept as tests under \examples{\dontshow{...}}. # Converted to "proper" unit tests for clarity, after making them more # canonical within {testthat}, e.g. better capturing expected warnings, # changing stopifnot(identical(...)) to expect_identical(...). test_that("Old \\dontshow{} tests continue working", { xi = c(1L, 1L, 2L) xi64 = as.integer64(xi) yi = c(3L, 4L, 4L) yi64 = as.integer64(yi) t_xi = table(x=xi) t_xi_yi = table(x=xi, y=yi) expect_identical(table(x=xi64), t_xi) expect_identical(table(x=xi64, y=yi64), t_xi_yi) expect_identical(table(x=xi64, y=yi), t_xi_yi) expect_identical(table(x=xi, y=yi64), t_xi_yi) }) test_that("unipos() works as intended", { x = as.integer64(c(1L, 2L, 1L, 3L, 2L, 4L)) x_unipos = c(1L, 2L, 4L, 6L) expect_identical(unipos(x), x_unipos) expect_identical(unipos(x, method="hashupo"), x_unipos) expect_identical(unipos(x, method="sortorderupo"), x_unipos) expect_identical(unipos(x, method="orderupo"), x_unipos) expect_error(unipos(x, method="_unknown_"), "'arg' should be one of", fixed=TRUE) }) test_that("keypos() works as intended", { x = as.integer64(c(5L, 2L, 5L, 3L, 2L, 4L)) x_keypos = c(4L, 1L, 4L, 2L, 1L, 3L) expect_identical(keypos(x), x_keypos) expect_identical(keypos(x, method="orderkey"), x_keypos) expect_error(keypos(x, method="_unknown_"), "'arg' should be one of", fixed=TRUE) }) test_that("summary() works as intended", { x = as.integer64(c(1L, 2L, 10L, 20L, NA, 30L)) # NB: as.integer64() strips names, so as.integer64(c(Min. = ...)) won't work x_summary = as.integer64(c(1L, 2L, 10L, 12L, 20L, 30L, 1L)) names(x_summary) = c("Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.", "NA's") expect_identical(summary(x), x_summary) expect_identical(summary(x[-5L]), x_summary[-7L]) }) test_that("prank() works as intended", { x = as.integer64(1:100) expect_identical(prank(x), (x-1.0)/99.0) expect_identical(prank(x[1L]), NA_integer64_) }) test_that("match.integer64 with method='orderpos' works", { x <- as.integer64(1:5) table <- as.integer64(3:7) expect_identical(match(x, table, method="orderpos"), c(NA, NA, 1:3)) }) test_that("match.integer64 with partial cache triggers fallback", { x <- as.integer64(1:5) table <- as.integer64(3:7) sortcache(table) # creates 'sort' and 'nunique' in cache # This should fallback to hashpos/hashrev logic. # x is small, table is small. expect_identical(match(x, table), c(NA_integer_, NA_integer_, 1L, 2L, 3L)) remcache(table) }) test_that("match.integer64 and %in% cover various cache states", { x = as.integer64(c(1L, 3L, 5L)) table = as.integer64(c(2L, 4L, 3L, 1L)) # Cover hashpos via cache selection hashcache(table) expect_identical(match(x, table), c(4L, 3L, NA_integer_)) expect_identical(x %in% table, c(TRUE, TRUE, FALSE)) remcache(table) # Cover sortorderpos/sortfin via cache selection sortordercache(table) expect_identical(match(x, table), c(4L, 3L, NA_integer_)) expect_identical(x %in% table, c(TRUE, TRUE, FALSE)) remcache(table) # Cover orderfin via cache selection (used by %in%) ordercache(table) expect_identical(x %in% table, c(TRUE, TRUE, FALSE)) # Cover orderpos logic if possible via automatic selection # Note: explicit method="orderpos" has known issues in other tests, # but this checks the automatic selection path based on cache existence. remcache(table) # Explicitly trigger hashrev with cache (requires cache on x) hashcache(x) expect_identical(match(x, table, method="hashrev"), c(4L, 3L, NA_integer_)) remcache(x) }) test_that("duplicated.integer64 covers various cache states", { x = as.integer64(c(1L, 2L, 1L)) res = c(FALSE, FALSE, TRUE) # Cover sortorderdup with existing cache (retrieving sort/order from cache) sortordercache(x) expect_identical(duplicated(x), res) # Force specific method to ensure cache path is used expect_identical(duplicated(x, method="sortorderdup"), res) remcache(x) # Cover hashdup with existing cache hashcache(x) expect_identical(duplicated(x), res) remcache(x) # Cover orderdup with existing cache ordercache(x) expect_identical(duplicated(x), res) expect_identical(duplicated(x, method="orderdup"), res) remcache(x) }) test_that("unique.integer64 covers various cache states and order arguments", { x = as.integer64(c(3L, 1L, 3L)) # order="original" + hashcache hashcache(x) expect_identical(unique(x, order="original"), x[1:2]) remcache(x) # order="original" + ordercache ordercache(x) expect_identical(unique(x, order="original"), x[1:2]) remcache(x) # order="original" + sortordercache sortordercache(x) expect_identical(unique(x, order="original"), x[1:2]) remcache(x) # order="values" + sortcache (triggers sortuni from cache) sortcache(x) expect_identical(unique(x, order="values"), as.integer64(c(1L, 3L))) remcache(x) # order="values" + hashcache (triggers hashuni if nunique < length/2) x2 = as.integer64(rep(1L, 5L)) hashcache(x2) expect_identical(unique(x2, order="values"), as.integer64(1L)) remcache(x2) # order="values" + ordercache (triggers orderuni) ordercache(x) expect_identical(unique(x, order="values"), as.integer64(c(1L, 3L))) remcache(x) # order="any" + hashcache hashcache(x) res = unique(x, order="any") expect_setequal(res, as.integer64(c(1L, 3L))) remcache(x) }) test_that("unipos.integer64 covers various cache states", { x = as.integer64(c(3L, 1L, 3L)) # positions: 1, 2 # order="original" + hashcache hashcache(x) expect_identical(unipos(x, order="original"), c(1L, 2L)) remcache(x) # order="values" + sortcache (triggers sortorderupo) sortcache(x) expect_identical(unipos(x, order="values"), c(2L, 1L)) remcache(x) # order="values" + ordercache (triggers orderupo) ordercache(x) expect_identical(unipos(x, order="values"), c(2L, 1L)) remcache(x) # order="values" + hashcache (with nunique < length/2, triggers hashupo) x_many_dups = as.integer64(c(rep(1L, 5L), 2L)) hashcache(x_many_dups) expect_identical(unipos(x_many_dups, order="values"), c(1L, 6L)) remcache(x_many_dups) # order="any" + sortordercache sortordercache(x) res = unipos(x, order="any") expect_true(setequal(res, c(1L, 2L))) remcache(x) }) test_that("table.integer64 covers inputs, cache states, and return types", { x = as.integer64(c(1L, 2L, 1L)) # List input handling t_list = table(list(x)) t_vec = table(x) expect_identical(as.vector(t_list), as.vector(t_vec)) expect_shape(t_list, dim=dim(t_vec)) # Error: length mismatch expect_error(table(x, as.integer64(1:2)), "all arguments must have the same length") # return="data.frame" df = table(x, return="data.frame") expect_identical(df, data.frame(x=as.integer64(1:2), Freq=as.integer(c(2L, 1L)))) # return="list" lst = table(x, return="list") expect_identical(lst$values, as.integer64(1:2)) # Fix: Counts are standard integer expect_identical(lst$counts, as.integer(c(2L, 1L))) # order="counts" tbl_cnt = table(x, order="counts") # 2 appears 1x, 1 appears 2x. Sorted by counts ascending: 2, 1. expect_identical(as.vector(tbl_cnt), c(1L, 2L)) # Method selection: hashtab via cache hashcache(x) expect_identical(as.vector(table(x)), c(2L, 1L)) remcache(x) # Method selection: sorttab via cache sortcache(x) expect_identical(as.vector(table(x)), c(2L, 1L)) remcache(x) # Method selection: ordertab via cache ordercache(x) expect_identical(as.vector(table(x)), c(2L, 1L)) remcache(x) # Cross-tabulation coverage y = as.integer64(c(1L, 2L, 1L)) t2 = table(x, y, return="data.frame") # Unique pairs are (1,1) and (2,2) --> 2 rows expect_shape(t2, nrow=2L) # Potential overflow check for combinations > 2^63 # We construct a list of many small vectors. args = rep(list(as.integer64(1:2)), 65L) # Suppress warning about overflow ("NAs produced by integer64 overflow") # to verify the explicit stop error cleanly. expect_error(suppressWarnings(do.call(table, args)), "attempt to make a table from more than") }) test_that("table dispatch integer64 and 'higher' types and factors", { expect_identical(table(as.integer64(1L), "a"), table(1L, "a")) expect_identical(table("a", as.integer64(1L)), table("a", 1L)) expect_identical(table(as.integer64(1L), factor("a")), table(1L, factor("a"))) expect_identical(table(factor("a"), as.integer64(1L)), table(factor("a"), 1L)) expect_identical(table(as.integer64(1L), 1.0), table(1L, 1.0)) expect_identical(table(1.0, as.integer64(1L)), table(1.0, 1L)) expect_identical(table(as.integer64(1L), 1e100), table(1L, 1e100)) expect_identical(table(1e100, as.integer64(1L)), table(1e100, 1L)) expect_identical(table(as.integer64(1L), 1.0+1.0i), table(1L, 1.0+1.0i)) expect_identical(table(1.0+1.0i, as.integer64(1L)), table(1.0+1.0i, 1L)) }) test_that("implicit tests from ?match work", { x = as.integer64(sample(c(rep(NA, 9L), 0:9), 32L, TRUE)) table = as.integer64(sample(c(rep(NA, 9L), 1:9), 32L, TRUE)) expect_identical( match(x, table), match(as.integer(x), as.integer(table)) ) expect_identical( x %in% table, as.integer(x) %in% as.integer(table) ) }) test_that("implicit tests from ?unipos and ?keypos work", { x = as.integer64(sample(c(rep(NA, 9L), 1:9), 32L, TRUE)) expect_identical(unipos(x), seq_along(x)[!duplicated(x)]) expect_identical(unipos(x), match(unique(x), x)) expect_identical(unipos(x, order="values"), match(unique(x, order="values"), x)) expect_identical(unique(x), x[unipos(x)]) expect_identical(unique(x, order="values"), x[unipos(x, order="values")]) x = as.integer64(sample(c(rep(NA, 9L), 1:9), 32L, TRUE)) expect_identical(keypos(x), match(x, sort(unique(x), na.last=FALSE))) }) test_that("implicit test from ?rank.integer64 works", { x <- as.integer64(sample(c(rep(NA, 9L), 1:9), 32L, TRUE)) expect_identical( rank(x), rank(as.integer(x), na.last="keep", ties.method="average") ) }) test_that("implicit test from ?rank.integer64 works", { x <- as.integer64(sample(c(rep(NA, 9), 1:9), 32, TRUE)) expect_identical( rank(x), rank(as.integer(x), na.last="keep", ties.method="average") ) }) test_that("keypos, tiepos, rank, qtile with ordercache", { x = as.integer64(c(5L, 2L, 5L, 3L, 2L, 4L)) # Populate ordercache (has 'order' but not 'sort') ordercache(x) # 1. keypos (should use orderkey path) x_keypos = c(4L, 1L, 4L, 2L, 1L, 3L) expect_identical(keypos(x), x_keypos) # 2. tiepos (should use ordertie path) expect_identical(tiepos(x), c(1L, 2L, 3L, 5L)) # 3. rank (should use orderrnk path) expect_identical(rank(x), c(5.5, 1.5, 5.5, 3.0, 1.5, 4.0)) # 4. qtile (should use orderqtl path) expected_q = qtile(x, probs=seq(0.0, 1.0, 0.25), names=FALSE) # Reset cache and use sortqtl to get expected x_no_cache = as.integer64(c(5L, 2L, 5L, 3L, 2L, 4L)) expected_q_sort = qtile(x_no_cache, probs=seq(0.0, 1.0, 0.25), names=FALSE) expect_identical(expected_q, expected_q_sort) remcache(x) }) test_that("table.integer64 multidimensional cache states", { a = as.integer64(c(1L, 2L, 1L)) b = as.integer64(c(2L, 1L, 2L)) c = as.integer64(c(1L, 1L, 2L)) # a: no cache (triggers ramsortorder) # b: ordercache (triggers order only) ordercache(b) # c: sortordercache (triggers sort and order) sortordercache(c) t = table(a, b, c, return="data.frame") expect_s3_class(t, "data.frame") remcache(b) remcache(c) }) test_that("keypos, tiepos, rank, qtile with sortordercache", { x = as.integer64(c(5L, 2L, 5L, 3L, 2L, 4L)) sortordercache(x) # 1. keypos (should use sortorderkey path from cache) x_keypos = c(4L, 1L, 4L, 2L, 1L, 3L) expect_identical(keypos(x), x_keypos) # 2. tiepos (should use sortordertie path from cache) expect_identical(tiepos(x), c(1L, 2L, 3L, 5L)) # 3. rank (should use sortorderrnk path from cache) expect_identical(rank(x), c(5.5, 1.5, 5.5, 3.0, 1.5, 4.0)) # 4. qtile (should use sortqtl path from cache) expected_q = qtile(x, probs=seq(0.0, 1.0, 0.25), names=FALSE) x_no_cache = as.integer64(c(5L, 2L, 5L, 3L, 2L, 4L)) expected_q_sort = qtile(x_no_cache, probs=seq(0.0, 1.0, 0.25), names=FALSE) expect_identical(expected_q, expected_q_sort) remcache(x) }) test_that("qtile with sortcache", { x = as.integer64(c(5L, 2L, 5L, 3L, 2L, 4L)) sortcache(x) expected_q = qtile(x, probs=seq(0.0, 1.0, 0.25), names=FALSE) x_no_cache = as.integer64(c(5L, 2L, 5L, 3L, 2L, 4L)) expected_q_sort = qtile(x_no_cache, probs=seq(0.0, 1.0, 0.25), names=FALSE) expect_identical(expected_q, expected_q_sort) remcache(x) }) test_that("mean.integer64 works", { x = as.integer64(c(1:3, NA)) expect_identical(mean(x, na.rm=TRUE), as.integer64(2L)) expect_identical(mean(x, na.rm=FALSE), NA_integer64_) }) test_that("highlevel S3 methods incomparables error", { x = as.integer64(1:3) expect_error(unique(x, incomparables=TRUE), '`incomparables=TRUE`.*not yet supported') expect_error(unipos(x, incomparables=TRUE), '`incomparables=TRUE`.*not yet supported') expect_error(duplicated(x, incomparables=TRUE), '`incomparables=TRUE`.*not yet supported') }) test_that("qtile invalid probs error", { x = as.integer64(1:3) expect_error(qtile(x, probs=-0.1), "p outside") expect_error(qtile(x, probs=1.1), "p outside") expect_error(qtile(x, probs=NA_real_), "p outside") }) test_that("order.integer64 multiple vectors error", { x = as.integer64(1:3) y = as.integer64(3:1) expect_error(order(x, y), "can only order one vector") }) test_that("factor and ordered with large vectors (length >= 4000)", { n = 4005L x = as.integer64(sample.int(5L, n, replace=TRUE)) # 1. default labels (missing) f1 = factor(x) expect_s3_class(f1, "factor") expect_length(f1, n) expect_identical(levels(f1), as.character(1:5)) # 2. custom labels (length(labels) == length(levels)) f2 = factor(x, labels=c("A", "B", "C", "D", "E")) expect_identical(levels(f2), c("A", "B", "C", "D", "E")) # 3. single label (length(labels) == 1) f3 = factor(x, labels="L") expect_identical(levels(f3), paste0("L", 1:5)) # 4. invalid labels length expect_error(factor(x, labels=c("A", "B")), "invalid 'labels'") # 5. ordered factor o1 = ordered(x) expect_s3_class(o1, c("ordered", "factor")) }) test_that("match.integer64 hashrev with sortordercache on x", { x = as.integer64(c(1L, 3L, 5L)) table = as.integer64(c(2L, 4L, 3L, 1L)) sortordercache(x) expect_identical(match(x, table, method="hashrev"), c(4L, 3L, NA_integer_)) remcache(x) }) test_that("table.integer64 multidimensional return formats", { a = as.integer64(c(1L, 2L, 1L)) b = as.integer64(c(2L, 1L, 2L)) # 1. return="data.frame" df = table(a, b, return="data.frame") expect_s3_class(df, "data.frame") expect_shape(df, dim=2:3) # 2. return="list" lst = table(a, b, return="list") expect_type(lst, "list") expect_named(lst, c("values", "counts", "dims")) expect_length(lst$dims, 2L) }) test_that("table.integer64 exclude and useNA work", { a = as.integer64(c(1L, 1L, 2L, NA)) b = as.integer64(c(2L, 2L, 1L, NA)) # 1D table t1 = table(a, exclude=1L) expect_named(t1, c("2", NA_character_)) t2 = table(a, useNA="always") expect_named(t2, c("1", "2", NA_character_)) # 2D table t3 = table(a, b, exclude=1L, useNA="always") expect_s3_class(t3, "table") expect_identical(dimnames(t3)[[1L]], c("2", NA_character_)) expect_identical(dimnames(t3)[[2L]], c("2", NA_character_)) }) test_that("duplicated.integer64 with sortcache", { x = as.integer64(c(1L, 2L, 1L)) sortcache(x) expect_identical(duplicated(x), c(FALSE, FALSE, TRUE)) remcache(x) }) test_that("unipos.integer64 sortcache permutations", { x = as.integer64(c(3L, 1L, 3L)) # 1. order="original" + sortcache (triggers hashmapupo) sortcache(x) expect_identical(unipos(x, order="original"), c(1L, 2L)) remcache(x) # 2. order="any" + sortcache (triggers sortorderupo) sortcache(x) res = unipos(x, order="any") expect_true(setequal(res, c(1L, 2L))) remcache(x) }) test_that("unique.integer64 sortcache permutations", { x = as.integer64(c(3L, 1L, 3L)) # 1. order="original" + sortcache (triggers hashmapuni) sortcache(x) expect_identical(unique(x, order="original"), x[1:2]) remcache(x) # 2. order="any" + sortcache (triggers sortuni) sortcache(x) res = unique(x, order="any") expect_setequal(res, as.integer64(c(1L, 3L))) remcache(x) }) test_that("table.integer64 with list argument", { a = as.integer64(c(1L, 2L, 1L)) b = as.integer64(c(2L, 1L, 2L)) t = table(list(a=a, b=b)) expect_s3_class(t, "table") expect_shape(t, dim=c(2L, 2L)) }) test_that("unique and unipos with nunique < length/2", { x = as.integer64(c(2L, 2L, 2L, 1L, 1L)) hashcache(x) expect_identical(unique(x, order="values"), as.integer64(1:2)) expect_identical(unipos(x, order="values"), c(4L, 1L)) remcache(x) })