provisional version of the new reorder.phylo()

[ape.git] / R / reorder.phylo.R

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
 }
+