在R语言中统计每周重叠治疗疗程数及新增/结束疗程数

在患者依从性分析中，需统计不同周期间当前接受治疗的患者数量。现有两个数据框：

• 周期间隔数据框df，包含每周的起始和结束日期
• 治疗疗程数据框te，包含每个治疗疗程的起始和结束日期

需要为df新增三列：

• current.users：统计每周与治疗疗程重叠的患者数量
• starters：每周新增的治疗疗程数（疗程起始日期落在当周内）
• stoppers：每周结束的治疗疗程数（疗程结束日期落在当周内）

数据示例 #

周期间隔数据框df

df <- data.frame(week = c(1,2,3,4,5,6))
df$start.week = as.Date('2020-01-01') + 7*df$week -7
df$end.week = df$start.week + 6
df 
#   week start.week   end.week 
# 1    1 2020-01-01 2020-01-07
# 2    2 2020-01-08 2020-01-14
# 3    3 2020-01-15 2020-01-21
# 4    4 2020-01-22 2020-01-28
# 5    5 2020-01-29 2020-02-04
# 6    6 2020-02-05 2020-02-11

治疗疗程数据框te

te <- data.frame(episode = c(1,2,3,4)) 
te$episode.start <-  as.Date(c('2020-01-10', '2020-01-23', '2020-01-14', '2020-01-08'))
te$episode.end <- as.Date(c('2020-02-01', '2020-02-27', '2020-03-01', '2020-01-25'))
te
#   episode episode.start episode.end
# 1       1    2020-01-10  2020-02-01
# 2       2    2020-01-23  2020-02-27
# 3       3    2020-01-14  2020-03-01
# 4       4    2020-01-08  2020-01-25

预期核心输出（含current.users）

week start.week   end.week current.user
1    1 2020-01-01 2020-01-07            0
2    2 2020-01-08 2020-01-14            3
3    3 2020-01-15 2020-01-21            3
4    4 2020-01-22 2020-01-28            4
5    5 2020-01-29 2020-02-04            3
6    6 2020-02-05 2020-02-11            2

方法1：基础R实现 #

通过循环遍历每周，逐一计算三个指标：

# 初始化新增列
df$current.users <- 0
df$starters <- 0
df$stoppers <- 0

# 遍历每一周
for (i in 1:nrow(df)) {
  # 提取当前周的起止日期
  week_start <- df$start.week[i]
  week_end <- df$end.week[i]
  
  # 计算current.users：疗程与当前周有重叠的数量
  # 重叠判定逻辑：疗程起始 <= 周结束 且 疗程结束 >= 周起始
  df$current.users[i] <- sum(te$episode.start <= week_end & te$episode.end >= week_start)
  
  # 计算starters：疗程起始日期落在当前周内的数量
  df$starters[i] <- sum(te$episode.start >= week_start & te$episode.start <= week_end)
  
  # 计算stoppers：疗程结束日期落在当前周内的数量
  df$stoppers[i] <- sum(te$episode.end >= week_start & te$episode.end <= week_end)
}

# 查看最终结果
df

运行后输出结果：

week start.week   end.week current.users starters stoppers
1    1 2020-01-01 2020-01-07             0        0        0
2    2 2020-01-08 2020-01-14             3        2        0
3    3 2020-01-15 2020-01-21             3        1        0
4    4 2020-01-22 2020-01-28             4        1        1
5    5 2020-01-29 2020-02-04             3        0        1
6    6 2020-02-05 2020-02-11             2        0        0

方法2：tidyverse风格实现（dplyr + purrr） #

若习惯使用tidyverse工具链，可通过purrr::map_dbl替代循环，代码更简洁：

library(dplyr)
library(purrr)

df <- df %>%
  mutate(
    # 计算当前周在治患者数
    current.users = map_dbl(1:n(), ~sum(te$episode.start <= end.week[.] & te$episode.end >= start.week[.])),
    # 计算当周新增疗程数
    starters = map_dbl(1:n(), ~sum(te$episode.start >= start.week[.] & te$episode.start <= end.week[.])),
    # 计算当周结束疗程数
    stoppers = map_dbl(1:n(), ~sum(te$episode.end >= start.week[.] & te$episode.end <= end.week[.]))
  )

# 查看结果
df

此方法输出结果与基础R实现完全一致，仅代码风格更贴合tidyverse生态。

关键逻辑说明 #

• current.users：覆盖所有重叠场景（疗程完全在周内、周完全在疗程内、部分重叠），核心判定条件为疗程起始 <= 周结束 且 疗程结束 >= 周起始
• starters：直接判断疗程起始日期是否落在当前周的起止区间内
• stoppers：直接判断疗程结束日期是否落在当前周的起止区间内

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