[Phylobase-commits] r632 - in pkg: R inst/unitTests

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

Author: regetz
Date: 2009-09-10 08:53:11 +0200 (Thu, 10 Sep 2009)
New Revision: 632

Modified:
   pkg/R/methods-phylo4.R
   pkg/inst/unitTests/runit.methods-phylo4.R
Log:
fixed phylo4 summary method's root edge issue (bug #646) and edge length
checking, now making better use of accessor methods; created unit test


Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R	2009-09-10 05:31:26 UTC (rev 631)
+++ pkg/R/methods-phylo4.R	2009-09-10 06:53:11 UTC (rev 632)
@@ -412,25 +412,23 @@
 
     ## build the result object
     res$name <- deparse(substitute(object, sys.frame(-1)))
-    res$nb.tips <- length(x at tip.label)
-    res$nb.nodes <- x at Nnode
+    res$nb.tips <- nTips(x)
+    res$nb.nodes <- nNodes(x)
 
-    if(!is.null(x at edge.length)){
-        res$mean.el <- mean(x at edge.length, na.rm=TRUE)
-        res$var.el <- var(x at edge.length, na.rm=TRUE)
-        if (isRooted(x) && is.na(x at edge.length[rootNode(x)])) {
-            res$sumry.el <- summary(x at edge.length[-rootNode(x)])
+    if(hasEdgeLength(x)) {
+        edge.length <- edgeLength(x)
+        res$mean.el <- mean(edge.length, na.rm=TRUE)
+        res$var.el <- var(edge.length, na.rm=TRUE)
+        if (isRooted(x) && is.na(edgeLength(x, rootNode(x)))) {
+            root.index <- match(edgeId(x, "root"), names(edge.length))
+            res$sumry.el <- summary(edge.length[-root.index])
         } else {
-            res$sumry.el <- summary(x at edge.length)
+            res$sumry.el <- summary(edge.length)
         }
-    } else {
-        res$mean.el <- NULL
-        res$var.el <- NULL
-        res$sumry.el <- NULL
     }
 
     ## check for polytomies
-    if (nrow(edges(x)) != 0 && any(tabulate(na.omit(edges(object)[,1]))>2)){ # if there are polytomies
+    if (hasPoly(x)) {
         E <- edges(x)
         temp <- tabulate(na.omit(E[,1]))
         degree <- temp[na.omit(E[,1])] # contains the degree of the ancestor for all edges
@@ -463,16 +461,16 @@
     cat(" Number of tips    :", res$nb.tips, "\n")
     cat(" Number of nodes   :", res$nb.nodes, "\n")
     ## cat("  ")
-    if(!length(x at edge.length)) {
-        cat(" Branch lengths    : No branch lengths.\n")
-    } else {
+    if(hasEdgeLength(x)) {
         cat(" Branch lengths:\n")
         cat("        mean         :", res$mean.el, "\n")
         cat("        variance     :", res$var.el, "\n")
         cat("        distribution :\n")
         print(res$sumry.el)
+    } else {
+        cat(" Branch lengths    : No branch lengths.\n")
     }
-    if(nrow(edges(x)) != 0 && hasPoly(x)){
+    if (hasPoly(x)) {
         cat("\nDegree of the nodes  :\n")
         print(res$degree)
         cat("\n")

Modified: pkg/inst/unitTests/runit.methods-phylo4.R
===================================================================
--- pkg/inst/unitTests/runit.methods-phylo4.R	2009-09-10 05:31:26 UTC (rev 631)
+++ pkg/inst/unitTests/runit.methods-phylo4.R	2009-09-10 06:53:11 UTC (rev 632)
@@ -196,7 +196,25 @@
 }
 
 test.summary.phylo4 <- function() {
- #TODO? function (object, quiet=FALSE)
+  phy.sum <- summary(phy, quiet=TRUE)
+  checkIdentical(phy.sum$name, "phy")
+  checkIdentical(phy.sum$nb.tips, length(nid.tip))
+  checkIdentical(phy.sum$nb.nodes, length(nid.int))
+  checkIdentical(phy.sum$mean.el, mean(elen))
+  checkIdentical(phy.sum$var.el, var(elen))
+  checkIdentical(phy.sum$sumry.el, summary(elen))
+  # now make root edge length NA
+  edgeLength(phy)[edgeId(phy, "root")] <- NA
+  phy.sum2 <- summary(phy, quiet=TRUE)
+  checkIdentical(phy.sum2$mean.el, mean(edgeLength(phy), na.rm=TRUE))
+  checkIdentical(phy.sum2$var.el, var(edgeLength(phy), na.rm=TRUE))
+  checkIdentical(phy.sum2$sumry.el, summary(na.omit(edgeLength(phy))))
+  # now remove edge lengths altogether
+  phy at edge.length[] <- NA
+  phy.sum3 <- summary(phy, quiet=TRUE)
+  checkTrue(is.null(phy.sum3$mean.el))
+  checkTrue(is.null(phy.sum3$var.el))
+  checkTrue(is.null(phy.sum3$sumry.el))
 }
 
 # not an exported function -- called internally by reorder("phylo4")