provisional version of the new reorder.phylo()

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

diff --git a/NEWS b/NEWS
index 812bb6c414cdbf2a9e8f3b54bbbb63b0e711c441..46af03fc06ef1fcf9e8a61d37760c26251265397 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,19 @@
                CHANGES IN APE VERSION 3.0-6
 
 
+NEW FEATURES
+
+    o reorder.phylo() has a new order, "postorder", and a new option
+      index.only = TRUE to return only the vector of indices (the tree
+      is unmodified; see ?reorder.phylo for details).
+
+
+BUG FIXES
+
+    o reorder(, "pruningwise") made R crash if the rows of the edge
+      matrix are in random order.
+
+
 OTHER CHANGES
 
     o dist.nodes() is now 6 to 10 times faster.

diff --git a/R/reorder.phylo.R b/R/reorder.phylo.R
index c7e11d3bb5c4816d4dadccaf9fc69935060fd4ed..ee9e9e0dcf703f7da186d125f82a8f14c26b1758 100644 (file)
--- a/R/reorder.phylo.R
+++ b/R/reorder.phylo.R
@@ -1,4 +1,4 @@
-## reorder.phylo.R (2012-08-17)
+## reorder.phylo.R (2012-09-03)
 
 ##   Internal Reordering of Trees
 
@@ -7,32 +7,37 @@
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
 
-reorder.phylo <- function(x, order = "cladewise", ...)
+reorder.phylo <- function(x, order = "cladewise", index.only = FALSE, ...)
 {
-    order <- match.arg(order, c("cladewise", "pruningwise"))
+    ORDER <- c("cladewise", "postorder", "pruningwise")
+    io <- pmatch(order, ORDER)
+    if (is.na(io)) stop("ambiguous order")
+    order <- ORDER[io]
     if (!is.null(attr(x, "order")))
         if (attr(x, "order") == order) return(x)
     nb.node <- x$Nnode
     if (nb.node == 1) return(x)
     nb.tip <- length(x$tip.label)
     nb.edge <- dim(x$edge)[1]
-    if (order == "cladewise") {
-        neworder <-
-            .C("neworder_cladewise", as.integer(nb.tip),
-               as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
-               as.integer(nb.edge), integer(nb.edge),
-               DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")[[5]]
-    } else {
-        ##node.degree <- tabulate(x$edge[, 1])
+    if (io == 3) {
+        x <- reorder(x)
         neworder <-
             .C("neworder_pruningwise", as.integer(nb.tip),
                as.integer(nb.node), as.integer(x$edge[, 1]),
                as.integer(x$edge[, 2]), as.integer(nb.edge),
                integer(nb.edge), PACKAGE = "ape")[[6]]
+    } else {
+        neworder <-
+            .C("neworder_phylo", as.integer(nb.tip),
+               as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
+               as.integer(nb.edge), integer(nb.edge), io,
+               DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")[[5]]
     }
+    if (index.only) return(neworder)
     x$edge <- x$edge[neworder, ]
     if (!is.null(x$edge.length))
-      x$edge.length <- x$edge.length[neworder]
+        x$edge.length <- x$edge.length[neworder]
     attr(x, "order") <- order
     x
 }
+

diff --git a/man/reorder.phylo.Rd b/man/reorder.phylo.Rd
index 6a002faee528f536db02578c939b6c75408d84cf..dda3b3525c011737ef89473205f17d5a4fb247db 100644 (file)
--- a/man/reorder.phylo.Rd
+++ b/man/reorder.phylo.Rd
@@ -7,13 +7,15 @@
   the one input, but the ordering of the edges could be different.
 }
 \usage{
-\method{reorder}{phylo}(x, order = "cladewise", ...)
+\method{reorder}{phylo}(x, order = "cladewise", index.only = FALSE, ...)
 }
 \arguments{
   \item{x}{an object of class \code{"phylo"}.}
   \item{order}{a character string: either \code{"cladewise"} (the
-    default), or \code{"pruningwise"}, or any unambiguous abbreviation
-    of these.}
+    default), \code{"postorder"}, \code{"pruningwise"}, or any
+    unambiguous abbreviation of these.}
+  \item{index.only}{should the function return only the ordered indices
+    of the rows of the edge matrix?}
   \item{\dots}{further arguments passed to or from other methods.}
 }
 \details{
@@ -29,7 +31,7 @@
   multichotomies and branch lengths are preserved.
 }
 \value{
-  an object of class \code{"phylo"}.
+  an object of class \code{"phylo"}, or a numeric vector if \code{index.only = TRUE}.
 }
 \author{Emmanuel Paradis}
 \seealso{

diff --git a/src/reorder_phylo.c b/src/reorder_phylo.c
index c9c0fabe9a6f37cc01810792ec6db6ec4b9ecc01..7a2f80eb0070d1f0739035d43199bfa6d5587852 100644 (file)
--- a/src/reorder_phylo.c
+++ b/src/reorder_phylo.c
@@ -1,4 +1,4 @@
-/* reorder_phylo.c       2012-08-17 */
+/* reorder_phylo.c       2012-09-03 */
 
 /* Copyright 2008-2012 Emmanuel Paradis */
 
@@ -23,7 +23,21 @@ void foo_reorder(int node, int n, int m, int *e1, int *e2, int *neworder, int *L
        }
 }
 
-void neworder_cladewise(int *n, int *e1, int *e2, int *N, int *neworder)
+void bar_reorder(int node, int n, int m, int *e1, int *e2, int *neworder, int *L, int *pos)
+{
+       int i = node - n - 1, j, k;
+
+       for (j = pos[i] - 1; j >= 0; j--)
+               neworder[iii--] = L[i + m * j] + 1;
+
+       for (j = 0; j < pos[i]; j++) {
+               k = e2[L[i + m * j]];
+               if (k > n)
+                       bar_reorder(k, n, m, e1, e2, neworder, L, pos);
+       }
+}
+
+void neworder_phylo(int *n, int *e1, int *e2, int *N, int *neworder, int *order)
 /* n: nb of tips
    m: nb of nodes
    N: nb of edges */
@@ -58,11 +72,16 @@ void neworder_cladewise(int *n, int *e1, int *e2, int *N, int *neworder)
 /* We start with the root 'n + 1': its index will be changed into
    the corresponding C index inside the recursive function. */
 
-       iii = 0;
-       foo_reorder(*n + 1, *n, m, e1, e2, neworder, L, pos);
+       switch(*order) {
+       case 1 : iii = 0;
+               foo_reorder(*n + 1, *n, m, e1, e2, neworder, L, pos);
+               break;
+       case 2 : iii = *N - 1;
+               bar_reorder(*n + 1, *n, m, e1, e2, neworder, L, pos);
+               break;
+       }
 }
 
-
 #define DO_NODE_PRUNING\
     /* go back down in `edge' to set `neworder' */\
     for (j = 0; j <= i; j++) {\
@@ -130,3 +149,4 @@ void neworder_pruningwise(int *ntip, int *nnode, int *edge1,
        nextI++;
     }
 }
+