[英]Intersect all possible combinations of list elements
我有一個向量列表:
> 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"
我想計算列表元素的所有可能的成對組合之間的重疊長度 ,即(結果的格式無關緊要):
AintB 2
AintC 2
AintD 0
BintC 1
BintD 0
CintD 1
我知道combn(x, 2)
可以用來得到一個矢量中所有可能的成對組合的矩陣,那個length(intersect(a, b))
會給我兩個向量重疊的長度,但我可以'想一想把兩件事放在一起的方法。
任何幫助深表感謝! 謝謝。
如果我理解正確,你可以查看crossprod
和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
如果您想要一個僅包含相關值的data.frame
,您可以擴展這個想法,如下所示:
寫一個漂亮的功能
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), ] }
應用它
listIntersect(l) # ind ind.1 Freq # 5 AB 2 # 9 AC 2 # 13 AD 0 # 10 BC 1 # 14 BD 0 # 15 CD 1
表現看起來相當不錯。
展開list
:
L <- unlist(replicate(100, l, FALSE), recursive=FALSE)
names(L) <- make.unique(names(L))
設置一些功能來測試:
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)
}
查看時間:
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
每個人似乎都對結果進行了不同的排序,但數字匹配:
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
combn
可以與列表結構一起使用,你只需要對結果進行一些unlist
,即可使用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
嘗試:
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.