如何用R统计个体年度唯一服务天数（解决IVS包单日周期问题）

需求说明 #

需要统计每个个体一年内接触服务的不重复天数，数据集包含重叠/不重叠的服务周期，其中存在起止日期为同一天的单日记录；要求输出带日期变量的数据框（而非向量），方便后续计算总天数。

示例数据 #

eg_data <- data.frame(
  id = c(1,1,1,  2,2,  3,3,3,3,3,3,  4,4,  5,5,5,5),
  start_dt = c("01/01/2016", "12/02/2016", "03/12/2017",  "02/01/2016", 
               "03/04/2016",  "01/01/2016", "03/05/2016", "05/07/2016", "07/01/2016", 
               "09/04/2016", "10/10/2016",  "01/01/2016", "05/28/2016",  "01/01/2016", 
               "06/05/2016", "08/25/2016", "11/01/2016"),  
  end_dt =   c("12/01/2016", "12/02/2016", "05/15/2017",  "05/15/2016", 
               "12/29/2016",  "03/02/2016", "04/29/2016", "06/29/2016", "08/31/2016", 
               "03/04/2016", "11/29/2016",  "05/31/2016", "08/19/2016",  "06/10/2016", 
               "07/25/2016", "08/25/2016", "12/30/2016"))
eg_data$row_n <- 1:nrow(eg_data)

之前尝试的代码（存在问题） #

无法处理单日周期，且未输出带日期的数据框：

ab <- a %>%
  mutate(
    start_dt = as.Date(ActivityStartDate, format = "%m/%d/%Y"),
    end_dt = as.Date(ActivityEndDate, format = "%m/%d/%Y")
  ) %>%
  mutate(
    range = iv(start_dt, end_dt),
    .keep = "unused"
  )

c <-ab %>%
  group_by(ID) %>%
  mutate(group = iv_identify_group(range)) %>%
  group_by(group, .add = TRUE)

解决方案 #

方法1：展开日期序列（输出带日期的数据框） #

适合需要保留每个服务日期的场景，兼容单日/多日周期：

library(dplyr)
library(lubridate)

# 1. 转换日期格式为Date类型
eg_data_clean <- eg_data %>%
  mutate(
    start_dt = mdy(start_dt),  # 自动识别月/日/年格式
    end_dt = mdy(end_dt)
  )

# 2. 展开每个服务周期的所有日期，去重得到唯一天数
service_dates <- eg_data_clean %>%
  rowwise() %>%
  # 生成从start到end的所有日期（含两端）
  mutate(service_date = list(seq(start_dt, end_dt, by = "day"))) %>%
  unnest(service_date) %>%
  select(id, service_date) %>%
  distinct(id, service_date)  # 按个体和日期去重

# 查看结果（每行对应一个个体的一个服务日期）
head(service_dates)

# 3. 统计每个个体的总不重复服务天数
service_days_count <- service_dates %>%
  group_by(id) %>%
  summarise(total_unique_days = n())

print(service_days_count)

方法2：合并区间（高效统计天数，适合大数据集） #

无需展开日期，通过合并重叠/相邻区间计算总天数，同时可按需生成日期序列：

library(dplyr)
library(lubridate)

eg_data_clean <- eg_data %>%
  mutate(
    start_dt = mdy(start_dt),
    end_dt = mdy(end_dt)
  )

# 合并个体的所有服务区间，计算总天数
interval_summary <- eg_data_clean %>%
  group_by(id) %>%
  # 创建闭区间对象（包含起止日期）
  mutate(period = interval(start_dt, end_dt)) %>%
  # 合并重叠或相邻的区间
  summarise(merged_periods = reduce(period, union)) %>%
  # 计算总天数：每个区间的天数（time_length返回间隔天数，需+1补全闭区间）
  mutate(total_unique_days = sum(time_length(merged_periods, "day")) + length(merged_periods))

print(interval_summary)

# 若需要生成日期序列，可从合并后的区间提取
interval_to_dates <- function(intervals) {
  map(intervals, ~ seq(int_start(.x), int_end(.x), by = "day")) %>%
    unlist() %>%
    as.Date(origin = "1970-01-01")
}

# 生成每个个体的服务日期序列
service_dates_from_interval <- interval_summary %>%
  rowwise() %>%
  mutate(service_date = list(interval_to_dates(merged_periods))) %>%
  unnest(service_date) %>%
  select(id, service_date)

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