NEW FEATURES
+ o There three new methods for the "multiPhylo" class: str, $,
+ and [[.
+
o root() gains the options 'node' and 'resolve.root'
(FALSE by default) as well as its code being improved.
o mltt.plot() has now an option 'log' used in the same way
- than in plot.default()
+ than in plot.default().
BUG FIXES
'cex' to draw symbols of different sizes (which has
worked already for thermometers).
+ o read.nexus() generally failed to read very big files.
+
OTHER CHANGES
o The argument 'family' of compar.gee() can now be a function
as well as a character string.
+ o read.tree() and read.nexus() now return an unnamed list if
+ 'tree.names = NULL'.
+
+ o read.nexus() now returns a modified object of class "multiPhylo"
+ when there is a TRANSLATE block in the NEXUS file: the individual
+ trees have no 'tip.label' vector, but the list has a 'TipLabel'
+ attribute. The new methods '$' and '[[' set these elements
+ correctly when extracting trees.
+
CHANGES IN APE VERSION 2.1-1
Package: ape
Version: 2.1-2
-Date: 2008-02-21
+Date: 2008-02-28
Title: Analyses of Phylogenetics and Evolution
Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong,
Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel,
scale.value = scale.value))
W <- geemod$naive.variance
fname <-
- if is.function(family) deparse(substitute(family)) else family
+ if (is.function(family)) deparse(substitute(family)) else family
if (fname == "binomial")
W <- summary(glm(formula, family = quasibinomial, data = data))$cov.scaled
N <- geemod$nobs
-## identify.phylo.R (2008-02-08)
+## identify.phylo.R (2008-02-28)
## Graphical Identification of Nodes and Tips
{
cat("Click close to a node of the tree...\n")
xy <- locator(1)
- Ntip <- get("last_plot.phylo$Ntip", envir = .PlotPhyloEnv)
- d <- sqrt((xy$x - get("last_plot.phylo$xx", envir = .PlotPhyloEnv))^2 +
- (xy$y - get("last_plot.phylo$yy", envir = .PlotPhyloEnv))^2)
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
+ d <- sqrt((xy$x - lastPP$xx)^2 + (xy$y - lastPP$yy)^2)
NODE <- which.min(d)
res <- list()
- if (NODE <= Ntip) {
+ if (NODE <= lastPP$Ntip) {
res$tips <- if (labels) x$tip.label[NODE] else NODE
return(res)
}
if (tips) {
- TIPS <- prop.part(x)[[NODE - Ntip]]
+ TIPS <- prop.part(x)[[NODE - lastPP$Ntip]]
res$tips <- if (labels) x$tip.label[TIPS] else TIPS
}
if (nodes) {
if (is.null(x$node.label)) labels <- FALSE
- res$nodes <- if (labels) x$node.label[NODE - Ntip] else NODE
+ res$nodes <- if (labels) x$node.label[NODE - lastPP$Ntip] else NODE
}
res
}
-## nodelabels.R (2008-02-21)
+## nodelabels.R (2008-02-28)
## Labelling Trees
pch = NULL, thermo = NULL, pie = NULL, piecol = NULL,
col = "black", bg = "lightblue", ...)
{
- xx <- get("last_plot.phylo$xx", envir = .PlotPhyloEnv)
- yy <- get("last_plot.phylo$yy", envir = .PlotPhyloEnv)
- if (missing(node))
- node <- (get("last_plot.phylo$Ntip",
- envir = .PlotPhyloEnv) + 1):length(xx)
- XX <- xx[node]
- YY <- yy[node]
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
+ if (missing(node)) node <- (lastPP$Ntip + 1):length(lastPP$xx)
+ XX <- lastPP$xx[node]
+ YY <- lastPP$yy[node]
BOTHlabels(text, node, XX, YY, adj, frame, pch, thermo,
pie, piecol, col, bg, ...)
}
pch = NULL, thermo = NULL, pie = NULL, piecol = NULL,
col = "black", bg = "yellow", ...)
{
- if (missing(tip))
- tip <- 1:get("last_plot.phylo$Ntip", envir = .PlotPhyloEnv)
- XX <- get("last_plot.phylo$xx", envir = .PlotPhyloEnv)[tip]
- YY <- get("last_plot.phylo$yy", envir = .PlotPhyloEnv)[tip]
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
+ if (missing(tip)) tip <- 1:lastPP$Ntip
+ XX <- lastPP$xx[tip]
+ YY <- lastPP$yy[tip]
BOTHlabels(text, tip, XX, YY, adj, frame, pch, thermo,
pie, piecol, col, bg, ...)
}
pch = NULL, thermo = NULL, pie = NULL, piecol = NULL,
col = "black", bg = "lightgreen", ...)
{
- xx <- get("last_plot.phylo$xx", envir = .PlotPhyloEnv)
- yy <- get("last_plot.phylo$yy", envir = .PlotPhyloEnv)
- lastEdge <- get("last_plot.phylo$edge", envir = .PlotPhyloEnv)
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
if (missing(edge)) {
- sel <- 1:dim(lastEdge)[1]
- subedge <- lastEdge
+ sel <- 1:dim(lastPP$edge)[1]
+ subedge <- lastPP$edge
} else {
sel <- edge
- subedge <- lastEdge[sel, , drop = FALSE]
+ subedge <- lastPP$edge[sel, , drop = FALSE]
}
- if (get("last_plot.phylo$type", envir = .PlotPhyloEnv) == "phylogram") {
- if(get("last_plot.phylo$direction", envir = .PlotPhyloEnv)
- %in% c("rightwards", "leftwards")) {
- XX <- (xx[subedge[, 1]] + xx[subedge[, 2]]) / 2
- YY <- yy[subedge[, 2]]
+ if (lastPP$type == "phylogram") {
+ if (lastPP$direction %in% c("rightwards", "leftwards")) {
+ XX <- (lastPP$xx[subedge[, 1]] + lastPP$xx[subedge[, 2]]) / 2
+ YY <- lastPP$yy[subedge[, 2]]
} else {
- XX <- xx[subedge[, 2]]
- YY <- (yy[subedge[, 1]] + yy[subedge[, 2]]) / 2
+ XX <- lastPP$xx[subedge[, 2]]
+ YY <- (lastPP$yy[subedge[, 1]] + lastPP$yy[subedge[, 2]]) / 2
}
} else {
- XX <- (xx[subedge[, 1]] + xx[subedge[, 2]]) / 2
- YY <- (yy[subedge[, 1]] + yy[subedge[, 2]]) / 2
+ XX <- (lastPP$xx[subedge[, 1]] + lastPP$xx[subedge[, 2]]) / 2
+ YY <- (lastPP$yy[subedge[, 1]] + lastPP$yy[subedge[, 2]]) / 2
}
BOTHlabels(text, sel, XX, YY, adj, frame, pch, thermo,
pie, piecol, col, bg, ...)
-## plot.phylo.R (2008-02-08)
+## plot.phylo.R (2008-02-28)
## Plot Phylogenies
label.offset = label.offset, x.lim = x.lim, y.lim = y.lim,
direction = direction, tip.color = tip.color,
Ntip = Ntip, Nnode = Nnode)
- assing("last_plot.phylo", c(L, list(edge = xe, xx = xx, yy = yy)),
+ assign("last_plot.phylo", c(L, list(edge = xe, xx = xx, yy = yy)),
envir = .PlotPhyloEnv)
invisible(L)
}
par(ask = TRUE)
on.exit(par(ask = FALSE))
}
- for (i in x) plot(i, ...)
+ for (i in 1:length(x)) plot(x[[i]], ...)
}
-## read.nexus.R (2007-12-22)
+## read.nexus.R (2008-02-28)
## Read Tree File in Nexus Format
-## Copyright 2003-2007 Emmanuel Paradis
+## Copyright 2003-2008 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
-clado.build <- function(tp) {
+.treeBuildWithTokens <- function(x)
+{
+ 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")
+ names(phy) <- nms
+ if (!sum(phy[[4]])) phy[[4]] <- NULL
+ class(phy) <- "phylo"
+ phy
+}
+
+clado.build <- function(tp)
+{
add.internal <- function() {
edge[j, 1] <<- current.node
node <<- node + 1
edge <- edge[-nb.edge, ]
obj <- list(edge = edge, tip.label = tip.label,
Nnode = nb.node, node.label = node.label)
- obj$node.label <- if (all(obj$node.label == "NA")) NULL else gsub("^NA", "", obj$node.label)
+ obj$node.label <-
+ if (all(obj$node.label == "NA")) NULL
+ else gsub("^NA", "", obj$node.label)
class(obj) <- "phylo"
- return(obj)
+ obj
}
read.nexus <- function(file, tree.names = NULL)
{
- X <- scan(file = file, what = character(), sep = "\n", quiet = TRUE)
- ## first remove all the comments
+ X <- scan(file = file, what = "", sep = "\n", quiet = TRUE)
+ ## remove all comments
+ ## (this might not work if there are square brackets within the comments)
LEFT <- grep("\\[", X)
RIGHT <- grep("\\]", X)
- if (length(LEFT)) {
- for (i in length(LEFT):1) {
- if (LEFT[i] == RIGHT[i]) {
- X[LEFT[i]] <- gsub("\\[.*\\]", "", X[LEFT[i]])
- } else {
- X[LEFT[i]] <- gsub("\\[.*", "", X[LEFT[i]])
- X[RIGHT[i]] <- gsub(".*\\]", "", X[RIGHT[i]])
- if (LEFT[i] < RIGHT[i] - 1) X <- X[-((LEFT[i] + 1):(RIGHT[i] - 1))]
- }
+ if (length(LEFT)) { # in case there are no comments at all
+ w <- LEFT == RIGHT
+ if (any(w)) { # in case all comments use at least 2 lines
+ s <- LEFT[w]
+ X[s] <- gsub("\\[.*\\]", "", X[s])
+ }
+ w <- !w
+ if (any(w)) {
+ s <- LEFT[w]
+ X[s] <- gsub("\\[.*", "", X[s])
+ sb <- RIGHT[w]
+ X[sb] <- gsub(".*\\]", "", X[sb])
+ if (any(s < sb - 1))
+ X <- X[-unlist(mapply(":", (s + 1), (sb - 1)))]
}
}
- X <- gsub("ENDBLOCK;", "END;", X, ignore.case = TRUE)
- endblock <- grep("END;", X, ignore.case = TRUE)
+ endblock <- grep("END;|ENDBLOCK;", X, ignore.case = TRUE)
semico <- grep(";", X)
i1 <- grep("BEGIN TREES;", X, ignore.case = TRUE)
i2 <- grep("TRANSLATE", X, ignore.case = TRUE)
- translation <- FALSE
- if (length(i2) == 1) if (i2 > i1) translation <- TRUE
+ translation <- if (length(i2) == 1 && i2 > i1) TRUE else FALSE
if (translation) {
end <- semico[semico > i2][1]
- x <- paste(X[i2:end], sep = "", collapse = "")
- x <- gsub("TRANSLATE", "", x, ignore.case = TRUE)
+ x <- X[(i2 + 1):end] # assumes there's a 'new line' after "TRANSLATE"
+ ## x <- gsub("TRANSLATE", "", x, ignore.case = TRUE)
x <- unlist(strsplit(x, "[,; \t]"))
- x <- x[x != ""]
+ x <- x[nzchar(x)]
TRANS <- matrix(x, ncol = 2, byrow = TRUE)
TRANS[, 2] <- gsub("['\"]", "", TRANS[, 2])
+ n <- dim(TRANS)[1]
}
- start <- if (translation) semico[semico > i2][1] + 1 else semico[semico > i1][1]
+ start <-
+ if (translation) semico[semico > i2][1] + 1
+ else semico[semico > i1][1]
end <- endblock[endblock > i1][1] - 1
- tree <- paste(X[start:end], sep = "", collapse = "")
- tree <- gsub(" ", "", tree)
- tree <- unlist(strsplit(tree, "[=;]"))
- tree <- tree[grep("[\\(\\)]", tree)]
- nb.tree <- length(tree)
- STRING <- as.list(tree)
- trees <- list()
- for (i in 1:nb.tree) {
- obj <- if (length(grep(":", STRING[[i]]))) tree.build(STRING[[i]]) else clado.build(STRING[[i]])
+ tree <- X[start:end]
+ rm(X)
+ tree <- gsub("^.*= *", "", 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
+ rm(tree)
+ STRING <- gsub(" ", "", STRING)
+ colon <- grep(":", STRING)
+ if (!length(colon)) {
+ trees <- lapply(STRING, clado.build)
+ } else if (length(colon) == Ntree) {
+ trees <-
+ if (translation) lapply(STRING, .treeBuildWithTokens)
+ else lapply(STRING, tree.build)
+ } else {
+ trees <- vector("list", Ntree)
+ trees[colon] <- lapply(STRING[colon], tree.build)
+ nocolon <- (1:Ntree)[!1:Ntree %in% colon]
+ trees[nocolon] <- lapply(STRING[nocolon], clado.build)
if (translation) {
- for (j in 1:length(obj$tip.label)) {
- ind <- which(obj$tip.label[j] == TRANS[, 1])
- obj$tip.label[j] <- TRANS[ind, 2]
- }
- if (!is.null(obj$node.label)) {
- for (j in 1:length(obj$node.label)) {
- ind <- which(obj$node.label[j] == TRANS[, 1])
- obj$node.label[j] <- TRANS[ind, 2]
+ for (i in 1:Ntree) {
+ tr <- trees[[i]]
+ for (j in 1:n) {
+ ind <- which(tr$tip.label[j] == TRANS[, 1])
+ tr$tip.label[j] <- TRANS[ind, 2]
}
+ if (!is.null(tr$node.label)) {
+ for (j in 1:length(tr$node.label)) {
+ ind <- which(tr$node.label[j] == TRANS[, 1])
+ tr$node.label[j] <- TRANS[ind, 2]
+ }
+ }
+ trees[[i]] <- tr
}
+ translation <- FALSE
}
+ }
+ for (i in 1:Ntree) {
+ tr <- trees[[i]]
## Check here that the root edge is not incorrectly represented
## in the object of class "phylo" by simply checking that there
## is a bifurcation at the root
- ROOT <- length(obj$tip.label) + 1
- if (sum(obj$edge[, 1] == ROOT) == 1 && dim(obj$edge)[1] > 1) {
+ 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 = ""))
}
- trees[[i]] <- obj
}
- if (nb.tree == 1) trees <- trees[[1]] else {
- names(trees) <- if (is.null(tree.names))
- paste("tree", 1:nb.tree, sep = "") else tree.names
+ if (Ntree == 1) trees <- trees[[1]] else {
+ if (!is.null(tree.names)) names(trees) <- tree.names
+ if (translation) attr(trees, "TipLabel") <- TRANS[, 2]
class(trees) <- "multiPhylo"
}
- if (length(grep("[\\/]", file)) == 1) attr(trees, "origin") <- file
- else attr(trees, "origin") <- paste(getwd(), file, sep = "/")
+ if (length(grep("[\\/]", file)) == 1)
+ file <- paste(getwd(), file, sep = "/")
+ attr(trees, "origin") <- file
trees
}
-## read.tree.R (2007-12-22)
+## read.tree.R (2008-02-18)
## Read Tree Files in Parenthetic Format
-## Copyright 2002-2007 Emmanuel Paradis
+## Copyright 2002-2008 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
{
add.internal <- function() {
edge[j, 1] <<- current.node
- edge[j, 2] <<- current.node <<- node <<- node + 1
- j <<- j + 1
+ edge[j, 2] <<- current.node <<- node <<- node + 1L
+ j <<- j + 1L
}
add.terminal <- function() {
edge[j, 1] <<- current.node
X <- unlist(strsplit(tpc[k], ":"))
tip.label[tip] <<- X[1]
edge.length[j] <<- as.numeric(X[2])
- k <<- k + 1
- tip <<- tip + 1
- j <<- j + 1
+ k <<- k + 1L
+ tip <<- tip + 1L
+ j <<- j + 1L
}
go.down <- function() {
l <- which(edge[, 2] == current.node)
X <- unlist(strsplit(tpc[k], ":"))
node.label[current.node - nb.tip] <<- X[1]
edge.length[l] <<- as.numeric(X[2])
- k <<- k + 1
+ k <<- k + 1L
current.node <<- edge[l, 1]
}
if (!length(grep(",", tp))) {
- obj <- list(edge = matrix(c(2, 1), 1, 2))
+ obj <- list(edge = matrix(c(2L, 1L), 1, 2))
tp <- unlist(strsplit(tp, "[\\(\\):;]"))
obj$edge.length <- as.numeric(tp[3])
- obj$Nnode <- 1
+ obj$Nnode <- 1L
obj$tip.label <- tp[2]
if (length(tp) == 4) obj$node.label <- tp[4]
class(obj) <- "phylo"
return(obj)
}
- tsp <- unlist(strsplit(tp, NULL))
+
tpc <- unlist(strsplit(tp, "[\\(\\),;]"))
- tpc <- tpc[tpc != ""]
- skeleton <- tsp[tsp == "(" | tsp == ")" | tsp == "," | tsp == ";"]
+ tpc <- tpc[nzchar(tpc)]
+ ## the following 2 lines are (slightly) faster than using gsub()
+ tsp <- unlist(strsplit(tp, NULL))
+ skeleton <- tsp[tsp %in% c("(", ")", ",", ";")]
nsk <- length(skeleton)
nb.node <- sum(skeleton == ")")
nb.tip <- sum(skeleton == ",") + 1
tip.label <- character(nb.tip)
edge.length <- numeric(nb.edge)
- edge <- matrix(NA, nb.edge, 2)
- current.node <- node <- nb.tip + 1 # node number
- edge[nb.edge, 1] <- 0 # see comment above
+ edge <- matrix(0L, nb.edge, 2)
+ current.node <- node <- as.integer(nb.tip + 1) # node number
edge[nb.edge, 2] <- node #
## j: index of the line number of edge
## k: index of the line number of tpc
## tip: tip number
- j <- k <- tip <- 1
+ j <- k <- tip <- 1L
for (i in 2:nsk) {
if (skeleton[i] == "(") add.internal() # add an internal branch (on top)
if (skeleton[i - 1] == ")") go.down() # go down one level
}
}
- if (is.na(node.label[1])) node.label[1] <- ""
+
edge <- edge[-nb.edge, ]
+ obj <- list(edge = edge, Nnode = nb.node, tip.label = tip.label)
root.edge <- edge.length[nb.edge]
edge.length <- edge.length[-nb.edge]
- obj <- list(edge = edge, edge.length = edge.length, Nnode = nb.node,
- tip.label = tip.label, node.label = node.label,
- root.edge = root.edge)
- if (all(obj$node.label == "")) obj$node.label <- NULL
- if (is.na(obj$root.edge)) obj$root.edge <- NULL
- if (all(is.na(obj$edge.length))) obj$edge.length <- NULL # added 2005-08-18
+ if (!all(is.na(edge.length))) # added 2005-08-18
+ obj$edge.length <- edge.length
+ if (is.na(node.label[1])) node.label[1] <- ""
+ if (any(nzchar(node.label))) obj$node.label <- node.label
+ if (!is.na(root.edge)) obj$root.edge <- root.edge
class(obj) <- "phylo"
obj
}
stop("argument `text' must be of mode character")
tree <- text
} else {
- tree <- scan(file = file, what = character(), sep = "\n", quiet = TRUE,
+ tree <- scan(file = file, what = "", sep = "\n", quiet = TRUE,
skip = skip, comment.char = comment.char, ...)
}
## Suggestion from Eric Durand and Nicolas Bortolussi (added 2005-08-17):
return(NULL)
}
tree <- gsub("[ \t]", "", tree)
- tsp <- unlist(strsplit(tree, NULL))
- ind <- which(tsp == ";")
- nb.tree <- length(ind)
- x <- c(1, ind[-nb.tree] + 1)
- y <- ind - 1
+ tree <- unlist(strsplit(tree, NULL))
+ y <- which(tree == ";")
+ Ntree <- length(y)
+ x <- c(1, y[-Ntree] + 1)
## Suggestion from Olivier François (added 2006-07-15):
if (is.na(y[1])) return(NULL)
- else {
- STRING <- vector("list", nb.tree)
- for (i in 1:nb.tree)
- STRING[[i]] <- paste(tsp[x[i]:y[i]], sep = "", collapse = "")
+ STRING <- character(Ntree)
+ for (i in 1:Ntree)
+ STRING[i] <- paste(tree[x[i]:y[i]], sep = "", collapse = "")
+ colon <- grep(":", STRING)
+ if (!length(colon)) {
+ obj <- lapply(STRING, clado.build)
+ } else if (length(colon) == Ntree) {
+ obj <- lapply(STRING, tree.build)
+ } else {
+ obj <- vector("list", Ntree)
+ obj[colon] <- lapply(STRING[colon], tree.build)
+ nocolon <- (1:Ntree)[!1:Ntree %in% colon]
+ obj[nocolon] <- lapply(STRING[nocolon], clado.build)
}
- obj <- vector("list", nb.tree)
- for (i in 1:nb.tree) {
- obj[[i]] <- if (length(grep(":", STRING[[i]]))) tree.build(STRING[[i]]) else clado.build(STRING[[i]])
+ for (i in 1:Ntree) {
## Check here that the root edge is not incorrectly represented
## in the object of class "phylo" by simply checking that there
## is a bifurcation at the root
ROOT <- length(obj[[i]]$tip.label) + 1
- if(sum(obj[[i]]$edge[, 1] == ROOT) == 1 && dim(obj[[i]]$edge)[1] > 1) {
+ if(sum(obj[[i]]$edge[, 1] == ROOT) == 1 && dim(obj[[i]]$edge)[1] > 1)
stop(paste("There is apparently two root edges in your file: cannot read tree file.\n Reading Newick file aborted at tree no.", i, sep = ""))
- }
}
- if (nb.tree == 1) obj <- obj[[1]] else {
- if (is.null(tree.names))
- tree.names <- paste("tree", 1:nb.tree, sep = "")
- names(obj) <- tree.names
+ if (Ntree == 1) obj <- obj[[1]] else {
+ if (!is.null(tree.names)) names(obj) <- tree.names
class(obj) <- "multiPhylo"
}
obj
-## scales.R (2008-02-08)
+## scales.R (2008-02-28)
## Add a Scale Bar or Axis to a Phylogeny Plot
add.scale.bar <- function(x = 0, y = 1, length = NULL, ...)
{
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
if (is.null(length)) {
- nb.digit <- ceiling(log10(mean(get("last_plot.phylo$xx",
- envir = .PlotPhyloEnv)))) - 2
+ nb.digit <- ceiling(log10(mean(lastPP$xx))) - 2
length <- eval(parse(text = paste("1e", nb.digit, sep = "")))
}
segments(x, y, x + length, y)
axisPhylo <- function(side = 1, ...)
{
- type <- get("last_plot.phylo$type", envir = .PlotPhyloEnv)
- direction <- get("last_plot.phylo$direction", envir = .PlotPhyloEnv)
- if (type %in% c("phylogram", "cladogram")) {
- if (direction %in% c("rightwards", "leftwards")) {
- xx <- get("last_plot.phylo$xx", envir = .PlotPhyloEnv)
- x <- pretty(xx)
- if (direction == "rightwards") maxi <- max(xx)
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
+ if (lastPP$type %in% c("phylogram", "cladogram")) {
+ if (lastPP$direction %in% c("rightwards", "leftwards")) {
+ x <- pretty(lastPP$xx)
+ if (lastPP$direction == "rightwards") maxi <- max(lastPP$xx)
else {
- maxi <- min(xx)
+ maxi <- min(lastPP$xx)
x <- -x
}
} else {
- yy <- get("last_plot.phylo$yy", envir = .PlotPhyloEnv)
- x <- pretty(yy)
- if (direction == "upwards") maxi <- max(yy)
+ x <- pretty(lastPP$yy)
+ if (lastPP$direction == "upwards") maxi <- max(lastPP$yy)
else {
- maxi <- min(yy)
+ maxi <- min(lastPP$yy)
x <- -x
}
}
-## summary.phylo.R (2007-12-29)
+## summary.phylo.R (2008-02-28)
## Print Summary of a Phylogeny
-## Copyright 2003-2007 Emmanuel Paradis, and 2006 Ben Bolker
+## Copyright 2003-2008 Emmanuel Paradis, and 2006 Ben Bolker
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
cat("\n")
}
+"[[.multiPhylo" <- function(x, i)
+{
+ class(x) <- NULL
+ phy <- x[[i]]
+ if (!is.null(attr(x, "TipLabel")))
+ phy$tip.label <- attr(x, "TipLabel")
+ phy
+}
+
+`$.multiPhylo` <- function(x, name) x[[name]]
+
"[.multiPhylo" <- function(x, i)
{
class(x) <- NULL
- structure(x[i], class = "multiPhylo")
+ structure(x[i], TipLabel = attr(x, "TipLabel"),
+ class = "multiPhylo")
+}
+
+str.multiPhylo <- function(object, ...)
+{
+ class(object) <- NULL
+ str(object, ...)
}
Moran's I coefficient is computed using the formula:
\deqn{I = \frac{n}{S_0} \frac{\sum_{i=1}^n\sum_{j=1}^n w_{i,j}(y_i -
\overline{y})(y_j - \overline{y})}{\sum_{i=1}^n {(y_i -
- \overline{y})}^2}}
- {\code{I = n/S0 * (sum\{i=1..n\} sum\{j=1..n\} wij(yi - ym))(yj - ym)
+ \overline{y})}^2}}{\code{I = n/S0 * (sum\{i=1..n\} sum\{j=1..n\} wij(yi - ym))(yj - ym)
/ (sum\{i=1..n\} (yi - ym)^2)}}
with
\itemize{
ltt.plot(phy, xlab = "Time", ylab = "N", ...)
ltt.lines(phy, ...)
mltt.plot(phy, ..., dcol = TRUE, dlty = FALSE, legend = TRUE,
- xlab = "Time", ylab = "N", log = ""))
+ xlab = "Time", ylab = "N", log = "")
}
\arguments{
\item{phy}{an object of class \code{"phylo"}; this could be an object
\alias{print.phylo}
\alias{print.multiPhylo}
\alias{[.multiPhylo}
+\alias{[[.multiPhylo}
+\alias{$.multiPhylo}
+\alias{str.multiPhylo}
\title{Compact Display of a Phylogeny}
\usage{
\method{print}{phylo}(x, printlen = 6 ,...)
\method{print}{multiPhylo}(x, details = FALSE ,...)
\method{[}{multiPhylo}(x, i)
+\method{[[}{multiPhylo}(x, i)
+\method{$}{multiPhylo}(x, name)
+\method{str}{multiPhylo}(object, ...)
}
\arguments{
\item{x}{an object of class \code{"phylo"} or \code{"multiPhylo"}.}
+ \item{object}{an object of class \code{"multiPhylo"}.}
\item{printlen}{the number of labels to print (6 by default).}
\item{details}{a logical indicating whether to print information on
all trees.}
- \item{i}{indices of the trees to select from a list; this may be a
+ \item{i}{indices of the tree(s) to select from a list; this may be a
vector of integers, logicals, or names.}
+ \item{name}{a character string specifying the tree to be extracted.}
\item{...}{further arguments passed to or from other methods.}
}
\description{
These functions prints a compact summary of a phylogeny, or a list of,
on the console.
+
+ The operators \code{[}, \code{[[}, and \code{$} propagate the class
+ correctly.
}
\value{
- An object of class \code{"multiPhylo"} or NULL.
+ An object of class \code{"phylo"} (\code{[[}, \code{$}) or of class
+ \code{"multiPhylo"} (\code{[[}), or NULL.
}
\author{Ben Bolker \email{bolker@zoo.ufl.edu} and Emmanuel Paradis
\email{Emmanuel.Paradis@mpl.ird.fr}}
projects / ape.git / commitdiff