R - 快速计算不同宽度的轧制平均值

时间:2016-05-04 07:54:33

标签: r time-series zoo data-manipulation windowing

我的数据框包含多个日期(时间)的银行资产。每家银行都有一个唯一的ID:

yAxis: {
  min: 0,
  max: 105,
  endOnTick: false,
  title: {
    text: null
  },
  stackLabels: {
enabled: true,
style: {
  fontWeight: 'bold',
  color: 'black'
}
}
},

对于每个银行,我想计算资产的滚动均值,根据连续时间值的数量改变宽度。因此,滚动平均值应包括银行的所有可用连续先前值。如果一家银行没有以前的可用价值,它应该等于资产。因此,我添加了一个计算连续时间值的列,而不是使用动物园包中的# 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 ,这给了我想要的结果,但是对于大数据集,它太慢了:

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 以及来自TTR的rollmean和来自预测的SMA,但这些不允许变宽。我的问题也可能与this questionrblog有关,但我不熟悉C ++,也不了解很多关于函数编写的知识,因此我并不理解这些帖子。< / p>

编辑1:请注意,在上面的代码中,它不是ma - 循环,但是rollapplyr需要花费大量时间。

编辑2:滚动平均值不得超过最后4个值。这是根据时间变量的多个连续值,但不超过最后4个值。抱歉这个不准确的问题! :/我的措辞基于假设使用&#34; number.time&#34; -column,很容易将所有值限制为最大= 4。

2 个答案:

答案 0 :(得分:1)

首先创建一个分组变量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

答案 1 :(得分:0)

使用cumsum

如果您只有一家银行,请尝试:

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

如果您有多家银行该怎么办,我作为excersize离开。提示:您可以使用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]
}