X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fcollapse.singles.R;h=9762bb0538c4f91cb8fad224a9df0701d7869695;hb=9f4eb32b3354f76ec0f13f9ca58ad63b082fecca;hp=cfbf4c80c4c4ddfef46d2471ecdc777714a33f84;hpb=c827059eeafc8cbe41c812b26979543ab287803e;p=ape.git

diff --git a/R/collapse.singles.R b/R/collapse.singles.R
index cfbf4c8..9762bb0 100644
--- a/R/collapse.singles.R
+++ b/R/collapse.singles.R
@@ -1,4 +1,4 @@
-## collapse.singles.R (2006-07-15)
+## collapse.singles.R (2008-06-19)
 
 ##    Collapse "Single" Nodes
 
@@ -11,6 +11,11 @@ collapse.singles <- function(tree)
 {
     elen <- tree$edge.length
     xmat <- tree$edge
+    ## added by Elizabeth Purdom (2008-06-19):
+    node.lab <- tree$node.label
+    nnode <- tree$Nnode
+    ntip <- length(tree$tip.label)
+    ## end
     singles <- NA
     while (length(singles) > 0) {
         ## changed by EP to make it slightly more efficient:
@@ -24,16 +29,24 @@ collapse.singles <- function(tree)
             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
+            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] - 1 ## adjust indices
             ## 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]
         }
     }
     tree$edge <- xmat
     tree$edge.length <- elen
+    ## added by Elizabeth Purdom (2008-06-19):
+    tree$node.label <- node.lab
+    tree$Nnode <- nnode
+    ## end
     tree
 }