[Adephylo-commits] r8 - pkg/R

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

Author: jombart
Date: 2008-11-20 18:21:32 +0100 (Thu, 20 Nov 2008)
New Revision: 8

Modified:
   pkg/R/partition.R
Log:
Added listNodes.


Modified: pkg/R/partition.R
===================================================================
--- pkg/R/partition.R	2008-11-20 16:30:32 UTC (rev 7)
+++ pkg/R/partition.R	2008-11-20 17:21:32 UTC (rev 8)
@@ -3,6 +3,10 @@
 ## For instance to obtain dummy vectors used in the orthogram.
 ##
 
+
+
+
+
 ############
 # listTips
 ############
@@ -16,17 +20,43 @@
     if (is.character(checkval <- check_phylo4(x))) stop(checkval)
 
     ## computations
-    res <- lapply(nodeLabels(x), function(e) descendants(x, e))
+    res <- lapply(1:nNodes(x), function(i) descendants(x, i))
 
-    names(res) <- nodeLabels(x)
+    if(hasNodeLabels(x)) {names(res) <- nodeLabels(x)}
 
     return(res)
-}
+} # end listTips
 
 
 
 
 
+############
+# listNodes
+############
+listNodes <- function(x){
+    if(!require(phylobase)) stop("phylobase package is not installed")
+
+    ## conversion from phylo, phylo4 and phylo4d
+    x <- as(x, "phylo4")
+
+    ## check phylo4 object
+    if (is.character(checkval <- check_phylo4(x))) stop(checkval)
+
+    ## computations
+    nodIdx <- nTips(x)+1
+    nodIdx <- nodIdx:(nodIdx+nNodes(x)-1)
+    res <- lapply(nodIdx, function(i) children(x, i))
+
+    if(hasNodeLabels(x)) {names(res) <- nodeLabels(x)}
+
+    return(res)
+} # end listNodes
+
+
+
+
+
 ###########
 # treePart
 ###########
@@ -52,6 +82,7 @@
     temp <- listTips(x)
     res <- data.frame(lapply(temp,fDum))
     row.names(res) <- x at tip.label
+    res <- res[,-1]
 
     return(res)
 }