-## read.nexus.R (2008-11-24)
+## read.nexus.R (2009-11-21)
## Read Tree File in Nexus Format
-## Copyright 2003-2008 Emmanuel Paradis
+## Copyright 2003-2009 Emmanuel Paradis
## 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", "node.label")
- if (length(phy) == 5) nms <- c(nms, "root.edge")
+ nms <- c("edge", "edge.length", "Nnode", "root.edge")
+ if (length(phy) == 3) nms <- nms[-4]
names(phy) <- nms
- if (!sum(phy[[4]])) phy[[4]] <- NULL
+ if (has.node.labels) phy$node.label <- node.label
class(phy) <- "phylo"
phy
}
rm(X)
tree <- gsub("^.*= *", "", tree)
## check whether there are empty lines from the above manips:
- tree <- tree[tree == ""]
+ tree <- tree[tree != ""]
semico <- grep(";", tree)
Ntree <- length(semico)
## are some trees on several lines?
}
} else {
if (!is.null(tree.names)) names(trees) <- tree.names
- if (translation) attr(trees, "TipLabel") <- TRANS[, 2]
+ if (translation) {
+ if (length(colon) == Ntree) # .treeBuildWithTokens() was used
+ attr(trees, "TipLabel") <- TRANS[, 2]
+ else { # reassign the tip labels then compress
+ for (i in 1:Ntree)
+ trees[[i]]$tip.label <-
+ TRANS[, 2][as.numeric(trees[[i]]$tip.label)]
+ trees <- .compressTipLabel(trees)
+ }
+ }
class(trees) <- "multiPhylo"
}
if (length(grep("[\\/]", file)) == 1)
- file <- paste(getwd(), file, sep = "/")
+ if (!file.exists(file)) # suggestion by Francois Michonneau
+ file <- paste(getwd(), file, sep = "/")
attr(trees, "origin") <- file
trees
}