[Lme4-commits] r1727 - in pkg/lme4: inst/tests tests

[noreply at r-forge.r-project.org]

Author: dmbates
Date: 2012-05-15 19:13:20 +0200 (Tue, 15 May 2012)
New Revision: 1727

Added:
   pkg/lme4/inst/tests/test-glmmFail.R
Removed:
   pkg/lme4/tests/cloglog.R
Log:
Move cloglog test to the testthat tests to trap an error more easily.


Copied: pkg/lme4/inst/tests/test-glmmFail.R (from rev 1726, pkg/lme4/tests/cloglog.R)
===================================================================
--- pkg/lme4/inst/tests/test-glmmFail.R	                        (rev 0)
+++ pkg/lme4/inst/tests/test-glmmFail.R	2012-05-15 17:13:20 UTC (rev 1727)
@@ -0,0 +1,22 @@
+library("testthat")
+library("lme4")
+
+set.seed(101)
+d <- expand.grid(block=LETTERS[1:26], rep=1:100, KEEP.OUT.ATTRS = FALSE)
+d$x <- runif(nrow(d))  ## sd=1
+reff_f <- rnorm(length(levels(d$block)),sd=1)
+## set intercept large enough to create a constant response
+d$eta0 <- 4+3*d$x  ## fixed effects only
+d$eta <- d$eta0+reff_f[d$block]
+dBc <- d
+cc <- binomial(link="cloglog")
+dBc$mu <- cc$linkinv(d$eta)
+dBc$y <- rbinom(nrow(d),dBc$mu,size=1)
+
+context("glmer failure because of a constant response")
+test_that("constant response", {
+    expect_that(glmer(y ~ 1 + (1|block), data=dBc,
+                      family=binomial(link="cloglog")),
+                throws_error())
+})
+

Deleted: pkg/lme4/tests/cloglog.R
===================================================================
--- pkg/lme4/tests/cloglog.R	2012-05-14 13:30:42 UTC (rev 1726)
+++ pkg/lme4/tests/cloglog.R	2012-05-15 17:13:20 UTC (rev 1727)
@@ -1,29 +0,0 @@
-## subsetted from glmmExt.R, for convenience
-library(lme4)
-
-set.seed(101)
-d <- expand.grid(block=LETTERS[1:26], rep=1:100, KEEP.OUT.ATTRS = FALSE)
-d$x <- runif(nrow(d))  ## sd=1
-reff_f <- rnorm(length(levels(d$block)),sd=1)
-## need intercept large enough to avoid negative values
-d$eta0 <- 4+3*d$x  ## fixed effects only
-d$eta <- d$eta0+reff_f[d$block]
-dBc <- d
-cc <- binomial(link="cloglog")
-dBc$mu <- cc$linkinv(d$eta)
-dBc$y <- rbinom(nrow(d),dBc$mu,size=1)
-
-if (FALSE) {
-    ## debug(lme4:::glmerPwrssUpdate)
-    ## if we set compDev=FALSE we get
-    ##   pdev eventually going to NaN in RglmerWrkIter/glmerPwrssUpdate
-    gBc1 <- glmer(y ~ 1 + (1|block), data=dBc,
-                  family=binomial(link="cloglog"), verbose= 3,
-                  compDev=FALSE)
-    gBc2 <- glmer(y ~ x + (1|block), data=dBc,
-                  family=binomial(link="cloglog"), verbose= 3)
-}
-
-
-
-