1 ## as.matching.R (2011-02-26)
3 ## Conversion Between Phylo and Matching Objects
5 ## Copyright 2005-2011 Emmanuel Paradis
7 ## This file is part of the R-package `ape'.
8 ## See the file ../COPYING for licensing issues.
10 as.matching <- function(x, ...) UseMethod("as.matching")
12 as.matching.phylo <- function(x, labels = TRUE, ...)
14 nb.tip <- length(x$tip.label)
16 if (nb.tip != nb.node + 1)
17 stop("the tree must be dichotomous AND rooted.")
18 x <- reorder(x, "pruningwise")
19 mat <- matrix(x$edge[, 2], ncol = 2, byrow = TRUE)
20 nodes <- x$edge[seq(by = 2, length.out = nb.node), 1]
21 ## we can use match() becoz each node appears once in `mat'
22 O <- match(mat, nodes)
23 new.nodes <- 1:nb.node + nb.tip
25 mat[sel] <- new.nodes[O[sel]]
26 mat <- t(apply(mat, 1, sort))
28 obj <- list(matching = mat)
29 if (!is.null(x$edge.length))
30 warning("branch lengths have been ignored")
32 obj$tip.label <- x$tip.label
33 if (!is.null(x$node.label))
34 obj$node.label <- x$node.label[match(new.nodes, nodes)]
36 class(obj) <- "matching"
40 as.phylo.matching <- function(x, ...)
42 nb.node <- dim(x$matching)[1]
45 edge <- matrix(NA, N, 2)
46 new.nodes <- numeric(N + 1)
47 new.nodes[N + 1] <- nb.tip + 1
48 nextnode <- nb.tip + 2
50 for (i in nb.node:1) {
51 edge[j:(j + 1), 1] <- new.nodes[i + nb.tip]
53 if (x$matching[i, k] > nb.tip) {
54 edge[j + k - 1, 2] <- new.nodes[x$matching[i, k]] <- nextnode
55 nextnode <- nextnode + 1
56 } else edge[j + k - 1, 2] <- x$matching[i, k]
60 obj <- list(edge = edge)
61 if (!is.null(x$tip.label)) obj$tip.label <- x$tip.label
62 else obj$tip.label <- as.character(1:nb.tip)
65 read.tree(text = write.tree(obj))