R/as.matching.R

In gjuggler/ape: Analyses of Phylogenetics and Evolution

## as.matching.R (2010-09-29)

##    Conversion Between Phylo and Matching Objects

## Copyright 2005-2010 Emmanuel Paradis

## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.

as.matching <- function(x, ...) UseMethod("as.matching")

as.matching.phylo <- function(x, labels = TRUE, ...)
{
    nb.tip <- length(x$tip.label)
    nb.node <- x$Nnode
    if (nb.tip != nb.node + 1)
      stop("the tree must be dichotomous AND rooted.")
    x <- reorder(x, "pruningwise")
    mat <- matrix(x$edge[, 2], ncol = 2, byrow = TRUE)
    nodes <- x$edge[seq(by = 2, length.out = nb.node), 1]
    ## we can use match() becoz each node appears once in `mat'
    O <- match(mat, nodes)
    new.nodes <- 1:nb.node + nb.tip
    sel <- !is.na(O)
    mat[sel] <- new.nodes[O[sel]]
    mat <- cbind(t(apply(mat, 1, sort)), new.nodes, deparse.level = 0)

    obj <- list(matching = mat)
    if (!is.null(x$edge.length))
        warning("branch lengths have been ignored")
    if (labels) {
        obj$tip.label <- x$tip.label
        if (!is.null(x$node.label))
          obj$node.label <- x$node.label[match(new.nodes, nodes)]
    }
    class(obj) <- "matching"
    obj
}

as.phylo.matching <- function(x, ...)
{
    N <- 2*dim(x$matching)[1]
    edge <- matrix(NA, N, 2)
    nb.tip <- (N + 2)/2
    nb.node <- nb.tip - 1
    new.nodes <- numeric(N + 1)
    new.nodes[N + 1] <- nb.tip + 1
    nextnode <- nb.tip + 2
    j <- 1
    for (i in nb.node:1) {
        edge[j:(j + 1), 1] <- new.nodes[x$matching[i, 3]]
        for (k in 1:2) {
            if (x$matching[i, k] > nb.tip) {
                edge[j + k - 1, 2] <- new.nodes[x$matching[i, k]] <- nextnode
                nextnode <- nextnode + 1
            } else edge[j + k - 1, 2] <- x$matching[i, k]
        }
        j <- j + 2
    }
    obj <- list(edge = edge)
    if (!is.null(x$tip.label)) obj$tip.label <- x$tip.label
    else obj$tip.label <- as.character(1:nb.tip)
    obj$Nnode <- nb.node
    class(obj) <- "phylo"
    read.tree(text = write.tree(obj))
}