[Lme4-commits] r1600 - pkg/lme4Eigen/R

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

Author: bbolker
Date: 2012-02-14 18:33:11 +0100 (Tue, 14 Feb 2012)
New Revision: 1600

Modified:
   pkg/lme4Eigen/R/lmer.R
Log:

  make sure nAGQ gets stored in rho
  extend 'lower' when refitting GLMMs



Modified: pkg/lme4Eigen/R/lmer.R
===================================================================
--- pkg/lme4Eigen/R/lmer.R	2012-02-13 17:47:32 UTC (rev 1599)
+++ pkg/lme4Eigen/R/lmer.R	2012-02-14 17:33:11 UTC (rev 1600)
@@ -322,6 +322,7 @@
     if (devFunOnly && !nAGQ) return(devfun)
     control$iprint <- min(verbose, 3L)
     opt <- bobyqa(rho$pp$theta, devfun, rho$lower, control=control)
+    rho$nAGQ <- nAGQ
     if (nAGQ > 0L) {
         rho$lower <- c(rho$lower, rep.int(-Inf, length(rho$beta0)))
         rho$u0    <- rho$pp$u0
@@ -1163,6 +1164,8 @@
 ##' @S3method refit merMod
 refit.merMod <- function(object, newresp, ...) {
     rr        <- object at resp$copy()
+    ## FIXME: want this to work for binomial (two-column) data?
+    ##  or tell people they have to work with prop/weights formulation?
     stopifnot(length(newresp <- as.numeric(as.vector(newresp))) == length(rr$y))
     rr$setResp(newresp)
     pp        <- object at pp$copy()
@@ -1174,16 +1177,18 @@
                         nAGQ=nAGQ)
     xst       <- rep.int(0.1, nth)
     x0        <- pp$theta
+    lower     <- object at lower
     if (!is.na(nAGQ) && nAGQ > 0L) {
         xst   <- c(xst, sqrt(diag(pp$unsc())))
         x0    <- c(x0, pp$beta0)
+        lower <- c(lower, rep(-Inf,length(pp$beta0)))
     }
     control <- list(...)$control
     if (is.null(control)) control <- list()
 ### FIXME: Probably should save the control settings and the optimizer name in the merMod object
-    opt <- Nelder_Mead(ff, x0, xst=0.2*xst, xt=xst*0.0001, lower=object at lower, control=control)
+    opt <- Nelder_Mead(ff, x0, xst=0.2*xst, xt=xst*0.0001, 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), object at frame, getCall(object))
+                                        lower=lower), object at frame, getCall(object))
 }    
 
 ##' @S3method refitML merMod