Роликовое окно подачи результата или рулонное нанесение спермой

Question

Предположим, у меня есть следующий объект зоопарка:

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 

Я хотел бы вычислить скользящую сумму width=seq_along(x.orig) следующим образом:

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
...

Я бы представил способ сделать это было бы для подачи результата x каким-то образом, чтобы x обновлялся после каждого rollapply l oop, так что следующая итерация rollapply подбирает измененное значение в своем окне, но я просто не уверен, как его записать ...

Answer 1

Я не думаю, что это очень распространено, поэтому, вероятно, для этого не будет функции, однако вы можете взломать свою собственную быструю функцию с помощью Rcpp, вот пример:

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][]

Answer 2

Простой l oop сделает это:

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

, что приведет к этому объекту зоопарка:

> 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

Если вы хотите обернуть это в пределах rollapplyr ширины 3, скажем:

accum <- function(x) { for(i in seq_along(x)) x[i] <- sum(head(x, i)); tail(x, 1) }
rollapplyr(x.orig, 3, accum)

Answer 3

Вот моя попытка. В идеале я хотел изменить x.orig после каждой итерации, но не мог заставить это работать, поэтому создал другую переменную с именем latest. Я сомневаюсь, что это лучший способ сделать это:

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