[Phylobase-commits] r326 - pkg/R

[noreply at r-forge.r-project.org]

Author: francois
Date: 2008-12-19 15:02:26 +0100 (Fri, 19 Dec 2008)
New Revision: 326

Modified:
   pkg/R/methods-phylo4.R
Log:
created typeNode method, changed the way rootNode identifies the root

Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R	2008-12-19 12:52:47 UTC (rev 325)
+++ pkg/R/methods-phylo4.R	2008-12-19 14:02:26 UTC (rev 326)
@@ -53,14 +53,40 @@
     ## root node (first node after last tip) has <= 2 descendants
 })
 
+setMethod("typeNode", "phylo4", function(x) {
+    if(nTips(x) == 0)
+        return(NULL)
+    else {
+        listNodes <- sort(unique(as.vector(edges(x))))
+        t <- rep("internal", length(listNodes)) # FM: internal is default (I think it's safer)
+        names(t) <- listNodes
 
+        ## node number of real internal nodes
+        iN <- names(table(edges(x)[,1]))
+        ## node number that are not internal nodes (ie that are tips)
+        tN <- names(t)[!names(t) %in% iN]
+        t[tN] <- "tip"
+
+        ## if the tree is rooted
+        if(isRooted(x)) t[rootNode(x)] <- "root"
+
+        return(t)
+    }
+})
+
+
 setMethod("rootNode", "phylo4", function(x) {
     if (!isRooted(x))
         return(NA)
     if (!is.na(x at root.edge))
         stop("FIXME: don't know what to do in this case")
     ## BMB: danger!  do we require this???
-    return(nTips(x) + 1)
+    ## return(nTips(x) + 1)
+    ## FM: alternative?
+    listNodes <- sort(unique(as.vector(edges(x))))
+    notRoot <- names(table(edges(x)[,2]))
+    iR <- listNodes[!listNodes %in% notRoot]
+    return(iR)
 })
 
 setReplaceMethod("rootNode", "phylo4", function(x, value) {