R/collapse.singles.R

   1 ## collapse.singles.R (2006-07-15)
   2
   3 ##    Collapse "Single" Nodes
   4
   5 ## Copyright 2006 Ben Bolker
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 collapse.singles <- function(tree)
  11 {
  12     elen <- tree$edge.length
  13     xmat <- tree$edge
  14     singles <- NA
  15     while (length(singles) > 0) {
  16         ## changed by EP to make it slightly more efficient:
  17         ## tx <- table(xmat[xmat < 0])
  18         ## singles <- as.numeric(names(tx)[tx < 3])
  19         tx <- tabulate(xmat[, 1])
  20         singles <- which(tx == 1)
  21         ## END
  22         if (length(singles) > 0) {
  23             i <- singles[1]
  24             prev.node <- which(xmat[, 2] == i)
  25             next.node <- which(xmat[, 1] == i)
  26             xmat[prev.node, 2] <- xmat[next.node, 2]
  27             xmat <- xmat[xmat[, 1] != i, ] ## drop
  28             ## changed by EP for the new coding of "phylo" (2006-10-05):
  29             ## xmat[xmat < i] <- xmat[xmat < i] + 1 ## adjust indices
  30             xmat[xmat > i] <- xmat[xmat > i] - 1 ## adjust indices
  31             ## END
  32             elen[prev.node] <- elen[prev.node] + elen[next.node]
  33             elen <- elen[-next.node]
  34         }
  35     }
  36     tree$edge <- xmat
  37     tree$edge.length <- elen
  38     tree
  39 }