[Phylobase-commits] r656 - in pkg: inst/unitTests tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 22 09:18:09 CEST 2009
Author: regetz
Date: 2009-09-22 09:18:09 +0200 (Tue, 22 Sep 2009)
New Revision: 656
Removed:
pkg/tests/trees.RData
Modified:
pkg/inst/unitTests/runit.subset.R
Log:
revised subset unit tests to use code-based test objects, rather than
loading objects from an annoying-to-maintain binary save file
Modified: pkg/inst/unitTests/runit.subset.R
===================================================================
--- pkg/inst/unitTests/runit.subset.R 2009-09-22 06:06:23 UTC (rev 655)
+++ pkg/inst/unitTests/runit.subset.R 2009-09-22 07:18:09 UTC (rev 656)
@@ -2,31 +2,70 @@
# --- Test subset.R ---
#
-# load test comparison objects
-load("trees.RData")
-
-# Create sample tree for testing (ape::phylo object)
-tr <- read.tree(text="(((t1:0.2,(t2:0.1,t3:0.1):0.15):0.5,t4:0.7):0.2,t5:1):0.4;")
-tr.sub2 <- read.tree(text="(t2:0.95,t5:1);")
-tr.sub4 <- read.tree(text="(((t1:0.2,t2:0.25):0.5,t4:0.7):0.2,t5:1);")
+# create phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,NA,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+# create altered version such that each slot is out of order with
+# respect to all others; methods should be able to handle this
+phy.alt <- phy
+phy.alt at tip.label <- rev(phy at tip.label)
+phy.alt at node.label <- rev(phy at node.label)
+phy.alt at edge <- phy at edge[c(6:9, 1:5), ]
+phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)]
+phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)]
+
+# now create phylo4d by adding data (with node IDs as row.names)
+phyd.alt <- as(phy.alt, "phylo4d")
+allDt <- data.frame(a=letters[nid.all], b=10*nid.all, row.names=nid.all)
+tdata(phyd.alt, "all") <- allDt
+
+# create altered version such that data slots are out of order with
+# respect to all others; methods should be able to handle this
+nid.tip.r <- c(2,5,4,3,1)
+nid.int.r <- c(8,7,9,6)
+nid.all.r <- c(nid.tip.r, nid.int.r)
+phyd.alt at tip.data <- phyd.alt at tip.data[rank(nid.tip.r), ]
+phyd.alt at node.data <- phyd.alt at node.data[rank(nid.int.r), ]
+
+#-----------------------------------------------------------------------
+
+## Also be testing "[" phylo4 methods here
test.subset.phylo4 <- function() {
# subset 2 tips
- checkEquals(phy.sub2, subset(phy, tips.include=c(2, 5)))
- checkEquals(phy.sub2, subset(phy, tips.exclude=c(1, 3, 4)))
- checkEquals(phy.sub2, subset(phy, tips.include=c("t2", "t5")))
- checkEquals(phy.sub2, subset(phy, tips.exclude=c("t1", "t3", "t4")))
+ phy.sub2 <- subset(phy.alt, tips.include=c(2, 5))
+ checkEquals(tipLabels(phy.sub2), c("t2", "t5"), checkNames=FALSE)
+ checkEquals(nodeLabels(phy.sub2), c("n6"), checkNames=FALSE)
+ checkEquals(edgeLength(phy.sub2), c(0.6, 0.9, 2.2), checkNames=FALSE)
+ checkIdentical(subset(phy.alt, tips.exclude=c(1, 3, 4)), phy.sub2)
+ checkIdentical(subset(phy.alt, tips.include=c("t2", "t5")), phy.sub2)
+ checkIdentical(subset(phy.alt, tips.exclude=c("t1", "t3", "t4")), phy.sub2)
# subset 4 tips
- checkEquals(phy.sub4, subset(phy, tips.include=c(1, 2, 4, 5)))
- checkEquals(phy.sub4, subset(phy, tips.exclude=3))
- checkEquals(phy.sub4, subset(phy, tips.include=c("t1", "t2", "t4", "t5")))
- checkEquals(phy.sub4, subset(phy, tips.exclude="t3"))
+ phy.sub4 <- subset(phy.alt, tips.include=c(1, 2, 4, 5))
+ checkEquals(tipLabels(phy.sub4), c("t1", "t2", "t4", "t5"), checkNames=FALSE)
+ checkEquals(nodeLabels(phy.sub4), c("n6", "n7", "n9"), checkNames=FALSE)
+ checkEquals(edgeLength(phy.sub4), c(0.6, 0.4, 0.5, 0.7, 0.1, 0.2, 1.7),
+ checkNames=FALSE)
+ checkIdentical(subset(phy.alt, tips.exclude=3), phy.sub4)
+ checkIdentical(subset(phy.alt, tips.include=c("t1", "t2", "t4", "t5")), phy.sub4)
+ checkIdentical(subset(phy.alt, tips.exclude="t3"), phy.sub4)
# 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))])
+ checkIdentical(phy.alt, subset(phy.alt))
+ checkIdentical(phy.alt, subset(phy.alt, tipLabels(phy.alt)))
+ checkIdentical(phy.alt, subset(phy.alt, seq_len(nTips(phy.alt))))
+ checkIdentical(phy.alt, phy.alt[tipLabels(phy.alt)])
+ checkIdentical(phy.alt, phy.alt[seq_len(nTips(phy.alt))])
+ checkIdentical(phy.alt, phy.alt[TRUE])
# error if only one valid tip requested
checkException(subset(phy, tips.include="t1"))
checkException(subset(phy, tips.include=c("t1", "t999")))
@@ -36,44 +75,50 @@
checkException(subset(phyd, tips.include="t1", tips.exclude="t3"))
}
+## Also testing "[" phylo4d methods here
+##TODO get rid of some tests that are pretty much redundant with the
+##above, and add tests focused more on tree data
test.subset.phylo4d <- function() {
# subset 2 tips
- checkEquals(phyd.sub2, subset(phyd, tips.include=c(2, 5)))
- checkEquals(phyd.sub2, subset(phyd, tips.exclude=c(1, 3, 4)))
- checkEquals(phyd.sub2, subset(phyd, tips.include=c("t2", "t5")))
- checkEquals(phyd.sub2, subset(phyd, tips.exclude=c("t1", "t3", "t4")))
+ phyd.sub2 <- subset(phyd.alt, tips.include=c(2, 5))
+ checkEquals(tipLabels(phyd.sub2), c("t2", "t5"), checkNames=FALSE)
+ checkEquals(nodeLabels(phyd.sub2), c("n6"), checkNames=FALSE)
+ checkEquals(edgeLength(phyd.sub2), c(0.6, 0.9, 2.2), checkNames=FALSE)
+ checkIdentical(subset(phyd.alt, tips.exclude=c(1, 3, 4)), phyd.sub2)
+ checkIdentical(subset(phyd.alt, tips.include=c("t2", "t5")), phyd.sub2)
+ checkIdentical(subset(phyd.alt, tips.exclude=c("t1", "t3", "t4")), phyd.sub2)
# subset 4 tips
- checkEquals(phyd.sub4, subset(phyd, tips.include=c(1, 2, 4, 5)))
- checkEquals(phyd.sub4, subset(phyd, tips.exclude=3))
- checkEquals(phyd.sub4, subset(phyd, tips.include=c("t1", "t2", "t4", "t5")))
- checkEquals(phyd.sub4, subset(phyd, tips.exclude="t3"))
+ phyd.sub4 <- subset(phyd.alt, tips.include=c(1, 2, 4, 5))
+ checkEquals(tipLabels(phyd.sub4), c("t1", "t2", "t4", "t5"), checkNames=FALSE)
+ checkEquals(nodeLabels(phyd.sub4), c("n6", "n7", "n9"), checkNames=FALSE)
+ checkEquals(edgeLength(phyd.sub4), c(0.6, 0.4, 0.5, 0.7, 0.1, 0.2, 1.7),
+ checkNames=FALSE)
+ checkIdentical(subset(phyd.alt, tips.exclude=3), phyd.sub4)
+ checkIdentical(subset(phyd.alt, tips.include=c("t1", "t2", "t4", "t5")), phyd.sub4)
+ checkIdentical(subset(phyd.alt, tips.exclude="t3"), phyd.sub4)
# check variants that should all return the original object
- checkEquals(phyd, subset(phyd))
- 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))])
+ checkIdentical(phyd.alt, subset(phyd.alt))
+ checkIdentical(phyd.alt, subset(phyd.alt, tipLabels(phyd.alt)))
+ checkIdentical(phyd.alt, subset(phyd.alt, seq_len(nTips(phyd.alt))))
+ checkIdentical(phyd.alt, phyd.alt[tipLabels(phyd.alt)])
+ checkIdentical(phyd.alt, phyd.alt[seq_len(nTips(phyd.alt))])
+ checkIdentical(phyd.alt, phyd.alt[TRUE])
# error if only one valid tip requested
- checkException(subset(phyd, tips.include="t1"))
- checkException(subset(phyd, tips.include=c("t1", "t999")))
+ checkException(subset(phyd.alt, tips.include="t1"))
+ checkException(subset(phyd.alt, tips.include=c("t1", "t999")))
# error if zero valid tips requested
- checkException(subset(phyd, tips.include="t999"))
+ checkException(subset(phyd.alt, tips.include="t999"))
# subset tips that include an NA value
- tdata(phyd)["t5", "x"] <- NA
- tdata(phyd.sub2)["t5", "x"] <- NA
- checkEquals(phyd.sub2, subset(phyd, tips.include=c(2, 5)))
- checkEquals(phyd.sub2, subset(phyd, tips.exclude=c(1, 3, 4)))
- checkEquals(phyd.sub2, subset(phyd, tips.include=c("t2", "t5")))
- checkEquals(phyd.sub2, subset(phyd, tips.exclude=c("t1", "t3", "t4")))
+#TODO uncomment this after tdata is working right with scrambled order
+# tdata(phyd.alt)["t5", "a"] <- NA
+# tdata(phyd.sub2)["t5", "a"] <- NA
+# checkEquals(phyd.sub2, subset(phyd.alt, tips.include=c(2, 5)))
}
test.extractTree <- function() {
# extract phylo4 from itself
- phy <- phylo4(tr, annote=list(x="annotation"))
- checkIdentical(phy, extractTree(phy))
+ checkIdentical(phy.alt, extractTree(phy.alt))
# 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))
+ checkIdentical(phy.alt, extractTree(phyd.alt))
}
Deleted: pkg/tests/trees.RData
===================================================================
(Binary files differ)
More information about the Phylobase-commits
mailing list