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

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

Author: dmbates
Date: 2012-05-17 06:06:42 +0200 (Thu, 17 May 2012)
New Revision: 1749

Modified:
   pkg/lme4/R/lmer.R
   pkg/lme4/inst/tests/test-glmmFail.R
   pkg/lme4/tests/glmerWarn.R
Log:
Handle glmer(..., family=gaussian) by calling lmer.  Move the testthat calls in tests/glmerWarn.R to inst/tests/test-glmmFail.R


Modified: pkg/lme4/R/lmer.R
===================================================================
--- pkg/lme4/R/lmer.R	2012-05-17 01:43:54 UTC (rev 1748)
+++ pkg/lme4/R/lmer.R	2012-05-17 04:06:42 UTC (rev 1749)
@@ -272,10 +272,18 @@
 {
     verbose <- as.integer(verbose)
     mf <- mc <- match.call()
-    if (missing(family)) { ## divert using lmer()
+                                        # extract family, call lmer for gaussian
+    if (is.character(family))
+        family <- get(family, mode = "function", envir = parent.frame(2))
+    if( is.function(family)) family <- family()
+    if (isTRUE(all.equal(family, gaussian()))) {
         mc[[1]] <- as.name("lmer")
+        mc["family"] <- NULL            # to avoid an infinite loop
         return(eval(mc, parent.frame()))
     }
+
+    if (family$family %in% c("quasibinomial", "quasipoisson", "quasi"))
+        stop('"quasi" families cannot be used in glmer')
 ### '...' handling up front, safe-guarding against typos ("familiy") :
     if(length(l... <- list(...))) {
         ## Check for invalid specifications
@@ -293,11 +301,6 @@
                     paste(sQuote(names(l...)), collapse=", "),
                     " disregarded")
     }
-    if(is.character(family))
-        family <- get(family, mode = "function", envir = parent.frame(2))
-    if(is.function(family)) family <- family()
-    if (family$family %in% c("quasibinomial", "quasipoisson", "quasi"))
-        stop('"quasi" families cannot be used in glmer')
 
     stopifnot(length(nAGQ <- as.integer(nAGQ)) == 1L,
               nAGQ >= 0L,

Modified: pkg/lme4/inst/tests/test-glmmFail.R
===================================================================
--- pkg/lme4/inst/tests/test-glmmFail.R	2012-05-17 01:43:54 UTC (rev 1748)
+++ pkg/lme4/inst/tests/test-glmmFail.R	2012-05-17 04:06:42 UTC (rev 1749)
@@ -13,10 +13,29 @@
 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())
+m1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
+            family = binomial, data = cbpp)
+context("Errors and warnings from glmer")
+test_that("glmer", {
+    expect_error(glmer(y ~ 1 + (1|block), data=dBc, family=binomial(link="cloglog")))
+    expect_warning(m2 <-lmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
+                             family = binomial, data = cbpp),
+                   "calling lmer with family\\(\\) is deprecated.*")
+    expect_equal(m1,m2)
+    expect_warning(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
+                         family = binomial, data = cbpp, REML=TRUE),
+                   "extra argument.*REML.*disregarded")
+    m3 <- glmer(Reaction ~ Days + (Days|Subject), sleepstudy)
+    m4 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
+    m5 <- glmer(Reaction ~ Days + (Days|Subject), sleepstudy, family=gaussian)
+    expect_equal(fixef(m3),fixef(m5))
+    expect_equal(m3,m4)
+    isTRUE(all.equal(m3,m5))
+
+    ## would like m3==m5 != m4 ??
+    VarCorr(m4)
+    VarCorr(m5)  ## wrong??? is this the report or the
+    getME(m4,"theta")
+    getME(m5,"theta")
 })
 

Modified: pkg/lme4/tests/glmerWarn.R
===================================================================
--- pkg/lme4/tests/glmerWarn.R	2012-05-17 01:43:54 UTC (rev 1748)
+++ pkg/lme4/tests/glmerWarn.R	2012-05-17 04:06:42 UTC (rev 1749)
@@ -1,25 +1,11 @@
 library(lme4)
 library(testthat)
-m1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
-            family = binomial, data = cbpp)
-expect_that(lmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
-            family = binomial, data = cbpp),
-            gives_warning("calling lmer with family\\(\\) is deprecated.*"))
 
-## FIXME: should glmer(..., [no family]) give a warning as well?
-stopifnot(all.equal(m1,m2))
-
-expect_that(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
-                  family = binomial, data = cbpp,
-                  REML=TRUE),
-            gives_warning("extra argument.*REML.*disregarded"))
-
-
 m3 <- glmer(Reaction ~ Days + (Days|Subject), sleepstudy)
 m4 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
 m5 <- glmer(Reaction ~ Days + (Days|Subject), sleepstudy, family=gaussian)
-all.equal(fixef(m3),fixef(m5))
-all.equal(m3,m4)
+expect_equal(fixef(m3),fixef(m5))
+expect_equal(m3,m4)
 isTRUE(all.equal(m3,m5))
 
 ## would like m3==m5 != m4 ??