[Phylobase-commits] r691 - in pkg: R man

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

Author: regetz
Date: 2009-10-14 18:33:55 +0200 (Wed, 14 Oct 2009)
New Revision: 691

Modified:
   pkg/R/treewalk.R
   pkg/man/treewalk.Rd
Log:
enhanced getNode: (1) allow matching against specific node types, (2) if
node is missing, return all nodes of specified type; quickly added type
argument to docs (larger overhaul of documentation forthcoming)


Modified: pkg/R/treewalk.R
===================================================================
--- pkg/R/treewalk.R	2009-10-12 22:00:51 UTC (rev 690)
+++ pkg/R/treewalk.R	2009-10-14 16:33:55 UTC (rev 691)
@@ -7,32 +7,35 @@
 ## x = n-nTips(phy)
 ## so:     n = x+nTips(phy)
 
-getNode <- function(phy, node, missing=c("warn","OK","fail")) {
+getNode <- function(phy, node, type=c("all", "tip", "internal"),
+    missing=c("warn","OK","fail")) {
+
+    type <- match.arg(type)
     missing <- match.arg(missing)
-    if (is.numeric(node) && all(floor(node) == node, na.rm=TRUE)) {
-        node <- as.integer(node)
+
+    ## if missing node arg, get all nodes of specified type
+    if (missing(node)) {
+        node <- nodeId(phy, type)
     }
 
+    ## match node to tree
     if (is.character(node)) {
-        irval <- match(node, labels(phy, "all"))
-
+        irval <- match(node, labels(phy, type))
+    } else if (is.numeric(node) && all(floor(node) == node, na.rm=TRUE)) {
+        irval <- match(as.character(node), names(labels(phy, type)))
+    } else {
+        stop("Node must be a vector of class \'integer\' or \'character\'.")
     }
-    else {
-        if (is.integer(node)) {
-            irval <- match(as.character(node), names(labels(phy, "all")))
-        }
-        else stop("Node must be a vector of class \'integer\' or \'character\'.")
-    }
 
     ## node numbers
-    rval <- names(labels(phy, "all"))[irval]
+    rval <- names(labels(phy, type))[irval]
 
     rval[node == 0]   <- NA # root ancestor gets special treatment
     rval[is.na(node)] <- NA # return NA for any NA_character_ inputs
     rval <- as.integer(rval)
 
     ## node labels
-    nmNd <- labels(phy, "all")[irval]
+    nmNd <- labels(phy, type)[irval]
 
     names(rval) <- nmNd
     names(rval)[rval == 0] <- "0" # root ancestor gets special treatment
@@ -40,7 +43,8 @@
     ## deal with nodes that don't match
     if (any(is.na(rval))) {
         missnodes <- node[is.na(rval)]
-        msg <- paste("Some nodes are missing from tree: ", paste(missnodes,collapse=", "))
+        msg <- paste("Some nodes not found among", type, "nodes in tree:",
+            paste(missnodes,collapse=", "))
         if (missing=="fail") {
             stop(msg)
         } else if (missing=="warn") {

Modified: pkg/man/treewalk.Rd
===================================================================
--- pkg/man/treewalk.Rd	2009-10-12 22:00:51 UTC (rev 690)
+++ pkg/man/treewalk.Rd	2009-10-14 16:33:55 UTC (rev 691)
@@ -20,7 +20,7 @@
   phylogenetic nodes (i.e. internal nodes or tips).
 }
 \usage{
-getNode(phy,node,missing=c("warn","OK","fail"))
+getNode(phy,node,type=c("all","tip","internal"),missing=c("warn","OK","fail"))
 ancestors(phy, node, type=c("all","parent","ALL"))
 ancestor(phy, node)
 siblings(phy,node,include.self=FALSE)