bug fixed in write.tree

git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@136 6e262413-ae40-0410-9e79-b911bd7a66b7

diff --git a/ChangeLog b/ChangeLog
index 8db603f95885fcfddc68a3bc52b475f70953838c..69c19c3a7f200c10591a523c3c074b532b64437d 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -7,15 +7,20 @@ NEW FEATURES
       conditioned on no extinction for the taxonomic data.
 
 
+BUG FIXES
+
+    o write.tree() failed to output correctly tree names.
+
+
 
                CHANGES IN APE VERSION 2.6-1
 
 
 NEW FEATURES
 
-    o The new speciesTree calculates the species tree from a set of gene
-      trees. Several methods are available including maximum tree and
-      shallowest divergence tree.
+    o The new function speciesTree calculates the species tree from a set
+      of gene trees. Several methods are available including maximum tree
+      and shallowest divergence tree.
 
 
 BUG FIXES

diff --git a/R/write.tree.R b/R/write.tree.R
index 20e74ad9237cce9705e72c687f5c5da0a7ca2d81..08747b99c672a993d6ead68efd3623ea64a173ff 100644 (file)
--- a/R/write.tree.R
+++ b/R/write.tree.R
@@ -1,4 +1,4 @@
-## write.tree.R (2010-09-27)
+## write.tree.R (2010-11-08)
 
 ##   Write Tree File in Parenthetic Format
 
@@ -28,28 +28,33 @@ checkLabel <- function(x, ...)
 }
 
 write.tree <-
-    function (phy, file = "", append = FALSE, digits = 10, tree.names = FALSE)
+    function(phy, file = "", append = FALSE, digits = 10, tree.names = FALSE)
 {
-    output.tree.names <- FALSE
+    if (!(inherits(phy, "phylo") || inherits(phy, "multiPhylo")))
+        stop("object \"phy\" has no trees")
+
+    if (inherits(phy, "phylo")) phy <- c(phy)
+    N <- length(phy)
+    res <- character(N)
+
     if (is.logical(tree.names)) {
-        output.tree.names <- tree.names
-        tree.names <- NULL
-    } else if (is.character(tree.names)) {
-        output.tree.names <- TRUE
-        names(phy) <- tree.names
+        if (tree.names) {
+            tree.names <-
+                if (is.null(names(phy))) character(N)
+                else names(phy)
+        } else tree.names <- character(N)
     }
-    if (output.tree.names)
-        names(phy) <- checkLabel(names(phy))
-    if (inherits(phy, "multiPhylo")) {
-        write.tree(phy[[1]], file = file, append = append,
-                   digits = digits, tree.names = names(phy)[1])
-        if (length(phy) > 1)
-            for (i in 2:length(phy)) write.tree(phy[[i]], file = file,
-                append = TRUE, digits = digits, tree.names = names(phy)[i])
-        return(invisible(NULL))
-    }
-    if (!inherits(phy, "phylo"))
-        stop("object \"phy\" is not of class \"phylo\"")
+
+    for (i in 1:N)
+        res[i] <- .write.tree2(phy[[i]], digits = digits,
+                               tree.prefix = tree.names[i])
+
+    if (file == "") return(res)
+    else cat(res, file = file, append = append, sep = "\n")
+}
+
+.write.tree2 <- function(phy, digits = 10, tree.prefix = "")
+{
     brl <- !is.null(phy$edge.length)
     nodelab <- !is.null(phy$node.label)
     phy$tip.label <- checkLabel(phy$tip.label)
@@ -98,9 +103,8 @@ write.tree <-
     if (nodelab)  LS <- LS + n
     STRING <- character(LS)
     k <- 1
-    if (output.tree.names) cp(tree.names)
+    cp(tree.prefix)
     cp("(")
-    k <- 2
     getRoot <- function(phy)
         phy$edge[, 1][!match(phy$edge[, 1], phy$edge[, 2], 0)][1]
     root <- getRoot(phy) # replaced n+1 with root - root has not be n+1
@@ -123,8 +127,5 @@ write.tree <-
         cp(sprintf(f.d, phy$root.edge))
         cp(";")
     }
-    STRING <- paste(STRING, collapse = "")
-    if (file == "")
-        return(STRING)
-    else cat(STRING, file = file, append = append, sep = "\n")
+    paste(STRING, collapse = "")
 }