1 ## as.phylo.R (2007-03-05)
3 ## Conversion Among Tree Objects
5 ## Copyright 2005-2007 Emmanuel Paradis
7 ## This file is part of the R-package `ape'.
8 ## See the file ../COPYING for licensing issues.
10 old2new.phylo <- function(phy)
12 mode(phy$edge) <- "numeric"
13 phy$Nnode <- -min(phy$edge)
14 n <- length(phy$tip.label)
16 phy$edge[NODES] <- n - phy$edge[NODES]
20 new2old.phylo <- function(phy)
22 NTIP <- length(phy$tip.label)
23 NODES <- phy$edge > NTIP
24 phy$edge[NODES] <- NTIP - phy$edge[NODES]
25 mode(phy$edge) <- "character"
30 as.phylo <- function (x, ...)
32 if (class(x) == "phylo") return(x)
36 as.phylo.hclust <- function(x, ...)
39 edge <- matrix(NA, 2*N, 2)
40 edge.length <- numeric(2*N)
41 ## `node' gives the number of the node for the i-th row of x$merge
47 edge[j:(j + 1), 1] <- node[i]
50 if (x$merge[i, l] > 0) {
51 edge[k, 2] <- node[x$merge[i, l]] <- cur.nod
52 cur.nod <- cur.nod + 1
53 edge.length[k] <- x$height[i] - x$height[x$merge[i, l]]
55 edge[k, 2] <- -x$merge[i, l]
56 edge.length[k] <- x$height[i]
61 if (is.null(x$labels))
62 x$labels <- as.character(1:(N + 1))
63 obj <- list(edge = edge, edge.length = edge.length,
64 tip.label = x$labels, Nnode = N)
69 as.phylo.phylog <- function(x, ...)
71 tr <- read.tree(text = x$tre)
72 n <- length(tr$tip.label)
73 edge.length <- numeric(dim(tr$edge)[1])
74 term <- which(tr$edge[, 2] <= n)
75 inte <- which(tr$edge[, 2] > n)
76 edge.length[term] <- x$leaves[tr$tip.label]
77 edge.length[inte] <- x$nodes[tr$node.label][-1]
78 tr$edge.length <- edge.length
79 if (x$nodes["Root"] != 0) {
80 tr$edge.root <- x$nodes["Root"]
81 names(tr$edge.root) <- NULL
86 as.hclust.phylo <- function(x, ...)
88 if (!is.ultrametric(x)) stop("the tree is not ultrametric")
89 if (!is.binary.tree(x)) stop("the tree is not binary")
90 n <- length(x$tip.label)
91 bt <- rev(branching.times(x))
93 nm <- as.numeric(names(bt))
94 merge <- matrix(NA, N, 2)
96 ind <- which(x$edge[, 1] == nm[i])
98 merge[i, k] <- if (x$edge[ind[k], 2] <= n) -x$edge[ind[k], 2]
99 else which(nm == x$edge[ind[k], 2])
102 obj <- list(merge = merge, height = bt, order = 1:(N + 1),
103 labels = x$tip.label, call = match.call(),
105 class(obj) <- "hclust"