如何在2001-2006与2006-2011两个时间窗口实现两年移动平均？

原始数据集 #

Year   Pct
  2011   -97%
  2010   -95%
  2009   -90%
  2008   -72%
  2007   -40%
  2006    NA
  2005    47%
  2004    71%
  2003    -25%
  2002    116%
  2001    -5%

需求说明 #

需要分别在2001-2006和2006-2011两个独立时间窗口内计算两年移动平均，预期计算结果如下：

Year    Pct   MovAvg
  2011   -97%   (-97  +  -95)/2
  2010   -95%   (-95  +  -90)/2
  2009   -90%   (-90  +  -72)/2
  2008   -72%   (-72  +  -40)/2
  2007   -40%   NA 
  2006    NA    NA
  2005    47%   (47  +  71)/2
  2004    71%   (71  + -25)/2
  2003    -25%  (-25 + 116 )/2
  2002    116%  (116 - 5)/2
  2001    -5%   NA

已知可用apply(embed(x, k), 1, mean)实现两年滚动平均，但不清楚如何在上述两个独立窗口中应用该逻辑，寻求解决方法。

核心思路是拆分数据集到两个目标时间窗口，分别计算滚动平均后再合并结果，以下是具体实现步骤：

步骤1：数据预处理 #

先把百分比格式的数值转为纯数字，方便计算：

# 假设原始数据存储在名为df的数据框中
df$Pct_num <- as.numeric(sub("%", "", df$Pct))

步骤2：分窗口计算移动平均 #

按年份升序排序后，分别处理两个窗口，注意移动平均的计算逻辑是当前年份值 + 前一年份值的平均：

# 按年份升序排列数据
df_sorted <- df[order(df$Year), ]

# 处理2001-2006窗口
window1 <- df_sorted[df_sorted$Year >= 2001 & df_sorted$Year <= 2006, ]
window1$MovAvg <- c(NA, apply(embed(window1$Pct_num, 2), 1, mean))

# 处理2006-2011窗口
window2 <- df_sorted[df_sorted$Year >= 2006 & df_sorted$Year <= 2011, ]
window2$MovAvg <- c(NA, apply(embed(window2$Pct_num, 2), 1, mean))

# 合并窗口结果，去掉重复的2006年数据，再按原年份降序排列
result <- rbind(window1, window2[window2$Year != 2006, ])
result <- result[order(-result$Year), ]

# 把移动平均转为预期的表达式格式（可选）
result$MovAvg_expr <- ifelse(is.na(result$MovAvg), "NA", 
                            paste0("(", result$Pct_num, " + ", lag(result$Pct_num), ")/2"))

步骤3：整理最终输出 #

提取需要的列，匹配预期格式：

final_output <- result[, c("Year", "Pct", "MovAvg_expr")]
colnames(final_output)[3] <- "MovAvg"
print(final_output, row.names = FALSE)

更简洁的dplyr实现 #

如果熟悉dplyr和zoo包，可以用分组方式高效处理：

library(dplyr)
library(zoo)

df %>%
  # 转换百分比为数值
  mutate(Pct_num = as.numeric(sub("%", "", Pct))) %>%
  # 按年份升序排列
  arrange(Year) %>%
  # 标记所属窗口
  mutate(window = case_when(
    Year >=2001 & Year <=2006 ~ "window1",
    Year >=2006 & Year <=2011 ~ "window2"
  )) %>%
  # 按窗口分组计算移动平均
  group_by(window) %>%
  mutate(MovAvg = ifelse(is.na(Pct_num), NA, lag(rollmean(Pct_num, k=2, fill=NA, align="right")))) %>%
  ungroup() %>%
  # 生成表达式格式的移动平均
  mutate(MovAvg_expr = ifelse(is.na(MovAvg), "NA", 
                            paste0("(", Pct_num, " + ", lag(Pct_num), ")/2"))) %>%
  # 按年份降序排列，整理输出列
  arrange(-Year) %>%
  select(Year, Pct, MovAvg_expr) %>%
  rename(MovAvg = MovAvg_expr)

注：使用rollmean需要先安装zoo包：install.packages("zoo")

内容的提问来源于stack exchange，提问作者Ahir Bhairav Orai