按组查找时间间隔中的重叠并返回子集 data.frame答案

【问题标题】：Find overlaps in time intervals by group and return subsetted data.frame按组查找时间间隔中的重叠并返回子集 data.frame
【发布时间】：2021-09-25 15:27:06
【问题描述】：

假设我有这个数据框，它有两个 ID (1/2)，它们的开始和结束时间位于三个不同的区域 (A/B/C)：

df <- structure(list(id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2), zone = c("A", 
"B", "A", "C", "B", "A", "B", "A", "B", "C"), start = c(0, 6, 
7, 8, 10, 0, 3, 5, 6, 7), end = c(6, 7, 8, 10, 11, 3, 5, 6, 7, 
11)), row.names = c(NA, -10L), class = "data.frame")

df

   id zone start end
1   1    A     0   6
2   1    B     6   7
3   1    A     7   8
4   1    C     8  10
5   1    B    10  11
6   2    A     0   3
7   2    B     3   5
8   2    A     5   6
9   2    B     6   7
10  2    C     7  11

如果我们查看每个区域，我们可以直观地检查 ID 何时在同一区域中以及何时不在：

split(df,df$zone)

$A
  id zone start end
1  1    A     0   6
3  1    A     7   8
6  2    A     0   3
8  2    A     5   6

$B
  id zone start end
2  1    B     6   7
5  1    B    10  11
7  2    B     3   5
9  2    B     6   7

$C
   id zone start end
4   1    C     8  10
10  2    C     7  11

例如1 和 2 都在 0-3 和 5-6 的区域 A 中，但在其他时间不。

期望的输出

我想提取三个数据帧。

显示时间和区域的数据框：

  zone start end  id
1    A     0   3 1-2
2    A     5   6 1-2
3    B     6   7 1-2
4    C     8  10 1-2

2 & 3：不在一起时的数据帧：

#id=1
  zone start end
1    A     3   5
2    A     7   8
3    B    10  11

#id=2
  zone start end
1    B     3   5
2    C     7   8
3    C    10  11

我一直在尝试使用来自data.table 和intervals 包的foverlaps，但似乎无法找到正确的方法。

例如对每个区域/id 进行子集化，我可以得到一个包含重叠的输出，但它似乎不是完全正确的方向：

A <- split(df,df$zone)$A
Asp <- split(A,A$id)
x <- setDT(Asp[[1]])
y <- setDT(Asp[[2]])

setkey(y, start, end)

foverlaps(x, y, type="any")

   id zone start end i.id i.zone i.start i.end
1:  2    A     0   3    1      A       0     6
2:  2    A     5   6    1      A       0     6
3: NA <NA>    NA  NA    1      A       7     8

非常感谢任何帮助。

编辑：额外的示例数据集似乎对当前建议的解决方案提出了一些问题：

df2 <- structure(list(start = c(0, 5, 6, 8, 10, 13, 15, 20, 22, 26, 
       29, 37, 40, 42, 0, 3, 6, 9, 15, 20, 25, 33, 35, 40), id = c(1, 
       1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 
       2, 2), zone = c("A", "B", "A", "D", "C", "B", "C", "B", "A", 
       "B", "A", "D", "C", "D", "A", "B", "C", "D", "A", "B", "C", "B", 
       "A", "D"), end = c(5, 6, 8, 10, 13, 15, 20, 22, 26, 29, 37, 40, 
       42, 45, 3, 6, 9, 15, 20, 25, 33, 35, 40, 45)), class = c("data.table", "data.frame"), row.names = c(NA, -24L))
          
df2

    start id zone end
 1:     0  1    A   5
 2:     5  1    B   6
 3:     6  1    A   8
 4:     8  1    D  10
 5:    10  1    C  13
 6:    13  1    B  15
 7:    15  1    C  20
 8:    20  1    B  22
 9:    22  1    A  26
10:    26  1    B  29
11:    29  1    A  37
12:    37  1    D  40
13:    40  1    C  42
14:    42  1    D  45
15:     0  2    A   3
16:     3  2    B   6
17:     6  2    C   9
18:     9  2    D  15
19:    15  2    A  20
20:    20  2    B  25
21:    25  2    C  33
22:    33  2    B  35
23:    35  2    A  40
24:    40  2    D  45
    start id zone end

【问题讨论】：

标签： r dataframe data.table

【解决方案1】：

更新的解决方案 我对之前的解决方案进行了一些修改，以便它可以与新呈现的数据集df2 一起使用：

