- ## Added by Klaus (2013-01-16):
- tx <- tabulate(xmat[, 1])
- singles <- which(tx == 1)
- if (length(singles) > 0) {
- prev.nodes <- match(singles, xmat[,2])
- next.nodes <- match(singles, xmat[,1])
- for(j in length(singles):1) {
- i <- singles[j]
- xmat[prev.nodes[j], 2] <- xmat[next.nodes[j], 2]
- elen[prev.nodes[j]] <- elen[prev.nodes[j]] + elen[next.nodes[j]]
+ singles <- NA
+ while (length(singles) > 0) {
+ ## changed by EP to make it slightly more efficient:
+ ## tx <- table(xmat[xmat < 0])
+ ## singles <- as.numeric(names(tx)[tx < 3])
+ tx <- tabulate(xmat[, 1])
+ singles <- which(tx == 1)
+ ## END
+ if (length(singles) > 0) {
+ i <- singles[1]
+ prev.node <- which(xmat[, 2] == i)
+ next.node <- which(xmat[, 1] == i)
+ xmat[prev.node, 2] <- xmat[next.node, 2]
+ xmat <- xmat[xmat[, 1] != i, ] # drop
+ ## changed by EP for the new coding of "phylo" (2006-10-05):
+ ## xmat[xmat < i] <- xmat[xmat < i] + 1 ## adjust indices
+ xmat[xmat > i] <- xmat[xmat > i] - 1L ## adjust indices # changed '1' by '1L' (2010-07-23)
+ ## END
+ elen[prev.node] <- elen[prev.node] + elen[next.node]
+ ## added by Elizabeth Purdom (2008-06-19):
+ if (!is.null(node.lab)) node.lab <- node.lab[-c(i - ntip)]
+ nnode <- nnode - 1L
+ ## end
+ elen <- elen[-next.node]