fix bug in read.nexus()

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

diff --git a/R/read.nexus.R b/R/read.nexus.R
index ff148df2eaa1ff9b419f346c3f64d8cc14611718..01aec6495d560e7dc5ef15386f062941ad0e2af0 100644 (file)
--- a/R/read.nexus.R
+++ b/R/read.nexus.R
@@ -1,4 +1,4 @@
-## read.nexus.R (2008-02-28)
+## read.nexus.R (2008-11-24)
 
 ##   Read Tree File in Nexus Format
 
@@ -109,7 +109,17 @@ read.nexus <- function(file, tree.names = NULL)
         w <- LEFT == RIGHT
         if (any(w)) { # in case all comments use at least 2 lines
             s <- LEFT[w]
-            X[s] <- gsub("\\[.*\\]", "", X[s])
+            X[s] <- gsub("\\[[^]]*\\]", "", X[s])
+            ## The above regexp was quite tough to find: it makes
+            ## possible to delete series of comments on the same line:
+            ##       ...[...]xxx[...]...
+            ## without deleting the "xxx". This regexp is in three parts:
+            ##       \\[      [^]]*       \\]
+            ## where [^]]* means "any character, except "]", repeated zero
+            ## or more times" (note that the ']' is not escaped here).
+            ## The previous version was:
+            ##       X[s] <- gsub("\\[.*\\]", "", X[s])
+            ## which deleted the "xxx". (EP  2008-06-24)
         }
         w <- !w
         if (any(w)) {
@@ -143,16 +153,25 @@ read.nexus <- function(file, tree.names = NULL)
     tree <- X[start:end]
     rm(X)
     tree <- gsub("^.*= *", "", tree)
+    ## check whether there are empty lines from the above manips:
+    tree <- tree[tree == ""]
     semico <- grep(";", tree)
     Ntree <- length(semico)
     ## are some trees on several lines?
-    if (any(diff(semico) != 1)) {
-        STRING <- character(Ntree)
-        s <- c(1, semico[-Ntree] + 1)
-        j <- mapply(":", s, semico)
-        for (i in 1:Ntree)
-            STRING[i] <- paste(tree[j[, i]], collapse = "")
-    } else STRING <- tree
+    if (Ntree == 1 && length(tree) > 1) STRING <- paste(tree, collapse = "") else {
+        if (any(diff(semico) != 1)) {
+            STRING <- character(Ntree)
+            s <- c(1, semico[-Ntree] + 1)
+            j <- mapply(":", s, semico)
+            if (is.list(j)) {
+                for (i in 1:Ntree)
+                    STRING[i] <- paste(tree[j[[i]]], collapse = "")
+            } else {
+                for (i in 1:Ntree)
+                    STRING[i] <- paste(tree[j[, i]], collapse = "")
+            }
+        } else STRING <- tree
+    }
     rm(tree)
     STRING <- gsub(" ", "", STRING)
     colon <- grep(":", STRING)
@@ -198,7 +217,11 @@ read.nexus <- function(file, tree.names = NULL)
     }
     if (Ntree == 1) {
         trees <- trees[[1]]
-        trees$tip.label <- TRANS[, 2]
+        if (translation) {
+            trees$tip.label <-
+                if (length(colon)) TRANS[, 2] else
+                TRANS[, 2][as.numeric(trees$tip.label)]
+        }
     } else {
         if (!is.null(tree.names)) names(trees) <- tree.names
         if (translation) attr(trees, "TipLabel") <- TRANS[, 2]