1

Suppose I have the following zoo object:

x.orig <- read.zoo(data.frame(date=seq(as.Date('2020-01-01'), as.Date('2020-01-10'), 1), v=c(1,2,3,100,4,5,1000,8,8,10)))
2020-01-01 2020-01-02 2020-01-03 2020-01-04 2020-01-05 2020-01-06 2020-01-07 2020-01-08 2020-01-09 2020-01-10 
         1          2          3        100          4          5       1000          8          8         10

I would like to compute a rolling sum of width=seq_along(x.orig) as follows:

2020-01-01 1
2020-01-02 1 + 2                                   #2020-01-01 + 2020-01-02
2020-01-03 1 + (1 + 2) + 3                         #2020-01-01 + 2020-01-02 + 2020-01-03
2010-01-04 1 + (1 + 2) + (1 + (1 + 2) + 3) + 100   #2020-01-01 + 2020-01-02 + 2020-01-03 + 2020-01-04
...

I would imagine the way to do this would be to result-feed x in some way so that x is updated after each rollapply loop so that the next rollapply iteration picks up the modified value in its window but am just not sure how to write it...

Denis
  • 11,796
  • 16
  • 88
  • 150

3 Answers3

2

I don't think this is very common so probably there won't be a function for this, however you can hack your own fast function with Rcpp, here's an example:

library(data.table)
library(Rcpp)

DT <- data.table(date=seq(as.Date('2020-01-01'), as.Date('2020-01-10'), 1),
                 v=c(1,2,3,100,4,5,1000,8,8,10))
DT[, week := 1:.N %/% 7] # create a week column (you can adapt this to your needs)

# Add your logic to a cpp function
cppFunction("
    IntegerVector roll_cumsum(IntegerVector x) {
        int n = x.size();
        int cumsum = 0;
        IntegerVector y = clone(x);
        for (int i = 0; i < n; ++i) {
            y[i] += cumsum;
            cumsum += y[i];
        }
        return y;
    }
")

DT[, result := roll_cumsum(v), by = week][]
josemz
  • 1,283
  • 7
  • 15
1

A simple loop will do it:

v <- x.orig
for(i in seq_along(v)) v[i] <- sum(head(v, i))

which results in this zoo object:

> v
2020-01-01 2020-01-02 2020-01-03 2020-01-04 2020-01-05 2020-01-06 2020-01-07 
         1          3          7        111        126        253       1501 
2020-01-08 2020-01-09 2020-01-10 
      2010       4020       8042

rollapply

If you wanted to wrap this within a rollapplyr of width 3, say:

accum <- function(x) { for(i in seq_along(x)) x[i] <- sum(head(x, i)); tail(x, 1) }
rollapplyr(x.orig, 3, accum)
G. Grothendieck
  • 254,981
  • 17
  • 203
  • 341
  • How would I generalize this if let’s say I wanted to use a width=3? Or a custom width list? – Denis May 30 '20 at 21:22
  • See added rollapply section. – G. Grothendieck May 30 '20 at 22:13
  • can you explain a little about what this is doing? and how it is doing it? – Denis Jun 01 '20 at 14:12
  • Regarding the loop involving v and x if we have computed v[1], v[2], ..., v[i-1] then v[i] should equal the sum of those plus x[i] but we have already initialized v to x so v[i] equals x[i] thus we just set v[i] to the sum of v[1]+...+v[i] which equals sum(head(v, i)) . accum works similarly but since there is no need to preserve x since it is lost when the function exits we can just use x in place of both x and v. – G. Grothendieck Jun 01 '20 at 14:16
0

Here's my attempt at this. Ideally I wanted to modify x.orig after every iteration but couldn't get that to work so made another variable called latest. I doubt this is the best way to do it though:

library(zoo)

latest <- x.orig
rollapplyr(x.orig, width = seq_along(x.orig), function(x) {
   #browser()
   x <- latest[index(x)]
   v <- sum(x)
   if (!is.na(v))
     latest[last(index(x))] <<- v
   latest[last(index(x))]
})

2020-01-01 2020-01-02 2020-01-03 2020-01-04 2020-01-05 2020-01-06 2020-01-07 2020-01-08 2020-01-09 2020-01-10 
         1          3          7        111        126        253       1501       2010       4020       8042
Denis
  • 11,796
  • 16
  • 88
  • 150