o write.nexus() failed to write correctly trees with a "TipLabel"
attribute.
+ o rcoal() failed to compute branch lengths with very large n.
+
+ o A small bug was fixed in compar.cheverud() (thanks to Michael
+ Phelan for the fix).
+
+ o seg.sites() failed when passing a vector.
+
+ o drop.tip() sometimes shuffled tip labels.
+
+ o root() shuffled node labels with 'resolve.root = TRUE'.
+
CHANGES IN APE VERSION 2.3-2
Package: ape
Version: 2.3-3
-Date: 2009-07-27
+Date: 2009-09-09
Title: Analyses of Phylogenetics and Evolution
Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong, Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel, Gangolf Jobb, Christoph Heibl, Daniel Lawson, Vincent Lefort, Pierre Legendre, Jim Lemon, Yvonnick Noel, Johan Nylander, Rainer Opgen-Rhein, Korbinian Strimmer, Damien de Vienne
Maintainer: Emmanuel Paradis <Emmanuel.Paradis@ird.fr>
# Evolution 55(11): 2143-2160
compar.cheverud <- function(y, W, tolerance=1e-6, gold.tol=1e-4)
{
- W <- W - diag(W) # ensure diagonal is zero
+ ## fix by Michael Phelan
+ diag(W) <- 0 # ensure diagonal is zero
+ ## end of fix
y <- as.matrix(y)
if(dim(y)[2] != 1) stop("Error: y must be a single column vector.")
D <- solve(diag(apply(t(W),2,sum)))
-## DNA.R (2009-05-19)
+## DNA.R (2009-09-06)
## Manipulations and Comparisons of DNA Sequences
seg.sites <- function(x)
{
if (is.list(x)) x <- as.matrix(x)
- n <- dim(x)
- s <- n[2]
- n <- n[1]
+ if (is.vector(x)) n <- 1
+ else { # 'x' is a matrix
+ n <- dim(x)
+ s <- n[2]
+ n <- n[1]
+ }
+ if (n == 1) return(integer(0))
ans <- .C("SegSites", x, n, s, integer(s),
DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")
which(as.logical(ans[[4]]))
}
W <- cophenetic.phylo(phy)
dev <- function(p) {
- M <- rowSums(exp(-p[1] * Wstart) - exp(-p[1] * Wend) * p[-(1:2)])
+ ##M <- rowSums(exp(-p[1] * Wstart) - exp(-p[1] * Wend) * p[-(1:2)])
+ ##M <- -rowSums(exp(-p[1] * Wstart) - exp(-p[1] * Wend) * p[-(1:2)])
+ M <- rowSums((exp(-p[1] * Wend) - exp(-p[1] * Wstart)) * p[-(1:2)])
V <- exp(-p[1]*W) * (1 - exp(-2*p[1]*(Tmax - W/2)))
nb.tip*log(2*pi*p[2]) + log(det(V)) +
(t(x - M) %*% chol2inv(V) %*% (x - M)) / p[2]
dist.topo <- function(x, y, method = "PH85")
{
if (method == "BHV01" && (is.null(x$edge.length) || is.null(y$edge.length)))
- stop("trees must have branch lengths for Billera et al.'s distance.")
+ stop("trees must have branch lengths for Billera et al.'s distance.")
n <- length(x$tip.label)
bp1 <- .Call("bipartition", x$edge, n, x$Nnode, PACKAGE = "ape")
bp1 <- lapply(bp1, function(xx) sort(x$tip.label[xx]))
-## drop.tip.R (2009-07-06)
+## drop.tip.R (2009-09-09)
## Remove Tips in a Phylogenetic Tree
n <- length(oldNo.ofNewTips) # the new number of tips in the tree
- ## assumes that the ordering of tips is unchanged:
- phy$edge[TERMS, 2] <- 1:n
+ ## the tips may not be sorted in increasing order of their
+ ## in the 2nd col of edge, so no need to reorder $tip.label
+ phy$edge[TERMS, 2] <- rank(phy$edge[TERMS, 2])
## make new tip labels if necessary:
if (subtree || !trim.internal) {
-## root.R (2009-07-06)
+## root.R (2009-09-09)
## Root of Phylogenetic Trees
phy$edge[, 1] <- newNb[phy$edge[, 1]]
if (!is.null(phy$node.label)) {
+ #browser()
newNb <- newNb[-(1:n)]
if (fuseRoot) {
newNb <- newNb[-1]
phy$node.label <- phy$node.label[-1]
}
phy$node.label <- phy$node.label[order(newNb)]
- if (resolve.root)
- phy$node.label <- c(phy$node.label[1], NA, phy$node.label[-1])
+ if (resolve.root) {
+ phy$node.label[is.na(phy$node.label)] <- phy$node.label[1]
+ phy$node.label[1] <- NA
+ ##phy$node.label <- c(phy$node.label[1], NA, phy$node.label[-1])
+ ##phy$node.label <- c("NA", phy$node.label)
+ }
}
phy
}
nbr <- 2*n - 2
edge <- matrix(NA, nbr, 2)
## coalescence times by default:
- x <- if (is.character(br)) 2*rexp(n - 1)/(n:2 * (n - 1):1)
+ x <- if (is.character(br)) 2*rexp(n - 1)/(as.double(n:2) * as.double((n - 1):1))
else br(n - 1, ...)
if (n == 2) {
edge[] <- c(3L, 3L, 1:2)
Significant bug fixes were provided by Cécile Ané, James Bullard,
Éric Durand, Olivier François, Rich FitzJohn, Bret Larget, Nick Matzke,
-Elizabeth Purdom, Dan Rabosky, Klaus Schliep, Tim Wallstrom, Li-San
-Wang, Yan Wong, and Peter Wragg. Contact me if I forgot someone.
+Michael Phelan, Elizabeth Purdom, Dan Rabosky, Klaus Schliep, Tim
+Wallstrom, Li-San Wang, Yan Wong, and Peter Wragg. Contact me if I
+forgot someone.
Kurt Hornik, of the R Core Team, helped in several occasions to
fix some problems and bugs.
for (i = OTU1 - 1; i > 0; i--)
otu_label[i] = otu_label[i - 1];
if (OTU2 != n)
- for (i = OTU2; i <= n; i++)
+ for (i = OTU2; i < n; i++)
otu_label[i - 1] = otu_label[i];
otu_label[0] = cur_nod;