-## read.nexus.R (2010-09-27)
+## read.nexus.R (2011-03-26)
## Read Tree File in Nexus Format
-## Copyright 2003-2009 Emmanuel Paradis and 2010 Klaus Schliep
+## Copyright 2003-2011 Emmanuel Paradis and 2010 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
.treeBuildWithTokens <- function(x)
{
- ## remove potential node labels; see ?read.nexus for justification
- node.label <- gsub("[:;].*$", "", strsplit(x, ")")[[1]][-1])
- has.node.labels <- FALSE
- if (any(node.label != "")) {
- x <- gsub(")[^:]*:", "):", x)
- x <- gsub(")[^:]*;", ");", x) # if there's no root edge
- has.node.labels <- TRUE
- }
phy <- .Call("treeBuildWithTokens", x, PACKAGE = "ape")
dim(phy[[1]]) <- c(length(phy[[1]])/2, 2)
- nms <- c("edge", "edge.length", "Nnode", "root.edge")
- if (length(phy) == 3) nms <- nms[-4]
+ nms <- c("edge", "edge.length", "Nnode", "node.label", "root.edge")
+ if (length(phy) == 4) nms <- nms[-5]
names(phy) <- nms
- if (has.node.labels) phy$node.label <- node.label
+ if (all(phy$node.label == "")) phy$node.label <- NULL
class(phy) <- "phylo"
phy
}
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)
} 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)
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) {
}
}
class(trees) <- "multiPhylo"
+ if (!all(nms.trees == "")) names(trees) <- nms.trees
}
if (length(grep("[\\/]", file)) == 1)
if (!file.exists(file)) # suggestion by Francois Michonneau