R/ladderize.R

   1 ## ladderize.R (2007-01-04)
   2
   3 ##   Ladderize a Tree
   4
   5 ## Copyright 2007 Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 ladderize <- function(phy, right = TRUE)
  11 {
  12     foo <- function(node, END, where) {
  13         start <- which(phy$edge[, 1] == node)
  14         end <- c(start[-1] - 1, END)
  15         size <- end - start + 1
  16         desc <- phy$edge[start, 2]
  17         Nclade <- length(desc)
  18         n <- N[desc]
  19         o <- order(n, decreasing = right)
  20         newpos <- c(0, cumsum(size[o][-Nclade])) + where
  21         desc <- desc[o]
  22         end <- end[o]
  23         start <- start[o]
  24         neworder[newpos] <<- start
  25         for (i in 1:Nclade)
  26           if (desc[i] > nb.tip) foo(desc[i], end[i], newpos[i] + 1)
  27     }
  28     nb.tip <- length(phy$tip.label)
  29     nb.node <- phy$Nnode
  30     nb.edge <- dim(phy$edge)[1]
  31     tmp <- reorder(phy, "pruningwise")
  32     N <- .C("node_depth", as.integer(nb.tip), as.integer(nb.node),
  33             as.integer(tmp$edge[, 1]), as.integer(tmp$edge[, 2]),
  34             as.integer(nb.edge), double(nb.tip + nb.node),
  35             DUP = FALSE, PACKAGE = "ape")[[6]]
  36     neworder <- integer(nb.edge)
  37     foo(nb.tip + 1, nb.edge, 1)
  38     phy$edge <- phy$edge[neworder, ]
  39     if (!is.null(phy$edge.length))
  40       phy$edge.length <- phy$edge.length[neworder]
  41     phy
  42 }