[Phylobase-commits] r873 - pkg/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Mar 17 06:27:20 CET 2014
Author: francois
Date: 2014-03-17 06:27:19 +0100 (Mon, 17 Mar 2014)
New Revision: 873
Removed:
pkg/tests/RUnit-tests.R
pkg/tests/RUnit-tests.Rout.save
Modified:
pkg/tests/misctests.R
pkg/tests/phylo4dtests.R
pkg/tests/phylosubtest.R
pkg/tests/phylotorture.R
pkg/tests/plottest.R
Log:
removed old files.
Deleted: pkg/tests/RUnit-tests.R
===================================================================
--- pkg/tests/RUnit-tests.R 2014-03-17 02:15:25 UTC (rev 872)
+++ pkg/tests/RUnit-tests.R 2014-03-17 05:27:19 UTC (rev 873)
@@ -1,7 +0,0 @@
-require(RUnit)
-## TODO -- find solution to run these tests on R-forge
-
-##testsuite <- defineTestSuite("phylobase", dirs="/home/francois/Work/R-dev/phylobase/branches/fm-branch/RUnit-tests",
-## testFileRegexp="^test", testFuncRegexp="^test")
-##testRslt <- runTestSuite(testsuite)
-##printTextProtocol(testRslt)
Deleted: pkg/tests/RUnit-tests.Rout.save
===================================================================
--- pkg/tests/RUnit-tests.Rout.save 2014-03-17 02:15:25 UTC (rev 872)
+++ pkg/tests/RUnit-tests.Rout.save 2014-03-17 05:27:19 UTC (rev 873)
@@ -1,32 +0,0 @@
-
-R version 2.12.0 (2010-10-15)
-Copyright (C) 2010 The R Foundation for Statistical Computing
-ISBN 3-900051-07-0
-Platform: x86_64-pc-linux-gnu (64-bit)
-
-R is free software and comes with ABSOLUTELY NO WARRANTY.
-You are welcome to redistribute it under certain conditions.
-Type 'license()' or 'licence()' for distribution details.
-
- Natural language support but running in an English locale
-
-R is a collaborative project with many contributors.
-Type 'contributors()' for more information and
-'citation()' on how to cite R or R packages in publications.
-
-Type 'demo()' for some demos, 'help()' for on-line help, or
-'help.start()' for an HTML browser interface to help.
-Type 'q()' to quit R.
-
-> require(RUnit)
-Loading required package: RUnit
-> ## TODO -- find solution to run these tests on R-forge
->
-> ##testsuite <- defineTestSuite("phylobase", dirs="/home/francois/Work/R-dev/phylobase/branches/fm-branch/RUnit-tests",
-> ## testFileRegexp="^test", testFuncRegexp="^test")
-> ##testRslt <- runTestSuite(testsuite)
-> ##printTextProtocol(testRslt)
->
-> proc.time()
- user system elapsed
- 0.34 0.02 0.36
Modified: pkg/tests/misctests.R
===================================================================
--- pkg/tests/misctests.R 2014-03-17 02:15:25 UTC (rev 872)
+++ pkg/tests/misctests.R 2014-03-17 05:27:19 UTC (rev 873)
@@ -1,112 +1,97 @@
-library(phylobase)
-library(ape)
-set.seed(1)
+R version 3.0.3 (2014-03-06) -- "Warm Puppy"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
-data(geospiza)
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
-## make sure geospiza is properly formatted
-if(is.character(checkval <- checkPhylo4(geospiza)))
- stop(checkval)
-
+ Natural language support but running in an English locale
-geospiza0 <-
- list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tipData(geospiza))
-## push data back into list form as in geiger
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
-t1 <- try(p1 <- phylo4d(geospiza0$geospiza.tree,geospiza0$geospiza.data))
-## Error in checkData(res, ...) :
-## Tip data names are a subset of tree tip labels.
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
-p2 <- as(geospiza0$geospiza.tree,"phylo4")
-plot(p2)
+> ## 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")
++ }
-lab1 <- tipLabels(p2)
-lab2 <- rownames(geospiza0$geospiza.data)
+Running unit tests
+$pkg
+[1] "phylobase"
-lab1[!lab1 %in% lab2] ## missing data
-lab2[!lab2 %in% lab1] ## extra data (none)
-p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="warn")
-p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="OK")
+$getwd
+[1] "/home/francois/R-dev/phylobase/pkg/tests"
-plot(p1)
-plot(p1,show.node.label=TRUE)
-## one way to deal with it:
+$pathToUnitTests
+[1] "/home/francois/.R/library/phylobase/unitTests"
-p1B <- prune(p1,tip="olivacea")
-## or ...
-p1C <- na.omit(p1)
-
-labels(p1C, "all") <- tolower(labels(p1C, "all"))
-
-## trace("prune",browser,signature="phylo4d")
-r1 <- read.tree(text="((t4:0.3210275554,(t2:0.2724586465,t3:0.2724586465):0.0485689089):0.1397952619,(t5:0.07551818331,t1:0.07551818331):0.385304634);")
-
-## trace("phylo4d", browser, signature = "phylo")
-## untrace("phylo4d", signature = "phylo")
-tipdat <- data.frame(a=1:5, row.names=r1$tip.label)
-q1 <- phylo4d(r1,tip.data=tipdat, node.data=data.frame(a=6:9), match.data=FALSE)
-q2 <- prune(q1,1)
-summary(q2)
-
-tipdat2 <- tipdat
-row.names(tipdat2)[1] <- "s1"
-t1 <- try(q1 <- phylo4d(r1,tip.data=tipdat2))
-
-plot(q2)
-plot(q2,type="cladogram")
-## plot(p2,type="dotchart",labels.nodes=nodeLabels(p2))
-## trace("plot", browser, signature = c("phylo4d","missing"))
-tipLabels(q1) <- paste("q",1:5,sep="")
-nodeLabels(q1) <- paste("n",1:4,sep="")
-p3 <- phylo4d(r1,tip.data=tipdat,node.data=data.frame(b=6:9), match.data=FALSE)
-summary(p3)
-
-plot(p1)
-
-plot(subset(p1,tips.include=c("fuliginosa","fortis","magnirostris",
- "conirostris","scandens")))
-## better error?
-## Error in phy$edge[, 2] : incorrect number of dimensions
-
-if(dev.cur() == 1) get(getOption("device"))()
-plot(subset(p2,tips.include=c("fuliginosa","fortis","magnirostris",
- "conirostris","scandens")))
-
-plot(p2,show.node.label=TRUE)
-
-tree.owls <- read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);")
-
-z <- as(tree.owls,"phylo4")
-
-example("phylo4d")
-obj1 <- obj2 <- obj3 <- phylo4d(z, data.frame(wing=1:4,color=factor(c("b","w","b","b")), tail=runif(4)*10), match.data=FALSE)
-
-obj2 at data <- as.data.frame(obj2 at data[,1])
-obj3 at data <- cbind(obj1 at data,obj2 at data)
-obj4 <- obj1
-obj4 at data[2,3] <- NA
-obj4 at data[1,1] <- NA
-
-nodeLabels(obj4) <- character(0)
-
-obj5 <- obj1
-tipData(obj4) <- subset(tipData(obj4),select=sapply(tipData(obj4),class)=="numeric")
-
-treePlot(obj4)
-
-E <- matrix(c(
- 8, 9,
- 9, 10,
- 10, 1,
- 10, 2,
- 9, 3,
- 9, 4,
- 8, 11,
- 11, 5,
- 11, 6,
- 11, 7,
- 0, 8), ncol=2,byrow=TRUE)
-
-P2 <- phylo4(E)
+Warning messages:
+1: replacing previous import by ‘Rcpp::evalCpp’ when loading ‘phylobase’
+2: replacing previous import by ‘ade4::newick2phylog’ when loading ‘phylobase’
+Execution halted
Modified: pkg/tests/phylo4dtests.R
===================================================================
--- pkg/tests/phylo4dtests.R 2014-03-17 02:15:25 UTC (rev 872)
+++ pkg/tests/phylo4dtests.R 2014-03-17 05:27:19 UTC (rev 873)
@@ -1,5 +1,5 @@
library(phylobase)
-require(ape)
+library(ape)
tree.phylo <- read.tree(text="(((A,B)C,D),E);") #only one node is labelled
tree <- as(tree.phylo, "phylo4")
Modified: pkg/tests/phylosubtest.R
===================================================================
--- pkg/tests/phylosubtest.R 2014-03-17 02:15:25 UTC (rev 872)
+++ pkg/tests/phylosubtest.R 2014-03-17 05:27:19 UTC (rev 873)
@@ -1,4 +1,5 @@
-require(phylobase)
+library(phylobase)
+library(ape)
data(geospiza)
gtree <- extractTree(geospiza)
Modified: pkg/tests/phylotorture.R
===================================================================
--- pkg/tests/phylotorture.R 2014-03-17 02:15:25 UTC (rev 872)
+++ pkg/tests/phylotorture.R 2014-03-17 05:27:19 UTC (rev 873)
@@ -1,29 +1,38 @@
## torture-testing phylo4 objects.
-require(phylobase)
-require(ape)
-set.seed(1001)
-p1 <- list()
-n <- 10
+library(phylobase)
+library(ape)
+
+set.seed(10101)
+n <- 200
+p1 <- vector("list", n)
## don't want to slow down R CMD check by doing this every time:
## n <- 10000
for (i in 1:n) {
-## e2 <- c(sample(1:5,replace=FALSE,size=5),sample(6:10,replace=FALSE,size=5))
-## e1 <- sample(6:10,replace=TRUE
- e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2)
- p1[[i]] <- try(phylo4(e),silent=TRUE)
+ if (i <= n/2) {
+ e <- matrix(sample(1:10, replace=TRUE, size=10), ncol=2)
+ }
+ else {
+ e <- cbind(sample(rep(11:19, 2)), sample(1:19))
+ e <- rbind(c(0, sample(11:19, 1)), e)
+ }
+ p1[[i]] <- try(phylo4(e), silent=TRUE)
}
OKvals <- sapply(p1, class) != "try-error"
## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with
## R check because of different width of terminal/output, trying something simpler:
message(unique(sapply(p1[!OKvals], as.character)))
+unname(table(sapply(p1[!OKvals], as.character)))
+if (sum(OKvals)) message("There are ", sum(OKvals), " valid trees...")
if (any(OKvals)) {
p2 <- p1[OKvals]
length(p2)
- has.poly <- sapply(p2,hasPoly)
- has.sing <- sapply(p2,hasSingle)
- has.retic <- sapply(p2,hasRetic)
- ##
+ has.poly <- sapply(p2, hasPoly)
+ has.sing <- sapply(p2, hasSingle)
+ has.retic <- sapply(p2, hasRetic)
+ message("number of trees with polytomies: ", sum(has.poly))
+ message("number of trees with singletons: ", sum(has.sing))
+ message("number of trees with reticulation: ", sum(has.retic))
if (any(has.sing)) {
p4 <- p2[has.sing]
plot(p4[[1]]) ## gives descriptive error
@@ -73,9 +82,9 @@
## warning, but no error
## plot(broke2) ## seems to hang R CMD check??
## generates error, but it's about wrong number of tips, not wrong value at root.
-print(try(as(broke2, "phylo4"), silent=TRUE))
+message(try(as(broke2, "phylo4"), silent=TRUE))
## error regarding number of tip labels vs edges and nodes
-print(try(phylo4(broke2$edge), silent=TRUE))
+message(try(phylo4(broke2$edge), silent=TRUE))
# switch root node value (6) with next internal node (7):
@@ -99,15 +108,15 @@
broke4$edge[broke4$edge==4] <- 14
broke4$edge[broke4$edge==5] <- 15
-print(try(as(broke4, "phylo4"), silent=TRUE) ) # error message saying tree has more than one root
-print(try(phylo4(broke4$edge),silent=TRUE)) # error message saying tree has more than one root
+message(try(as(broke4, "phylo4"), silent=TRUE))
+message(try(phylo4(broke4$edge), silent=TRUE))
# print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG!
###
foo <- new('phylo4')
-set.seed(1001)
+
foo at edge <- rcoal(10)$edge
-print(try(plot(foo)))
+message(try(plot(foo)))
foo at label <- c(rep('blah',10), rep("",9))
@@ -116,5 +125,5 @@
## with "Error in if (which(nAncest == 0) != nTips + 1) { :
## argument is of length zero"
-edge <- matrix(c(3,1,3,2),byrow=TRUE,ncol=2)
+edge <- matrix(c(3, 1, 3, 2), byrow=TRUE, ncol=2)
try(p2 <- phylo4(edge), silent=TRUE)
Modified: pkg/tests/plottest.R
===================================================================
--- pkg/tests/plottest.R 2014-03-17 02:15:25 UTC (rev 872)
+++ pkg/tests/plottest.R 2014-03-17 05:27:19 UTC (rev 873)
@@ -1,5 +1,5 @@
library(phylobase)
-## library(ape)
+library(ape)
data(geospiza)
g1 <- as(geospiza,"phylo4")
More information about the Phylobase-commits
mailing list