Somme Chevauchement/non-Chevauchement Intervalles dans R

Question

Ceci est un suivi: Find matching intervals in data frame by range of two column values

J'ai une trame de données d'événements liés à temps.

En utilisant les mêmes données d'échantillons comme avant:

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 

Je période de temps se chevauchent pour tous les différents groupes, mais je suis maintenant de trouver le total exact de temps partagé entre tous les différents noms (il sera 20+ dans le df final) - toujours dépendant de la séquence dans laquelle ils sont groupés. Par exemple, en utilisant l'heure de début de "0" de John et Adam dans le groupe A, je sais qu'ils se chevauchent entre 0 et 79 secondes de communalité (le point final maximal entre les deux qui apparaîtrait dans le groupe A). fonction de chevauchement), mais leur temps de partage réel total est de seulement 19 secondes (de 0 à 19, lorsque John est désactivé). Un autre exemple serait dans la séquence C, John est actif de 566-611 secondes, et Adam est actif de 522-599 secondes, le temps actif total partagé est de 33 secondes (de l'activité de départ de John à 566 et Adam désactivant à 599).

Ma sortie souhaitée serait ce style:

"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) 

Et pour continuer toutes les permutations des 20+ noms et combos dans la trame de données

Merci!

Answer 1

une approche est la suivante:

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 
} 

Remarques:

• l1 et l2 pourraient être calculées directement à partir df (comme indiqué dans les commentaires), mais la ligne ADAM 1 A 0 79 56 ID2 contient une durée étrange
• sum_length_of_overlaps fonctionne en recherchant les points qui se trouvent dans les deux intervalles (ce qui est le cas si un nombre impair des points de début et de fin des deux listes d'intervalles a été vu dans la liste triée). Ce sont les premiers points des régions d'intersection. Remarque: sum_length_of_overlaps ne fonctionnera pas correctement si l'un des vecteurs contient des intervalles de chevauchement.

Exemple: (de la façon dont sum_length_of_overlaps travaux)

Tenir compte des intervalles de séquence 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 

Mettre seulement start_event et end_event rangée par rangée dans des vecteurs séparés pour JOHN et ADAM une obtient

> 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 

Si l'on joint ces vecteurs et trie le vecteur résultant, il est nécessaire de garder la trace du point qui appartenait à quelle séquence d'intervalle.Ainsi, il est utile de mettre ce vecteur conjointe avec des lignes indicatrices dans une matrice:

> 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 

Après le tri, on peut encore comprendre le groupe d'origine en regardant la première ou la deuxième rangée:

> 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 

Puisqu'il existe une intersection si et seulement si le point de départ d'un intervalle a été vu dans chaque groupe, mais que les points d'extrémité correspondants ne l'ont pas été, il suffit de compter le nombre de points vus de chaque groupe. Si le nombre de points vu de chaque groupe est impair le point est le début d'une intersection:

> 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 

Ainsi, on voit immédiatement que m[3,2], m[3,4] et m[3,8] sont les points de départ des intersections. (Voir aussi la dérivation manuelle ci-dessous)

sortie:

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

$`JOHN - ADAM` 
[1] 135 

$`ADAM - JOHN` 
[1] 260 

dérivation manuelle de JOHN + ADAM:

1. intersections en séquence A:
   • [0, 19], [0,79] => Longueur 19
   • [60112], [0,79] => Longueur 19
   • [392429], [384407] => Longueur 15
2. Intersections dans la séquence B: Aucun
3. Intersections dans la séquence C:
   • [147226], [140205] => Longueur 58
   • [566611], [522599] => Longueur 33

Longueur totale des intersections = 19 + 19 + 15 + 58 + 33 = 144