From: paradis <paradis@6e262413-ae40-0410-9e79-b911bd7a66b7>
Date: Mon, 21 Jan 2013 10:54:42 +0000 (+0000)
Subject: more corrections for ape 3.0-7
X-Git-Url: https://git.donarmstrong.com/?p=ape.git;a=commitdiff_plain;h=dc2dda7eb763b4e140f1e5adb7fa8bfaa2661f6d

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 8245658..bed8b3d 100644
--- 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 6c87184..6ca4ae5 100644
--- 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 e4d2bfe..bbde0a1 100644
--- 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 4b2ddd8..f898f3b 100644
--- 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 01a4db3..d9e52c4 100644
--- 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 */