Intersect tất cả các kết hợp có thể có của các yếu tố danh sách

Question

Tôi có một danh sách các vectơ:

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

Tôi muốn tính toán chiều dài của sự chồng chéo giữa tất cả các kết hợp cặp có thể có của các yếu tố danh sách, tức là (định dạng về kết quả không quan trọng):

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

---

tôi biết combn(x, 2) thể được sử dụng để có được một ma trận của tất cả pairwi thể se kết hợp trong một vector và rằng length(intersect(a, b)) sẽ cho tôi chiều dài của sự chồng chéo của hai vectơ, nhưng tôi không thể nghĩ ra một cách để đặt hai thứ lại với nhau.

Bất kỳ trợ giúp nào được đánh giá cao! Cảm ơn.

Answer 1

combn công trình với cấu trúc danh sách là tốt, bạn chỉ cần một chút unlist 'ing của kết quả sử dụng 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

Hãy thử:

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

Nếu tôi hiểu đúng, bạn có thể nhìn vào crossprod và 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 

---

Bạn có thể mở rộng ý tưởng nếu bạn muốn có một data.frame chỉ có liên quan các giá trị như sau:

1. Viết một hàm 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. Áp dụng nó

   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 
   

---

Performance dường như khá tốt.

Mở rộng list:

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

Thiết lập một số chức năng để kiểm tra:

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

Kiểm tra timings:

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 

Mọi người dường như được sắp xếp kết quả khác nhau, nhưng các con số phù hợp:

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