From d9a42c0a60991a5863124160abada60dafd1e566 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 10:54:02 -0700 Subject: [PATCH 01/12] initial sweep + implementation --- R/test.data.table.R | 8 +++++++- inst/tests/froll.Rraw | 30 ++++++++++++------------------ inst/tests/tests.Rraw | 3 +-- 3 files changed, 20 insertions(+), 21 deletions(-) diff --git a/R/test.data.table.R b/R/test.data.table.R index 225176e92a..6b4f7fd599 100644 --- a/R/test.data.table.R +++ b/R/test.data.table.R @@ -323,7 +323,10 @@ gc_mem = function() { # nocov end } -test = function(num,x,y=TRUE,error=NULL,warning=NULL,message=NULL,output=NULL,notOutput=NULL,ignore.warning=NULL,options=NULL,env=NULL) { +test = function(num, x, y=TRUE, + error=NULL, warning=NULL, message=NULL, output=NULL, notOutput=NULL, ignore.warning=NULL, + options=NULL, env=NULL, + context=NULL) { if (!is.null(env)) { old = Sys.getenv(names(env), names=TRUE, unset=NA) to_unset = !lengths(env) @@ -570,6 +573,9 @@ test = function(num,x,y=TRUE,error=NULL,warning=NULL,message=NULL,output=NULL,no } # nocov end } + if (fail && !is.null(context)) { + catf("Test context: %s\n", context) + } if (fail && .test.data.table && num>0.0) { # nocov start assign("nfail", nfail+1L, parent.frame(), inherits=TRUE) diff --git a/inst/tests/froll.Rraw b/inst/tests/froll.Rraw index f6a4f96a80..1deead6c6e 100644 --- a/inst/tests/froll.Rraw +++ b/inst/tests/froll.Rraw @@ -878,12 +878,10 @@ base_compare = function(x, n, funs=c("mean","sum"), algos=c("fast","exact")) { for (fill in c(NA_real_, 0)) { for (algo in algos) { num <<- num + num.step - eval(substitute( # so we can have values displayed in output/log rather than variables - test(.num, - froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo), - rollfun(x, n, FUN=.fun, fill=.fill, na.rm=.na.rm, nf.rm=.nf.rm)), - list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .nf.rm=algo!="exact") - )) + test(num, + froll(fun, x, n, fill=fill, na.rm=na.rm, algo=algo), + rollfun(x, n, FUN=fun, fill=fill, na.rm=na.rm, nf.rm=algo != "exact"), + context=sprintf("fun=%s\tfill=%s\tna.rm=%s\talgo=%s", fun, fill, na.rm, algo)) } } } @@ -911,12 +909,10 @@ if (requireNamespace("zoo", quietly=TRUE)) { for (fill in c(NA_real_, 0)) { for (algo in algos) { num <<- num + num.step - eval(substitute( # so we can have values displayed in output/log rather than variables - test(.num, - froll(.fun, x, n, align=.align, fill=.fill, na.rm=.na.rm, algo=.algo), - drollapply(x, n, FUN=.fun, fill=.fill, align=.align, na.rm=.na.rm)), - list(.num=num, .fun=fun, .align=align, .fill=fill, .na.rm=na.rm, .algo=algo) - )) + test(num, + froll(fun, x, n, align=align, fill=fill, na.rm=na.rm, algo=algo), + drollapply(x, n, FUN=fun, fill=fill, align=align, na.rm=na.rm), + context=sprintf("fun=%s\talign=%s\tfill=%s\tna.rm=%s\talgo=%s", fun, align, fill, na.rm, algo)) } } } @@ -974,12 +970,10 @@ afun_compare = function(x, n, funs=c("mean","sum"), algos=c("fast","exact")) { for (fill in c(NA_real_, 0)) { for (algo in algos) { num <<- num + num.step - eval(substitute( - test(.num, - froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo, adaptive=TRUE), - arollfun(.fun, x, n, fill=.fill, na.rm=.na.rm, nf.rm=.nf.rm)), - list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .nf.rm=algo!="exact") - )) + test(num, + froll(fun, x, n, fill=fill, na.rm=na.rm, algo=algo, adaptive=TRUE), + arollfun(fun, x, n, fill=fill, na.rm=na.rm, nf.rm=algo != "exact"), + context=sprintf("fun=%s\tfill=%s\tna.rm=%s\talgo=%s", fun, fill, na.rm, algo)) } } } diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index b9fec0021c..2fb7f5f35c 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -9861,11 +9861,10 @@ nqjoin_test <- function(x, y, k=1L, test_no, mult="all") { for (i in seq_along(runcmb)) { thiscols = runcmb[[i]] thisops = runops[[i]] - # cat("k = ", k, "\ti = ", i, "\t thiscols = [", paste0(thiscols,collapse=","), "]\t thisops = [", paste0(thisops,collapse=","), "]\t ", sep="") ans1 = nq(x, y, thiscols, thisops, 0L, mult=mult) ans2 = check(x, y, thiscols, thisops, mult=mult) test_no = test_no + .001 - test(test_no, ans1, ans2) # nolint: dt_test_literal_linter. + test(test_no, ans1, ans2, context=sprintf("k = %d\ti = %d\tthiscols = [%s]\tthisops = [%s]", k, i, paste(thiscols, collapse=","), paste(thisops, collapse=","))) } gc() # no longer needed but left in place just in case, no harm } From 8ced74703933ed85067b1413b1ac633bce659a1c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 10:55:08 -0700 Subject: [PATCH 02/12] doc in ?test --- man/test.Rd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/man/test.Rd b/man/test.Rd index 594040aca9..19bd9d4f9c 100644 --- a/man/test.Rd +++ b/man/test.Rd @@ -8,7 +8,7 @@ test(num, x, y = TRUE, error = NULL, warning = NULL, message = NULL, output = NULL, notOutput = NULL, ignore.warning = NULL, - options = NULL, env = NULL) + options = NULL, env = NULL, context = NULL) } \arguments{ \item{num}{ A unique identifier for a test, helpful in identifying the source of failure when testing is not working. Currently, we use a manually-incremented system with tests formatted as \code{n.m}, where essentially \code{n} indexes an issue and \code{m} indexes aspects of that issue. For the most part, your new PR should only have one value of \code{n} (scroll to the end of \code{inst/tests/tests.Rraw} to see the next available ID) and then index the tests within your PR by increasing \code{m}. Note -- \code{n.m} is interpreted as a number, so \code{123.4} and \code{123.40} are actually the same -- please \code{0}-pad as appropriate. Test identifiers are checked to be in increasing order at runtime to prevent duplicates being possible. } @@ -22,6 +22,7 @@ test(num, x, y = TRUE, \item{ignore.warning}{ A single character string. Any warnings emitted by \code{x} that contain this string are dropped. Remaining warnings are compared to the expected \code{warning} as normal. } \item{options}{ A named list of options to set for the duration of the test. Any code evaluated during this call to \code{test()} (usually, \code{x}, or maybe \code{y}) will run with the named options set, and the original options will be restored on return. This is a named list since different options can have different types in general, but in typical usage, only one option is set at a time, in which case a named vector is also accepted. } \item{env}{ A named list of environment variables to set for the duration of the test, much like \code{options}. A list entry set to \code{NULL} will unset (i.e., \code{\link{Sys.unsetenv}}) the corresponding variable. } +\item{context}{ String, default \code{NULL}. Used to provide context where this is useful, e.g. in a test run in a loop where we can't just search for the test number. } } \note{ \code{NA_real_} and \code{NaN} are treated as equal, use \code{identical} if distinction is needed. See examples below. From 1bedacfb97070fc712053f51055c1f0fd6721b23 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 11:17:38 -0700 Subject: [PATCH 03/12] progress in num+x tests --- inst/tests/tests.Rraw | 102 ++++++++++++++++++++++-------------------- 1 file changed, 53 insertions(+), 49 deletions(-) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 2fb7f5f35c..1bc04ad1c3 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -2687,11 +2687,11 @@ for (ne in seq_along(eols)) { # on unix we simulate Windows too. On Windows \n will write \r\n (and \r\n will write \r\r\n) num_major = nr/100 + nc/1000 + ne/10000 # if (isTRUE(all.equal(testIDtail, 0.4103))) browser() - test(894+num_major+0.00001, fread(f,na.strings=""), headDT) - cat(eol,file=f,append=TRUE) # now a normal file properly ending with final \n - test(894+num_major+0.00002, fread(f,na.strings=""), headDT) - cat(eol,file=f,append=TRUE) # extra \n should be ignored other than for single columns where it is significant - test(894+num_major+0.00003, fread(f,na.strings=""), if (nc==1) rbind(headDT, list(NA)) else headDT) + test(894 + num_major + 0.00001, fread(f, na.strings=""), headDT, context=sprintf("nr=%d, nc=%d, ne=%d [I]", nr, nc, ne)) + cat(eol, file=f, append=TRUE) # now a normal file properly ending with final \n + test(894 + num_major + 0.00002, fread(f, na.strings=""), headDT, context=sprintf("nr=%d, nc=%d, ne=%d [II]", nr, nc, ne)) + cat(eol, file=f, append=TRUE) # extra \n should be ignored other than for single columns where it is significant + test(894 + num_major + 0.00003, fread(f, na.strings=""), if (nc==1) rbind(headDT, list(NA)) else headDT, context=sprintf("nr=%d, nc=%d, ne=%d [III]", nr, nc, ne)) unlink(f) }}} if (test_bit64) { @@ -4462,13 +4462,13 @@ old_rounding = getNumericRounding() DT = data.table(A=c(1,2,-Inf,+Inf,3,-1.1,NaN,NA,3.14,NaN,2.8,NA), B=1:12, key="A") for (i in 0:1) { # tests 1207 & 1208 setNumericRounding(if (i==0L) 0L else 2L) - test(1207+i+0.1, DT[.(c(NA_real_,Inf)),B], INT(8,12,4)) - test(1207+i+0.2, DT[.(c(Inf,NA_real_)),B], INT(4,8,12)) - test(1207+i+0.3, DT[.(c(NaN,NA_real_)),B], INT(7,10,8,12)) - test(1207+i+0.4, DT[.(c(NA_real_,NaN)),B], INT(8,12,7,10)) - test(1207+i+0.5, DT[,sum(B),by=A]$V1, INT(20,17,3,6,1,2,11,5,9,4)) - test(1207+i+0.6, DT[,sum(B),by=list(g=abs(trunc(A)))], data.table(g=c(NA,NaN,Inf,1,2,3),V1=INT(20,17,7,7,13,14))) - test(1207+i+0.7, DT[,sum(B),keyby=list(g=abs(trunc(A)))], data.table(g=c(NA,NaN,1,2,3,Inf),V1=INT(20,17,7,13,14,7),key="g")) + test(1207 + i + 0.1, DT[.(c(NA_real_,Inf)), B], INT(8, 12, 4), context=sprintf("setNumericRounding(%d) [I]", 2*i)) + test(1207 + i + 0.2, DT[.(c(Inf,NA_real_)), B], INT(4, 8, 12), context=sprintf("setNumericRounding(%d) [II]", 2*i)) + test(1207 + i + 0.3, DT[.(c(NaN,NA_real_)), B], INT(7, 10, 8, 12), context=sprintf("setNumericRounding(%d) [III]", 2*i)) + test(1207 + i + 0.4, DT[.(c(NA_real_,NaN)), B], INT(8, 12, 7, 10), context=sprintf("setNumericRounding(%d) [IV]", 2*i)) + test(1207 + i + 0.5, DT[, sum(B), by=A]$V1, INT(20, 17, 3, 6, 1, 2, 11, 5, 9, 4), context=sprintf("setNumericRounding(%d) [V]", 2*i)) + test(1207 + i + 0.6, DT[, sum(B), by=list(g=abs(trunc(A)))], data.table(g=c(NA, NaN, Inf, 1, 2, 3), V1=INT(20, 17, 7, 7, 13, 14)), context=sprintf("setNumericRounding(%d) [VI]", 2*i)) + test(1207 + i + 0.7, DT[, sum(B), keyby=list(g=abs(trunc(A)))], data.table(g=c(NA, NaN, 1, 2, 3, Inf), V1=INT(20, 17, 7, 13, 14, 7), key="g"), context=sprintf("setNumericRounding(%d) [VII]", 2*i)) # test(1207+i+0.8, DT[.(-200.0),roll=TRUE]$B, 3L) # TO DO: roll to -Inf. Also remove -Inf and test rolling to NaN and NA } setNumericRounding(old_rounding) @@ -4537,7 +4537,7 @@ seedInfo = paste(seedInfo, "colorder = ", paste(colorder, collapse=","), sep="") test_no = 0L oldnfail = nfail for (nvars in seq_along(names(DT))) { - signs = expand.grid(replicate(nvars, c(-1L,1L), simplify=FALSE)) + signs = expand.grid(replicate(nvars, c(-1L, 1L), simplify=FALSE)) combn(names(DT), nvars, simplify=FALSE, function(x) { # simplify=FALSE needed for R 3.1.0 for (i in seq_len(nrow(signs))) { test_no <<- test_no + 1L @@ -4555,7 +4555,7 @@ for (nvars in seq_along(names(DT))) { } }) )) - test(1223.0 + test_no*0.001, forderv(DT, by=x, order=signs[i,]), with(DT, eval(ll))) + test(1223.0 + test_no*0.001, forderv(DT, by=x, order=signs[i,]), with(DT, eval(ll)), context=sprintf("signs[%d, ]==%s", i, paste(unlist(signs[i, ]), collapse=","))) } integer() }) @@ -4679,10 +4679,10 @@ for (i in seq_along(names(DT))) { cc = combn(names(DT), i) apply(cc, 2L, function(jj) { test_no <<- test_no + 1L # first without key - test(1246.0 + test_no*0.01, duplicated(DT, by=jj, fromLast=TRUE), duplicated.data.frame(DT[, jj, with=FALSE], fromLast=TRUE)) + test(1246.0 + test_no*0.01, duplicated(DT, by=jj, fromLast=TRUE), duplicated.data.frame(DT[, jj, with=FALSE], fromLast=TRUE), context=sprintf("jj=%s", paste(jj, collapse=","))) test_no <<- test_no + 1L setkeyv(DT, jj) # with key - test(1246.0 + test_no*0.01, duplicated(DT, by=jj, fromLast=TRUE), duplicated.data.frame(DT[, jj, with=FALSE], fromLast=TRUE)) + test(1246.0 + test_no*0.01, duplicated(DT, by=jj, fromLast=TRUE), duplicated.data.frame(DT[, jj, with=FALSE], fromLast=TRUE), context=sprintf("jj=%s", paste(jj, collapse=","))) }) } if (nfail > oldnfail) cat(seedInfo, "\n") # to reproduce @@ -4702,10 +4702,10 @@ for (i in seq_along(names(DT))) { cc = combn(names(DT), i) apply(cc, 2L, function(jj) { test_no <<- test_no + 1L # first without key - test(1246.0 + test_no*0.01, duplicated(DT, by=jj, fromLast=TRUE), duplicated.data.frame(DT[, jj, with=FALSE], fromLast=TRUE)) + test(1246.0 + test_no*0.01, duplicated(DT, by=jj, fromLast=TRUE), duplicated.data.frame(DT[, jj, with=FALSE], fromLast=TRUE), context=sprintf("jj=%s", paste(jj, collapse=","))) test_no <<- test_no + 1L setkeyv(DT, jj) # with key - test(1246.0 + test_no*0.01, duplicated(DT, by=jj, fromLast=TRUE), duplicated.data.frame(DT[, jj, with=FALSE], fromLast=TRUE)) + test(1246.0 + test_no*0.01, duplicated(DT, by=jj, fromLast=TRUE), duplicated.data.frame(DT[, jj, with=FALSE], fromLast=TRUE), context=sprintf("jj=%s", paste(jj, collapse=","))) }) } if (nfail > oldnfail) cat(seedInfo, "\n") # to reproduce @@ -4801,22 +4801,23 @@ for (i in seq_along(names(DT))) { as.name("base_order"), method = "radix", lapply(seq_along(x), function(j) { + x_nm = as.name(x[j]) if (y[j] == 1L) - as.name(x[j]) + x_nm else { if (is.character(DT[[x[j]]])) - as.call(c(as.name("-"), as.call(list(as.name("xtfrm"), as.name(x[j]))))) + as.call(c(as.name("-"), as.call(list(as.name("xtfrm"), x_nm)))) else - as.call(list(as.name("-"), as.name(x[j]))) + as.call(list(as.name("-"), x_nm)) } }) )) ans1 = forderv(DT, by=x, order=y, na.last=TRUE) # adding tests for both nalast=TRUE and nalast=NA - test(1252.0 + test_no*0.001, ans1, with(DT, eval(ll))) + test(1252.0 + test_no*0.001, ans1, with(DT, eval(ll)), context=sprintf("ll=%s", format(ll))) test_no <<- test_no + 1L ll <- as.call(c(as.list(ll), na.last=NA)) ans1 = forderv(DT, by=x, order=y, na.last=NA) # nalast=NA here. - test(1252.0 + test_no*0.001, ans1[ans1 != 0], with(DT, eval(ll))) + test(1252.0 + test_no*0.001, ans1[ans1 != 0], with(DT, eval(ll)), context=sprintf("ll=%s", format(ll))) }) dim(tmp)=NULL list(tmp) @@ -4942,12 +4943,12 @@ setNumericRounding(old_rounding) # http://stackoverflow.com/questions/22290544/grouping-very-small-numbers-e-g-1e-28-and-0-0-in-data-table-v1-8-10-vs-v1-9-2 old_rounding = getNumericRounding() test_no = 0L -for (dround in c(0,2)) { +for (dround in c(0, 2)) { setNumericRounding(dround) # rounding should not affect the result here because although small, it's very accurace (1 s.f.) - for (i in c(-30:-1,1:30)) { - DT = data.table(c(1 * (10^i),2,9999,-1,0,1)) + for (i in c(-30:-1, 1:30)) { + DT = data.table(c(1 * (10^i), 2, 9999, -1, 0, 1)) test_no = test_no + 1L - test(1278.0 + test_no*0.001, nrow(DT[, .N, by=V1]), 6L) + test(1278.0 + test_no*0.001, nrow(DT[, .N, by=V1]), 6L, context=sprintf("dround=%d, i=%d", dround, i)) } } setNumericRounding(old_rounding) @@ -5781,9 +5782,9 @@ for (i in seq_along(dt)) { r4 = frankv(col, order=-1L, ties.method=k, na.last=j) test_no = test_no + 1L - test(1368.0 + test_no*0.0001, r1, r3) + test(1368.0 + test_no*0.0001, r1, r3, context=sprintf("i=%d, j=%s, k=%s [asc]", i, j, k)) test_no = test_no + 1L - test(1368.0 + test_no*0.0001, r2, r4) + test(1368.0 + test_no*0.0001, r2, r4, context=sprintf("i=%d, j=%s, k=%s [desc]", i, j, k)) } } } @@ -5813,9 +5814,9 @@ for (i in seq_along(dt)) { r4 = frankv(col, order=-1L, ties.method=k, na.last=NA) test_no = test_no + 1L - test(1369.0 + test_no*0.0001, r1, r3) + test(1369.0 + test_no*0.0001, r1, r3, context=sprintf("i=%d, k=%s [asc]", i, k)) test_no = test_no + 1L - test(1369.0 + test_no*0.0001, r2, r4) + test(1369.0 + test_no*0.0001, r2, r4, context=sprintf("i=%d, k=%s [desc]", i, k)) } } @@ -5838,13 +5839,13 @@ for (i in seq_along(dt)) { ans1 = is_na(dt[cols]) ans2 = rowSums(is.na(as.data.table(dt[cols]))) > 0L test_no <<- test_no + 1L - test(1370.0 + test_no*0.0001, ans1, ans2) + test(1370.0 + test_no*0.0001, ans1, ans2, context=sprintf("cols=%s [is_na]", paste(cols, collapse=","))) # update: tests for any_na test_no <<- test_no + 1L - test(1370.0 + test_no*0.0001, any_na(dt[cols]), TRUE) + test(1370.0 + test_no*0.0001, any_na(dt[cols]), context=sprintf("cols=%s [any_na]", paste(cols, collapse=","))) test_no <<- test_no + 1L - test(1370.0 + test_no*0.0001, any_na(ans[cols]), FALSE) + test(1370.0 + test_no*0.0001, !any_na(ans[cols]), context=sprintf("cols=%s [!any_na]", paste(cols, collapse=","))) TRUE }) } @@ -5971,7 +5972,7 @@ for (run in seq_len(times)) { # cat("test =", test_no, ", run = ", run, ", type = ", type, ", mult = ", mult, "\n", sep="") idx = paste(type, mult, run, sep="_") # ans[[idx]] contains fo(gr(i), gr(x), type=type, select=mult) - test(1372.0 + test_no*0.01, thisans, ans[[idx]]) + test(1372.0 + test_no*0.01, thisans, ans[[idx]], context=sprintf("run=%d, type=%s, mult=%s", run, type, mult")) this = this+1L } } @@ -6197,7 +6198,7 @@ for (i in seq_along(DT)) { ans1 = na.omit(DT, cols=cols) ans2 = DT[stats::complete.cases(DT[, cols, with=FALSE])] test_no <<- test_no + 1L - test(1394.0 + test_no*0.001, ans1, ans2) + test(1394.0 + test_no*0.001, ans1, ans2, context=sprintf("cols=%s", paste(cols, collapse=","))) 0L }) } @@ -6566,7 +6567,7 @@ bys <- c("groupCol", "sortedGroupCol", character(0)) test_no <- 1438.0000 if (.Machine$sizeof.pointer>4) { # temporarily disabled for 32bit, #2767 -for(t in seq_len(nrow(all))){ +for (t in seq_len(nrow(all))) { ## test the query with missing j thisQuery <- all$query[t] options("datatable.optimize" = 3L) @@ -6574,24 +6575,24 @@ for(t in seq_len(nrow(all))){ options("datatable.optimize" = 2L) ansRef <- DT[eval(parse(text = thisQuery))] test_no <- test_no + 1L - test(1438.0 + test_no*0.0001, ansOpt, ansRef) + test(1438.0 + test_no*0.0001, ansOpt, ansRef, context=sprintf("t=%d [I]", t)) ## repeat the test with 'which = TRUE' options("datatable.optimize" = 3L) ansOpt <- DT[eval(parse(text = thisQuery)), which = TRUE] options("datatable.optimize" = 2L) ansRef <- DT[eval(parse(text = thisQuery)), which = TRUE] test_no <- test_no + 1L - test(1438.0 + test_no*0.0001, ansOpt, ansRef) + test(1438.0 + test_no*0.0001, ansOpt, ansRef, context=sprintf("t=%d [II]", t)) ## repeat the test with the j queries - for(thisJquery in jQueries) { + for (thisJquery in jQueries) { ## do it with and without existing "by" - for(thisBy in bys){ + for (thisBy in bys) { options("datatable.optimize" = 3L) ansOpt <- DT[eval(parse(text = thisQuery)), eval(parse(text = thisJquery)), by = thisBy] options("datatable.optimize" = 2L) ansRef <- DT[eval(parse(text = thisQuery)), eval(parse(text = thisJquery)), by = thisBy] test_no <- test_no + 1L - test(1438.0 + test_no*0.0001, ansOpt, ansRef) + test(1438.0 + test_no*0.0001, ansOpt, ansRef, context=sprintf("t=%d, thisJquery=%s, thisBy=%s", t, thisJquery, thisBy)) } } } @@ -6890,12 +6891,12 @@ test(1466.2, as.data.table(as.data.frame(x)), as.data.table(x)) # posix type # fix for #1001, #1002 and #759 # When adding a column, even if i results in no rows, the RHS needs to evaluate so we can know the # column type to create. Always create the column for consistency that does not depend on the data in i -for (bool in c(FALSE,TRUE)) { +for (bool in c(FALSE, TRUE)) { options(datatable.auto.index=bool) DT = data.table(a=1:2) - test(1467.01 + bool*0.03, copy(DT)[a==3, b:=notExist+1], error="notExist") - test(1467.02 + bool*0.03, copy(DT)[a==3, b:=a+5L], data.table(a=1:2, b=NA_integer_)) - test(1467.03 + bool*0.03, copy(DT)[a==3, b:=a+5], data.table(a=1:2, b=NA_real_)) + test(1467.01 + bool*0.03, copy(DT)[a==3, b:=notExist+1], error="notExist", context=sprintf("bool=%s [I]", bool)) + test(1467.02 + bool*0.03, copy(DT)[a==3, b:=a+5L], data.table(a=1:2, b=NA_integer_), context=sprintf("bool=%s [II]", bool)) + test(1467.03 + bool*0.03, copy(DT)[a==3, b:=a+5], data.table(a=1:2, b=NA_real_), context=sprintf("bool=%s [III]", bool)) } test(1467.07, getOption("datatable.auto.index")) # ensure to leave TRUE @@ -11365,9 +11366,12 @@ test(1750.07, # 0 length `by`, must also use `sets=list()`, so 0L rows result # for any single value from dataset there should be always be the same aggregate result on any level of grouping # changed from all(sapply()) to for() to save ram, #5517 for (i in seq_len(nrow(dt))) { - test(1750.08+i/10000, uniqueN( - groupingsets(dt[i], j = lapply(.SD, sum), by = c("color","year","status"), sets=list(c("color","year","status"), c("year"), c("status"), character())), - by=c("amount","value")) == 1L) + test(1750.08 + i/10000, + uniqueN( + groupingsets(dt[i], j = lapply(.SD, sum), by = c("color", "year", "status"), sets=list(c("color", "year", "status"), "year", "status", character())), + by=c("amount", "value")), + 1L, + context = sprintf("dt[%d]", i)) } # all grouping id matches in all totals r = groupingsets(dt, j = c(list(cnt=.N), lapply(.SD, sum)), by = c("color","year","status"), sets=list(c("color","year","status"), c("year"), c("status"), character()), id=TRUE) From 0650c62675cd3cb7bae7164378ecf2073de004b1 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 11:29:25 -0700 Subject: [PATCH 04/12] more progress --- inst/tests/tests.Rraw | 75 ++++++++++++++++++++++++------------------- 1 file changed, 42 insertions(+), 33 deletions(-) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 1bc04ad1c3..a65bc74eb4 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -7594,7 +7594,7 @@ dt = data.table(x=1:5, y=6:10) test(1536, duplicated(dt, incomparables=TRUE), error = base_messages$not_yet_used('incomparables != FALSE')) # test for covering melt 100% -test(1537 , names(melt(dt, id.vars=1L, variable.name = "x", value.name="x")), c("x", "x.1", "x.2"), output = "Duplicate column names") +test(1537, names(melt(dt, id.vars=1L, variable.name = "x", value.name="x")), c("x", "x.1", "x.2"), output = "Duplicate column names") # test for tables() test(1538.1, tables(), output="Total:") @@ -7899,20 +7899,20 @@ DT = data.table(int = 1:K, bool = sample( c(TRUE, FALSE), K, replace = TRUE)) DT_NA = DT -for (j in seq_len( ncol(DT) )) { +for (j in seq_len(ncol(DT))) { set(x = DT_NA, i = j, j = j, value = NA) } -for(k in seq_along(nastrings)) { +for (k in seq_along(nastrings)) { dt0 = copy(DT) - for (j in seq_len( ncol(DT) )) { + for (j in seq_len(ncol(DT))) { set(x = dt0, i = NULL, j = j, value = as.character(dt0[[j]])) set(x = dt0, i = j, j = j, value = nastrings[[k]]) } str = do.call(paste, c(dt0, collapse="\n", sep=",")) str = paste(paste(names(dt0), collapse=","), str, sep="\n") DT_fread = fread(str, na.strings = nastrings, verbose = FALSE) - test(1550 + k * 0.1, DT_fread, DT_NA) + test(1550 + k * 0.1, DT_fread, DT_NA, context=sprintf("nastrings=%s", nastrings[k])) } # FR #568 @@ -11371,7 +11371,7 @@ for (i in seq_len(nrow(dt))) { groupingsets(dt[i], j = lapply(.SD, sum), by = c("color", "year", "status"), sets=list(c("color", "year", "status"), "year", "status", character())), by=c("amount", "value")), 1L, - context = sprintf("dt[%d]", i)) + context=sprintf("dt[%d]", i)) } # all grouping id matches in all totals r = groupingsets(dt, j = c(list(cnt=.N), lapply(.SD, sum)), by = c("color","year","status"), sets=list(c("color","year","status"), c("year"), c("status"), character()), id=TRUE) @@ -11616,7 +11616,7 @@ test(1762, DT[ , {}], NULL) # rbindlist empty items segfault, #2019 x = list(list(a = 1), list(), list(a = 2)) ans = data.table(id=c(1L,3L),a=c(1,2)) -for (i in 1:100) test(1763+i/1000, rbindlist(x, idcol="id"), ans) +for (i in 1:100) test(1763+i/1000, rbindlist(x, idcol="id"), ans, context=sprintf("i=%d", i)) # as.ITime(character(0)) used to fail, #2032 test(1764.1, format(as.ITime(character(0))), character(0)) @@ -11989,8 +11989,8 @@ for (mul in c(16, 128, 512, 1024, 2048)) { cat(strrep("1234,5678,9012,3456,7890,abcd,4\x0A", mul), file=ff) close(ff) DT = data.table(V1=rep(1234L, mul), V2=5678L, V3=9012L, V4=3456L, V5=7890L, V6="abcd", V7=4L) - test(1801 + log2(mul)/100 + 0.001, file.info(f)$size, mul*32) - test(1801 + log2(mul)/100 + 0.002, fread(f), DT) + test(1801 + log2(mul)/100 + 0.001, file.info(f)$size, mul*32, context=sprintf("mul=%d [file size]", mul)) + test(1801 + log2(mul)/100 + 0.002, fread(f), DT, context=sprintf("mul=%d [fread]", mul)) } # Test without the newline ff = file(f<-tempfile(), open="wb") @@ -12444,7 +12444,7 @@ DTs = list( # passed fread(fwrite(DT))==DT f = tempfile() for (i in seq_along(DTs)) { fwrite(DTs[[i]], file=f) - test(1857.0 + i/100, fread(f), DTs[[i]]) + test(1857.0 + i/100, fread(f), DTs[[i]], context=sprintf("%d", i)) } unlink(f) @@ -12624,7 +12624,7 @@ test(1871.13, fread("A\n100\n200", verbose=TRUE), data.table(A=c(100L,200L)), ou test(1871.14, fread("col1, col2, col3\n1, 2, 3\n3, 5, 6\n7, 8, 9\n\nsome text to ignore", nrows = 3L), data.table(col1=INT(1,3,7), col2=INT(2,5,8), col3=INT(3,6,9))) # from #1671 (no warning expected) for (i in 100:1) { lines <- paste(c(rep("2,3,4",i), "2,3"), collapse='\n') - test(1871.2 + (100-i)/1000, fread(lines, nrows=i), data.table(V1=rep.int(2L,i), V2=3L, V3=4L)) + test(1871.2 + (100-i)/1000, fread(lines, nrows=i), data.table(V1=rep.int(2L,i), V2=3L, V3=4L), context=sprintf("i=%d", i)) } # miscellaneous missing tests uncovered by CodeCov difference in the process of PR #2573 @@ -13084,7 +13084,7 @@ test(1913.10, all(names(M) %in% union(names(M), names(m)))) test_no = 0L for (name in names(m)) { test_no = test_no + 1L - test(1913.11 + test_no*0.0001, M[[name]], m[[name]]) + test(1913.11 + test_no*0.0001, M[[name]], m[[name]], context=sprintf("name=%s", name)) } # # Original example that smoked out the bug @@ -13102,7 +13102,7 @@ test(1913.13, all(names(M) %in% union(names(M), names(m)))) test_no = 0L for (name in names(m)) { test_no = test_no + 1L - test(1913.14 + test_no*0.0001, M[[name]], m[[name]]) + test(1913.14 + test_no*0.0001, M[[name]], m[[name]], context=sprintf("name=%s", name)) } # # simple subset maintains keys @@ -13140,7 +13140,7 @@ test(1913.23, is.null(key(t2))) # transforming a key column nukes the key test_no = 0L for (col in c('b', 'c')) { test_no = test_no + 1L - test(1913.24 + test_no*0.0001, t2[[col]], dt[[col]]) # mutating-key-transform maintains other columns + test(1913.24 + test_no*0.0001, t2[[col]], dt[[col]], context=sprintf("col=%s", col)) # mutating-key-transform maintains other columns } # Test 1914 of S4 compatibility was moved to S4.Rraw for #3808 @@ -13513,7 +13513,7 @@ eols = c("\n", "\r\n", "\r", "\n\r") for (i in 1:4) { eol = eols[i] src = paste(c("A", "B", "...", ",,,,,", "c1,c2,c3", "1,2,3"), collapse=eol) - test(1959 + (i*0.1), fread(text=src, skip=4), data.table(c1=1L, c2=2L, c3=3L)) + test(1959 + (i*0.1), fread(text=src, skip=4), data.table(c1=1L, c2=2L, c3=3L), context=sprintf("i=%d", i)) } test(1959.5, fread("A\n\nB\n\nC\n1\n", skip=2), data.table(B=c("", "C", "1"))) test(1959.6, fread("A,B\r\r\nX,Y\r\r\nB,C\r\r\n1,2", skip=4), data.table(B=1L, C=2L)) @@ -14872,17 +14872,17 @@ f = tempfile() for (nNUL in 0:3) { writeBin(c(charToRaw("a=b\nA B C\n1 3 5\n"), rep(as.raw(0), nNUL), charToRaw("2 4 6\n")), con=f) num_major = (1+nNUL)/10 - test(2025 + num_major + .01, fread(f, skip=1, header=TRUE), ans<-data.table(A=1:2, B=3:4, C=5:6)) - test(2025 + num_major + .02, fread(f), ans) # auto detect skip and header works too + test(2025 + num_major + .01, fread(f, skip=1, header=TRUE), ans<-data.table(A=1:2, B=3:4, C=5:6), context=sprintf("nNul=%d [I]", nNul)) + test(2025 + num_major + .02, fread(f), ans, context=sprintf("nNul=%d [II]", nNul)) # auto detect skip and header works too writeBin(c(charToRaw("a=b\nA,B,C\n1,3,5\n"), rep(as.raw(0), nNUL), charToRaw("2,4,6\n")), con=f) - test(2025 + num_major + .03, fread(f, skip=1, header=TRUE), ans) - test(2025 + num_major + .04, fread(f), ans) + test(2025 + num_major + .03, fread(f, skip=1, header=TRUE), ans, context=sprintf("nNul=%d [III]", nNul)) + test(2025 + num_major + .04, fread(f), ans, context=sprintf("nNul=%d [IV]", nNul)) writeBin(c(charToRaw("a=b\n"), rep(as.raw(0), nNUL), charToRaw("A B C\n1 3 5\n2 4 6\n")), con=f) - test(2025 + num_major + .05, fread(f, skip=1, header=TRUE), ans) - test(2025 + num_major + .06, fread(f), ans) + test(2025 + num_major + .05, fread(f, skip=1, header=TRUE), ans, context=sprintf("nNul=%d [V]", nNul)) + test(2025 + num_major + .06, fread(f), ans, context=sprintf("nNul=%d [VI]", nNul)) writeBin(c(charToRaw("a=b\n"), rep(as.raw(0), nNUL), charToRaw("A,B,C\n1,3,5\n2,4,6\n")), con=f) - test(2025 + num_major + .07, fread(f, skip=1, header=TRUE), ans) - test(2025 + num_major + .08, fread(f), ans) + test(2025 + num_major + .07, fread(f, skip=1, header=TRUE), ans, context=sprintf("nNul=%d [VII]", nNul)) + test(2025 + num_major + .08, fread(f), ans, context=sprintf("nNul=%d [VIII]", nNul)) } makeNul = function(str){ tt=charToRaw(str); tt[tt==42L]=as.raw(0); writeBin(tt, con=f)} # "*" (42) represents NUL makeNul("A,B,C\n1,foo,5\n2,*bar**,6\n") @@ -17148,8 +17148,8 @@ DT = data.table(A=INT(1,1,2,3,3,4,5,5,6,7), B=lapply(1:10, function(x) structure(rnorm(90), foo=c(42,12,36)))) for (i in 0:4) test(2155+i/10, { gctorture2(step=20); ans=DT[, .(attr(B[[1L]],"foo")[1L]), by=A]; gctorture2(step=0); gc(); ans }, - data.table(A=1:7, V1=42) -) + data.table(A=1:7, V1=42), + context=sprintf("i=%d", i)) # dogroups.c eval(j) could create list columns containing altrep references to the specials, #4759 # thanks to revdep testing of 1.13.2 where package tstools revealed this via ts() creating ALTREP, #4758 @@ -17791,27 +17791,36 @@ test(2210.26, DT[-c(1L,0L), nomatch=0], data.table(x=2:4), warning="Please use n # NA in i would segfault gforce, #1994 DT = data.table(a=1L, b=2, c="a", grp=1L) i = c(1L,NA,NA,NA) # 3 NA to trigger segfault in var (min 3 obs) otherwise just c(1L,NA) is enough to trigger the others -funs = c("sum","mean","var","sd","median","prod","min","max","`[`","first","last","head","tail") +funs = list( + supports_na_rm = list( + no_character = c("sum", "mean", "var", "sd", "median", "prod"), + supports_character = c("min", "max")), + needs_index = c("`[`", "first", "last", "head", "tail") +) +n_numeric_only = length(funs$supports_na_rm$no_character) +n_supporting_na_rm = sum(lengths(funs$supports_na_rm)) +funs = unlist(funs) EVAL = function(...) { e = paste0(...) - # cat(e,"\n") # uncomment to check the queries tested eval(parse(text=e)) } testnum = 0L -for (col in c("a","b","c")) { +for (col in c("a", "b", "c")) { testnum = testnum + 100L for (fi in seq_along(funs)) { - if (col=="c" && fi<=6L) next # first 6 funs don't support type character + if (col == "c" && fi <= n_numeric_only) next f = funs[fi] testnum = testnum + 1L test(2211.0 + testnum*0.001, - EVAL("DT[i, ",f,"(",col, if(fi>8L)", 1L","), by=grp]"), # segfault before when NA in i - EVAL("DT[i][, ",f,"(",col, if(fi>8L)", 1L","), by=grp]")) # ok before by taking DT[i] subset first - if (fi<=8L) { + EVAL("DT[i, ",f,"(",col, if(fi > n_supporting_na_rm)", 1L","), by=grp]"), # segfault before when NA in i + EVAL("DT[i][, ",f,"(",col, if(fi > n_supporting_na_rm)", 1L","), by=grp]"), # ok before by taking DT[i] subset first + context=sprintf("col=%s, f=%s", col, f)) + if (fi <= n_supporting_na_rm) { testnum = testnum + 1L test(2211.0 + testnum*0.001, EVAL("DT[i, ",f,"(",col,", na.rm=TRUE), by=grp]"), - EVAL("DT[i][, ",f,"(",col,", na.rm=TRUE), by=grp]")) + EVAL("DT[i][, ",f,"(",col,", na.rm=TRUE), by=grp]"), + context=sprintf("col=%s, f=%s [na.rm=TRUE]", col, f)) } } } From 972846cb0be18a17701546c2bcd60563df4619d6 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 12:22:32 -0700 Subject: [PATCH 05/12] done --- inst/tests/tests.Rraw | 102 +++++++++++++++++++++++++----------------- 1 file changed, 61 insertions(+), 41 deletions(-) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index a65bc74eb4..6073b53b2d 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -17938,31 +17938,31 @@ for (f1 in funs) { DT = data.table(x=f1(1:4), g=g) for (f2 in funs) { testnum = testnum + 1L - test(2218.0 + testnum*0.001, DT[, shift(x)], f1(c(NA, 1:3))) + test(2218.0 + testnum*0.001, DT[, shift(x)], f1(c(NA, 1:3)), context=sprintf("f1=%s, f2=%s, ungrouped, no fill", deparse(f1), deparse(f2))) testnum = testnum + 1L - w = if (identical(f2,as.character) && !identical(f1,as.character)) "Coercing.*character.*to match the type of target vector" - test(2218.0 + testnum*0.001, DT[, shift(x, fill=f2(NA))], f1(c(NA, 1:3)), warning=w) + w = if (identical(f2, as.character) && !identical(f1, as.character)) "Coercing.*character.*to match the type of target vector" + test(2218.0 + testnum*0.001, DT[, shift(x, fill=f2(NA))], f1(c(NA, 1:3)), warning=w, context=sprintf("f1=%s, f2=%s, ungrouped, fill=NA", deparse(f1), deparse(f2))) testnum = testnum + 1L - if (identical(f1,as.character) && identical(f2,as.complex)) { + if (identical(f1, as.character) && identical(f2, as.complex)) { # one special case due to as.complex(0)=="0+0i"!="0" - test(2218.0 + testnum*0.001, DT[, shift(x, fill="0")], f1(0:3)) + test(2218.0 + testnum*0.001, DT[, shift(x, fill="0")], f1(0:3), context="f1=as.character, f2=as.complex, ungrouped") } else { - test(2218.0 + testnum*0.001, DT[, shift(x, fill=f2(0))], f1(0:3), warning=w) + test(2218.0 + testnum*0.001, DT[, shift(x, fill=f2(0))], f1(0:3), warning=w, context=sprintf("f1=%s, f2=%s, ungrouped, fill=0", deparse(f1), deparse(f2))) } testnum = testnum + 1L - test(2218.0 + testnum*0.001, DT[, shift(x), by=g], data.table(g=g, V1=f1(c(NA, 1, NA, 3)))) + test(2218.0 + testnum*0.001, DT[, shift(x), by=g], data.table(g=g, V1=f1(c(NA, 1, NA, 3))), context=sprintf("f1=%s, f2=%s, grouped, no fill", deparse(f1), deparse(f2))) testnum = testnum + 1L w = if (identical(f2,as.character) && !identical(f1,as.character)) "Coercing.*character.*to match the type of target vector" f = f2(NA) - test(2218.0 + testnum*0.001, DT[, shift(x, fill=f), by=g], data.table(g=g, V1=f1(c(NA, 1, NA, 3))), warning=w) + test(2218.0 + testnum*0.001, DT[, shift(x, fill=f), by=g], data.table(g=g, V1=f1(c(NA, 1, NA, 3))), warning=w, context=sprintf("f1=%s, f2=%s, grouped, fill=NA", deparse(f1), deparse(f2))) testnum = testnum + 1L - if (identical(f1,as.character) && identical(f2,as.complex)) { + if (identical(f1, as.character) && identical(f2, as.complex)) { # one special case due to as.complex(0)=="0+0i"!="0" - test(2218.0 + testnum*0.001, DT[, shift(x, fill="0"), by=g], data.table(g=g, V1=f1(c(0,1,0,3)))) + test(2218.0 + testnum*0.001, DT[, shift(x, fill="0"), by=g], data.table(g=g, V1=f1(c(0,1,0,3))), context="f1=as.character, f2=as.complex, grouped") } else { f = f2(0) - test(2218.0 + testnum*0.001, DT[, shift(x, fill=f), by=g], data.table(g=g, V1=f1(c(0,1,0,3))), warning=w) + test(2218.0 + testnum*0.001, DT[, shift(x, fill=f), by=g], data.table(g=g, V1=f1(c(0,1,0,3))), warning=w, context=sprintf("f1=%s, f2=%s, grouped, fill=0", deparse(f1), deparse(f2))) } } } @@ -17979,9 +17979,9 @@ funs = c("sum", "mean", "min", "max", "median", "var", "sd", "prod") testnum = 0L for (fun in funs) { testnum = testnum + 1L - test(2220.0 + testnum*0.01, EVAL("DT[,",fun,"(i, na.rm='a'), g]"), error="na.rm must be TRUE or FALSE") + test(2220.0 + testnum*0.01, EVAL("DT[,",fun,"(i, na.rm='a'), g]"), error="na.rm must be TRUE or FALSE", context=sprintf("fun=%s [na.rm='a']", fun)) testnum = testnum + 1L - test(2220.0 + testnum*0.01, EVAL("DT[,",fun,"(f), g]"), error=sprintf("%s is not meaningful for factors.", fun)) + test(2220.0 + testnum*0.01, EVAL("DT[,",fun,"(f), g]"), error=sprintf("%s is not meaningful for factors.", fun), context=sprintf("fun=%s [factor]", fun)) } testnum = testnum + 1L test(2220.0 + testnum*0.01, DT[, prod(l), g], error="GForce prod can only be applied to columns, not .SD or similar.") @@ -18018,13 +18018,14 @@ if (test_bit64) { } i = 1L for (col in names(DT)[-1]) { - for (n in list(1, 5, -1, -5, c(1,2), c(-1,1))) { - for (type in c('lag','lead','shift','cyclic')) { + for (n in list(1, 5, -1, -5, c(1, 2), c(-1, 1))) { + for (type in c('lag', 'lead', 'shift', 'cyclic')) { # fill is tested by group in tests 2218.*; see comments in #5205 # sapply(sapply()) changed to for(for(for())) to save 29MiB, #5517 test(2224.1+i/10000, # 192 tests here when test_bit64=TRUE; 168 when FALSE EVAL(sprintf("DT[, shift(%s, %d, type='%s'), by=x]$V1", col, n, type)), - ans[[i]]) + ans[[i]], + context=sprintf("col=%s, n=%s", type=%s", col, paste(n, collapse=","), type)) i = i+1L } } @@ -18283,18 +18284,18 @@ test(2233.38, copy(DT)[, val:=v[1L], keyby=.(A,B), verbose=TRUE], data.table(A=I set.seed(10) n = 100 a = data.table(id1=1:n, id2=sample(1:900,n,replace=TRUE), flag=sample(c(0,0,0,1),n,replace=TRUE)) -for (opt in c(0,Inf)) { +for (opt in c(0, Inf)) { options(datatable.optimize=opt) out = if (opt) "GForce.*gsum" else "GForce FALSE" B = copy(a) A = a[sample(seq_len(nrow(a)), nrow(a))] # shuffle num_bump = (opt>0)/100 - test(2233.39+num_bump+0.001, A[, t1 := sum(flag, na.rm=TRUE), by=id2, verbose=TRUE], A, output=out) # y=A dummy just to test output= + test(2233.39+num_bump+0.001, A[, t1 := sum(flag, na.rm=TRUE), by=id2, verbose=TRUE], A, output=out, context=sprintf("optimize=%s [I]", format(opt))) # y=A dummy just to test output= setorder(A, id1) - test(2233.39+num_bump+0.002, A[, t2 := sum(flag, na.rm=TRUE), by=id2, verbose=TRUE], A, output=out) - test(2233.39+num_bump+0.003, any(A[,t1!=t2]), FALSE) - test(2233.39+num_bump+0.004, any(A[, length(unique(t1))>1, by=id2]$V1), FALSE) - test(2233.39+num_bump+0.005, any(A[, length(unique(t2))>1, by=id2]$V1), FALSE) + test(2233.39+num_bump+0.002, A[, t2 := sum(flag, na.rm=TRUE), by=id2, verbose=TRUE], A, output=out, context=sprintf("optimize=%s [II]", format(opt))) + test(2233.39+num_bump+0.003, !any(A[,t1!=t2])) + test(2233.39+num_bump+0.004, !any(A[, length(unique(t1))>1, by=id2]$V1), context=sprintf("optimize=%s [III]", format(opt))) + test(2233.39+num_bump+0.005, !any(A[, length(unique(t2))>1, by=id2]$V1), context=sprintf("optimize=%s [IV]", format(opt))) } # test from #5337 n=4; k=2 @@ -19283,61 +19284,80 @@ names(sdlist) <- sdnames for (opt in c(0, 1, 2)) { test(2283 + opt/10 + 0.001, options=c(datatable.optimize=opt), names(M[, c(m=lapply(.SD, mean)), by="cyl"]), - c("cyl", names(c(m=sdlist)))) + c("cyl", names(c(m=sdlist))), + context=sprintf("optimize=%s [I]", format(opt))) test(2283 + opt/10 + 0.002, options=c(datatable.optimize=opt), names(M[, c(Mpg=list(mpg), lapply(.SD, mean)), by="cyl"]), - c("cyl", "Mpg", sdnames)) + c("cyl", "Mpg", sdnames), + context=sprintf("optimize=%s [II]", format(opt))) test(2283 + opt/10 + 0.003, options=c(datatable.optimize=opt), names(M[, c(Mpg=list(mpg), m=lapply(.SD, mean)), by="cyl"]), - c("cyl", "Mpg", names(c(m=sdlist)))) + c("cyl", "Mpg", names(c(m=sdlist))), + context=sprintf("optimize=%s [III]", format(opt))) test(2283 + opt/10 + 0.004, options=c(datatable.optimize=opt), names(M[, c(mpg=list(mpg), mpg=lapply(.SD, mean)), by="cyl"]), - c("cyl", "mpg", names(c(mpg=sdlist)))) + c("cyl", "mpg", names(c(mpg=sdlist))), + context=sprintf("optimize=%s [IV]", format(opt))) test(2283 + opt/10 + 0.005, options=c(datatable.optimize=opt), names(M[, c(list(mpg), lapply(.SD, mean)), by="cyl"]), - c("cyl", "V1", sdnames)) + c("cyl", "V1", sdnames), + context=sprintf("optimize=%s [V]", format(opt))) test(2283 + opt/10 + 0.006, options=c(datatable.optimize=opt), names(M[, c(lapply(.SD, mean), list(mpg)), by="cyl"]), - c("cyl", sdnames, sprintf("V%d", length(sdnames)+1L))) + c("cyl", sdnames, sprintf("V%d", length(sdnames)+1L)), + context=sprintf("optimize=%s [VI]", format(opt))) test(2283 + opt/10 + 0.007, options=c(datatable.optimize=opt), names(M[, c(lapply(.SD, mean), lapply(.SD, sum)), by="cyl"]), - c("cyl", sdnames, sdnames)) + c("cyl", sdnames, sdnames), + context=sprintf("optimize=%s [VII]", format(opt))) test(2283 + opt/10 + 0.008, options=c(datatable.optimize=opt), names(M[, c(mean=lapply(.SD, mean), sum=lapply(.SD, sum)), by="cyl"]), - c("cyl", names(c(mean=sdlist, sum=sdlist)))) + c("cyl", names(c(mean=sdlist, sum=sdlist))), + context=sprintf("optimize=%s [VIII]", format(opt))) test(2283 + opt/10 + 0.009, options=c(datatable.optimize=opt), names(M[, c(lapply(.SD, mean), sum=lapply(.SD, sum)), by="cyl"]), - c("cyl", sdnames, names(c(sum=sdlist))) ) + c("cyl", sdnames, names(c(sum=sdlist))) , + context=sprintf("optimize=%s [IX]", format(opt))) test(2283 + opt/10 + 0.010, options=c(datatable.optimize=opt), names(M[, c(" "=lapply(.SD, mean), "."=lapply(.SD, sum)), by="cyl"]), - c("cyl", names(c(" "=sdlist, "."=sdlist)))) + c("cyl", names(c(" "=sdlist, "."=sdlist))), + context=sprintf("optimize=%s [X]", format(opt))) test(2283 + opt/10 + 0.011, options=c(datatable.optimize=opt), names(M[, c(A=list(a=mpg, b=hp), lapply(.SD, mean)), by="cyl"]), - c("cyl", names(c(A=list(a=0, b=0))), sdnames)) + c("cyl", names(c(A=list(a=0, b=0))), sdnames), + context=sprintf("optimize=%s [XI]", format(opt))) test(2283 + opt/10 + 0.012, options=c(datatable.optimize=opt), names(M[, c(A=list(mpg, hp), lapply(.SD, mean)), by="cyl"]), - c("cyl", names(c(A=list(0, 0))), sdnames)) + c("cyl", names(c(A=list(0, 0))), sdnames), + context=sprintf("optimize=%s [XII]", format(opt))) test(2283 + opt/10 + 0.013, options=c(datatable.optimize=opt), names(M[, c(A=list(mpg, b=hp, wt), lapply(.SD, mean)), by="cyl"]), - c("cyl", names(c(A=list(0, b=0, 0))), sdnames)) + c("cyl", names(c(A=list(0, b=0, 0))), sdnames), + context=sprintf("optimize=%s [XIII]", format(opt))) test(2283 + opt/10 + 0.014, options=c(datatable.optimize=opt), names(M[, c(A=list(mpg), lapply(.SD, mean)), by="cyl"]), - c("cyl", names(c(A=list(0))), sdnames)) + c("cyl", names(c(A=list(0))), sdnames), + context=sprintf("optimize=%s [XIV]", format(opt))) test(2283 + opt/10 + 0.015, options=c(datatable.optimize=opt), names(M[, c(" "=list(" "=hp, "."=disp, mpg), lapply(.SD, mean)), by="cyl"]), - c("cyl", names(c(" "=list(" "=0, "."=0, 0))), sdnames)) + c("cyl", names(c(" "=list(" "=0, "."=0, 0))), sdnames), + context=sprintf("optimize=%s [XV]", format(opt))) test(2283 + opt/10 + 0.016, options=c(datatable.optimize=opt), names(M[, c("."=list(" "=hp, "."=disp, mpg), lapply(.SD, mean)), by="cyl"]), - c("cyl", names(c("."=list(" "=0, "."=0, 0))), sdnames)) + c("cyl", names(c("."=list(" "=0, "."=0, 0))), sdnames), + context=sprintf("optimize=%s [XVI]", format(opt))) test(2283 + opt/10 + 0.017, options=c(datatable.optimize=opt), names(M[, c(list(mpg, b=hp), lapply(.SD, mean)), by="cyl", .SDcols=c("vs", "am")]), - c("cyl", "V1", "b", "vs", "am")) + c("cyl", "V1", "b", "vs", "am"), + context=sprintf("optimize=%s [XVII]", format(opt))) test(2283 + opt/10 + 0.018, options=c(datatable.optimize=opt), names(M[, c(list(mpg, b=hp), c(lapply(.SD, mean))), by="cyl", .SDcols=c("vs", "am")]), - c("cyl", "V1", "b", "vs", "am")) + c("cyl", "V1", "b", "vs", "am"), + context=sprintf("optimize=%s [XVIII]", format(opt))) test(2283 + opt/10 + 0.019, options=c(datatable.optimize=opt), names(M[, c(mpg[1], list(mpg, b=hp), c(lapply(.SD, mean))), by="cyl", .SDcols=c("vs", "am")]), - c("cyl", "V1", "V2", "b", "vs", "am")) + c("cyl", "V1", "V2", "b", "vs", "am"), + context=sprintf("optimize=%s [XIX]", format(opt))) } # Confusing behavior with DT[, min(var):max(var)] #2069 From 7915132aebd2950bc5d8ecc571c84cba795090aa Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 12:34:59 -0700 Subject: [PATCH 06/12] done mergelist --- inst/tests/mergelist.Rraw | 110 +++++++++++++++++++------------------- 1 file changed, 55 insertions(+), 55 deletions(-) diff --git a/inst/tests/mergelist.Rraw b/inst/tests/mergelist.Rraw index 81df47e207..448c67f034 100644 --- a/inst/tests/mergelist.Rraw +++ b/inst/tests/mergelist.Rraw @@ -149,10 +149,10 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(21 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected) ## copy=TRUE: no shared columns - test(21 + (frac <- frac + 0.001), copied(ans, l)) - test(21 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected) ## copy=FALSE: LHS shared but no RHS - test(21 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(21 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected, context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) ## copy=TRUE: no shared columns + test(21 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(21 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected, context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) ## copy=FALSE: LHS shared but no RHS + test(21 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-notcopied]", how, mult)) } } }) @@ -174,13 +174,13 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(22 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]]) - test(22 + (frac <- frac + 0.001), copied(ans, l)) - test(22 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]]) + test(22 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) + test(22 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(22 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) if (how == "full") { - test(22 + (frac <- frac + 0.001), copied(ans, l)) + test(22 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } else { - test(22 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(22 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } } } @@ -203,13 +203,13 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(23 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]]) - test(23 + (frac <- frac + 0.001), copied(ans, l)) - test(23 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]]) + test(23 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) + test(23 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(23 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) if (how == "inner") { - test(23 + (frac <- frac + 0.001), copied(ans, l)) + test(23 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } else { - test(23 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(23 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } } } @@ -232,13 +232,13 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(24 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]]) - test(24 + (frac <- frac + 0.001), copied(ans, l)) - test(24 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]]) + test(24 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) + test(24 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(24 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) if (how %in% c("inner", "full")) { - test(24 + (frac <- frac + 0.001), copied(ans, l)) + test(24 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } else { - test(24 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(24 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } } } @@ -261,13 +261,13 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(25 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]]) - test(25 + (frac <- frac + 0.001), copied(ans, l)) - test(25 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]]) + test(25 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) + test(25 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(25 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) if (how %in% c("inner", "full")) { - test(25 + (frac <- frac + 0.001), copied(ans, l)) + test(25 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } else { - test(25 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(25 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } } } @@ -290,10 +290,10 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(26 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]]) - test(26 + (frac <- frac + 0.001), copied(ans, l)) - test(26 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]]) - test(26 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(26 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) + test(26 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(26 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) + test(26 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-notcopied]", how, mult)) } } }) @@ -315,10 +315,10 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(27 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]]) - test(27 + (frac <- frac + 0.001), copied(ans, l)) - test(27 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]]) - test(27 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(27 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) + test(27 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(27 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) + test(27 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-notcopied]", how, mult)) } } }) @@ -340,13 +340,13 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(28 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]]) - test(28 + (frac <- frac + 0.001), copied(ans, l)) - test(28 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]]) + test(28 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) + test(28 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(28 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) if (how == "inner") { - test(28 + (frac <- frac + 0.001), copied(ans, l)) + test(28 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } else { - test(28 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(28 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-copiedness]", how, mult)) } } } @@ -369,10 +369,10 @@ local({ frac = frac + 0.1 for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 - test(29 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]]) - test(29 + (frac <- frac + 0.001), copied(ans, l)) - test(29 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]]) - test(29 + (frac <- frac + 0.001), notcopied(ans, l, how=how)) + test(29 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=TRUE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=TRUE]", how, mult)) + test(29 + (frac <- frac + 0.001), copied(ans, l), context=sprintf("how=%s, mult=%s [check-copied]", how, mult)) + test(29 + (frac <- frac + 0.001), ans <- mergepair(l$lhs, l$rhs, on="id1", how=how, mult=mult, copy=FALSE), expected[[how]], context=sprintf("how=%s, mult=%s [copy=FALSE]", how, mult)) + test(29 + (frac <- frac + 0.001), notcopied(ans, l, how=how), context=sprintf("how=%s, mult=%s [check-notcopied]", how, mult)) } } }) @@ -974,9 +974,9 @@ local({ for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 if (is.null(expected[[how]][[mult]])) { - test(221 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge") + test(221 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge", context=sprintf("how=%s, mult=%s", how, mult)) } else { - test(221 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]]) + test(221 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]], context=sprintf("how=%s, mult=%s", how, mult)) } } } @@ -1017,9 +1017,9 @@ local({ for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 if (is.null(expected[[how]][[mult]])) { - test(222 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge") + test(222 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge", context=sprintf("how=%s, mult=%s", how, mult)) } else { - test(222 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]]) + test(222 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]], context=sprintf("how=%s, mult=%s", how, mult)) } } } @@ -1060,9 +1060,9 @@ local({ for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 if (is.null(expected[[how]][[mult]])) { - test(223 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge") + test(223 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge", context=sprintf("how=%s, mult=%s", how, mult)) } else { - test(223 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]]) + test(223 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]], context=sprintf("how=%s, mult=%s", how, mult)) } } } @@ -1103,9 +1103,9 @@ local({ for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 if (is.null(expected[[how]][[mult]])) { - test(224 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge") + test(224 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge", context=sprintf("how=%s, mult=%s", how, mult)) } else { - test(224 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]]) + test(224 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]], context=sprintf("how=%s, mult=%s", how, mult)) } } } @@ -1146,9 +1146,9 @@ local({ for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 if (is.null(expected[[how]][[mult]])) { - test(225 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge") + test(225 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge", context=sprintf("how=%s, mult=%s", how, mult)) } else { - test(225 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]]) + test(225 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]], context=sprintf("how=%s, mult=%s", how, mult)) } } } @@ -1189,9 +1189,9 @@ local({ for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 if (is.null(expected[[how]][[mult]])) { - test(226 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge") + test(226 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge", context=sprintf("how=%s, mult=%s", how, mult)) } else { - test(226 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]]) + test(226 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]], context=sprintf("how=%s, mult=%s", how, mult)) } } } @@ -1232,9 +1232,9 @@ local({ for (mult in c("all", "first", "last", "error")) { frac = frac + 0.01 if (is.null(expected[[how]][[mult]])) { - test(227 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge") + test(227 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), error="multiple matches during merge", context=sprintf("how=%s, mult=%s", how, mult)) } else { - test(227 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]]) + test(227 + (frac <- frac + 0.001), mergelist(l, on="id1", how=how, mult=mult), expected[[how]][[mult]], context=sprintf("how=%s, mult=%s", how, mult)) } } } From f56c4b54b995f9836e480ce92c2d3ec43c8095cd Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 19:55:00 +0000 Subject: [PATCH 07/12] typos --- inst/tests/tests.Rraw | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 6073b53b2d..741c09b87e 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -5972,7 +5972,7 @@ for (run in seq_len(times)) { # cat("test =", test_no, ", run = ", run, ", type = ", type, ", mult = ", mult, "\n", sep="") idx = paste(type, mult, run, sep="_") # ans[[idx]] contains fo(gr(i), gr(x), type=type, select=mult) - test(1372.0 + test_no*0.01, thisans, ans[[idx]], context=sprintf("run=%d, type=%s, mult=%s", run, type, mult")) + test(1372.0 + test_no*0.01, thisans, ans[[idx]], context=sprintf("run=%d, type=%s, mult=%s", run, type, mult)) this = this+1L } } @@ -18025,7 +18025,7 @@ for (col in names(DT)[-1]) { test(2224.1+i/10000, # 192 tests here when test_bit64=TRUE; 168 when FALSE EVAL(sprintf("DT[, shift(%s, %d, type='%s'), by=x]$V1", col, n, type)), ans[[i]], - context=sprintf("col=%s, n=%s", type=%s", col, paste(n, collapse=","), type)) + context=sprintf("col=%s, n=%s, type=%s", col, paste(n, collapse=","), type)) i = i+1L } } From 9b2d99a67524d2ca5d0b0d476886434ca7f29df4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 13:08:26 -0700 Subject: [PATCH 08/12] nocov --- R/test.data.table.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/test.data.table.R b/R/test.data.table.R index 6b4f7fd599..6426ace9d6 100644 --- a/R/test.data.table.R +++ b/R/test.data.table.R @@ -574,7 +574,7 @@ test = function(num, x, y=TRUE, # nocov end } if (fail && !is.null(context)) { - catf("Test context: %s\n", context) + catf("Test context: %s\n", context) # nocov } if (fail && .test.data.table && num>0.0) { # nocov start From 08d855873052d33ff0466ab1819387fe367e3313 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 26 Dec 2025 17:34:32 +0000 Subject: [PATCH 09/12] finish merge --- inst/tests/frollBatch.Rraw | 62 +++++++++++++++----------------------- 1 file changed, 24 insertions(+), 38 deletions(-) diff --git a/inst/tests/frollBatch.Rraw b/inst/tests/frollBatch.Rraw index dd1e286136..ff8dbbcfad 100644 --- a/inst/tests/frollBatch.Rraw +++ b/inst/tests/frollBatch.Rraw @@ -64,21 +64,17 @@ base_compare = function(x, n, funs=c("mean","sum","max","min","prod","median","v } 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) - )) + test(num, + 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), + context=sprintf("fun=%s\tna.rm=$s\tfill=%s\tpartial=%s\thas.nf=%s\talgo=%s", fun, na.rm, fill, partial, has.nf, algo)) } } 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) - )) + 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), + context=sprintf("fun=%s\tna.rm=$s\tfill=%s\tpartial=%s", fun, na.rm, fill, partial)) } } } @@ -152,21 +148,17 @@ if (requireNamespace("zoo", quietly=TRUE)) { } 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) - )) + 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), + context=sprintf("fun=%s\talign=%s\tna.rm=$s\tfill=%s\tpartial=%s\thas.nf=%s\talgo=%s", fun, align, na.rm, fill, partial, has.nf, algo)) } } 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) - )) + 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), + context=sprintf("fun=%s\talign=%s\tna.rm=$s\tfill=%s\tpartial=%s", fun, align, na.rm, fill, partial)) } } } @@ -250,24 +242,18 @@ afun_compare = function(x, n, funs=c("mean","sum","max","min","prod","median","v } 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) - )) + 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), + context=sprintf("fun=%s\talign=%s\tna.rm=$s\tfill=%s\tpartial=%s\thas.nf=%s\talgo=%s", fun, align, na.rm, fill, partial, has.nf, algo)) } } } 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) - )) + 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), + context=sprintf("fun=%s\talign=%s\tna.rm=$s\tfill=%s", fun, align, na.rm, fill)) } } } From 0eba59608a7dcc59f323c25909f4b90face34961 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 26 Dec 2025 17:36:28 +0000 Subject: [PATCH 10/12] revert bad merge --- inst/tests/froll.Rraw | 1057 ++++++++++++++++++++++++++++++++++------- 1 file changed, 883 insertions(+), 174 deletions(-) diff --git a/inst/tests/froll.Rraw b/inst/tests/froll.Rraw index c65487c13b..489afcdad0 100644 --- a/inst/tests/froll.Rraw +++ b/inst/tests/froll.Rraw @@ -861,182 +861,891 @@ test(6000.225, frollsum(1:3, c(2,2,2), adaptive=TRUE), c(NA, 3, 5), output="frol test(6000.226, frollsum(c(NA,2,3), c(2,2,2), adaptive=TRUE), c(NA, NA, 5), output="non-finite values are present in input, re-running with extra care for NFs") options(datatable.verbose=FALSE) -## 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 -} -num = 6001.0 -## 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) { - ans = rep(fill, nx<-length(x)) - f = match.fun(FUN) - if (nf.rm) x[is.infinite(x)] = NA_real_ - for (i in n:nx) ans[i] = f(x[(i-n+1):i], na.rm=na.rm) - ans -} -base_compare = function(x, n, funs=c("mean","sum"), algos=c("fast","exact")) { - num.step = 0.001 - for (fun in funs) { - for (na.rm in c(FALSE, TRUE)) { - for (fill in c(NA_real_, 0)) { - for (algo in algos) { - num <<- num + num.step - eval(substitute( # so we can have values displayed in output/log rather than variables - test(.num, - froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo), - rollfun(x, n, FUN=.fun, fill=.fill, na.rm=.na.rm, nf.rm=.nf.rm)), - list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .nf.rm=algo!="exact") - )) - } - } - } - } -} -## 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) -num = 6002.0 -#### 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"), algos=c("fast","exact")) { - num.step = 0.0001 - #### fun, align, na.rm, fill, algo - 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 (algo in algos) { - num <<- num + num.step - eval(substitute( # so we can have values displayed in output/log rather than variables - test(.num, - froll(.fun, x, n, align=.align, fill=.fill, na.rm=.na.rm, algo=.algo), - drollapply(x, n, FUN=.fun, fill=.fill, align=.align, na.rm=.na.rm)), - list(.num=num, .fun=fun, .align=align, .fill=fill, .na.rm=na.rm, .algo=algo) - )) - } - } - } - } - } - } - ## 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 -num = 6003.0 -arollfun = function(fun, x, n, na.rm=FALSE, fill=NA, nf.rm=FALSE) { - # adaptive moving average in R - stopifnot((nx<-length(x))==length(n)) - ans = rep(NA_real_, nx) - if (nf.rm) x[is.infinite(x)] = NA_real_ - FUN = match.fun(fun) - for (i in seq_along(x)) { - ans[i] = if (i >= n[i]) - FUN(x[(i-n[i]+1):i], na.rm=na.rm) - else as.double(fill) - } +## frollmax adaptive +options(datatable.verbose=TRUE) ## adaptive frollmax no fast algo +test(6000.3, frollmax(1:4, c(2,2,2,2), adaptive=TRUE), output="frolladaptivefun: algo 0 not implemented, fall back to 1") +test(6000.3001, frollmax(1:4, c(2,2,2,2), algo="fast", adaptive=TRUE), output="frolladaptivefun: algo 0 not implemented, fall back to 1") +test(6000.3002, frollmax(1:4, c(2,2,2,2), algo="exact", adaptive=TRUE), notOutput="frolladaptivefun: algo 0 not implemented, fall back to 1") +options(datatable.verbose=FALSE) +n = c(3,2,2,4,2,1,4,8) +x = c(7,2,3,6,3,2,6,6) # no NA +test(6000.3111, frollmax(x, n, adaptive=TRUE), c(NA,7,3,7,6,2,6,7)) # has.nf=NA # narm=F +test(6000.3112, frollmax(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,7,3,7,6,2,6,7)) # narm=T +test(6000.3121, frollmax(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,7,3,7,6,2,6,7)) # has.nf=F +test(6000.3122, frollmax(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.3131, frollmax(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,7,3,7,6,2,6,7)) # has.nf=T +test(6000.3132, frollmax(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,7,3,7,6,2,6,7)) +x = c(7,2,NA,6,3,NA,6,6) # NA +test(6000.3211, frollmax(x, n, adaptive=TRUE), c(NA,7,NA,NA,6,NA,NA,NA)) +test(6000.3212, frollmax(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,7,2,7,6,-Inf,6,7)) +test(6000.3221, frollmax(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,7,2,7,6,-Inf,6,7)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.3222, frollmax(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.3231, frollmax(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,7,NA,NA,6,NA,NA,NA)) +test(6000.3232, frollmax(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,7,2,7,6,-Inf,6,7)) +x = rep(NA_real_, 8) # all NA +test(6000.3241, frollmax(x, n, adaptive=TRUE), rep(NA_real_, 8)) +test(6000.3242, frollmax(x, n, na.rm=TRUE, adaptive=TRUE), c(NA, rep(-Inf, 7))) +test(6000.3251, frollmax(x, n, has.nf=FALSE, adaptive=TRUE), c(NA, rep(-Inf, 7))) +test(6000.3252, frollmax(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.3261, frollmax(x, n, has.nf=TRUE, adaptive=TRUE), rep(NA_real_, 8)) +test(6000.3262, frollmax(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA, rep(-Inf, 7))) +x = c(NA,NaN,NA,NaN,NaN,NaN,NA,NA) # all NaN/NA +test(6000.3271, frollmax(x, n, adaptive=TRUE), c(NA,NA,NA,NA,NaN,NaN,NA,NA)) +test(6000.3272, frollmax(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) +test(6000.3281, frollmax(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.3282, frollmax(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.3291, frollmax(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,NA,NA,NA,NaN,NaN,NA,NA)) +test(6000.3292, frollmax(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) +x = c(7,2,NA,6,3,Inf,6,6) # Inf +test(6000.3311, frollmax(x, n, adaptive=TRUE), c(NA,7,NA,NA,6,Inf,Inf,NA)) +test(6000.3312, frollmax(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,7,2,7,6,Inf,Inf,Inf)) +test(6000.3321, frollmax(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,7,2,7,6,Inf,Inf,Inf)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.3322, frollmax(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.3331, frollmax(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,7,NA,NA,6,Inf,Inf,NA)) +test(6000.3332, frollmax(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,7,2,7,6,Inf,Inf,Inf)) +x = c(7,2,-Inf,6,3,NA,6,6) # -Inf +test(6000.3341, frollmax(x, n, adaptive=TRUE), c(NA,7,2,7,6,NA,NA,NA)) +test(6000.3342, frollmax(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,7,2,7,6,-Inf,6,7)) +test(6000.3351, frollmax(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,7,2,7,6,-Inf,6,7)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.3352, frollmax(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.3361, frollmax(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,7,2,7,6,NA,NA,NA)) +test(6000.3362, frollmax(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,7,2,7,6,-Inf,6,7)) + +## frollmax non-adaptive +options(datatable.verbose=TRUE) +test(6000.4001, frollmax(1:3, 2), c(NA, 2, 3), output="frollmaxFast: running for input length") +test(6000.4002, frollmax(1:10, 5), c(NA,NA,NA,NA,5,6,7,8,9,10), output="frollmaxFast: nested window max calculation called 0 times") +test(6000.4003, frollmax(10:1, 5), c(NA,NA,NA,NA,10,9,8,7,6,5), output="frollmaxFast: nested window max calculation called 5 times") +test(6000.4004, frollmax(1:3, 2, algo="exact"), c(NA, 2, 3), output="frollmaxExact: running in parallel for input length") +test(6000.4005, frollmax(c(1,2,3,NA,5), 2), c(NA, 2, 3, NA, NA), output="continue with extra care for NFs") +options(datatable.verbose=FALSE) +n = 3 +x = c(7,2,3,6,3,2,4,5) # no NA +ans = c(NA,NA,7,6,6,6,4,5) +test(6000.4111, frollmax(x, n), ans) # has.nf=NA # narm=F +test(6000.4112, frollmax(x, n, na.rm=TRUE), ans) # narm=T +test(6000.4113, frollmax(x, n, algo="exact"), ans) # has.nf=NA # narm=F +test(6000.4114, frollmax(x, n, algo="exact", na.rm=TRUE), ans) # narm=T +test(6000.4121, frollmax(x, n, has.nf=FALSE), ans) # has.nf=F +test(6000.4122, frollmax(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4123, frollmax(x, n, algo="exact", has.nf=FALSE), ans) # has.nf=F +test(6000.4124, frollmax(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4131, frollmax(x, n, has.nf=TRUE), ans) # has.nf=T +test(6000.4132, frollmax(x, n, has.nf=TRUE, na.rm=TRUE), ans) +test(6000.4133, frollmax(x, n, algo="exact", has.nf=TRUE), ans) # has.nf=T +test(6000.4134, frollmax(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), ans) +x = c(7,2,3,NA,3,2,4,NA) # NA +test(6000.4211, frollmax(x, n), c(NA,NA,7,NA,NA,NA,4,NA)) +test(6000.4212, frollmax(x, n, na.rm=TRUE), c(NA,NA,7,3,3,3,4,4)) +test(6000.4213, frollmax(x, n, algo="exact"), c(NA,NA,7,NA,NA,NA,4,NA)) +test(6000.4214, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA,7,3,3,3,4,4)) +test(6000.4221, frollmax(x, n, has.nf=FALSE), c(NA,NA,7,3,3,3,4,4)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.4222, frollmax(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4223, frollmax(x, n, algo="exact", has.nf=FALSE), c(NA,NA,7,3,3,3,4,4)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.4224, frollmax(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4231, frollmax(x, n, has.nf=TRUE), c(NA,NA,7,NA,NA,NA,4,NA)) +test(6000.4232, frollmax(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA,7,3,3,3,4,4)) +test(6000.4233, frollmax(x, n, algo="exact", has.nf=TRUE), c(NA,NA,7,NA,NA,NA,4,NA)) +test(6000.4234, frollmax(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA,7,3,3,3,4,4)) +x = rep(NA_real_, 8) # all NA +test(6000.4241, frollmax(x, n), rep(NA_real_, 8)) +test(6000.4242, frollmax(x, n, na.rm=TRUE), c(NA,NA, rep(-Inf, 6))) +test(6000.4243, frollmax(x, n, algo="exact"), rep(NA_real_, 8)) +test(6000.4244, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA, rep(-Inf, 6))) +test(6000.4251, frollmax(x, n, has.nf=FALSE), c(NA,NA, rep(-Inf, 6))) +test(6000.4252, frollmax(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4253, frollmax(x, n, algo="exact", has.nf=FALSE), c(NA,NA, rep(-Inf, 6))) +test(6000.4254, frollmax(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4261, frollmax(x, n, has.nf=TRUE), rep(NA_real_, 8)) +test(6000.4262, frollmax(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA, rep(-Inf, 6))) +test(6000.4263, frollmax(x, n, algo="exact", has.nf=TRUE), rep(NA_real_, 8)) +test(6000.4264, frollmax(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA, rep(-Inf, 6))) +x = c(NA,NaN,NA,NaN,NaN,NaN,NA,NA) # all NaN/NA +test(6000.4271, frollmax(x, n), c(NA,NA,NA,NA,NA,NaN,NA,NA)) +test(6000.4272, frollmax(x, n, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) +test(6000.4273, frollmax(x, n, algo="exact"), c(NA,NA,NA,NA,NA,NaN,NA,NA)) +test(6000.4274, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) +test(6000.4281, frollmax(x, n, has.nf=FALSE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.4282, frollmax(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4283, frollmax(x, n, algo="exact", has.nf=FALSE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.4284, frollmax(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4291, frollmax(x, n, has.nf=TRUE), c(NA,NA,NA,NA,NA,NaN,NA,NA)) +test(6000.4292, frollmax(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) +test(6000.4293, frollmax(x, n, algo="exact", has.nf=TRUE), c(NA,NA,NA,NA,NA,NaN,NA,NA)) +test(6000.4294, frollmax(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) +x = c(NA,2,6,3,Inf,2,4,5) # Inf +test(6000.4311, frollmax(x, n), c(NA,NA,NA,6,Inf,Inf,Inf,5)) +test(6000.4312, frollmax(x, n, na.rm=TRUE), c(NA,NA,6,6,Inf,Inf,Inf,5)) +test(6000.4313, frollmax(x, n, algo="exact"), c(NA,NA,NA,6,Inf,Inf,Inf,5)) +test(6000.4314, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA,6,6,Inf,Inf,Inf,5)) +test(6000.4321, frollmax(x, n, has.nf=FALSE), c(NA,NA,6,6,Inf,Inf,Inf,5)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.4322, frollmax(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4323, frollmax(x, n, algo="exact", has.nf=FALSE), c(NA,NA,6,6,Inf,Inf,Inf,5)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.4324, frollmax(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4331, frollmax(x, n, has.nf=TRUE), c(NA,NA,NA,6,Inf,Inf,Inf,5)) +test(6000.4332, frollmax(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA,6,6,Inf,Inf,Inf,5)) +test(6000.4333, frollmax(x, n, algo="exact", has.nf=TRUE), c(NA,NA,NA,6,Inf,Inf,Inf,5)) +test(6000.4334, frollmax(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA,6,6,Inf,Inf,Inf,5)) +x = c(NA,2,-Inf,3,Inf,2,4,5) # -Inf +test(6000.4341, frollmax(x, n), c(NA,NA,NA,3,Inf,Inf,Inf,5)) +test(6000.4342, frollmax(x, n, na.rm=TRUE), c(NA,NA,2,3,Inf,Inf,Inf,5)) +test(6000.4343, frollmax(x, n, algo="exact"), c(NA,NA,NA,3,Inf,Inf,Inf,5)) +test(6000.4344, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA,2,3,Inf,Inf,Inf,5)) +test(6000.4351, frollmax(x, n, has.nf=FALSE), c(NA,NA,2,3,Inf,Inf,Inf,5)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.4352, frollmax(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4353, frollmax(x, n, algo="exact", has.nf=FALSE), c(NA,NA,2,3,Inf,Inf,Inf,5)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.4354, frollmax(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.4361, frollmax(x, n, has.nf=TRUE), c(NA,NA,NA,3,Inf,Inf,Inf,5)) +test(6000.4362, frollmax(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA,2,3,Inf,Inf,Inf,5)) +test(6000.4363, frollmax(x, n, algo="exact", has.nf=TRUE), c(NA,NA,NA,3,Inf,Inf,Inf,5)) +test(6000.4364, frollmax(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA,2,3,Inf,Inf,Inf,5)) +# edge cases +test(6000.501, frollmax(c(5,NA,1), 1L), c(5,NA,1)) ## na.rm=FALSE window recalc and NA happens to be the first element in a nested loop ## didn't help for codecov, adding internal error to wmax till we have a data that can reach there +test(6000.502, frollmax(c(5,NaN,1), 1L), c(5,NaN,1)) +test(6000.503, frollmax(c(5,1,1,NaN,1,1,1), 2L), c(NA,5,1,NaN,NaN,1,1)) +test(6000.504, frollmax(c(5,1,NA,NaN,1,1,1), 2L), c(NA,5,NA,NA,NaN,1,1)) + +# n==NA, n<0 +test(6000.550, frollmean(1:3, NA), error="'n' must be an integer") +test(6000.551, frollmean(1:3, NA_integer_), error="'n' must be non-negative integer values (>= 0)") +test(6000.552, frollmean(1:3, NA, algo="exact"), error="'n' must be an integer") +test(6000.553, frollmean(1:3, NA_integer_, algo="exact"), error="'n' must be non-negative integer values (>= 0)") +test(6000.554, frollmean(adaptive=TRUE, 1:3, c(2,NA,2)), error="'n' must be non-negative integer values (>= 0)") +test(6000.555, frollmean(adaptive=TRUE, 1:3, c(2,NA,2), algo="exact"), error="'n' must be non-negative integer values (>= 0)") +test(6000.556, frollapply(FUN=mean, 1:3, NA), error="'N' must be an integer") +test(6000.557, frollapply(FUN=mean, 1:3, NA_integer_), error="'N' must be non-negative integer values (>= 0)") +test(6000.558, frollapply(FUN=mean, adaptive=TRUE, 1:3, c(2,NA,2)), error="'N' must be non-negative integer values (>= 0)") +test(6000.559, frollapply(FUN=mean, adaptive=TRUE, 1:3, list(c(2,NA,2))), error="'N' must be non-negative integer values (>= 0)") +test(6000.560, frollmean(1:3, -1), error="'n' must be non-negative integer values (>= 0)") +test(6000.561, frollmean(1:3, -1, algo="exact"), error="'n' must be non-negative integer values (>= 0)") +test(6000.562, frollapply(FUN=mean, 1:3, -1), error="'N' must be non-negative integer values (>= 0)") +test(6000.563, frollapply(FUN=mean, 1:3, c(0,-1,1), adaptive=TRUE), error="'N' must be non-negative integer values (>= 0)") +test(6000.564, frollapply(FUN=mean, 1:3, list(c(0,-1,1)), adaptive=TRUE), error="'N' must be non-negative integer values (>= 0)") + +## frollmin adaptive +options(datatable.verbose=TRUE) ## adaptive frollmin no fast algo +test(6000.6, frollmin(1:4, c(2,2,2,2), adaptive=TRUE), output="frolladaptivefun: algo 0 not implemented, fall back to 1") +test(6000.6001, frollmin(1:4, c(2,2,2,2), algo="fast", adaptive=TRUE), output="frolladaptivefun: algo 0 not implemented, fall back to 1") +test(6000.6002, frollmin(1:4, c(2,2,2,2), algo="exact", adaptive=TRUE), notOutput="frolladaptivefun: algo 0 not implemented, fall back to 1") +options(datatable.verbose=FALSE) +n = c(3,2,2,4,2,1,4,8) +x = c(7,2,3,6,3,2,6,6) # no NA +test(6000.6111, frollmin(x, n, adaptive=TRUE), c(NA,2,2,2,3,2,2,2)) # has.nf=NA # narm=F +test(6000.6112, frollmin(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,2,2,2,3,2,2,2)) # narm=T +test(6000.6121, frollmin(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,2,2,2,3,2,2,2)) # has.nf=F +test(6000.6122, frollmin(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.6131, frollmin(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,2,2,2,3,2,2,2)) # has.nf=T +test(6000.6132, frollmin(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,2,2,2,3,2,2,2)) +x = c(7,2,NA,6,3,NA,6,6) # NA +test(6000.6211, frollmin(x, n, adaptive=TRUE), c(NA,2,NA,NA,3,NA,NA,NA)) +test(6000.6212, frollmin(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,2,2,2,3,Inf,3,2)) +test(6000.6221, frollmin(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,2,2,2,3,Inf,3,2)) +test(6000.6222, frollmin(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.6231, frollmin(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,2,NA,NA,3,NA,NA,NA)) +test(6000.6232, frollmin(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,2,2,2,3,Inf,3,2)) +x = rep(NA_real_, 8) # all NA +test(6000.6241, frollmin(x, n, adaptive=TRUE), rep(NA_real_, 8)) +test(6000.6242, frollmin(x, n, na.rm=TRUE, adaptive=TRUE), c(NA, rep(Inf, 7))) +test(6000.6251, frollmin(x, n, has.nf=FALSE, adaptive=TRUE), c(NA, rep(Inf, 7))) +test(6000.6252, frollmin(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.6261, frollmin(x, n, has.nf=TRUE, adaptive=TRUE), rep(NA_real_, 8)) +test(6000.6262, frollmin(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA, rep(Inf, 7))) +x = c(NA,NaN,NA,NaN,NaN,NaN,NA,NA) # all NaN/NA +test(6000.6271, frollmin(x, n, adaptive=TRUE), c(NA,NA,NA,NA,NaN,NaN,NA,NA)) +test(6000.6272, frollmin(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,Inf,Inf,Inf,Inf,Inf,Inf,Inf)) +test(6000.6281, frollmin(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,Inf,Inf,Inf,Inf,Inf,Inf,Inf)) +test(6000.6282, frollmin(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.6291, frollmin(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,NA,NA,NA,NaN,NaN,NA,NA)) +test(6000.6292, frollmin(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,Inf,Inf,Inf,Inf,Inf,Inf,Inf)) +x = c(7,2,NA,6,3,Inf,6,6) # Inf +test(6000.6311, frollmin(x, n, adaptive=TRUE), c(NA,2,NA,NA,3,Inf,3,NA)) +test(6000.6312, frollmin(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,2,2,2,3,Inf,3,2)) +test(6000.6321, frollmin(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,2,2,2,3,Inf,3,2)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.6322, frollmin(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.6331, frollmin(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,2,NA,NA,3,Inf,3,NA)) +test(6000.6332, frollmin(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,2,2,2,3,Inf,3,2)) +x = c(7,2,-Inf,6,3,NA,6,6) # -Inf +test(6000.6341, frollmin(x, n, adaptive=TRUE), c(NA,2,-Inf,-Inf,3,NA,NA,NA)) +test(6000.6342, frollmin(x, n, na.rm=TRUE, adaptive=TRUE), c(NA,2,-Inf,-Inf,3,Inf,3,-Inf)) +test(6000.6351, frollmin(x, n, has.nf=FALSE, adaptive=TRUE), c(NA,2,-Inf,-Inf,3,Inf,3,-Inf)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.6352, frollmin(x, n, has.nf=FALSE, na.rm=TRUE, adaptive=TRUE), error="does not make sense") +test(6000.6361, frollmin(x, n, has.nf=TRUE, adaptive=TRUE), c(NA,2,-Inf,-Inf,3,NA,NA,NA)) +test(6000.6362, frollmin(x, n, has.nf=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,2,-Inf,-Inf,3,Inf,3,-Inf)) + +## frollmin non-adaptive +options(datatable.verbose=TRUE) +test(6000.7001, frollmin(1:3, 2), c(NA, 1, 2), output="frollminFast: running for input length") +test(6000.7002, frollmin(1:10, 5), c(NA,NA,NA,NA,1,2,3,4,5,6), output="frollminFast: nested window min calculation called 5 times") ## max: 0 +test(6000.7003, frollmin(10:1, 5), c(NA,NA,NA,NA,6,5,4,3,2,1), output="frollminFast: nested window min calculation called 0 times") ## max: 5 +test(6000.7004, frollmin(1:3, 2, algo="exact"), c(NA, 1, 2), output="frollminExact: running in parallel for input length") +test(6000.7005, frollmin(c(1,2,3,NA,5), 2), c(NA, 1, 2, NA, NA), output="continue with extra care for NFs") +options(datatable.verbose=FALSE) +n = 3 +x = c(7,2,3,6,3,2,4,5) # no NA +ans = c(NA,NA,2,2,3,2,2,2) +test(6000.7111, frollmin(x, n), ans) # has.nf=NA # narm=F +test(6000.7112, frollmin(x, n, na.rm=TRUE), ans) # narm=T +test(6000.7113, frollmin(x, n, algo="exact"), ans) # has.nf=NA # narm=F +test(6000.7114, frollmin(x, n, algo="exact", na.rm=TRUE), ans) # narm=T +test(6000.7121, frollmin(x, n, has.nf=FALSE), ans) # has.nf=F +test(6000.7122, frollmin(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7123, frollmin(x, n, algo="exact", has.nf=FALSE), ans) # has.nf=F +test(6000.7124, frollmin(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7131, frollmin(x, n, has.nf=TRUE), ans) # has.nf=T +test(6000.7132, frollmin(x, n, has.nf=TRUE, na.rm=TRUE), ans) +test(6000.7133, frollmin(x, n, algo="exact", has.nf=TRUE), ans) # has.nf=T +test(6000.7134, frollmin(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), ans) +x = c(7,2,3,NA,3,2,4,NA) # NA +test(6000.7211, frollmin(x, n), c(NA,NA,2,NA,NA,NA,2,NA)) +test(6000.7212, frollmin(x, n, na.rm=TRUE), c(NA,NA,2,2,3,2,2,2)) +test(6000.7213, frollmin(x, n, algo="exact"), c(NA,NA,2,NA,NA,NA,2,NA)) +test(6000.7214, frollmin(x, n, algo="exact", na.rm=TRUE), c(NA,NA,2,2,3,2,2,2)) +test(6000.7221, frollmin(x, n, has.nf=FALSE), c(NA,NA,2,2,3,2,2,2)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.7222, frollmin(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7223, frollmin(x, n, algo="exact", has.nf=FALSE), c(NA,NA,2,2,3,2,2,2)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.7224, frollmin(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7231, frollmin(x, n, has.nf=TRUE), c(NA,NA,2,NA,NA,NA,2,NA)) +test(6000.7232, frollmin(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA,2,2,3,2,2,2)) +test(6000.7233, frollmin(x, n, algo="exact", has.nf=TRUE), c(NA,NA,2,NA,NA,NA,2,NA)) +test(6000.7234, frollmin(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA,2,2,3,2,2,2)) +x = rep(NA_real_, 8) # all NA +test(6000.7241, frollmin(x, n), rep(NA_real_, 8)) +test(6000.7242, frollmin(x, n, na.rm=TRUE), c(NA,NA, rep(Inf, 6))) +test(6000.7243, frollmin(x, n, algo="exact"), rep(NA_real_, 8)) +test(6000.7244, frollmin(x, n, algo="exact", na.rm=TRUE), c(NA,NA, rep(Inf, 6))) +test(6000.7251, frollmin(x, n, has.nf=FALSE), c(NA,NA, rep(Inf, 6))) +test(6000.7252, frollmin(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7253, frollmin(x, n, algo="exact", has.nf=FALSE), c(NA,NA, rep(Inf, 6))) +test(6000.7254, frollmin(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7261, frollmin(x, n, has.nf=TRUE), rep(NA_real_, 8)) +test(6000.7262, frollmin(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA, rep(Inf, 6))) +test(6000.7263, frollmin(x, n, algo="exact", has.nf=TRUE), rep(NA_real_, 8)) +test(6000.7264, frollmin(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA, rep(Inf, 6))) +x = c(NA,NaN,NA,NaN,NaN,NaN,NA,NA) # all NaN/NA +test(6000.7271, frollmin(x, n), c(NA,NA,NA,NA,NA,NaN,NA,NA)) +test(6000.7272, frollmin(x, n, na.rm=TRUE), c(NA,NA,Inf,Inf,Inf,Inf,Inf,Inf)) +test(6000.7273, frollmin(x, n, algo="exact"), c(NA,NA,NA,NA,NA,NaN,NA,NA)) +test(6000.7274, frollmin(x, n, algo="exact", na.rm=TRUE), c(NA,NA,Inf,Inf,Inf,Inf,Inf,Inf)) +test(6000.7281, frollmin(x, n, has.nf=FALSE), c(NA,NA,Inf,Inf,Inf,Inf,Inf,Inf)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.7282, frollmin(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7283, frollmin(x, n, algo="exact", has.nf=FALSE), c(NA,NA,Inf,Inf,Inf,Inf,Inf,Inf)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.7284, frollmin(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7291, frollmin(x, n, has.nf=TRUE), c(NA,NA,NA,NA,NA,NaN,NA,NA)) +test(6000.7292, frollmin(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA,Inf,Inf,Inf,Inf,Inf,Inf)) +test(6000.7293, frollmin(x, n, algo="exact", has.nf=TRUE), c(NA,NA,NA,NA,NA,NaN,NA,NA)) +test(6000.7294, frollmin(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA,Inf,Inf,Inf,Inf,Inf,Inf)) +x = c(NA,2,6,3,Inf,2,4,5) # Inf +test(6000.7311, frollmin(x, n), c(NA,NA,NA,2,3,2,2,2)) +test(6000.7312, frollmin(x, n, na.rm=TRUE), c(NA,NA,2,2,3,2,2,2)) +test(6000.7313, frollmin(x, n, algo="exact"), c(NA,NA,NA,2,3,2,2,2)) +test(6000.7314, frollmin(x, n, algo="exact", na.rm=TRUE), c(NA,NA,2,2,3,2,2,2)) +test(6000.7321, frollmin(x, n, has.nf=FALSE), c(NA,NA,2,2,3,2,2,2)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.7322, frollmin(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7323, frollmin(x, n, algo="exact", has.nf=FALSE), c(NA,NA,2,2,3,2,2,2)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.7324, frollmin(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7331, frollmin(x, n, has.nf=TRUE), c(NA,NA,NA,2,3,2,2,2)) +test(6000.7332, frollmin(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA,2,2,3,2,2,2)) +test(6000.7333, frollmin(x, n, algo="exact", has.nf=TRUE), c(NA,NA,NA,2,3,2,2,2)) +test(6000.7334, frollmin(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA,2,2,3,2,2,2)) +x = c(NA,2,-Inf,3,Inf,2,4,5) # -Inf +test(6000.7341, frollmin(x, n), c(NA,NA,NA,-Inf,-Inf,2,2,2)) +test(6000.7342, frollmin(x, n, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,2,2,2)) +test(6000.7343, frollmin(x, n, algo="exact"), c(NA,NA,NA,-Inf,-Inf,2,2,2)) +test(6000.7344, frollmin(x, n, algo="exact", na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,2,2,2)) +test(6000.7351, frollmin(x, n, has.nf=FALSE), c(NA,NA,-Inf,-Inf,-Inf,2,2,2)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.7352, frollmin(x, n, has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7353, frollmin(x, n, algo="exact", has.nf=FALSE), c(NA,NA,-Inf,-Inf,-Inf,2,2,2)) ## expected incorrect results, see manual has.nf section for details, added in #5441 +test(6000.7354, frollmin(x, n, algo="exact", has.nf=FALSE, na.rm=TRUE), error="does not make sense") +test(6000.7361, frollmin(x, n, has.nf=TRUE), c(NA,NA,NA,-Inf,-Inf,2,2,2)) +test(6000.7362, frollmin(x, n, has.nf=TRUE, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,2,2,2)) +test(6000.7363, frollmin(x, n, algo="exact", has.nf=TRUE), c(NA,NA,NA,-Inf,-Inf,2,2,2)) +test(6000.7364, frollmin(x, n, algo="exact", has.nf=TRUE, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,2,2,2)) +# edge cases +test(6000.801, frollmin(c(5,NA,1), 1L), c(5,NA,1)) ## na.rm=FALSE window recalc and NA happens to be the first element in a nested loop ## didn't help for codecov, adding internal error to wmin till we have a data that can reach there +test(6000.802, frollmin(c(5,NaN,1), 1L), c(5,NaN,1)) +test(6000.803, frollmin(c(1,5,5,NaN,5,5,5), 2L), c(NA,1,5,NaN,NaN,5,5)) +test(6000.804, frollmin(c(1,5,NA,NaN,5,5,5), 2L), c(NA,1,NA,NA,NaN,5,5)) + +# frollprod +test(6000.901, frollprod(c(1,1,1), 1), c(1,1,1)) +test(6000.902, frollprod(c(1,1,1), 2), c(NA,1,1)) +test(6000.903, frollprod(c(1,1,1), 2, partial=TRUE), c(1,1,1)) +test(6000.904, frollprod(c(1,1,1), 2, align="left"), c(1,1,NA)) +test(6000.905, frollprod(c(1,1,1), 2, align="left", partial=TRUE), c(1,1,1)) +test(6000.906, frollprod(c(1,1,1), 2, align="center"), c(1,1,NA)) +test(6000.907, frollprod(c(1,1,1,1), 2, align="center"), c(1,1,1,NA)) +test(6000.908, frollprod(1:5, 2, partial=TRUE), c(1,2,6,12,20)) +test(6000.909, frollprod(5:1, 2, partial=TRUE), c(5,20,12,6,2)) +test(6000.910, frollprod(c(Inf,Inf,-Inf), 3), c(NA,NA,-Inf)) +test(6000.911, frollprod(c(Inf,-Inf,-Inf), 3), c(NA,NA,Inf)) +test(6000.912, frollprod(c(-Inf,-Inf), 2), c(NA,Inf)) +test(6000.913, frollprod(c(-Inf,-Inf, -1), 3), c(NA,NA,-Inf)) +test(6000.914, frollprod(1:5, rep(2,5), adaptive=TRUE), c(NA,2,6,12,20)) +test(6000.915, frollprod(1:6/2, 3), c(rep(NA_real_,2), c(0.75, 3, 7.5, 15))) +test(6000.916, frollprod(1:6/2, c(2L, 2L, 3L, 4L, 2L, 3L), adaptive=TRUE), c(NA, 0.5, 0.75, 1.5, 5, 15)) +options(datatable.verbose=TRUE) +test(6000.921, frollprod(1:5, 6), rep(NA_real_, 5L), output="window width longer than input vector") +options(datatable.verbose=FALSE) +test(6000.922, frollprod(c(1:2,NA,4:10), 4, has.nf=FALSE), c(rep(NA_real_, 6), 840, 1680, 3024, 5040), warning="has.nf=FALSE used but non-finite values are present in input, use default has.nf=NA to avoid this warning") +test(6000.923, frollprod(c(1:2,NA,4:10), 2, has.nf=FALSE), c(NA, 2, NA, NA, 20, 30, 42, 56, 72, 90), warning="has.nf=FALSE used but non-finite values are present in input, use default has.nf=NA to avoid this warning") +test(6000.924, frollprod(c(1:2,NA,4:10), 4, has.nf=FALSE, algo="exact"), c(rep(NA_real_, 6), 840, 1680, 3024, 5040), warning="has.nf=FALSE used but non-finite values are present in input, use default has.nf=NA to avoid this warning") +options(datatable.verbose=TRUE) +test(6000.925, frollprod(c(1:2,NA,4:10), 4, algo="exact", na.rm=TRUE), c(NA, NA, NA, 8, 40, 120, 840, 1680, 3024, 5040), output="non-finite values are present in input, re-running with extra care for NFs") +test(6000.926, frollprod(c(1:2,NA,4:10), 4, algo="exact"), c(NA, NA, NA, NA, NA, NA, 840, 1680, 3024, 5040), output="non-finite values are present in input, na.rm=FALSE and algo='exact' propagates NFs properply, no need to re-run") +options(datatable.verbose=FALSE) +test(6000.927, frollprod(c(1:2,NA,4:10), rep(4L,10), adaptive=TRUE, has.nf=FALSE), c(NA, NA, NA, NA, NA, NA, 840, 1680, 3024, 5040), warning="has.nf=FALSE used but non-finite values are present in input, use default has.nf=NA to avoid this warning") +test(6000.928, frollprod(c(1:2,NA,4:10), rep(4L,10), adaptive=TRUE, has.nf=FALSE, algo="exact"), c(NA, NA, NA, NA, NA, NA, 840, 1680, 3024, 5040), warning="has.nf=FALSE used but non-finite values are present in input, use default has.nf=NA to avoid this warning") +options(datatable.verbose=TRUE) +test(6000.929, frollprod(c(1:2,NA,4:10), rep(4L,10), adaptive=TRUE, algo="exact", na.rm=TRUE), c(NA, NA, NA, 8, 40, 120, 840, 1680, 3024, 5040), output="non-finite values are present in input, re-running with extra care for NFs") +test(6000.930, frollprod(c(1:2,NA,4:10), rep(4L,10), adaptive=TRUE, algo="exact"), c(NA, NA, NA, NA, NA, NA, 840, 1680, 3024, 5040), output="non-finite values are present in input, na.rm=FALSE and algo='exact' propagates NFs properply, no need to re-run") +test(6000.931, frollprod(1:3, 2), c(NA, 2, 6), output="frollprodFast: running for input length") +test(6000.932, frollprod(1:3, 2, align="left"), c(2, 6, NA), output="frollfun: align") +test(6000.933, frollprod(c(1,2,NA), 2), c(NA, 2, NA), output="non-finite values are present in input, re-running with extra care for NFs") +test(6000.934, frollprod(c(NA,2,3), 2), c(NA, NA, 6), output="non-finite values are present in input, skip non-finite inaware attempt and run with extra care for NFs straighaway") +test(6000.935, frollprod(1:3, c(2,2,2), adaptive=TRUE), c(NA, 2, 6), output="algo 0 not implemented, fall back to 1") +test(6000.936, frollprod(c(NA,2,3), c(2,2,2), adaptive=TRUE), c(NA, NA, 6), output="non-finite values are present in input, na.rm=FALSE and algo='exact' propagates NFs properply, no need to re-run") +options(datatable.verbose=FALSE) +# floating point overflow +test(6000.941, frollprod(c(1e100, 1e100, 1e100, 1e100, 1e100), 5), c(NA,NA,NA,NA,Inf)) +test(6000.942, frollprod(c(1e100, 1e100, 1e100, 1e100, 1e100), 4), c(NA,NA,NA,Inf,Inf)) +test(6000.943, frollprod(c(1e100, 1e100, 1e100, 1e100, -1e100), 5), c(NA,NA,NA,NA,-Inf)) +test(6000.944, frollprod(c(1e100, 1e100, 1e100, 1e100, -1e100), 4), c(NA,NA,NA,Inf,-Inf)) +test(6000.945, frollprod(c(1e100, 1e100, 1e100, 1e100, 1e100), 5, algo="exact"), c(NA,NA,NA,NA,Inf)) +test(6000.946, frollprod(c(1e100, 1e100, 1e100, 1e100, 1e100), 4, algo="exact"), c(NA,NA,NA,Inf,Inf)) +test(6000.947, frollprod(c(1e100, 1e100, 1e100, 1e100, -1e100), 5, algo="exact"), c(NA,NA,NA,NA,-Inf)) +test(6000.948, frollprod(c(1e100, 1e100, 1e100, 1e100, -1e100), 4, algo="exact"), c(NA,NA,NA,Inf,-Inf)) +test(6000.949, frollprod(c(1e100, 1e100, 1e100, 1e100, 1e100), rep(5, 5), adaptive=TRUE), c(NA,NA,NA,NA,Inf)) +test(6000.950, frollprod(c(1e100, 1e100, 1e100, 1e100, 1e100), rep(4, 5), adaptive=TRUE), c(NA,NA,NA,Inf,Inf)) +test(6000.951, frollprod(c(1e100, 1e100, 1e100, 1e100, -1e100), rep(5, 5), adaptive=TRUE), c(NA,NA,NA,NA,-Inf)) +test(6000.952, frollprod(c(1e100, 1e100, 1e100, 1e100, -1e100), rep(4, 5), adaptive=TRUE), c(NA,NA,NA,Inf,-Inf)) +test(6000.953, frollprod(c(1e100, 1e100, 1e100, 1e100, 1e100), rep(5, 5), algo="exact", adaptive=TRUE), c(NA,NA,NA,NA,Inf)) +test(6000.954, frollprod(c(1e100, 1e100, 1e100, 1e100, 1e100), rep(4, 5), algo="exact", adaptive=TRUE), c(NA,NA,NA,Inf,Inf)) +test(6000.955, frollprod(c(1e100, 1e100, 1e100, 1e100, -1e100), rep(5, 5), algo="exact", adaptive=TRUE), c(NA,NA,NA,NA,-Inf)) +test(6000.956, frollprod(c(1e100, 1e100, 1e100, 1e100, -1e100), rep(4, 5), algo="exact", adaptive=TRUE), c(NA,NA,NA,Inf,-Inf)) +# rolling product and numerical stability #7349 +test(6000.9601, frollprod(c(2,2,0,2,2), 2), c(NA,4,0,0,4)) +test(6000.9602, frollprod(c(2,2,0,-2,2), 2), c(NA,4,0,0,-4)) +test(6000.9603, frollprod(c(2,2,0,-2,-2), 2), c(NA,4,0,0,4)) +test(6000.9604, frollprod(c(2,2,0,Inf,2), 2), c(NA,4,0,NaN,Inf)) +test(6000.9605, frollprod(c(2,2,0,-Inf,2), 2), c(NA,4,0,NaN,-Inf)) +test(6000.9606, frollprod(c(2,2,0,-Inf,-2), 2), c(NA,4,0,NaN,Inf)) +test(6000.9607, frollprod(c(0,2,2,2,2), 2), c(NA,0,4,4,4)) +test(6000.9608, frollprod(c(2,0,2,2,2), 2), c(NA,0,0,4,4)) + +# n==0, k==0, k[i]==0 +test(6001.111, frollmean(1:3, 0), c(NaN,NaN,NaN), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.112, frollmean(1:3, 0, fill=99), c(NaN,NaN,NaN)) +test(6001.113, frollmean(c(1:2,NA), 0), c(NaN,NaN,NaN)) +test(6001.114, frollmean(c(1:2,NA), 0, na.rm=TRUE), c(NaN,NaN,NaN)) +test(6001.115, frollmean(1:3, 0, algo="exact"), c(NaN,NaN,NaN), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.116, frollmean(c(1:2,NA), 0, algo="exact"), c(NaN,NaN,NaN)) +test(6001.117, frollmean(c(1:2,NA), 0, algo="exact", na.rm=TRUE), c(NaN,NaN,NaN)) +test(6001.121, frollmean(adaptive=TRUE, 1:3, c(2,0,2)), c(NA,NaN,2.5)) +test(6001.122, frollmean(adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NaN,2.5)) +test(6001.123, frollmean(adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,NaN,NA)) +test(6001.124, frollmean(adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,NaN,2)) +test(6001.125, frollmean(adaptive=TRUE, 1:3, c(2,0,2), algo="exact"), c(NA,NaN,2.5)) +test(6001.126, frollmean(adaptive=TRUE, 1:3, c(2,0,2), fill=99, algo="exact"), c(99,NaN,2.5)) +test(6001.127, frollmean(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact"), c(NA,NaN,NA)) +test(6001.128, frollmean(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE), c(NA,NaN,2)) +test(6001.129, frollmean(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE, partial=TRUE), c(1,NaN,2)) +test(6001.130, frollmean(adaptive=TRUE, c(1:2,NA), c(2,0,2), fill=99, algo="exact", na.rm=TRUE), c(99,NaN,2)) +test(6001.181, frollapply(FUN=mean, 1:3, 0), c(NaN,NaN,NaN)) +test(6001.182, frollapply(FUN=mean, 1:3, 0, fill=99), c(NaN,NaN,NaN)) +test(6001.183, frollapply(FUN=mean, c(1:2,NA), 0), c(NaN,NaN,NaN)) +test(6001.184, frollapply(FUN=mean, c(1:2,NA), 0, na.rm=TRUE), c(NaN,NaN,NaN)) +test(6001.185, frollapply(FUN=mean, c(FALSE, TRUE, TRUE), 0), c(NaN,NaN,NaN)) +test(6001.1910, frollapply(FUN=mean, adaptive=TRUE, 1:3, c(2,0,2)), c(NA,NaN,2.5)) +test(6001.1911, frollapply(FUN=mean, adaptive=TRUE, list(1:3,2:4), c(2,0,2)), list(c(NA, NaN, 2.5), c(NA, NaN, 3.5))) +test(6001.1912, frollapply(FUN=mean, adaptive=TRUE, 1:3, list(c(2,0,2), c(0,2,0))), list(c(NA,NaN,2.5), c(NaN,1.5,NaN))) +test(6001.1913, frollapply(FUN=mean, adaptive=TRUE, list(1:3,2:4), list(c(2,0,2), c(0,2,0))), list(c(NA,NaN,2.5), c(NaN,1.5,NaN), c(NA,NaN,3.5), c(NaN,2.5,NaN))) +test(6001.1915, frollapply(FUN=mean, adaptive=TRUE, c(FALSE, TRUE, TRUE), c(2,0,2)), c(NA,NaN,1)) +test(6001.192, frollapply(FUN=mean, adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NaN,2.5)) +test(6001.193, frollapply(FUN=mean, adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,NaN,NA)) +test(6001.194, frollapply(FUN=mean, adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,NaN,2)) +test(6001.195, frollapply(FUN=mean, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE, partial=TRUE), c(1,NaN,2)) +test(6001.196, frollapply(FUN=mean, adaptive=TRUE, c(FALSE, TRUE, TRUE), c(2,0,2), fill=99), c(99,NaN,1)) + +test(6001.211, frollsum(1:3, 0), c(0,0,0), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.212, frollsum(1:3, 0, fill=99), c(0,0,0)) +test(6001.213, frollsum(c(1:2,NA), 0), c(0,0,0)) +test(6001.214, frollsum(c(1:2,NA), 0, na.rm=TRUE), c(0,0,0)) +test(6001.215, frollsum(1:3, 0, algo="exact"), c(0,0,0), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.216, frollsum(c(1:2,NA), 0, algo="exact"), c(0,0,0)) +test(6001.217, frollsum(c(1:2,NA), 0, algo="exact", na.rm=TRUE), c(0,0,0)) +test(6001.221, frollsum(adaptive=TRUE, 1:3, c(2,0,2)), c(NA,0,5)) +test(6001.222, frollsum(adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,0,5)) +test(6001.223, frollsum(adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,0,NA)) +test(6001.224, frollsum(adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,0,2)) +test(6001.225, frollsum(adaptive=TRUE, 1:3, c(2,0,2), algo="exact"), c(NA,0,5)) +test(6001.226, frollsum(adaptive=TRUE, 1:3, c(2,0,2), fill=99, algo="exact"), c(99,0,5)) +test(6001.227, frollsum(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact"), c(NA,0,NA)) +test(6001.228, frollsum(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE), c(NA,0,2)) +test(6001.229, frollsum(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE, partial=TRUE), c(1,0,2)) +test(6001.230, frollsum(adaptive=TRUE, c(1:2,NA), c(2,0,2), fill=99, algo="exact", na.rm=TRUE), c(99,0,2)) +test(6001.281, frollapply(FUN=sum, as.numeric(1:3), 0), c(0,0,0)) +test(6001.282, frollapply(FUN=sum, as.numeric(1:3), 0, fill=99), c(0,0,0)) +test(6001.283, frollapply(FUN=sum, c(1:2,NA_real_), 0), c(0,0,0)) +test(6001.284, frollapply(FUN=sum, c(1:2,NA_real_), 0, na.rm=TRUE), c(0,0,0)) +test(6001.285, frollapply(FUN=sum, c(FALSE, TRUE, TRUE), 0), c(0L,0L,0L)) +test(6001.286, frollapply(FUN=sum, 1:3, 0), c(0L,0L,0L)) +test(6001.2910, frollapply(FUN=sum, adaptive=TRUE, as.numeric(1:3), c(2,0,2)), c(NA,0,5)) +test(6001.2911, frollapply(FUN=sum, adaptive=TRUE, list(as.numeric(1:3), as.numeric(2:4)), c(2,0,2)), list(c(NA,0,5), c(NA,0,7))) +test(6001.2912, frollapply(FUN=sum, adaptive=TRUE, as.numeric(1:3), list(c(2,0,2), c(0,2,0))), list(c(NA,0,5), c(0,3,0))) +test(6001.2913, frollapply(FUN=sum, adaptive=TRUE, list(as.numeric(1:3), as.numeric(2:4)), list(c(2,0,2), c(0,2,0))), list(c(NA,0,5), c(0,3,0), c(NA,0,7), c(0,5,0))) +test(6001.2914, frollapply(FUN=sum, adaptive=TRUE, c(FALSE, TRUE, TRUE), c(2,0,2)), c(NA,0L,2L)) +test(6001.2915, frollapply(FUN=sum, adaptive=TRUE, 1:3, c(2,0,2)), c(NA,0L,5L)) +test(6001.292, frollapply(FUN=sum, adaptive=TRUE, as.numeric(1:3), c(2,0,2), fill=99), c(99,0,5)) +test(6001.293, frollapply(FUN=sum, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2)), c(NA,0,NA)) +test(6001.294, frollapply(FUN=sum, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE), c(NA,0,2)) +test(6001.295, frollapply(FUN=sum, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE, partial=TRUE), c(1,0,2)) +test(6001.296, frollapply(FUN=sum, adaptive=TRUE, c(FALSE, TRUE, TRUE), c(2,0,2), fill=1L), c(1L,0L,2L)) +test(6001.297, frollapply(FUN=sum, adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99L,0L,5L)) + +test(6001.311, frollmax(1:3, 0), c(-Inf,-Inf,-Inf), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.312, frollmax(1:3, 0, fill=99), c(-Inf,-Inf,-Inf)) +test(6001.313, frollmax(c(1:2,NA), 0), c(-Inf,-Inf,-Inf)) +test(6001.314, frollmax(c(1:2,NA), 0, na.rm=TRUE), c(-Inf,-Inf,-Inf)) +test(6001.315, frollmax(1:3, 0, algo="exact"), c(-Inf,-Inf,-Inf), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.316, frollmax(c(1:2,NA), 0, algo="exact"), c(-Inf,-Inf,-Inf)) +test(6001.317, frollmax(c(1:2,NA), 0, algo="exact", na.rm=TRUE), c(-Inf,-Inf,-Inf)) +test(6001.321, frollmax(adaptive=TRUE, 1:3, c(2,0,2)), c(NA,-Inf,3)) +test(6001.322, frollmax(adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,-Inf,3)) +test(6001.323, frollmax(adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,-Inf,NA)) +test(6001.324, frollmax(adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,-Inf,2)) +test(6001.325, frollmax(adaptive=TRUE, 1:3, c(2,0,2), algo="exact"), c(NA,-Inf,3)) +test(6001.326, frollmax(adaptive=TRUE, 1:3, c(2,0,2), fill=99, algo="exact"), c(99,-Inf,3)) +test(6001.327, frollmax(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact"), c(NA,-Inf,NA)) +test(6001.328, frollmax(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE), c(NA,-Inf,2)) +test(6001.329, frollmax(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE, partial=TRUE), c(1,-Inf,2)) +test(6001.330, frollmax(adaptive=TRUE, c(1:2,NA), c(2,0,2), fill=99, algo="exact", na.rm=TRUE), c(99,-Inf,2)) +test(6001.381, frollapply(FUN=max, 1:3, 0), c(-Inf,-Inf,-Inf)) +test(6001.382, frollapply(FUN=max, 1:3, 0, fill=99), c(-Inf,-Inf,-Inf)) +test(6001.383, frollapply(FUN=max, c(1:2,NA_real_), 0), c(-Inf,-Inf,-Inf)) +test(6001.384, frollapply(FUN=max, c(1:2,NA_real_), 0, na.rm=TRUE), c(-Inf,-Inf,-Inf)) +test(6001.3910, frollapply(FUN=max, adaptive=TRUE, as.numeric(1:3), c(2,0,2)), c(NA,-Inf,3)) +test(6001.3911, frollapply(FUN=max, adaptive=TRUE, list(as.numeric(1:3), as.numeric(2:4)), c(2,0,2)), list(c(NA,-Inf,3), c(NA,-Inf,4))) +test(6001.3912, frollapply(FUN=max, adaptive=TRUE, as.numeric(1:3), list(c(2,0,2), c(0,2,0))), list(c(NA,-Inf,3), c(-Inf,2,-Inf))) +test(6001.3913, frollapply(FUN=max, adaptive=TRUE, list(as.numeric(1:3), as.numeric(2:4)), list(c(2,0,2), c(0,2,0))), list(c(NA,-Inf,3), c(-Inf,2,-Inf), c(NA,-Inf,4), c(-Inf,3,-Inf))) +test(6001.392, frollapply(FUN=max, adaptive=TRUE, as.numeric(1:3), c(2,0,2), fill=99), c(99,-Inf,3)) +test(6001.393, frollapply(FUN=max, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2)), c(NA,-Inf,NA)) +test(6001.394, frollapply(FUN=max, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE), c(NA,-Inf,2)) +test(6001.395, frollapply(FUN=max, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE, partial=TRUE), c(1,-Inf,2)) + +test(6001.411, frollmin(1:3, 0), c(Inf,Inf,Inf), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.412, frollmin(1:3, 0, fill=99), c(Inf,Inf,Inf)) +test(6001.413, frollmin(c(1:2,NA), 0), c(Inf,Inf,Inf)) +test(6001.414, frollmin(c(1:2,NA), 0, na.rm=TRUE), c(Inf,Inf,Inf)) +test(6001.415, frollmin(1:3, 0, algo="exact"), c(Inf,Inf,Inf), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.416, frollmin(c(1:2,NA), 0, algo="exact"), c(Inf,Inf,Inf)) +test(6001.417, frollmin(c(1:2,NA), 0, algo="exact", na.rm=TRUE), c(Inf,Inf,Inf)) +test(6001.421, frollmin(adaptive=TRUE, 1:3, c(2,0,2)), c(NA,Inf,2)) +test(6001.422, frollmin(adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,Inf,2)) +test(6001.423, frollmin(adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,Inf,NA)) +test(6001.424, frollmin(adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,Inf,2)) +test(6001.425, frollmin(adaptive=TRUE, 1:3, c(2,0,2), algo="exact"), c(NA,Inf,2)) +test(6001.426, frollmin(adaptive=TRUE, 1:3, c(2,0,2), fill=99, algo="exact"), c(99,Inf,2)) +test(6001.427, frollmin(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact"), c(NA,Inf,NA)) +test(6001.428, frollmin(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE), c(NA,Inf,2)) +test(6001.429, frollmin(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE, partial=TRUE), c(1,Inf,2)) +test(6001.430, frollmin(adaptive=TRUE, c(1:2,NA), c(2,0,2), fill=99, algo="exact", na.rm=TRUE), c(99,Inf,2)) +test(6001.481, frollapply(FUN=min, 1:3, 0), c(Inf,Inf,Inf)) +test(6001.482, frollapply(FUN=min, 1:3, 0, fill=99), c(Inf,Inf,Inf)) +test(6001.483, frollapply(FUN=min, c(1:2,NA_real_), 0), c(Inf,Inf,Inf)) +test(6001.484, frollapply(FUN=min, c(1:2,NA_real_), 0, na.rm=TRUE), c(Inf,Inf,Inf)) +test(6001.4910, frollapply(FUN=min, adaptive=TRUE, as.numeric(1:3), c(2,0,2)), c(NA,Inf,2)) +test(6001.4911, frollapply(FUN=min, adaptive=TRUE, list(as.numeric(1:3), as.numeric(2:4)), c(2,0,2)), list(c(NA,Inf,2), c(NA,Inf,3))) +test(6001.4912, frollapply(FUN=min, adaptive=TRUE, as.numeric(1:3), list(c(2,0,2), c(0,2,0))), list(c(NA,Inf,2), c(Inf,1,Inf))) +test(6001.4913, frollapply(FUN=min, adaptive=TRUE, list(as.numeric(1:3), as.numeric(2:4)), list(c(2,0,2), c(0,2,0))), list(c(NA,Inf,2), c(Inf,1,Inf), c(NA,Inf,3), c(Inf,2,Inf))) +test(6001.492, frollapply(FUN=min, adaptive=TRUE, as.numeric(1:3), c(2,0,2), fill=99), c(99,Inf,2)) +test(6001.493, frollapply(FUN=min, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2)), c(NA,Inf,NA)) +test(6001.494, frollapply(FUN=min, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE), c(NA,Inf,2)) +test(6001.495, frollapply(FUN=min, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE, partial=TRUE), c(1,Inf,2)) + +test(6001.511, frollprod(1:3, 0), c(1,1,1), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.512, frollprod(1:3, 0, fill=99), c(1,1,1)) +test(6001.513, frollprod(c(1:2,NA), 0), c(1,1,1)) +test(6001.514, frollprod(c(1:2,NA), 0, na.rm=TRUE), c(1,1,1)) +test(6001.515, frollprod(1:3, 0, algo="exact"), c(1,1,1), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.516, frollprod(c(1:2,NA), 0, algo="exact"), c(1,1,1)) +test(6001.517, frollprod(c(1:2,NA), 0, algo="exact", na.rm=TRUE), c(1,1,1)) +test(6001.521, frollprod(adaptive=TRUE, 1:3, c(2,0,2)), c(NA,1,6)) +test(6001.522, frollprod(adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,1,6)) +test(6001.523, frollprod(adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,1,NA)) +test(6001.524, frollprod(adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,1,2)) +test(6001.525, frollprod(adaptive=TRUE, 1:3, c(2,0,2), algo="exact"), c(NA,1,6)) +test(6001.526, frollprod(adaptive=TRUE, 1:3, c(2,0,2), fill=99, algo="exact"), c(99,1,6)) +test(6001.527, frollprod(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact"), c(NA,1,NA)) +test(6001.528, frollprod(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE), c(NA,1,2)) +test(6001.529, frollprod(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE, partial=TRUE), c(1,1,2)) +test(6001.530, frollprod(adaptive=TRUE, c(1:2,NA), c(2,0,2), fill=99, algo="exact", na.rm=TRUE), c(99,1,2)) +test(6001.581, frollapply(FUN=prod, 1:3, 0), c(1,1,1)) +test(6001.582, frollapply(FUN=prod, 1:3, 0, fill=99), c(1,1,1)) +test(6001.583, frollapply(FUN=prod, c(1:2,NA), 0), c(1,1,1)) +test(6001.584, frollapply(FUN=prod, c(1:2,NA), 0, na.rm=TRUE), c(1,1,1)) +test(6001.5910, frollapply(FUN=prod, adaptive=TRUE, 1:3, c(2,0,2)), c(NA,1,6)) +test(6001.5911, frollapply(FUN=prod, adaptive=TRUE, list(1:3,2:4), c(2,0,2)), list(c(NA,1,6), c(NA,1,12))) +test(6001.5912, frollapply(FUN=prod, adaptive=TRUE, 1:3, list(c(2,0,2), c(0,2,0))), list(c(NA,1,6), c(1,2,1))) +test(6001.5913, frollapply(FUN=prod, adaptive=TRUE, list(1:3,2:4), list(c(2,0,2), c(0,2,0))), list(c(NA,1,6), c(1,2,1), c(NA,1,12), c(1,6,1))) +test(6001.592, frollapply(FUN=prod, adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,1,6)) +test(6001.593, frollapply(FUN=prod, adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,1,NA)) +test(6001.594, frollapply(FUN=prod, adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,1,2)) +test(6001.595, frollapply(FUN=prod, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE, partial=TRUE), c(1,1,2)) + +test(6001.611, frollmedian(1:3, 0), c(NA_real_,NA_real_,NA_real_), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.612, frollmedian(1:3, 0, fill=99), c(NA_real_,NA_real_,NA_real_)) +test(6001.613, frollmedian(c(1:2,NA), 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.614, frollmedian(c(1:2,NA), 0, na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.615, frollmedian(1:3, 0, algo="exact"), c(NA_real_,NA_real_,NA_real_), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.616, frollmedian(c(1:2,NA), 0, algo="exact"), c(NA_real_,NA_real_,NA_real_)) +test(6001.617, frollmedian(c(1:2,NA), 0, algo="exact", na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.621, frollmedian(adaptive=TRUE, 1:3, c(2,0,2)), c(NA,NA_real_,2.5)) +test(6001.6211, frollmedian(adaptive=TRUE, 1:3, c(2,0,2), has.nf=TRUE), c(NA,NA_real_,2.5), options=c("datatable.verbose"=TRUE), output="no NAs detected, redirecting to itself using") +test(6001.6212, frollmedian(adaptive=TRUE, 1:3, c(0,0,0)), c(NA_real_,NA_real_,NA_real_), options=c("datatable.verbose"=TRUE), output="adaptive window width of size 0") +test(6001.622, frollmedian(adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NA_real_,2.5)) +test(6001.623, frollmedian(adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,NA_real_,NA)) +test(6001.624, frollmedian(adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,NA_real_,2)) +test(6001.625, frollmedian(adaptive=TRUE, 1:3, c(2,0,2), algo="exact"), c(NA,NA_real_,2.5)) +test(6001.626, frollmedian(adaptive=TRUE, 1:3, c(2,0,2), fill=99, algo="exact"), c(99,NA_real_,2.5)) +test(6001.627, frollmedian(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact"), c(NA,NA_real_,NA)) +test(6001.628, frollmedian(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE), c(NA,NA_real_,2)) +test(6001.629, frollmedian(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE, partial=TRUE), c(1,NA_real_,2)) +test(6001.630, frollmedian(adaptive=TRUE, c(1:2,NA), c(2,0,2), fill=99, algo="exact", na.rm=TRUE), c(99,NA_real_,2)) +test(6001.681, frollapply(FUN=median, c(1,2,3), 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.6811, frollapply(FUN=median, 1:3, 0), c(NA_integer_,NA_integer_,NA_integer_)) +test(6001.682, frollapply(FUN=median, c(1,2,3), 0, fill=99), c(NA_real_,NA_real_,NA_real_)) +test(6001.683, frollapply(FUN=median, c(1,2,NA), 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.684, frollapply(FUN=median, c(1,2,NA), 0, na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.6910, frollapply(FUN=median, adaptive=TRUE, c(1,2,3), c(2,0,2)), c(NA,NA_real_,2.5)) +test(6001.6911, frollapply(FUN=median, adaptive=TRUE, list(c(1,2,3),c(2,3,4)), c(2,0,2)), list(c(NA, NA_real_, 2.5), c(NA, NA_real_, 3.5))) +test(6001.6912, frollapply(FUN=median, adaptive=TRUE, c(1,2,3), list(c(2,0,2), c(0,2,0))), list(c(NA,NA_real_,2.5), c(NA_real_,1.5,NA_real_))) +test(6001.6913, frollapply(FUN=median, adaptive=TRUE, list(1:3,2:4), list(c(2,0,2), c(0,2,0))), list(c(NA,NA_real_,2.5), c(NA_real_,1.5,NA_real_), c(NA,NA_real_,3.5), c(NA_real_,2.5,NA_real_))) ## simplifylist +test(6001.692, frollapply(FUN=median, adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NA_real_,2.5)) ## simplifylist +test(6001.6921, frollapply(FUN=median, adaptive=TRUE, c(1L,2L,4L), c(2,0,2), fill=99L), c(99,NA_real_,3)) ## fill coerced to results type +test(6001.6922, frollapply(FUN=median, adaptive=TRUE, c(1L,2L,3L), c(2,0,2), fill=99), c(99,NA_real_,2.5)) ## simplifylist handle non-type stable output for median(1:3) median(1:2) +test(6001.693, frollapply(FUN=median, adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA,NA_integer_,NA)) +test(6001.694, frollapply(FUN=median, adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA,NA_integer_,2L)) +test(6001.695, frollapply(FUN=median, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE, partial=TRUE), c(1,NA_real_,2)) + +test(6001.711, frollvar(1:3, 0), c(NA_real_,NA_real_,NA_real_), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.712, frollvar(1:3, 0, fill=99), c(NA_real_,NA_real_,NA_real_)) +test(6001.713, frollvar(c(1:2,NA), 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.714, frollvar(c(1:2,NA), 0, na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.715, frollvar(1:3, 0, algo="exact"), c(NA_real_,NA_real_,NA_real_), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.716, frollvar(c(1:2,NA), 0, algo="exact"), c(NA_real_,NA_real_,NA_real_)) +test(6001.717, frollvar(c(1:2,NA), 0, algo="exact", na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.718, frollvar(c(1:2,NA), 2), c(NA,0.5,NA), options=c("datatable.verbose"=TRUE), output="redirecting to frollvarExact") +test(6001.721, frollvar(adaptive=TRUE, 1:3, c(2,0,2)), c(NA,NA,0.5), options=c("datatable.verbose"=TRUE), output="not implemented, fall back to") +test(6001.722, frollvar(adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NA,0.5)) +test(6001.723, frollvar(adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA_real_,NA_real_,NA_real_)) +test(6001.724, frollvar(adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.7241, frollvar(adaptive=TRUE, c(1:2,NA), c(2,2,2), has.nf=FALSE), c(NA_real_,0.5,NA_real_), warning="used but non-finite values are present in input") +test(6001.7242, frollvar(adaptive=TRUE, c(1:2,NA), c(2,2,2)), c(NA_real_,0.5,NA_real_), options=c("datatable.verbose"=TRUE), output="propagates NFs properply, no need to re-run") +test(6001.7243, frollvar(adaptive=TRUE, c(1:2,NA), c(2,2,2), na.rm=TRUE), c(NA_real_,0.5,NA_real_), options=c("datatable.verbose"=TRUE), output="re-running with extra care for NFs") +test(6001.725, frollvar(adaptive=TRUE, 1:3, c(2,0,2), algo="exact"), c(NA,NA,0.5)) +test(6001.726, frollvar(adaptive=TRUE, 1:3, c(2,0,2), fill=99, algo="exact"), c(99,NA,0.5)) +test(6001.727, frollvar(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact"), c(NA_real_,NA_real_,NA_real_)) +test(6001.728, frollvar(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.729, frollvar(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE, partial=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.730, frollvar(adaptive=TRUE, c(1:2,NA), c(2,0,2), fill=99, algo="exact", na.rm=TRUE), c(99,NA,NA)) +y = c(1e8+2.980232e-8, 1e8, 1e8, 1e8) # CLAMP0 test +test(6001.731, frollvar(y, 3)[4L], 0) +test(6001.732, frollsd(y, 3)[4L], 0) +test(6001.733, frollvar(y, c(3,3,3,3), adaptive=TRUE)[4L], 0) +test(6001.734, frollsd(y, c(3,3,3,3), adaptive=TRUE)[4L], 0) +test(6001.740, frollvar(c(1.5,2.5,2,NA), c(3,3)), list(c(NA,NA,0.25,NA), c(NA,NA,0.25,NA)), output="running sequentially, because outer parallelism has been used", options=c(datatable.verbose=TRUE)) # ensure no nested parallelism in rolling functions #7352 +test(6001.741, frollsd(c(1.5,2.5,2,NA), c(3,3)), list(c(NA,NA,0.5,NA), c(NA,NA,0.5,NA)), output="running sequentially, because outer parallelism has been used", options=c(datatable.verbose=TRUE)) +test(6001.742, frollvar(c(1.5,2.5,2,1.5), c(3,3)), list(c(NA,NA,0.25,0.25), c(NA,NA,0.25,0.25)), notOutput="running sequentially, because outer parallelism has been used", options=c(datatable.verbose=TRUE)) # no NA - no fallback to exact +test(6001.743, frollsd(c(1.5,2.5,2,1.5), c(3,3)), list(c(NA,NA,0.5,0.5), c(NA,NA,0.5,0.5)), notOutput="running sequentially, because outer parallelism has been used", options=c(datatable.verbose=TRUE)) +test(6001.744, frollvar(c(1.5,2.5,2,NA), 3), c(NA,NA,0.25,NA), notOutput="running sequentially, because outer parallelism has been used", options=c(datatable.verbose=TRUE)) # not vectorized - no outer parallelism +test(6001.745, frollsd(c(1.5,2.5,2,NA), 3), c(NA,NA,0.5,NA), notOutput="running sequentially, because outer parallelism has been used", options=c(datatable.verbose=TRUE)) +test(6001.750, frollvar(c(1.5,2.5,2,1.5), rep(3,4), adaptive=TRUE), c(NA,NA,0.25,0.25), output="sequentially because adaptive=TRUE is already parallelised within each rolling computation", options=c(datatable.verbose=TRUE)) # adaptive also disables outer parallelism +test(6001.781, frollapply(FUN=var, 1:3, 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.782, frollapply(FUN=var, 1:3, 0, fill=99), c(NA_real_,NA_real_,NA_real_)) +test(6001.783, frollapply(FUN=var, c(1:2,NA), 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.784, frollapply(FUN=var, c(1:2,NA), 0, na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.7910, frollapply(FUN=var, adaptive=TRUE, 1:3, c(2,0,2)), c(NA,NA,0.5)) +test(6001.7911, frollapply(FUN=var, adaptive=TRUE, list(1:3,2:4), c(2,0,2)), list(c(NA,NA,0.5), c(NA,NA,0.5))) +test(6001.7912, frollapply(FUN=var, adaptive=TRUE, 1:3, list(c(2,0,2), c(0,2,0))), list(c(NA,NA,0.5), c(NA,0.5,NA))) +test(6001.7913, frollapply(FUN=var, adaptive=TRUE, list(1:3,2:4), list(c(2,0,2), c(0,2,0))), list(c(NA,NA,0.5), c(NA,0.5,NA), c(NA,NA,0.5), c(NA,0.5,NA))) +test(6001.792, frollapply(FUN=var, adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NA,0.5)) +test(6001.793, frollapply(FUN=var, adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA_real_,NA_real_,NA_real_)) +test(6001.794, frollapply(FUN=var, adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.795, frollapply(FUN=var, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE, partial=TRUE), c(NA_real_,NA_real_,NA_real_)) + +test(6001.810, frollsd(1:3, 0), c(NA_real_,NA_real_,NA_real_), options=c("datatable.verbose"=TRUE), output="frollsdFast: calling sqrt(frollvarFast(...))") +test(6001.811, frollsd(1:3, 0), c(NA_real_,NA_real_,NA_real_), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.812, frollsd(1:3, 0, fill=99), c(NA_real_,NA_real_,NA_real_)) +test(6001.813, frollsd(c(1:2,NA), 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.814, frollsd(c(1:2,NA), 0, na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.815, frollsd(1:3, 0, algo="exact"), c(NA_real_,NA_real_,NA_real_), options=c("datatable.verbose"=TRUE), output="window width of size 0") +test(6001.816, frollsd(c(1:2,NA), 0, algo="exact"), c(NA_real_,NA_real_,NA_real_)) +test(6001.817, frollsd(c(1:2,NA), 0, algo="exact", na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.818, frollsd(c(1:2,NA), 2), c(NA,sqrt(0.5),NA), options=c("datatable.verbose"=TRUE), output="redirecting to frollvarExact") +test(6001.8191, frollsd(1:3, 2, fill=99), c(99,sqrt(0.5),sqrt(0.5))) +test(6001.8192, frollsd(1:3, 2, fill=99, algo="exact"), c(99,sqrt(0.5),sqrt(0.5))) +test(6001.8193, frollsd(c(1:2,NA), 2, has.nf=FALSE), c(NA,sqrt(0.5),NA), warning="used but non-finite values are present in input") +test(6001.8194, frollsd(c(NA,2:3), 2, has.nf=FALSE), c(NA,NA,sqrt(0.5)), warning="used but non-finite values are present in input") +test(6001.8195, frollsd(c(NA,2:3), 2), c(NA,NA,sqrt(0.5)), options=c("datatable.verbose"=TRUE), output="skip non-finite inaware attempt and run with extra care") +test(6001.8196, frollsd(c(NA,2:3), 2, has.nf=FALSE, algo="exact"), c(NA,NA,sqrt(0.5)), warning="used but non-finite values are present in input") +test(6001.8197, frollsd(c(NA,2:3), 2, algo="exact", na.rm=TRUE), c(NA,NA,sqrt(0.5)), options=c("datatable.verbose"=TRUE), output="re-running with extra care for NF") +test(6001.8201, frollsd(adaptive=TRUE, 1:3, c(2,2,2)), c(NA,sqrt(0.5),sqrt(0.5)), options=c("datatable.verbose"=TRUE), output="frolladaptivefun: algo 0 not implemented, fall back to 1") +test(6001.8202, frollsd(adaptive=TRUE, 1:3, c(2,2,2)), c(NA,sqrt(0.5),sqrt(0.5)), options=c("datatable.verbose"=TRUE), output="frolladaptivesdExact: calling sqrt(frolladaptivevarExact(...))") +test(6001.821, frollsd(adaptive=TRUE, 1:3, c(2,0,2)), c(NA,NA,sqrt(0.5))) +test(6001.822, frollsd(adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NA,sqrt(0.5))) +test(6001.823, frollsd(adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA_real_,NA_real_,NA_real_)) +test(6001.824, frollsd(adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.825, frollsd(adaptive=TRUE, 1:3, c(2,0,2), algo="exact"), c(NA,NA,sqrt(0.5))) +test(6001.826, frollsd(adaptive=TRUE, 1:3, c(2,0,2), fill=99, algo="exact"), c(99,NA,sqrt(0.5))) +test(6001.827, frollsd(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact"), c(NA_real_,NA_real_,NA_real_)) +test(6001.828, frollsd(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.829, frollsd(adaptive=TRUE, c(1:2,NA), c(2,0,2), algo="exact", na.rm=TRUE, partial=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.830, frollsd(adaptive=TRUE, c(1:2,NA), c(2,0,2), fill=99, algo="exact", na.rm=TRUE), c(99,NA,NA)) +test(6001.881, frollapply(FUN=sd, 1:3, 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.882, frollapply(FUN=sd, 1:3, 0, fill=99), c(NA_real_,NA_real_,NA_real_)) +test(6001.883, frollapply(FUN=sd, c(1:2,NA), 0), c(NA_real_,NA_real_,NA_real_)) +test(6001.884, frollapply(FUN=sd, c(1:2,NA), 0, na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.8910, frollapply(FUN=sd, adaptive=TRUE, 1:3, c(2,0,2)), c(NA,NA,sqrt(0.5))) +test(6001.8911, frollapply(FUN=sd, adaptive=TRUE, list(1:3,2:4), c(2,0,2)), list(c(NA,NA,sqrt(0.5)), c(NA,NA,sqrt(0.5)))) +test(6001.8912, frollapply(FUN=sd, adaptive=TRUE, 1:3, list(c(2,0,2), c(0,2,0))), list(c(NA,NA,sqrt(0.5)), c(NA,sqrt(0.5),NA))) +test(6001.8913, frollapply(FUN=sd, adaptive=TRUE, list(1:3,2:4), list(c(2,0,2), c(0,2,0))), list(c(NA,NA,sqrt(0.5)), c(NA,sqrt(0.5),NA), c(NA,NA,sqrt(0.5)), c(NA,sqrt(0.5),NA))) +test(6001.892, frollapply(FUN=sd, adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NA,sqrt(0.5))) +test(6001.893, frollapply(FUN=sd, adaptive=TRUE, c(1:2,NA), c(2,0,2)), c(NA_real_,NA_real_,NA_real_)) +test(6001.894, frollapply(FUN=sd, adaptive=TRUE, c(1:2,NA), c(2,0,2), na.rm=TRUE), c(NA_real_,NA_real_,NA_real_)) +test(6001.895, frollapply(FUN=sd, adaptive=TRUE, c(1:2,NA_real_), c(2,0,2), na.rm=TRUE, partial=TRUE), c(NA_real_,NA_real_,NA_real_)) + +# frollmedian +rollmedian = function(x, k, na.rm=FALSE) { + ans = rep(NA_real_, length(x)) + for (i in k:length(x)) ans[i] = median(x[(i-k+1L):(i)], na.rm=na.rm) ans +} ## used for dput +options(datatable.verbose=TRUE) +x = c(5, 1, 2, 2.5, 1.5, 4, 4.5, 0.5, 3.5, 3) ## escape for n < 3 +test(6004.001, frollmedian(x, 1), c(5, 1, 2, 2.5, 1.5, 4, 4.5, 0.5, 3.5, 3), output="window width of size 1, skip median and use simple loop") +test(6004.002, frollmedian(x, 2), c(NA, 3, 1.5, 2.25, 2, 2.75, 4.25, 2.5, 2, 3.25), output="window width of size 2, skip median and use simple loop") +x = c(5, 1, NA, 2.5, 1.5, 4, NA, NA, 3.5, 3) +test(6004.003, frollmedian(x, 1), c(5, 1, NA, 2.5, 1.5, 4, NA, NA, 3.5, 3), output="window width of size 1, skip median and use simple loop") +test(6004.004, frollmedian(x, 2), c(NA, 3, NA, NA, 2, 2.75, NA, NA, NA, 3.25), output="window width of size 2, skip median and use simple loop") +test(6004.005, frollmedian(x, 1, na.rm=TRUE), c(5, 1, NA, 2.5, 1.5, 4, NA, NA, 3.5, 3), output="window width of size 1, skip median and use simple loop") +test(6004.006, frollmedian(x, 2, na.rm=TRUE), c(NA, 3, 1, 2.5, 2, 2.75, 4, NA, 3.5, 3.25), output="window width of size 2, skip median and use simple loop") +x = c(5, 1, Inf, 2.5, 1.5, 4, Inf, -Inf, 3.5, 3) +test(6004.007, frollmedian(x, 1), c(5, 1, Inf, 2.5, 1.5, 4, Inf, -Inf, 3.5, 3), output="window width of size 1, skip median and use simple loop") +test(6004.008, frollmedian(x, 2), c(NA, 3, Inf, Inf, 2, 2.75, Inf, NaN, -Inf, 3.25), output="window width of size 2, skip median and use simple loop") +test(6004.011, frollmedian(1:9, 3), as.double(c(NA,NA,2:8)), output="running implementation as described in the paper by Jukka Suomela, for uneven window size, length of input a multiple of window size, no NAs in the input data") +test(6004.012, frollmedian(1:10, 3), as.double(c(NA,NA,2:9)), notOutput="running implementation as described in the paper by Jukka Suomela, for uneven window size, length of input a multiple of window size, no NAs in the input data", output="padding with 2 elements") +test(6004.013, frollmedian(1:8, 4), c(NA, NA, NA, 2.5, 3.5, 4.5, 5.5, 6.5), notOutput="running implementation as described in the paper by Jukka Suomela, for uneven window size, length of input a multiple of window size, no NAs in the input data") +test(6004.014, frollmedian(c(NA,2:9), 3), as.double(c(NA,NA,NA,3:8)), notOutput="running implementation as described in the paper by Jukka Suomela, for uneven window size, length of input a multiple of window size, no NAs in the input data", output="NAs detected") +test(6004.015, frollmedian(c(1,2,3,4,NA,6), 3), c(NA, NA, 2, 3, NA, NA), output="NAs detected, fall back to frollmedianExact\nfrollmedianExact: running in parallel for input length 6, window 3, hasnf 1, narm 0") +test(6004.016, frollmedian(c(1,2,3,4,5,6), 3), c(NA, NA, 2, 3, 4, 5), output="sequentially as there is only single rolling computation.*finding order and initializing links for 2 blocks in parallel took") +test(6004.017, frollmedian(c(1,2,3,4,5,6), c(3,3)), list(c(NA, NA, 2, 3, 4, 5), c(NA, NA, 2, 3, 4, 5)), output="in parallel.*finding order and initializing links for 2 blocks sequentially took", notOutput="finding order and initializing links for 2 blocks in parallel took") +options(datatable.verbose=FALSE) +test(6004.021, frollmedian(c(1,2,3,4,NA,6), 3, has.nf=FALSE), c(NA, NA, 2, 3, 4, NA)) ## incorrect results due to misuse of has.nf=T documented +test(6004.022, frollmedian(c(1,2,3,4,NA,6), 3, algo="exact", has.nf=FALSE), c(NA, NA, 2, 3, 4, NA)) ## incorrect results due to misuse of has.nf=T documented +test(6004.023, frollmedian(c(1,2,3,4,NA,6), rep(3, 6), has.nf=FALSE, adaptive=TRUE), c(NA, NA, 2, 3, 4, NA)) ## incorrect results due to misuse of has.nf=T documented +test(6004.024, frollmedian(c(1,2,3,4,NA,6), rep(3, 6), algo="exact", has.nf=FALSE, adaptive=TRUE), c(NA, NA, 2, 3, 4, NA)) ## incorrect results due to misuse of has.nf=T documented +test(6004.025, frollmedian(1:3, 2, has.nf=TRUE, algo="exact"), c(NA,1.5,2.5), options=c("datatable.verbose"=TRUE), output="no NAs detected, redirecting to itself using") +# codecov +test(6004.0261, frollmedian(9:1, 3), c(NA, NA, 8, 7, 6, 5, 4, 3, 2)) +test(6004.0262, frollmedian(rep(2,8), 4), c(NA, NA, NA, 2, 2, 2, 2, 2)) + +x = 1:6/2 +test(6004.031, frollmedian(x, 3), c(NA,NA,1,1.5,2,2.5)) +test(6004.032, frollmedian(x, c(2L, 2L, 3L, 4L, 2L, 3L), adaptive=TRUE), c(NA, 0.75, 1, 1.25, 2.25, 2.5)) +options(datatable.verbose=TRUE) +test(6004.033, frollmedian(1:3, 2), c(NA, 1.5, 2.5), output="frollmedianFast: running for input length") +test(6004.034, frollmedian(1:3, c(2,2,2), adaptive=TRUE), c(NA, 1.5, 2.5), output="frolladaptivemedianExact: running in parallel") +options(datatable.verbose=FALSE) +test(6004.035, frollmedian(rep(NA_real_, 9), 3), rep(NA_real_, 9)) +test(6004.036, frollmedian(rep(NA_real_, 10), 3), rep(NA_real_, 10)) +test(6004.037, frollmedian(rep(NA_real_, 10), 4), rep(NA_real_, 10)) +test(6004.038, frollmedian(rep(NA_real_, 12), 4), rep(NA_real_, 12)) +d = as.data.table(list(1:6/2, 3:8/4)) +test(6004.039, frollmedian(d, 3:4), list(c(NA, NA, 1, 1.5, 2, 2.5), c(NA, NA, NA, 1.25, 1.75, 2.25), c(NA, NA, 1, 1.25, 1.5, 1.75), c(NA, NA, NA, 1.125, 1.375, 1.625))) + +x = c(1,2,3,4,NA,6) +k = 3 +test(6004.101, frollmedian(x, k, na.rm=FALSE), c(NA, NA, 2, 3, NA, NA)) +test(6004.102, frollmedian(x, k, na.rm=TRUE), c(NA, NA, 2, 3, 3.5, 5)) +test(6004.103, frollmedian(x, k, na.rm=FALSE, algo="exact"), c(NA, NA, 2, 3, NA, NA)) +test(6004.104, frollmedian(x, k, na.rm=TRUE, algo="exact"), c(NA, NA, 2, 3, 3.5, 5)) +x = c(1,2,3,4,NA,NA,6) +k = 3 +test(6004.105, frollmedian(x, k, na.rm=FALSE), c(NA, NA, 2, 3, NA, NA, NA)) +test(6004.106, frollmedian(x, k, na.rm=TRUE), c(NA, NA, 2, 3, 3.5, 4, 6)) +test(6004.107, frollmedian(x, k, na.rm=FALSE, algo="exact"), c(NA, NA, 2, 3, NA, NA, NA)) +test(6004.108, frollmedian(x, k, na.rm=TRUE, algo="exact"), c(NA, NA, 2, 3, 3.5, 4, 6)) +x = c(1,2,3,4,NA,6) +k = 4 +test(6004.109, frollmedian(x, k, na.rm=FALSE), c(NA, NA, NA, 2.5, NA, NA)) +test(6004.110, frollmedian(x, k, na.rm=TRUE), c(NA, NA, NA, 2.5, 3, 4)) +test(6004.111, frollmedian(x, k, na.rm=FALSE, algo="exact"), c(NA, NA, NA, 2.5, NA, NA)) +test(6004.112, frollmedian(x, k, na.rm=TRUE, algo="exact"), c(NA, NA, NA, 2.5, 3, 4)) +x = c(1,2,3,4,NA,NA,6) +k = 4 +test(6004.113, frollmedian(x, k, na.rm=FALSE), c(NA, NA, NA, 2.5, NA, NA, NA)) +test(6004.114, frollmedian(x, k, na.rm=TRUE), c(NA, NA, NA, 2.5, 3, 3.5, 5)) +test(6004.115, frollmedian(x, k, na.rm=FALSE, algo="exact"), c(NA, NA, NA, 2.5, NA, NA, NA)) +test(6004.116, frollmedian(x, k, na.rm=TRUE, algo="exact"), c(NA, NA, NA, 2.5, 3, 3.5, 5)) +x = c(1,2,3,4,NA,NA,NA,NA,6) +k = 3 +test(6004.117, frollmedian(x, k, na.rm=FALSE), c(NA, NA, 2, 3, NA, NA, NA, NA, NA)) +test(6004.118, frollmedian(x, k, na.rm=TRUE), c(NA, NA, 2, 3, 3.5, 4, NA, NA, 6)) +test(6004.119, frollmedian(x, k, na.rm=FALSE, algo="exact"), c(NA, NA, 2, 3, NA, NA, NA, NA, NA)) +test(6004.120, frollmedian(x, k, na.rm=TRUE, algo="exact"), c(NA, NA, 2, 3, 3.5, 4, NA, NA, 6)) +k = 4 +test(6004.121, frollmedian(x, k, na.rm=FALSE), c(NA, NA, NA, 2.5, NA, NA, NA, NA, NA)) +test(6004.122, frollmedian(x, k, na.rm=TRUE), c(NA, NA, NA, 2.5, 3, 3.5, 4, NA, 6)) +test(6004.123, frollmedian(x, k, na.rm=FALSE, algo="exact"), c(NA, NA, NA, 2.5, NA, NA, NA, NA, NA)) +test(6004.124, frollmedian(x, k, na.rm=TRUE, algo="exact"), c(NA, NA, NA, 2.5, 3, 3.5, 4, NA, 6)) +x = rep(NA_real_,10) +k = 3 +test(6004.125, frollmedian(x, k, na.rm=FALSE), rep(NA_real_,10)) +test(6004.126, frollmedian(x, k, na.rm=TRUE), rep(NA_real_,10)) +test(6004.127, frollmedian(x, k, na.rm=FALSE, algo="exact"), rep(NA_real_,10)) +test(6004.128, frollmedian(x, k, na.rm=TRUE, algo="exact"), rep(NA_real_,10)) +k = 4 +test(6004.129, frollmedian(x, k, na.rm=FALSE), rep(NA_real_,10)) +test(6004.130, frollmedian(x, k, na.rm=TRUE), rep(NA_real_,10)) +test(6004.131, frollmedian(x, k, na.rm=FALSE, algo="exact"), rep(NA_real_,10)) +test(6004.132, frollmedian(x, k, na.rm=TRUE, algo="exact"), rep(NA_real_,10)) + +## bigger sets for uneven k vs stats::runmed Turlach +runmedr = function(x, k) { + ans = stats::runmed(x, k, algorithm="Turlach") + h = (k-1L)/2L + n = length(x) + c(rep(NA_real_, k-1L), ans[-c(1:h, (n-h+1L):n)]) } -afun_compare = function(x, n, funs=c("mean","sum"), algos=c("fast","exact")) { - num.step = 0.0001 - #### fun, na.rm, fill, algo - for (fun in funs) { - for (na.rm in c(FALSE, TRUE)) { - for (fill in c(NA_real_, 0)) { - for (algo in algos) { - num <<- num + num.step - eval(substitute( - test(.num, - froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo, adaptive=TRUE), - arollfun(.fun, x, n, fill=.fill, na.rm=.na.rm, nf.rm=.nf.rm)), - list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .nf.rm=algo!="exact") - )) - } - } - } - } -} -#### 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) -#### 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) -#### 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) -#### 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) -rm(num) +set.seed(108) +x = rnorm(1e4) +n = 11 +test(6004.951, frollmedian(x, n), runmedr(x, n)) +n = 101 +test(6004.952, frollmedian(x, n), runmedr(x, n)) +n = 1001 +test(6004.953, frollmedian(x, n), runmedr(x, n)) +x = rnorm(1e5) +n = 101 +test(6004.954, frollmedian(x, n), runmedr(x, n)) +n = 1001 +test(6004.955, frollmedian(x, n), runmedr(x, n)) +#n = 10001 ## too long +#test(6004.956, frollmedian(x, n), runmedr(x, n)) + +## partial +x = 1:6/2 +n = 3 +an = function(n, len) c(seq.int(n), rep(n, len-n)) +test(6006.011, frollmean(x, an(n, length(x)), adaptive=TRUE), c(0.5,0.75,1,1.5,2,2.5)) +test(6006.012, frollmean(x, n, partial=TRUE), c(0.5,0.75,1,1.5,2,2.5)) +ans = frollmean(x, n) +ans[seq.int(n-1L)] = frollmean(x[seq.int(n-1L)], n, partial=TRUE) +test(6006.013, ans, c(0.5,0.75,1,1.5,2,2.5)) +test(6006.021, frollmean(x, rev(an(rev(n), length(x))), adaptive=TRUE, align="left"), c(1,1.5,2,2.5,2.75,3)) +test(6006.022, frollmean(x, n, partial=TRUE, align="left"), c(1,1.5,2,2.5,2.75,3)) +ans = frollmean(x, n, align="left") +ans[(length(x)-n-1L):length(x)] = frollmean(x[(length(x)-n-1L):length(x)], n, partial=TRUE, align="left") +test(6006.023, ans, c(1,1.5,2,2.5,2.75,3)) +ans = list(c(0.50,0.75,1.00,1.50,2.00,2.50), c(0.50,0.75,1.00,1.25,1.75,2.25)) +test(6006.031, frollmean(1:6/2, list(3L,4L), partial=TRUE), error="n must be an integer, list is accepted for adaptive TRUE") +test(6006.032, frollmean(1:6/2, 3:4, partial=TRUE), ans) +options(datatable.verbose=TRUE) +test(6006.901, frollmean(x, n, partial=TRUE), c(0.5,0.75,1,1.5,2,2.5), output="froll partial=TRUE trimming n and redirecting to adaptive=TRUE") +test(6006.902, frollmean(x, rep(n, length(x)), adaptive=TRUE, partial=TRUE), c(0.5,0.75,1,1.5,2,2.5), output="trimming", notOutput="redirecting") +options(datatable.verbose=FALSE) +test(6006.903, frollmean(1:4, 2L, align="center", partial=TRUE), error="'partial' cannot be used together with align='center'") +test(6006.904, frollmean(list(1:4, 2:4), n, partial=TRUE), error="'partial' does not support variable length of columns in x") +test(6006.905, frollmean(list(data.table(v1=1:4), data.table(v1=1:3)), n, partial=TRUE), error="'partial' does not support variable nrow of data.tables in x") +test(6006.906, frollmean(x, TRUE, partial=TRUE), error="n must be an integer") +test(6006.907, frollmean(x, list(TRUE), partial=TRUE), error="n must be an integer, list is accepted for adaptive TRUE") +test(6006.908, frollsum(1:4, integer(), partial = TRUE), error = "n must be non 0 length") + +## partial adaptive +test(6006.930, frollmean(1:4, rep(2L,4L), adaptive=TRUE, partial=TRUE), c(1,1.5,2.5,3.5)) +test(6006.9301, frollmean(1:4, list(1:4, 1:3), adaptive=TRUE, partial=TRUE), error="adaptive windows provided in n must not to have different lengths") +test(6006.9302, frollmean(1:4, list(1:3), adaptive=TRUE, partial=TRUE), error="length of vectors in x must match to length of adaptive window in n") +test(6006.9303, frollmean(1:4, list(rep(2L,4L)), adaptive=TRUE, partial=TRUE), c(1,1.5,2.5,3.5)) +test(6006.9311, frollsum(1:4, 1:4, adaptive=TRUE, partial=TRUE), c(1,3,6,10)) ## all same as index +test(6006.9312, frollsum(1:4, 1:4, align="left", adaptive=TRUE, partial=TRUE), c(1,5,7,4)) +test(6006.9321, frollsum(1:4, c(2,3,1,1), adaptive=TRUE, partial=TRUE), c(1,3,3,4)) ## leading two bigger than index +test(6006.9322, frollsum(1:4, c(2,3,1,1), align="left", adaptive=TRUE, partial=TRUE), c(3,9,3,4)) +test(6006.9323, frollsum(1:4, c(6,5,4,2), adaptive=TRUE, partial=TRUE), c(1,3,6,7)) ## leading two bigger than rev index +test(6006.9324, frollsum(1:4, c(6,5,4,2), align="left", adaptive=TRUE, partial=TRUE), c(10,9,7,4)) +test(6006.9331, frollsum(1:4, c(2,4,5,6), adaptive=TRUE, partial=TRUE), c(1,3,6,10)) ## trailing two bigger than index +test(6006.9332, frollsum(1:4, c(2,4,5,6), align="left", adaptive=TRUE, partial=TRUE), c(3,9,7,4)) +test(6006.9333, frollsum(1:4, c(1,1,3,2), adaptive=TRUE, partial=TRUE), c(1,2,6,7)) ## trailing two bigger than rev index +test(6006.9334, frollsum(1:4, c(1,1,3,2), align="left", adaptive=TRUE, partial=TRUE), c(1,2,7,4)) +test(6006.9335, frollsum(1:4, list(c(1,1,3,2), c("a","b","c","d")), adaptive=TRUE, partial=TRUE), error = "n must be an integer vector or a list of integer vectors") +test(6006.9336, frollsum(1:4, c(1,2,3), adaptive=TRUE, partial=TRUE), error = "length of n argument must be equal to number of observations provided in x") + +## give.names +test(6006.9511, frollsum(c(1,2,3), 2, give.names=TRUE), c(NA,3,5)) +test(6006.9512, frollsum(c(1,2,3), c(b=2), give.names=TRUE), c(NA,3,5)) +test(6006.9513, frollsum(c(a1=1,a2=2,a3=3), c(b=2), give.names=TRUE), c(NA,3,5)) +test(6006.9514, frollsum(c(a1=1,a2=2,a3=3), 2, give.names=TRUE), c(NA,3,5)) +test(6006.952, frollsum(list(c(1,2,3)), 2, give.names=TRUE), list(V1_rollsum2=c(NA,3,5))) +test(6006.953, frollsum(list(x1=c(1,2,3)), 2, give.names=TRUE), list(x1_rollsum2=c(NA,3,5))) +test(6006.954, frollsum(list(c(1,2,3)), c(n1=2), give.names=TRUE), list(V1_n1=c(NA,3,5))) +test(6006.955, frollsum(list(x1=c(1,2,3)), c(n1=2), give.names=TRUE), list(x1_n1=c(NA,3,5))) +test(6006.956, frollsum(c(1,2,3), 2:3, give.names=TRUE), list(rollsum2=c(NA,3,5), rollsum3=c(NA,NA,6))) +test(6006.957, frollsum(list(c(1,2,3)), 2:3, give.names=TRUE), list(V1_rollsum2=c(NA,3,5), V1_rollsum3=c(NA,NA,6))) +test(6006.958, frollsum(list(c(1,2,3), c(2,3,4)), 2, give.names=TRUE), list(V1_rollsum2=c(NA,3,5), V2_rollsum2=c(NA,5,7))) +test(6006.959, frollsum(list(c(1,2,3), c(2,3,4)), 2:3, give.names=TRUE), list(V1_rollsum2=c(NA,3,5), V1_rollsum3=c(NA,NA,6), V2_rollsum2=c(NA,5,7), V2_rollsum3=c(NA,NA,9))) +test(6006.960, frollsum(c(1,2,3), c(n1=2, n2=3), give.names=TRUE), list(n1=c(NA,3,5), n2=c(NA,NA,6))) +test(6006.961, frollsum(list(c(1,2,3)), c(n1=2, n2=3), give.names=TRUE), list(V1_n1=c(NA,3,5), V1_n2=c(NA,NA,6))) +test(6006.962, frollsum(list(x1=c(1,2,3)), 2:3, give.names=TRUE), list(x1_rollsum2=c(NA,3,5), x1_rollsum3=c(NA,NA,6))) +test(6006.963, frollsum(list(x1=c(1,2,3)), c(n1=2, n2=3), give.names=TRUE), list(x1_n1=c(NA,3,5), x1_n2=c(NA,NA,6))) +test(6006.964, frollsum(list(c(1,2,3), c(2,3,4)), c(n1=2), give.names=TRUE), list(V1_n1=c(NA,3,5), V2_n1=c(NA,5,7))) +test(6006.965, frollsum(list(c(1,2,3), c(2,3,4)), c(n1=2, n2=3), give.names=TRUE), list(V1_n1=c(NA,3,5), V1_n2=c(NA,NA,6), V2_n1=c(NA,5,7), V2_n2=c(NA,NA,9))) +test(6006.966, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), 2, give.names=TRUE), list(x1_rollsum2=c(NA,3,5), x2_rollsum2=c(NA,5,7))) +test(6006.967, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), 2:3, give.names=TRUE), list(x1_rollsum2=c(NA,3,5), x1_rollsum3=c(NA,NA,6), x2_rollsum2=c(NA,5,7), x2_rollsum3=c(NA,NA,9))) +test(6006.968, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), c(n1=2), give.names=TRUE), list(x1_n1=c(NA,3,5), x2_n1=c(NA,5,7))) +test(6006.969, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), c(n1=2, n2=3), give.names=TRUE), list(x1_n1=c(NA,3,5), x1_n2=c(NA,NA,6), x2_n1=c(NA,5,7), x2_n2=c(NA,NA,9))) +test(6006.971, frollsum(c(1,2,3), c(2,2,2), adaptive=TRUE, give.names=TRUE), c(NA,3,5)) ## adaptive +test(6006.972, frollsum(c(1,2,3), list(c(2,2,2)), adaptive=TRUE, give.names=TRUE), c(NA,3,5)) +test(6006.973, frollsum(list(c(1,2,3)), c(2,2,2), adaptive=TRUE, give.names=TRUE), list(V1=c(NA,3,5))) +test(6006.974, frollsum(list(c(1,2,3)), list(c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(V1_arollsum1=c(NA,3,5))) +test(6006.975, frollsum(list(x1=c(1,2,3)), c(2,2,2), adaptive=TRUE, give.names=TRUE), list(x1=c(NA,3,5))) +test(6006.976, frollsum(list(x1=c(1,2,3)), list(c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(x1_arollsum1=c(NA,3,5))) +test(6006.977, frollsum(list(c(1,2,3)), list(n1=c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(V1_n1=c(NA,3,5))) +test(6006.978, frollsum(list(x1=c(1,2,3)), list(n1=c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(x1_n1=c(NA,3,5))) +test(6006.979, frollsum(c(1,2,3), list(c(2,2,2), c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(arollsum1=c(NA,3,5), arollsum2=c(NA,NA,6))) +test(6006.980, frollsum(list(c(1,2,3)), list(c(2,2,2), c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(V1_arollsum1=c(NA,3,5), V1_arollsum2=c(NA,NA,6))) +test(6006.981, frollsum(list(c(1,2,3), c(2,3,4)), c(2,2,2), adaptive=TRUE, give.names=TRUE), list(V1=c(NA,3,5), V2=c(NA,5,7))) +test(6006.982, frollsum(list(c(1,2,3), c(2,3,4)), list(c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(V1_arollsum1=c(NA,3,5), V2_arollsum1=c(NA,5,7))) +test(6006.983, frollsum(list(c(1,2,3), c(2,3,4)), list(c(2,2,2), c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(V1_arollsum1=c(NA,3,5), V1_arollsum2=c(NA,NA,6), V2_arollsum1=c(NA,5,7), V2_arollsum2=c(NA,NA,9))) +test(6006.984, frollsum(c(1,2,3), list(n1=c(2,2,2), n2=c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(n1=c(NA,3,5), n2=c(NA,NA,6))) +test(6006.985, frollsum(list(c(1,2,3)), list(n1=c(2,2,2), n2=c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(V1_n1=c(NA,3,5), V1_n2=c(NA,NA,6))) +test(6006.986, frollsum(list(x1=c(1,2,3)), list(c(2,2,2), c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(x1_arollsum1=c(NA,3,5), x1_arollsum2=c(NA,NA,6))) +test(6006.987, frollsum(list(x1=c(1,2,3)), list(n1=c(2,2,2), n2=c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(x1_n1=c(NA,3,5), x1_n2=c(NA,NA,6))) +test(6006.988, frollsum(list(c(1,2,3), c(2,3,4)), list(n1=c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(V1_n1=c(NA,3,5), V2_n1=c(NA,5,7))) +test(6006.989, frollsum(list(c(1,2,3), c(2,3,4)), list(n1=c(2,2,2), n2=c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(V1_n1=c(NA,3,5), V1_n2=c(NA,NA,6), V2_n1=c(NA,5,7), V2_n2=c(NA,NA,9))) +test(6006.990, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), c(2,2,2), adaptive=TRUE, give.names=TRUE), list(x1=c(NA,3,5), x2=c(NA,5,7))) +test(6006.991, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), list(c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(x1_arollsum1=c(NA,3,5), x2_arollsum1=c(NA,5,7))) +test(6006.992, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), list(c(2,2,2), c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(x1_arollsum1=c(NA,3,5), x1_arollsum2=c(NA,NA,6), x2_arollsum1=c(NA,5,7), x2_arollsum2=c(NA,NA,9))) +test(6006.993, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), list(n1=c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(x1_n1=c(NA,3,5), x2_n1=c(NA,5,7))) +test(6006.994, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), list(n1=c(2,2,2), n2=c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(x1_n1=c(NA,3,5), x1_n2=c(NA,NA,6), x2_n1=c(NA,5,7), x2_n2=c(NA,NA,9))) +test(6006.9950, frollsum(c(1,2,3), 2, partial=TRUE, give.names=TRUE), c(1,3,5)) ## partial +test(6006.9951, frollsum(c(1,2,3), c(n1=2), partial=TRUE, give.names=TRUE), c(1,3,5)) +test(6006.9952, frollsum(list(c(1,2,3)), 2, partial=TRUE, give.names=TRUE), list(V1_rollsum2=c(1,3,5))) +test(6006.9953, frollsum(list(x1=c(1,2,3)), 2, partial=TRUE, give.names=TRUE), list(x1_rollsum2=c(1,3,5))) +test(6006.9954, frollsum(list(c(1,2,3)), c(n1=2), partial=TRUE, give.names=TRUE), list(V1_n1=c(1,3,5))) +test(6006.9955, frollsum(list(x1=c(1,2,3)), c(n1=2), partial=TRUE, give.names=TRUE), list(x1_n1=c(1,3,5))) +test(6006.9956, frollsum(list(c(1,2,3), c(2,3,4)), c(2, 3), partial=TRUE, give.names=TRUE), list(V1_rollsum2=c(1,3,5), V1_rollsum3=c(1,3,6), V2_rollsum2=c(2,5,7), V2_rollsum3=c(2,5,9))) +test(6006.9957, frollsum(list(c(1,2,3), c(2,3,4)), c(n1=2, n2=3), partial=TRUE, give.names=TRUE), list(V1_n1=c(1,3,5), V1_n2=c(1,3,6), V2_n1=c(2,5,7), V2_n2=c(2,5,9))) +test(6006.9958, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), c(2, 3), partial=TRUE, give.names=TRUE), list(x1_rollsum2=c(1,3,5), x1_rollsum3=c(1,3,6), x2_rollsum2=c(2,5,7), x2_rollsum3=c(2,5,9))) +test(6006.9959, frollsum(list(x1=c(1,2,3), x2=c(2,3,4)), c(n1=2, n2=3), partial=TRUE, give.names=TRUE), list(x1_n1=c(1,3,5), x1_n2=c(1,3,6), x2_n1=c(2,5,7), x2_n2=c(2,5,9))) +test(6006.9960, frollsum(c(1,2,3), c(2,2,2), adaptive=TRUE, partial=TRUE, give.names=TRUE), c(1,3,5)) ## adaptive partial +test(6006.9961, frollsum(c(1,2,3), list(c(2,2,2)), adaptive=TRUE, partial=TRUE, give.names=TRUE), c(1,3,5)) +test(6006.9962, frollsum(list(c(1,2,3)), c(2,2,2), adaptive=TRUE, partial=TRUE, give.names=TRUE), list(V1=c(1,3,5))) +test(6006.9963, frollsum(list(c(1,2,3)), list(c(2,2,2)), adaptive=TRUE, partial=TRUE, give.names=TRUE), list(V1_arollsum1=c(1,3,5))) +test(6006.9964, frollsum(list(x1=c(1,2,3)), c(2,2,2), adaptive=TRUE, partial=TRUE, give.names=TRUE), list(x1=c(1,3,5))) +test(6006.9965, frollsum(list(x1=c(1,2,3)), list(c(2,2,2)), adaptive=TRUE, partial=TRUE, give.names=TRUE), list(x1_arollsum1=c(1,3,5))) +test(6006.9966, frollsum(c(1,2,3), list(c(n1=c(2,2,2))), adaptive=TRUE, partial=TRUE, give.names=TRUE), c(1,3,5)) +test(6006.9967, frollsum(list(c(1,2,3)), c(2,2,2), adaptive=TRUE, partial=TRUE, give.names=TRUE), list(V1=c(1,3,5))) +test(6006.9968, frollsum(list(c(1,2,3)), list(n1=c(2,2,2)), adaptive=TRUE, partial=TRUE, give.names=TRUE), list(V1_n1=c(1,3,5))) +test(6006.9969, frollsum(list(x1=c(1,2,3)), list(n1=c(2,2,2)), adaptive=TRUE, partial=TRUE, give.names=TRUE), list(x1_n1=c(1,3,5))) ## frollapply x = as.double(1:10) From f0cd1f22a1c4db575ba7c246712342dec455c66f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 26 Dec 2025 17:39:14 +0000 Subject: [PATCH 11/12] missed one ignore.warning= --- inst/tests/frollBatch.Rraw | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/tests/frollBatch.Rraw b/inst/tests/frollBatch.Rraw index ff8dbbcfad..d252ad587f 100644 --- a/inst/tests/frollBatch.Rraw +++ b/inst/tests/frollBatch.Rraw @@ -64,7 +64,7 @@ base_compare = function(x, n, funs=c("mean","sum","max","min","prod","median","v } for (algo in algos) { num <<- num + num.step - test(num, + 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), context=sprintf("fun=%s\tna.rm=$s\tfill=%s\tpartial=%s\thas.nf=%s\talgo=%s", fun, na.rm, fill, partial, has.nf, algo)) From 4f53b0842ab63040c46d130275ee153f5c8a158d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 26 Dec 2025 17:43:53 +0000 Subject: [PATCH 12/12] missed '.'-prefix --- inst/tests/frollBatch.Rraw | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/tests/frollBatch.Rraw b/inst/tests/frollBatch.Rraw index d252ad587f..0dd7c81bd2 100644 --- a/inst/tests/frollBatch.Rraw +++ b/inst/tests/frollBatch.Rraw @@ -243,7 +243,7 @@ afun_compare = function(x, n, funs=c("mean","sum","max","min","prod","median","v for (algo in algos) { num <<- num + num.step test(num, ignore.warning = "no non-missing arguments", - arollfun(fun, x, n, fill=fill, na.rm=.na.rm, align=align, partial=partial), + 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), context=sprintf("fun=%s\talign=%s\tna.rm=$s\tfill=%s\tpartial=%s\thas.nf=%s\talgo=%s", fun, align, na.rm, fill, partial, has.nf, algo)) }