[Phylobase-commits] r827 - in pkg: . R

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

Author: francois
Date: 2011-02-24 17:01:19 +0100 (Thu, 24 Feb 2011)
New Revision: 827

Modified:
   pkg/DESCRIPTION
   pkg/NEWS
   pkg/R/treewalk.R
Log:
fix bug in getNode in case of tips labelled 0

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2011-02-10 23:00:55 UTC (rev 826)
+++ pkg/DESCRIPTION	2011-02-24 16:01:19 UTC (rev 827)
@@ -1,8 +1,8 @@
 Package: phylobase
 Type: Package
 Title: Base package for phylogenetic structures and comparative data
-Version: 0.6.2
-Date: 2010-08-06
+Version: 0.6.3
+Date: 2011-02-24
 Depends: methods, grid, ape(>= 2.1), Rcpp (>= 0.8.3)
 LinkingTo: Rcpp
 Suggests: adephylo, MASS, RUnit

Modified: pkg/NEWS
===================================================================
--- pkg/NEWS	2011-02-10 23:00:55 UTC (rev 826)
+++ pkg/NEWS	2011-02-24 16:01:19 UTC (rev 827)
@@ -7,6 +7,14 @@
         *                                               *
         *************************************************
 
+                CHANGES IN phylobase VERSION 0.6.3
+
+   *   Fixed bugs in getNode in cases where labels included regexpr
+       metacharacters and when a tip was labelled 0
+
+   *   New methods: depthTips, nodeDepth and isUltrametric
+
+
                 CHANGES IN phylobase VERSION 0.6.2
 
    *   Improve handling of errors returned by NCL (NxsException)

Modified: pkg/R/treewalk.R
===================================================================
--- pkg/R/treewalk.R	2011-02-10 23:00:55 UTC (rev 826)
+++ pkg/R/treewalk.R	2011-02-24 16:01:19 UTC (rev 827)
@@ -17,10 +17,20 @@
         node <- nodeId(x, type)
     }
 
+    if (length(node) == 0) {
+      rval <- integer(0)
+      names(rval) <- character(0)
+      return(rval)
+    }
+
     ## match node to tree
-    if (is.character(node)) {       
+    if (is.character(node)) {
         ndTmp <- paste("^\\Q", node, "\\E$", sep="")
-        irval <- lapply(ndTmp, function(ND) grep(ND, labels(x, type), perl=TRUE))
+        irval <- lapply(ndTmp, function(ND) {
+          xx <- grep(ND, labels(x, type), perl=TRUE)
+          if (length(xx) == 0) 0
+          else xx
+        })                                
         irval <- unlist(irval)
     } else if (is.numeric(node) && all(floor(node) == node, na.rm=TRUE)) {
         irval <- match(as.character(node), names(labels(x, type)))
@@ -31,7 +41,11 @@
     ## node numbers
     rval <- names(labels(x, type))[irval]
 
-    rval[node == 0]   <- NA # root ancestor gets special treatment
+    ## root ancestor gets special treatment
+    isRoot <- ifelse(length(node) > 0,
+                     sapply(node, function(nd) identical(nd, 0)),
+                     logical(0))
+    rval[isRoot] <- NA
     rval[is.na(node)] <- NA # return NA for any NA_character_ inputs
     rval <- as.integer(rval)