Skip to content

Commit 6e5c583

Browse files
jangoreckijangorecki
authored
internal helper make.roll.names - split from frollapply rewrite (#7269)
* put logic into internal helper make.roll.names * use correct function name * solve codecov
1 parent f7263a3 commit 6e5c583

File tree

2 files changed

+112
-33
lines changed

2 files changed

+112
-33
lines changed

‎R/froll.R‎

Lines changed: 46 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -68,10 +68,52 @@ partial2adaptive = function(x, n, align, adaptive) {
6868
}
6969
}
7070

71+
# internal helper for handling give.names=TRUE
72+
make.roll.names = function(x.len, n.len, n, x.nm, n.nm, fun, adaptive) {
73+
if (is.null(n.nm)) {
74+
if (!adaptive) {
75+
if (!is.numeric(n))
76+
stopf("internal error: misuse of make.roll.names, n must be numeric for !adaptive") ## nocov
77+
n.nm = paste0("roll", fun, as.character(as.integer(n)))
78+
} else {
79+
n.nm = paste0("aroll", fun, seq_len(n.len))
80+
}
81+
} else if (!length(n.nm) && !adaptive)
82+
stopf("internal error: misuse of make.roll.names, non-null length 0 n is not possible for !adaptive") ## nocov
83+
if (is.null(x.nm)) {
84+
x.nm = paste0("V", seq_len(x.len))
85+
}
86+
ans = if (length(x.nm)) { ## is.list(x) && !is.data.frame(x)
87+
if (length(n.nm)) { ## !adaptive || is.list(n)
88+
paste(rep(x.nm, each=length(n.nm)), n.nm, sep="_")
89+
} else { ## adaptive && is.numeric(n)
90+
x.nm
91+
}
92+
} else { ## (by.column && is.atomic(x)) || (!by.column && is.data.frame(x))
93+
if (length(n.nm)) { ## !adaptive || is.list(n)
94+
n.nm
95+
} else { ## adaptive && is.numeric(n)
96+
NULL # nocov ## call to make.roll.names is excluded by is.list(ans) condition before calling it, it will be relevant for !by.column in next PR
97+
}
98+
}
99+
if (!is.null(ans) && length(ans) != x.len*n.len)
100+
stopf("internal error: make.roll.names generated names of wrong length") ## nocov
101+
ans
102+
}
103+
71104
froll = function(fun, x, n, fill=NA, algo, align=c("right","left","center"), na.rm=FALSE, has.nf=NA, adaptive=FALSE, partial=FALSE, FUN, rho, give.names=FALSE) {
72105
align = match.arg(align)
73-
if (isTRUE(give.names))
74-
orig = list(n=n, adaptive=adaptive)
106+
if (isTRUE(give.names)) {
107+
orig = list(n=n, adaptive=adaptive)
108+
xnam = if (is.list(x)) names(x) else character()
109+
nnam = if (isTRUE(adaptive)) {
110+
if (is.list(n)) names(n) else character()
111+
} else names(n)
112+
nx = if (is.list(x)) length(x) else 1L
113+
nn = if (isTRUE(adaptive)) {
114+
if (is.list(n)) length(n) else 1L
115+
} else length(n)
116+
}
75117
if (isTRUE(partial)) {
76118
n = partial2adaptive(x, n, align, adaptive)
77119
adaptive = TRUE
@@ -96,13 +138,8 @@ froll = function(fun, x, n, fill=NA, algo, align=c("right","left","center"), na.
96138
ans = rev2(ans)
97139
}
98140
if (isTRUE(give.names) && is.list(ans)) {
99-
n = orig$n
100-
adaptive = orig$adaptive
101-
nx = names(x)
102-
nn = names(n)
103-
if (is.null(nx)) nx = paste0("V", if (is.atomic(x)) 1L else seq_along(x))
104-
if (is.null(nn)) nn = if (adaptive) paste0("N", if (is.atomic(n)) 1L else seq_along(n)) else paste("roll", as.character(n), sep="_")
105-
setattr(ans, "names", paste(rep(nx, each=length(nn)), nn, sep="_"))
141+
nms = make.roll.names(x.len=nx, n.len=nn, n=orig$n, x.nm=xnam, n.nm=nnam, fun=fun, adaptive=orig$adaptive)
142+
setattr(ans, "names", nms)
106143
}
107144
ans
108145
}

‎inst/tests/froll.Rraw‎

Lines changed: 66 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -1053,30 +1053,72 @@ test(6006.9335, frollsum(1:4, list(c(1,1,3,2), c("a","b","c","d")), adaptive=TRU
10531053
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'")
10541054

10551055
## give.names
1056-
test(6006.951, frollsum(1:3, 2, give.names=TRUE), c(NA,3,5))
1057-
test(6006.952, frollsum(1:3, c(b=2), give.names=TRUE), c(NA,3,5))
1058-
test(6006.953, frollsum(c(a1=1,a2=2,a3=3), c(b=2), give.names=TRUE), c(NA,3,5))
1059-
test(6006.954, frollsum(list(a=1:3), c(b=2), give.names=TRUE), list(a_b=c(NA,3,5)))
1060-
test(6006.955, frollsum(list(a=1:3), c(2), give.names=TRUE), list(a_roll_2=c(NA,3,5)))
1061-
test(6006.956, frollsum(list(a=1:3, b=3:1), c(2), give.names=TRUE), list(a_roll_2=c(NA,3,5), b_roll_2=c(NA,5,3)))
1062-
test(6006.957, frollsum(list(a=1:3, b=3:1), c(small=2, big=3), give.names=TRUE), list(a_small=c(NA,3,5), a_big=c(NA,NA,6), b_small=c(NA,5,3), b_big=c(NA,NA,6)))
1063-
test(6006.958, frollapply(FUN=sum, list(a=1:3, b=3:1), c(small=2, big=3), give.names=TRUE), list(a_small=c(NA,3,5), a_big=c(NA,NA,6), b_small=c(NA,5,3), b_big=c(NA,NA,6)))
1064-
test(6006.959, frollsum(list(1:3, 3:1), c(small=2, big=3), give.names=TRUE), list(V1_small=c(NA,3,5), V1_big=c(NA,NA,6), V2_small=c(NA,5,3), V2_big=c(NA,NA,6)))
1065-
test(6006.960, frollsum(list(1:3, 3:1), c(2, 3), give.names=TRUE), list(V1_roll_2=c(NA,3,5), V1_roll_3=c(NA,NA,6), V2_roll_2=c(NA,5,3), V2_roll_3=c(NA,NA,6)))
1066-
test(6006.961, frollsum(list(1:3, 3:1), list(c(2,2,2), 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,3), V2_N2=c(NA,NA,6)))
1067-
test(6006.962, frollsum(list(a=1:3, b=3:1), list(small=c(2,2,2), big=c(3,3,3)), adaptive=TRUE, give.names=TRUE), list(a_small=c(NA,3,5), a_big=c(NA,NA,6), b_small=c(NA,5,3), b_big=c(NA,NA,6)))
1068-
test(6006.963, frollsum(list(a=1:3, b=3:1), list(small=c(2,2,2)), adaptive=TRUE, give.names=TRUE), list(a_small=c(NA,3,5), b_small=c(NA,5,3)))
1069-
test(6006.964, frollsum(list(a=1:3, b=3:1), c(2,2,2), adaptive=TRUE, give.names=TRUE), list(a_N1=c(NA,3,5), b_N1=c(NA,5,3)))
1070-
test(6006.965, frollsum(list(a=1:3), c(2,2,2), adaptive=TRUE, give.names=TRUE), list(a_N1=c(NA,3,5)))
1071-
test(6006.966, frollsum(list(1:3), c(2,2,2), adaptive=TRUE, give.names=TRUE), list(V1_N1=c(NA,3,5)))
1072-
test(6006.967, frollsum(1:3, c(2,2,2), adaptive=TRUE, give.names=TRUE), c(NA,3,5))
1073-
test(6006.968, frollsum(list(a=1:3), c(b=2), partial=TRUE, give.names=TRUE), list(a_b=c(1,3,5)))
1074-
test(6006.969, frollsum(list(a=1:3, b=3:1), c(small=2, big=3), partial=TRUE, give.names=TRUE), list(a_small=c(1,3,5), a_big=c(1,3,6), b_small=c(3,5,3), b_big=c(3,5,6)))
1075-
test(6006.970, frollsum(list(a=1:3), 2, partial=TRUE, give.names=TRUE), list(a_roll_2=c(1,3,5)))
1076-
test(6006.971, frollsum(list(1:3), 2, partial=TRUE, give.names=TRUE), list(V1_roll_2=c(1,3,5)))
1077-
test(6006.972, frollsum(list(1:3), c(b=2), partial=TRUE, give.names=TRUE), list(V1_b=c(1,3,5)))
1078-
test(6006.973, frollsum(list(1:3), 2, partial=TRUE, give.names=TRUE), list(V1_roll_2=c(1,3,5)))
1079-
test(6006.974, frollsum(list(1:3, 3:1), c(2, 3), partial=TRUE, give.names=TRUE), list(V1_roll_2=c(1,3,5), V1_roll_3=c(1,3,6), V2_roll_2=c(3,5,3), V2_roll_3=c(3,5,6)))
1056+
test(6006.9511, frollsum(c(1,2,3), 2, give.names=TRUE), c(NA,3,5))
1057+
test(6006.9512, frollsum(c(1,2,3), c(b=2), give.names=TRUE), c(NA,3,5))
1058+
test(6006.9513, frollsum(c(a1=1,a2=2,a3=3), c(b=2), give.names=TRUE), c(NA,3,5))
1059+
test(6006.9514, frollsum(c(a1=1,a2=2,a3=3), 2, give.names=TRUE), c(NA,3,5))
1060+
test(6006.952, frollsum(list(c(1,2,3)), 2, give.names=TRUE), list(V1_rollsum2=c(NA,3,5)))
1061+
test(6006.953, frollsum(list(x1=c(1,2,3)), 2, give.names=TRUE), list(x1_rollsum2=c(NA,3,5)))
1062+
test(6006.954, frollsum(list(c(1,2,3)), c(n1=2), give.names=TRUE), list(V1_n1=c(NA,3,5)))
1063+
test(6006.955, frollsum(list(x1=c(1,2,3)), c(n1=2), give.names=TRUE), list(x1_n1=c(NA,3,5)))
1064+
test(6006.956, frollsum(c(1,2,3), 2:3, give.names=TRUE), list(rollsum2=c(NA,3,5), rollsum3=c(NA,NA,6)))
1065+
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)))
1066+
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)))
1067+
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)))
1068+
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)))
1069+
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)))
1070+
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)))
1071+
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)))
1072+
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)))
1073+
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)))
1074+
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)))
1075+
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)))
1076+
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)))
1077+
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)))
1078+
test(6006.971, frollsum(c(1,2,3), c(2,2,2), adaptive=TRUE, give.names=TRUE), c(NA,3,5)) ## adaptive
1079+
test(6006.972, frollsum(c(1,2,3), list(c(2,2,2)), adaptive=TRUE, give.names=TRUE), c(NA,3,5))
1080+
test(6006.973, frollsum(list(c(1,2,3)), c(2,2,2), adaptive=TRUE, give.names=TRUE), list(V1=c(NA,3,5)))
1081+
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)))
1082+
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)))
1083+
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)))
1084+
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)))
1085+
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)))
1086+
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)))
1087+
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)))
1088+
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)))
1089+
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)))
1090+
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)))
1091+
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)))
1092+
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)))
1093+
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)))
1094+
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)))
1095+
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)))
1096+
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)))
1097+
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)))
1098+
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)))
1099+
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)))
1100+
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)))
1101+
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)))
1102+
test(6006.9950, frollsum(c(1,2,3), 2, partial=TRUE, give.names=TRUE), c(1,3,5)) ## partial
1103+
test(6006.9951, frollsum(c(1,2,3), c(n1=2), partial=TRUE, give.names=TRUE), c(1,3,5))
1104+
test(6006.9952, frollsum(list(c(1,2,3)), 2, partial=TRUE, give.names=TRUE), list(V1_rollsum2=c(1,3,5)))
1105+
test(6006.9953, frollsum(list(x1=c(1,2,3)), 2, partial=TRUE, give.names=TRUE), list(x1_rollsum2=c(1,3,5)))
1106+
test(6006.9954, frollsum(list(c(1,2,3)), c(n1=2), partial=TRUE, give.names=TRUE), list(V1_n1=c(1,3,5)))
1107+
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)))
1108+
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)))
1109+
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)))
1110+
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)))
1111+
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)))
1112+
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
1113+
test(6006.9961, frollsum(c(1,2,3), list(c(2,2,2)), adaptive=TRUE, partial=TRUE, give.names=TRUE), c(1,3,5))
1114+
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)))
1115+
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)))
1116+
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)))
1117+
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)))
1118+
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))
1119+
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)))
1120+
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)))
1121+
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)))
10801122

10811123
## validation
10821124

0 commit comments

Comments
 (0)