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

时间:2017-01-24 21:25:58

标签: r time dplyr intervals overlap

以下是:Find matching intervals in data frame by range of two column values

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

使用与以前相同的样本数据:

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,当John停用时)。

另一个实例是序列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多个名称和组合的所有排列

谢谢!

1 个答案:

答案 0 :(得分:2)

一种方法如下:

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
}

说明:

  • l1l2可以直接从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_eventend_event逐行放入JOHNADAM的单独向量中获取

> 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] =&gt;长度19
    • [60,112],[0,79] =&gt;长度19
    • [392,429],[384,407] =&gt;长度15
  2. 序列中的交叉点B:无
  3. 序列中的交叉点C
    • [147,226],[140,205] =&gt;长度58
    • [566,611],[522,599] =&gt;长度33
  4. 交叉点的总长度= 19 + 19 + 15 + 58 + 33 = 144