changes in reorder(, "cladewise")

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

diff --git a/R/read.nexus.R b/R/read.nexus.R
index 117b31f36ce61b33178734b3715dff078e23cb9e..0268e6833a448853d78822c12ef9e8bbe4cb0904 100644 (file)
--- a/R/read.nexus.R
+++ b/R/read.nexus.R
@@ -1,8 +1,8 @@
-## read.nexus.R (2011-03-18)
+## read.nexus.R (2012-02-09)
 
 ##   Read Tree File in Nexus Format
 
-## Copyright 2003-2011 Emmanuel Paradis and 2010 Klaus Schliep
+## Copyright 2003-2012 Emmanuel Paradis and 2010 Klaus Schliep
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
@@ -154,12 +154,13 @@ read.nexus <- function(file, tree.names = NULL)
     end <- endblock[endblock > i1][1] - 1
     tree <- X[start:end]
     rm(X)
-    tree <- gsub("^.*= *", "", tree)
+###    tree <- gsub("^.*= *", "", tree)
     ## check whether there are empty lines from the above manips:
     tree <- tree[tree != ""]
     semico <- grep(";", tree)
-    Ntree <- length(semico)
+    Ntree <- length(semico) # provisional -- some ";" may actually mark end of commands
     ## are some trees on several lines?
+    ## -- this actually 'packs' all characters ending with a ";" in a single string --
     if (Ntree == 1 && length(tree) > 1) STRING <- paste(tree, collapse = "") else {
         if (any(diff(semico) != 1)) {
             STRING <- character(Ntree)
@@ -175,7 +176,14 @@ read.nexus <- function(file, tree.names = NULL)
         } else STRING <- tree
     }
     rm(tree)
-    STRING <- gsub(" ", "", STRING)
+    ## exclude the possible command lines ending with ";":
+    STRING <- STRING[grep("^[[:blank:]]*tree.*= *", STRING, ignore.case = TRUE)]
+    Ntree <- length(STRING) # update Ntree
+    ## get the tree names:
+    nms.trees <- sub(" *= *.*", "", STRING) # only the first occurence of "="
+    nms.trees <- sub("^ *tree *", "", nms.trees, ignore.case = TRUE)
+    STRING <- sub("^.*= *", "", STRING) # delete title and 'TREE' command with 'sub'
+    STRING <- gsub(" ", "", STRING) # delete all white spaces
     colon <- grep(":", STRING)
     if (!length(colon)) {
         trees <- lapply(STRING, clado.build)
@@ -214,7 +222,7 @@ read.nexus <- function(file, tree.names = NULL)
         if (!translation) n <- length(tr$tip.label)
         ROOT <- n + 1
         if (sum(tr$edge[, 1] == ROOT) == 1 && dim(tr$edge)[1] > 1) {
-            stop(paste("There is apparently two root edges in your file: cannot read tree file.\n  Reading NEXUS file aborted at tree no.", i, sep = ""))
+            stop(paste("The tree has apparently singleton node(s): cannot read tree file.\n  Reading NEXUS file aborted at tree no.", i, sep = ""))
         }
     }
     if (Ntree == 1) {
@@ -237,10 +245,7 @@ read.nexus <- function(file, tree.names = NULL)
             }
         }
         class(trees) <- "multiPhylo"
+        if (!all(nms.trees == "")) names(trees) <- nms.trees
     }
-    if (length(grep("[\\/]", file)) == 1)
-        if (!file.exists(file)) # suggestion by Francois Michonneau
-            file <- paste(getwd(), file, sep = "/")
-    attr(trees, "origin") <- file
     trees
 }