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

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

Author: regetz
Date: 2009-09-10 07:31:26 +0200 (Thu, 10 Sep 2009)
New Revision: 631

Modified:
   pkg/R/treestruc.R
   pkg/inst/unitTests/runit.treestruc.R
Log:
fixed treestruc functions to work with empty trees, and added unit tests
for this case; also now making better use of accessors


Modified: pkg/R/treestruc.R
===================================================================
--- pkg/R/treestruc.R	2009-09-09 15:50:58 UTC (rev 630)
+++ pkg/R/treestruc.R	2009-09-10 05:31:26 UTC (rev 631)
@@ -5,23 +5,23 @@
 ##   any(edgeLength(x)==0) if necessary
 hasPoly <- function(object) {
   if(!checkPhylo4(object)) stop("to be used with a phylo4 object")
-  degree <- tabulate(na.omit(edges(object)[, 1]))
-  struc <- any(degree > 2)
-  return(struc)
+  if (nEdges(object)==0) return(FALSE)
+  degree <- tabulate(edges(object, drop.root=TRUE)[, 1])
+  any(degree > 2)
 }
 
-
-
 hasSingle <- function(object) {
   if(!checkPhylo4(object)) stop("to be used with a phylo4 object")
-  degree <- tabulate(na.omit(edges(object)[, 1]))
+  if (nEdges(object)==0) return(FALSE)
+  degree <- tabulate(edges(object, drop.root=TRUE)[, 1])
   any(degree == 1)
 }
 
 hasRetic <- function(object) {
   if(!checkPhylo4(object)) stop("to be used with a phylo4 object")
+  if (nEdges(object)==0) return(FALSE)
   ancest <- tabulate(edges(object)[, 2])
-  any(ancest>1)
+  any(ancest > 1)
 }
 
 

Modified: pkg/inst/unitTests/runit.treestruc.R
===================================================================
--- pkg/inst/unitTests/runit.treestruc.R	2009-09-09 15:50:58 UTC (rev 630)
+++ pkg/inst/unitTests/runit.treestruc.R	2009-09-10 05:31:26 UTC (rev 631)
@@ -11,11 +11,17 @@
     owls$edge.length <- owls$edge.length[-4]
     tr <- as(owls, "phylo4")
     checkTrue(hasPoly(tr))
+    # test against empty tree
+    checkTrue(!hasPoly(new("phylo4")))
 }
 
 test.hasSingle <- function() {
+    # test against empty tree
+    checkTrue(!hasSingle(new("phylo4")))
 }
 
 test.hasRetic <- function() {
+    # test against empty tree
+    checkTrue(!hasRetic(new("phylo4")))
 }