add optional parameter and move batch tests

Author: ben-schwen

.github/workflows/R-CMD-check-occasional.yaml

@@ -42,6 +42,7 @@ jobs:
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      RunAllDataTableTests: yes
 
     steps:
       - name: Set locale

.github/workflows/R-CMD-check.yaml

@@ -38,6 +38,7 @@ jobs:
       RSPM: ${{ matrix.config.rspm }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       _R_CHECK_RD_CHECKRD_MINLEVEL_: -Inf
+      RunAllDataTableTests: yes
 
     steps:
       - uses: actions/checkout@v4

.gitlab-ci.yml

@@ -13,6 +13,7 @@ variables:
   TZ: "UTC"  ## to avoid 'Failed to create bus connection' from timedatectl via Sys.timezone() on Docker with R 3.4.
              ## Setting TZ for all GLCI jobs to isolate them from timezone. We could have a new GLCI job to test under
              ## a non-UTC timezone, although, that's what we do routinely in dev.
+  RunAllDataTableTests: "yes"  ## run optional tests in CI
   R_REL_VERSION:  "4.5" # only raise when RTOOLS for REL is available
   R_REL_WIN_BIN:  "https://cloud.r-project.org/bin/windows/base/old/4.5.0/R-4.5.0-win.exe"
   R_DEV_VERSION:  "4.6"

R/test.data.table.R

@@ -1,6 +1,12 @@
 test.data.table = function(script="tests.Rraw", verbose=FALSE, pkg=".", silent=FALSE, showProgress=interactive()&&!silent, testPattern=NULL,
-                           memtest=Sys.getenv("TEST_DATA_TABLE_MEMTEST", 0L), memtest.id=NULL) {
-  stopifnot(isTRUEorFALSE(verbose), isTRUEorFALSE(silent), isTRUEorFALSE(showProgress))
+                           memtest=Sys.getenv("TEST_DATA_TABLE_MEMTEST", 0L), memtest.id=NULL, optional=FALSE) {
+  stopifnot(isTRUEorFALSE(verbose), isTRUEorFALSE(silent), isTRUEorFALSE(showProgress), isTRUEorFALSE(optional))
+
+  # Skip optional tests unless RunAllDataTableTests is set
+  if (optional && Sys.getenv("RunAllDataTableTests") != "yes") {
+    return(invisible(TRUE))
+  }
+
   memtest = as.integer(memtest)
   stopifnot(length(memtest)==1L, memtest %in% 0:2)
   memtest.id = as.integer(memtest.id)

inst/tests/froll.Rraw

@@ -2297,339 +2297,3 @@ test(6015.907, frolladapt(c(1L,3L,2L), 2L), error="be sorted, have no duplicates
 test(6015.908, frolladapt(c(1L,2L,2L), 2L), error="be sorted, have no duplicates, have no NAs")
 test(6015.909, frolladapt(c(1L,2L,NA_integer_), 2L), error="be sorted, have no duplicates, have no NAs") ## loop that checks for sorted will detect NAs as well, except for first element
 test(6015.910, frolladapt(c(NA_integer_,1L,2L), 2L), error="be sorted, have no duplicates, have no NAs") ## first NA is detected by extra check
-
-## batch validation
-set.seed(108)
-makeNA = function(x, ratio=0.1, nf=FALSE) {
-  n = as.integer(length(x) * ratio)
-  id = sample(length(x), n)
-  if (!nf) {
-    x[id] = NA
-  } else {
-    x[id[1:(n/4)]] = NA
-    x[id[(n/4+1):(n/2)]] = NaN
-    x[id[(n/2+1):(3*n/4)]] = -Inf
-    x[id[(3*n/4+1):n]] = +Inf
-  }
-  x
-}
-## against base to verify exactness of non-finite values, not handled in zoo
-rollfun = function(x, n, FUN, fill=NA_real_, na.rm=FALSE, nf.rm=FALSE, partial=FALSE) {
-  ans = rep(fill, nx<-length(x))
-  f = match.fun(FUN)
-  if (nf.rm) x[is.infinite(x)] = NA_real_
-  for (i in seq_along(x)) {
-    ans[i] = if (n==0)
-      f(x[integer()], na.rm=na.rm)
-    else if (i >= n)
-      f(x[(i-n+1L):i], na.rm=na.rm)
-    else if (partial)
-      f(x[max((i-n+1), 1L):i], na.rm=na.rm)
-    else
-      as.double(fill)
-  }
-  ans
-}
-base_compare = function(x, n, funs=c("mean","sum","max","min","prod","median","var","sd"), algos=c("fast","exact")) {
-  num.step = 0.0001
-  for (fun in funs) {
-    for (na.rm in c(FALSE, TRUE)) {
-      for (fill in c(NA_real_, 0)) {
-        for (partial in c(FALSE,TRUE)) {
-          for (has.nf in c(NA,TRUE,FALSE)) {
-            if (identical(has.nf, FALSE)) {
-              if (na.rm)
-                next ## errors "not make sense"
-              if (any(!is.finite(x)))
-                next ## do not test warnings (mean, sum) or incorrect expect results (max)
-            }
-            for (algo in algos) {
-              num <<- num + num.step
-              eval(substitute( # so we can have values displayed in output/log rather than variables
-                test(.num, ignore.warning="no non-missing arguments",
-                     rollfun(x, n, FUN=.fun, fill=.fill, na.rm=.na.rm, partial=.partial),
-                     froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo, partial=.partial, has.nf=.has.nf)),
-                list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .partial=partial, .has.nf=has.nf)
-              ))
-            }
-          }
-          num <<- num + num.step
-          eval(substitute( # so we can have values displayed in output/log rather than variables
-            test(.num, ignore.warning="no non-missing arguments",
-                 frollapply(x, n, FUN=match.fun(.fun), fill=.fill, na.rm=.na.rm, partial=.partial),
-                 froll(.fun, x, n, fill=.fill, na.rm=.na.rm, partial=.partial)),
-            list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .partial=partial)
-          ))
-        }
-      }
-    }
-  }
-}
-num = 7000.0
-x = rnorm(1e3); n = 50
-base_compare(x, n)
-x = rnorm(1e3+1); n = 50 ## uneven len
-base_compare(x, n)
-x = rnorm(1e3); n = 51 ## uneven window
-base_compare(x, n)
-x = rnorm(1e3+1); n = 51
-base_compare(x, n)
-x = sort(rnorm(1e3)); n = 50 ## inc
-base_compare(x, n)
-x = sort(rnorm(1e3+1)); n = 50
-base_compare(x, n)
-x = sort(rnorm(1e3)); n = 51
-base_compare(x, n)
-x = sort(rnorm(1e3+1)); n = 51
-base_compare(x, n)
-x = rev(sort(rnorm(1e3))); n = 50 ## desc
-base_compare(x, n)
-x = rev(sort(rnorm(1e3+1))); n = 50
-base_compare(x, n)
-x = rev(sort(rnorm(1e3))); n = 51
-base_compare(x, n)
-x = rev(sort(rnorm(1e3+1))); n = 51
-base_compare(x, n)
-x = rep(rnorm(1), 1e3); n = 50 ## const
-base_compare(x, n)
-x = rep(rnorm(1), 1e3+1); n = 50
-base_compare(x, n)
-x = rep(rnorm(1), 1e3); n = 51
-base_compare(x, n)
-x = rep(rnorm(1), 1e3+1); n = 51
-base_compare(x, n)
-num = 7100.0
-## random NA non-finite
-x = makeNA(rnorm(1e3), nf=TRUE); n = 50
-base_compare(x, n)
-x = makeNA(rnorm(1e3+1), nf=TRUE); n = 50
-base_compare(x, n)
-x = makeNA(rnorm(1e3), nf=TRUE); n = 51
-base_compare(x, n)
-x = makeNA(rnorm(1e3+1), nf=TRUE); n = 51
-base_compare(x, n)
-x = makeNA(rnorm(1e3), nf=TRUE); n = 0
-base_compare(x, n)
-
-#### against zoo
-if (requireNamespace("zoo", quietly=TRUE)) {
-  drollapply = function(...) as.double(zoo::rollapply(...)) # rollapply is not consistent in data type of answer, force to double
-  zoo_compare = function(x, n, funs=c("mean","sum","max","min","prod","median","var","sd"), algos=c("fast","exact")) {
-    num.step = 0.0001
-    #### fun, align, na.rm, fill, algo, partial
-    for (fun in funs) {
-      for (align in c("right","center","left")) {
-        for (na.rm in c(FALSE, TRUE)) {
-          for (fill in c(NA_real_, 0)) {
-            for (partial in c(FALSE,TRUE)) {
-              if (partial && align=="center")
-                next ## not implemented
-              for (has.nf in c(NA,TRUE,FALSE)) {
-                if (identical(has.nf, FALSE)) {
-                  if (na.rm)
-                    next ## errors "not make sense"
-                  if (any(!is.finite(x)))
-                    next ## do not test warnings (mean, sum, prod) or incorrect expect results (max, min, median)
-                }
-                for (algo in algos) {
-                  num <<- num + num.step
-                  eval(substitute( # so we can have values displayed in output/log rather than variables
-                    test(.num, ignore.warning="no non-missing arguments",
-                         drollapply(x, n, FUN=.fun, fill=.fill, align=.align, na.rm=.na.rm, partial=.partial),
-                         froll(.fun, x, n, align=.align, fill=.fill, na.rm=.na.rm, algo=.algo, partial=.partial, has.nf=.has.nf)),
-                    list(.num=num, .fun=fun, .align=align, .fill=fill, .na.rm=na.rm, .algo=algo, .partial=partial, .has.nf=has.nf)
-                  ))
-                }
-              }
-              num <<- num + num.step
-              eval(substitute( # so we can have values displayed in output/log rather than variables
-                test(.num, ignore.warning="no non-missing arguments",
-                     frollapply(x, n, FUN=.fun, fill=.fill, align=.align, na.rm=.na.rm, partial=.partial),
-                     froll(.fun, x, n, align=.align, fill=.fill, na.rm=.na.rm, partial=.partial)),
-                list(.num=num, .fun=fun, .align=align, .fill=fill, .na.rm=na.rm, .partial=partial)
-              ))
-            }
-          }
-        }
-      }
-    }
-  }
-  num = 7200.0
-  ## no NA
-  x = rnorm(1e3); n = 50 # x even, n even
-  zoo_compare(x, n)
-  x = rnorm(1e3+1); n = 50 # x odd, n even
-  zoo_compare(x, n)
-  x = rnorm(1e3); n = 51 # x even, n odd
-  zoo_compare(x, n)
-  x = rnorm(1e3+1); n = 51 # x odd, n odd
-  zoo_compare(x, n)
-  ## leading and trailing NAs
-  x = c(rep(NA, 60), rnorm(1e3), rep(NA, 60)); n = 50
-  zoo_compare(x, n)
-  x = c(rep(NA, 60), rnorm(1e3+1), rep(NA, 60)); n = 50
-  zoo_compare(x, n)
-  x = c(rep(NA, 60), rnorm(1e3), rep(NA, 60)); n = 51
-  zoo_compare(x, n)
-  x = c(rep(NA, 60), rnorm(1e3+1), rep(NA, 60)); n = 51
-  zoo_compare(x, n)
-  ## random NA
-  x = makeNA(rnorm(1e3)); n = 50
-  zoo_compare(x, n)
-  x = makeNA(rnorm(1e3+1)); n = 50
-  zoo_compare(x, n)
-  x = makeNA(rnorm(1e3)); n = 51
-  zoo_compare(x, n)
-  x = makeNA(rnorm(1e3+1)); n = 51
-  zoo_compare(x, n)
-}
-#### adaptive moving average compare
-arollfun = function(FUN, x, n, na.rm=FALSE, align=c("right","left"), fill=NA, nf.rm=FALSE, partial=FALSE) {
-  # adaptive moving average in R
-  stopifnot((nx<-length(x))==length(n))
-  align = match.arg(align)
-  ans = rep(fill, nx)
-  if (nf.rm) x[is.infinite(x)] = NA_real_
-  f = match.fun(FUN)
-  if (align=="right") {
-    for (i in seq_along(x)) {
-      if (n[i] == 0)
-        ans[i] = f(x[integer()], na.rm=na.rm)
-      else if (i >= n[i])
-        ans[i] = f(x[(i-n[i]+1L):i], na.rm=na.rm)
-      else if (partial)
-        ans[i] = f(x[1L:i], na.rm=na.rm)
-    }
-  } else {
-    for (i in seq_along(x)) {
-      if (n[i] == 0)
-        ans[i] = f(x[integer()], na.rm=na.rm)
-      else if (i <= nx-n[i]+1)
-        ans[i] = f(x[i:(i+n[i]-1L)], na.rm=na.rm)
-      else if (partial)
-        ans[i] = f(x[i:length(x)], na.rm=na.rm)
-    }
-  }
-  ans
-}
-afun_compare = function(x, n, funs=c("mean","sum","max","min","prod","median","var","sd"), algos=c("fast","exact")) {
-  num.step = 0.0001
-  #### fun, align, na.rm, fill, algo
-  for (fun in funs) {
-    for (align in c("right","left")) {
-      for (na.rm in c(FALSE, TRUE)) {
-        for (fill in c(NA_real_, 0)) {
-          for (partial in c(FALSE, TRUE)) {
-            for (has.nf in c(NA, TRUE, FALSE)) {
-              if (identical(has.nf, FALSE)) {
-                if (na.rm) {
-                  next
-                } ## errors "not make sense"
-                if (any(!is.finite(x))) {
-                  next
-                } ## do not test warnings (mean, sum, prod) or incorrect expect results (max, min, median)
-              }
-              for (algo in algos) {
-                num <<- num + num.step
-                eval(substitute(
-                  test(.num,
-                    ignore.warning = "no non-missing arguments",
-                    arollfun(.fun, x, n, fill = .fill, na.rm = .na.rm, align = .align, partial=.partial),
-                    froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo, adaptive=TRUE, align=.align, has.nf=.has.nf, partial=.partial)
-                  ),
-                  list(.num = num, .fun = fun, .fill = fill, .na.rm = na.rm, .algo = algo, .align = align, .partial=partial, .has.nf = has.nf)
-                ))
-              }
-            }
-          }
-          num <<- num + num.step
-          eval(substitute(
-            test(.num, ignore.warning="no non-missing arguments",
-              frollapply(x, n, FUN=match.fun(.fun), fill=.fill, na.rm=.na.rm, adaptive=TRUE, align=.align),
-              froll(.fun, x, n, fill=.fill, na.rm=.na.rm, adaptive=TRUE, align=.align)),
-            list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .align=align)
-          ))
-        }
-      }
-    }
-  }
-}
-num = 7300.0
-x = rnorm(1e3); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = rnorm(1e3+1); n = sample(50, length(x), TRUE) ## uneven len
-afun_compare(x, n)
-x = rnorm(1e3); n = sample(51, length(x), TRUE) ## uneven window
-afun_compare(x, n)
-x = rnorm(1e3+1); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = sort(rnorm(1e3)); n = sample(50, length(x), TRUE) ## inc
-afun_compare(x, n)
-x = sort(rnorm(1e3+1)); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = sort(rnorm(1e3)); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = sort(rnorm(1e3+1)); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = rev(sort(rnorm(1e3))); n = sample(50, length(x), TRUE) ## desc
-afun_compare(x, n)
-x = rev(sort(rnorm(1e3+1))); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = rev(sort(rnorm(1e3))); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = rev(sort(rnorm(1e3+1))); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = rep(rnorm(1), 1e3); n = sample(50, length(x), TRUE) ## const
-afun_compare(x, n)
-x = rep(rnorm(1), 1e3+1); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = rep(rnorm(1), 1e3); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = rep(rnorm(1), 1e3+1); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-num = 7400.0
-#### no NA
-x = rnorm(1e3); n = sample(50, length(x), TRUE) # x even, n even
-afun_compare(x, n)
-x = rnorm(1e3+1); n = sample(50, length(x), TRUE) # x odd, n even
-afun_compare(x, n)
-x = rnorm(1e3); n = sample(51, length(x), TRUE) # x even, n odd
-afun_compare(x, n)
-x = rnorm(1e3+1); n = sample(51, length(x), TRUE) # x odd, n odd
-afun_compare(x, n)
-x = rnorm(1e3); n = sample(0:49, length(x), TRUE) # x even, n even
-afun_compare(x, n)
-#### leading and trailing NAs
-x = c(rep(NA, 60), rnorm(1e3), rep(NA, 60)); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = c(rep(NA, 60), rnorm(1e3+1), rep(NA, 60)); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = c(rep(NA, 60), rnorm(1e3), rep(NA, 60)); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = c(rep(NA, 60), rnorm(1e3+1), rep(NA, 60)); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = c(rep(NA, 60), rnorm(1e3), rep(NA, 60)); n = sample(0:49, length(x), TRUE)
-afun_compare(x, n)
-#### random NA
-x = makeNA(rnorm(1e3)); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = makeNA(rnorm(1e3+1)); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = makeNA(rnorm(1e3)); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = makeNA(rnorm(1e3+1)); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = makeNA(rnorm(1e3)); n = sample(0:49, length(x), TRUE)
-afun_compare(x, n)
-#### random NA non-finites
-x = makeNA(rnorm(1e3), nf=TRUE); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = makeNA(rnorm(1e3+1), nf=TRUE); n = sample(50, length(x), TRUE)
-afun_compare(x, n)
-x = makeNA(rnorm(1e3), nf=TRUE); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = makeNA(rnorm(1e3+1), nf=TRUE); n = sample(51, length(x), TRUE)
-afun_compare(x, n)
-x = makeNA(rnorm(1e3), nf=TRUE); n = sample(0:49, length(x), TRUE)
-afun_compare(x, n)
-rm(num)