some updates for ape 3.0-7

git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@204 6e262413-ae40-0410-9e79-b911bd7a66b7

diff --git a/DESCRIPTION b/DESCRIPTION
index 8d17b0b0a986314bb2d46b6ecb8cf5c74df2ba5d..82456580dfef20f4ae3057b3d3bfebbe676e0bc2 100644 (file)
--- 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 <Emmanuel.Paradis@ird.fr>

diff --git a/NEWS b/NEWS
index 1f2cd220f396a79f3bc7b53b25555fa3bf2a683c..6c871841b94dba7d480bd99264ea9c43de64b3a3 100644 (file)
--- 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 6b70a12bf193d11932a9c35a506e05eab0de9637..a2073d05aa7ca53ca1a5b93cb89a6cc8ef340eff 100644 (file)
--- 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 bbde0a17e003ce464a68dab76afa7d4aa412b416..e4d2bfe410516dcc0da6cd586cd6c65f40b6e8a6 100644 (file)
--- 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 96d9aa4e590a6f4b9262335d480fc197ea950076..b9309a004882249ce7444517e1eb1bdb1157e63f 100644 (file)
--- 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)