[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