在 R 中求和 Overlapping/Non-Overlapping 个时间间隔

Question

这是一个关注：

我有一个时间相关事件的数据框。

使用与之前相同的示例数据：

Name     Event Order     Sequence     start_event     end_event     duration     Group 
JOHN     1               A               0               19          19           ID1
JOHN     2               A               60              112         52           ID1  
JOHN     3               A               392             429         37           ID1  
JOHN     4               B               282             329         47           ID1
JOHN     5               C               147             226         79           ID1  
JOHN     6               C               566             611         45           ID1  
ADAM     1               A               0               79          56           ID2
ADAM     2               A               384             407         23           ID2  
ADAM     3               B               0               79          79           ID2  
ADAM     4               B               505             586         81           ID2
ADAM     5               C               140             205         65           ID2  
ADAM     6               C               522             599         77           ID2

我对所有不同的分组都有重叠的时间段，但我现在正在寻找所有不同名称之间的准确共享时间总数（最终 df 中将有 20 多个）- 仍然取决于它们被分组到的顺序。

例如，使用 John 和 Adam 在 A 组中的“0”秒开始时间，我知道他们在 0-79 秒的共同点之间重叠（他们两人之间的最大终点将出现在重叠功能），但他们的总实际共享时间仅为 19 秒（从 0 到 19，当约翰停用时）。

另一个实例将在序列 C 中，John 活跃时间为 566-611 秒，Adam 活跃时间为 522-599 秒，总共享活跃时间为 33 秒（从 John 开始 activity 566 和 Adam 在 599 停用）。

我想要的输出是这种风格：

"John + Adam": total shared active time

"John - Adam": total active time (John without Adam, excludes time where they are active together)

"Adam - John": total active time (Adam without John, excludes time where they are active together)

并继续对数据框中 20 多个名称和组合的所有排列

谢谢！

Answer 1

一种方法如下：

lines <- "Name  Event Order Sequence    start_event end_event   duration    Group
JOHN    1   A   0   19  19  ID1
JOHN    2   A   60  112 52  ID1
JOHN    3   A   392 429 37  ID1
JOHN    4   B   282 329 47  ID1
JOHN    5   C   147 226 79  ID1
JOHN    6   C   566 611 45  ID1
ADAM    1   A   0   79  56  ID2
ADAM    2   A   384 407 23  ID2
ADAM    3   B   0   79  79  ID2
ADAM    4   B   505 586 81  ID2
ADAM    5   C   140 205 65  ID2
ADAM    6   C   522 599 77  ID2"

con <- textConnection(lines)
df <- read.delim(con)
close(con)

extract_interval_as_vector <- function(df) {
  as.vector(t(subset(df,select=c('start_event','end_event'))))
}

sum_length_of_overlaps <- function(v1,v2) {
  id <- rep(c(1,0),c(length(v1),length(v2)))
  m <- rbind(id,1-id,c(v1,v2))
  m <- m[,order(m[3,])]
  idx <- which(cumsum(m[1,]) %% 2 & cumsum(m[2,]) %% 2)
  if(length(idx)) sum(sapply(idx,function(i) m[3,i+1]-m[3,i]))
  else 0
}
sum_length <- function(v) {
  sum(v[seq(2,length(v),2)]-v[seq(1,length(v),2)])
}

all_names <- unique(df$Name)
combs <- combn(all_names,2)

l = list()

for(i in 1:ncol(combs)) {
  df.sub1 <- subset(df,Name == combs[1,i])
  df.sub2 <- subset(df,Name == combs[2,i])
  l1 <- sum_length(extract_interval_as_vector(df.sub1)) #sum(df.sub1$duration)
  l2 <- sum_length(extract_interval_as_vector(df.sub2)) #sum(df.sub2$duration)
  seqs <- unique(df$Sequence)
  overlap <- sum(sapply(seqs,function(s) {
    v1 <- extract_interval_as_vector(subset(df.sub1,Sequence == s))
    v2 <- extract_interval_as_vector(subset(df.sub2,Sequence == s))
    sum_length_of_overlaps(v1,v2)
  }))
  l[[paste(combs[,i],collapse=" + ")]] = overlap
  l[[paste(combs[,i],collapse=" - ")]] = l1 - overlap
  l[[paste(rev(combs[,i]),collapse=" - ")]] = l2 - overlap
}

