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

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

Author: dmbates
Date: 2012-05-07 23:50:21 +0200 (Mon, 07 May 2012)
New Revision: 1721

Modified:
   pkg/lme4/R/lmer.R
   pkg/lme4/R/nbinom.R
   pkg/lme4/tests/nbinom.R
Log:
Fix up the offset issue in a refit GLMM allowing glmer.nb to work.


Modified: pkg/lme4/R/lmer.R
===================================================================
--- pkg/lme4/R/lmer.R	2012-05-07 18:56:45 UTC (rev 1720)
+++ pkg/lme4/R/lmer.R	2012-05-07 21:50:21 UTC (rev 1721)
@@ -1122,8 +1122,9 @@
     ## FIXME: generic optimizer stuff
 ### FIXME: Probably should save the control settings and the optimizer name in the merMod object
     opt <- Nelder_Mead(ff, x0, lower=lower, control=control)
-    mkMerMod(environment(ff), opt, list(flist=object at flist, cnms=object at cnms, Gp=object at Gp,
-                                        lower=object at lower),
+    if (isGLMM(object)) rr$setOffset(baseOffset)
+    mkMerMod(environment(ff), opt,
+             list(flist=object at flist, cnms=object at cnms, Gp=object at Gp, lower=object at lower),
              object at frame, getCall(object))
 }
 

Modified: pkg/lme4/R/nbinom.R
===================================================================
--- pkg/lme4/R/nbinom.R	2012-05-07 18:56:45 UTC (rev 1720)
+++ pkg/lme4/R/nbinom.R	2012-05-07 21:50:21 UTC (rev 1721)
@@ -34,10 +34,10 @@
       ## FIXME: kluge to retain last value and evaluation count
       ## Perhaps use a reference class object to keep track of this
       ## auxilliary information?  DB
-      L <- -logLik(lastfit <<- refitNB(lastfit,theta=exp(t)))
+      dev <- deviance(lastfit <<- refitNB(lastfit,theta=exp(t)))
       evalcnt <<- evalcnt+1
-      if (verbose) cat(evalcnt,exp(t),L,"\n")
-      L
+      if (verbose) cat(evalcnt,exp(t),dev,"\n")
+      dev
   }, interval=interval)
   stopifnot(all.equal(optval$minimum,log(getNBdisp(lastfit))))
   ## FIXME: return eval count info somewhere else? MM: new slot there, why not?

Modified: pkg/lme4/tests/nbinom.R
===================================================================
--- pkg/lme4/tests/nbinom.R	2012-05-07 18:56:45 UTC (rev 1720)
+++ pkg/lme4/tests/nbinom.R	2012-05-07 21:50:21 UTC (rev 1721)
@@ -18,8 +18,6 @@
                  mu=exp(X %*% beta +u_f[f]),size=NBtheta))
 }
 
-if (FALSE) {
-    #### FIXME: just plain broken, 28 April 2012
 set.seed(102)
 d.1 <- simfun()
 t1 <- system.time(g1 <- glmer.nb(z ~ x + (1|f), data=d.1, verbose=TRUE))
@@ -30,8 +28,7 @@
 (g1B <- refitNB(g1,theta=getNBdisp(g1)))
 (ddev <- deviance(g1)-deviance(g1B))
 (rel.d <- (fixef(g1)-fixef(g1B))/fixef(g1))
-stopifnot(all.equal(d1, 0.448, tol = 1e-3),
-          all.equal(ddev, 0.0007, tol=.0005),
+stopifnot(abs(ddev) < 1e-6,
           abs(rel.d) < 0.0004)
 
 ## library(glmmADMB)
@@ -63,7 +60,6 @@
           } else
           all.equal(as.numeric(logLik.m(g1B)), as.numeric(-glmmADMB_vals$ NLL), tol= 4e-5)
           )
-}
 
 if(FALSE) { ## simulation study --------------------