Skip to content

Commit

Permalink
Tests of is.sorted, sortfin (#163)
Browse files Browse the repository at this point in the history
* Don't use redundant PACKAGE=

* caught typo

* Simple tests of is.sorted & sortfin

* earlier missed R CMD check note re: utils::head

* disable segfaulting test for now
  • Loading branch information
MichaelChirico authored Feb 2, 2025
1 parent 14744c1 commit 705f455
Show file tree
Hide file tree
Showing 10 changed files with 45 additions and 69 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -402,6 +402,7 @@ importFrom(methods,is)
importFrom(stats,cor)
importFrom(stats,median)
importFrom(stats,quantile)
importFrom(utils,head)
importFrom(utils,packageDescription)
importFrom(utils,strOptions)
importFrom(utils,tail)
Expand Down
2 changes: 1 addition & 1 deletion R/bit64-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -697,7 +697,7 @@
#' @importFrom graphics barplot par title
#' @importFrom methods as is
#' @importFrom stats cor median quantile
#' @importFrom utils packageDescription strOptions tail
#' @importFrom utils head packageDescription strOptions tail
#' @export : :.default :.integer64
#' @export [.integer64 [[.integer64 [[<-.integer64 [<-.integer64
#' @export %in% %in%.default
Expand Down
26 changes: 10 additions & 16 deletions R/cache.R
Original file line number Diff line number Diff line change
Expand Up @@ -207,7 +207,7 @@ sortcache <- function(x, has.na = NULL) {
}
s <- clone(x)
na.count <- ramsort(s, has.na = has.na, na.last = FALSE, decreasing = FALSE, stable = FALSE, optimize = "time")
nut <- .Call(C_r_ram_integer64_sortnut, x = s, PACKAGE = "bit64")
nut <- .Call(C_r_ram_integer64_sortnut, x = s)
setcache(x, "sort", s)
setcache(x, "na.count", na.count)
setcache(x, "nunique", nut[[1L]])
Expand Down Expand Up @@ -238,7 +238,7 @@ sortordercache <- function(x, has.na = NULL, stable = NULL) {
o <- seq_along(x)
na.count <-
ramsortorder(s, o, has.na = has.na, na.last = FALSE, decreasing = FALSE, stable = stable, optimize = "time")
nut <- .Call(C_r_ram_integer64_sortnut, x = s, PACKAGE = "bit64")
nut <- .Call(C_r_ram_integer64_sortnut, x = s)
setcache(x, "sort", s)
setcache(x, "order", o)
setcache(x, "na.count", na.count)
Expand Down Expand Up @@ -269,7 +269,7 @@ ordercache <- function(x, has.na = NULL, stable = NULL, optimize = "time") {
o <- seq_along(x)
na.count <-
ramorder(x, o, has.na = has.na, na.last = FALSE, decreasing = FALSE, stable = stable, optimize = optimize)
nut <- .Call(C_r_ram_integer64_ordernut, table = x, order = o, PACKAGE = "bit64")
nut <- .Call(C_r_ram_integer64_ordernut, table = x, order = o)
setcache(x, "order", o)
setcache(x, "na.count", na.count)
setcache(x, "nunique", nut[[1L]])
Expand Down Expand Up @@ -320,10 +320,10 @@ NULL
na.count.integer64 <- function(x, ...) {
env <- cache(x)
if (is.null(env))
return(.Call(C_r_ram_integer64_nacount, x = x, PACKAGE = "bit64"))
return(.Call(C_r_ram_integer64_nacount, x = x))
if (exists("na.count", envir=env, inherits=FALSE))
return(get("na.count", envir=env, inherits=FALSE))
ret <- .Call(C_r_ram_integer64_nacount, x = x, PACKAGE = "bit64")
ret <- .Call(C_r_ram_integer64_nacount, x = x)
assign("na.count", ret, envir=env)
ret
}
Expand All @@ -340,10 +340,10 @@ nvalid.integer64 <- function(x, ...) {
is.sorted.integer64 <- function(x, ...) {
env <- cache(x)
if (is.null(env))
return(.Call(C_r_ram_integer64_issorted_asc, x = x, PACKAGE = "bit64"))
return(.Call(C_r_ram_integer64_issorted_asc, x = x))
if (exists("is.sorted", envir=env, inherits=FALSE))
return(get("is.sorted", envir=env, inherits=FALSE))
ret <- .Call(C_r_ram_integer64_issorted_asc, x = x, PACKAGE = "bit64")
ret <- .Call(C_r_ram_integer64_issorted_asc, x = x)
assign("is.sorted", ret, envir=env)
ret
}
Expand All @@ -359,10 +359,7 @@ nunique.integer64 <- function(x, ...) {
else # nolint: unreachable_code_linter. TODO(r-lib/lintr#2710): Re-enable.
has.cache <- TRUE
if (is.sorted(x)) {
ret <- .Call(C_r_ram_integer64_sortnut
, x = x
, PACKAGE = "bit64"
)
ret <- .Call(C_r_ram_integer64_sortnut, x = x)
if (has.cache) {
assign("nunique", ret[1L], envir=env)
assign("nties", ret[2L], envir=env)
Expand All @@ -382,16 +379,13 @@ nties.integer64 <- function(x, ...) {
cv <- getcache(x, "nties")
if (is.null(cv)) {
if (is.sorted(x)) {
cv <- .Call(C_r_ram_integer64_sortnut
, x = x
, PACKAGE = "bit64"
)[2L]
cv <- .Call(C_r_ram_integer64_sortnut, x = x)[2L]
} else {
s <- clone(x)
# nolint next: object_usage_linter. Keep the output of in-place ramsort for debugging.
na.count <-
ramsort(s, has.na = TRUE, na.last = FALSE, decreasing = FALSE, stable = FALSE, optimize = "time")
cv <- .Call(C_r_ram_integer64_sortnut, x = s, PACKAGE = "bit64")[[2L]]
cv <- .Call(C_r_ram_integer64_sortnut, x = s)[[2L]]
}
}
cv
Expand Down
12 changes: 0 additions & 12 deletions R/sort64.R
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,6 @@ shellsort.integer64 <- function(x, has.na=TRUE, na.last=FALSE, decreasing=FALSE,
, has_na = as.logical(has.na)
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, PACKAGE = "bit64"
)
}

Expand All @@ -103,7 +102,6 @@ shellsortorder.integer64 <- function(x, i, has.na=TRUE, na.last=FALSE, decreasin
, has_na = as.logical(has.na)
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, PACKAGE = "bit64"
)
}

Expand All @@ -122,7 +120,6 @@ shellorder.integer64 <- function(x, i, has.na=TRUE, na.last=FALSE, decreasing=FA
, has_na = as.logical(has.na)
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, PACKAGE = "bit64"
)
}

Expand All @@ -135,7 +132,6 @@ mergesort.integer64 <- function(x, has.na=TRUE, na.last=FALSE, decreasing=FALSE,
, has_na = as.logical(has.na)
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, PACKAGE = "bit64"
)
}

Expand All @@ -154,7 +150,6 @@ mergeorder.integer64 <- function(x, i, has.na=TRUE, na.last=FALSE, decreasing=FA
, has_na = as.logical(has.na)
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, PACKAGE = "bit64"
)
}

Expand All @@ -173,7 +168,6 @@ mergesortorder.integer64 <- function(x, i, has.na=TRUE, na.last=FALSE, decreasin
, has_na = as.logical(has.na)
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, PACKAGE = "bit64"
)
}

Expand All @@ -194,7 +188,6 @@ quicksort.integer64 <- function(x,
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, restlevel = as.integer(restlevel)
, PACKAGE = "bit64"
)
}

Expand All @@ -221,7 +214,6 @@ quicksortorder.integer64 <- function(x, i,
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, restlevel = as.integer(restlevel)
, PACKAGE = "bit64"
)
}

Expand All @@ -248,7 +240,6 @@ quickorder.integer64 <- function(x, i,
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, restlevel = as.integer(restlevel)
, PACKAGE = "bit64"
)
}

Expand All @@ -263,7 +254,6 @@ radixsort.integer64 <- function(x, has.na=TRUE, na.last=FALSE, decreasing=FALSE,
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, radixbits = as.integer(radixbits)
, PACKAGE = "bit64"
)
}

Expand All @@ -284,7 +274,6 @@ radixsortorder.integer64 <- function(x, i, has.na=TRUE, na.last=FALSE, decreasin
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, radixbits = as.integer(radixbits)
, PACKAGE = "bit64"
)
}

Expand All @@ -305,7 +294,6 @@ radixorder.integer64 <- function(x, i, has.na=TRUE, na.last=FALSE, decreasing=FA
, na_last = as.logical(na.last)
, decreasing = as.logical(decreasing)
, radixbits = as.integer(radixbits)
, PACKAGE = "bit64"
)
}

Expand Down
Loading

0 comments on commit 705f455

Please sign in to comment.