备注：

l1 和 l2 可以直接从 df 计算出来（如注释所示），但是 ADAM 1 A 0 79 56 ID2 行包含一个奇怪的持续时间）
sum_length_of_overlaps 通过查找位于两个区间内的点来工作（如果在排序列表中看到来自两个区间列表的奇数个起点和终点，就会出现这种情况）。这些是相交区域的第一个点。注意：如果其中一个向量包含重叠间隔，sum_length_of_overlaps 将无法正常工作。

示例：（sum_length_of_overlaps 的工作原理）

考虑序列的间隔 A:

> subset(df,Sequence=="A")
  Name Event.Order Sequence start_event end_event duration Group
1 JOHN           1        A           0        19       19   ID1
2 JOHN           2        A          60       112       52   ID1
3 JOHN           3        A         392       429       37   ID1
7 ADAM           1        A           0        79       56   ID2
8 ADAM           2        A         384       407       23   ID2

仅将 start_event 和 end_event row-wise 放入单独的向量中 JOHN 和 ADAM 得到

> v.john <- extract_interval_as_vector(subset(df,Sequence == "A" & Name == "JOHN"))
> v.john
[1]   0  19  60 112 392 429
> v.adam <- extract_interval_as_vector(subset(df,Sequence == "A" & Name == "ADAM"))
> v.adam
[1]   0  79 384 407

如果加入这些向量并对生成的向量进行排序，则有必要跟踪哪个点属于哪个区间序列。因此，将此联合向量与指标行一起放入矩阵中很有用：

> id <- rep(c(1,0),c(length(v.john),length(v.adam)))
> m <- rbind(id,1-id,c(v.john,v.adam))
> m
   [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
id    1    1    1    1    1    1    0    0    0     0
      0    0    0    0    0    0    1    1    1     1
      0   19   60  112  392  429    0   79  384   407

排序后仍然可以通过查看第一行或第二行来找出原始组：

> m <- m[,order(m[3,])]
> m
   [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
id    1    0    1    1    0    1    0    1    0     1
      0    1    0    0    1    0    1    0    1     0
      0    0   19   60   79  112  384  392  407   429

由于当且仅当在每组中都看到了一个区间的起点，但没有看到对应的终点，所以才算相交，所以统计每组看到的点数就足够了。如果从每组中看到的点数是奇数，则该点是交叉点的起点：

> m[1,] <- cumsum(m[1,]) %% 2
> m[2,] <- cumsum(m[2,]) %% 2
> m
   [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
id    1    1    0    1    1    0    0    1    1     0
      0    1    1    1    0    0    1    1    0     0
      0    0   19   60   79  112  384  392  407   429

这样一看就知道m[3,2]、m[3,4]、m[3,8]是交点的起点。（也参见下面的手动推导）

输出:

> l
$`JOHN + ADAM`
[1] 144

$`JOHN - ADAM`
[1] 135

$`ADAM - JOHN`
[1] 260

人工推导JOHN + ADAM:

顺序交叉点A：
- [0,19], [0,79] => 长度 19
- [60,112], [0,79] => 长度 19
- [392,429], [384,407] => 长度 15
顺序交叉点B：None
顺序交叉点C：
- [147,226], [140,205] => 长度 58
- [566,611], [522,599] => 长度 33

路口总长度=19+19+15+58+33=144

在 R 中求和 Overlapping/Non-Overlapping 个时间间隔

Sum Overlapping/Non-Overlapping Time Intervals in R

r

time

dplyr

intervals

overlap