Accelerazione del conteggio a coppie di osservazioni univoche

Question

Possiedo un vettore di oggetti (object) insieme a un vettore corrispondente di intervalli di tempo (tframe) in cui sono stati osservati gli oggetti. Per ogni coppia univoca di oggetti, voglio calcolare il numero di intervalli di tempo in cui sono stati osservati entrambi gli oggetti.

Posso scrivere il codice utilizzando i cicli for(), ma richiede molto tempo per l'esecuzione con l'aumentare del numero di oggetti unici. Come posso cambiare il codice per accelerare il tempo di esecuzione?

Di seguito è riportato un esempio con 4 oggetti univoci (in realtà ne ho circa 300). Ad esempio, gli oggetti a e c sono stati entrambi osservati nei periodi di tempo 1 e 2, quindi ricevono un conteggio di 2. Gli oggetti b e d non sono mai stati osservati nello stesso intervallo di tempo, pertanto ricevono un conteggio di 0.

object <- c("a", "a", "a", "b", "b", "c", "c", "c", "c", "d") 
tframe <- c(1, 1, 2, 2, 3, 1, 2, 2, 3, 1) 

uo <- unique(object) 
n <- length(uo) 

mpairs <- matrix(NA, nrow=n*(n-1)/2, ncol=3, dimnames=list(NULL, 
    c("obj1", "obj2", "sametf"))) 

row <- 0 
for(i in 1:(n-1)) { 
for(j in (i+1):n) { 
    row <- row+1 
    mpairs[row, "obj1"] <- uo[i] 
    mpairs[row, "obj2"] <- uo[j] 
    # no. of time frames in which both objects in a pair were observed 
    intwin <- intersect(tframe[object==uo[i]], tframe[object==uo[j]]) 
    mpairs[row, "sametf"] <- length(intwin) 
}} 

data.frame(object, tframe) 
    object tframe 
1  a  1 
2  a  1 
3  a  2 
4  b  2 
5  b  3 
6  c  1 
7  c  2 
8  c  2 
9  c  3 
10  d  1 

mpairs 
    obj1 obj2 sametf 
[1,] "a" "b" "1" 
[2,] "a" "c" "2" 
[3,] "a" "d" "1" 
[4,] "b" "c" "2" 
[5,] "b" "d" "0" 
[6,] "c" "d" "1" 

Answer 1

È possibile utilizzare crossproduct per ottenere i conteggi di accordo. È quindi possibile rimodellare i dati , se necessario.

Esempio

object <- c("a", "a", "a", "b", "b", "c", "c", "c", "c", "d") 
tframe <- c(1, 1, 2, 2, 3, 1, 2, 2, 3, 1) 

# This will give you the counts 
# Use code from Jean's comment 
tab <- tcrossprod(table(object, tframe)>0) 

# Reshape the data 
tab[lower.tri(tab, TRUE)] <- NA 
reshape2::melt(tab, na.rm=TRUE)