Результат кормления скользящим окном или рулонным слоем нанесите спермой

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

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, чтобы следующая итерация rollapply забирала измененное значение в своем окне, но я просто не уверен, как его записать ...


r dataframe zoo rollapply
person Denis    schedule 29.05.2020    source источник
comment
это может быть проще, и те, кто отцы, гоняются с базовым R. cumsum (cumsum (x))   -  person Santiago I. Hurtado    schedule 29.05.2020
comment
На самом деле у меня есть скользящее окно в неделю, поэтому cumsum не сработает, но да, я думаю, что это должно быть что-то вроде cumsum   -  person Denis    schedule 29.05.2020
comment
возможно создать функцию (x) {cumsum (cumsum (x))}, а затем свернуть ее на одну неделю   -  person Santiago I. Hurtado    schedule 29.05.2020

Ответы (3)


arrow_upward
1
arrow_downward

Это сделает простой цикл:

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

рулон

Если вы хотите заключить это в 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)
person G. Grothendieck    schedule 30.05.2020
comment
Как бы я обобщил это, если, скажем, я хотел бы использовать ширину = 3? Или список нестандартной ширины? - person Denis; 31.05.2020
comment
См. Добавленный раздел ролика. - person G. Grothendieck; 31.05.2020
comment
не могли бы вы немного объяснить, что это делает? и как он это делает? - person Denis; 01.06.2020
comment
Что касается цикла, включающего v и x, если мы вычислили v [1], v [2], ..., v [i-1], тогда v [i] должно быть равно сумме этих плюс x [i], но у нас есть уже инициализировал v как x, поэтому v [i] равно x [i], поэтому мы просто устанавливаем v [i] как сумму v [1] + ... + v [i], которая равна sum (head (v, i) ). Аккумулятор работает аналогично, но поскольку нет необходимости сохранять x, поскольку он теряется при выходе из функции, мы можем просто использовать x вместо x и v. - person G. Grothendieck; 01.06.2020

arrow_upward
2
arrow_downward

Я не думаю, что это очень распространено, поэтому, вероятно, для этого не будет функции, однако вы можете взломать свою собственную быструю функцию с помощью 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][]
person josemz    schedule 29.05.2020
comment
классный пример того, как встроить функцию C ++. Вау! Еще не пробовал ... - person Denis; 30.05.2020
comment
попробуйте, это довольно просто и полезно в ситуациях, подобных этой. - person josemz; 30.05.2020

arrow_upward
0
arrow_downward

Вот моя попытка. В идеале я хотел изменять 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
person Denis    schedule 29.05.2020