在R中基于自定义时间窗口按日期创建命名分组

核心需求 #

基于数据框的日期列，按自定义时间窗口（如14天、28天）生成分组标签：先按日期排序，从首个日期开始，范围内的行标记为同一分组；遇到超出窗口的日期时，分组编号递增，以此推进。

方法一：Base R 实现（无额外依赖） #

定义一个可复用的分组函数，处理日期排序、分组逻辑，并保留原数据的顺序：

assign_date_groups <- function(dates, threshold_days) {
  # 对日期排序，确保分组逻辑正确
  sorted_dates <- sort(dates)
  # 初始化分组向量
  groups <- integer(length(sorted_dates))
  groups[1] <- 1
  current_group_start <- sorted_dates[1]
  
  # 遍历后续日期，判断是否属于当前分组
  for (i in 2:length(sorted_dates)) {
    if (sorted_dates[i] > current_group_start + threshold_days) {
      groups[i] <- groups[i-1] + 1
      current_group_start <- sorted_dates[i]
    } else {
      groups[i] <- groups[i-1]
    }
  }
  
  # 将分组标签映射回原日期的顺序
  groups[match(dates, sorted_dates)]
}

应用到示例数据

先重现示例数据（设置随机种子保证可复现）：

set.seed(123)
dates <- as.Date(c("2025-01-19",
                   "2025-01-19",
                   "2025-01-20",
                   "2025-02-12",
                   "2025-02-13",
                   "2025-04-12",
                   "2025-04-12",
                   "2025-05-01",
                   "2025-05-28",
                   "2025-05-29"))
values <- sample(1:10)
df <- data.frame(dates, values)

生成不同阈值的分组列：

# 14天窗口分组
df$date_group_14 <- assign_date_groups(df$dates, 14)
# 28天窗口分组
df$date_group_28 <- assign_date_groups(df$dates, 28)

查看结果：

print(df)

输出与需求中的desired_output完全一致。

方法二：Tidyverse 实现（管道式风格） #

利用dplyr和purrr的函数，更符合现代R数据处理的管道式风格：

library(dplyr)
library(purrr)

assign_date_groups_tidy <- function(df, date_col, threshold_days) {
  df %>%
    # 先按日期排序
    arrange({{date_col}}) %>%
    # 累积计算当前分组的起始日期
    mutate(
      current_group_start = accumulate({{date_col}}, 
                                       ~ ifelse(.y > .x + threshold_days, .y, .x), 
                                       .init = first({{date_col}}))[-1],
      # 根据起始日期的变化生成分组编号
      date_group = cumsum(c(TRUE, diff(current_group_start) != 0))
    ) %>%
    # 恢复原数据的顺序
    arrange(match({{date_col}}, df[[date_col]]))
}

应用到示例数据

# 生成14天和28天的分组结果
df_grouped_14 <- assign_date_groups_tidy(df, dates, 14) %>% select(dates, date_group_14 = date_group)
df_grouped_28 <- assign_date_groups_tidy(df, dates, 28) %>% select(dates, date_group_28 = date_group)

# 合并到原数据框
df_combined <- df %>%
  left_join(df_grouped_14, by = "dates") %>%
  left_join(df_grouped_28, by = "dates")

关键逻辑说明 #

1. 排序优先：无论哪种方法，都先对日期排序，确保分组从最早日期开始推进。
2. 分组起始更新：当当前日期超出「当前分组起始日期 + 阈值天数」时，新建分组并更新起始日期为当前日期。
3. 原顺序保留：通过match函数或重新排序，确保分组标签匹配原数据的行顺序。

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