4

我的问题：需要从一组集合中找到所有不相交（不重叠）的集合。

背景：我正在使用比较系统发育方法来研究鸟类的性状进化。我有一棵树，大约有 300 种。这棵树可以分为子分支（即子树）。如果两个子分支不共享物种，则它们是独立的。我正在寻找一种算法（如果可能的话，还有一个 R 实现），它将找到所有可能的子进化枝分区，其中每个子进化枝具有大于 10 个分类单元并且都是独立的。每个子进化枝可以被认为是一个集合，当两个子进化枝是独立的（不共享物种）时，这些子进化枝是不相交的集合。

希望这很清楚，有人可以提供帮助。

干杯，格伦

以下代码生成示例数据集。其中 subclades 是所有可能的子分支（集合）的列表，我想从中采样 X 不相交的集合，其中集合的长度为 Y。

###################################
# Example Dataset
###################################

    library(ape)
    library(phangorn)
    library(TreeSim)
    library(phytools)

    ##simulate a tree

    n.taxa <- 300
    tree <- sim.bd.taxa(n.taxa,1,lambda=.5,mu=0)[[1]][[1]]
    tree$tip.label <- seq(n.taxa)

    ##extract all monophyletic subclades

    get.all.subclades <- function(tree){
    tmp <- vector("list")
    nodes <- sort(unique(tree$edge[,1]))
    i <- 282
    for(i in 1:length(nodes)){
    x <- Descendants(tree,nodes[i],type="tips")[[1]]
    tmp[[i]] <- tree$tip.label[x]
    }
    tmp
    }
    tmp <- get.all.subclades(tree)

    ##set bounds on the maximum and mininum number of tips of the subclades to include

    min.subclade.n.tip <- 10
    max.subclade.n.tip <- 40


    ##function to replace trees of tip length exceeding max and min with NA

    replace.trees <- function(x, min, max){
    if(length(x) >= min & length(x)<= max) x else NA
    }


    #apply testNtip across all the subclades

    tmp2 <- lapply(tmp, replace.trees, min = min.subclade.n.tip, max = max.subclade.n.tip)

    ##remove elements from list with NA, 
    ##all remaining elements are subclades with number of tips between 
##min.subclade.n.tip and max.subclade.n.tip

    subclades <- tmp2[!is.na(tmp2)]

    names(subclades) <- seq(length(subclades))
4

2 回答 2

2

这是一个示例，说明如何测试每对列表元素的零重叠，提取所有非重叠对的索引。

findDisjointPairs <- function(X) {
    ## Form a 2-column matrix enumerating all pairwise combos of X's elements
    ij <- t(combn(length(X),2))    
    ## A function that tests for zero overlap between a pair of vectors
    areDisjoint <- function(i, j) length(intersect(X[[i]], X[[j]])) == 0     
    ## Use mapply to test for overlap between each pair and extract indices 
    ## of pairs with no matches
    ij[mapply(areDisjoint, ij[,1], ij[,2]),]
}

## Make some reproducible data and test the function on it
set.seed(1)
A <- replicate(sample(letters, 5), n=5, simplify=FALSE)    
findDisjointPairs(A)
#      [,1] [,2]
# [1,]    1    2
# [2,]    1    4
# [3,]    1    5
于 2013-05-21T17:11:31.773 回答
1

Here are some functions that might be useful.

The first computes all possible disjoint collections of a list of sets.

I'm using "collection" instead of "partition" beacause a collection does not necessarily covers the universe (i. e., the union of all sets).

The algorithm is recursive, and only works for a small number of possible collections. This does not necessarily means that it won't work with a large list of sets, since the function removes the intersecting sets at every iteration.

If the code is not clear, please ask and I'll add comments.

The input must be a named list, and the result will be a list of collection, which is a character vector indicating the names of the sets.

DisjointCollectionsNotContainingX <- function(L, branch=character(0), x=numeric(0))
{
    filter <- vapply(L, function(y) length(intersect(x, y))==0, logical(1))

    L <- L[filter]

    result <- list(branch)

    for( i in seq_along(L) )
    {
        result <- c(result, Recall(L=L[-(1:i)], branch=c(branch, names(L)[i]), x=union(x, L[[i]])))
    }

    result
}

This is just a wrapper to hide auxiliary arguments:

DisjointCollections <- function(L) DisjointCollectionsNotContainingX(L=L)

The next function can be used to validade a given list of collections supposedly non-overlapping and "maximal".

For every collection, it will test if
1. all sets are effectively disjoint and
2. adding another set either results in a non-disjoint collection or an existing collection:

ValidateDC <- function(L, DC)
{
    for( collection in DC )
    {
        for( i in seq_along(collection) )
        {
            others <- Reduce(f=union, x=L[collection[-i]])

            if( length(intersect(L[collection[i]], others)) > 0 ) return(FALSE)
        }

        elements <- Reduce(f=union, x=L[collection])

        for( k in seq_along(L) ) if( ! (names(L)[k] %in% collection) )
        {
            if( length(intersect(elements, L[[k]])) == 0 )
            {
                check <- vapply(DC, function(z) setequal(c(collection, names(L)[k]), z), logical(1))

                if( ! any(check) ) return(FALSE)
            }
        }
    }

    TRUE
}

Example:

L <- list(A=c(1,2,3), B=c(3,4), C=c(5,6), D=c(6,7,8))

> ValidateDC(L,DisjointCollections(L))
[1] TRUE

> DisjointCollections(L)
[[1]]
character(0)

[[2]]
[1] "A"

[[3]]
[1] "A" "C"

[[4]]
[1] "A" "D"

[[5]]
[1] "B"

[[6]]
[1] "B" "C"

[[7]]
[1] "B" "D"

[[8]]
[1] "C"

[[9]]
[1] "D"

Note that the collections containing A and B simultaneously do not show up, due to their non-null intersection. Also, collections with C and D simultaneously don't appear. Others are OK.

Note: the empty collection character(0) is always a valid combination.

After creating all possible disjoint collections, you can apply any filters you want to proceed.

EDIT:

  1. I've removed the line if( length(L)==0 ) return(list(branch)) from the first function; it's not needed.

  2. Performance: If there is considerable overlapping among sets, the function runs fast. Example:

    set.seed(1)

    L <- lapply(1:50, function(.)sample(x=1200, size=20))

    names(L) <- c(LETTERS, letters)[1:50]

    system.time(DC <- DisjointCollections(L))

Result:

#   user  system elapsed 
#   9.91    0.00    9.92

Total number of collections found:

> length(DC)
[1] 121791
于 2013-05-21T21:00:05.677 回答