R/collapse.singles.R

   1 ## collapse.singles.R (2013-01-16)
   2
   3 ##    Collapse "Single" Nodes
   4
   5 ## Copyright 2006 Ben Bolker, 2013 Klaus Schliep
   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     tree <- reorder(tree) # added by Klaus
  13     elen <- tree$edge.length
  14     xmat <- tree$edge
  15     ## added by Elizabeth Purdom (2008-06-19):
  16     node.lab <- tree$node.label
  17     nnode <- tree$Nnode
  18     ntip <- length(tree$tip.label)
  19     ## end
  20     ## Added by Klaus (2013-01-16):
  21     tx <- tabulate(xmat[, 1])
  22     singles <- which(tx == 1)
  23     if (length(singles) > 0) {
  24         prev.nodes <- match(singles, xmat[,2])
  25         next.nodes <- match(singles, xmat[,1])
  26         for(j in length(singles):1) {
  27             i <- singles[j]
  28             xmat[prev.nodes[j], 2] <- xmat[next.nodes[j], 2]
  29             elen[prev.nodes[j]] <- elen[prev.nodes[j]] + elen[next.nodes[j]]
  30         }
  31         xmat <- xmat[-next.nodes,]
  32         elen <- elen[-next.nodes]
  33         if (!is.null(node.lab)) node.lab <- node.lab[-c(singles - ntip)]
  34         nnode = nnode - as.integer(length(singles))
  35         tmp = integer(max(xmat))
  36         tmp[sort(unique(as.vector(xmat)))] = as.integer(c(1:(ntip+nnode)))
  37         xmat[] = tmp[xmat]
  38     }
  39     # End
  40     tree$edge <- xmat
  41     tree$edge.length <- elen
  42     ## added by Elizabeth Purdom (2008-06-19):
  43     tree$node.label <- node.lab
  44     tree$Nnode <- nnode
  45     ## end
  46     tree
  47 }