From f5c4abe6ac31486e821d82788bf66b5db2be51d1 Mon Sep 17 00:00:00 2001 From: paradis Date: Wed, 16 Jan 2013 02:07:27 +0000 Subject: [PATCH] some updates for ape 3.0-7 git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@204 6e262413-ae40-0410-9e79-b911bd7a66b7 --- DESCRIPTION | 2 +- NEWS | 14 +++++++++---- R/Cheverud.R | 2 +- R/collapse.singles.R | 47 ++++++++++++++++++++------------------------ R/plot.phylo.R | 20 +++++++++---------- 5 files changed, 42 insertions(+), 43 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8d17b0b..8245658 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ape Version: 3.0-7 -Date: 2013-01-03 +Date: 2013-01-16 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, Andrei-Alin Popescu, Klaus Schliep, Korbinian Strimmer, Damien de Vienne Maintainer: Emmanuel Paradis diff --git a/NEWS b/NEWS index 1f2cd22..6c87184 100644 --- a/NEWS +++ b/NEWS @@ -3,7 +3,11 @@ NEW FEATURES - The new function chronos .......... + o The new function chronos estimates chronograms by penalised + likelihood and maximum likelihood with a completely reworked + code and interface. There is a new function makeChronosCalib to + set the calibration points easily. chronos() will eventually + replace chronopl(). o The new function 'where' searches patterns in DNA sequences. @@ -36,9 +40,11 @@ OTHER CHANGES o base.freq() is now faster with lists. - as.matrix.DNAbin() ............ should be faster.... now accepts vectors, + o as.matrix.DNAbin() should be faster and more efficient with + lists; it now accepts vectors. - read.dna() has a new for FASTA files............. faster C code. + o collapse.singles() is faster thanks to Klaus Schliep. This will + speed-up drop.tip() significantly. @@ -480,7 +486,7 @@ NEW FEATURES o base.freq() gains an option 'all' to count all the possible bases including the ambiguous ones (defaults to FALSE). - o read.nexus() now writes tree names in the NEXUS file if given a + o write.nexus() now writes tree names in the NEXUS file if given a list of trees with names. diff --git a/R/Cheverud.R b/R/Cheverud.R index 6b70a12..a2073d0 100644 --- a/R/Cheverud.R +++ b/R/Cheverud.R @@ -35,7 +35,7 @@ compar.cheverud <- function(y, W, tolerance=1e-6, gold.tol=1e-4) } sorted[ii] <- Re(sorted[ii]) # Remove imaginary part } - sorted <- as.real(sorted) + sorted <- as.double(sorted) Distinct <- numeric(0) Distinct[1] <- -Inf diff --git a/R/collapse.singles.R b/R/collapse.singles.R index bbde0a1..e4d2bfe 100644 --- a/R/collapse.singles.R +++ b/R/collapse.singles.R @@ -1,14 +1,15 @@ -## collapse.singles.R (2010-07-23) +## collapse.singles.R (2013-01-16) ## Collapse "Single" Nodes -## Copyright 2006 Ben Bolker +## Copyright 2006 Ben Bolker, 2013 Klaus Schliep ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. collapse.singles <- function(tree) { + tree <- reorder(tree) # added by Klaus elen <- tree$edge.length xmat <- tree$edge ## added by Elizabeth Purdom (2008-06-19): @@ -16,32 +17,26 @@ collapse.singles <- function(tree) nnode <- tree$Nnode ntip <- length(tree$tip.label) ## end - singles <- NA - while (length(singles) > 0) { - ## changed by EP to make it slightly more efficient: - ## tx <- table(xmat[xmat < 0]) - ## singles <- as.numeric(names(tx)[tx < 3]) - tx <- tabulate(xmat[, 1]) - singles <- which(tx == 1) - ## END - if (length(singles) > 0) { - i <- singles[1] - prev.node <- which(xmat[, 2] == i) - next.node <- which(xmat[, 1] == i) - xmat[prev.node, 2] <- xmat[next.node, 2] - xmat <- xmat[xmat[, 1] != i, ] # drop - ## changed by EP for the new coding of "phylo" (2006-10-05): - ## xmat[xmat < i] <- xmat[xmat < i] + 1 ## adjust indices - xmat[xmat > i] <- xmat[xmat > i] - 1L ## adjust indices # changed '1' by '1L' (2010-07-23) - ## END - elen[prev.node] <- elen[prev.node] + elen[next.node] - ## added by Elizabeth Purdom (2008-06-19): - if (!is.null(node.lab)) node.lab <- node.lab[-c(i - ntip)] - nnode <- nnode - 1L - ## end - elen <- elen[-next.node] + ## Added by Klaus (2013-01-16): + tx <- tabulate(xmat[, 1]) + singles <- which(tx == 1) + if (length(singles) > 0) { + prev.nodes <- match(singles, xmat[,2]) + next.nodes <- match(singles, xmat[,1]) + for(j in length(singles):1) { + i <- singles[j] + xmat[prev.nodes[j], 2] <- xmat[next.nodes[j], 2] + elen[prev.nodes[j]] <- elen[prev.nodes[j]] + elen[next.nodes[j]] } + xmat <- xmat[-next.nodes,] + elen <- elen[-next.nodes] + if (!is.null(node.lab)) node.lab <- node.lab[-c(singles - ntip)] + nnode = nnode - as.integer(length(singles)) + tmp = integer(max(xmat)) + tmp[sort(unique(as.vector(xmat)))] = as.integer(c(1:(ntip+nnode))) + xmat[] = tmp[xmat] } + # End tree$edge <- xmat tree$edge.length <- elen ## added by Elizabeth Purdom (2008-06-19): diff --git a/R/plot.phylo.R b/R/plot.phylo.R index 96d9aa4..b9309a0 100644 --- a/R/plot.phylo.R +++ b/R/plot.phylo.R @@ -1,8 +1,8 @@ -## plot.phylo.R (2012-12-19) +## plot.phylo.R (2013-01-11) ## Plot Phylogenies -## Copyright 2002-2012 Emmanuel Paradis +## Copyright 2002-2013 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -650,12 +650,10 @@ node.height.clado <- function(phy) plot.multiPhylo <- function(x, layout = 1, ...) { - if (layout > 1) - layout(matrix(1:layout, ceiling(sqrt(layout)), byrow = TRUE)) - else layout(matrix(1)) - if (!par("ask")) { - par(ask = TRUE) - on.exit(par(ask = FALSE)) + layout(matrix(1:layout, ceiling(sqrt(layout)), byrow = TRUE)) + if (!devAskNewPage() && interactive()) { + devAskNewPage(TRUE) + on.exit(devAskNewPage(FALSE)) } for (i in 1:length(x)) plot(x[[i]], ...) } @@ -721,9 +719,9 @@ kronoviz <- function(x, layout = length(x), horiz = TRUE, ...) h <- 1 } layout(matrix(1:layout, nrow), widths = w, heights = h) - if (layout > Ntree && !par("ask")) { - par(ask = TRUE) - on.exit(par(ask = FALSE)) + if (layout < Ntree && !devAskNewPage() && interactive()) { + devAskNewPage(TRUE) + on.exit(devAskNewPage(FALSE)) } if (horiz) { for (i in 1:Ntree) -- 2.39.2