[Phylobase-commits] r458 - in pkg: inst inst/unitTests tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 13 19:58:36 CEST 2009
Author: regetz
Date: 2009-08-13 19:58:35 +0200 (Thu, 13 Aug 2009)
New Revision: 458
Added:
pkg/inst/unitTests/
pkg/inst/unitTests/Makefile
pkg/inst/unitTests/runit.methods-phylo4.R
pkg/inst/unitTests/runit.phylo.R
pkg/inst/unitTests/runit.setAs.R
pkg/inst/unitTests/runit.subset.R
pkg/inst/unitTests/runit.treestruc.R
pkg/inst/unitTests/runit.treewalk.R
pkg/tests/doRUnit.R
Log:
added infrastructure for RUnit tests (Makefile and doRUnit.R script),
plus a handful of actual tests
Added: pkg/inst/unitTests/Makefile
===================================================================
--- pkg/inst/unitTests/Makefile (rev 0)
+++ pkg/inst/unitTests/Makefile 2009-08-13 17:58:35 UTC (rev 458)
@@ -0,0 +1,15 @@
+TOP=../..
+PKG=${shell cd ${TOP};pwd}
+SUITE=doRUnit.R
+R=R
+
+all: inst test
+
+inst: # Install package
+ cd ${TOP}/..;\
+ ${R} CMD INSTALL ${PKG}
+
+test: # Run unit tests
+ export RCMDCHECK=FALSE;\
+ cd ${TOP}/tests;\
+ ${R} --vanilla --slave < ${SUITE}
Property changes on: pkg/inst/unitTests/Makefile
___________________________________________________________________
Name: svn:eol-style
+ native
Added: pkg/inst/unitTests/runit.methods-phylo4.R
===================================================================
--- pkg/inst/unitTests/runit.methods-phylo4.R (rev 0)
+++ pkg/inst/unitTests/runit.methods-phylo4.R 2009-08-13 17:58:35 UTC (rev 458)
@@ -0,0 +1,23 @@
+#
+# --- Test phylo4 methods ---
+#
+
+# 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;")
+phy <- as(tr, "phylo4")
+## label node ancestr edge.length node.type
+## 6 <NA> 6 NA 0.40 root
+## 7 <NA> 7 6 0.20 internal
+## 8 <NA> 8 7 0.50 internal
+## 9 <NA> 9 8 0.15 internal
+## 1 spA 1 8 0.20 tip
+## 2 spB 2 9 0.10 tip
+## 3 spC 3 9 0.10 tip
+## 4 spD 4 7 0.70 tip
+## 5 spE 5 6 1.00 tip
+
+test.edgeLength <- function() {
+ ans <- c(`8-1`=0.2)
+ checkEquals(edgeLength(phy, "spA"), ans)
+}
+
Property changes on: pkg/inst/unitTests/runit.methods-phylo4.R
___________________________________________________________________
Name: svn:eol-style
+ native
Added: pkg/inst/unitTests/runit.phylo.R
===================================================================
--- pkg/inst/unitTests/runit.phylo.R (rev 0)
+++ pkg/inst/unitTests/runit.phylo.R 2009-08-13 17:58:35 UTC (rev 458)
@@ -0,0 +1,61 @@
+#
+# --- Test ape import and handling ---
+#
+
+# 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.import.with.valid.node.labels <- function() {
+
+ 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))
+ checkEqualsNumeric(tmp at node.label, as.character(1:4))
+ checkEquals(nrow(tdata(tmp)), 0)
+
+}
+
+test.phylo.import.with.numeric.node.labels <- function() {
+
+ tr$node.label <- 1:4
+
+ # can't keep invalid node labels
+ checkException(phylo4(tr))
+ checkException(phylo4(tr, check.node.labels="keep"))
+ checkException(phylo4d(tr))
+ checkException(phylo4d(tr, check.node.labels="keep"))
+
+ # import to phylo4, dropping node labels
+ tmp <- phylo4(tr, check.node.labels="drop")
+ checkEquals(length(tmp at node.label), 0)
+
+ # import to phylo4d, dropping node labels
+ tmp <- phylo4d(tr, check.node.labels="drop")
+ checkEquals(length(tmp at node.label), 0)
+ checkEquals(nrow(tdata(tmp)), 0)
+
+ # import to phylo4d, converting node labels to data
+ tmp <- phylo4d(tr, check.node.labels="asdata")
+ checkEquals(tdata(tmp, "internal", label.type="column")$labelValues,
+ 1:4)
+ checkEquals(length(tmp at node.label), 0)
+}
+
+test.phylo.import.2tips <- function() {
+ tr2 <- drop.tip(tr, 3:Ntip(tr))
+ phy2 <- as(tr2, "phylo4")
+ checkEquals(nTips(as(tr2, "phylo4")), 2)
+ checkEquals(nNodes(as(tr2, "phylo4")), 1)
+}
+
Property changes on: pkg/inst/unitTests/runit.phylo.R
___________________________________________________________________
Name: svn:eol-style
+ native
Added: pkg/inst/unitTests/runit.setAs.R
===================================================================
--- pkg/inst/unitTests/runit.setAs.R (rev 0)
+++ pkg/inst/unitTests/runit.setAs.R 2009-08-13 17:58:35 UTC (rev 458)
@@ -0,0 +1,31 @@
+#
+# --- Test setAs methods ---
+#
+
+# 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;")
+phy <- as(tr, "phylo4")
+
+test.phylo4.As.data.frame <- function() {
+
+ # rooted tree
+ checkTrue(is.data.frame(as(phy, "data.frame")))
+ phy.df <- structure(list(label = c(NA, NA, NA, NA, "spA", "spB",
+ "spC", "spD", "spE"), node = c(6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L,
+ 5L), ancestr = c(NA, 6L, 7L, 8L, 8L, 9L, 9L, 7L, 6L),
+ edge.length = c(0.4, 0.2, 0.5, 0.15, 0.2, 0.1, 0.1, 0.7, 1),
+ node.type = structure(c(2L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L),
+ .Label = c("internal", "root", "tip"), class = "factor")),
+ .Names = c("label", "node", "ancestr", "edge.length",
+ "node.type"), row.names = c(6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L),
+ class = "data.frame")
+ checkEquals(as(phy, "data.frame"), phy.df)
+
+ # unrooted tree
+ tru <- unroot(tr)
+ phyu <- as(tru, "phylo4")
+ # should probably check that this coercion results in something
+ # *correct*, not just that it produces a data.frame
+ checkTrue(is.data.frame(as(phyu, "data.frame")))
+
+}
Property changes on: pkg/inst/unitTests/runit.setAs.R
___________________________________________________________________
Name: svn:eol-style
+ native
Added: pkg/inst/unitTests/runit.subset.R
===================================================================
--- pkg/inst/unitTests/runit.subset.R (rev 0)
+++ pkg/inst/unitTests/runit.subset.R 2009-08-13 17:58:35 UTC (rev 458)
@@ -0,0 +1,27 @@
+#
+# --- Test subset methods ---
+#
+
+# 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.subset.phylo <- function() {
+ print(subset(tr, 1:4))
+ print(subset(tr, 1:2))
+}
+
+test.subset.phylo4 <- function() {
+ phy <- as(tr, "phylo4")
+ print(subset(phy, 1:4))
+ print(subset(phy, 1:2))
+}
+
+test.subset.phylo4d <- function() {
+ phyd <- as(tr, "phylo4d")
+ 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))
+}
+
Property changes on: pkg/inst/unitTests/runit.subset.R
___________________________________________________________________
Name: svn:eol-style
+ native
Added: pkg/inst/unitTests/runit.treestruc.R
===================================================================
--- pkg/inst/unitTests/runit.treestruc.R (rev 0)
+++ pkg/inst/unitTests/runit.treestruc.R 2009-08-13 17:58:35 UTC (rev 458)
@@ -0,0 +1,15 @@
+#
+# --- Test treestruc functions ---
+#
+
+test.hasPoly <- function() {
+ # construct simple polytomy
+ owls <- read.tree(text =
+ "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);")
+ owls$edge <- matrix(c(4,4,4,1,2,3), ncol=2)
+ owls$Nnode <- 1
+ owls$edge.length <- owls$edge.length[-4]
+ tr <- as(owls, "phylo4")
+ checkTrue(hasPoly(tr))
+}
+
Property changes on: pkg/inst/unitTests/runit.treestruc.R
___________________________________________________________________
Name: svn:eol-style
+ native
Added: pkg/inst/unitTests/runit.treewalk.R
===================================================================
--- pkg/inst/unitTests/runit.treewalk.R (rev 0)
+++ pkg/inst/unitTests/runit.treewalk.R 2009-08-13 17:58:35 UTC (rev 458)
@@ -0,0 +1,64 @@
+#
+# --- Test treewalk functions ---
+#
+
+# Note: we're not explicitly testing missing="warn" condition below;
+# however, if "OK" and "fail" both work as expected, then so must "warn"
+
+# Create sample phylo4 tree for testing
+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;")
+phy <- as(tr, "phylo4")
+
+test.getNode.valid.character <- function() {
+ # node only has valid characters
+ checkEquals(getNode(phy, "spA"), c(spA=1))
+ checkEquals(getNode(phy, c("spA", "spC")), c(spA=1, spC=3))
+}
+
+test.getNode.valid.integer <- function() {
+ # node only has valid integers
+ ans <- 4
+ names(ans) <- "spD"
+ checkEquals(getNode(phy, 4), ans)
+ ans <- c(4,6)
+ names(ans) <- c("spD", NA)
+ checkEquals(getNode(phy, c(4,6)), ans)
+}
+
+test.getNode.missing.character <- function() {
+ # node includes only missing characters (names), but missing=OK
+ ans <- rep(NA_integer_, 2) # return values should be NA
+ names(ans) <- c("xxx", "yyy")
+ checkEquals(getNode(phy, c("xxx", "yyy"), missing="OK"), ans)
+ # now missing = "fail"
+ checkException(getNode(phy, c("xxx", "yyy"), missing="fail"))
+}
+
+test.getNode.missing.integer <- function() {
+ # node includes only missing numbers (IDs), but missing=OK
+ ans <- rep(NA_integer_, 3) # return values should be NA
+ names(ans) <- rep(NA, 3)
+ checkEquals(getNode(phy, c(-9, 0, 50), missing="OK"), ans)
+ # now missing = "fail"
+ checkException(getNode(phy, c(-9, 0, 50), missing="fail"), ans)
+}
+
+test.getNode.NAs <- function() {
+ # node includes NAs, but missing = "OK"
+ checkTrue(is.na(getNode(phy, NA_integer_, missing="OK")))
+ checkTrue(is.na(getNode(phy, NA_character_, missing="OK")))
+}
+
+test.getNode.mixed.cases <- function() {
+ # node includes mixture of valid values and NAs
+ ans <- c(2, NA)
+ names(ans) <- c("spB", NA)
+ checkEquals(getNode(phy, c("spB", NA), missing="OK"), ans)
+ checkEquals(getNode(phy, c(2, NA), missing="OK"), ans)
+}
+
+test.getNode.invalid.nodes <- function() {
+ # node is neither integer-like nor character
+ checkException(getNode(phy, 1.5))
+}
+
Property changes on: pkg/inst/unitTests/runit.treewalk.R
___________________________________________________________________
Name: svn:eol-style
+ native
Added: pkg/tests/doRUnit.R
===================================================================
--- pkg/tests/doRUnit.R (rev 0)
+++ pkg/tests/doRUnit.R 2009-08-13 17:58:35 UTC (rev 458)
@@ -0,0 +1,62 @@
+## RUnit script obtained from:
+## http://wiki.r-project.org/rwiki/doku.php?id=developers:runit
+
+## unit tests will not be done if RUnit is not available
+if(require("RUnit", quietly=TRUE)) {
+
+ ## --- Setup ---
+
+ pkg <- "phylobase"
+ if(Sys.getenv("RCMDCHECK") == "FALSE") {
+ ## Path to unit tests for standalone running under Makefile (not R CMD check)
+ ## PKG/tests/../inst/unitTests
+ path <- file.path(getwd(), "..", "inst", "unitTests")
+ } else {
+ ## Path to unit tests for R CMD check
+ ## PKG.Rcheck/tests/../PKG/unitTests
+ path <- system.file(package=pkg, "unitTests")
+ }
+ cat("\nRunning unit tests\n")
+ print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path))
+
+ library(package=pkg, character.only=TRUE)
+
+ ## If desired, load the name space to allow testing of private functions
+ ## if (is.element(pkg, loadedNamespaces()))
+ ## attach(loadNamespace(pkg), name=paste("namespace", pkg, sep=":"), pos=3)
+ ##
+ ## or simply call PKG:::myPrivateFunction() in tests
+
+ ## --- Testing ---
+
+ ## Define tests
+ testSuite <- defineTestSuite(name=paste(pkg, "unit testing"),
+ dirs=path)
+ ## Run
+ tests <- runTestSuite(testSuite)
+
+ ## Default report name
+ pathReport <- file.path(path, "report")
+
+ ## Report to stdout and text files
+ cat("------------------- UNIT TEST SUMMARY ---------------------\n\n")
+ printTextProtocol(tests, showDetails=FALSE)
+ printTextProtocol(tests, showDetails=FALSE,
+ fileName=paste(pathReport, "Summary.txt", sep=""))
+ printTextProtocol(tests, showDetails=TRUE,
+ fileName=paste(pathReport, ".txt", sep=""))
+
+ ## Report to HTML file
+ printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep=""))
+
+ ## Return stop() to cause R CMD check stop in case of
+ ## - failures i.e. FALSE to unit tests or
+ ## - errors i.e. R errors
+ tmp <- getErrors(tests)
+ if(tmp$nFail > 0 | tmp$nErr > 0) {
+ stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail,
+ ", #R errors: ", tmp$nErr, ")\n\n", sep=""))
+ }
+} else {
+ warning("cannot run unit tests -- package RUnit is not available")
+}
Property changes on: pkg/tests/doRUnit.R
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the Phylobase-commits
mailing list