如何在R中基于移动窗口生成修正列及关联检测列

示例数据集 #

dt <- data.frame(A_LM = c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
                          0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0),
                 B_LM = c(1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0,
                          0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1))

具体需求 #

• 创建列A_LM_corrected：当A_LM为1且其前5行无其他1时为1，否则为0；
• 创建列B_LM_corrected：遵循相同规则，基于B_LM列；
• 创建列A_LM_foll：当A_LM_corrected为1且其后续5行的B_LM_corrected中至少有一个1时为1，否则为0；
• 创建列B_LM_foll：遵循相同规则，当B_LM_corrected为1且其后续5行的A_LM_corrected中至少有一个1时为1，否则为0。

理想结果数据集 #

dt_aim <- data.frame(A_LM = c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
                              0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0),
                     B_LM = c(1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0,
                              0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1),
                     A_LM_corrected = c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0),
                     B_LM_corrected = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1),
                     A_LM_foll = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                   0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0),
                     B_LM_foll = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                   0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0))

解决方案 #

方法1：使用tidyverse（dplyr + slider） #

借助slider包的滑动窗口函数处理前序和后续窗口判断，代码如下：

library(tidyverse)
library(slider)

dt_result <- dt %>%
  # 生成corrected列：前5行无1且当前行是1
  mutate(
    A_LM_corrected = if_else(
      A_LM == 1 & slide_dbl(row_number(), ~sum(A_LM[.x]), .before = 5, .after = -1, .complete = FALSE) == 0,
      1, 0
    ),
    B_LM_corrected = if_else(
      B_LM == 1 & slide_dbl(row_number(), ~sum(B_LM[.x]), .before = 5, .after = -1, .complete = FALSE) == 0,
      1, 0
    )
  ) %>%
  # 生成foll列：当前corrected为1，且后续5行对应corrected列至少有一个1
  mutate(
    A_LM_foll = if_else(
      A_LM_corrected == 1 & slide_dbl(row_number(), ~sum(B_LM_corrected[.x]), .before = -1, .after = 5, .complete = FALSE) >= 1,
      1, 0
    ),
    B_LM_foll = if_else(
      B_LM_corrected == 1 & slide_dbl(row_number(), ~sum(A_LM_corrected[.x]), .before = -1, .after = 5, .complete = FALSE) >= 1,
      1, 0
    )
  )

# 验证结果是否匹配
all.equal(dt_result, dt_aim)

方法2：使用data.table #

利用data.table的滚动窗口功能高效处理，代码如下：

library(data.table)

setDT(dt)

# 生成corrected列：前5行无1且当前行是1
dt[, A_LM_corrected := as.integer(A_LM == 1 & frollsum(A_LM, n = 5, align = "right", na.rm = TRUE, adaptive = TRUE) - A_LM == 0)]
dt[, B_LM_corrected := as.integer(B_LM == 1 & frollsum(B_LM, n = 5, align = "right", na.rm = TRUE, adaptive = TRUE) - B_LM == 0)]

# 生成foll列：当前corrected为1，后续5行对应corrected列至少有一个1
# 反转数据将后续窗口转化为前序窗口处理
dt_rev <- dt[order(-.I)]
dt_rev[, A_LM_foll := as.integer(A_LM_corrected == 1 & frollsum(B_LM_corrected, n = 5, align = "right", na.rm = TRUE, adaptive = TRUE) - B_LM_corrected >= 1)]
dt_rev[, B_LM_foll := as.integer(B_LM_corrected == 1 & frollsum(A_LM_corrected, n = 5, align = "right", na.rm = TRUE, adaptive = TRUE) - A_LM_corrected >= 1)]
dt_result <- dt_rev[order(.I)]

# 验证结果是否匹配
all.equal(as.data.table(dt_result), as.data.table(dt_aim))

逻辑说明 #

• 前序窗口判断：slider::slide_dbl通过.before=5+.after=-1只统计当前行前5行的1的数量；data.table::frollsum用align="right"实现左到右滚动求和，减去当前行值得到前5行总和。
• 后续窗口判断：slider用.before=-1+.after=5只统计当前行后5行的1的数量；data.table通过反转数据集，将后续窗口转换为前序窗口处理后再还原顺序。

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