[Lme4-commits] r1732 - in pkg/lme4: R src tests

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

Author: bbolker
Date: 2012-05-15 21:35:07 +0200 (Tue, 15 May 2012)
New Revision: 1732

Added:
   pkg/lme4/tests/glmerWarn.R
Modified:
   pkg/lme4/R/lmer.R
   pkg/lme4/src/external.cpp
Log:

   various small glitches in glmer calling interfaces
   add warning for lmer(...,family) -> glmer



Modified: pkg/lme4/R/lmer.R
===================================================================
--- pkg/lme4/R/lmer.R	2012-05-15 18:02:58 UTC (rev 1731)
+++ pkg/lme4/R/lmer.R	2012-05-15 19:35:07 UTC (rev 1732)
@@ -334,7 +334,7 @@
         stop("Response is constant - cannot fit the model")
     rho$verbose     <- as.integer(verbose)
                                         # initialize (from mustart)
-    .Call(glmerLaplace, pp$ptr(), resp$ptr(), 0L, tolPwrss, verbose)
+    .Call(glmerLaplace, rho$pp$ptr(), rho$resp$ptr(), 0L, tolPwrss, verbose)
     rho$lp0         <- rho$pp$linPred(1) # each pwrss opt begins at this eta
     rho$pwrssUpdate <- glmerPwrssUpdate
     rho$compDev     <- compDev
@@ -488,7 +488,20 @@
 ##' (dd <- lmer(Yield ~ 1|Batch, Dyestuff, devFunOnly=TRUE))
 ##' dd(0.8)
 ##' minqa::bobyqa(1, dd, 0)
-##'
+
+## global variables defs to make codetools/R CMD check happier.
+## FIXME: does putting globalVariables() stuff here interfere with Roxygen?
+## ?globalVariables says that fields and methods in reference classes are
+## "handled automatically by ‘setRefClass()’ and friends, using the
+##  supplied field and method names" -- perhaps there's a better way to do this?
+if (getRversion()<="2.15.0")  {
+    ## dummy
+    globalVariables <- function(...) {}
+}
+globalVariables(c("pp","resp","lp0","pwrssUpdate","compDev",
+                   "baseOffset","GQmat","fac","nlmerAGQ","tolPwrss",
+                   "dpars","verbose"),
+                 package="lme4")
 mkdevfun <- function(rho, nAGQ=1L) {
     ## FIXME: should nAGQ be automatically embedded in rho?
     stopifnot(is.environment(rho), is(rho$resp, "lmResp"))
@@ -574,6 +587,7 @@
 }
 
 glmerPwrssUpdate <- function(pp, resp, tol, GQmat, compDev=TRUE, grpFac=NULL) {
+    verbose <- TRUE ## hack
     nAGQ <- nrow(GQmat)
     if (compDev) {
         if (nAGQ < 2L)

Modified: pkg/lme4/src/external.cpp
===================================================================
--- pkg/lme4/src/external.cpp	2012-05-15 18:02:58 UTC (rev 1731)
+++ pkg/lme4/src/external.cpp	2012-05-15 19:35:07 UTC (rev 1732)
@@ -853,8 +853,8 @@
     CALLDEF(glmFamily_theta,    1),
     CALLDEF(glmFamily_variance, 2),
 
-    CALLDEF(glmerAGQ,           5),
-    CALLDEF(glmerLaplace,       6),
+    CALLDEF(glmerAGQ,           6),
+    CALLDEF(glmerLaplace,       5),
 
     CALLDEF(golden_Create,      2),
     CALLDEF(golden_newf,        2),

Added: pkg/lme4/tests/glmerWarn.R
===================================================================
--- pkg/lme4/tests/glmerWarn.R	                        (rev 0)
+++ pkg/lme4/tests/glmerWarn.R	2012-05-15 19:35:07 UTC (rev 1732)
@@ -0,0 +1,23 @@
+library(lme4)
+library(testthat)
+m1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
+            family = binomial, data = cbpp)
+expect_that(m2 <- lmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
+            family = binomial, data = cbpp),
+            gives_warning())
+
+## FIXME: should glmer(..., [no family]) give a warning as well?
+stopifnot(all.equal(m1,m2))
+
+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)
+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")