R-（Tidyverse）将多个观测值压缩为一个

我有一个数据集，它有多个变量，其中两个是日期（开始日期、结束日期）。有时，一个日期间隔被划分为多个序列，例如：

开始时间：1990-12-12，停止时间：1990-12-13 开始时间：1990-12-13，停止时间：1990-12-14

而不是

开始时间：1990-12-12，停止时间：1990-12-14

我想做的是隔离这些序列链，基本上将它们折叠成一个观察值，这样序列末尾的所有观察值都会被保存，其余的都会被覆盖（第一个开始日期除外）。以下是一个基本示例：

library(tidyverse)
library(lubridate)

tib_ex <- tibble(
  id = rep(1,5),
  date1 = ymd(c('1990-11-05', '1990-12-01', 
                '1990-12-05', '1990-12-08', 
                '1990-12-15')),
  date2 = ymd(c('1990-11-28', '1990-12-05', 
                '1990-12-08', '1990-12-12', 
                '1990-12-31')),
  var1 = 2:6,
  var2 = 7:11,
  var3 = 12:16,
  var4 = c(0, 1, 0 ,0, 1)
)

库（tidyverse）
图书馆（lubridate）
tib_ex通过与下一行/上一行进行比较，找到具有开始和结束日期的行，并以适当的方式组合结果：

date_info <- 
  tib_ex %>% 
  ## find indices of start and end dates by comparing with date in next / previous row
  mutate(is_startdate = date1 != lag(date2),
         is_enddate = date2 != lead(date1)) %>% 
  ## NA's appear at the beginning (start_date) and end (end_date) and should thus be interpreted as TRUE
  replace_na(list(is_startdate = T, is_enddate = T))

## combine the start- and end-dates
date_info %>% 
  filter(is_enddate) %>% 
  mutate(date1 = date_info$date1[date_info$is_startdate]) %>% 
  select(-starts_with("is_"))

-------
# A tibble: 3 x 7
id date1      date2       var1  var2  var3  var4
<dbl> <date>     <date>     <int> <int> <int> <dbl>
1  1.00 1990-11-05 1990-11-28     2     7    12  0   
2  1.00 1990-12-01 1990-12-12     5    10    15  0   
3  1.00 1990-12-15 1990-12-31     6    11    16  1.00

日期信息%
##通过与下一行/上一行中的日期进行比较，查找开始日期和结束日期的索引
突变（is_startdate=date1！=滞后（date2），
是_enddate=date2！=lead（date1））%>%
##NA出现在开始（开始日期）和结束（结束日期），因此应解释为真
替换（列表（开始日期=T，结束日期=T））
##合并开始日期和结束日期
日期信息%>%
过滤器（is_enddate）%>%
变异（date1=日期\u信息$date1[日期\u信息$is\u开始日期]）%>%
选择（-start_with（“is_”））
-------
#一个tibble:3x7
id date1 date2 var1 var2 var3 var4
1  1.00 1990-11-05 1990-11-28     2     7    12  0   
2  1.00 1990-12-01 1990-12-12     5    10    15  0   
3  1.00 1990-12-15 1990-12-31     6    11    16  1.00
如果数据集包含多个
id
，则这里有一种不同的方法也可以使用。根据OP的预期结果，额外变量
var1
至
var4
通过在每个崩溃期结束时选取值进行聚合/汇总

下面的方法


使用
cumsum（）
和
lag（）
标识属于一个时段的行
使用
summary（）
折叠开始日期和结束日期
并与原始数据集联接，以拾取每个折叠时段结束时的值

最后一步避免在调用
summary（）
时包含所有其他变量

为
id=2
复制OPs数据集：

#一个tible:10 x 7
id date1 date2 var1 var2 var3 var4
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-01 1990-12-05     3     8    13     1
3     1 1990-12-05 1990-12-08     4     9    14     0
4     1 1990-12-08 1990-12-12     5    10    15     0
5     1 1990-12-15 1990-12-31     6    11    16     1
6     2 1990-11-05 1990-11-28     2     7    12     0
7     2 1990-12-01 1990-12-05     3     8    13     1
8     2 1990-12-05 1990-12-08     4     9    14     0
9     2 1990-12-08 1990-12-12     5    10    15     0
10     2 1990-12-15 1990-12-31     6    11    16     1