我尝试在每个区域中创建 id == 1 和 id == 2 的所有组合，以尝试找到它们的交点
然后我创建了一个自定义函数来获取我们数据集的一个子集加上一对ids 来提取它们的start 到end 值，这样我们就有两个向量，我们可以很容易地找到它们的交点 ` 最后，我将此函数应用于我们数据集的每个子集

library(dplyr)
library(tidyr)
library(purrr)

fn <- function(data, x, y) {
  base::intersect(data %>%
                    filter(row_number() == x) %>%
                    select(start, end) %>%
                    {map2(.$start, .$end, ~ .x:.y)} %>%
                    unlist(), 
                  data %>%
                    filter(row_number() == y) %>%
                    select(start, end) %>%
                    {map2(.$start, .$end, ~ .x:.y)} %>%
                    unlist())
}

然后我们将它应用到我们的数据集上：

split(df2, df2$zone) %>%
  map(~ .x %>% 
        mutate(grp = row_number()) %>%
        {expand.grid(.$grp[.$id == 1], .$grp[.$id == 2])} %>%
        rowwise() %>%
        mutate(insec = list(fn(.x, Var1, Var2))) %>%
        filter(length(insec) != 0) %>%
        unnest(cols = c(insec)) %>%
        group_by(Var1, Var2) %>%
        filter(row_number() == 1 | row_number() == n()) %>%
        filter(n() > 1) %>%
        mutate(id = row_number()) %>%
        pivot_wider(names_from = id, values_from = insec) %>%
        ungroup()) %>%
  keep(~ nrow(.x) != 0) %>%
  imap_dfr(~ .x %>% 
             mutate(zone 
                    = .y) %>%
             select(!starts_with("Var"))) %>%
  relocate(zone) %>%
  rename(start = `1`, end = `2`)

# A tibble: 6 x 3
  zone  start   end
  <chr> <int> <int>
1 A         0     3
2 A        35    37
3 B         5     6
4 B        20    22
5 D         9    10
6 D        42    45

【讨论】：

谢谢。它似乎确实适用于示例数据集，但似乎不能推广到其他类似的数据集，例如df2 在已编辑的问题中 - 我不确定为什么
@jalapic 我对之前的解决方案进行了一些修改，因此它现在可以与df2 一起使用。请您检查一下您的原始数据集，如果我需要对此进行更多改进，请告诉我。

【解决方案2】：

对于第一个data.frame，你也可以使用non-equi join：

ovlap <- df[df, on=.(zone, id<id, start<end, end>start), nomatch=0L,
    .(zone, id2=i.id, i.start, i.end, id1=x.id, x.start, x.end)][,
        .(start=max(x.start, i.start), end=min(x.end, i.end)), 
        .(zone, id1, id2, i.start)][,
            i.start := NULL][]
#   zone id1 id2 start end
#1:    A   1   2     0   3
#2:    A   1   2     5   6
#3:    B   1   2     6   7
#4:    C   1   2     8  10

对于其他输出 data.frames，您可以先与前一个结果执行非等连接，然后为每个间隔找到其他伙伴不在的子间隔：

rangeDiff <- function(DT) {
    DT[, 
        if (is.na(x.start[1L])) {
            .(start=i.start, end=i.end)   
        } else {
            .(start=c(i.start, x.end+1L),
                end=c(x.start-1L, i.end))
        }, 
        .(zone, id, i.start, i.end)][
            start<=end][,
                c("i.start","i.end") := NULL][]
} #rangeDiff

rangeDiff(ovlap[df[id==1L], on=.(zone, id1=id, start<end, end>start),
    .(zone, id, i.start, i.end, x.start, x.end)])
#   zone id V1 V2
#1:    A  1  4  4
#2:    A  1  7  8
#3:    B  1 10 11


rangeDiff(ovlap[df[id==2L], on=.(zone, id2=id, start<end, end>start),
    .(zone, id, i.start, i.end, x.start, x.end)])
#   zone id V1 V2
#1:    B  2  3  5
#2:    C  2  7  7
#3:    C  2 11 11

在 OP 中存在一些不一致之处，即区间的边界是包含还是不包含。当两个 id 都在同一个区域（即在第一个输出 data.frame 中）时，我使用了包容性。

编辑：显示df2的输出

ovlap

#   zone id1 id2 start end
#1:    A   1   2     0   3
#2:    A   1   2    35  37
#3:    B   1   2     5   6
#4:    B   1   2    20  22
#5:    D   1   2     9  10
#6:    D   1   2    42  45

其他需要的data.frames：

rangeDiff(ovlap[df[id==1L], on=.(zone, id1=id, start<end, end>start),
    .(zone, id, i.start, i.end, x.start, x.end)])
#     zone id start end
#  1:    A  1     4   5
#  2:    A  1     6   8
#  3:    A  1    22  26
#  4:    A  1    29  34
#  5:    B  1    13  15
#  6:    B  1    26  29
#  7:    C  1    10  13
#  8:    C  1    15  20
#  9:    C  1    40  42
# 10:    D  1     8   8
# 11:    D  1    37  40

rangeDiff(ovlap[df[id==2L], on=.(zone, id2=id, start<end, end>start),
    .(zone, id, i.start, i.end, x.start, x.end)])
#    zone id start end
# 1:    A  2    15  20
# 2:    A  2    38  40
# 3:    B  2     3   4
# 4:    B  2    23  25
# 5:    B  2    33  35
# 6:    C  2     6   9
# 7:    C  2    25  33
# 8:    D  2    11  15
# 9:    D  2    40  41

df2 按区域排序以便于检查：

    start id zone end
 1:     0  1    A   5
 2:     6  1    A   8
 3:    22  1    A  26
 4:    29  1    A  37
 5:     0  2    A   3
 6:    15  2    A  20
 7:    35  2    A  40
 8:     5  1    B   6
 9:    13  1    B  15
10:    20  1    B  22
11:    26  1    B  29
12:     3  2    B   6
13:    20  2    B  25
14:    33  2    B  35
15:    10  1    C  13
16:    15  1    C  20
17:    40  1    C  42
18:     6  2    C   9
19:    25  2    C  33
20:     8  1    D  10
21:    37  1    D  40
22:    42  1    D  45
23:     9  2    D  15
24:    40  2    D  45

【讨论】：

感谢您的建议回答。我用类似的数据集（编辑问题中的df2）尝试了它，但它似乎不起作用。有什么我应该改变以使其具有普遍性的吗？

【解决方案3】：

这似乎有效，过滤 foverlaps 输出：

DT = data.table(df)
setkey(DT, start, end)
oDT0 = foverlaps(DT[id==1], DT[id==2])
oDT0[, `:=`(
  ostart = pmax(start, i.start),
  oend = pmin(end, i.end)
)]
oDT = oDT0[ostart < oend]

# together
oDT[zone == i.zone, .(ids = '1-2', zone, ostart, oend)]
#    ids zone ostart oend
# 1: 1-2    A      0    3
# 2: 1-2    A      5    6
# 3: 1-2    B      6    7
# 4: 1-2    C      8   10

# apart
oDT[zone != i.zone, .(id, zone, i.id, i.zone, ostart, oend)]
#    id zone i.id i.zone ostart oend
# 1:  2    B    1      A      3    5
# 2:  2    C    1      A      7    8
# 3:  2    C    1      B     10   11

重复新的输入...不确定是否正确，因为没有提供预期的输出：

> DT = data.table(df2)
> ...
> oDT[zone == i.zone, .(ids = '1-2', zone, ostart, oend)]
   ids zone ostart oend
1: 1-2    A      0    3
2: 1-2    B      5    6
3: 1-2    D      9   10
4: 1-2    B     20   22
5: 1-2    A     35   37
6: 1-2    D     42   45
> oDT[zone != i.zone, .(id, zone, i.id, i.zone, ostart, oend)]
    id zone i.id i.zone ostart oend
 1:  2    B    1      A      3    5
 2:  2    C    1      A      6    8
 3:  2    C    1      D      8    9
 4:  2    D    1      C     10   13
 5:  2    D    1      B     13   15
 6:  2    A    1      C     15   20
 7:  2    B    1      A     22   25
 8:  2    C    1      A     25   26
 9:  2    C    1      B     26   29
10:  2    C    1      A     29   33
11:  2    B    1      A     33   35
12:  2    A    1      D     37   40
13:  2    D    1      C     40   42

我怀疑有一种方法可以将参数传递给foverlaps，以避免需要通过ostart 和oend 定义和过滤。截至该软件包的最新 CRAN 版本，文档表明 minoverlap 尚未实现，所以现在可能有必要。

【讨论】：

【解决方案4】：

我想你快到了。您可以通过定义函数f来尝试下面的代码

f <- function(A) {
    Asp <- split(A, by = "id")
    u <- na.omit(foverlaps(Asp[[1]], setkey(Asp[[2]], start, end)))
    r <- c()
    for (k in 1:nrow(u)) {
        if (u[k, end - start < i.end - i.start]) {
            p <- u[k, .(start, end)]
        } else {
            p <- u[k, .(start = i.start, end = i.end)]
        }
        r[[k]] <- p
    }
    cbind(
        zone = u[, zone],
        rbindlist(r),
        id = paste0(unique(A[, id]), collapse = "-")
    )
}

然后运行

rbindlist(Map(f, split(setDT(df), by = "zone")))

给了

> rbindlist(Map(f, split(setDT(df), by = "zone")))
   zone start end  id
1:    A     0   3 1-2
2:    A     5   6 1-2
3:    B     6   7 1-2
4:    C     8  10 1-2

【讨论】：

太棒了 - 谢谢。有没有办法在时间/区域不重叠时也能够返回数据帧？
@jalapic 我猜你可以使用anti_join(df, out[, id := NULL])，其中out 是我的答案中的输出。
谢谢你，虽然我注意到它不太好用。例如，假设id1 从 29 到 37 在区域 A，而 id2 从 35 到 40 在区域 A。行：` if (u[k, end - start
如果没有重叠似乎也存在问题，例如df2 中的 C 区。可以通过在循环中添加另一个 if else 部分来解决这个问题？