[Phylobase-commits] r577 - pkg/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 24 08:40:10 CEST 2009
Author: regetz
Date: 2009-08-24 08:40:09 +0200 (Mon, 24 Aug 2009)
New Revision: 577
Modified:
pkg/inst/unitTests/runit.prune.R
pkg/inst/unitTests/runit.subset.R
Log:
added and cleaned up subset and prune unit tests
Modified: pkg/inst/unitTests/runit.prune.R
===================================================================
--- pkg/inst/unitTests/runit.prune.R 2009-08-24 03:37:01 UTC (rev 576)
+++ pkg/inst/unitTests/runit.prune.R 2009-08-24 06:40:09 UTC (rev 577)
@@ -2,16 +2,22 @@
# --- Test prune.R ---
#
+data(geospiza)
+gtree <- extractTree(geospiza)
+
+
test.DropTip <- function() {
# function(phy, tip, ...)
}
test.prune.phylo4 <- function() {
# function(phy, tip, trim.internal = TRUE, subtree = FALSE, ...)
+ checkEquals(gtree, prune(gtree, character(0)))
}
test.prune.phylo4d <- function() {
# function(phy, tip, trim.internal = TRUE, subtree = FALSE, ...)
+ checkEquals(geospiza, prune(geospiza, character(0)))
}
test.prune.phylo <- function() {
Modified: pkg/inst/unitTests/runit.subset.R
===================================================================
--- pkg/inst/unitTests/runit.subset.R 2009-08-24 03:37:01 UTC (rev 576)
+++ pkg/inst/unitTests/runit.subset.R 2009-08-24 06:40:09 UTC (rev 577)
@@ -3,47 +3,95 @@
#
# 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;")
+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);")
test.subset.phylo <- function() {
- print(subset(tr, 1:4))
- print(subset(tr, 1:2))
+ # subset 2 tips
+ checkEquals(tr.sub2, subset(tr, tips.include=c(2, 5)))
+ checkEquals(tr.sub2, subset(tr, tips.exclude=c(1, 3, 4)))
+ checkEquals(tr.sub2, subset(tr, tips.include=c("t2", "t5")))
+ checkEquals(tr.sub2, subset(tr, tips.exclude=c("t1", "t3", "t4")))
+ # subset 4 tips
+ checkEquals(tr.sub4, subset(tr, tips.include=c(1, 2, 4, 5)))
+ checkEquals(tr.sub4, subset(tr, tips.exclude=3))
+ checkEquals(tr.sub4, subset(tr, tips.include=c("t1", "t2", "t4",
+ "t5")))
+ checkEquals(tr.sub4, subset(tr, tips.exclude="t3"))
+ # check variants that should all return the original object
checkEquals(tr, subset(tr))
+ # error if only one valid tip requested
+ checkException(subset(tr, tips.include="t1"))
+ checkException(subset(tr, tips.include=c("t1", "t999")))
+ # error if zero valid tips requested
+ checkException(subset(tr, tips.include="t999"))
}
test.subset.phylo4 <- function() {
- phy <- as(tr, "phylo4")
- print(subset(phy, 1:4))
- print(subset(phy, 1:2))
+ DEACTIVATED("Broken?: subset changes phy order from 'unknown' to 'preorder'")
+ phy <- phylo4(tr)
+ phy.sub2 <- phylo4(tr.sub2)
+ phy.sub4 <- phylo4(tr.sub4)
+ # 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")))
+ # 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"))
# 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))])
- checkException(subset(phy,"spA"))
- checkException(subset(phy,c("spA","spZ")))
- checkException(subset(phy,c("spZ")))
+ # error if only one valid tip requested
+ checkException(subset(phy, tip.include="t1"))
+ checkException(subset(phy, tip.include=c("t1", "t999")))
+ # error if zero valid tips requested
+ checkException(subset(phy, tip.include="t999"))
+ # error if more than one subset criteria are supplied
+ checkException(subset(phyd, tips.include="t1", tips.exclude="t3"))
}
test.subset.phylo4d <- function() {
- phyd <- as(tr, "phylo4d")
- tdata(phyd) <- 1:5
- print(subset(phyd, 1:4))
- print(subset(phyd, 1:2))
+ phyd <- phylo4d(tr, data.frame(x=1:5, row.names=paste("t", 1:5, sep="")))
+ phyd.sub2 <- phylo4d(tr.sub2, data.frame(x=c(2,5),
+ row.names=paste("t", c(2,5), sep="")))
+ phyd.sub4 <- phylo4d(tr.sub4, data.frame(x=c(1,2,4,5),
+ row.names=paste("t", c(1,2,4,5), sep="")))
+ # 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")))
+ # 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"))
# 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))])
- set.seed(1)
- z1 = rcoal(5)
- zdat = data.frame(1:4)
- rownames(zdat) <- paste("t",1:4,sep="")
- z2 = phylo4d(z1,zdat,missing="OK")
- subset(z2,tips.exclude="t1")
- subset(z2,tips.include=c("t4","t5"))
+ # error if only one valid tip requested
+ checkException(subset(phyd, tips.include="t1"))
+ checkException(subset(phyd, tips.include=c("t1", "t999")))
+ # error if zero valid tips requested
+ checkException(subset(phyd, 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")))
}
test.extractTree <- function() {
More information about the Phylobase-commits
mailing list