more corrections for ape 3.0-7

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

diff --git a/DESCRIPTION b/DESCRIPTION
index 82456580dfef20f4ae3057b3d3bfebbe676e0bc2..bed8b3da3e33c96b41a999a5c53de11fda480683 100644 (file)
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: ape
 Version: 3.0-7
-Date: 2013-01-16
+Date: 2013-01-19
 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 6c871841b94dba7d480bd99264ea9c43de64b3a3..6ca4ae5ac27602474b382f7c026c3d1a533c008e 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -43,9 +43,6 @@ OTHER CHANGES
     o as.matrix.DNAbin() should be faster and more efficient with
       lists; it now accepts vectors.
 
-    o collapse.singles() is faster thanks to Klaus Schliep. This will
-      speed-up drop.tip() significantly.
-
 
 
                CHANGES IN APE VERSION 3.0-6

diff --git a/R/collapse.singles.R b/R/collapse.singles.R
index e4d2bfe410516dcc0da6cd586cd6c65f40b6e8a6..bbde0a17e003ce464a68dab76afa7d4aa412b416 100644 (file)
--- a/R/collapse.singles.R
+++ b/R/collapse.singles.R
@@ -1,15 +1,14 @@
-## collapse.singles.R (2013-01-16)
+## collapse.singles.R (2010-07-23)
 
 ##    Collapse "Single" Nodes
 
-## Copyright 2006 Ben Bolker, 2013 Klaus Schliep
+## Copyright 2006 Ben Bolker
 
 ## 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):
@@ -17,26 +16,32 @@ collapse.singles <- function(tree)
     nnode <- tree$Nnode
     ntip <- length(tree$tip.label)
     ## end
-    ## 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]]
+    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]
         }
-        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/read.dna.R b/R/read.dna.R
index 4b2ddd8e2a65dd7b664071251fd17824320a160e..f898f3bc8a2df3c28dc3697d8edf18edb70b76f6 100644 (file)
--- a/R/read.dna.R
+++ b/R/read.dna.R
@@ -16,6 +16,7 @@ read.FASTA <- function(file)
         x <- x[-icr]
     }
     res <- .Call("rawStreamToDNAbin", x, PACKAGE = "ape")
+    names(res) <- sub("^ +", "", names(res)) # to permit phylosim
     class(res) <- "DNAbin"
     res
 }

diff --git a/src/read_dna.c b/src/read_dna.c
index 01a4db32c5d2b1de517d2f659496a73c1d1b9c13..d9e52c4589661473e08dea156c4b557ece124aac 100644 (file)
--- a/src/read_dna.c
+++ b/src/read_dna.c
@@ -1,4 +1,4 @@
-/* read_dna.c       2013-01-04 */
+/* read_dna.c       2013-01-19 */
 
 /* Copyright 2013 Emmanuel Paradis */
 
@@ -55,7 +55,7 @@ static const unsigned char tab_trans[] = {
        0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, /* 40-49 */
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 50-59 */
        0x00, 0x00, 0x00, 0x02, 0x00, 0x88, 0x70, 0x28, 0xd0, 0x00, /* 60-69 */
-       0x48, 0x00, 0xb0, 0x00, 0x00, 0x50, 0x00, 0xa0, 0xf0, 0x00, /* 70-79 */
+       0x00, 0x48, 0xb0, 0x00, 0x00, 0x50, 0x00, 0xa0, 0xf0, 0x00, /* 70-79 */
        0x00, 0x00, 0xc0, 0x60, 0x18, 0x00, 0xe0, 0x90, 0x00, 0x30, /* 80-89 */
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x88, 0x70, 0x28, /* 90-99 */
        0xd0, 0x00, 0x00, 0x48, 0xb0, 0x00, 0x00, 0x50, 0x00, 0xa0, /* 100-109 */