How can I pass the width argument of the zoo:rollapply function to the FUN function called within rollapply?
I put the values and widths as columns of a same data.frame:
library(zoo)
a = data.frame(v = 1:10, w = c(2,1,3,5,2,7,3,2,1,3))
# v w
# 1 1 2
# 2 2 1
# 3 3 3
# 4 4 5
# 5 5 2
# 6 6 7
# 7 7 3
# 8 8 2
# 9 9 1
# 10 10 3
I can do:
rollapply(a$v, a$w, function(x) sum(x), partial=T)
Which gives:
[1] 3 2 9 20 11 42 21 17 9 19
Now I would like to use, for each rolling window of a$v, the corresponding value of a$w in the computation. For example:
rollapply(a$v, a$w, function(x) sum(x) + a$w[1], partial=T)
But instead of having a$w[1] as a constant value (here, it simply adds 2 to the values above), I would like to use the value in a$w corresponding each time to the a$w (i.e., in the same row of a).
Hence the desired output would be:
[1] 5 3 12 25 13 49 24 19 10 22
1) The width need not be in the function. It can be added on afterwards:
rollapply(a$v, a$w, sum, partial = TRUE) + a$w
## [1] 5 3 12 25 13 49 24 19 10 22
Specify align= if you want different alignment.
2) This approach is a bit ugly but another way is to maintain an external index.
i <- 0
rollapply(a$v, a$w, function(x) sum(x) + a$w[i <<- i+1], partial = TRUE)
## [1] 5 3 12 25 13 49 24 19 10 22
2a) This can be cleaned up a bit at the expense of extra code using object oriented ideas to maintain state. Here we define a proto object p having an internal counter and an incr method which increments and returns it each time incr is invoked on the object.
library(proto)
p <- proto(counter = 0, incr = function(.) .$counter <- .$counter + 1)
rollapply(a$v, a$w, function(x) sum(x) + a$w[p$incr()], partial = TRUE)
## [1] 5 3 12 25 13 49 24 19 10 22
3) The example in the question used center alignment but if you actually need right or left alignment then it can be done by iterating over a rather than just over a$v. Here it is for right alignment.
Sum <- function(x) {
x <- matrix(x,,2)
v <- x[, 1]
w <- tail(x[, 2], 1)
sum(v) + w
}
rollapplyr(a, a$w, Sum, partial = TRUE, by.column = FALSE)
## [1] 3 3 9 15 11 28 21 17 10 30
# double check
rollapplyr(a$v, a$w, sum, partial = TRUE) + a$w
## [1] 3 3 9 15 11 28 21 17 10 30