填补R中咒语（日期范围）之前、之间和之后的空白

Question

假设您有一个包含三个研究参与者的数据框及其进入 (doe) 和退出 (dox) 的日期：

> participants <- data.frame(id = 1:3, 
+            doe = c("1990/01/04","1988/05/02","2001/06/04"), 
+            dox = c("2020/01/02","1999/03/01","2011/05/06"))
> participants
  id        doe        dox
1  1 1990/01/04 2020/01/02
2  2 1988/05/02 1999/03/01
3  3 2001/06/04 2011/05/06

他们三个都在 doe 和 dox 之间的不同时间段被寄养：

> placement_dates<-data.frame(
+           id = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 3L),
+           placement_start = c("1993/04/21","1994/12/04","1994/12/19",
+                  "2000/01/14","2003/11/22","2015/03/03","1993/04/21",
+                  "1993/05/13","1998/02/19","2005/01/31"),
+           placement_end = c("1993/06/01","1994/12/06","1995/05/02",
+                  "2002/12/04","2005/06/01","2019/02/08","1993/05/12",
+                  "1996/01/30","1998/02/28","2006/08/19")
+ )
> placement_dates
   id placement_start placement_end
1   1      1993/04/21    1993/06/01
2   1      1994/12/04    1994/12/06
3   1      1994/12/19    1995/05/02
4   1      2000/01/14    2002/12/04
5   1      2003/11/22    2005/06/01
6   1      2015/03/03    2019/02/08
7   2      1993/04/21    1993/05/12
8   2      1993/05/13    1996/01/30
9   2      1998/02/19    1998/02/28
10  3      2005/01/31    2006/08/19

我现在有兴趣结合参与者和placement_dates 数据框来生成不被寄养（spell_type = A）和被寄养（spell_type = B）的咒语。因此，我想要的输出是：

> desired_df <- data.frame(
+   id = c(1L,1L,1L,1L,1L,1L,1L,1L,
+          1L,1L,1L,1L,1L,2L,2L,2L,2L,2L,2L,3L,3L,3L),
+   spell_start = c("1990/01/04","1993/04/21",
+          "1993/06/02","1994/12/04","1994/12/07","1994/12/19",
+          "1995/05/03","2000/01/14","2002/12/05","2003/11/22",
+          "2005/06/02","2015/03/03","2019/02/09","1988/05/02",
+          "1993/04/22","1993/05/13","1996/01/31","1998/02/19",
+          "1998/03/01","2001/06/04","2005/01/31","2006/08/20"),
+   spell_end = c("1993/04/20","1993/06/01",
+          "1994/12/03","1994/12/06","1994/12/18","1995/05/02",
+          "2000/01/13","2002/12/04","2003/11/21","2005/06/01",
+          "2015/03/02","2019/02/08","2020/01/02","1993/04/21",
+          "1993/05/12","1996/01/30","1998/02/18","1998/02/28",
+          "1999/03/01","2005/01/30","2006/08/19","2011/05/06"),
+   spell_type = c("A","B","A","B","A","B",
+          "A","B","A","B","A","B","A","A","B","B","A","B",
+          "A","A","B","A")
+ )
> desired_df
   id spell_start  spell_end spell_type
1   1  1990/01/04 1993/04/20          A
2   1  1993/04/21 1993/06/01          B
3   1  1993/06/02 1994/12/03          A
4   1  1994/12/04 1994/12/06          B
5   1  1994/12/07 1994/12/18          A
6   1  1994/12/19 1995/05/02          B
7   1  1995/05/03 2000/01/13          A
8   1  2000/01/14 2002/12/04          B
9   1  2002/12/05 2003/11/21          A
10  1  2003/11/22 2005/06/01          B
11  1  2005/06/02 2015/03/02          A
12  1  2015/03/03 2019/02/08          B
13  1  2019/02/09 2020/01/02          A
14  2  1988/05/02 1993/04/21          A
15  2  1993/04/22 1993/05/12          B
16  2  1993/05/13 1996/01/30          B
17  2  1996/01/31 1998/02/18          A
18  2  1998/02/19 1998/02/28          B
19  2  1998/03/01 1999/03/01          A
20  3  2001/06/04 2005/01/30          A
21  3  2005/01/31 2006/08/19          B
22  3  2006/08/20 2011/05/06          A

