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

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

Author: regetz
Date: 2009-08-19 09:13:42 +0200 (Wed, 19 Aug 2009)
New Revision: 502

Modified:
   pkg/inst/unitTests/runit.phylo.R
   pkg/inst/unitTests/runit.subset.R
Log:
added new tests for subset methods and import of phylo trees (mostly
just consistency checks)


Modified: pkg/inst/unitTests/runit.phylo.R
===================================================================
--- pkg/inst/unitTests/runit.phylo.R	2009-08-19 07:05:46 UTC (rev 501)
+++ pkg/inst/unitTests/runit.phylo.R	2009-08-19 07:13:42 UTC (rev 502)
@@ -5,15 +5,33 @@
 # Create sample tree for testing (ape::phylo object)
 tr <- read.tree(text="(((spA:0.2,(spB:0.1,spC:0.1):0.15):0.5,spD:0.7):0.2,spE:1):0.4;") 
 
-test.phylo.import.simple <- function() {
-    checkTrue(class(phylo4(tr))=="phylo4")
-    checkTrue(class(phylo4d(tr))=="phylo4d")
+test.phylo.to.phylo4.simple <- function() {
+  phy <- as(tr, "phylo4")
+  checkTrue(class(phy)=="phylo4")
+  checkEquals(phy, phylo4(tr))
 }
 
-test.phylo.import.with.valid.node.labels <- function() {
+test.phylo.to.phylo4d.simple <- function() {
+  phyd <- as(tr, "phylo4d")
+  checkTrue(class(phyd)=="phylo4d")
+  checkEquals(phyd, phylo4d(tr))
+}
 
-    tr$node.label <- as.character(1:4)
+test.roundtrip.phylo.to.phylo4 <- function() {
+  phy <- as(tr, "phylo4")
+  checkEquals(tr, as(phy, "phylo"))
+}
 
+test.roundtrip.phylo.to.phylo4d <- function() {
+  phyd <- as(tr, "phylo4d")
+  checkEquals(tr, as(phyd, "phylo"))
+}
+
+test.phylo.import.with.character.node.labels <- function() {
+
+  # case 1: unique non-numeric characters
+  tr$node.label <- paste("n", 1:4, sep="")
+
     # import to phylo4
     tmp <- phylo4(tr, check.node.labels="keep")
     checkEquals(tmp, phylo4(tr))
@@ -21,21 +39,42 @@
     # import to phylo4d
     tmp <- phylo4d(tr, check.node.labels="keep")
     checkEquals(tmp, phylo4d(tr))
-    checkEqualsNumeric(tmp at node.label, as.character(1:4))
+    checkEquals(unname(nodeLabels(tmp)), tr$node.label)
     checkEquals(nrow(tdata(tmp)), 0)
 
+  # case 2: unique number-like characters
+  tr$node.label <- as.character(1:4)
+
+    # import to phylo4
+    tmp <- phylo4(tr, check.node.labels="keep")
+    checkEquals(tmp, phylo4(tr))
+
+    # import to phylo4d
+    tmp <- phylo4d(tr, check.node.labels="keep")
+    checkEquals(tmp, phylo4d(tr))
+    checkEquals(unname(nodeLabels(tmp)), tr$node.label)
+    checkEquals(nrow(tdata(tmp)), 0)
+
+  # case 3: non-unique characters
+  tr$node.label <- rep("x", 4)
+
+    # import to phylo4
+    checkException(phylo4(tr))
+    checkException(phylo4(tr, check.node.labels="keep"))
+
+    # import to phylo4d
+    checkException(phylo4d(tr))
+    checkException(phylo4d(tr, check.node.labels="keep"))
+
 }
 
 test.phylo.import.with.numeric.node.labels <- function() {
 
     tr$node.label <- 1:4
 
-    # can't keep invalid node labels
-# TODO: remove/modify these after fm-branch merge
-#    checkException(phylo4(tr))
-#    checkException(phylo4(tr, check.node.labels="keep"))
-#    checkException(phylo4d(tr))
-#    checkException(phylo4d(tr, check.node.labels="keep"))
+    # keeping node labels should be the default
+    checkEquals(phylo4(tr), phylo4(tr, check.node.labels="keep"))
+    checkEquals(phylo4d(tr), phylo4d(tr, check.node.labels="keep"))
 
     # import to phylo4, dropping node labels
     tmp <- phylo4(tr, check.node.labels="drop")

Modified: pkg/inst/unitTests/runit.subset.R
===================================================================
--- pkg/inst/unitTests/runit.subset.R	2009-08-19 07:05:46 UTC (rev 501)
+++ pkg/inst/unitTests/runit.subset.R	2009-08-19 07:13:42 UTC (rev 502)
@@ -8,20 +8,32 @@
 test.subset.phylo <- function() {
     print(subset(tr, 1:4))
     print(subset(tr, 1:2))
+    checkEquals(tr, subset(tr))
 }
 
 test.subset.phylo4 <- function() {
     phy <- as(tr, "phylo4")
     print(subset(phy, 1:4))
     print(subset(phy, 1:2))
+    # check variants that should all return the original object
+    checkEquals(phy, subset(phy))
+    checkEquals(phy, subset(phy, tipLabels(phy)))
+    checkEquals(phy, subset(phy, seq_len(nTips(phy))))
+    checkEquals(phy, phy[tipLabels(phy)])
+    checkEquals(phy, phy[seq_len(nTips(phy))])
 }
 
 test.subset.phylo4d <- function() {
     phyd <- as(tr, "phylo4d")
+    tdata(phyd) <- 1:5
     print(subset(phyd, 1:4))
-## the following print statement currently fails, for reasons related to
-## the subtle differences between str(as(subset(tr, 1:2), "phylo4d"))
-## and str(subset(as(tr, "phylo4d"), 1:2))
-#    print(subset(phyd, 1:2))
+    print(subset(phyd, 1:2))
+    # check variants that should all return the original object
+    checkEquals(phyd, subset(phyd))
+## TODO: These should ideally work. Bug #586
+#    checkEquals(phyd, subset(phyd, tipLabels(phyd)))
+#    checkEquals(phyd, subset(phyd, seq_len(nTips(phyd))))
+    checkEquals(phyd, phyd[tipLabels(phyd)])
+    checkEquals(phyd, phyd[seq_len(nTips(phyd))])
 }