R - (Tidyverse) 将多个观察结果压缩为一个

Question

我有一个包含多个变量的数据集，其中两个是日期（开始日期、结束日期）。有时日期间隔已被分成序列，例如您将有：

开始：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)
)

这会产生以下小标题：

# A tibble: 5 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

我想将其转换为以下小标题：

# 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

我考虑过按 id、date1 和 date2 嵌套，它将其余变量打包成每行的一个小标题，以便于覆盖我只是不知道如何有效地将日期从第 2 行折叠到第 4 行.

我尝试创建一个二进制变量来跟踪一次观察的结束日期是否与下一次观察的开始日期相匹配，但我运行也遇到了困难。

Answer 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

Answer 2

这是一种不同的方法，如果数据集包含多个个体，该方法也适用 id。根据 OP 的预期结果，附加变量 var1 到 var4 是 aggregated/summarized，方法是在每个折叠期结束时选择值。

下面的方法

使用cumsum()和lag()来识别属于一个时期的行，
使用 summarize() 折叠开始日期和结束日期，
并加入原始数据集以选取每个折叠周期结束时的值。

最后一步避免在 summarize().

的调用中包含所有附加变量

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

这是一个测试，表明该方法适用于多个 id:

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

复制 id = 2 的 OPs 数据集：

# 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

R - (Tidyverse) 将多个观察结果压缩为一个

R - (Tidyverse) Compress multiple observations into one

r

lubridate

dplyr

tidyverse