我的实际数据集包含大约 30 万个不同类型的寄养安置。 spell_type 变量因此更复杂，但我需要一些想法才能开始。我已经查看了 tidyr 包中的完整功能，但我无法针对我的具体问题实现它。

Answer 1

这是一个data.table 选项：

#calculate spell_start
ans <- placement_dates[participants, on=.(id), by=.EACHI,
    .(spell_start=sort(unique(c(doe, placement_start, placement_end+1L))))]

#calculate and populate spell_end
ans[, spell_end := shift(spell_start, -1L) - 1L, id]
ans[is.na(spell_end), spell_end := participants[.SD, on=.(id), dox]]

#populate spell_type
ans[, spell_type := "NotInFoster"][
    placement_dates, on=.(id, spell_start=placement_start, spell_end=placement_end), 
    spell_type := "InFoster"]

输出：

    id spell_start  spell_end  spell_type
 1:  1  1990-01-04 1993-04-20 NotInFoster
 2:  1  1993-04-21 1993-06-01    InFoster
 3:  1  1993-06-02 1994-12-03 NotInFoster
 4:  1  1994-12-04 1994-12-06    InFoster
 5:  1  1994-12-07 1994-12-18 NotInFoster
 6:  1  1994-12-19 1995-05-02    InFoster
 7:  1  1995-05-03 2000-01-13 NotInFoster
 8:  1  2000-01-14 2002-12-04    InFoster
 9:  1  2002-12-05 2003-11-21 NotInFoster
10:  1  2003-11-22 2005-06-01    InFoster
11:  1  2005-06-02 2015-03-02 NotInFoster
12:  1  2015-03-03 2019-02-08    InFoster
13:  1  2019-02-09 2020-01-02 NotInFoster
14:  2  1988-05-02 1993-04-20 NotInFoster
15:  2  1993-04-21 1993-05-12    InFoster
16:  2  1993-05-13 1993-05-12 NotInFoster
17:  2  1993-05-13 1996-01-30    InFoster
18:  2  1996-01-31 1998-02-18 NotInFoster
19:  2  1998-02-19 1998-02-28    InFoster
20:  2  1998-03-01 1999-03-01 NotInFoster
21:  3  2001-06-04 2005-01-30 NotInFoster
22:  3  2005-01-31 2006-08-19    InFoster
23:  3  2006-08-20 2011-05-06 NotInFoster
    id spell_start  spell_end  spell_type

数据：

library(data.table)
participants <- data.frame(id = 1:3, 
    doe = c("1990/01/04","1988/05/02","2001/06/04"), 
    dox = c("2020/01/02","1999/03/01","2011/05/06"))
placement_dates<-data.frame(
      id = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 3L),
      placement_start = c("1993/04/21","1994/12/04","1994/12/19",
             "2000/01/14","2003/11/22","2015/03/03","1993/04/21",
             "1993/05/13","1998/02/19","2005/01/31"),
      placement_end = c("1993/06/01","1994/12/06","1995/05/02",
             "2002/12/04","2005/06/01","2019/02/08","1993/05/12",
             "1996/01/30","1998/02/28","2006/08/19"))

cols <- c("doe","dox")
setDT(participants)[, (cols) := lapply(.SD, as.Date, format="%Y/%m/%d"), .SDcols=cols]
cols <- c("placement_start","placement_end")
setDT(placement_dates)[, (cols) := lapply(.SD, as.Date, format="%Y/%m/%d"), .SDcols=cols]

希望大家都有一个 Oliver Twist 的结局。