1 ## as.phylo.R (2011-03-25)
3 ## Conversion Among Tree 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 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 (length(class(x)) == 1 && class(x) == "phylo")
37 as.phylo.hclust <- function(x, ...)
40 edge <- matrix(0L, 2*N, 2)
41 edge.length <- numeric(2*N)
42 ## `node' gives the number of the node for the i-th row of x$merge
48 edge[j:(j + 1), 1] <- node[i]
53 edge[k, 2] <- node[y] <- cur.nod
54 cur.nod <- cur.nod + 1L
55 edge.length[k] <- x$height[i] - x$height[y]
58 edge.length[k] <- x$height[i]
63 if (is.null(x$labels))
64 x$labels <- as.character(1:(N + 1))
65 obj <- list(edge = edge, edge.length = edge.length / 2,
66 tip.label = x$labels, Nnode = N)
71 as.phylo.phylog <- function(x, ...)
73 tr <- read.tree(text = x$tre)
74 n <- length(tr$tip.label)
75 edge.length <- numeric(dim(tr$edge)[1])
76 term <- which(tr$edge[, 2] <= n)
77 inte <- which(tr$edge[, 2] > n)
78 edge.length[term] <- x$leaves[tr$tip.label]
79 edge.length[inte] <- x$nodes[tr$node.label][-1]
80 tr$edge.length <- edge.length
81 if (x$nodes["Root"] != 0) {
82 tr$edge.root <- x$nodes["Root"]
83 names(tr$edge.root) <- NULL
88 as.hclust.phylo <- function(x, ...)
90 if (!is.ultrametric(x)) stop("the tree is not ultrametric")
91 if (!is.binary.tree(x)) stop("the tree is not binary")
92 if (!is.rooted(x)) stop("the tree is not rooted")
93 n <- length(x$tip.label)
94 x$node.label <- NULL # by Jinlong Zhang (2010-12-15)
95 bt <- sort(branching.times(x))
96 inode <- as.numeric(names(bt))
98 nm <- numeric(N + n) # hash table
100 merge <- matrix(NA, N, 2)
102 ind <- which(x$edge[, 1] == inode[i])
104 tmp <- x$edge[ind[k], 2]
105 merge[i, k] <- if (tmp <= n) -tmp else nm[tmp]
109 obj <- list(merge = merge, height = bt, order = 1:n, labels = x$tip.label,
110 call = match.call(), method = "unknown")
111 class(obj) <- "hclust"
115 as.network.phylo <- function(x, directed = is.rooted(x), ...)
117 if (is.null(x$node.label)) x <- makeNodeLabel(x)
118 res <- network(x$edge, directed = directed, ...)
119 network.vertex.names(res) <- c(x$tip.label, x$node.label)
123 as.igraph <- function(x, ...) UseMethod("as.igraph")
125 as.igraph.phylo <- function(x, directed = is.rooted(x), use.labels = TRUE, ...)
127 ## local copy because x will be changed before evaluating is.rooted(x):
130 if (is.null(x$node.label)) x <- makeNodeLabel(x)
131 x$edge <- matrix(c(x$tip.label, x$node.label)[x$edge], ncol = 2)
132 } else x$edge <- x$edge - 1L
133 graph.edgelist(x$edge, directed = directed, ...)