Skip to content

Commit

Permalink
Coverage tests of highlevel64.R (#81)
Browse files Browse the repository at this point in the history 
* Coverage tests of unipos(), keypos()

* Add a test for summary()

* Add a test for prank()

* more rank() and tiepos() tests

* More method=, some errors

* More tests, including improving error messages

* Two tiny tests so that #missing here is not #1 anymore
  • Loading branch information
@MichaelChirico
MichaelChirico authored Oct 15, 2024
1 parent 3cc2e4b commit 7899e98
Show file tree
Hide file tree
Showing 2 changed files with 101 additions and 45 deletions.
85 changes: 41 additions & 44 deletions R/highlevel64.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1426,7 +1426,7 @@ match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, metho
}
p <- orderpos(table, o, x, nomatch=nomatch)
}
, stop("unknown method")
, stop("unknown method ", method)
)
p
}
Expand All @@ -1436,42 +1436,39 @@ match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, metho
`%in%.integer64` <- function(x, table, ...){
stopifnot(is.integer64(x))
table <- as.integer64(table)
nunique <- NULL
method <- NULL
nunique <- NULL
cache_env <- cache(table)
if (is.null(method)){
if (is.null(cache_env)){
nx <- length(x)
if (is.null(nunique))
nunique <- length(table)
btable <- as.integer(ceiling(log2(nunique*1.5)))
bx <- as.integer(ceiling(log2(nx*1.5)))
if (bx<=17L && btable>=16L){
method <- "hashrin"
}else{
method <- "hashfin"
}
} else if (exists("hashmap", envir=cache_env, inherits=FALSE)) {
method <- "hashfin"
} else if (exists("sort", envir=cache_env, inherits=FALSE) && (length(table)>length(x) || length(x)<4096L)) {
method <- "sortfin"
} else if (exists("order", envir=cache_env, inherits=FALSE) && (length(table)>length(x) || length(x)<4096L)) {
method <- "orderfin"
if (is.null(cache_env)) {
nx <- length(x)
if (is.null(nunique))
nunique <- length(table)
btable <- as.integer(ceiling(log2(nunique*1.5)))
bx <- as.integer(ceiling(log2(nx*1.5)))
if (bx<=17L && btable>=16L) {
method <- "hashrin"
} else {
nx <- length(x)
if (is.null(nunique)){
if (exists("nunique", envir=cache_env, inherits=FALSE))
nunique <- cache_env$nunique
else
nunique <- length(table)
}
btable <- as.integer(ceiling(log2(nunique*1.5)))
bx <- as.integer(ceiling(log2(nx*1.5)))
if (bx<=17L && btable>=16L) {
method <- "hashrin"
} else {
method <- "hashfin"
}
method <- "hashfin"
}
} else if (exists("hashmap", envir=cache_env, inherits=FALSE)) {
method <- "hashfin"
} else if (exists("sort", envir=cache_env, inherits=FALSE) && (length(table)>length(x) || length(x)<4096L)) {
method <- "sortfin"
} else if (exists("order", envir=cache_env, inherits=FALSE) && (length(table)>length(x) || length(x)<4096L)) {
method <- "orderfin"
} else {
nx <- length(x)
if (is.null(nunique)){
if (exists("nunique", envir=cache_env, inherits=FALSE))
nunique <- cache_env$nunique
else
nunique <- length(table)
}
btable <- as.integer(ceiling(log2(nunique*1.5)))
bx <- as.integer(ceiling(log2(nx*1.5)))
if (bx<=17L && btable>=16L) {
method <- "hashrin"
} else {
method <- "hashfin"
}
}
switch(method
Expand Down Expand Up @@ -1520,7 +1517,7 @@ match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, metho
}
p <- orderfin(table, o, x)
}
, stop("unknown method")
, stop("unknown method ", method)
)
p
}
Expand Down Expand Up @@ -1571,7 +1568,7 @@ duplicated.integer64 <- function(x
if (is.null(method)){
if (is.null(cache_env)){
if (length(x)>50000000L)
method <- "sortorderdup"
method <- "sortorderdup" # nocov. Too large for practical unit tests.
else
method <- "hashdup"
} else if (exists("sort", envir=cache_env, inherits=FALSE) && exists("order", envir=cache_env, inherits=FALSE))
Expand Down Expand Up @@ -1613,7 +1610,7 @@ duplicated.integer64 <- function(x
}
p <- orderdup(x, o)
}
, stop("unknown method", method)
, stop("unknown method ", method)
)
p
}
Expand Down Expand Up @@ -1774,7 +1771,7 @@ unique.integer64 <- function(x
nunique <- ordernut(x, o)[1L]
p <- orderuni(x, o, nunique, keep.order=keep.order)
}
, stop("unknown method", method)
, stop("unknown method ", method)
)
p
}
Expand Down Expand Up @@ -1926,7 +1923,7 @@ unipos.integer64 <- function(x
nunique <- ordernut(x, o)[1L]
p <- orderupo(x, o, nunique, keep.order=keep.order)
}
, stop("unknown method", method)
, stop("unknown method ", method)
)
p
}
Expand Down Expand Up @@ -2326,7 +2323,7 @@ keypos.integer64 <- function(x
}
p <- orderkey(x, o)
}
, stop("unknown method", method)
, stop("unknown method ", method)
)
p
}
Expand Down Expand Up @@ -2409,7 +2406,7 @@ tiepos.integer64 <- function(x
nties <- ordernut(x, o)[2L]
p <- ordertie(x, o, nties)
}
, stop("unknown method", method)
, stop("unknown method ", method)
)
p
}
Expand Down Expand Up @@ -2481,7 +2478,7 @@ rank.integer64 <- function(x
}
p <- orderrnk(x, o, na.count)
}
, stop("unknown method", method)
, stop("unknown method ", method)
)
p
}
Expand Down Expand Up @@ -2613,7 +2610,7 @@ qtile.integer64 <- function(x, probs = seq(0.0, 1.0, 0.25), names = TRUE, method
}
qs <- orderqtl(x, o, na.count, probs)
}
, stop("unknown method", method)
, stop("unknown method ", method)
)
if (names){
np <- length(probs)
Expand Down
61 changes: 60 additions & 1 deletion tests/testthat/test-highlevel64.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ test_that("Different method= for match() and %in% work", {
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_"), "unknown method _unknown_", fixed=TRUE)
# TODO(#58): Fix this, currently fails.
# expect_identical(match(x, y, method="orderpos"), expected)

Expand Down Expand Up @@ -63,6 +64,9 @@ test_that("duplicated, unique, table methods work", {
expect_identical(duplicated(x), c(FALSE, TRUE, FALSE))
expect_identical(unique(x), x[c(1L, 3L)])
expect_identical(table.integer64(x), table(x = c(1L, 1L, 2L)))

expect_error(duplicated(x, method="_unknown_"), "unknown method _unknown_", fixed=TRUE)
expect_error(unique(x, method="_unknown_"), "unknown method _unknown_", fixed=TRUE)
})

test_that("different method= for duplicated, unique work", {
Expand Down Expand Up @@ -90,7 +94,10 @@ test_that("more coercion works", {
})

test_that("sorting methods work", {
expect_identical(rank(as.integer64(c(10L, 4L, 8L))), c(3.0, 1.0, 2.0))
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))
Expand All @@ -99,6 +106,25 @@ test_that("sorting methods work", {
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(median(NA_integer64_), "missing values not allowed")
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_"), "unknown method _unknown_", fixed=TRUE)
expect_error(qtile(x, method="_unknown_"), "unknown method _unknown_", fixed=TRUE)
expect_error(tiepos(x, method="_unknown_"), "unknown method _unknown_", fixed=TRUE)
})

# These tests were previously kept as tests under \examples{\dontshow{...}}.
Expand Down Expand Up @@ -138,3 +164,36 @@ test_that("Old \\dontshow{} tests continue working", {
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_"), "unknown method _unknown_", 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_"), "unknown method _unknown_", 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_)
})

0 comments on commit 7899e98

Please sign in to comment.