r 中的分组移动平均线

Grouped moving average in r

我正在尝试计算特定字段上 r 的移动平均值,但我需要将此移动平均值按两个或多个其他字段分组。这个新平均值的目的是用于预测分析,所以我也需要它是尾随的。 任何没有足够值进行平均的变量(例如学生 J)最好给出 NA 或其原始 Score 值。

我一直在尝试 rollapply 和 data.table,但没有成功!

我已经提供了 table 数据和两个移动平均线(AVG2 k=2 和 AVG3 k=3)来准确显示我所追求的。移动平均值在分数上,要分组的变量是学校、学生和地区。请帮忙!

   no   school  Student area    Score **AVG2**  **AVG3**
   1    I       S       A       5      NA       NA
   2    B       S       A       2      NA       NA
   3    B       S       A       7      NA       NA
   4    B       O       A       3      NA       NA
   5    B       O       B       9      NA       NA
   6    I       O       A       6      NA       NA
   7    I       O       B       3      NA       NA
   8    I       S       A       7      NA       NA
   9    I       O       A       1      NA       NA
   10   B       S       A       7      4.5      NA
   11   I       S       A       3      NA       NA
   12   I       O       A       8      3.5      NA
   13   B       S       A       3      7        5.33
   14   I       O       A       4      4.5      5
   15   B       O       A       1      NA       NA
   16   I       S       A       9      5        5
   17   B       S       A       4      5        5.67
   18   B       O       A       6      2        NA
   19   I       S       A       3      6        6.33
   20   I       O       B       8      NA       NA
   21   B       S       A       3      3.5      4.67
   22   I       O       A       4      6        4.33
   23   B       O       A       1      3.5      3.33
   24   I       S       A       9      6        5
   25   B       S       A       4      3.5      3.33
   26   B       O       A       6      3.5      2.67
   27   I       J       A       6      NA       NA

这是在 r:

中重新创建初始 table 的代码
school <- c('I','B','B','B','B','I','I','I','I','B','I','I','B','I','B','I','B','B','I','I','B','I','B','I','B','B','I')
Student <- c('S','S','S','O','O','O','O','S','O','S','S','O','S','O','O','S','S','O','S','O','S','O','O','S','S','O','J')
area <- c('A','A','A','A','B','A','B','A','A','A','A','A','A','A','A','A','A','A','A','B','A','A','A','A','A','A','A')
Score <- c(5,2,7,3,9,6,3,7,1,7,3,8,3,4,1,9,4,6,3,8,3,4,1,9,4,6,6)
data.frame(school, Student, area,  Score)

您可以尝试使用 dplyrTTR 解决问题,但是对于学校的学生 J I 来说,由于只有一个测量值,因此无法计算移动平均值。

stats:filter 计算的 AVG2 给出了您想要的结果,但我还添加了用 TTR::SMA 计算的 AVG2b 以显示简单的移动平均计算,其中还考虑了当前测量值.

library(dplyr)
library(TTR)

df <- data.frame(school, Student, Score)
df$AVG2 <- NA
df$AVG2b <- NA
df[!(df$school=="I" & df$Student=="J"),] <- df[!(df$school=="I" & df$Student=="J"),] %>% 
  group_by(school, Student) %>% 
  mutate(AVG2 = stats::filter(Score, c(0, 0.5, 0.5), sides = 1 ), AVG2b = SMA(Score, n= 2)) 

    > df
   school Student Score AVG2 AVG2b
1       I       S     5   NA    NA
2       B       S     2   NA    NA
3       B       S     7   NA   4.5
4       B       O     3   NA    NA
5       B       O     9   NA   6.0
6       I       O     6   NA    NA
7       I       O     3   NA   4.5
8       I       S     7   NA   6.0
9       I       O     1  4.5   2.0
10      B       S     7  4.5   7.0
...

这是一个rollapply解决方案。请注意,您似乎想要同一组中前两行或三行的平均值,即排除当前行中的数据。

library(zoo)

roll <- function(x, n) { 
   if (length(x) <= n) NA 
   else rollapply(x, list(-seq(n)), mean, fill = NA)
}
transform(DF, AVG2 = ave(Score, school, Student, FUN = function(x) roll(x, 2)),
              AVG3 = ave(Score, school, Student, FUN = function(x) roll(x, 3)))

给予:

   school Student Score AVG2     AVG3
1       I       S     5   NA       NA
2       B       S     2   NA       NA
3       B       S     7   NA       NA
4       B       O     3   NA       NA
5       B       O     9   NA       NA
6       I       O     6   NA       NA
7       I       O     3   NA       NA
8       I       S     7   NA       NA
9       I       O     1  4.5       NA
10      B       S     7  4.5       NA
11      I       S     3  6.0       NA
12      I       O     8  2.0 3.333333
13      B       S     3  7.0 5.333333
14      I       O     4  4.5 4.000000
15      B       O     1  6.0       NA
16      I       S     9  5.0 5.000000
17      B       S     4  5.0 5.666667
18      B       O     6  5.0 4.333333
19      I       S     3  6.0 6.333333
20      I       O     8  6.0 4.333333
21      B       S     3  3.5 4.666667
22      I       O     4  6.0 6.666667
23      B       O     1  3.5 5.333333
24      I       S     9  6.0 5.000000
25      B       S     4  3.5 3.333333
26      B       O     6  3.5 2.666667
27      I       J     6   NA       NA

更新:固定滚动。

这里是使用 data.table 进行的 AVG2 计算,与其他方法相比速度更快:

library(data.table)
dt <- data.table(df)
setkey(dt, school, Student, area)
dt[, c("start", "len") := .(ifelse(.I + 1 > .I[.N], 0, .I +1), pmax(pmin(1, .I[.N] - .I -1), 0)), by = .(school, Student, area)][
    , AVG2 := mean(dt$Score[start:(start+len)]), by = 1:nrow(dt)]
res$AVG2[res$len == 0] <- NA