tib_ex%>%
绑定行(
（.）%>%突变（id=2））%>%
安排（id，date1，date2）%>%#这很重要！
分组依据（id）%>%
mutate（period=cumsum（滞后（date2，默认值=date1[1]）%
右翼(
（.）%>%分组依据（id，期间）%>%
汇总（date1=第一个（date1），date2=最后一个（date2）），
by=c（“id”，“period”，“date2”），后缀=c（“，.y”））%>%
选择（-period，-date1.y）

#一个tible:6 x 7
#组别:id[2]
id date1 date2 var1 var2 var3 var4
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-08 1990-12-12     5    10    15     0
3     1 1990-12-15 1990-12-31     6    11    16     1
4     2 1990-11-05 1990-11-28     2     7    12     0
5     2 1990-12-08 1990-12-12     5    10    15     0
6     2 1990-12-15 1990-12-31     6    11    16     1

太棒了！
# A tibble: 3 x 7
     id date1      date2       var1  var2  var3  var4
  <dbl> <chr>      <chr>      <dbl> <dbl> <dbl> <dbl>
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-01 1990-12-12     5    10    15     0
3     1 1990-12-15 1990-12-31     6    11    16     1

date_info <- 
  tib_ex %>% 
  ## find indices of start and end dates by comparing with date in next / previous row
  mutate(is_startdate = date1 != lag(date2),
         is_enddate = date2 != lead(date1)) %>% 
  ## NA's appear at the beginning (start_date) and end (end_date) and should thus be interpreted as TRUE
  replace_na(list(is_startdate = T, is_enddate = T))

## combine the start- and end-dates
date_info %>% 
  filter(is_enddate) %>% 
  mutate(date1 = date_info$date1[date_info$is_startdate]) %>% 
  select(-starts_with("is_"))

-------
# A tibble: 3 x 7
id date1      date2       var1  var2  var3  var4
<dbl> <date>     <date>     <int> <int> <int> <dbl>
1  1.00 1990-11-05 1990-11-28     2     7    12  0   
2  1.00 1990-12-01 1990-12-12     5    10    15  0   
3  1.00 1990-12-15 1990-12-31     6    11    16  1.00

tib_ex %>% 
  arrange(id, date1, date2) %>%   # this is important!
  group_by(id) %>% 
  mutate(period = cumsum(lag(date2, default = date1[1]) < date1)) %>% 
  right_join(
    (.) %>% group_by(id, period) %>% 
      summarize(date1 = first(date1), date2 = last(date2)),
    by = c("id", "period", "date2"), suffix = c("", ".y")) %>% 
  select(-period, -date1.y) 

# A tibble: 3 x 7
# Groups:   id [1]
     id date1      date2       var1  var2  var3  var4
  <dbl> <date>     <date>     <int> <int> <int> <dbl>
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-08 1990-12-12     5    10    15     0
3     1 1990-12-15 1990-12-31     6    11    16     1

tib_ex %>% 
  bind_rows(
  (.) %>% mutate(id = 2))

# A tibble: 10 x 7
      id date1      date2       var1  var2  var3  var4
   <dbl> <date>     <date>     <int> <int> <int> <dbl>
 1     1 1990-11-05 1990-11-28     2     7    12     0
 2     1 1990-12-01 1990-12-05     3     8    13     1
 3     1 1990-12-05 1990-12-08     4     9    14     0
 4     1 1990-12-08 1990-12-12     5    10    15     0
 5     1 1990-12-15 1990-12-31     6    11    16     1
 6     2 1990-11-05 1990-11-28     2     7    12     0
 7     2 1990-12-01 1990-12-05     3     8    13     1
 8     2 1990-12-05 1990-12-08     4     9    14     0
 9     2 1990-12-08 1990-12-12     5    10    15     0
10     2 1990-12-15 1990-12-31     6    11    16     1

tib_ex %>% 
  bind_rows(
    (.) %>% mutate(id = 2)) %>%
  arrange(id, date1, date2) %>%   # this is important!
  group_by(id) %>% 
  mutate(period = cumsum(lag(date2, default = date1[1]) < date1)) %>% 
  right_join(
    (.) %>% group_by(id, period) %>% 
      summarize(date1 = first(date1), date2 = last(date2)),
    by = c("id", "period", "date2"), suffix = c("", ".y")) %>% 
  select(-period, -date1.y) 

# A tibble: 6 x 7
# Groups:   id [2]
     id date1      date2       var1  var2  var3  var4
  <dbl> <date>     <date>     <int> <int> <int> <dbl>
1     1 1990-11-05 1990-11-28     2     7    12     0
2     1 1990-12-08 1990-12-12     5    10    15     0
3     1 1990-12-15 1990-12-31     6    11    16     1
4     2 1990-11-05 1990-11-28     2     7    12     0
5     2 1990-12-08 1990-12-12     5    10    15     0
6     2 1990-12-15 1990-12-31     6    11    16     1