fixing various bugs + news in cophyloplot

[ape.git] / R / read.tree.R

diff --git a/R/read.tree.R b/R/read.tree.R
index aa508b0eab5d37879162a9a0a16746cbc4e68041..d19acaef73edfa15054bb30a1158d647eaa5b06f 100644 (file)
--- a/R/read.tree.R
+++ b/R/read.tree.R
@@ -1,4 +1,4 @@
-## read.tree.R (2009-03-09)
+## read.tree.R (2009-04-27)
 
 ##   Read Tree Files in Parenthetic Format
 
@@ -98,12 +98,13 @@ read.tree <- function(file = "", text = NULL, tree.names = NULL, skip = 0,
     comment.char = "#", keep.multi = FALSE, ...)
 {
     unname <- function(treetext) {
+        nc <- nchar(treetext)
        tstart <- 1
-       while (substr(treetext, tstart, tstart) != "(" && tstart <= nchar(treetext))
+       while (substr(treetext, tstart, tstart) != "(" && tstart <= nc)
             tstart <- tstart + 1
        if (tstart > 1)
             return(c(substr(treetext, 1, tstart - 1),
-                     substr(treetext, tstart, nchar(treetext))))
+                     substr(treetext, tstart, nc)))
        return(c("", treetext))
     }
     if (!is.null(text)) {
@@ -114,10 +115,6 @@ read.tree <- function(file = "", text = NULL, tree.names = NULL, skip = 0,
         tree <- scan(file = file, what = "", sep = "\n", quiet = TRUE,
                      skip = skip, comment.char = comment.char, ...)
     }
-    tmp <- lapply(tree, unname)
-    tmpnames <- sapply(tmp, function(x) x[1])
-    tree <- sapply(tmp, function(x) x[2])
-    if (is.null(tree.names) && any(nzchar(tmpnames))) tree.names <- tmpnames
     ## Suggestion from Eric Durand and Nicolas Bortolussi (added 2005-08-17):
     if (identical(tree, character(0))) {
         warning("empty character string.")
@@ -133,6 +130,13 @@ read.tree <- function(file = "", text = NULL, tree.names = NULL, skip = 0,
     STRING <- character(Ntree)
     for (i in 1:Ntree)
         STRING[i] <- paste(tree[x[i]:y[i]], sep = "", collapse = "")
+
+    tmp <- unlist(lapply(STRING, unname))
+    tmpnames <- tmp[c(TRUE, FALSE)]
+    STRING <- tmp[c(FALSE, TRUE)]
+    if (is.null(tree.names) && any(nzchar(tmpnames)))
+        tree.names <- tmpnames
+
     colon <- grep(":", STRING)
     if (!length(colon)) {
         obj <- lapply(STRING, clado.build)