1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
## as.matching.R (2011-02-26)
## Conversion Between Phylo and Matching Objects
## Copyright 2005-2011 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") # cannot use "postorder" here!
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 <- t(apply(mat, 1, sort))
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, ...)
{
nb.node <- dim(x$matching)[1]
nb.tip <- nb.node + 1
N <- 2 * nb.node
edge <- matrix(NA, N, 2)
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[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
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))
}
|
