as.integer64 keep cache and names

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
 

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]]

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)

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
 }
 

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

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)

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))
+})

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)
+})