-## as.matching.R (2007-12-23)
+## as.matching.R (2011-02-26)
## Conversion Between Phylo and Matching Objects
-## Copyright 2005-2007 Emmanuel Paradis
+## Copyright 2005-2011 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
nb.tip <- length(x$tip.label)
nb.node <- x$Nnode
if (nb.tip != nb.node + 1)
- stop("the tree must be dichotomous AND rooted.")
+ 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]
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)
+ mat <- t(apply(mat, 1, sort))
obj <- list(matching = mat)
if (!is.null(x$edge.length))
if (labels) {
obj$tip.label <- x$tip.label
if (!is.null(x$node.label))
- obj$node.label <- x$node.label[match(new.nodes, nodes)]
+ 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]
+ nb.node <- dim(x$matching)[1]
+ nb.tip <- nb.node + 1
+ N <- 2 * nb.node
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]]
+ edge[j:(j + 1), 1] <- new.nodes[i + nb.tip]
for (k in 1:2) {
if (x$matching[i, k] > nb.tip) {
edge[j + k - 1, 2] <- new.nodes[x$matching[i, k]] <- nextnode
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))
}