frollapply(adaptive=TRUE): resizable temporaries

Since adaptive application of rolling functions requires us to resize
the argument to match the window size, make sure to allocate it as such.

Author: aitap

R/frollapply.R

@@ -297,38 +297,22 @@ frollapply = function(X, N, FUN, ..., by.column=TRUE, fill=NA, align=c("right","
       tight = function(i, dest, src, n) FUN(.Call(CmemcpyDT, dest, src, i, n), ...)
     }
   } else {
-    #has.growable = base::getRversion() >= "3.4.0"
-    ## this is now always TRUE
-    ## we keep this branch, it may be useful when getting rid of SET_GROWABLE_BIT and SETLENGTH #6180
-    has.growable = TRUE
-    cpy = if (has.growable) function(x) .Call(Csetgrowable, copy(x)) else copy
+    cpy = function(x) .Call(CcopyAsGrowable, x, by.column)
     ansMask = function(len, n) {
       mask = seq_len(len) >= n
       mask[is.na(mask)] = FALSE ## test 6010.206
       mask
     }
     if (by.column) {
-      allocWindow = function(x, n) x[seq_len(max(n, na.rm=TRUE))]
-      if (has.growable) {
-        tight = function(i, dest, src, n) FUN(.Call(CmemcpyVectoradaptive, dest, src, i, n), ...) # CmemcpyVectoradaptive handles k[i]==0
-      } else {
-        tight = function(i, dest, src, n) {stopf("internal error: has.growable should be TRUE, implement support for n==0"); FUN(src[(i-n[i]+1L):i], ...)} # nocov
-      }
+      allocWindow = function(x, n) cpy(x[seq_len(max(n, na.rm=TRUE))])
+      tight = function(i, dest, src, n) FUN(.Call(CmemcpyVectoradaptive, dest, src, i, n), ...) # CmemcpyVectoradaptive handles k[i]==0
     } else {
       if (!list.df) {
-        allocWindow = function(x, n) x[seq_len(max(n, na.rm=TRUE)), , drop=FALSE]
-      } else {
-        allocWindow = function(x, n) lapply(x, `[`, seq_len(max(n)))
-      }
-      if (has.growable) {
-        tight = function(i, dest, src, n) FUN(.Call(CmemcpyDTadaptive, dest, src, i, n), ...) # CmemcpyDTadaptive handles k[i]==0
+        allocWindow = function(x, n) cpy(x[seq_len(max(n, na.rm=TRUE)), , drop=FALSE])
       } else {
-        if (!list.df) { # nocov
-          tight = function(i, dest, src, n) {stopf("internal error: has.growable should be TRUE, implement support for n==0"); FUN(src[(i-n[i]+1L):i, , drop=FALSE], ...)} # nocov
-        } else {
-          tight = function(i, dest, src, n) {stopf("internal error: has.growable should be TRUE, implement support for n==0"); FUN(lapply(src, `[`, (i-n[i]+1L):i), ...)} # nocov
-        }
+        allocWindow = function(x, n) cpy(lapply(x, `[`, seq_len(max(n))))
       }
+      tight = function(i, dest, src, n) FUN(.Call(CmemcpyDTadaptive, dest, src, i, n), ...) # CmemcpyDTadaptive handles k[i]==0
     }
   }
   ## prepare templates for errors and warnings

src/data.table.h

@@ -301,7 +301,7 @@ SEXP memcpyVector(SEXP dest, SEXP src, SEXP offset, SEXP size);
 SEXP memcpyDT(SEXP dest, SEXP src, SEXP offset, SEXP size);
 SEXP memcpyVectoradaptive(SEXP dest, SEXP src, SEXP offset, SEXP size);
 SEXP memcpyDTadaptive(SEXP dest, SEXP src, SEXP offset, SEXP size);
-SEXP setgrowable(SEXP x);
+SEXP copyAsGrowable(SEXP x, SEXP by_column);
 
 // nafill.c
 void nafillDouble(double *x, uint_fast64_t nx, unsigned int type, double fill, bool nan_is_na, ans_t *ans, bool verbose);

src/frollapply.c

@@ -75,6 +75,14 @@ SEXP memcpyDTadaptive(SEXP dest, SEXP src, SEXP offset, SEXP size) {
 // # nocov end
 
 // needed in adaptive=TRUE
-SEXP setgrowable(SEXP x) {
-  return x;
+SEXP copyAsGrowable(SEXP x, SEXP by_column) {
+  if (LOGICAL_RO(by_column)[0])
+    return R_duplicateAsResizable(x);
+
+  SEXP ret = PROTECT(shallow_duplicate(x));
+  R_xlen_t n = xlength(ret);
+  for (R_xlen_t i = 0; i < n; ++i)
+    SET_VECTOR_ELT(ret, i, R_duplicateAsResizable(VECTOR_ELT(ret, i)));
+  UNPROTECT(1);
+  return ret;
 }

src/init.c

@@ -158,7 +158,7 @@ R_CallMethodDef callMethods[] = {
 {"CmemcpyDT", (DL_FUNC)&memcpyDT, -1},
 {"CmemcpyVectoradaptive", (DL_FUNC)&memcpyVectoradaptive, -1},
 {"CmemcpyDTadaptive", (DL_FUNC)&memcpyDTadaptive, -1},
-{"Csetgrowable", (DL_FUNC)&setgrowable, -1},
+{"CcopyAsGrowable", (DL_FUNC)&copyAsGrowable, -1},
 {"Cfrolladapt", (DL_FUNC)&frolladapt, -1},
 {NULL, NULL, 0}
 };