X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fas.phylo.R;h=5d541bce67f3de75f947ba59caa0ea256921e4eb;hb=46bc16a7531d871fccb6ea7c2a31d980aac21bd1;hp=c0304b50493512e69fcf5032265f7222dc185845;hpb=df2d6bcb931ba3b5fa7b327176e5793908d6c8fd;p=ape.git

diff --git a/R/as.phylo.R b/R/as.phylo.R
index c0304b5..5d541bc 100644
--- a/R/as.phylo.R
+++ b/R/as.phylo.R
@@ -1,8 +1,8 @@
-## as.phylo.R (2010-11-30)
+## as.phylo.R (2011-03-25)
 
 ##     Conversion Among Tree Objects
 
-## Copyright 2005-2010 Emmanuel Paradis
+## Copyright 2005-2011 Emmanuel Paradis
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
@@ -29,7 +29,8 @@ new2old.phylo <- function(phy)
 
 as.phylo <- function (x, ...)
 {
-    if (class(x) == "phylo") return(x)
+    if (length(class(x)) == 1 && class(x) == "phylo")
+        return(x)
     UseMethod("as.phylo")
 }
 
@@ -88,7 +89,9 @@ as.hclust.phylo <- function(x, ...)
 {
     if (!is.ultrametric(x)) stop("the tree is not ultrametric")
     if (!is.binary.tree(x)) stop("the tree is not binary")
+    if (!is.rooted(x)) stop("the tree is not rooted")
     n <- length(x$tip.label)
+    x$node.label <- NULL # by Jinlong Zhang (2010-12-15)
     bt <- sort(branching.times(x))
     inode <- as.numeric(names(bt))
     N <- n - 1L
@@ -108,3 +111,24 @@ as.hclust.phylo <- function(x, ...)
     class(obj) <- "hclust"
     obj
 }
+
+as.network.phylo <- function(x, directed = is.rooted(x), ...)
+{
+    if (is.null(x$node.label)) x <- makeNodeLabel(x)
+    res <- network(x$edge, directed = directed, ...)
+    network.vertex.names(res) <- c(x$tip.label, x$node.label)
+    res
+}
+
+as.igraph <- function(x, ...) UseMethod("as.igraph")
+
+as.igraph.phylo <- function(x, directed = is.rooted(x), use.labels = TRUE, ...)
+{
+    ## local copy because x will be changed before evaluating is.rooted(x):
+    directed <- directed
+    if (use.labels) {
+        if (is.null(x$node.label)) x <- makeNodeLabel(x)
+        x$edge <- matrix(c(x$tip.label, x$node.label)[x$edge], ncol = 2)
+    } else x$edge <- x$edge - 1L
+    graph.edgelist(x$edge, directed = directed, ...)
+}