R/reorder.phylo.R

   1 ## reorder.phylo.R (2012-10-12)
   2
   3 ##   Internal Reordering of Trees
   4
   5 ## Copyright 2006-2012 Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 reorder.phylo <- function(x, order = "cladewise", index.only = FALSE, ...)
  11 {
  12     ORDER <- c("cladewise", "postorder", "pruningwise")
  13     io <- pmatch(order, ORDER)
  14     if (is.na(io)) stop("ambiguous order")
  15     order <- ORDER[io]
  16     nb.edge <- dim(x$edge)[1]
  17     if (!is.null(attr(x, "order")))
  18         if (attr(x, "order") == order)
  19             if (index.only) return(1:nb.edge) else return(x)
  20     nb.node <- x$Nnode
  21     if (nb.node == 1) return(x)
  22     nb.tip <- length(x$tip.label)
  23     if (io == 3) {
  24         x <- reorder(x)
  25         neworder <-
  26             .C("neworder_pruningwise", as.integer(nb.tip),
  27                as.integer(nb.node), as.integer(x$edge[, 1]),
  28                as.integer(x$edge[, 2]), as.integer(nb.edge),
  29                integer(nb.edge), PACKAGE = "ape")[[6]]
  30     } else {
  31         neworder <-
  32             .C("neworder_phylo", as.integer(nb.tip),
  33                as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
  34                as.integer(nb.edge), integer(nb.edge), io,
  35                DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")[[5]]
  36     }
  37     if (index.only) return(neworder)
  38     x$edge <- x$edge[neworder, ]
  39     if (!is.null(x$edge.length))
  40         x$edge.length <- x$edge.length[neworder]
  41     attr(x, "order") <- order
  42     x
  43 }
  44