【问题标题】：conditional rolling average条件滚动平均
【发布时间】：2019-10-24 10:22:46
【问题描述】：

library(data.table)

set.seed(123)
d <- data.frame(ID = rep(1:5, each = 17), yearRef = rep(1998:2014, times = 5), y = sample(1:100, 17 * 5))

对于每个 ID，我想从 1998 年开始计算 y 的 7 年滚动平均值。然而，条件是在每个滚动窗口中，我只选择 y 的前 5 个最高值来做平均值。例如

第一个滚动窗口是

1998-2004 - 只计算前 5 个最高 'y' 值的平均值

1999-2005 - 只计算前 5 个最高 'y' 值的平均值 . .

2007-2013 - 只计算前 5 个最高 'y' 值的平均值

2008-2014 - 只计算前 5 个最高 'y' 值的平均值

我有兴趣使用 data.table 来实现这一点。但是也可以接受其他建议。这是我尝试过的

 d = setDT(d)
 d[, avg.Y := frollmean(y, 7), by = ID]

如何输入另一个参数，对于每个滚动的 7 年窗口，我只选择前 5 个最高 y 值来计算平均值？

编辑

我还可能遇到某些 ID 可能没有至少 7 年的数据来进行移动平均的情况，在这种情况下，上述函数将为我提供 NA。对于那些 ID，是否可以简单地采用算术平均值？例如如果一个 ID 有 1998-2002 年的数据，在这种情况下，我可以简单地取 1998-2002 年的y 的平均值

【问题讨论】：

最好打开一个单独的问题，而不是编辑一个已经回答的问题
好的。我会这样做的。

标签： r dplyr data.table

【解决方案1】：

我们可以使用zoo 中的rollapplyr 并应用自定义函数来计算每个滚动窗口中前5 个值的mean。

library(data.table)
library(zoo)

setDT(d)
d[, avg.Y:= rollapplyr(y, 7,function(x) mean(tail(sort(x), 5)), fill = NA), by = ID]

对于观察次数可能少于我们可以做的窗口大小的情况

d[, avg.Y:= if (.N > 6) 
            rollapplyr(y, 7,function(x) mean(tail(sort(x), 5)), fill = NA)  
            else mean(y), by = ID]

【讨论】：

谢谢。我刚刚意识到我错过了问题中的一个重要细节。我已经编辑了我的问题以反映这一点。如果您愿意，我可以将其作为单独的问题重新发布。
@89_Simple 更新了解决该案例的答案，
太棒了。谢谢罗纳克

【解决方案2】：

第一次使用frollapply()，但这似乎有效：

get_mean_top5 <- function(x) mean(-sort(-x, partial = 1:5)[1:5])
d[, test := frollapply(y, 7, FUN = get_mean_top5), by = ID]

函数get_mean_top5() 过滤掉前 5 个最高值，然后取平均值。其他更易读的形式是：

get_mean_top5 <- function(x) mean(mean(x[order(x, decreasing=TRUE)[1:5]]))

【讨论】：

【解决方案3】：

更多步骤和一点点重复的基本 R 解决方案：

df$seven_year_group <-  paste0(ave(as.integer(as.factor(df$yearRef)) %% 7,

                               as.integer(as.factor(df$yearRef)) %% 7,

                               FUN = seq.int), 

                           "_",

                           df$ID)

seven_year_averages <- data.frame(avg_y = do.call("rbind", lapply(split(df, df$seven_year_group),

                                             function(x){mean(tail(x[order(x$y), "y"], 5))})))



seven_year_averages$seven_year_group <- row.names(seven_year_averages)

df <- merge(df, seven_year_averages, by = "seven_year_group", all.x = TRUE)

数据：

set.seed(2019)

df <- data.frame(ID = rep(1:5, each = 17), yearRef = rep(1998:2014, times = 5), y = sample(1:100, 17 * 5))

【讨论】：