R语言实现正确处理缺失年份的移动平均值计算

问题需求 #

需要为数据框创建新列，计算当前年份之前n年（不含当前年）的移动平均值。当存在年份缺失时，仅用实际存在的有效年份计算平均值，而非简单取前n行的滞后值。现有代码忽略TIME_PERIOD的年份信息，仅按行位置取数，无法满足需求。

示例数据与错误代码 #

library(dplyr)

# 创建示例数据框
df <- data.frame(
  NUTS = rep("XX", 12),
  TIME_PERIOD = c(2008, 2009, 2010, 2011, 
                  # 2012年缺失
                  2013, 2014, 2015, 
                  # 2016年缺失
                  2017, 2018, 2019, 2020, 2021),
  DATA = c(524288.2008, 1048576.201, 2097152.201, 4194304.201, 16777216.2, 33554432.2, 67108864.2, 268435456.2, 536870912.2, 1073741824, 2147483648, 4294967296),
  INDICATOR_CODE = rep("Dummy", 12),
  wanted_calculation= c(NA, NA, NA, "DATA average of 2008, 2009, 2010",
                        "DATA average of 2009, 2010, 2011",
                        "2012 is missing so DATA average of 2011, 2013",
                        "2012 is missing so DATA average of 2013, 2014",
                        "DATA average of 2013, 2014, 2015",
                        "2016 is missing so DATA average of 2015, 2017",
                        "2016 is missing so DATA average of 2017, 2018",
                        "DATA average of 2017, 2018, 2019",
                        "DATA average of 2018, 2019, 2020"
  )
)

# 按分组字段排序
df <- df %>% arrange(INDICATOR_CODE, NUTS, TIME_PERIOD)

# 错误的计算逻辑：仅按行位置取前n行
moving_avg_length <- 3
df <- df %>%
  group_by(INDICATOR_CODE, NUTS) %>%
  mutate(my_bugged_moving_avg = sapply(1:n(), function(i) {
    if (i <= moving_avg_length || INDICATOR_CODE[i] != INDICATOR_CODE[i-1] || NUTS[i] != NUTS[i-1]) {
      return(NA)
    } else {
      return(mean(DATA[(i - moving_avg_length):(i-1)], na.rm = TRUE))
    }
  })) %>%
  ungroup()

# 预期结果
wanted_result <- data.frame(
  wanted_moving_avg = c(NA, NA, NA, 1223338.868, 2446677.534, 10485760.2, 25165824.2, 39146837.53, 167772160.2, 402653184.2, 626349397.5, 1252698795)
)

df <- df %>% cbind(wanted_result)

解决方案代码 #

核心思路是针对每个当前年份，明确筛选出年份在当前年份 - n到当前年份 - 1区间内的所有有效数据，再计算平均值：

library(dplyr)
library(purrr)

# 沿用上述示例数据框df，已完成排序

moving_avg_length <- 3

# 正确的动态移动平均值计算
df <- df %>%
  group_by(INDICATOR_CODE, NUTS) %>%
  mutate(
    correct_moving_avg = map_dbl(TIME_PERIOD, function(current_year) {
      # 筛选符合年份范围的有效数据
      valid_data <- DATA[TIME_PERIOD >= (current_year - moving_avg_length) & TIME_PERIOD < current_year]
      # 无有效数据时返回NA，否则计算平均值
      if (length(valid_data) == 0) NA else mean(valid_data)
    })
  ) %>%
  ungroup()

逻辑说明 #

• 抛弃按行索引取数的逻辑，转而基于TIME_PERIOD的实际年份范围筛选数据
• 对每个当前年份，自动匹配之前n年内的所有存在的年份数据，即使有缺失也不会错误包含超出范围的年份
• 分组计算确保不同INDICATOR_CODE和NUTS的分组独立计算，不会互相干扰

内容的提问来源于stack exchange，提问作者Gary