Skip to content

Commit 7b57c82

Browse files
jangoreckijangorecki
committed
frollapply simplify more conservative
1 parent 6f225f3 commit 7b57c82

File tree

4 files changed

+161
-91
lines changed

4 files changed

+161
-91
lines changed

‎NEWS.md‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -177,20 +177,20 @@
177177
```r
178178
x = data.table(v1=rnorm(120), v2=rnorm(120))
179179
f = function(x) coef(lm(v2 ~ v1, data=x))
180-
coef.fill = c("(Intercept)"=NA_real_, "v1"=NA_real_)
181-
frollapply(x, 4, f, by.column=FALSE, fill=coef.fill)
180+
frollapply(x, 4, f, by.column=FALSE)
182181
# (Intercept) v1
182+
# <num> <num>
183183
# 1: NA NA
184184
# 2: NA NA
185185
# 3: NA NA
186-
# 4: 0.65456931 0.3138012
187-
# 5: -1.07977441 -2.0588094
186+
# 4: -0.04648236 -0.6349687
187+
# 5: 0.09208733 -0.4964023
188188
#---
189-
#116: 0.15828417 0.3570216
190-
#117: -0.09083424 1.5494507
191-
#118: -0.18345878 0.6424837
192-
#119: -0.28964772 0.6116575
193-
#120: -0.40598313 0.6112854
189+
#116: -0.21169439 0.7421358
190+
#117: -0.19729119 0.4926939
191+
#118: -0.04217896 0.0452713
192+
#119: 0.22472549 -0.5245874
193+
#120: 0.54540359 -0.1638333
194194
```
195195
- uses multiple CPU threads (on a decent OS); evaluation of UDF is inherently slow so this can be a great help.
196196
```r

‎R/frollapply.R‎

Lines changed: 106 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -1,57 +1,116 @@
1+
all_atomic = function(x) all(vapply_1b(x, is.atomic, use.names=FALSE))
2+
all_data.frame = function(x) all(vapply_1b(x, is.data.frame, use.names=FALSE))
3+
all_list = function(x) all(vapply_1b(x, is.list, use.names=FALSE))
4+
all_types = function(x) vapply_1c(x, typeof, use.names=FALSE)
5+
all_names = function(x) lapply(x, names)
6+
len_unq = function(x) length(unique(x))
7+
any_NA_neg = function(x) anyNA(x) || any(x < 0L)
8+
any_NA_names = function(x) anyNA(names(x))
9+
all_NULL_names = function(x) all(vapply_1b(x, function(y) is.null(names(y)), use.names=FALSE))
10+
equal.lengths = function(x) len_unq(lengths(x)) <= 1L
11+
equal.nrows = function(x) len_unq(lapply(x, nrow)) <= 1L
12+
equal.dims = function(x) len_unq(lapply(x, dim)) <= 1L
13+
equal.types = function(x) len_unq(all_types(x)) <= 1L
14+
equal.names = function(x) len_unq(all_names(x)) <= 1L
15+
116
## ansmask is to handle leading values from fill to match type of the ans
217
simplifylist = function(x, fill, ansmask) {
3-
all.t = vapply_1c(x, typeof, use.names=FALSE)
18+
all.t = all_types(x)
419
all.ut = unique(all.t)
520
if (length(all.ut) > 1L) {
6-
ans.t = vapply_1c(x[ansmask], typeof, use.names=FALSE)
7-
ans.ut = unique(ans.t)
8-
## ans postprocessing to match types
9-
if ((length(ans.ut) == 2L) && all(ans.ut %in% c("double","integer","logical"))) { ## align numeric and integer when function is not type stable: median #7313
10-
if ("double" %in% ans.ut) {
11-
if ("integer" %in% ans.ut)
12-
x[ansmask & all.t=="integer"] = lapply(x[ansmask & all.t=="integer"], as.numeric) ## coerce integer to double
13-
if ("logical" %in% ans.ut)
14-
x[ansmask & all.t=="logical"] = lapply(x[ansmask & all.t=="logical"], as.numeric) ## coerce logical to double
15-
ans.ut = "double"
16-
} else if ("integer" %in% ans.ut) {
17-
if ("logical" %in% ans.ut)
18-
x[ansmask & all.t=="logical"] = lapply(x[ansmask & all.t=="logical"], as.integer) ## coerce logical to integer
19-
else
20-
internal_error("simplifylist aligning return types, at that place there should have been some logical types in the answer") # nocov
21-
ans.ut = "integer"
22-
}
21+
ans.ut = unique(all_types(x[ansmask]))
22+
## coerce int to double when varies within answer results: median #7313
23+
if (
24+
length(ans.ut) == 2L && ## simplifylist(list(NA, 1, 1L, TRUE), NA, ansmask=c(F,T,T,T))
25+
all(c("double","integer") %in% ans.ut) && ## simplifylist(list(NA, 1, TRUE), NA, ansmask=c(F,T,T))
26+
equal.lengths(x[ansmask]) ## simplifylist(list(NA, 1, 1:2), NA, ansmask=c(F,T,T))
27+
) {
28+
x[ansmask & all.t=="integer"] = lapply(x[ansmask & all.t=="integer"], as.numeric) ## coerce integer to double
29+
ans.ut = "double"
2330
}
24-
## file postprocessing to match types
25-
if (length(ans.ut) == 1L && equal.lengths(x[ansmask])) {
26-
if (identical(fill, NA)) { ## different typeof of ans and default fill=NA and lengths of ans equal
27-
filli = which(!ansmask)
28-
ans1 = x[[which.first(ansmask)]] ## first ans from full window
29-
x[filli] = rep_len(list(ans1[NA]), length(filli)) ## this will make NA of matching type to ans1 and recycle for all filli
30-
all.ut = ans.ut
31-
} else if (typeof(fill) != ans.ut && all(c(typeof(fill), ans.ut) %in% c("double","integer","logical"))) { ## fill=-2, ans=1L
32-
filli = which(!ansmask)
33-
cast = switch(ans.ut, double = as.numeric, integer = as.integer, logical = as.logical)
34-
x[filli] = rep_len(list(cast(fill)), length(filli))
35-
all.ut = ans.ut
31+
## coerce fill to answers type and length
32+
if (
33+
length(ans.ut) == 1L && ## simplifylist(list(NA, 1, TRUE), NA, ansmask=c(F,T,T))
34+
equal.lengths(x[ansmask]) && ## simplifylist(list(NA, 1L, 1:2), NA, ansmask=c(F,T,T))
35+
is.atomic(fill) ## simplifylist(list(list(NA), list(1), list(2)), list(NA), ansmask=c(F,T,T))
36+
) {
37+
fill.t = typeof(fill)
38+
ans1 = x[[which.first(ansmask)]] ## first ans from full window, all ans same type by now
39+
## coerce fill to type
40+
if (identical(fill, NA)) {
41+
if (ans.ut == "list") {
42+
fill = lapply(ans1, `[`, NA) ## we want list(NA) rather than list(NULL), this also propagates names
43+
} else {
44+
fill = setNames(ans1[NA], names(ans1))
45+
}
46+
fill.t = ans.ut
47+
} else if (
48+
fill.t != ans.ut && ## simplifylist(list(-1, 1, 2), -1, ansmask=c(F,T,T))
49+
fill.t %in% c("double","integer") && ## simplifylist(list(NULL, 1, 2), NULL, ansmask=c(F,T,T))
50+
ans.ut %in% c("double","integer") ## simplifylist(list(1, "a", "b"), 1, ansmask=c(F,T,T))
51+
) { ## fill=-2, ans=1L
52+
if (fill.t == "integer" && ans.ut == "double") {
53+
fill = as.double(fill)
54+
} else if (fill.t == "double" && ans.ut == "integer") {
55+
fill = as.integer(fill)
56+
} else {
57+
internal_error("coerce fill type reached a branch of unexpected fill type and answer type") # nocov
58+
}
59+
fill.t = ans.ut
3660
}
61+
## name fill if all ans have same names
62+
if (
63+
ans.ut != "list" &&
64+
is.null(names(fill)) &&
65+
!is.null(names(ans1)) && ## simplifylist(list(NA, c(1,2), c(1,2)), NA, ansmask=c(F,T,T))
66+
len_unq(vapply_1b(x[ansmask], any_NA_names, use.names=FALSE)) <= 1L && ## simplifylist(list(NA, c(a=1,b=2), setNames(c(1, 2), c(NA,"b"))), NA, ansmask=c(F,T,T))
67+
equal.names(x[ansmask]) ## simplifylist(list(NA, c(a=1,b=2), c(x=1,y=2)), NA, ansmask=c(F,T,T))
68+
) {
69+
fill = setNames(fill, names(ans1))
70+
}
71+
## recycle fill
72+
filli = which(!ansmask)
73+
x[filli] = rep_len(list(fill), length(filli))
3774
}
75+
all.ut = unique(all_types(x))
76+
}
77+
if (
78+
!is.null(names(fill)) &&
79+
all_NULL_names(x[ansmask]) &&
80+
equal.lengths(x)
81+
) {
82+
nm = names(fill)
83+
x[ansmask] = lapply(x[ansmask], `names<-`, nm)
3884
}
39-
all.ut = unique(vapply_1c(x, typeof, use.names=FALSE))
40-
if ((length(all.ut) == 1L) && all(all.ut %in% c("integer","logical","double","complex","character","raw"))) {
41-
if (identical(unique(lengths(x)), 1L)) { ## length 1
42-
return(unlist(x, recursive=FALSE, use.names=FALSE))
43-
} else if (equal.lengths(x)) { ## length 2+ and equal
44-
return(rbindlist(lapply(x, as.list)))
85+
if (length(all.ut) == 1L) {
86+
if (all.ut %in% c("integer","logical","double","complex","character","raw")) {
87+
if (identical(unique(lengths(x)), 1L)) { ## all length 1
88+
return(unlist(x, recursive=FALSE, use.names=FALSE))
89+
} else if (
90+
equal.lengths(x) &&
91+
equal.names(x)
92+
) { ## length 2+ and equal
93+
return(rbindlist(lapply(x, as.list)))
94+
}
95+
} else if (identical(all.ut,"list")) {
96+
if (
97+
all_data.frame(x) && ## simplifylist(list(NA, list(a=1L, b=2L), data.table(a=1L, b=2L)), NA, ansmask=c(F,T,T))
98+
equal.dims(x) && ## simplifylist(list(NA, data.table(a=1L, b=2L), data.table(a=1L)), NA, ansmask=c(F,T,T))
99+
equal.types(x) && ## simplifylist(list(NA, data.table(a=1L, b=2L), data.table(a=1L, b="b")), NA, ansmask=c(F,T,T))
100+
equal.names(x) ## simplifylist(list(NA, data.table(a=1L, b=2L), data.table(x=1L, y=2L)), NA, ansmask=c(F,T,T))
101+
) {
102+
return(rbindlist(x))
103+
} else if (
104+
equal.lengths(x) &&
105+
len_unq(lapply(x, lengths, use.names=FALSE)) <= 1L && ## nested lengths
106+
len_unq(lapply(lapply(x, unlist, recursive=FALSE, use.names=FALSE), typeof)) <= 1L &&
107+
equal.names(x)
108+
) { ## same length lists: list(list(1:2, 1:2), list(2:3, 2:3))
109+
return(rbindlist(x)) ## simplifylist(list(NA, list(1:2, 1:2), list(2:3, 2:3)), NA, ansmask=c(F,T,T))
110+
}
45111
}
46-
} else if (identical(all.ut, "list")) {
47-
if (all_data.frame(x)) ## list(data.table(...), data.table(...))
48-
return(rbindlist(x))
49-
if (equal.lengths(x)) ## same length lists: list(list(1:2, 1:2), list(2:3, 2:3))
50-
return(rbindlist(x))
51112
}
52-
## not simplified, return as is
53-
# not length stable
54-
# not type stable
113+
## not simplified, return as is, see #7317
55114
# NULL, closure, special, builtin, environment, S4, ...
56115
x
57116
}
@@ -65,13 +124,6 @@ fixselfref = function(x) {
65124
x
66125
}
67126

68-
all_atomic = function(x) all(vapply_1b(x, is.atomic, use.names=FALSE))
69-
all_data.frame = function(x) all(vapply_1b(x, is.data.frame, use.names=FALSE))
70-
all_list = function(x) all(vapply_1b(x, is.list, use.names=FALSE))
71-
equal.lengths = function(x) length(unique(lengths(x))) <= 1L
72-
equal.nrows = function(x) length(unique(vapply(x, nrow, 0L))) <= 1L
73-
anyNAneg = function(x) anyNA(x) || any(x < 0L)
74-
75127
frollapply = function(X, N, FUN, ..., by.column=TRUE, fill=NA, align=c("right","left","center"), adaptive=FALSE, partial=FALSE, give.names=FALSE, simplify=TRUE, x, n) {
76128
if (!missing(x)) {
77129
warningf("'x' is deprecated in frollapply, use 'X' instead")
@@ -159,7 +211,7 @@ frollapply = function(X, N, FUN, ..., by.column=TRUE, fill=NA, align=c("right","
159211
nnam = names(N) ## used for give.names
160212
if (!is.integer(N))
161213
N = as.integer(N)
162-
if (anyNAneg(N))
214+
if (any_NA_neg(N))
163215
stopf("'N' must be non-negative integer values (>= 0)")
164216
nn = length(N) ## top level loop for vectorized n
165217
} else {
@@ -170,7 +222,7 @@ frollapply = function(X, N, FUN, ..., by.column=TRUE, fill=NA, align=c("right","
170222
stopf("length of integer vector(s) provided as list to 'N' argument must be equal to number of observations provided in 'X'")
171223
if (!is.integer(N))
172224
N = as.integer(N)
173-
if (anyNAneg(N))
225+
if (any_NA_neg(N))
174226
stopf("'N' must be non-negative integer values (>= 0)")
175227
nn = 1L
176228
N = list(N)
@@ -184,7 +236,7 @@ frollapply = function(X, N, FUN, ..., by.column=TRUE, fill=NA, align=c("right","
184236
stopf("'N' must be an integer vector or list of integer vectors")
185237
if (!all(vapply_1b(N, is.integer, use.names=FALSE)))
186238
N = lapply(N, as.integer)
187-
if (any(vapply_1b(N, anyNAneg, use.names=FALSE)))
239+
if (any(vapply_1b(N, any_NA_neg, use.names=FALSE)))
188240
stopf("'N' must be non-negative integer values (>= 0)")
189241
nn = length(N)
190242
nnam = names(N)

‎inst/tests/froll.Rraw‎

Lines changed: 30 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1580,9 +1580,9 @@ test(6010.103, frollapply(c(1,2,1,1,1,2,3,2), 3, uniqueN), c(NA,NA,2L,2L,1L,2L,3
15801580
test(6010.104, frollapply(c(1,2,1,1,NA,2,NA,2), 3, anyNA), c(NA,NA,FALSE,FALSE,TRUE,TRUE,TRUE,TRUE))
15811581
f = function(x) {
15821582
n = length(x) # double type will be returned only for first iteration
1583-
if (n==x[n]) 1 else NA # NA logical coerced properly
1583+
if (n==x[n]) 1 else NA
15841584
}
1585-
test(6010.105, frollapply(1:5, 3, f), c(NA,NA,1,NA,NA))
1585+
test(6010.105, frollapply(1:5, 3, f), list(NA,NA,1,NA,NA)) ## this demands user to write type aware NA inside FUN, which is mentioned as recommendation in ?frollapply
15861586

15871587
## partial
15881588
x = 1:6/2
@@ -1737,8 +1737,15 @@ test(6010.621, as.data.table(iris)[, "flow" := frollapply(.(Sepal.Length, Sepal.
17371737
test(6010.622, as.data.table(iris)[, "flow" := frollapply(data.frame(Sepal.Length, Sepal.Width), 2L, flow, by.column=FALSE), by = Species]$flow[idx], ans)
17381738
test(6010.623, as.data.table(iris)[, "flow" := unlist(lapply(split(data.frame(Sepal.Length, Sepal.Width), Species), frollapply, 2L, flow, by.column=FALSE))]$flow[idx], ans)
17391739
f = function(l) as.list(range(l[[1L]])-range(l[[2L]]))
1740-
test(6010.624, frollapply(list(1:5, 5:1), c(2,2,3,3,4), f, adaptive=TRUE, by.column=FALSE, fill=list(NA,NA)), data.table(V1=c(NA,-3L,-2L,0L,1L), V2=c(NA,-3L,-2L,0L,1L)))
1741-
test(6010.625, frollapply(list(1:5, 5:1), c(2,2,3,3,4), f, align="left", adaptive=TRUE, by.column=FALSE, fill=list(NA,NA)), data.table(V1=c(-3L,-1L,2L,NA,NA), V2=c(-3L,-1L,2L,NA,NA)))
1740+
test(6010.624, frollapply(list(1:5, 5:1), c(2,2,3,3,4), f, adaptive=TRUE, by.column=FALSE, fill=list(NA,NA)), list(list(NA, NA), list(-3L, -3L), list(-2L, -2L), list(0L, 0L), list(1L, 1L)))
1741+
test(6010.6241, frollapply(list(1:5, 5:1), c(2,2,3,3,4), f, adaptive=TRUE, by.column=FALSE), data.table(V1=c(NA,-3L,-2L,0L,1L), V2=c(NA,-3L,-2L,0L,1L)))
1742+
f = function(l) range(l[[1L]])-range(l[[2L]])
1743+
test(6010.6242, frollapply(list(1:5, 5:1), c(2,2,3,3,4), f, adaptive=TRUE, by.column=FALSE), data.table(V1=c(NA,-3L,-2L,0L,1L), V2=c(NA,-3L,-2L,0L,1L)))
1744+
f = function(l) as.list(range(l[[1L]])-range(l[[2L]]))
1745+
test(6010.625, frollapply(list(1:5, 5:1), c(2,2,3,3,4), f, align="left", adaptive=TRUE, by.column=FALSE, fill=list(NA,NA)), list(list(-3L, -3L), list(-1L, -1L), list(2L, 2L), list(NA, NA), list(NA, NA)))
1746+
test(6010.6251, frollapply(list(1:5, 5:1), c(2,2,3,3,4), f, align="left", adaptive=TRUE, by.column=FALSE), data.table(V1 = c(-3L, -1L, 2L, NA, NA), V2 = c(-3L, -1L, 2L, NA, NA)))
1747+
f = function(l) range(l[[1L]])-range(l[[2L]])
1748+
test(6010.6252, frollapply(list(1:5, 5:1), c(2,2,3,3,4), f, align="left", adaptive=TRUE, by.column=FALSE), data.table(V1=c(-3L,-1L,2L,NA,NA), V2=c(-3L,-1L,2L,NA,NA)))
17421749
#### list of df/lists
17431750
x = list(data.table(x=1:2, y=2:3), data.table(z=3:5))
17441751
test(6010.631, frollapply(x, 2, tail, 1, by.column=FALSE, fill=data.table(), simplify=function(x) rbindlist(x, fill=TRUE)), list(data.table(x=2L, y=3L), data.table(z=4:5)))
@@ -1773,7 +1780,14 @@ test(6010.705, frollapply(1:5, 2, range, simplify=FALSE), list(NA,1:2,2:3,3:4,4:
17731780
test(6010.706, frollapply(1:5, 2, range, fill=c(NA_integer_,NA_integer_)), data.table(V1=c(NA,1:4), V2=c(NA,2:5)))
17741781
test(6010.707, frollapply(1:5, 2, range, fill=c(min=NA_integer_, max=NA_integer_)), data.table(min=c(NA,1:4), max=c(NA,2:5)))
17751782
test(6010.708, frollapply(1:5, 2, range, fill=c(min=NA_integer_, max=NA_integer_), simplify=function(x) rbindlist(lapply(x, as.list))), data.table(min=c(NA,1:4), max=c(NA,2:5)))
1776-
test(6010.709, frollapply(1:5, 2, function(x) as.list(range(x)), fill=list(min=NA_integer_, max=NA_integer_)), data.table(min=c(NA,1:4), max=c(NA,2:5)))
1783+
test(6010.7091, frollapply(1:5, 2, function(x) as.list(range(x))), data.table(c(NA,1:4), c(NA,2:5)))
1784+
test(6010.7092, frollapply(1:5, 2, function(x) as.list(range(x)), fill=list(min=NA_integer_, max=NA_integer_)), data.table(min=c(NA,1:4), max=c(NA,2:5)))
1785+
test(6010.7093, frollapply(1:5, 2, function(x) as.list(setNames(range(x), c("min","max")))), data.table(min=c(NA,1:4), max=c(NA,2:5)))
1786+
test(6010.7094, frollapply(1:5, 2, function(x) as.list(setNames(range(x), c("v1","v2"))), fill=list(min=NA_integer_, max=NA_integer_)), list(list(min = NA_integer_, max = NA_integer_), list(v1 = 1L, v2 = 2L), list(v1 = 2L, v2 = 3L), list(v1 = 3L, v2 = 4L), list(v1 = 4L, v2 = 5L)))
1787+
test(6010.7095, frollapply(1:5, 2, function(x) range(x)), data.table(c(NA,1:4), c(NA,2:5)))
1788+
test(6010.7096, frollapply(1:5, 2, function(x) range(x), fill=c(min=NA_integer_, max=NA_integer_)), data.table(min=c(NA,1:4), max=c(NA,2:5)))
1789+
test(6010.7097, frollapply(1:5, 2, function(x) setNames(range(x), c("min","max"))), data.table(min=c(NA,1:4), max=c(NA,2:5)))
1790+
test(6010.7098, frollapply(1:5, 2, function(x) setNames(range(x), c("v1","v2")), fill=c(min=NA_integer_, max=NA_integer_)), list(c(min = NA_integer_, max = NA_integer_), c(v1=1L, v2=2L), c(v1=2L, v2=3L), c(v1=3L, v2=4L), c(v1=4L, v2=5L)))
17771791
test(6010.710, frollapply(1:5, 2, function(x) as.list(range(x)), fill=list(min=NA_integer_, max=NA_integer_), simplify=rbindlist), data.table(min=c(NA,1:4), max=c(NA,2:5)))
17781792
test(6010.711, frollapply(1:5, 2, function(x) as.list(range(x)), fill=list(NA_integer_, NA_integer_), simplify=FALSE), list(list(NA_integer_, NA_integer_), as.list(1:2), as.list(2:3), as.list(3:4), as.list(4:5)))
17791793
test(6010.712, as.null(frollapply(1:3, 1, function(x) if (x==1L) sum else if (x==2L) mean else `[`, simplify=TRUE)), NULL) ## as.null as we are only interested in codecov here
@@ -1783,27 +1797,29 @@ test(6010.751, frollapply(FUN=median, adaptive=TRUE, list(1:3,2:4), list(c(2,0,2
17831797
test(6010.752, frollapply(FUN=median, adaptive=TRUE, 1:3, c(2,0,2), fill=99), c(99,NA_real_,2.5))
17841798
test(6010.753, frollapply(FUN=median, adaptive=TRUE, c(1L,2L,4L), c(2,0,2), fill=99L), c(99,NA_real_,3))
17851799
test(6010.754, frollapply(FUN=median, adaptive=TRUE, c(1L,2L,3L), c(2,0,2), fill=99), c(99,NA_real_,2.5))
1786-
test(6010.755, frollapply(1:2, 1, function(i) if (i==1L) 1L else FALSE), c(1L,0L))
1787-
test(6010.756, frollapply(1:3, 2, fill=9, function(i) if (i[1L]==1L) 1L else FALSE), c(9L,1L,0L)) ## matches fun answer
1788-
test(6010.757, frollapply(1:3, 2, fill=9L, function(i) if (i[1L]==1L) 1 else FALSE), c(9,1,0)) ## matches fun answer
1789-
test(6010.758, frollapply(1:3, 2, fill=0, function(i) TRUE), c(FALSE,TRUE,TRUE)) ## matches fun answer
1800+
test(6010.755, frollapply(1:2, 1, function(i) if (i==1L) 1L else NA), list(1L,NA))
1801+
test(6010.756, frollapply(1:3, 2, fill=9, function(i) if (i[1L]==1L) 1L else NA), list(9,1L,NA))
1802+
test(6010.757, frollapply(1:3, 2, fill=9, function(i) if (i[1L]==1L) 1L else 2L), c(9L,1L,2L)) ## matches fun answer
1803+
test(6010.758, frollapply(1:3, 2, fill=9L, function(i) if (i[1L]==1L) 1 else FALSE), list(9L,1,FALSE))
1804+
test(6010.759, frollapply(1:3, 2, fill=0, function(i) TRUE), list(0,TRUE,TRUE))
17901805

17911806
#### mutlithreading throttle caveats from manual: copy, fixing .internal.selfref
17921807
use.fork = .Platform$OS.type!="windows" && getDTthreads()>1L
17931808
if (use.fork) {
1794-
setDTthreads(throttle=1) ## disable throttle
17951809
old = setDTthreads(1)
17961810
test(6010.761, frollapply(c(1, 9), N=1L, FUN=identity), c(9,9)) ## unexpected
17971811
test(6010.762, frollapply(c(1, 9), N=1L, FUN=list), data.table(V1=c(9,9))) ## unexpected
1798-
setDTthreads(2)
1812+
setDTthreads(2, throttle=1) ## disable throttle
17991813
test(6010.763, frollapply(c(1, 9), N=1L, FUN=identity), c(1,9)) ## good only because threads >= input
18001814
test(6010.764, frollapply(c(1, 5, 9), N=1L, FUN=identity), c(5,5,9)) ## unexpected again
18011815
is.ok = function(x) {stopifnot(is.data.table(x)); capture.output(print(attr(x, ".internal.selfref", TRUE)))!="<pointer: (nil)>"}
1816+
ans = frollapply(1:2, 2, data.table)
1817+
test(6010.769, is.ok(ans)) ## frollapply will fix DT in most cases
18021818
ans = frollapply(1:2, 2, data.table, simplify=FALSE) ## default: fill=NA
18031819
test(6010.770, is.ok(ans[[2L]])) ## frollapply detected DT and fixed
1804-
ans = frollapply(1:2, 2, data.table, fill=data.table(NA)) ## fill type match
1820+
ans = frollapply(1:2, 2, data.table, fill=data.table(c(NA,NA))) ## fill size match
18051821
test(6010.771, is.ok(ans)) ## simplify=TRUE did run rbindlist, but frollapply fixed anyway
1806-
ans = frollapply(1:2, 2, data.table, fill=data.table(NA), simplify=FALSE)
1822+
ans = frollapply(1:2, 2, data.table, fill=data.table(NA)) ## fill size not match, no rbindlist, but frollapply fixed anyway
18071823
test(6010.772, is.ok(ans[[2L]]))
18081824
ans = frollapply(1:2, 2, function(x) list(data.table(x)), fill=list(data.table(NA)), simplify=FALSE)
18091825
test(6010.773, !is.ok(ans[[2L]][[1L]]))
@@ -1817,7 +1833,7 @@ if (use.fork) {
18171833
test(6010.776, !is.ok(ans[[3L]]))
18181834
ans = frollapply(1:3, 2, f, fill=data.table(NA), simplify=function(x) lapply(x, function(y) if (is.data.table(y)) setDT(y) else y))
18191835
test(6010.777, is.ok(ans[[3L]])) ## fix inside frollapply via simplify
1820-
setDTthreads(throttle=1024) ## re-enable throttle
1836+
setDTthreads(old, throttle=1024) ## re-enable throttle
18211837
}
18221838

18231839
## partial adaptive

0 commit comments

Comments
 (0)