如何在R中高效灵活地判断分组变量多期滞后是否满足条件？

我正在分析不同地区多年间的特定天气事件，使用的数据框如下：

library(tidyverse)

df <- tibble(region = c(rep("A", 10), rep("B", 10)),
             event = c(rep("storm", 5), rep("rain", 5), rep("storm", 5), rep("rain", 5)),
             year = c(rep(1:5, 4)),
             occured = c("n", "n", "y", "n", "y",
                         "y", "n", "n", "n", "y",
                         "n", "y", "y", "y", "y",
                         "n", "n", "n", "n", "y")
             )

我需要创建一个指示器变量，用于判断某一地区的特定天气事件是否为X年内首次发生。目前针对过去2年的场景，我通过手动添加lag()语句实现：

df %>% 
   group_by(region, event) %>% 
   mutate(ind = case_when(
     occured == "y" &
       lag(occured, 1, default = "n") == "n" &
       lag(occured, 2, default = "n") == "n" ~ 1,
     .default = 0
     )
     )

输出结果：

# A tibble: 20 × 5
# Groups:   region, event [4]
   region event  year occured   ind
   <chr>  <chr> <int> <chr>   <dbl>
 1 A      storm     1 n           0
 2 A      storm     2 n           0
 3 A      storm     3 y           1
 4 A      storm     4 n           0
 5 A      storm     5 y           0
 6 A      rain      1 y           1
 7 A      rain      2 n           0
 8 A      rain      3 n           0
 9 A      rain      4 n           0
10 A      rain      5 y           1
11 B      storm     1 n           0
12 B      storm     2 y           1
13 B      storm     3 y           0
14 B      storm     4 y           0
15 B      storm     5 y           0
16 B      rain      1 n           0
17 B      rain      2 n           0
18 B      rain      3 n           0
19 B      rain      4 n           0
20 B      rain      5 y           1

我的问题是：有没有更高效、灵活的方法实现这个需求？不用每次根据关注的年数手动增减lag()语句。

解决方案1：使用slider包实现滑动窗口检查 #

slider包提供了简洁的滑动窗口操作函数，只需修改x_years变量即可切换关注的年数：

library(tidyverse)
library(slider)

# 设置需要关注的年数
x_years <- 2

# 定义判断逻辑：当前事件发生，且过去x年都未发生
is_first_occurrence <- function(window_vals) {
  current_val <- last(window_vals)
  current_val == "y" && all(head(window_vals, -1) == "n")
}

df %>%
  group_by(region, event) %>%
  # 滑动窗口包含当前行 + 过去x年的行
  mutate(ind = as.integer(slide_lgl(occured, is_first_occurrence, .before = x_years))) %>%
  ungroup()

解决方案2：使用zoo包的rollapply函数 #

如果你习惯用zoo包的滚动计算功能，也可以这样实现：

library(tidyverse)
library(zoo)

x_years <- 2

df %>%
  group_by(region, event) %>%
  mutate(
    # 检查过去x年是否都未发生，不足年份用"n"填充
    past_x_no_event = rollapply(occured, width = x_years, 
                                FUN = function(x) all(x == "n"),
                                align = "right", fill = TRUE),
    # 当前发生且过去x年未发生则标记为1
    ind = as.integer(occured == "y" & past_x_no_event)
  ) %>%
  select(-past_x_no_event) %>%
  ungroup()

方案优势 #

两种方法都只需修改x_years变量即可适配不同的时间窗口，无需手动添加或删除lag()语句，灵活性和可维护性更强。运行结果和你手动写lag()的逻辑完全一致。

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