R 中重叠/非重叠时间间隔的总和

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 多个） - 仍然取决于它们分组的顺序到。

例如，使用 A 组中 John 和 Adam 的开始时间“0”秒，我知道它们在 0-79 秒的共性之间重叠（他们两个之间的最大终点将显示在重叠函数中），但他们的实际共享总时间只有 19 秒（从 0 到 19，约翰停用时）。

另一个实例是序列 C，John 在 566-611 秒内处于活动状态，Adam 在 522-599 秒内处于活动状态，总共享活动时间为 33 秒（从 John 在 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逐行放入单独的向量中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：

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

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