frolladapt

Author: jangorecki

NAMESPACE

@@ -56,6 +56,7 @@ export(frollmean)
 export(frollsum)
 export(frollmax)
 export(frollapply)
+export(frolladapt)
 export(nafill)
 export(setnafill)
 export(.Last.updated)

NEWS.md

@@ -32,6 +32,19 @@
     ```
     Additionally argument names in `frollapply` has been renamed from `x` to `X` and `n` to `N` to avoid conflicts with common argument names that may be passed to `...`, aligning to base R API of `lapply`. `x` and `n` continue to work with a warning, for now.
 
+5. Adaptive rolling functions no longer tolerate `NA`s and negative values passed to `n` argument.
+    ```r
+    n = c(2,NA,2)
+    frollsum(1:3, n, adaptive=TRUE)
+    #Error in froll(fun = "sum", x = x, n = n, fill = fill, algo = algo, align = align,  :
+    #  'n' must be non-negative integer values (>= 0)
+    ```
+    If for some reason previous `NA`s behavior is needed, it can be achieved by replacing `NA`s with a value big enough
+    ```r
+    n = nafill(c(2,NA,2), fill=.Machine$integer.max)
+    frollsum(1:3, n, adaptive=TRUE)
+    ```
+
 ### NOTICE OF INTENDED FUTURE POTENTIAL BREAKING CHANGES 
 
 1. `data.table(x=1, <expr>)`, where `<expr>` is an expression resulting in a 1-column matrix without column names, will eventually have names `x` and `V2`, not `x` and `V1`, consistent with `data.table(x=1, <expr>)` where `<expr>` results in an atomic vector, for example `data.table(x=1, cbind(1))` and `data.table(x=1, 1)` will both have columns named `x` and `V2`. In this release, the matrix case continues to be named `V1`, but the new behavior can be activated by setting `options(datatable.old.matrix.autoname)` to `FALSE`. See point 5 under Bug Fixes for more context; this change will provide more internal consistency as well as more consistency with `data.frame()`.
@@ -210,6 +223,40 @@
     #[1] TRUE
     ```
 
+18. New `frolladapt` helper function has been added to aid in preparation of adaptive length of rolling window width when dealing with _irregularly spaced ordered data_. This lets the user to apply a rolling function over a period without having to deal with gaps in a data where some periods might be missing.
+```r
+idx = as.Date("2022-10-23") + c(0,1,4,5,6,7,9,10,14)
+dt = data.table(index=idx, value=seq_along(idx))
+dt
+#        index value
+#       <Date> <int>
+#1: 2022-10-23     1
+#2: 2022-10-24     2
+#3: 2022-10-27     3
+#4: 2022-10-28     4
+#5: 2022-10-29     5
+#6: 2022-10-30     6
+#7: 2022-11-01     7
+#8: 2022-11-02     8
+#9: 2022-11-06     9
+dt[, c("rollmean3","rollmean3days") := list(
+  frollmean(value, 3),
+  frollmean(value, frolladapt(index, 3), adaptive=TRUE)
+  )]
+dt
+#        index value rollmean3 rollmean3days
+#       <Date> <int>     <num>         <num>
+#1: 2022-10-23     1        NA            NA
+#2: 2022-10-24     2        NA            NA
+#3: 2022-10-27     3         2           3.0
+#4: 2022-10-28     4         3           3.5
+#5: 2022-10-29     5         4           4.0
+#6: 2022-10-30     6         5           5.0
+#7: 2022-11-01     7         6           6.5
+#8: 2022-11-02     8         7           7.5
+#9: 2022-11-06     9         8           9.0
+```
+
 ### BUG FIXES
 
 1. `fread()` no longer warns on certain systems on R 4.5.0+ where the file owner can't be resolved, [#6918](https://github.com/Rdatatable/data.table/issues/6918). Thanks @ProfFancyPants for the report and PR.

R/froll.R

@@ -111,6 +111,47 @@ make.roll.names = function(x.len, n.len, n, x.nm, n.nm, fun, adaptive) {
   ans
 }
 
+# irregularly spaced time series, helper for creating adaptive window size
+frolladapt = function(x, n, align="right", partial=FALSE, give.names=FALSE) {
+  x = unclass(x)
+  if (!is.numeric(x))
+    stopf("'x' must be of a numeric type")
+  if (!is.integer(x))
+    x = as.integer(x)
+  if (!is.numeric(n)) {
+    stopf("'n' must be an integer")
+  } else {
+    nms = names(n) ## only for give.names
+    if (!is.integer(n)) {
+      if (!fitsInInt32(n))
+        stopf("'n' must be an integer")
+      n = as.integer(n)
+    }
+  }
+  if (!length(n))
+    stopf("'n' must be non 0 length")
+  if (anyNA(n))
+    stopf("'n' must not have NAs")
+  if (!identical(align, "right"))
+    stopf("'align' other than 'right' has not yet been implemented")
+  if (!isTRUEorFALSE(partial))
+    stopf("'partial' must be TRUE or FALSE")
+  if (!isTRUEorFALSE(give.names))
+    stopf("'give.names' must be TRUE or FALSE")
+
+  if (length(n) == 1L) {
+    ans = .Call(Cfrolladapt, x, n, partial)
+  } else {
+    ans = lapply(n, function(.n) .Call(Cfrolladapt, x, .n, partial))
+    if (give.names) {
+      if (is.null(nms))
+        nms = paste0("n", as.character(n))
+      setattr(ans, "names", nms)
+    }
+  }
+  ans
+}
+
 froll = function(fun, x, n, fill=NA, algo=c("fast","exact"), align=c("right","left","center"), na.rm=FALSE, has.nf=NA, adaptive=FALSE, partial=FALSE, give.names=FALSE, hasNA) {
   stopifnot(!missing(fun), is.character(fun), length(fun)==1L, !is.na(fun))
   if (!missing(hasNA)) {

R/frollapply.R

@@ -147,6 +147,8 @@ frollapply = function(X, N, FUN, ..., by.column=TRUE, fill=NA, align=c("right","
     nnam = names(N) ## used for give.names
     if (!is.integer(N))
       N = as.integer(N)
+    if (anyNA(N))
+      stopf("'N' must be non-negative integer values (>= 0)")
     nn = length(N) ## top level loop for vectorized n
   } else {
     if (length(unique(len)) > 1L) ## vectorized x requires same nrow for adaptive
@@ -156,6 +158,8 @@ frollapply = function(X, N, FUN, ..., by.column=TRUE, fill=NA, align=c("right","
         stopf("length of integer vector(s) provided as list to 'N' argument must be equal to number of observations provided in 'X'")
       if (!is.integer(N))
         N = as.integer(N)
+      if (anyNA(N))
+        stopf("'N' must be non-negative integer values (>= 0)")
       nn = 1L
       N = list(N)
       nnam = character()
@@ -168,6 +172,8 @@ frollapply = function(X, N, FUN, ..., by.column=TRUE, fill=NA, align=c("right","
         stopf("'N' must be an integer vector or list of integer vectors")
       if (!all(vapply_1b(N, is.integer, use.names=FALSE)))
         N = lapply(N, as.integer)
+      if (any(vapply_1b(N, anyNA, use.names=FALSE)))
+        stopf("'N' must be non-negative integer values (>= 0)")
       nn = length(N)
       nnam = names(N)
     } else