Skip to content

Commit b2870e6

Browse files
jangoreckijangorecki
authored
NA support in frollmax
1 parent a559201 commit b2870e6

File tree

7 files changed

+335
-228
lines changed

7 files changed

+335
-228
lines changed

‎R/froll.R‎

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ partial2adaptive = function(x, n, align) {
3434
}
3535
}
3636

37-
froll = function(fun, x, n, fill=NA, algo=c("fast", "exact"), align=c("right", "left", "center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE, partial=FALSE) {
37+
froll = function(fun, x, n, fill=NA, algo=c("fast","exact"), align=c("right","left","center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE, partial=FALSE) {
3838
stopifnot(!missing(fun), is.character(fun), length(fun)==1L, !is.na(fun))
3939
algo = match.arg(algo)
4040
align = match.arg(align)
@@ -68,17 +68,17 @@ froll = function(fun, x, n, fill=NA, algo=c("fast", "exact"), align=c("right", "
6868
}
6969
}
7070

71-
frollmean = function(x, n, fill=NA, algo=c("fast", "exact"), align=c("right", "left", "center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE, partial=FALSE) {
71+
frollmean = function(x, n, fill=NA, algo=c("fast","exact"), align=c("right","left","center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE, partial=FALSE) {
7272
froll(fun="mean", x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, hasNA=hasNA, adaptive=adaptive, partial=partial)
7373
}
74-
frollsum = function(x, n, fill=NA, algo=c("fast","exact"), align=c("right", "left", "center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE, partial=FALSE) {
74+
frollsum = function(x, n, fill=NA, algo=c("fast","exact"), align=c("right","left","center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE, partial=FALSE) {
7575
froll(fun="sum", x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, hasNA=hasNA, adaptive=adaptive, partial=partial)
7676
}
77-
frollmax = function(x, n, fill=NA, algo=c("fast", "exact"), align=c("right", "left", "center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE, partial=FALSE) {
77+
frollmax = function(x, n, fill=NA, algo=c("fast","exact"), align=c("right","left","center"), na.rm=FALSE, hasNA=NA, adaptive=FALSE, partial=FALSE) {
7878
froll(fun="max", x=x, n=n, fill=fill, algo=algo, align=align, na.rm=na.rm, hasNA=hasNA, adaptive=adaptive, partial=partial)
7979
}
8080

81-
frollapply = function(x, n, FUN, ..., fill=NA, align=c("right", "left", "center"), adaptive=FALSE, partial=FALSE) {
81+
frollapply = function(x, n, FUN, ..., fill=NA, align=c("right","left","center"), adaptive=FALSE, partial=FALSE) {
8282
FUN = match.fun(FUN)
8383
align = match.arg(align)
8484
if (isTRUE(partial)) {
@@ -91,12 +91,14 @@ frollapply = function(x, n, FUN, ..., fill=NA, align=c("right", "left", "center"
9191
n = partial2adaptive(x, n, align)
9292
adaptive = TRUE
9393
}
94+
if (isTRUE(adaptive) && base::getRversion() < "3.4.0") ## support SET_GROWABLE_BIT
95+
stopf("frollapply adaptive=TRUE requires at least R 3.4.0"); # nocov
9496
leftadaptive = isTRUE(adaptive) && align=="left"
9597
if (leftadaptive) {
9698
verbose = getOption("datatable.verbose")
9799
rev2 = function(x) if (is.list(x)) lapply(x, rev) else rev(x)
98100
if (verbose)
99-
cat("froll: adaptive=TRUE && align='left' pre-processing for align='right'\n")
101+
cat("frollapply: adaptive=TRUE && align='left' pre-processing for align='right'\n")
100102
x = rev2(x)
101103
n = rev2(n)
102104
align = "right"

‎TODO‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
This is the list of follow up issues that may be resolved after all rolling functions PRs will be merged. As of the current moment none of those is a bug fix or essentially necessary but rather good practice changes.
22

3+
- catf() instead of cat()
4+
35
- use `test(..., options(datatable.verbose=TRUE))` rather than `options(datatable.verbose=TRUE)`
46

57
- verbose output `frolladaptivefun: algo 0 not implemented, fall back to 1` could be more intuitive

‎inst/tests/froll.Rraw‎

Lines changed: 172 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -853,7 +853,7 @@ test(6000.225, frollsum(1:3, c(2,2,2), adaptive=TRUE), c(NA, 3, 5), output="frol
853853
test(6000.226, frollsum(c(NA,2,3), c(2,2,2), adaptive=TRUE), c(NA, NA, 5), output="re-running with extra care for NAs")
854854
options(datatable.verbose=FALSE)
855855

856-
## frollmax
856+
## frollmax adaptive
857857
options(datatable.verbose=TRUE) ## adaptive frollmax no fast algo
858858
test(6000.3, frollmax(1:4, c(2,2,2,2), adaptive=TRUE), output="frolladaptivefun: algo 0 not implemented, fall back to 1")
859859
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")
@@ -903,8 +903,92 @@ test(6000.3352, frollmax(x, n, hasNA=FALSE, na.rm=TRUE, adaptive=TRUE), error="d
903903
test(6000.3361, frollmax(x, n, hasNA=TRUE, adaptive=TRUE), c(NA,7,2,7,6,NA,NA,NA))
904904
test(6000.3362, frollmax(x, n, hasNA=TRUE, na.rm=TRUE, adaptive=TRUE), c(NA,7,2,7,6,-Inf,6,7))
905905

906-
#TODO frollmax dev
907-
#TODO frollmax tests
906+
## frollmax non-adaptive
907+
options(datatable.verbose=TRUE) ## adaptive frollmax no fast algo
908+
#test(6000.4, frollmax(1:4, c(2,2,2,2)), output="frolladaptivefun: algo 0 not implemented, fall back to 1") ## implemented
909+
#test(6000.4001, frollmax(1:4, c(2,2,2,2), algo="fast"), output="frolladaptivefun: algo 0 not implemented, fall back to 1")
910+
test(6000.4002, frollmax(1:4, c(2,2,2,2), algo="exact"), notOutput="frolladaptivefun: algo 0 not implemented, fall back to 1")
911+
options(datatable.verbose=FALSE)
912+
n = 3
913+
x = c(7,2,3,6,3,2,4,5) # no NA
914+
ans = c(NA,NA,7,6,6,6,4,5)
915+
test(6000.4111, frollmax(x, n), ans) # hasNA=NA # narm=F
916+
test(6000.4112, frollmax(x, n, na.rm=TRUE), ans) # narm=T
917+
test(6000.4113, frollmax(x, n, algo="exact"), ans) # hasNA=NA # narm=F
918+
test(6000.4114, frollmax(x, n, algo="exact", na.rm=TRUE), ans) # narm=T
919+
test(6000.4121, frollmax(x, n, hasNA=FALSE), ans) # hasNA=F
920+
test(6000.4122, frollmax(x, n, hasNA=FALSE, na.rm=TRUE), error="does not make sense")
921+
test(6000.4123, frollmax(x, n, algo="exact", hasNA=FALSE), ans) # hasNA=F
922+
test(6000.4124, frollmax(x, n, algo="exact", hasNA=FALSE, na.rm=TRUE), error="does not make sense")
923+
test(6000.4131, frollmax(x, n, hasNA=TRUE), ans) # hasNA=T
924+
test(6000.4132, frollmax(x, n, hasNA=TRUE, na.rm=TRUE), ans)
925+
test(6000.4133, frollmax(x, n, algo="exact", hasNA=TRUE), ans) # hasNA=T
926+
test(6000.4134, frollmax(x, n, algo="exact", hasNA=TRUE, na.rm=TRUE), ans)
927+
x = c(7,2,3,NA,3,2,4,NA) # NA
928+
test(6000.4211, frollmax(x, n), c(NA,NA,7,NA,NA,NA,4,NA))
929+
test(6000.4212, frollmax(x, n, na.rm=TRUE), c(NA,NA,7,3,3,3,4,4))
930+
test(6000.4213, frollmax(x, n, algo="exact"), c(NA,NA,7,NA,NA,NA,4,NA))
931+
test(6000.4214, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA,7,3,3,3,4,4))
932+
test(6000.4221, frollmax(x, n, hasNA=FALSE), c(NA,NA,7,3,3,3,4,4)) ## expected incorrect results, see manual hasNA section for details, added in #5441
933+
test(6000.4222, frollmax(x, n, hasNA=FALSE, na.rm=TRUE), error="does not make sense")
934+
test(6000.4223, frollmax(x, n, algo="exact", hasNA=FALSE), c(NA,NA,7,3,3,3,4,4)) ## expected incorrect results, see manual hasNA section for details, added in #5441
935+
test(6000.4224, frollmax(x, n, algo="exact", hasNA=FALSE, na.rm=TRUE), error="does not make sense")
936+
test(6000.4231, frollmax(x, n, hasNA=TRUE), c(NA,NA,7,NA,NA,NA,4,NA))
937+
test(6000.4232, frollmax(x, n, hasNA=TRUE, na.rm=TRUE), c(NA,NA,7,3,3,3,4,4))
938+
test(6000.4233, frollmax(x, n, algo="exact", hasNA=TRUE), c(NA,NA,7,NA,NA,NA,4,NA))
939+
test(6000.4234, frollmax(x, n, algo="exact", hasNA=TRUE, na.rm=TRUE), c(NA,NA,7,3,3,3,4,4))
940+
x = rep(NA_real_, 8) # all NA
941+
test(6000.4241, frollmax(x, n), rep(NA_real_, 8))
942+
test(6000.4242, frollmax(x, n, na.rm=TRUE), c(NA,NA, rep(-Inf, 6)))
943+
test(6000.4243, frollmax(x, n, algo="exact"), rep(NA_real_, 8))
944+
test(6000.4244, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA, rep(-Inf, 6)))
945+
test(6000.4251, frollmax(x, n, hasNA=FALSE), c(NA,NA, rep(-Inf, 6)))
946+
test(6000.4252, frollmax(x, n, hasNA=FALSE, na.rm=TRUE), error="does not make sense")
947+
test(6000.4253, frollmax(x, n, algo="exact", hasNA=FALSE), c(NA,NA, rep(-Inf, 6)))
948+
test(6000.4254, frollmax(x, n, algo="exact", hasNA=FALSE, na.rm=TRUE), error="does not make sense")
949+
test(6000.4261, frollmax(x, n, hasNA=TRUE), rep(NA_real_, 8))
950+
test(6000.4262, frollmax(x, n, hasNA=TRUE, na.rm=TRUE), c(NA,NA, rep(-Inf, 6)))
951+
test(6000.4263, frollmax(x, n, algo="exact", hasNA=TRUE), rep(NA_real_, 8))
952+
test(6000.4264, frollmax(x, n, algo="exact", hasNA=TRUE, na.rm=TRUE), c(NA,NA, rep(-Inf, 6)))
953+
x = c(NA,NaN,NA,NaN,NaN,NaN,NA,NA) # all NaN/NA
954+
test(6000.4271, frollmax(x, n), c(NA,NA,NA,NA,NA,NaN,NA,NA))
955+
test(6000.4272, frollmax(x, n, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf))
956+
test(6000.4273, frollmax(x, n, algo="exact"), c(NA,NA,NA,NA,NA,NaN,NA,NA))
957+
test(6000.4274, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf))
958+
test(6000.4281, frollmax(x, n, hasNA=FALSE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) ## expected incorrect results, see manual hasNA section for details, added in #5441
959+
test(6000.4282, frollmax(x, n, hasNA=FALSE, na.rm=TRUE), error="does not make sense")
960+
test(6000.4283, frollmax(x, n, algo="exact", hasNA=FALSE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf)) ## expected incorrect results, see manual hasNA section for details, added in #5441
961+
test(6000.4284, frollmax(x, n, algo="exact", hasNA=FALSE, na.rm=TRUE), error="does not make sense")
962+
test(6000.4291, frollmax(x, n, hasNA=TRUE), c(NA,NA,NA,NA,NA,NaN,NA,NA))
963+
test(6000.4292, frollmax(x, n, hasNA=TRUE, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf))
964+
test(6000.4293, frollmax(x, n, algo="exact", hasNA=TRUE), c(NA,NA,NA,NA,NA,NaN,NA,NA))
965+
test(6000.4294, frollmax(x, n, algo="exact", hasNA=TRUE, na.rm=TRUE), c(NA,NA,-Inf,-Inf,-Inf,-Inf,-Inf,-Inf))
966+
x = c(NA,2,6,3,Inf,2,4,5) # Inf
967+
test(6000.4311, frollmax(x, n), c(NA,NA,NA,6,Inf,Inf,Inf,5))
968+
test(6000.4312, frollmax(x, n, na.rm=TRUE), c(NA,NA,6,6,Inf,Inf,Inf,5))
969+
test(6000.4313, frollmax(x, n, algo="exact"), c(NA,NA,NA,6,Inf,Inf,Inf,5))
970+
test(6000.4314, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA,6,6,Inf,Inf,Inf,5))
971+
test(6000.4321, frollmax(x, n, hasNA=FALSE), c(NA,NA,6,6,Inf,Inf,Inf,5)) ## expected incorrect results, see manual hasNA section for details, added in #5441
972+
test(6000.4322, frollmax(x, n, hasNA=FALSE, na.rm=TRUE), error="does not make sense")
973+
test(6000.4323, frollmax(x, n, algo="exact", hasNA=FALSE), c(NA,NA,6,6,Inf,Inf,Inf,5)) ## expected incorrect results, see manual hasNA section for details, added in #5441
974+
test(6000.4324, frollmax(x, n, algo="exact", hasNA=FALSE, na.rm=TRUE), error="does not make sense")
975+
test(6000.4331, frollmax(x, n, hasNA=TRUE), c(NA,NA,NA,6,Inf,Inf,Inf,5))
976+
test(6000.4332, frollmax(x, n, hasNA=TRUE, na.rm=TRUE), c(NA,NA,6,6,Inf,Inf,Inf,5))
977+
test(6000.4333, frollmax(x, n, algo="exact", hasNA=TRUE), c(NA,NA,NA,6,Inf,Inf,Inf,5))
978+
test(6000.4334, frollmax(x, n, algo="exact", hasNA=TRUE, na.rm=TRUE), c(NA,NA,6,6,Inf,Inf,Inf,5))
979+
x = c(NA,2,-Inf,3,Inf,2,4,5) # -Inf
980+
test(6000.4341, frollmax(x, n), c(NA,NA,NA,3,Inf,Inf,Inf,5))
981+
test(6000.4342, frollmax(x, n, na.rm=TRUE), c(NA,NA,2,3,Inf,Inf,Inf,5))
982+
test(6000.4343, frollmax(x, n, algo="exact"), c(NA,NA,NA,3,Inf,Inf,Inf,5))
983+
test(6000.4344, frollmax(x, n, algo="exact", na.rm=TRUE), c(NA,NA,2,3,Inf,Inf,Inf,5))
984+
test(6000.4351, frollmax(x, n, hasNA=FALSE), c(NA,NA,2,3,Inf,Inf,Inf,5)) ## expected incorrect results, see manual hasNA section for details, added in #5441
985+
test(6000.4352, frollmax(x, n, hasNA=FALSE, na.rm=TRUE), error="does not make sense")
986+
test(6000.4353, frollmax(x, n, algo="exact", hasNA=FALSE), c(NA,NA,2,3,Inf,Inf,Inf,5)) ## expected incorrect results, see manual hasNA section for details, added in #5441
987+
test(6000.4354, frollmax(x, n, algo="exact", hasNA=FALSE, na.rm=TRUE), error="does not make sense")
988+
test(6000.4361, frollmax(x, n, hasNA=TRUE), c(NA,NA,NA,3,Inf,Inf,Inf,5))
989+
test(6000.4362, frollmax(x, n, hasNA=TRUE, na.rm=TRUE), c(NA,NA,2,3,Inf,Inf,Inf,5))
990+
test(6000.4363, frollmax(x, n, algo="exact", hasNA=TRUE), c(NA,NA,NA,3,Inf,Inf,Inf,5))
991+
test(6000.4364, frollmax(x, n, algo="exact", hasNA=TRUE, na.rm=TRUE), c(NA,NA,2,3,Inf,Inf,Inf,5))
908992

909993
## partial
910994
x = 1:6/2
@@ -956,25 +1040,41 @@ makeNA = function(x, ratio=0.1, nf=FALSE) {
9561040
}
9571041
num = 6007.0
9581042
## against base to verify exactness of non-finite values, not handled in zoo
959-
rollfun = function(x, n, FUN, fill=NA_real_, na.rm=FALSE, nf.rm=FALSE) {
1043+
rollfun = function(x, n, FUN, fill=NA_real_, na.rm=FALSE, nf.rm=FALSE, partial=FALSE) {
9601044
ans = rep(fill, nx<-length(x))
9611045
f = match.fun(FUN)
9621046
if (nf.rm) x[is.infinite(x)] = NA_real_
963-
for (i in n:nx) ans[i] = f(x[(i-n+1):i], na.rm=na.rm)
1047+
for (i in seq_along(x)) {
1048+
ans[i] = if (i >= n)
1049+
f(x[(i-n+1):i], na.rm=na.rm)
1050+
else if (partial)
1051+
f(x[max((i-n+1), 1L):i], na.rm=na.rm)
1052+
else
1053+
as.double(fill)
1054+
}
9641055
ans
9651056
}
966-
base_compare = function(x, n, funs=c("mean","sum"), algos=c("fast","exact")) {
1057+
base_compare = function(x, n, funs=c("mean","sum","max"), algos=c("fast","exact")) {
9671058
num.step = 0.001
9681059
for (fun in funs) {
9691060
for (na.rm in c(FALSE, TRUE)) {
9701061
for (fill in c(NA_real_, 0)) {
971-
for (algo in algos) {
1062+
for (partial in c(FALSE,TRUE)) {
1063+
for (algo in algos) {
1064+
num <<- num + num.step
1065+
eval(substitute( # so we can have values displayed in output/log rather than variables
1066+
test(.num, ignore.warning="no non-missing arguments",
1067+
rollfun(x, n, FUN=.fun, fill=.fill, na.rm=.na.rm, nf.rm=.nf.rm, partial=.partial),
1068+
froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo, partial=.partial)),
1069+
list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .nf.rm=algo!="exact"&&fun!="max", .partial=partial)
1070+
))
1071+
}
9721072
num <<- num + num.step
9731073
eval(substitute( # so we can have values displayed in output/log rather than variables
974-
test(.num,
975-
froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo),
976-
rollfun(x, n, FUN=.fun, fill=.fill, na.rm=.na.rm, nf.rm=.nf.rm)),
977-
list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .nf.rm=algo!="exact")
1074+
test(.num, ignore.warning="no non-missing arguments",
1075+
frollapply(x, n, FUN=match.fun(.fun), fill=.fill, na.rm=.na.rm, partial=.partial),
1076+
froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo="exact", partial=.partial)), # change to fast after inf support
1077+
list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .partial=partial)
9781078
))
9791079
}
9801080
}
@@ -994,20 +1094,30 @@ num = 6008.0
9941094
#### against zoo
9951095
if (requireNamespace("zoo", quietly=TRUE)) {
9961096
drollapply = function(...) as.double(zoo::rollapply(...)) # rollapply is not consistent in data type of answer, force to double
997-
zoo_compare = function(x, n, funs=c("mean","sum"), algos=c("fast","exact")) {
1097+
zoo_compare = function(x, n, funs=c("mean","sum","max"), algos=c("fast","exact")) {
9981098
num.step = 0.0001
999-
#### fun, align, na.rm, fill, algo
1099+
#### fun, align, na.rm, fill, algo, partial
10001100
for (fun in funs) {
10011101
for (align in c("right","center","left")) {
10021102
for (na.rm in c(FALSE, TRUE)) {
10031103
for (fill in c(NA_real_, 0)) {
1004-
for (algo in algos) {
1104+
for (partial in c(FALSE,TRUE)) {
1105+
if (partial && align=="center") next
1106+
for (algo in algos) {
1107+
num <<- num + num.step
1108+
eval(substitute( # so we can have values displayed in output/log rather than variables
1109+
test(.num, ignore.warning="no non-missing arguments",
1110+
drollapply(x, n, FUN=.fun, fill=.fill, align=.align, na.rm=.na.rm, partial=.partial),
1111+
froll(.fun, x, n, align=.align, fill=.fill, na.rm=.na.rm, algo=.algo, partial=.partial)),
1112+
list(.num=num, .fun=fun, .align=align, .fill=fill, .na.rm=na.rm, .algo=algo, .partial=partial)
1113+
))
1114+
}
10051115
num <<- num + num.step
10061116
eval(substitute( # so we can have values displayed in output/log rather than variables
1007-
test(.num,
1008-
froll(.fun, x, n, align=.align, fill=.fill, na.rm=.na.rm, algo=.algo),
1009-
drollapply(x, n, FUN=.fun, fill=.fill, align=.align, na.rm=.na.rm)),
1010-
list(.num=num, .fun=fun, .align=align, .fill=fill, .na.rm=na.rm, .algo=algo)
1117+
test(.num, ignore.warning="no non-missing arguments",
1118+
frollapply(x, n, FUN=.fun, fill=.fill, align=.align, na.rm=.na.rm, partial=.partial),
1119+
froll(.fun, x, n, align=.align, fill=.fill, na.rm=.na.rm, algo="exact", partial=.partial)), # change to fast after inf support
1120+
list(.num=num, .fun=fun, .align=align, .fill=fill, .na.rm=na.rm, .partial=partial)
10111121
))
10121122
}
10131123
}
@@ -1045,33 +1155,51 @@ if (requireNamespace("zoo", quietly=TRUE)) {
10451155
}
10461156
#### adaptive moving average compare
10471157
num = 6009.0
1048-
arollfun = function(fun, x, n, na.rm=FALSE, fill=NA, nf.rm=FALSE) {
1158+
arollfun = function(FUN, x, n, na.rm=FALSE, align=c("right","left"), fill=NA, nf.rm=FALSE) { ## partial cannot be used with adaptive
10491159
# adaptive moving average in R
10501160
stopifnot((nx<-length(x))==length(n))
1051-
ans = rep(NA_real_, nx)
1161+
align = match.arg(align)
1162+
ans = rep(fill, nx)
10521163
if (nf.rm) x[is.infinite(x)] = NA_real_
1053-
FUN = match.fun(fun)
1054-
for (i in seq_along(x)) {
1055-
ans[i] = if (i >= n[i])
1056-
FUN(x[(i-n[i]+1):i], na.rm=na.rm)
1057-
else as.double(fill)
1164+
f = match.fun(FUN)
1165+
if (align=="right") {
1166+
for (i in seq_along(x)) {
1167+
if (i >= n[i])
1168+
ans[i] = f(x[(i-n[i]+1):i], na.rm=na.rm)
1169+
}
1170+
} else {
1171+
for (i in seq_along(x)) {
1172+
if (i <= nx-n[i]+1)
1173+
ans[i] = f(x[i:(i+n[i]-1)], na.rm=na.rm)
1174+
}
10581175
}
10591176
ans
10601177
}
1061-
afun_compare = function(x, n, funs=c("mean","sum"), algos=c("fast","exact")) {
1178+
afun_compare = function(x, n, funs=c("mean","sum","max"), algos=c("fast","exact")) {
10621179
num.step = 0.0001
1063-
#### fun, na.rm, fill, algo
1180+
#### fun, align, na.rm, fill, algo
10641181
for (fun in funs) {
1065-
for (na.rm in c(FALSE, TRUE)) {
1066-
for (fill in c(NA_real_, 0)) {
1067-
for (algo in algos) {
1068-
num <<- num + num.step
1069-
eval(substitute(
1070-
test(.num,
1071-
froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo, adaptive=TRUE),
1072-
arollfun(.fun, x, n, fill=.fill, na.rm=.na.rm, nf.rm=.nf.rm)),
1073-
list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .nf.rm=algo!="exact")
1074-
))
1182+
for (align in c("right","left")) {
1183+
for (na.rm in c(FALSE, TRUE)) {
1184+
for (fill in c(NA_real_, 0)) {
1185+
for (algo in algos) {
1186+
num <<- num + num.step
1187+
eval(substitute(
1188+
test(.num, ignore.warning="no non-missing arguments",
1189+
arollfun(.fun, x, n, fill=.fill, na.rm=.na.rm, nf.rm=.nf.rm, align=.align),
1190+
froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo=.algo, adaptive=TRUE, align=.align)),
1191+
list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .algo=algo, .nf.rm=algo!="exact"&&fun!="max", .align=align)
1192+
))
1193+
}
1194+
if (base::getRversion() >= "3.4.0") { ## SET_GROWABLE_BIT
1195+
num <<- num + num.step
1196+
eval(substitute(
1197+
test(.num, ignore.warning="no non-missing arguments",
1198+
frollapply(x, n, FUN=match.fun(.fun), fill=.fill, na.rm=.na.rm, adaptive=TRUE, align=.align),
1199+
froll(.fun, x, n, fill=.fill, na.rm=.na.rm, algo="exact", adaptive=TRUE, align=.align)), ## change to algo=fast when mean and sum will support Inf
1200+
list(.num=num, .fun=fun, .fill=fill, .na.rm=na.rm, .nf.rm=FALSE, .align=align)
1201+
))
1202+
}
10751203
}
10761204
}
10771205
}
@@ -1156,8 +1284,13 @@ f = function(x) {
11561284
options(datatable.verbose=FALSE)
11571285

11581286
# frollapply adaptive
1159-
test(6010.201, frollapply(1:3, c(3,3,3), sum, adaptive=TRUE), c(NA,NA,6))
1160-
#TODO tests
1287+
r340 = base::getRversion() >= "3.4.0" ## support SET_GROWABLE_BIT
1288+
if (!r340) {
1289+
test(6010.2, frollapply(1:3, c(3,3,3), sum, adaptive=TRUE), error="frollapply adaptive=TRUE requires at least R 3.4.0")
1290+
} else {
1291+
test(6010.201, frollapply(1:3, c(3,2,3), sum, adaptive=TRUE), c(NA,3,6))
1292+
test(6010.202, frollapply(1:3, c(4,4,4), sum, adaptive=TRUE), rep(NA_real_,3)) # none of the windows in k was small enough to cover length of x
1293+
}
11611294

11621295
#### test coverage
11631296
test(6010.501, frollapply(1:3, "b", sum), error="n must be integer")

0 commit comments

Comments
 (0)