[Phylobase-commits] r592 - pkg/inst/unitTests

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

Author: regetz
Date: 2009-08-26 02:49:12 +0200 (Wed, 26 Aug 2009)
New Revision: 592

Modified:
   pkg/inst/unitTests/runit.prune.R
   pkg/inst/unitTests/runit.setAs-Methods.R
   pkg/inst/unitTests/runit.subset.R
Log:
updated tests of coercion and tree extraction


Modified: pkg/inst/unitTests/runit.prune.R
===================================================================
--- pkg/inst/unitTests/runit.prune.R	2009-08-26 00:37:50 UTC (rev 591)
+++ pkg/inst/unitTests/runit.prune.R	2009-08-26 00:49:12 UTC (rev 592)
@@ -12,12 +12,11 @@
 
 test.prune.phylo4 <- function() {
     # function(phy, tip, trim.internal = TRUE, subtree = FALSE, ...)
-    checkEquals(gtree, prune(gtree, character(0)))
+    checkIdentical(gtree, prune(gtree, character(0)))
 }
 
 test.prune.phylo4d <- function() {
     # function(phy, tip, trim.internal = TRUE, subtree = FALSE, ...)
-    ## checkEquals(geospiza, prune(geospiza, character(0))) ## FAILS??
     checkIdentical(geospiza, prune(geospiza, character(0)))
 }
 

Modified: pkg/inst/unitTests/runit.setAs-Methods.R
===================================================================
--- pkg/inst/unitTests/runit.setAs-Methods.R	2009-08-26 00:37:50 UTC (rev 591)
+++ pkg/inst/unitTests/runit.setAs-Methods.R	2009-08-26 00:49:12 UTC (rev 592)
@@ -7,9 +7,11 @@
 phy <- as(tr, "phylo4")
 
 test.phylo.As.phylo4 <- function() {
+  checkIdentical(as(tr, "phylo4"), phylo4(tr))
 }
 
 test.phylo.As.phylo4d <- function() {
+  checkIdentical(as(tr, "phylo4d"), phylo4d(tr))
 }
 
 test.multiPhylo.As.multiPhylo4 <- function() {
@@ -19,8 +21,57 @@
 }
 
 test.phylo4.As.phylo <- function() {
+# note: checkEquals("phylo") uses all.equal.phylo()
+
+  # phylo tree in unknown order
+  phy <- as(tr, "phylo4")
+  checkEquals(as(phy, "phylo"), tr)
+  # ...now check for warning for unknown order
+  opt <- options(warn=3)
+  checkException(as(phy, "phylo"))
+  options(opt)
+
+  # phylo tree in cladewise order
+  tr.cladewise <- reorder(tr, "cladewise")
+  phy <- as(tr.cladewise, "phylo4")
+  checkEquals(as(phy, "phylo"), tr.cladewise)
+
+  # phylo tree in pruningwise order
+  tr.pruningwise <- reorder(tr, "pruningwise")
+  phy <- as(tr.pruningwise, "phylo4")
+  checkEquals(as(phy, "phylo"), tr.pruningwise)
 }
 
+# this coerce method is defined implicitly
+test.phylo4d.As.phylo <- function() {
+# note: checkEquals("phylo") uses all.equal.phylo()
+
+  # phylo tree in unknown order
+  phyd <- as(tr, "phylo4d")
+  tdata(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+  checkEquals(as(phyd, "phylo"), tr)
+  # ...now check for warning for unknown order
+  opt <- options(warn=3)
+  checkException(as(phyd, "phylo"))
+  options(opt)
+
+  # phylo tree in cladewise order
+  tr.cladewise <- reorder(tr, "cladewise")
+  phyd <- as(tr.cladewise, "phylo4d")
+  tdata(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+  checkEquals(as(phyd, "phylo"), tr.cladewise)
+  # ...now check for warning for dropping data
+  opt <- options(warn=3)
+  checkException(as(phyd, "phylo"))
+  options(opt)
+
+  # phylo tree in pruningwise order
+  tr.pruningwise <- reorder(tr, "pruningwise")
+  phyd <- as(tr.pruningwise, "phylo4d")
+  tdata(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+  checkEquals(as(phyd, "phylo"), tr.pruningwise)
+}
+
 test.phylo4.As.phylog <- function() {
 }
 

Modified: pkg/inst/unitTests/runit.subset.R
===================================================================
--- pkg/inst/unitTests/runit.subset.R	2009-08-26 00:37:50 UTC (rev 591)
+++ pkg/inst/unitTests/runit.subset.R	2009-08-26 00:49:12 UTC (rev 592)
@@ -99,7 +99,12 @@
 }
 
 test.extractTree <- function() {
-    phyd <- as(tr, "phylo4d")
-    phy <- as(tr, "phylo4")
-    checkEquals(phy, extractTree(phyd))
+    # extract phylo4 from itself
+    phy <- phylo4(tr, annote=list(x="annotation"))
+    checkIdentical(phy, extractTree(phy))
+
+    # extract phylo4 from phylo4d
+    phyd <- phylo4d(tr, tip.data= data.frame(x=1:5, row.names=tr$tip.label),
+      annote=list(x="annotation"), metadata=list(x="metadata"))
+    checkIdentical(phy, extractTree(phyd))
 }