Lubridate：按组重叠的间隔

Question

您好，非常感谢！

我正在尝试确定哪些区间与组中的任何其他区间重叠。

例如，如果我们有以下数据：

id <- rep(1:3, each=3)
hospitalization <- seq(ymd_hms("2017-11-28 00:00:01"), by = "day", length.out = length(id))

dat <- data.frame(id, hospitalization)

dat[3,2] <- dat[3,2] + dhours(12)

library(dplyr)
library(lubridate)

dat %>% 
  mutate(
    discharge = hospitalization + dhours(35),
    interval= hospitalization %--% discharge
  ) -> dat

dat

> dat
  id     hospitalization           discharge                                           interval
1  1 2017-11-28 00:00:01 2017-11-29 11:00:01 2017-11-28 00:00:01 UTC--2017-11-29 11:00:01 UTC
2  1 2017-11-29 00:00:01 2017-11-30 11:00:01 2017-11-29 00:00:01 UTC--2017-11-30 11:00:01 UTC
3  1 2017-11-30 12:00:01 2017-12-01 23:00:01 2017-11-30 12:00:01 UTC--2017-12-01 23:00:01 UTC
4  2 2017-12-01 00:00:01 2017-12-02 11:00:01 2017-12-01 00:00:01 UTC--2017-12-02 11:00:01 UTC
5  2 2017-12-02 00:00:01 2017-12-03 11:00:01 2017-12-02 00:00:01 UTC--2017-12-03 11:00:01 UTC
6  2 2017-12-03 00:00:01 2017-12-04 11:00:01 2017-12-03 00:00:01 UTC--2017-12-04 11:00:01 UTC
7  3 2017-12-04 00:00:01 2017-12-05 11:00:01 2017-12-04 00:00:01 UTC--2017-12-05 11:00:01 UTC
8  3 2017-12-05 00:00:01 2017-12-06 11:00:01 2017-12-05 00:00:01 UTC--2017-12-06 11:00:01 UTC
9  3 2017-12-06 00:00:01 2017-12-07 11:00:01 2017-12-06 00:00:01 UTC--2017-12-07 11:00:01 UTC

dat[1,4]
dat[2,4]
dat[3,4]

int_overlaps(dat[1,4],dat[2,4])
int_overlaps(dat[2,4],dat[3,4])
int_overlaps(dat[1,4],dat[3,4])
int_overlaps(dat[1,4],dat[3,4])

我想计算一个布尔值 (overlap_any) 列，指示一个时期是否与同一组中的任何一个（不是全部，而是至少一个）重叠。

当按 id 分组时，id==1 第一个和第二个周期重叠，但它们不与第三个周期重叠。所以对于那个 id overlap_any 应该是 (True,True,False)。

我在想这样的事情：

dat %>% 
  group_by(id) %>% 
  mutate(
    overlap_any = some_function(interval)
  )

但我不知道该怎么做，因为group_by 采用了一个组的所有间隔，而不是我想要评估的当前行是否与其余行重叠。此外，int_overlaps 只接受两个参数。

感谢您的帮助！

Answer 1

我做到了

overlaps_others <- function(y) sapply(y, function(x) sum(int_overlaps(x,y)))-1

dat %>% 
  split(id) %>% 
  lapply(function(z){
    z %>% 
      mutate(
        overlaps = overlaps_others(interval)

      ) %>%
      select(-interval)
  }) %>% 
  bind_rows()