[Phylobase-commits] r670 - in branches/edgesNAto0: R inst/unitTests

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

Author: pdc
Date: 2009-09-29 04:15:27 +0200 (Tue, 29 Sep 2009)
New Revision: 670

Modified:
   branches/edgesNAto0/R/setAs-Methods.R
   branches/edgesNAto0/R/treePlot.R
   branches/edgesNAto0/R/treewalk.R
   branches/edgesNAto0/inst/unitTests/runit.setAs-Methods.R
   branches/edgesNAto0/inst/unitTests/runit.treewalk.R
Log:
getNode should return NA for the root ancestor.  Updates, plot for new root ancestor as well as the phylo4ToData frame method.

Unit tests updated to activate all tests, and fix a typo in a function name

Modified: branches/edgesNAto0/R/setAs-Methods.R
===================================================================
--- branches/edgesNAto0/R/setAs-Methods.R	2009-09-28 05:34:04 UTC (rev 669)
+++ branches/edgesNAto0/R/setAs-Methods.R	2009-09-29 02:15:27 UTC (rev 670)
@@ -192,6 +192,9 @@
     if (edgeOrder == "pretty") {
         node <- nodeId(from, "all")
         ancestr <- ancestor(from, node)
+
+        # ancestor returns an NA, replace this w/ 0 to construct names correctly
+        ancestr[is.na(ancestr)] <- as.integer(0)
     } else {
         E <- edges(from)
         node <- E[, 2]

Modified: branches/edgesNAto0/R/treePlot.R
===================================================================
--- branches/edgesNAto0/R/treePlot.R	2009-09-28 05:34:04 UTC (rev 669)
+++ branches/edgesNAto0/R/treePlot.R	2009-09-29 02:15:27 UTC (rev 670)
@@ -216,7 +216,6 @@
     phy    <- reorder(phy, 'preorder')
     pedges <- edges(phy)
     Nedges <- nrow(pedges) ## TODO switch to the accessor once stablized
-    pedges[is.na(pedges[,1]), 1] <- -1
     Ntips  <- nTips(phy)
     tips <- pedges[, 2] <= Ntips
     if(!is.null(tip.order)) {
@@ -273,6 +272,15 @@
         }
         return(list(segs=segs, yy=yy))
     }
+    placeHolder2 <- function() {
+        for(i in rev((Ntips + 1):nEdges(phy))) {
+            cur <- pedges[, 2] == i
+            dex <- pedges[, 1] == i
+            yy[cur] <- segs$v0y[dex] <- mean(yy[dex])
+        }
+        return(list(segs=segs, yy=yy))
+    }
+
     yPos <- placeHolder()
     segs <- yPos$segs
     yy   <- yPos$yy

Modified: branches/edgesNAto0/R/treewalk.R
===================================================================
--- branches/edgesNAto0/R/treewalk.R	2009-09-28 05:34:04 UTC (rev 669)
+++ branches/edgesNAto0/R/treewalk.R	2009-09-29 02:15:27 UTC (rev 670)
@@ -27,7 +27,7 @@
     ## node numbers
     rval <- names(labels(phy, "all"))[irval]
 
-    rval[node == 0]   <- 0 # root ancestor gets special treatment
+    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)
 

Modified: branches/edgesNAto0/inst/unitTests/runit.setAs-Methods.R
===================================================================
--- branches/edgesNAto0/inst/unitTests/runit.setAs-Methods.R	2009-09-28 05:34:04 UTC (rev 669)
+++ branches/edgesNAto0/inst/unitTests/runit.setAs-Methods.R	2009-09-29 02:15:27 UTC (rev 670)
@@ -138,7 +138,7 @@
 test.phylo4.As.phylog <- function() {
 }
 
-test..phylo4ToDataFrame <- function() {
+test.phylo4ToDataFrame <- function() {
   phy.show <- phylobase:::.phylo4ToDataFrame(phy.alt, "pretty")
   checkIdentical(phy.show$label, c(lab.tip, lab.int))
   checkIdentical(phy.show$node, c(nid.tip, nid.int))

Modified: branches/edgesNAto0/inst/unitTests/runit.treewalk.R
===================================================================
--- branches/edgesNAto0/inst/unitTests/runit.treewalk.R	2009-09-28 05:34:04 UTC (rev 669)
+++ branches/edgesNAto0/inst/unitTests/runit.treewalk.R	2009-09-29 02:15:27 UTC (rev 670)
@@ -28,10 +28,6 @@
     # now missing = "fail"
     checkException(getNode(phy, c("xxx", "yyy"), missing="fail"))
 
-    DEACTIVATED('turned off getNode tests 
-    getNode(phy, c(-9, 0, 50), missing="OK")
-    now return a non-NA, because 0 is a valid node.
-    ')
     # node includes only missing numbers (IDs), but missing=OK
     ans <- rep(NA_integer_, 3)  # return values should be NA
     names(ans) <- rep(NA, 3)  # return values should have NA names