1 ## collapse.singles.R (2008-06-19)
3 ## Collapse "Single" Nodes
5 ## Copyright 2006 Ben Bolker
7 ## This file is part of the R-package `ape'.
8 ## See the file ../COPYING for licensing issues.
10 collapse.singles <- function(tree)
12 elen <- tree$edge.length
14 ## added by Elizabeth Purdom (2008-06-19):
15 node.lab <- tree$node.label
17 ntip <- length(tree$tip.label)
20 while (length(singles) > 0) {
21 ## changed by EP to make it slightly more efficient:
22 ## tx <- table(xmat[xmat < 0])
23 ## singles <- as.numeric(names(tx)[tx < 3])
24 tx <- tabulate(xmat[, 1])
25 singles <- which(tx == 1)
27 if (length(singles) > 0) {
29 prev.node <- which(xmat[, 2] == i)
30 next.node <- which(xmat[, 1] == i)
31 xmat[prev.node, 2] <- xmat[next.node, 2]
32 xmat <- xmat[xmat[, 1] != i, ] ## drop
33 ## changed by EP for the new coding of "phylo" (2006-10-05):
34 ## xmat[xmat < i] <- xmat[xmat < i] + 1 ## adjust indices
35 xmat[xmat > i] <- xmat[xmat > i] - 1 ## adjust indices
37 elen[prev.node] <- elen[prev.node] + elen[next.node]
38 ## added by Elizabeth Purdom (2008-06-19):
39 if (!is.null(node.lab)) node.lab <- node.lab[-c(i - ntip)]
42 elen <- elen[-next.node]
46 tree$edge.length <- elen
47 ## added by Elizabeth Purdom (2008-06-19):
48 tree$node.label <- node.lab