如何获得六组或更多组的交点数?

How to get counts of intersections of six or more sets?

我正在 运行 分析多个集合,我一直在使用 VennDiagram 包,它一直工作得很好,但它最多只能处理 5 个集合,现在结果是我需要看 6 套或更多套。

理想情况下,我正在寻找可以用 6 组或更多组执行此操作(如下)的东西,但它不一定必须具有绘图功能,只要可以检索计数即可:

我可以做些什么来将一组或多组添加到这五个中并仍然得到计数?

谢谢!

好的,这是一种方法,假设您将集合表示为向量列表,并且在这些集合中要搜索的项目也表示为向量:

# Example data format
sets <- list(v1 = 1:6, v2 = 1:8, v3 = 3:8)
items <- c(2:7)

# Search for items in each set
result <- data.frame(searched = items)
for (set in names(sets)) {
  result <- cbind(result, items %in% sets[[set]])
  names(result)[length(names(result))] <- set
}

# Count
library(plyr)
ddply(result, names(sets), function (i) {
  data.frame(count = nrow(i))
})

这为您提供了项目集中实际存在的所有组合:

     v1   v2    v3 count
1 FALSE TRUE  TRUE     1
2  TRUE TRUE FALSE     1
3  TRUE TRUE  TRUE     4

尝试一下:

list1 <- c("a","b","c","e")
list2 <- c("a","b","c","e")
list3 <- c("a","b")
list4 <- c("a","b","g","h")
list_names <- c("list1","list2","list3","list4")

lapply(1:length(list_names),function(y){
combinations <- combn(list_names,y)
res<-as.list(apply(combinations,2,function(x){
    if(length(x)==1){
            p <- setdiff(get(x),unlist(sapply(setdiff(list_names,x),get)))
        }

    else if(length(x) < length(list_names)){
            p <- setdiff(Reduce(intersect,lapply(x,get)),Reduce(union,sapply(setdiff(list_names,x),get)))
        }

    else p <- Reduce(intersect,lapply(x,get))

    if(!identical(p,character(0))) p
    else NA
}))

if(y==length(list_names)) {
        res[[1]] <- unlist(res); 
        res<-res[1]
}
names(res) <- apply(combinations,2,paste,collapse="-")
res
})

第一个lapply用于从1循环到你拥有的套数。然后我获取了列表名称的所有可能组合,一次获取 y 个。这基本上生成了维恩图中的所有不同子区域。

对于每个组合,输出是当前组合中列表的交集与不在该组合中的其他列表的并集之间的差值。

最后的结果是一个长度为输入的套数的列表。该列表的第一个元素包含每个列表中的唯一元素,第二个元素是两个列表的任意组合中的唯一元素等。

这是一个递归解决方案,用于查找维恩图中的所有交点。 sets 可以是一个列表,其中包含要查找其交集的任意数量的集合。出于某种原因,您使用的包中的代码对于每个集合大小都是硬编码的,因此它不会扩展到任意交叉点。

## Build intersections, 'out' accumulates the result
intersects <- function(sets, out=NULL) {
    if (length(sets) < 2) return ( out )                               # return result
    len <- seq(length(sets))
    if (missing(out)) out <- list()                                    # initialize accumulator
    for (idx in split((inds <- combn(length(sets), 2)), col(inds))) {  # 2-way combinations
        ii <- len > idx[2] & !(len %in% idx)                           # indices to keep for next intersect
        out[[(n <- paste(names(sets[idx]), collapse="."))]] <- intersect(sets[[idx[1]]], sets[[idx[2]]])
        out <- intersects(append(out[n], sets[ii]), out=out)
    }
    out
}

该函数构建成对交叉点。为了避免构建重复的解决方案,它仅在索引大于连接的组件(代码中的ii)的集合组件上调用自身。结果是所有交叉点的列表。如果传递命名组件,则结果将按约定命名 "set1.set2" 等

结果

## Some sample data
set.seed(0)
sets <- setNames(lapply(1:3, function(.) sample(letters, 10)), letters[1:3])

## Manually check intersections
a.b <- intersect(sets[[1]], sets[[2]])
b.c <- intersect(sets[[2]], sets[[3]])
a.c <- intersect(sets[[1]], sets[[3]])
a.b.c <- intersect(a.b, sets[[3]])

## Compare
res <- intersects(sets)
all.equal(res[c("a.b","a.c","b.c","a.b.c")], list(a.b=a.b, a.c=a.c, b.c=b.c, a.b.c=a.b.c))
# TRUE

res
# $a.b
# [1] "g" "i" "n" "e" "r"
# 
# $a.b.c
# [1] "g"
# 
# $a.c
# [1] "x" "g"
# 
# $b.c
# [1] "f" "g"

## Get the counts of intersections
lengths(res)
# a.b a.b.c   a.c   b.c 
#   5     1     2     2 

或者,用数字

intersects(list(a=1:10, b=c(1, 5, 10), c=9:20))
# $a.b
# [1]  1  5 10
# $a.b.c
# [1] 10
# $a.c
# [1]  9 10
# $b.c
# [1] 10