From 50912ceb91f34227ae89432b6e6a8969a3a3f5f7 Mon Sep 17 00:00:00 2001 From: paradis Date: Thu, 7 Oct 2010 09:21:18 +0000 Subject: [PATCH] a few changes.... git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@130 6e262413-ae40-0410-9e79-b911bd7a66b7 --- ChangeLog | 13 +++++++++ DESCRIPTION | 6 ++-- R/CDF.birth.death.R | 2 +- R/ace.R | 2 +- R/as.matching.R | 5 ++-- R/as.phylo.R | 4 +-- R/read.nexus.R | 12 ++++---- R/read.tree.R | 12 +++++--- R/write.tree.R | 67 ++++++++++++++++++++++++++++++--------------- Thanks | 2 +- man/DNAbin.Rd | 5 ++-- man/rlineage.Rd | 15 +++++++--- 12 files changed, 97 insertions(+), 48 deletions(-) diff --git a/ChangeLog b/ChangeLog index abb2616..05ff241 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ + CHANGES IN APE VERSION 2.6-1 + + +BUG FIXES + + o as.hclust.phylo() failed with trees with node labels (thanks to + Filipe Vieira for the fix). + + + CHANGES IN APE VERSION 2.6 @@ -57,6 +67,9 @@ OTHER CHANGES o pic() now returns a vector with the node labels of the tree (if available) as names. + o write.tree() and read.tree() have been substantially thanks to + contributions by Klaus Schliep. + CHANGES IN APE VERSION 2.5-3 diff --git a/DESCRIPTION b/DESCRIPTION index dc7c895..014fd6f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: ape -Version: 2.6 -Date: 2010-09-27 +Version: 2.6-1 +Date: 2010-09-30 Title: Analyses of Phylogenetics and Evolution -Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong, Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel, Christoph Heibl, Daniel Lawson, Vincent Lefort, Pierre Legendre, Jim Lemon, Yvonnick Noel, Johan Nylander, Rainer Opgen-Rhein, Korbinian Strimmer, Damien de Vienne +Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong, Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel, Christoph Heibl, Daniel Lawson, Vincent Lefort, Pierre Legendre, Jim Lemon, Yvonnick Noel, Johan Nylander, Rainer Opgen-Rhein, Klaus Schliep, Korbinian Strimmer, Damien de Vienne Maintainer: Emmanuel Paradis Depends: R (>= 2.6.0) Suggests: gee diff --git a/R/CDF.birth.death.R b/R/CDF.birth.death.R index 3608a35..5fa088a 100644 --- a/R/CDF.birth.death.R +++ b/R/CDF.birth.death.R @@ -468,7 +468,7 @@ bd.time <- function(phy, birth, death, BIRTH = NULL, DEATH = NULL, PAR <- matrix(NA, boot, np) i <- 1L while (i <= boot) { - cat("i =", i, "\n") + cat("\rDoing bootstrap no.", i, "\n") x <- sort(sample(x, replace = TRUE)) o <- try(nlminb(ip, foo, control = list(trace = 0, eval.max = 500), upper = upper, lower = lower)) diff --git a/R/ace.R b/R/ace.R index 12c5f99..33c72de 100644 --- a/R/ace.R +++ b/R/ace.R @@ -253,7 +253,7 @@ print.ace <- function(x, digits = 4, ...) cat("Parameter estimates:\n") names(estim) <- c("rate index", "estimate", "std-err") print(estim, row.names = FALSE) - cat("\nScaled likelihoods at the root (type 'x$lik.anc' to get them for all nodes):\n") + cat("\nScaled likelihoods at the root (type '...$lik.anc' to get them for all nodes):\n") print(x$lik.anc[1, ]) } } diff --git a/R/as.matching.R b/R/as.matching.R index eb78aa8..15eb0e7 100644 --- a/R/as.matching.R +++ b/R/as.matching.R @@ -1,8 +1,8 @@ -## as.matching.R (2007-12-23) +## as.matching.R (2010-09-29) ## Conversion Between Phylo and Matching Objects -## Copyright 2005-2007 Emmanuel Paradis +## Copyright 2005-2010 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -60,6 +60,7 @@ as.phylo.matching <- function(x, ...) obj <- list(edge = edge) if (!is.null(x$tip.label)) obj$tip.label <- x$tip.label else obj$tip.label <- as.character(1:nb.tip) + obj$Nnode <- nb.node class(obj) <- "phylo" read.tree(text = write.tree(obj)) } diff --git a/R/as.phylo.R b/R/as.phylo.R index 79491d2..b576a54 100644 --- a/R/as.phylo.R +++ b/R/as.phylo.R @@ -1,4 +1,4 @@ -## as.phylo.R (2010-04-06) +## as.phylo.R (2010-09-30) ## Conversion Among Tree Objects @@ -91,7 +91,7 @@ as.hclust.phylo <- function(x, ...) n <- length(x$tip.label) bt <- rev(branching.times(x)) N <- length(bt) - nm <- as.numeric(names(bt)) + nm <- x$Nnode:1 + n # fix by Filipe G. Vieira (2010-09-30) merge <- matrix(NA, N, 2) for (i in 1:N) { ind <- which(x$edge[, 1] == nm[i]) diff --git a/R/read.nexus.R b/R/read.nexus.R index abcd131..77d5333 100644 --- a/R/read.nexus.R +++ b/R/read.nexus.R @@ -1,8 +1,8 @@ -## read.nexus.R (2009-11-21) +## read.nexus.R (2010-09-27) ## Read Tree File in Nexus Format -## Copyright 2003-2009 Emmanuel Paradis +## Copyright 2003-2009 Emmanuel Paradis and 2010 Klaus Schliep ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -33,18 +33,20 @@ clado.build <- function(tp) edge[j, 1] <<- current.node node <<- node + 1 edge[j, 2] <<- current.node <<- node + index[node] <<- j # set index j <<- j + 1 } add.terminal <- function() { edge[j, 1] <<- current.node edge[j, 2] <<- tip + index[tip] <<- j # set index tip.label[tip] <<- tpc[k] k <<- k + 1 tip <<- tip + 1 j <<- j + 1 } go.down <- function() { - l <- which(edge[, 2] == current.node) + l <- index[current.node] node.label[current.node - nb.tip] <<- tpc[k] k <<- k + 1 current.node <<- edge[l, 1] @@ -77,11 +79,12 @@ clado.build <- function(tp) edge[nb.edge, 1] <- 0 # see comment above edge[nb.edge, 2] <- node # + index <- numeric(nb.edge + 1) + index[node] <- nb.edge ## j: index of the line number of edge ## k: index of the line number of tpc ## tip: tip number j <- k <- tip <- 1 - for (i in 2:nsk) { if (skeleton[i] == "(") add.internal() # add an internal branch (on top) if (skeleton[i] == ",") { @@ -95,7 +98,6 @@ clado.build <- function(tp) if (skeleton[i - 1] == ")") go.down() # go down one level } } -# if(node.label[1] == "NA") node.label[1] <- "" edge <- edge[-nb.edge, ] obj <- list(edge = edge, tip.label = tip.label, Nnode = nb.node, node.label = node.label) diff --git a/R/read.tree.R b/R/read.tree.R index efb3117..87ae296 100644 --- a/R/read.tree.R +++ b/R/read.tree.R @@ -1,8 +1,8 @@ -## read.tree.R (2009-04-27) +## read.tree.R (2010-09-27) ## Read Tree Files in Parenthetic Format -## Copyright 2002-2009 Emmanuel Paradis and Daniel Lawson +## Copyright 2002-2010 Emmanuel Paradis, Daniel Lawson and Klaus Schliep ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -12,11 +12,13 @@ tree.build <- function(tp) add.internal <- function() { edge[j, 1] <<- current.node edge[j, 2] <<- current.node <<- node <<- node + 1L + index[node] <<- j # set index j <<- j + 1L } add.terminal <- function() { edge[j, 1] <<- current.node edge[j, 2] <<- tip + index[tip] <<- j # set index X <- unlist(strsplit(tpc[k], ":")) tip.label[tip] <<- X[1] edge.length[j] <<- as.numeric(X[2]) @@ -25,7 +27,7 @@ tree.build <- function(tp) j <<- j + 1L } go.down <- function() { - l <- which(edge[, 2] == current.node) + l <- index[current.node] X <- unlist(strsplit(tpc[k], ":")) node.label[current.node - nb.tip] <<- X[1] edge.length[l] <<- as.numeric(X[2]) @@ -60,7 +62,9 @@ tree.build <- function(tp) edge.length <- numeric(nb.edge) edge <- matrix(0L, nb.edge, 2) current.node <- node <- as.integer(nb.tip + 1) # node number - edge[nb.edge, 2] <- node # + edge[nb.edge, 2] <- node + index <- numeric(nb.edge + 1) # hash index to avoid which + index[node] <- nb.edge ## j: index of the line number of edge ## k: index of the line number of tpc diff --git a/R/write.tree.R b/R/write.tree.R index fa82a7b..934cda6 100644 --- a/R/write.tree.R +++ b/R/write.tree.R @@ -1,8 +1,8 @@ -## write.tree.R (2009-06-16) +## write.tree.R (2010-09-27) ## Write Tree File in Parenthetic Format -## Copyright 2002-2009 Emmanuel Paradis and Daniel Lawson +## Copyright 2002-2010 Emmanuel Paradis, Daniel Lawson, and Klaus Schliep ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -55,21 +55,23 @@ write.tree <- phy$tip.label <- checkLabel(phy$tip.label) if (nodelab) phy$node.label <- checkLabel(phy$node.label) f.d <- paste("%.", digits, "g", sep = "") - cp <- function(s) STRING <<- paste(STRING, s, sep = "") + cp <- function(x){ + STRING[k] <<- x + k <<- k + 1 + } add.internal <- function(i) { cp("(") - br <- which(phy$edge[, 1] == i) - for (j in br) { - desc <- phy$edge[j, 2] - if (desc > n) add.internal(desc) - else add.terminal(j) - if (j != br[length(br)]) cp(",") + desc <- kids[[i]] + for (j in desc) { + if (j > n) add.internal(j) + else add.terminal(ind[j]) + if (j != desc[length(desc)]) cp(",") } cp(")") - if (nodelab) cp(phy$node.label[i - n]) + if (nodelab) cp(phy$node.label[ind[i] - n]) if (brl) { cp(":") - cp(sprintf(f.d, phy$edge.length[which(phy$edge[, 2] == i)])) + cp(sprintf(f.d, phy$edge.length[ind[i]])) } } add.terminal <- function(i) { @@ -79,16 +81,36 @@ write.tree <- cp(sprintf(f.d, phy$edge.length[i])) } } + n <- length(phy$tip.label) - STRING <- - if (output.tree.names) paste(tree.names, "(", sep = "") else "(" - br <- which(phy$edge[, 1] == n + 1) - for (j in br) { - desc <- phy$edge[j, 2] - if (desc > n) add.internal(desc) - else add.terminal(j) - if (j != br[length(br)]) cp(",") + + ## borrowed from phangorn: + parent <- phy$edge[, 1] + children <- phy$edge[, 2] + kids <- vector("list", n + phy$Nnode) + for (i in 1:length(parent)) + kids[[parent[i]]] <- c(kids[[parent[i]]], children[i]) + + ind <- match(1:max(phy$edge), phy$edge[, 2]) + + LS <- 4*n + 5 + if (brl) LS <- LS + 4*n + if (nodelab) LS <- LS + n + STRING <- character(LS) + k <- 1 + if (output.tree.names) cp(tree.names) + cp("(") + k <- 2 + getRoot <- function(phy) + phy$edge[, 1][!match(phy$edge[, 1], phy$edge[, 2], 0)][1] + root <- getRoot(phy) # replaced n+1 with root - root has not be n+1 + desc <- kids[[root]] + for (j in desc) { + if (j > n) add.internal(j) + else add.terminal(ind[j]) + if (j != desc[length(desc)]) cp(",") } + if (is.null(phy$root.edge)) { cp(")") if (nodelab) cp(phy$node.label[1]) @@ -101,7 +123,8 @@ write.tree <- cp(sprintf(f.d, phy$root.edge)) cp(";") } - if (file == "") return(STRING) - cat(STRING, file = file, append = append, sep = "\n") + STRING <- paste(STRING, collapse = "") + if (file == "") + return(STRING) + else cat(STRING, file = file, append = append, sep = "\n") } - diff --git a/Thanks b/Thanks index 3a8555a..606d7a8 100644 --- a/Thanks +++ b/Thanks @@ -7,7 +7,7 @@ comments, or bug reports: thanks to all of you! Significant bug fixes were provided by Cécile Ané, James Bullard, Otto Cordero, Éric Durand, Olivier François, Rich FitzJohn, Bret Larget, Nick Matzke, Michael Phelan, Elizabeth Purdom, Dan Rabosky, -Klaus Schliep, Tim Wallstrom, Li-San Wang, Yan Wong, Peter Wragg, +Filipe Vieira, Tim Wallstrom, Li-San Wang, Yan Wong, Peter Wragg, and Janet Young. Contact me if I forgot someone. Kurt Hornik, of the R Core Team, helped in several occasions to diff --git a/man/DNAbin.Rd b/man/DNAbin.Rd index bce0df2..18d112a 100644 --- a/man/DNAbin.Rd +++ b/man/DNAbin.Rd @@ -93,9 +93,8 @@ \examples{ data(woodmouse) woodmouse -summary(woodmouse) -summary(woodmouse, 15, 6) -summary(woodmouse[1:5, 1:300], 15, 6) +print(woodmouse, 15, 6) +print(woodmouse[1:5, 1:300], 15, 6) ### Just to show how distances could be influenced by sampling: dist.dna(woodmouse[1:2, ]) dist.dna(woodmouse[1:3, ]) diff --git a/man/rlineage.Rd b/man/rlineage.Rd index d441245..dd36c0f 100644 --- a/man/rlineage.Rd +++ b/man/rlineage.Rd @@ -60,9 +60,16 @@ drop.fossil(phy, tol = 0) \examples{ plot(rlineage(0.1, 0)) # Yule process with lambda = 0.1 plot(rlineage(0.1, 0.05)) # simple birth-death process -b <- function(t) 1/(1 + exp(0.1*t - 2)) # logistic -layout(matrix(1:2, 1)) -plot(rlineage(b, 0.01)) -plot(rbdtree(b, 0.01)) +b <- function(t) 1/(1 + exp(0.2*t - 1)) # logistic +layout(matrix(0:3, 2, byrow = TRUE)) +curve(b, 0, 50, xlab = "Time", ylab = "") +mu <- 0.07 +segments(0, mu, 50, mu, lty = 2) +legend("topright", c(expression(lambda), expression(mu)), + lty = 1:2, bty = "n") +plot(rlineage(b, mu), show.tip.label = FALSE) +title("Simulated with 'rlineage'") +plot(rbdtree(b, mu), show.tip.label = FALSE) +title("Simulated with 'rbdtree'") } \keyword{datagen} -- 2.39.2