R/clade.matrix.R

In caper: Comparative Analyses of Phylogenetics and Evolution in R

clade.matrix <- function(phy) {
    # OLD2NEW: CONVERTED

    # returns the phylogeny as a table showing clade
    # membership below each node.

    # check the object is a phylogeny
    if (!inherits(phy, "phylo")) stop("Phylogeny required")

    # get the number of tips and nodes
    nb.tips <- max(phy$edge) - phy$Nnode
    nb.nodes <- phy$Nnode
    nb.all <- nb.tips + nb.nodes

    # set-up the clade matrix
    mat.names <- list(edges = c(1:nb.all), tips = 1:nb.tips)
    clade.mat <- matrix(0, nrow = nb.all, ncol = nb.tips, dimnames = mat.names)

    # the diagonal from [1,1] are the tips
    diag(clade.mat) <- 1

    # now deal with internals
    node.members <- clade.members.list(phy)

    node.id <- names(node.members)
    for (rows in seq(along = node.id)) {
        clade.mat[node.id[rows], node.members[rows][[1]]] <- 1
    }

    RET <- list(clade.matrix = clade.mat, tip.label = phy$tip.label, edge = phy$edge)
    class(RET) <- "clade.matrix"

    # if they exist, get edge lengths into correct order, inserting root edge
    if (!is.null(phy$edge.length)) {
        if (is.null(phy$root.edge)) {
            edge.len <- c(phy$edge.length, 0)
        } else {
            edge.len <- c(phy$edge.length, phy$root.edge)
        }

        names(edge.len) <- c(phy$edge[, 2], nb.tips + 1)
        edge.len <- edge.len[as.character(mat.names$edges)]
        RET$edge.length <- edge.len
    }

    return(RET)
}