[Lme4-commits] r1579 - pkg/lme4Eigen/inst/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 8 21:01:12 CET 2012
Author: dmbates
Date: 2012-02-08 21:01:11 +0100 (Wed, 08 Feb 2012)
New Revision: 1579
Added:
pkg/lme4Eigen/inst/tests/test-lmerResp.R
Log:
Unit tests of the lmerResp and glmResp classes in testthat form
Added: pkg/lme4Eigen/inst/tests/test-lmerResp.R
===================================================================
--- pkg/lme4Eigen/inst/tests/test-lmerResp.R (rev 0)
+++ pkg/lme4Eigen/inst/tests/test-lmerResp.R 2012-02-08 20:01:11 UTC (rev 1579)
@@ -0,0 +1,58 @@
+library("testthat")
+context("Response modules")
+
+n <- nrow(Dyestuff)
+ones <- rep.int(1, n)
+zeros <- rep.int(0, n)
+YY <- Dyestuff$Yield
+mYY <- mean(YY)
+
+test_that("lmerResp", {
+ mres <- YY - mYY
+ rr <- lmerResp$new(y=YY)
+
+ expect_that(rr$weights, equals(ones))
+ expect_that(rr$sqrtrwt, equals(ones))
+ expect_that(rr$sqrtXwt, equals(ones))
+ expect_that(rr$offset, equals(zeros))
+ expect_that(rr$mu, equals(zeros))
+ expect_that(rr$wtres, equals(YY))
+ expect_that(rr$wrss(), equals(sum(YY^2)))
+ expect_that(rr$updateMu(rep.int(mYY, n)), equals(sum(mres^2)))
+ expect_that(rr$REML, equals(0L))
+
+ rr$REML <- 1L
+ expect_that(rr$REML, equals(1L))
+})
+
+mlYY <- mean(log(YY))
+gmeanYY <- exp(mlYY) # geometric mean
+
+test_that("glmResp", {
+ mres <- YY - gmeanYY
+ gmean <- rep.int(gmeanYY, n)
+ rr <- glmResp$new(family=poisson(), y=YY)
+
+ expect_that(rr$weights, equals(ones))
+ expect_that(rr$sqrtrwt, equals(ones))
+ expect_that(rr$sqrtXwt, equals(ones))
+ expect_that(rr$offset, equals(zeros))
+ expect_that(rr$mu, equals(zeros))
+ expect_that(rr$wtres, equals(YY))
+ expect_that(rr$n, equals(ones))
+
+ ## wrss() causes an update of mu which becomes ones, wtres also changes
+ expect_that(rr$wrss(), equals(sum((YY-1)^2)))
+ expect_that(rr$mu, equals(ones))
+ expect_that(rr$wtres, equals(YY-ones))
+
+ expect_that(rr$updateMu(rep.int(mlYY, n)), equals(sum(mres^2)))
+ expect_that(rr$mu, equals(gmean))
+ expect_that(rr$muEta(), equals(gmean))
+ expect_that(rr$variance(), equals(gmean))
+
+ rr$updateWts()
+ expect_that(1/sqrt(rr$variance()), equals(rr$sqrtrwt))
+ expect_that(as.vector(rr$sqrtXwt), equals(rr$sqrtrwt * rr$muEta()))
+})
+
More information about the Lme4-commits
mailing list