diff --git a/NEWS.md b/NEWS.md index c58f5e2b..63a129e7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,7 +10,7 @@ 1. When integer64 and character are combined, the result will be character. This prevents loss of information, e.g. in `c(as.integer64(1L), "a")` and `c(as.integer64(1L), "999999999999999999999999")`. To try this in advance for `c.integer64`, `cbind.integer64`, `rbind.integer64`, `[.integer64<-`, `[[.integer64<-`, `union`, `intersect`, `setdiff`, `setdiff` and `is.element` one can set the option `bit64.promoteInteger64ToCharacter=TRUE`. -1. Some `as.integer64()` methods, e.g. `"double"`, allowed `keep.names=TRUE` to have `names(as.integer64(x)) == names(x)`. This is inconsistent with other vector coercions like `as.integer()`, `as.double()`, `as.character()`, ... which strip names. Therefore, starting from the next release, it will be a warning to use this argument; users should just add code to retain the names. +1. Some `as.integer64()` methods, e.g. `"double"`, allowed `keep.names=TRUE` to have `names(as.integer64(x)) == names(x)`. This is inconsistent with other vector coercions like `as.integer()`, `as.double()`, `as.character()`, ... which strip names. Therefore, starting from the next release, it will be a warning to use this argument; users should just add code to retain the names. For now, the argument is hidden behind `...`. ## BREAKING CHANGES diff --git a/R/cache.R b/R/cache.R index c7bdd077..e9e0e618 100644 --- a/R/cache.R +++ b/R/cache.R @@ -207,6 +207,8 @@ sortcache = function(x, has.na=NULL, na.last=FALSE) { has.na = na.count > 0L } s = clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) na.count = ramsort(s, has.na=has.na, na.last=na.last, decreasing=FALSE, stable=FALSE, optimize="time") nut = .Call(C_r_ram_integer64_sortnut, x=s) setcache(x, "sort", s) @@ -236,6 +238,8 @@ sortordercache = function(x, has.na=NULL, stable=NULL, na.last=FALSE) { stable = nunique < length(x) } s = clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o = seq_along(x) na.count = ramsortorder(s, o, has.na=has.na, na.last=na.last, decreasing=FALSE, stable=stable, optimize="time") nut = .Call(C_r_ram_integer64_sortnut, x=s) @@ -381,6 +385,8 @@ nties.integer64 = function(x, ...) { cv = .Call(C_r_ram_integer64_sortnut, x=x)[2L] } else { s = clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) # 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)[[2L]] diff --git a/R/highlevel64.R b/R/highlevel64.R index 4cd9fd0c..3e89cb9a 100644 --- a/R/highlevel64.R +++ b/R/highlevel64.R @@ -471,6 +471,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortorderpos", "prep"] = system.time({ s2 = clone(x2) + remcache(s2) o2 = seq_along(x2) ramsortorder(s2, o2, na.last=FALSE) })[3L] @@ -568,6 +569,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortfin", "prep"] = timefun({ s2 = clone(x2) + remcache(s2) ramsort(s2, na.last=FALSE) })[3L] tim["sortfin", "use"] = timefun({ @@ -646,6 +648,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortorderdup1", "prep"] = timefun({ s = clone(x) + remcache(s) o = seq_along(x) ramsortorder(s, o, na.last=FALSE) nunique = sortnut(s)[1L] @@ -757,6 +760,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortuni", "prep"] = timefun({ s = clone(x) + remcache(s) ramsort(s, na.last=FALSE) nunique = sortnut(s)[1L] })[3L] @@ -768,6 +772,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortunikeep", "prep"] = timefun({ s = clone(x) + remcache(s) o = seq_along(x) ramsortorder(s, o, na.last=FALSE) nunique = sortnut(s)[1L] @@ -898,6 +903,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortorderupo", "prep"] = timefun({ s = clone(x) + remcache(s) o = seq_along(x) ramsortorder(s, o, na.last=FALSE) nunique = sortnut(s)[1L] @@ -910,6 +916,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortorderupokeep", "prep"] = timefun({ s = clone(x) + remcache(s) o = seq_along(x) ramsortorder(s, o, na.last=FALSE) nunique = sortnut(s)[1L] @@ -1043,6 +1050,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sorttab", "prep"] = timefun({ s = clone(x) + remcache(s) ramsort(s, na.last=FALSE) nunique = sortnut(s)[1L] })[3L] @@ -1053,6 +1061,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortordertab", "prep"] = timefun({ s = clone(x) + remcache(s) o = seq_along(x) ramsortorder(s, o, na.last=FALSE) nunique = sortnut(s)[1L] @@ -1137,6 +1146,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortorderrnk", "prep"] = timefun({ s = clone(x) + remcache(s) o = seq_along(x) na.count = ramsortorder(s, o, na.last=FALSE) })[3L] @@ -1204,6 +1214,7 @@ optimizer64 = function(nsmall=2L^16L, tim["sortqtl", "prep"] = timefun({ s = clone(x) + remcache(s) na.count = ramsort(s, na.last=FALSE) })[3L] tim["sortqtl", "use"] = timefun({ @@ -1490,6 +1501,8 @@ match.integer64 = function(x, table, nomatch = NA_integer_, nunique=NULL, method sortorderpos={ if (is.null(cache_env) || !exists("sort", cache_env) || !exists("order", cache_env)) { s <- clone(table) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o <- seq_along(s) ramsortorder(s, o, na.last=FALSE) } else { @@ -1588,6 +1601,8 @@ match.integer64 = function(x, table, nomatch = NA_integer_, nunique=NULL, method sortfin={ if (is.null(cache_env) || !exists("sort", cache_env)) { s = clone(table) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) ramsort(s, na.last=FALSE) } else { s = get("sort", cache_env) @@ -1675,6 +1690,8 @@ duplicated.integer64 = function(x, incomparables = FALSE, nunique = NULL, method sortorderdup={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o <- seq_along(s) ramsortorder(s, o, na.last=FALSE) } else { @@ -1821,6 +1838,8 @@ unique.integer64 = function(x, sortuni={ if (is.null(cache_env) || is.null(cache_env$sort)) { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) ramsort(s, na.last=FALSE) } else { s <- get("sort", cache_env, inherits=FALSE) @@ -1832,6 +1851,8 @@ unique.integer64 = function(x, sortorderuni={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o <- seq_along(x) ramsortorder(s, o, na.last=FALSE) } else { @@ -1980,6 +2001,8 @@ unipos.integer64 = function(x, sortorderupo={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o <- seq_along(x) ramsortorder(s, o, na.last=FALSE) } else { @@ -2252,6 +2275,8 @@ table.integer64 = function(..., cache_env = cache(a) if (is.null(cache_env$order)) { s = clone(a) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o = seq_along(s) ramsortorder(s, o, na.last=TRUE) nu[[i]] = sortnut(s)[["nunique"]] @@ -2328,6 +2353,8 @@ table.integer64 = function(..., sorttab={ if (is.null(cache_env) || is.null(cache_env$sort)) { s = clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) ramsort(s, na.last=TRUE) } else { s = get("sort", cache_env, inherits=FALSE) @@ -2471,6 +2498,8 @@ keypos.integer64 = function(x, method = NULL, ...) { sortorderkey={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o <- seq_along(x) ramsortorder(s, o, na.last=FALSE) } else { @@ -2548,6 +2577,8 @@ tiepos.integer64 = function(x, nties = NULL, method = NULL, ...) { sortordertie={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o <- seq_along(x) ramsortorder(s, o, na.last=FALSE) } else { @@ -2620,6 +2651,8 @@ rank.integer64 = function(x, method = NULL, ...) { sortorderrnk={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) o <- seq_along(x) na.count <- ramsortorder(s, o, na.last=FALSE) } else { @@ -2750,6 +2783,8 @@ qtile.integer64 = function(x, probs = seq(0.0, 1.0, 0.25), names = TRUE, method sortqtl={ if (is.null(cache_env) || is.null(cache_env$sort)) { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) na.count <- ramsort(s, na.last=FALSE) } else { s <- get("sort", cache_env, inherits=FALSE) diff --git a/R/integer64.R b/R/integer64.R index 8537ab53..9c861063 100644 --- a/R/integer64.R +++ b/R/integer64.R @@ -550,23 +550,31 @@ is.integer64 = function(x) inherits(x, "integer64") as.integer64.NULL = function(x, ...) integer64() #' @rdname as.integer64.character -#' @param keep.names Logical, default `FALSE`. If `TRUE`, the input's names are retained. #' @export -as.integer64.integer64 = function(x, ..., keep.names=FALSE) { - ret = unclass(x) - attributes(ret) = NULL - oldClass(ret) = "integer64" - # for back-compatibility, e.g. {nanotime} - if (isTRUE(keep.names)) names(ret) = names(x) - ret +as.integer64.integer64 = function(x, ...) { + if (isS4(x) || length(class(x)) != 1L || class(x)[1L] != "integer64") { + x = unclass(x) + oldClass(x) = "integer64" + } + # keep the valid cache if it exists (attr and attributes copy the object) + the_cache = cache(x) + # keep names for back-compatibility, e.g. {nanotime} + # remove all attributes except for 'class', 'cache' and 'names' (if keep.names), to avoid copying of x in case of existing attributes that should be kept + for (n in setdiff(names(attributes(x)), c("class", "cache", if (isTRUE(list(...)$keep.names)) "names"))) + attr(x, n) = NULL + if (!is.null(the_cache)) + # keep the cache valid + assign("x", x, envir = the_cache) + x } #' @rdname as.integer64.character #' @export -as.integer64.double = function(x, ..., keep.names=FALSE) { +as.integer64.double = function(x, ...) { ret = .Call(C_as_integer64_double, x, double(length(x))) oldClass(ret) = "integer64" - if (isTRUE(keep.names)) names(ret) = names(x) + if (isTRUE(list(...)$keep.names)) + names(ret) = names(x) ret } @@ -583,6 +591,8 @@ as.integer64.complex = function(x, ...) { ) ret = .Call(C_as_integer64_double, xd, double(length(xd))) oldClass(ret) = "integer64" + if (isTRUE(list(...)$keep.names)) + names(ret) = names(x) ret } @@ -591,6 +601,8 @@ as.integer64.complex = function(x, ...) { as.integer64.integer = function(x, ...) { ret = .Call(C_as_integer64_integer, x, double(length(x))) oldClass(ret) = "integer64" + if (isTRUE(list(...)$keep.names)) + names(ret) = names(x) ret } @@ -599,6 +611,8 @@ as.integer64.integer = function(x, ...) { as.integer64.raw = function(x, ...) { ret = .Call(C_as_integer64_integer, as.integer(x), double(length(x))) oldClass(ret) = "integer64" + if (isTRUE(list(...)$keep.names)) + names(ret) = names(x) ret } @@ -611,6 +625,8 @@ as.integer64.logical = as.integer64.integer as.integer64.character = function(x, ...) { ret = .Call(C_as_integer64_character, x, rep(NA_real_, length(x))) oldClass(ret) = "integer64" + if (isTRUE(list(...)$keep.names)) + names(ret) = names(x) ret } diff --git a/R/sort64.R b/R/sort64.R index b8453ea7..f24bbe71 100644 --- a/R/sort64.R +++ b/R/sort64.R @@ -483,6 +483,8 @@ sort.integer64 <- function(x, if (identical(cache_env$na.count, 0L)) has.na <- FALSE s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) na.count <- ramsort( s , has.na=has.na @@ -553,6 +555,8 @@ order.integer64 <- function(..., o <- seq_along(x) if (optimize == "time") { s <- clone(x) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(s) na.count <- ramsortorder(s, o , has.na=has.na , na.last=do.na.last diff --git a/R/sortuse64.R b/R/sortuse64.R index c3447205..5e425da8 100644 --- a/R/sortuse64.R +++ b/R/sortuse64.R @@ -126,6 +126,8 @@ sortfin.integer64 = function(sorted, x, method=NULL, ...) { ) } else { sx = clone(as.integer64(x)) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(sx) o = seq_along(x) ramsortorder(sx, o, na.last=FALSE, ...) ret = logical(n) @@ -258,6 +260,8 @@ sortorderpos.integer64 = function(sorted, order, x, nomatch=NA, method=NULL, ... ) } else { sx = clone(as.integer64(x)) + # clone invalidates the cache, so we can remove it to avoid warning messages + remcache(sx) o = seq_along(x) ramsortorder(sx, o, na.last=FALSE, ...) ret = integer(n) diff --git a/man/as.integer64.character.Rd b/man/as.integer64.character.Rd index 5190479c..fd382c75 100644 --- a/man/as.integer64.character.Rd +++ b/man/as.integer64.character.Rd @@ -27,9 +27,9 @@ as.integer64(x, ...) \method{as.integer64}{`NULL`}(x, ...) -\method{as.integer64}{integer64}(x, ..., keep.names = FALSE) +\method{as.integer64}{integer64}(x, ...) -\method{as.integer64}{double}(x, ..., keep.names = FALSE) +\method{as.integer64}{double}(x, ...) \method{as.integer64}{complex}(x, ...) @@ -59,8 +59,6 @@ NA_integer64_ \item{x}{an atomic vector} \item{..., units}{further arguments to the \code{\link[=NextMethod]{NextMethod()}}} - -\item{keep.names}{Logical, default \code{FALSE}. If \code{TRUE}, the input's names are retained.} } \value{ The other methods return atomic vectors of the expected types diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index b2cedf85..cf02441c 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -32,3 +32,9 @@ test_that("na-last works", { remcache(x_64) }) +test_that("cache is preserved when converting to integer64", { + x = as.integer64(1:3) + sortcache(x, na.last=FALSE) + x_converted = as.integer64(x) + expect_identical(cache(x_converted), cache(x)) +}) diff --git a/tests/testthat/test-integer64.R b/tests/testthat/test-integer64.R index bc36015d..837f91e4 100644 --- a/tests/testthat/test-integer64.R +++ b/tests/testthat/test-integer64.R @@ -1573,3 +1573,22 @@ test_that("back-compatible keep.names=TRUE is supported for limited input classe y = c(a = 1.0) expect_named(as.integer64(y, keep.names=TRUE), "a") }) + +test_that("as.integer64 does not copy integer64 object if not necessary", { + x = as.integer64(1:3) + tm_x = tracemem(x) + y = as.integer64(x) + tm_y = tracemem(y) + expect_identical(tm_x, tm_y) + untracemem(x) + untracemem(y) + + x = as.integer64(1:3) + names(x) = letters[seq_along(x)] + tm_x = tracemem(x) + y = as.integer64(x, keep.names=TRUE) + tm_y = tracemem(y) + expect_identical(tm_x, tm_y) + untracemem(x) + untracemem(y) +})