logo标签列表

按组查找时间间隔重叠，并返回子数据框。

rdataframedata.table
5

假设我有这个数据框，其中包含两个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区域一起，但其他时间不在一起。

期望输出

我想要提取三个数据框。

  1. 一个数据框显示它们在一起的时间和区域：
  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: 数据框（Dataframes）在它们不在一起时的处理：

#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
4个回答
4
这个看起来可行，通过过滤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尚未实现，因此现在可能是必需的。

3

我认为你已经接近成功了。你可以通过定义一个函数 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
@jalapic 我猜你可以使用anti_join(df, out[, id := NULL])，其中out是我答案中的输出。 - ThomasIsCoding
谢谢您提供的内容，但我注意到它并不完全有效。例如，假设id1在29到37的A区域内，而id2在35到40的A区域内。这行代码：if (u[k, end - start < i.end - i.start]) {会导致返回开始和结束时间为35和40，但实际上应该是37和40。我已经将一个示例数据集编辑到问题中。 - jalapic
如果没有重叠，例如df2中的区域C，似乎也存在问题。这可能可以通过在循环中添加另一个if else部分来解决？ - jalapic
3

对于第一个数据框，您也可以使用非等连接：

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

对于其他输出数据框，您可以先执行一个非等连接与前面的结果，然后针对每个区间找到另一个伙伴不在场的子区间：

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 在同一区域时（即在第一个输出数据框中），我使用了包含的边界。
编辑：显示 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

其他必需的数据框：

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），但似乎并没有起作用。是否有什么需要更改以使其具有普适性？ - jalapic
3

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

  • 我尝试在每个区域内创建所有id == 1和id == 2的组合，以尝试找到它们的交集
  • 然后，我创建了一个自定义函数来获取我们数据集的子集和一对id，以提取它们的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
1
@jalapic，我对之前的解决方案进行了一些修改，现在它可以与df2一起使用。您能否在原始数据集上检查一下，并让我知道是否需要更多改进。 - Anoushiravan R
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接