合并 data.table 中部分重叠的日期范围

Question

假设我有两个 tables（DT_sportA 和 DT_sportB）测量两个 children（id）进行运动的时间段“A”和“B”。

library(data.table)
library(lubridate)

DT_sportA <- data.table(id = rep(1:2,each=2),
                start_date = ymd(c("2000-01-01","2002-01-15","2014-03-12","2016-10-14")),
                end_date = ymd(c("2000-02-03","2003-03-01","2014-04-03","2017-05-19")))
DT_sportA
#    id start_date   end_date
# 1:  1 2000-01-01 2000-02-03
# 2:  1 2002-01-15 2003-03-01
# 3:  2 2014-03-12 2014-04-03
# 4:  2 2016-10-14 2017-05-19


DT_sportB <- data.table(id = c(1L,1L,2L),
                        start_date = ymd(c("2000-01-15","2002-01-15","2017-02-10")),
                        end_date = ymd(c("2000-02-01","2006-03-19","2017-02-20")))

DT_sportB
#    id start_date   end_date
# 1:  1 2000-01-15 2000-02-01
# 2:  1 2002-01-15 2006-03-19
# 3:  2 2017-02-10 2017-02-20

我想生成一个新的 table，其中包含所有唯一且重叠的日期范围，以及两个表示 children 参加的运动的分类指标。所需的 DT 应如下所示：

   id start_date   end_date sportA sportB
1:  1 2000-01-01 2000-01-14      1      0
2:  1 2000-01-15 2000-02-01      1      1
3:  1 2000-02-02 2000-02-03      1      0
4:  1 2002-01-15 2002-03-01      1      1
5:  1 2002-03-02 2002-03-19      0      1
6:  2 2014-03-12 2014-04-03      1      0
7:  2 2016-10-14 2017-02-09      1      0
8:  2 2017-02-10 2017-02-20      1      1
9:  2 2017-02-21 2017-05-19      1      0

这是一个相当简单的玩具示例。真实数据跨越数百万行和大约 20 个“运动”，这就是我寻找 data.table 解决方案的原因。

Answer 1

备注：

当对多个表执行 similar/same 操作时，我发现将它们作为 list of tables 而不是单个对象进行操作几乎总是更可取；虽然这个解决方案在没有这个的情况下通常也能工作（需要一些调整），但我相信它让很多事情都值得改变主意；
此外，我实际上认为长格式比这里的列表更好，因为我们仍然可以轻松区分 id 和 sport；
您的预期输出在避免行之间重叠方面有点不一致；例如，"2000-01-14" 不在数据中，但它是 end_date，这表明 "2000-01-15" 已减少，因为下一行从该日期开始......但开始于"2000-02-02" 出于明显相似（但相反）的原因；解决这个问题的一种方法是从 end_date 中减去一个非常低的数字，这样 id/sport/date 范围就不会匹配多行，我说“低数字”而不是 1 因为 Date-class对象实际上是numeric，日期可以是小数：虽然不是小数显示，但它仍然是小数，比较Sys.Date()-0.1和dput(Sys.Date()-0.1)。

sports <- rbindlist(mget(ls(pattern = "DT_sport.*")), idcol = "sport")
sports[, sport := gsub("^DT_", "", sport) ] # primarily aesthetics
#     sport    id start_date   end_date
#    <char> <int>     <Date>     <Date>
# 1: sportA     1 2000-01-01 2000-02-03
# 2: sportA     1 2002-01-15 2003-03-01
# 3: sportA     2 2014-03-12 2014-04-03
# 4: sportA     2 2016-10-14 2017-05-19
# 5: sportB     1 2000-01-15 2000-02-01
# 6: sportB     1 2002-01-15 2006-03-19
# 7: sportB     2 2017-02-10 2017-02-20

我倾向于喜欢滚边 data.table，因为我还在使用 R-4.0.5，所以我使用 magrittr::%>%；它不是严格要求的，但我觉得它有助于提高可读性（以及因此的可维护性等）。（我不知道这在 R-4.1 的原生 |> 管道中是否会同样容易地工作，因为它对 RHS 数据放置有更多限制。）

library(magrittr)
out <- sports[, {
  vec <- sort(unique(c(start_date, end_date)));
  .(sd = vec[-length(vec)], ed = vec[-1]);
}, by = .(id) ] %>%
  .[, ed := pmin(ed, shift(sd, type = "lead") - 1e-5, na.rm = TRUE), by = .(id) ] %>%
  sports[., on = .(id, start_date <= sd, end_date >= ed) ] %>%
  .[ !is.na(sport), ] %>%
  .[, val := 1L ] %>%
  dcast(id + start_date + end_date ~ sport, value.var = "val", fill = 0)
out
#       id start_date   end_date sportA sportB
#    <int>     <Date>     <Date>  <int>  <int>
# 1:     1 2000-01-01 2000-01-14      1      0
# 2:     1 2000-01-15 2000-01-31      1      1
# 3:     1 2000-02-01 2000-02-02      1      0
# 4:     1 2002-01-15 2003-02-28      1      1
# 5:     1 2003-03-01 2006-03-19      0      1
# 6:     2 2014-03-12 2014-04-02      1      0
# 7:     2 2016-10-14 2017-02-09      1      0
# 8:     2 2017-02-10 2017-02-19      1      1
# 9:     2 2017-02-20 2017-05-19      1      0

演练：

第一个sports[, {...}]只产生可行的日期范围，per-id；它会产生比需要更多的东西，这些会在稍后过滤掉；我将它与 end_date 的轻微偏移相结合，以便行相互排斥（上面的第二个注释）；虽然它们 看起来 相隔了整整一天，但它们只相隔不到 1 秒；我添加 secdiff 以在此处显示：

sports[, {
  vec <- sort(unique(c(start_date, end_date)));
  .(sd = vec[-length(vec)], ed = vec[-1]);
}, by = .(id) ] %>%
  .[, ed := pmin(ed, shift(sd, type = "lead") - 1e-5, na.rm = TRUE), by = .(id) ] %>%
  .[, secdiff := c(as.numeric(sd[-1] - ed[-.N], units="secs"), NA), by = .(id) ]
#        id         sd         ed   secdiff
#     <int>     <Date>     <Date>     <num>
#  1:     1 2000-01-01 2000-01-14 0.8640000
#  2:     1 2000-01-15 2000-01-31 0.8640000
#  3:     1 2000-02-01 2000-02-02 0.8640000
#  4:     1 2000-02-03 2002-01-14 0.8640000  # will be empty post-join
#  5:     1 2002-01-15 2003-02-28 0.8640000
#  6:     1 2003-03-01 2006-03-19        NA
#  7:     2 2014-03-12 2014-04-02 0.8640001
#  8:     2 2014-04-03 2016-10-13 0.8640001  # will be empty post-join
#  9:     2 2016-10-14 2017-02-09 0.8640001
# 10:     2 2017-02-10 2017-02-19 0.8640001
# 11:     2 2017-02-20 2017-05-19        NA

顺便说一句，上一个项目符号中 sports[..] 的第一个操作是 {-blocked 以稍微提高效率，选择不 sort(unique(c(start_date, end_date))) 两次;
在 id 和日期范围内加入 sports；这将在 sport 列中生成 NA 值，该值指示以编程方式创建的日期范围（具有简单的日期序列）但未分配任何运动； !is.na(sport);
删除了这些不需要的行
赋值val := 1L纯粹是为了让我们在reshaping时有一个值列；
dcast 用 0.
重塑和填充缺失值

合并 data.table 中部分重叠的日期范围

Merge partially overlapping date ranges in data.table

r

data.table