frollmax PRs 2:10

Author: jangorecki

NAMESPACE

@@ -54,6 +54,7 @@ S3method(cube, data.table)
 S3method(rollup, data.table)
 export(frollmean)
 export(frollsum)
+export(frollmax)
 export(frollapply)
 export(nafill)
 export(setnafill)

NEWS.md

@@ -4,6 +4,10 @@
 
 ## data.table [v1.17.99](https://github.com/Rdatatable/data.table/milestone/35)  (in development)
 
+### BREAKING CHANGE
+
+1. Rolling functions `frollmean` and `frollsum` used to treat `Inf` and `-Inf` as `NA` when using default `algo="fast"`. It has been changed now and infinite values are not treated as `NA` anymore. If your input into those functions has `Inf` or `-Inf` then you will be affected by this change.
+
 ### NEW FEATURES
 
 1. New `sort_by()` method for data.tables, [#6662](https://github.com/Rdatatable/data.table/issues/6662). It uses `forder()` to improve upon the data.frame method and also match `DT[order(...)]` behavior with respect to locale. Thanks @rikivillalba for the suggestion and PR.
@@ -14,6 +18,44 @@
 
 4. `as.Date()` method for `IDate` no longer coerces to `double` [#6922](https://github.com/Rdatatable/data.table/issues/6922). Thanks @MichaelChirico for the report and PR. The only effect should be on overly-strict tests that assert `Date` objects have `double` storage, which is not in general true, especially from R 4.5.0.
 
+5. Multiple improvements has been added to rolling functions. Request came from @gpierard who needed left aligned, adaptive, rolling max, [#5438](https://github.com/Rdatatable/data.table/issues/5438). There was no `frollmax` function yet. Adaptive rolling functions did not have support for `align="left"`. `frollapply` did not support `adaptive=TRUE`. Available alternatives were base R `mapply` or self-join using `max` and grouping `by=.EACHI`. As a follow up of his request, following features has been added:
+- new function `frollmax`, applies `max` over a rolling window.
+- support for `align="left"` for adaptive rolling function.
+- support for `adaptive=TRUE` in `frollapply`.
+- `partial` argument to trim window width to available observations rather than returning `NA` whenever window is not complete.
+- `give.names` argument that can be used to automatically give the names based on the names of `x` and `n`.
+- `frollmean` and `frollsum` no longer treat `Inf` and `-Inf` as `NA`s as it used to be for `algo="fast"` (breaking change).
+- `hasNA` argument has been renamed to `has.nf` to convey that it is not only related to `NA/NaN` but other non-finite values (`Inf/-Inf`) as well.
+
+For a comprehensive description about all available features see `?froll` manual.
+
+Adaptive `frollmax` has observed to be up to 50 times faster than second fastest solution (data.table self-join using `max` and grouping `by=.EACHI`). Note that important factor in performance is width of the rolling window. Code for the benchmark below has been taken from [this SO answer](https://stackoverflow.com/a/73408459/2490497).
+```r
+set.seed(108)
+setDTthreads(8)
+x = data.table(
+  value = cumsum(rnorm(1e6, 0.1)),
+  end_window = 1:1e6 + sample(50:500, 1e6, TRUE),
+  row = 1:1e6
+)[, "end_window" := pmin(end_window, .N)
+  ][, "len_window" := end_window-row+1L]
+
+baser = function(x) x[, mapply(function(from, to) max(value[from:to]), row, end_window)]
+sj = function(x) x[x, max(value), on=.(row >= row, row <= end_window), by=.EACHI]$V1
+frmax = function(x) x[, frollmax(value, len_window, adaptive=TRUE, align="left", has.nf=FALSE)]
+frapply = function(x) x[, frollapply(value, len_window, max, adaptive=TRUE, align="left")]
+microbenchmark::microbenchmark(
+  baser(x), sj(x), frmax(x), frapply(x),
+  times=10, check="identical"
+)
+#Unit: milliseconds
+#       expr        min         lq      mean     median        uq       max neval
+#   baser(x) 5181.36076 5417.57505 5537.2929 5494.73652 5706.2721 5818.6627    10
+#      sj(x) 4608.28940 4627.57186 4792.4031 4785.35306 4856.4475 5054.3301    10
+#   frmax(x)   70.41253   75.28659   91.3774   91.40227  102.0248  116.8622    10
+# frapply(x)  713.23108  742.34657  865.2524  848.31641  965.3599 1114.0531    10
+```
+
 ### BUG FIXES
 
 1. Custom binary operators from the `lubridate` package now work with objects of class `IDate` as with a `Date` subclass, [#6839](https://github.com/Rdatatable/data.table/issues/6839). Thanks @emallickhossain for the report and @aitap for the fix.

R/froll.R

@@ -1,21 +1,130 @@
-froll = function(fun, x, n, fill=NA, algo=c("fast", "exact"), align=c("right", "left", "center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE) {
-  stopifnot(!missing(fun), is.character(fun), length(fun)==1L, !is.na(fun))
-  algo = match.arg(algo)
+# helpers for partial2adaptive
+trimn = function(n, len, align) {
+  n = min(n, len) ## so frollsum(1:2, 3, partial=TRUE) works
+  if (align=="right")
+    c(seq.int(n), rep.int(n, len-n))
+  else
+    c(rep.int(n, len-n), rev(seq.int(n)))
+}
+trimnadaptive = function(n, align) {
+  if (align=="right")
+    pmin(n, seq_along(n))
+  else
+    pmin(n, rev(seq_along(n)))
+}
+
+# partial2adaptive helper function
+## tune provided 'n' via partial=TRUE to adaptive=TRUE by prepared adaptive 'n' as shown in ?froll examples
+# partial2adaptive(1:4, 2, "right", adaptive=FALSE)
+# partial2adaptive(1:4, 2:3, "right", adaptive=FALSE)
+# partial2adaptive(list(1:4, 2:5), 2:3, "right", adaptive=FALSE)
+# frollsum(1:4, 2, partial=FALSE, adaptive=FALSE)
+# frollsum(1:4, 2, partial=TRUE, adaptive=FALSE)
+# frollsum(1:4, 2:3, partial=FALSE, adaptive=FALSE)
+# frollsum(1:4, 2:3, partial=TRUE, adaptive=FALSE)
+# frollsum(list(1:4, 2:5), 2:3, partial=FALSE, adaptive=FALSE)
+# frollsum(list(1:4, 2:5), 2:3, partial=TRUE, adaptive=FALSE)
+partial2adaptive = function(x, n, align, adaptive) {
+  if (align=="center")
+    stopf("'partial' cannot be used together with align='center'")
+  if (is.list(x) && length(unique(lengths(x)))!=1L)
+    stopf("'partial' does not support variable length of columns in 'x'")
+  len = if (is.list(x)) length(x[[1L]]) else length(x)
+  verbose = getOption("datatable.verbose")
+  if (!adaptive) {
+    if (is.list(n))
+      stopf("n must be an integer, list is accepted for adaptive TRUE")
+    if (!is.numeric(n))
+      stopf("n must be an integer vector or a list of integer vectors")
+    if (verbose)
+      cat("partial2adaptive: froll partial=TRUE trimming 'n' and redirecting to adaptive=TRUE\n")
+    if (length(n)>1L) {
+      lapply(n, len, align, FUN=trimn)
+    } else {
+      trimn(n, len, align)
+    }
+  } else {
+    if (!(is.numeric(n) || (is.list(n) && all(vapply_1b(n, is.numeric)))))
+      stopf("n must be an integer vector or a list of integer vectors")
+    if (!is.list(n))
+      n = list(n)
+    if (length(unique(lengths(n))) != 1L)
+      stopf("adaptive window provided in 'n' must not to have different lengths")
+    if (length(n[[1L]]) != len)
+      stopf("length of vectors in 'x' must match to length of adaptive window in 'n'")
+    if (verbose)
+      cat("partial2adaptive: froll adaptive=TRUE and partial=TRUE trimming 'n'\n")
+    lapply(n, align, FUN=trimnadaptive)
+  }
+}
+
+froll = function(fun, x, n, fill=NA, algo, align=c("right","left","center"), na.rm=FALSE, has.nf=NA, adaptive=FALSE, partial=FALSE, FUN, rho, give.names=FALSE) {
   align = match.arg(align)
-  ans = .Call(CfrollfunR, fun, x, n, fill, algo, align, na.rm, hasNA, adaptive)
+  if (isTRUE(give.names))
+    orig = list(n=n, adaptive=adaptive)
+  if (isTRUE(partial)) {
+    if (!length(n))
+      stopf("n must be non 0 length")
+    n = partial2adaptive(x, n, align, adaptive)
+    adaptive = TRUE
+  }
+  leftadaptive = isTRUE(adaptive) && align=="left"
+  if (leftadaptive) {
+    verbose = getOption("datatable.verbose")
+    rev2 = function(x) if (is.list(x)) lapply(x, rev) else rev(x)
+    if (verbose)
+      cat("froll: adaptive=TRUE && align='left' pre-processing for align='right'\n")
+    x = rev2(x)
+    n = rev2(n)
+    align = "right"
+  } ## support for left adaptive added in #5441
+  if (missing(FUN))
+    ans = .Call(CfrollfunR, fun, x, n, fill, algo, align, na.rm, has.nf, adaptive)
+  else
+    ans = .Call(CfrollapplyR, FUN, x, n, fill, align, adaptive, rho)
+  if (leftadaptive) {
+    if (verbose)
+      cat("froll: adaptive=TRUE && align='left' post-processing from align='right'\n")
+    ans = rev2(ans)
+  }
+  if (isTRUE(give.names) && is.list(ans)) {
+    n = orig$n
+    adaptive = orig$adaptive
+    nx = names(x)
+    nn = names(n)
+    if (is.null(nx)) nx = paste0("V", if (is.atomic(x)) 1L else seq_along(x))
+    if (is.null(nn)) nn = if (adaptive) paste0("N", if (is.atomic(n)) 1L else seq_along(n)) else paste("roll", as.character(n), sep="_")
+    setattr(ans, "names",  paste(rep(nx, each=length(nn)), nn, sep="_"))
+  }
   ans
 }
 
-frollmean = function(x, n, fill=NA, algo=c("fast", "exact"), align=c("right", "left", "center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE) {
-  froll(fun="mean", x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, hasNA=hasNA, adaptive=adaptive)
+frollfun = 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, hasNA, give.names=FALSE) {
+  stopifnot(!missing(fun), is.character(fun), length(fun)==1L, !is.na(fun))
+  if (!missing(hasNA)) {
+    if (!is.na(has.nf))
+      stopf("hasNA is deprecated, use has.nf instead")
+    warningf("hasNA is deprecated, use has.nf instead")
+    has.nf = hasNA
+  } # remove check on next major release
+  algo = match.arg(algo)
+  froll(fun=fun, x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, has.nf=has.nf, adaptive=adaptive, partial=partial, give.names=give.names)
+}
+
+frollmean = function(x, n, fill=NA, algo=c("fast","exact"), align=c("right","left","center"), na.rm=FALSE, has.nf=NA, adaptive=FALSE, partial=FALSE, hasNA, give.names=FALSE) {
+  frollfun(fun="mean", x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, has.nf=has.nf, adaptive=adaptive, partial=partial, hasNA=hasNA, give.names=give.names)
+}
+frollsum = function(x, n, fill=NA, algo=c("fast","exact"), align=c("right","left","center"), na.rm=FALSE, has.nf=NA, adaptive=FALSE, partial=FALSE, hasNA, give.names=FALSE) {
+  frollfun(fun="sum", x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, has.nf=has.nf, adaptive=adaptive, partial=partial, hasNA=hasNA, give.names=give.names)
 }
-frollsum = function(x, n, fill=NA, algo=c("fast","exact"), align=c("right", "left", "center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE) {
-  froll(fun="sum", x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, hasNA=hasNA, adaptive=adaptive)
+frollmax = function(x, n, fill=NA, algo=c("fast","exact"), align=c("right","left","center"), na.rm=FALSE, has.nf=NA, adaptive=FALSE, partial=FALSE, hasNA, give.names=FALSE) {
+  frollfun(fun="max", x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, has.nf=has.nf, adaptive=adaptive, partial=partial, hasNA=hasNA, give.names=give.names)
 }
-frollapply = function(x, n, FUN, ..., fill=NA, align=c("right", "left", "center")) {
+
+frollapply = function(x, n, FUN, ..., fill=NA, align=c("right","left","center"), adaptive=FALSE, partial=FALSE, give.names=FALSE) {
+  if (isTRUE(adaptive) && base::getRversion() < "3.4.0") ## support SET_GROWABLE_BIT
+    stopf("frollapply adaptive=TRUE requires at least R 3.4.0"); # nocov
   FUN = match.fun(FUN)
-  align = match.arg(align)
   rho = new.env()
-  ans = .Call(CfrollapplyR, FUN, x, n, fill, align, rho)
-  ans
+  froll(FUN=FUN, rho=rho, x=x, n=n, fill=fill, align=align, adaptive=adaptive, partial=partial, give.names=give.names)
 }

TODO

@@ -0,0 +1,28 @@
+This is the list of follow up issues that may be resolved after all rolling functions PRs will be merged. As of the current moment none of those is a bug fix or essentially necessary but rather good practice changes.
+
+- Rename `has.nf` arg to `all.finite`?
+
+- fix malloc calls
+```
+bool *isnan = malloc(nx*sizeof(bool)); // isnan lookup - we use it to reduce ISNAN calls in nested loop
+## into
+bool *isnan = malloc(sizeof(*isnan)*nx);
+```
+
+- remove `free(NULL)`
+
+```
+free(isnan);
+```
+
+- as we moved to 3.4.0 dependency remove mentions of R < 3.4.0 related to set growable for frollapply adaptive
+
+- catf() instead of cat()
+
+- use `test(..., options(datatable.verbose=TRUE))` rather than `options(datatable.verbose=TRUE)`
+
+- verbose output `frolladaptivefun: algo 0 not implemented, fall back to 1` could be more intuitive
+
+The only reason why it was added was that we can test if expected algo is being used. Rolling functions do not expose verbose arg directly, it has to be set via options, therefore full user friendliness is maybe not the biggest priority at the moment. We will also have to keep in mind buffer limit of 500 characters set for `snprintf`.
+
+- The `snprintf(end(message), 500, format, ...)` idiom should be more like `len = strlen(ans->message[0]); snprintf(ans->message[0] + len, sizeof(ans->message[0]) - len, format, ...)`, but I don't see a way the current code could overflow the 4096-byte buffer, even with long translation strings; the current code doesn't cause a problem.