R - 计算不同宽度滚动平均值的快速方法

Question

我有一个包含多个日期（时间）的银行资产的数据框。每个银行都有一个唯一的 ID：

# Sample Data
time <- c(51, 52, 53, 55, 56, 51, 52, 51, 52, 53)
id <- c(1234, 1234, 1234, 1234, 1234, 2345, 2345, 3456, 3456, 3456)
name <- c("BANK A", "BANK A", "BANK A", "BANK A", "BANK A", "BANK B", "BANK B", "BANK C", 
          "BANK C", "BANK C")
assets <- c(5000, 6000, 4000, 7000, 8000, 10000, 12000, 30000, 35000, 40000)
df <- data.frame(time, id, name, assets)

> df
   time   id   name assets
1    51 1234 BANK A   5000
2    52 1234 BANK A   6000
3    53 1234 BANK A   4000
4    55 1234 BANK A   7000
5    56 1234 BANK A   8000
6    51 2345 BANK B  10000
7    52 2345 BANK B  12000
8    51 3456 BANK C  30000
9    52 3456 BANK C  35000
10   53 3456 BANK C  40000

对于每家银行，我想计算资产的滚动平均值，根据连续时间值的数量改变宽度。因此，滚动平均值应包括银行资产的所有可用的连续先前值。如果一家银行没有可用的先前价值，则它应等于资产。因此，我添加了一列来计算连续时间值的数量，而不是使用 zoo 包中的 rollapplyr，这给了我想要的结果，但是对于大数据集来说它太慢了：

# Calculate number of consecutive times
require(dplyr)
df <- df %>%
  mutate(number.time = 1) %>% # insert column for number.time, start value = 1
  group_by(id) %>%
  arrange(time) # correct order for moving average

for(i in 2:nrow(df)) # Start loop in second row, end in last row of df
  df$number.time[i] <- 
    ifelse(df$time[i] == df$time[i-1]+1,    # Is time consecutive?
           df$number.time[i - 1] + 1,       # If yes: add 1 to previous number.time
           1)                               # If no: set number.time = 1
# Moving Average
require(zoo)
df %>%
  mutate(mov.average = rollapplyr(data = assets,
                                  width = number.time, # use number.time for width
                                  FUN = mean, 
                                  fill = NA,
                                  na.rm = TRUE))
Source: local data frame [10 x 6]
Groups: id [3]

    time    id   name assets number.time mov.average
   (dbl) (dbl) (fctr)  (dbl)       (dbl)       (dbl)
1     51  1234 BANK A   5000           1        5000
2     52  1234 BANK A   6000           2        5500
3     53  1234 BANK A   4000           3        5000
4     55  1234 BANK A   7000           1        7000
5     56  1234 BANK A   8000           2        7500
6     51  2345 BANK B  10000           1       10000
7     52  2345 BANK B  12000           2       11000
8     51  3456 BANK C  30000           1       30000
9     52  3456 BANK C  35000           2       32500
10    53  3456 BANK C  40000           3       35000

如何使用更快的函数获得此输出？我知道来自 zoo 的 rollmean 以及来自 TTR 的 SMA 和来自 forecast 的 ma 但这些不允许变化的宽度。我的问题也可能与this question and this rblog有关，但我对C++不熟悉，对函数编写也不太了解，所以我不太理解那些帖子。

编辑 1: 请注意，在我上面的代码中，它不是 for-loop 而是 rollapplyr 需要很多时间。

编辑 2: 滚动平均值应包括不超过最后 4 个值。也就是说，根据时间变量，连续值的数量与连续值的数量一样多，但不超过最后 4 个值。抱歉问题不准确！ :/ 我的措辞是基于使用 "number.time" 列的假设，在该列中很容易将所有值限制为最大值 = 4.

Answer 1

使用cumsum.

如果您只有一家银行，请尝试：

cumsum(df$assets)/seq(nrow(df))

如果你有多个银行怎么办，我作为练习离开。提示：您可以使用 rle.

完全避免循环

这里是函数 "cumsum with restarts"，它应该可以帮助您。

cumsum.r <- function(vals, restart) {
    if (!is.vector(vals) || !is.vector(restart)) stop("expect vectors")
    if (length(vals) != length(restart)) stop("different length")
    # assume restart = FFTFFFTFFFFT
    len = length(vals) # 12
    restart[1]=T # TFTFFFTFFFFT
    ind = which(restart) # (1,3,7,12)
    ind = rep(ind, c(ind[-1],len+1)-ind) # 1,1,3,3,3,3,7,7,7,7,7,12
    vals.c = cumsum(vals)
    vals.c - vals.c[ind] + vals[ind]
}

Answer 2

首先创建一个分组变量g，然后计算滚动均值。请注意，rollsum 比 rollapply 快得多，但不支持 partial 需要显示的解决方法：

library(zoo) # rollsum

g <- with(df, cumsum(ave(time, id, FUN = function(x) c(1, diff(x) != 1))))
roll4 <- function(x) rollsum(c(0, 0, 0, x), 4) / pmin(4, seq_along(x)) 
transform(df, avg = ave(assets, g, FUN = roll4))

给予：

   time   id   name assets   avg
1    51 1234 BANK A   5000  5000
2    52 1234 BANK A   6000  5500
3    53 1234 BANK A   4000  5000
4    55 1234 BANK A   7000  7000
5    56 1234 BANK A   8000  7500
6    51 2345 BANK B  10000 10000
7    52 2345 BANK B  12000 11000
8    51 3456 BANK C  30000 30000
9    52 3456 BANK C  35000 32500
10   53 3456 BANK C  40000 35000

R - 计算不同宽度滚动平均值的快速方法

R - Fast way to calculate rolling mean with varying width

r

time-series

data-manipulation

windowing

zoo