基于条件计算R数据框前序行指定列的求和问题

需求说明 #

为时间序列数据框hh02创建新列sum_heat_on_prev_periods：

• 仅当heat_final_off_algo3 == 1时，计算当前行之前16行（每行对应30分钟，合计8小时）的heat_on_prev列求和值
• 当heat_final_off_algo3 == 0时，该列返回NA

示例数据 #

hh02 <- data.frame(row=c(1,2,3,4,5,6,7,8,9,10,12,11,13,14,15,16),
                 heat_final_off_algo3 = c(0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0),
                 avg_roomtemp = c(20,19,19,17,16,15,14,13,12,11,10,9,8,7,6,5),
                 temp_prev=c(21,20,19,19,17,16,15,14,13,12,11,10,9,8,7,6),
                 heat_on_prev = c(1,1,1,0,0,0,0,1,0,0,0,0,1,0,0,0))

# heat_final_off_algo3是二进制列，1表示当日最后一次关闭供暖，0表示否
# avg_roomtemp为平均室温
# temp_prev是前一行的室温，由lag(avg_roomtemp,1)生成
# heat_on_prev是二进制列，1表示前一时段供暖开启，0表示关闭

问题重现 #

尝试以下代码时出现报错：Error in .fun(piece, ...) : object 'heat_final_off_algo3' not found

fxn <- function(x) { 
  if (heat_final_off_algo3==1){
    sum_heat_on_prev_periods <- (heat_on_prev) + (lag(heat_on_prev,1)) + (lag(heat_on_prev,2)) + (lag(heat_on_prev,3)) + (lag(heat_on_prev,4)) + (lag(heat_on_prev,5)) + (lag(heat_on_prev,6)) + (lag(heat_on_prev,7)) + (lag(heat_on_prev,8)) + (lag(heat_on_prev,9)) + (lag(heat_on_prev,10)) + (lag(heat_on_prev,11)) + (lag(heat_on_prev,12)) + (lag(heat_on_prev,13)) + (lag(heat_on_prev,14)) + (lag(heat_on_prev,15)) + (lag(heat_on_prev,16))
  }
} 

hh02$sum_heat_on_prev_periods <- plyr::ddply(hh02, c("heat_final_off_algo3", "heat_on_prev"), fxn)

错误原因 #

1. plyr::ddply使用逻辑错误：它是按分组拆分数据框后处理，但此处不需要按heat_final_off_algo3和heat_on_prev分组，而是要逐行判断条件
2. 函数内未正确引用数据框列：直接写heat_final_off_algo3会被当作全局变量，而非分组后的子数据框列
3. 手动累加16个lag过于繁琐，且未处理边界情况（比如前16行没有足够历史数据时，求和会包含NA）

解决方法 #

推荐使用dplyr结合slider包实现滚动窗口求和，代码简洁且逻辑清晰：

完整代码 #

# 安装所需包（首次运行时执行）
install.packages(c("dplyr", "slider"))

# 加载包
library(dplyr)
library(slider)

# 处理数据
hh02 <- hh02 %>%
  # 按row排序，确保时间序列顺序正确
  arrange(row) %>%
  # 计算当前行之前16行的heat_on_prev求和，窗口不包含当前行
  mutate(
    roll_sum = slide_dbl(
      heat_on_prev,
      ~sum(.x, na.rm = TRUE),
      .before = 16,
      .after = -1, # 排除当前行
      .complete = FALSE # 允许窗口不足16行时返回部分求和
    ),
    # 根据条件赋值，不符合则设为NA
    sum_heat_on_prev_periods = ifelse(heat_final_off_algo3 == 1, roll_sum, NA)
  ) %>%
  # 移除中间辅助列（可选）
  select(-roll_sum)

# 查看结果
print(hh02)

结果说明 #

• 对row排序确保时间序列顺序正确，避免行乱序导致求和错误
• slide_dbl的.before=16表示取当前行之前的16行，.after=-1排除当前行，完美匹配需求
• na.rm=TRUE处理窗口内存在NA的情况（比如前16行没有足够历史数据时）
• 通过ifelse仅保留heat_final_off_algo3 == 1行的求和值，其余设为NA

替代方案（无需slider包，用zoo） #

如果不想安装slider，可以用zoo包的rollsumr函数：

install.packages("zoo")
library(zoo)
library(dplyr)

hh02 <- hh02 %>%
  arrange(row) %>%
  mutate(
    # rollsumr计算右侧对齐的滚动求和，窗口大小16，fill=NA表示不足窗口时填NA
    roll_sum = rollsumr(heat_on_prev, k=16, fill=NA),
    # 因为rollsumr包含当前行，所以需要再lag一次得到之前16行的和
    roll_sum = lag(roll_sum, 1),
    sum_heat_on_prev_periods = ifelse(heat_final_off_algo3 == 1, roll_sum, NA)
  ) %>%
  select(-roll_sum)

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