Intersezione tutte le possibili combinazioni di elementi di elenco

Question

Ho un elenco di vettori:

> l <- list(A=c("one", "two", "three", "four"), B=c("one", "two"), C=c("two", "four", "five", "six"), D=c("six", "seven")) 

> l 
$A 
[1] "one" "two" "three" "four" 

$B 
[1] "one" "two" 

$C 
[1] "two" "four" "five" "six" 

$D 
[1] "six" "seven" 

Vorrei calcolare la lunghezza della sovrapposizione tra tutte le possibili coppie di elementi della lista, cioè (il formato del risultato non importa):

AintB 2 
AintC 2 
AintD 0 
BintC 1 
BintD 0 
CintD 1 

---

so combn(x, 2) può essere utilizzato per ottenere una matrice di tutti i possibili pairwi Se combinazioni in un vettore e che length(intersect(a, b)) mi darebbe la lunghezza della sovrapposizione di due vettori, ma non riesco a pensare a un modo per mettere insieme le due cose.

Qualsiasi aiuto è molto apprezzato! Grazie.

Answer 1

combn opere con strutture lista pure, è solo bisogno di un po 'ing del risultato unlist di utilizzare intersect ...

# Get the combinations of names of list elements 
nms <- combn(names(l) , 2 , FUN = paste0 , collapse = "" , simplify = FALSE) 

# Make the combinations of list elements 
ll <- combn(l , 2 , simplify = FALSE) 

# Intersect the list elements 
out <- lapply(ll , function(x) length(intersect(x[[1]] , x[[2]]))) 

# Output with names 
setNames(out , nms) 
#$AB 
#[1] 2 

#$AC 
#[1] 2 

#$AD 
#[1] 0 

#$BC 
#[1] 1 

#$BD 
#[1] 0 

#$CD 
#[1] 1 

Answer 2

Prova:

m1 <- combn(names(l),2) 
val <- sapply(split(m1, col(m1)),function(x) {x1 <- l[[x[1]]]; x2 <- l[[x[2]]]; length(intersect(x1, x2))}) 
Ind <- apply(m1,2,paste,collapse="int") 
data.frame(Ind, val, stringsAsFactors=F) 
#  Ind val 
# 1 AntB 2 
# 2 AntC 2 
# 3 AntD 0 
# 4 BntC 1 
# 5 BntD 0 
# 6 CntD 1 

Answer 3

Se ho capito bene, si può guardare crossprod e stack:

crossprod(table(stack(l))) 
# ind 
# ind A B C D 
# A 4 2 2 0 
# B 2 2 1 0 
# C 2 1 4 1 
# D 0 0 1 2 

---

È possibile estendere l'idea se si vuole un data.frame del proprio rilevante valori come segue:

1. Scrivete una funzione spiffy

   listIntersect <- function(inList) { 
       X <- crossprod(table(stack(inList))) 
       X[lower.tri(X)] <- NA 
       diag(X) <- NA 
       out <- na.omit(data.frame(as.table(X))) 
       out[order(out$ind), ] 
   } 
   

2. applicarlo

   listIntersect(l) 
   # ind ind.1 Freq 
   # 5 A  B 2 
   # 9 A  C 2 
   # 13 A  D 0 
   # 10 B  C 1 
   # 14 B  D 0 
   # 15 C  D 1 
   

---

prestazioni sembra abbastanza decente.

Espandere l'list:

L <- unlist(replicate(100, l, FALSE), recursive=FALSE) 
names(L) <- make.unique(names(L)) 

impostare alcune funzioni di prova:

fun1 <- function(l) listIntersect(l) 
fun2 <- function(l) apply(combn(l , 2) , 2 , function(x) length(intersect(unlist(x[1]) , unlist(x[2])))) 
fun3 <- function(l) { 
    m1 <- combn(names(l),2) 
    val <- sapply(split(m1, col(m1)),function(x) {x1 <- l[[x[1]]]; x2 <- l[[x[2]]]; length(intersect(x1, x2))}) 
    Ind <- apply(m1,2,paste,collapse="int") 
    data.frame(Ind, val, stringsAsFactors=F) 
} 

Scopri i tempi:

system.time(F1 <- fun1(L)) 
# user system elapsed 
# 0.33 0.00 0.33 
system.time(F2 <- fun2(L)) 
# user system elapsed 
# 4.32 0.00 4.31 
system.time(F3 <- fun3(L)) 
# user system elapsed 
# 6.33 0.00 6.33 

tutti sembrano essere l'ordinamento il risultato in modo diverso, ma i numeri corrispondono:

table(F1$Freq) 
# 
#  0  1  2  4 
# 20000 20000 29900 9900 
table(F2) 
# F2 
#  0  1  2  4 
# 20000 20000 29900 9900 
table(F3$val) 
# 
#  0  1  2  4 
# 20000 20000 29900 9900