基于分组起止日期补全缺失非重叠日期区间并生成标识变量

这是两个日期补全类问题的变体，需求及相关数据如下：

初始数据 #

have <- data.frame(ID = c(1, 1),
                 date1 = as.Date(c("1999-09-01", "2000-01-29")),
                 date2 = as.Date(c("2000-01-15", "2001-04-30")),
                 start = as.Date(c("2000-01-01", "2000-01-01")),
                 end = as.Date(c("2001-07-31", "2001-07-31")),
                 ind = c(1,1))

输出展示：

> have
  ID      date1      date2      start        end ind
1  1 1999-09-01 2000-01-15 2000-01-01 2001-07-31   1
2  1 2000-01-29 2001-04-30 2000-01-01 2001-07-31   1

期望输出 #

want <- data.frame(ID = c(1, 1, 1, 1),
                 date1 = as.Date(c("2000-01-01", "2000-01-16", "2000-01-29", "2001-05-01")),
                 date2 = as.Date(c("2000-01-15", "2000-01-28", "2001-04-30", "2001-07-31")),
                 ind = c(1,0,1,0))

输出展示：

> want
  ID      date1      date2 ind
1  1 2000-01-01 2000-01-15 1
2  1 2000-01-16 2000-01-28 0
3  1 2000-01-29 2001-04-30 1
4  1 2001-05-01 2001-07-31 0

需求目标 #

• 在基准起止日期（floor和ceiling date）之间添加缺失的日期区间
• 按ID分组使用基准起止日期
• 排除基准起始日期之前的日期区间
• 创建标识变量ind，标记原数据中存在的日期区间（值为1）和补全的缺失区间（值为0）

尝试的代码及结果 #

首次尝试 #

library(dplyr)
ex <- have %>%
  group_by(ID) %>%
  summarize(newdate1 = c(start, date2+1), newdate2 = c(date1-1, end)) %>%
  rename(date1 = newdate1, date2 = newdate2) %>%
  filter(date2 > date1) %>%
  ungroup() %>%
  bind_rows(have) %>%
  arrange(ID, date1)

输出结果：

> ex
# A tibble: 5 × 6
     ID date1      date2      start      end          ind
  <dbl> <date>     <date>     <date>     <date>     <dbl>
1     1 1999-09-01 2000-01-15 2000-01-01 2001-07-31     1
2     1 2000-01-01 2000-01-28 NA         NA            NA
3     1 2000-01-16 2001-07-31 NA         NA            NA
4     1 2000-01-29 2001-04-30 2000-01-01 2001-07-31     1
5     1 2001-05-01 2001-07-31 NA         NA            NA

更新：截断区间至基准范围 #

have2 <- have %>%
  group_by(ID) %>%
  mutate(date1new = ifelse(date1<start & date2>start,start,date1),
         date2new = ifelse(date2>end & date1<end, end, date2),
         date1new = as.Date(date1new, origin = "1970-01-01"),
         date2new = as.Date(date2new, origin = "1970-01-01")) %>%
  select(ID, (start:date2new)) %>%
  rename(date1 = date1new, date2 = date2new) %>%
ungroup()

输出结果：

> have2
# A tibble: 2 × 6
     ID start      end          ind date1      date2     
  <dbl> <date>     <date>     <dbl> <date>     <date>    
1     1 2000-01-01 2001-07-31     1 2000-01-01 2000-01-15
2     1 2000-01-01 2001-07-31     1 2000-01-29 2001-04-30

再次尝试补全区间 #

ex2 <- have2 %>%
  group_by(ID) %>%
  summarize(newdate1 = c(start, date2+1), newdate2 = c(date1-1, end)) %>%
  rename(date1 = newdate1, date2 = newdate2) %>%
  filter(date2 > date1) %>%
  ungroup() %>%
  bind_rows(have2) %>%
  arrange(ID, date1)

输出结果：

> ex2
# A tibble: 5 × 6
     ID date1      date2      start      end          ind
  <dbl> <date>     <date>     <date>     <date>     <dbl>
1     1 2000-01-01 2000-01-28 NA         NA            NA
2     1 2000-01-01 2000-01-15 2000-01-01 2001-07-31     1
3     1 2000-01-16 2001-07-31 NA         NA            NA
4     1 2000-01-29 2001-04-30 2000-01-01 2001-07-31     1
5     1 2001-05-01 2001-07-31 NA         NA            NA

解决方案 #

通过以下步骤实现需求：

1. 截断原区间到基准范围内，确保只保留有效区间
2. 提取所有断点，生成基准范围内的完整连续区间
3. 合并原区间并标记ind变量

代码如下：

library(dplyr)
library(tidyr)

# 1. 截断原区间至基准范围，保留有效区间
processed <- have %>%
  group_by(ID) %>%
  mutate(
    date1 = pmax(date1, start),
    date2 = pmin(date2, end)
  ) %>%
  filter(date1 <= date2) %>%
  select(ID, date1, date2, ind) %>%
  ungroup()

# 2. 生成基准范围内的所有连续区间
full_intervals <- processed %>%
  group_by(ID) %>%
  mutate(
    base_start = first(have$start),
    base_end = first(have$end)
  ) %>%
  # 提取所有断点：基准起点、原区间终点+1、原区间起点、基准终点+1
  summarize(
    breakpoints = c(base_start, date2 + 1, date1, base_end + 1) %>% unique() %>% sort()
  ) %>%
  rowwise() %>%
  # 从断点生成连续区间
  mutate(
    intervals = list(tibble(
      date1 = breakpoints[-length(breakpoints)],
      date2 = breakpoints[-1] - 1
    ))
  ) %>%
  unnest(intervals) %>%
  ungroup() %>%
  filter(date1 <= date2)

# 3. 合并原区间，标记ind变量
result <- full_intervals %>%
  left_join(processed, by = c("ID", "date1", "date2")) %>%
  mutate(ind = ifelse(is.na(ind), 0, ind)) %>%
  select(ID, date1, date2, ind) %>%
  arrange(ID, date1)

print(result)

输出结果：

# A tibble: 4 × 4
     ID date1      date2      ind
  <dbl> <date>     <date>     <dbl>
1     1 2000-01-01 2000-01-15     1
2     1 2000-01-16 2000-01-28     0
3     1 2000-01-29 2001-04-30     1
4     1 2001-05-01 2001-07-31     0

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