[Lme4-commits] r1578 - pkg/lme4Eigen/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 8 21:00:31 CET 2012
Author: dmbates
Date: 2012-02-08 21:00:31 +0100 (Wed, 08 Feb 2012)
New Revision: 1578
Removed:
pkg/lme4Eigen/inst/unitTests/runTests.R
pkg/lme4Eigen/inst/unitTests/runit.compDev.R
pkg/lme4Eigen/inst/unitTests/runit.link.R
pkg/lme4Eigen/inst/unitTests/runit.lmerResp.R
Log:
Removing unit tests in RUnit form
Deleted: pkg/lme4Eigen/inst/unitTests/runTests.R
===================================================================
--- pkg/lme4Eigen/inst/unitTests/runTests.R 2012-02-08 19:19:52 UTC (rev 1577)
+++ pkg/lme4Eigen/inst/unitTests/runTests.R 2012-02-08 20:00:31 UTC (rev 1578)
@@ -1,88 +0,0 @@
-pkg <- "lme4Eigen"
-
-if(require("RUnit", quietly = TRUE)) {
-
- is_local <- function(){
- if( exists( "argv", globalenv() ) && "--local" %in% argv ) return(TRUE)
- if( "--local" %in% commandArgs(TRUE) ) return(TRUE)
- FALSE
- }
- if( is_local() ) path <- getwd()
-
- library(package=pkg, character.only = TRUE)
- if(!(exists("path") && file.exists(path)))
- path <- system.file("unitTests", package = pkg)
-
- ## --- Testing ---
-
- ## Define tests
- testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs = path)
-
- if(interactive()) {
- cat("Now have RUnit Test Suite 'testSuite' for package '", pkg,
- "' :\n", sep='')
- str(testSuite)
- cat('', "Consider doing",
- "\t tests <- runTestSuite(testSuite)", "\nand later",
- "\t printTextProtocol(tests)", '', sep="\n")
- } else { ## run from shell / Rscript / R CMD Batch / ...
- ## Run
- tests <- runTestSuite(testSuite)
-
- output <- NULL
-
- process_args <- function(argv){
- if( !is.null(argv) && length(argv) > 0 ){
- rx <- "^--output=(.*)$"
- g <- grep( rx, argv, value = TRUE )
- if( length(g) ){
- sub( rx, "\\1", g[1L] )
- }
- }
- }
-
- # give a chance to the user to customize where he/she wants
- # the unit tests results to be stored with the --output= command
- # line argument
- if( exists( "argv", globalenv() ) ){
- # littler
- output <- process_args(argv)
- } else {
- # Rscript
- output <- process_args(commandArgs(TRUE))
- }
-
- # if it did not work, try to use /tmp
- if( is.null(output) ){
- if( file.exists( "/tmp" ) ){
- output <- "/tmp"
- } else{
- output <- getwd()
- }
- }
-
- ## Print results
- output.txt <- file.path( output, sprintf("%s-unitTests.txt", pkg))
- output.html <- file.path( output, sprintf("%s-unitTests.html", pkg))
-
- printTextProtocol(tests, fileName=output.txt)
- message( sprintf( "saving txt unit test report to '%s'", output.txt ) )
-
- ## Print HTML version to a file
- ## printHTMLProtocol has problems on Mac OS X
- if (Sys.info()["sysname"] != "Darwin"){
- message( sprintf( "saving html unit test report to '%s'", output.html ) )
- printHTMLProtocol(tests, fileName=output.html)
- }
-
- ## stop() if there are any failures i.e. FALSE to unit test.
- ## This will cause R CMD check to return error and stop
- if(getErrors(tests)$nFail > 0) {
- stop("one of the unit tests failed")
- }
- }
-} else {
- cat("R package 'RUnit' cannot be loaded -- no unit tests run\n",
- "for package", pkg,"\n")
-}
-
Deleted: pkg/lme4Eigen/inst/unitTests/runit.compDev.R
===================================================================
--- pkg/lme4Eigen/inst/unitTests/runit.compDev.R 2012-02-08 19:19:52 UTC (rev 1577)
+++ pkg/lme4Eigen/inst/unitTests/runit.compDev.R 2012-02-08 20:00:31 UTC (rev 1578)
@@ -1,9 +0,0 @@
-if (FALSE) { # compDev no longer exists for lmer models - maybe check glmer?
-test.compDev <- function() { # cross-check compDev versus R evaluation
- fm1 <- lmer(Yield ~ 1|Batch, Dyestuff, doFit = FALSE)
- dd1c <- mkdevfun(fm1)
- dd1u <- mkdevfun(fm1, compDev = FALSE)
- checkEquals(dd1c(1), dd1u(1))
- checkEquals(bobyqa(1,dd1c,0), bobyqa(1,dd1u,0))
-}
-}
Deleted: pkg/lme4Eigen/inst/unitTests/runit.link.R
===================================================================
--- pkg/lme4Eigen/inst/unitTests/runit.link.R 2012-02-08 19:19:52 UTC (rev 1577)
+++ pkg/lme4Eigen/inst/unitTests/runit.link.R 2012-02-08 20:00:31 UTC (rev 1578)
@@ -1,89 +0,0 @@
-eps <- .Machine$double.eps
-oneMeps <- 1 - eps
-set.seed(1)
-
-etas <- data.frame(A = seq.int(-8, 8, by=1), # equal spacing to asymptotic area
- B = runif(17, -8, 8), # random sample from wide uniform dist
- C = rnorm(17, 0, 8), # random sample from wide normal dist
- D = c(-10^30, rnorm(15, 0, 4), 10^30))
-
-etapos <- data.frame(A = seq.int(1, 20, by=1),
- B = rexp(20),
- C = rgamma(20, 3),
- D = pmax(.Machine$double.eps, rnorm(20, 2, 1)))
-
-mubinom <-
- lapply(list(runif(100, 0, 1),
- rbeta(100, 1, 3),
- pmin(pmax(eps, rbeta(100, 0.1, 3)), oneMeps),
- pmin(pmax(eps, rbeta(100, 3, 0.1)), oneMeps)), as.numeric)
-
-tst.lnki <- function(fam, frm) {
- ff <- glmFamily$new(family=fam)
- sapply(frm, function(x) checkEquals(fam$linkinv(x), ff$linkInv(x)))
-}
-
-tst.link <- function(fam, frm) {
- ff <- glmFamily$new(family=fam)
- sapply(frm, function(x) checkEquals(fam$linkfun(x), ff$link(x)))
-}
-
-tst.muEta <- function(fam, frm) {
- ff <- glmFamily$new(family=fam)
- sapply(frm, function(x) checkEquals(fam$mu.eta(x), ff$muEta(x)))
-}
-
-tst.variance <- function(fam, frm) {
- ff <- glmFamily$new(family=fam)
- sapply(frm, function(x) checkEquals(fam$variance(x), ff$variance(x)))
-}
-
-test.uncons.lnki <- function() { # linkinv on unconstrained eta
- tst.lnki(binomial(), etas) # binomial with logit link
- tst.muEta(binomial(), etas)
- tst.lnki(binomial("probit"), etas) # binomial with probit link
- tst.muEta(binomial("probit"), etas)
- tst.lnki(binomial("cloglog"), etas) # binomial with cloglog link
- tst.muEta(binomial("cloglog"), etas)
- tst.lnki(binomial("cauchit"), etas) # binomial with cauchit link
- tst.muEta(binomial("cauchit"), etas)
- tst.lnki(poisson(), etas) # Poisson with log link
- tst.muEta(poisson(), etas)
- tst.lnki(gaussian(), etas) # Gaussian with identity link
- tst.muEta(gaussian(), etas)
-}
-
-test.pos.lnki <- function() { # linkinv for positive eta
- tst.lnki(Gamma(), etapos) # gamma family
- tst.muEta(Gamma(), etapos)
- tst.lnki(inverse.gaussian(), etapos) # inverse Gaussian
- tst.muEta(inverse.gaussian(), etapos)
-}
-
-test.binom.link <- function() { # link and variance for binomial mu
- tst.link(binomial(), mubinom)
- tst.variance(binomial(), mubinom)
- tst.link(binomial("probit"), mubinom)
- tst.variance(binomial("probit"), mubinom)
- tst.link(binomial("cauchit"), mubinom)
- tst.variance(binomial("cauchit"), mubinom)
-}
-
-test.pos.link <- function() { # link for positive mu (using positive etas)
- tst.link(poisson(), etapos)
- tst.variance(poisson(), etapos)
- tst.link(Gamma(), etapos)
- tst.variance(Gamma(), etapos)
- tst.link(inverse.gaussian(), etapos)
- tst.variance(inverse.gaussian(), etapos)
-}
-
-test.uncons.link <- function() { # link for unconstrained mu (using unconstrained etas)
- tst.link(gaussian(), etas)
- tst.variance(gaussian(), etas)
-}
-
-
-
-
-
Deleted: pkg/lme4Eigen/inst/unitTests/runit.lmerResp.R
===================================================================
--- pkg/lme4Eigen/inst/unitTests/runit.lmerResp.R 2012-02-08 19:19:52 UTC (rev 1577)
+++ pkg/lme4Eigen/inst/unitTests/runit.lmerResp.R 2012-02-08 20:00:31 UTC (rev 1578)
@@ -1,45 +0,0 @@
-set.seed(1)
-
-test.lmerResp <- function() {
- n <- nrow(Dyestuff)
- YY <- Dyestuff$Yield
- mYY <- mean(YY)
- mres <- YY - mYY
- rr <- lmerResp$new(y=YY)
- checkEquals(rr$weights, rep.int(1, n))
- checkEquals(rr$sqrtrwt(), rep.int(1, n))
- checkEquals(rr$sqrtXwt(), array(rep.int(1, n), c(n, 1L)))
- checkEquals(rr$offset, rep.int(0, n))
- checkEquals(rr$fitted(), rep.int(0, n))
- checkEquals(rr$wtres(), YY)
- checkEquals(rr$wrss(), sum(YY * YY))
- checkEquals(rr$updateMu(rep.int(mYY, n)), sum(mres^2))
- checkEquals(rr$reml, 0L)
- rr$reml <- 1L
- checkEquals(rr$reml, 1L)
-}
-
-test.glmResp <- function() {
- n <- nrow(Dyestuff)
- YY <- Dyestuff$Yield
- mlYY <- mean(log(YY))
- gmeanYY <- exp(mlYY) # geometric mean
- mres <- YY - gmeanYY
- rr <- glmResp$new(family=poisson(), y=YY)
-
- checkEquals(rr$weights, rep.int(1, n))
- checkEquals(rr$sqrtrwt(), rep.int(1, n))
- checkEquals(rr$sqrtXwt(), array(rep.int(1, n), c(n, 1L)))
- checkEquals(rr$offset, rep.int(0, n))
- checkEquals(rr$fitted(), rep.int(0, n))
- checkEquals(rr$wtres(), YY)
- checkEquals(rr$wrss(), sum(YY^2))
- checkEquals(rr$n, rep.int(1, n))
- checkEquals(rr$updateMu(rep.int(mlYY, n)), sum(mres^2))
- checkEquals(rr$fitted(), rep.int(gmeanYY, n))
- checkEquals(rr$muEta(), rep.int(gmeanYY, n))
- checkEquals(rr$variance(), rep.int(gmeanYY, n))
- rr$updateWts()
- checkEquals(1/sqrt(rr$variance()), rr$sqrtrwt())
- checkEquals(as.vector(rr$sqrtXwt()), rr$sqrtrwt() * rr$muEta())
-}
More information about the Lme4-commits
mailing list