lme4/0000755000176200001440000000000014177343542011125 5ustar liggesuserslme4/NAMESPACE0000644000176200001440000001764414136006216012345 0ustar liggesusersuseDynLib(lme4, .registration=TRUE) ## base packages importFrom("graphics", par, plot) importFrom("grid", gpar, viewport) importFrom("splines", backSpline, interpSpline, periodicSpline) importFrom("methods", as, getDataPart, extends, is, new, cbind2, rbind2, show, slot, slotNames, setRefClass, getClass) importFrom("stats", AIC, BIC, anova, approx, approxfun, as.formula, asOneSidedFormula, ave, coef, confint, contrasts, "contrasts<-", cooks.distance, delete.response, deviance, dfbeta, dfbetas, df.residual, dnorm, drop.scope, drop1, extractAIC, family, fitted, formula, gaussian, getCall, glm, hatvalues, influence, lm, logLik, model.extract, model.frame, model.matrix, model.offset, model.response, model.weights, na.exclude, na.omit, na.pass, napredict, naresid, nlminb, nobs, optim, optimize, pchisq, pnorm, poisson, ppoints, predict, printCoefmat, profile, pt, qchisq, qnorm, qqnorm, qt, quantile, rbinom, reformulate, reorder, resid, residuals, rgamma, rnbinom, rnorm, rpois, rstudent, runif, sd, setNames, simulate, symnum, terms, terms.formula, update, update.formula, var, vcov, weights) importFrom("utils", flush.console, packageVersion, sessionInfo, stack, str, capture.output) if(getRversion() >= "3.5.0") { importFrom("utils", warnErrList) } else { importFrom("utils", capture.output) # for "our" warnErrList() } ## Recommended packages importFrom("lattice", bwplot, current.panel.limits, densityplot, dotplot, histogram, llines,lpoints,lsegments,ltext, panel.abline,panel.axis,panel.bwplot,panel.grid,panel.histogram, panel.lines, panel.number, panel.points, panel.segments, panel.xyplot, prepanel.qqmathline, panel.qqmathline, panel.qqmath, qqmath, splom, strip.custom, strip.default, trellis.par.get, xyplot) importFrom("MASS", negative.binomial, theta.ml) importFrom("boot", boot.ci) ## generics we provide methods for and re-export: importFrom("nlme", fixef,ranef, VarCorr, getGroups, getData) importFrom("Matrix", drop0, rankMatrix, sparseMatrix, sparse.model.matrix, forceSymmetric, fac2sparse, KhatriRao, Diagonal, .bdiag, as.matrix, bdiag) importClassesFrom("Matrix", corMatrix, dgCMatrix, dpoMatrix, dCHMsimpl) ## methods incl. S4 generics: importMethodsFrom("Matrix", coerce, cov2cor, "%*%", crossprod,tcrossprod, t, diag, chol2inv, solve, colSums,rowSums) ## other CRAN packages: importFrom("minqa", bobyqa) importFrom("nloptr", nloptr) ## Re-Exports : export(negative.binomial) ## currently needed for some eval()ing methods for glmer.nb() objects ## Our Exports: export(allFit) export(bootMer) export(checkConv) export(devcomp) export(devfun2) export(dummy) export(factorize) ## needed for qqmath??? export(expandDoubleVerts) export(findbars) export(fixef) ## export(fortify) export(getL) export(getME) export(GHrule) export(glFormula) export(glmer.nb) export(glmer) export(glmerLaplaceHandle) export(glmFamily) export(glmResp) export(golden) export(GQdk) export(GQN) export(isLMM, isGLMM, isNLMM) export(isNested) export(isREML) export(isSingular) export(lFormula) export(lme4_testlevel) export(lmer) export(lmerControl, glmerControl, nlmerControl, .makeCC) export(lmerResp) export(lmList) export(lmResp) export(logProf) export(varianceProf) export(mlist2vec) export(vec2mlist) export(vec2STlist) export(sdcor2cov) export(cov2sdcor) export(Vv_to_Cv, Sv_to_Cv, Cv_to_Vv, Cv_to_Sv) export(merPredD) export(mkGlmerDevfun) export(mkLmerDevfun) export(mkMerMod) export(mkRespMod) export(mkReTrms) export(mkNewReTrms) export(mkVarCorr) export(mkParsTemplate) export(mkDataTemplate) export(Nelder_Mead) export(NelderMead) export(ngrps) export(nlformula) export(nlmer) export(nloptwrap, nlminbwrap)# export both (1st has been there "forever") export(nlsResp) export(nobars) export(optimizeGlmer) export(optimizeLmer) export(ranef) export(refit) export(refitML) export(rePos) export(REMLcrit) if(getRversion() >= "3.3.0") { importFrom("stats", sigma) } else { export(sigma) } export(.simulateFun) export(simulate.formula) export(subbars) export(updateGlmerDevfun) export(VarCorr) export(getData) export(varianceProf) ## print() and print.summary() utilities -- other [NG]LMM packages can import export(.prt.VC, .prt.aictab, .prt.call, .prt.family, .prt.grps, .prt.methTit, .prt.resids, .prt.warn, formatVC, llikAIC, methTitle) ## export(tnames) ##------ Our S4 Classes ------------------------ exportClasses(glmerMod, lmerMod, nlmerMod, merMod) exportClasses(lmList4) ##------ Our S4 Generics / Methods -------------- exportMethods(getL) exportMethods(show) ##------ Our S3 Methods ------------------------- S3method(anova,merMod) S3method(as.data.frame,bootMer) S3method(as.data.frame,thpr) S3method(as.data.frame,ranef.mer) S3method(as.data.frame,VarCorr.merMod) S3method(as.function,merMod) S3method(coef,lmList4) S3method(coef,merMod) S3method(confint,bootMer) S3method(confint,lmList4) S3method(confint,merMod)# but don't hide: export(confint.merMod) S3method(confint,thpr) S3method(cooks.distance,merMod) S3method(cooks.distance,influence.merMod) S3method(densityplot,thpr) S3method(deviance,merMod) S3method(df.residual,merMod) ## S3method(dim,merMod) ??? S3method(dotplot,coef.mer) S3method(dotplot,ranef.mer) ## helpful to allow direct access for glmmTMB export(dotplot.ranef.mer) S3method(drop1,merMod) S3method(extractAIC,merMod) S3method(family,glmResp) S3method(family,lmResp) S3method(family,merMod) S3method(family,nlsResp) S3method(fitted,merMod) S3method(fixef,merMod) S3method(formula,lmList4) S3method(formula,merMod) S3method(getData,merMod) ## S3method(fortify,merMod)# but don't hide: export(fortify.merMod) S3method(getME, merMod) S3method(hatvalues,merMod) S3method(influence,merMod) S3method(isGLMM,merMod) S3method(isLMM,merMod) S3method(isNLMM,merMod) S3method(isREML,merMod) S3method(log,thpr) S3method(logLik,merMod) S3method(model.frame,merMod) S3method(model.matrix,merMod) S3method(ngrps,factor) S3method(ngrps,merMod) S3method(nobs,merMod) S3method(plot,coef.mer) S3method(plot,lmList4.confint) S3method(plot,merMod) S3method(plot,ranef.mer) S3method(predict,merMod) S3method(print,allFit) S3method(print,bootMer) S3method(print,merMod) S3method(print,ranef.mer) S3method(print,summary.merMod) S3method(print,VarCorr.merMod) S3method(profile,merMod) S3method(qqmath,merMod) S3method(qqmath,ranef.mer) S3method(ranef,merMod) S3method(refit,merMod) S3method(refitML,merMod) S3method(residuals,glmResp) S3method(residuals,lmResp) S3method(residuals,merMod) S3method(rstudent,merMod) S3method(sigma,merMod) S3method(simulate,merMod) S3method(simulate,formula) S3method(simulate,formula_lhs_) S3method(simulate,formula_lhs_matrix) S3method(simulate,formula_lhs_numeric) S3method(simulate,formula_lhs_factor) S3method(simulate,formula_lhs_integer) S3method(simulate,formula_lhs_logical) S3method(simulate,formula_lhs) S3method(splom,thpr) S3method(summary,allFit) S3method(summary,merMod) S3method(summary,summary.merMod) S3method(terms,merMod) S3method(update,lmList4) S3method(update,merMod) S3method(VarCorr,merMod) S3method(vcov,merMod)# but do not hide: export(vcov.merMod) S3method(vcov,summary.merMod) S3method(weights,merMod) S3method(xyplot,thpr) S3method(sigma,lmList4) S3method(dfbeta,influence.merMod) S3method(dfbetas,influence.merMod) ## Re-using S3 methods from nlme (for 'lmList') as methods for our 'lmList4': S3method(fitted,lmList4) S3method(fixef,lmList4) S3method(logLik,lmList4) S3method(pairs,lmList4) S3method(plot,lmList4) S3method(predict,lmList4) S3method(qqnorm,lmList4) S3method(ranef,lmList4) S3method(residuals,lmList4) S3method(summary,lmList4) ## Auxiliaries: S3method(getGroups,lmList4) ## RePsychLing stuff S3method(rePCA,merMod) S3method(summary,prcomplist) export(rePCA) lme4/LICENSE.note0000644000176200001440000000022614063503234013064 0ustar liggesusersThis package is licensed under GPL (>=2), except for the code in R/simulate.formula.R, which is licensed under the MIT license (details in that file).lme4/ChangeLog0000644000176200001440000004336713751775607012724 0ustar liggesusers2012-01-07 Douglas Bates * man/GHrule.Rd, man/NelderMead-class.Rd, man/NelderMead.Rd, man/golden-class.Rd, man/golden.Rd, man/lmer.Rd, man/mkdevfun.Rd: Documentation updates. * R/lmer.R, R/profile.R, tests/lmer-1.R: Nlmer now working (for nAGQ=1). Updated tests and got profile working again. * R/AllClass.R, R/lmer.R, src/external.cpp, src/optimizer.h: Allowed setting options in the NelderMead optimizer. Switched so that this is the default in glmer. * R/AllClass.R, R/lmer.R, src/external.cpp, src/predModule.cpp: More work on nlmer. 2011-12-31 Douglas Bates * src/predModule.cpp: Add an explicit copy of the mapped sparse matrix to a sparse matrix in updateL 2011-12-28 Douglas Bates * R/lmer.R: Change maximum iterations error to a warning. * DESCRIPTION: New version number. * R/lmer.R: Allowed choice of optimizer in glmer at least. * R/AllClass.R: Extended and exported the NelderMead class * src/external.cpp, src/optimizer.cpp, src/optimizer.h: Removed debugging code, added methods to NelderMead to set convergence characteristics and exported same. 2011-12-22 Douglas Bates * NAMESPACE, R/AllClass.R, src/external.cpp, src/optimizer.cpp, src/optimizer.h: Tuned the Nelder-Mead optimizer a bit and got rid of some of the noise. * R/lmer.R, man/lmer.Rd, src/external.cpp: Incorporated aGQ code in the glmer function itself. Eliminated the doFit argument which is redundant when devFunOnly is also used. 2011-12-21 Douglas Bates * src/external.cpp: Added the glmerAGQ function and did some cleanup. * src/predModule.cpp: Delete some debugging code. * R/lmer.R: Updates in glmer, aGQ not yet added but soon will be. * R/GHrule.R: Rename the knots on the z scale as 'z', not 'k' * NAMESPACE: Export the golden class and class generator object 2011-12-16 Douglas Bates * src/respModule.cpp, src/respModule.h: Clean up declarations by declaring a typedef for Eigen::Map 2011-12-15 Douglas Bates * R/lmer.R: Adopt new version of the merPredD$new function that uses S. * R/GHrule.R: Added an R function, based on SparseGrid:::GQN to evaluate a matrix of nodes, weights and log-density for Gauss-Hermite quadrature against a Gaussian density. * R/AllClass.R, src/optimizer.h: Added a reverse-communication golden search algorithm class 2011-12-12 Douglas Bates * src/external.cpp: Fat-finger error. I meant to commit this file and not glmFamily.h * src/glmFamily.h, src/optimizer.cpp, src/optimizer.h: Added simple optimizers (Golden search for bounded 1-dimensional and Nelder-Mead for multidimensional). 2011-12-07 Douglas Bates * R/AllClass.R, R/lmer.R, src/external.cpp, src/predModule.cpp, src/predModule.h: Allow regeneration of pointers in merPredD objects. 2011-12-06 Douglas Bates * R/AllClass.R, R/lmer.R, src/external.cpp, src/predModule.cpp, src/predModule.h: Add many more fields to the merPredD class and allow for serialize/unserialize. Lower the default tolPwrss as per testing by Ben. 2011-12-05 Douglas Bates * DESCRIPTION, R/AllClass.R, R/lmer.R, man/lmer.Rd, man/mkdevfun.Rd, man/refitML.Rd, src/external.cpp, src/predModule.cpp, src/predModule.h, src/respModule.cpp, src/respModule.h: Use mapped objects in C++ structures so that serialize/unserialize will work. 2011-11-29 Douglas Bates * R/profile.R: More fixing of labels. Fix up strip names to reflect sigma, not log(sigma). 2011-11-29 Douglas Bates * R/profile.R: Profiling now works for lmer models with variance components only, including the case of a single fixed-effects parameter. Labeling of some plots needs to be corrected. * src/predModule.cpp, src/predModule.h: Modifications for the 0-column X matrix case used in profiling. * src/Gauss_Hermite.cpp, src/Gauss_Hermite.h, src/external.cpp: Move Gaussian quadrature knot/weight calculations to the Gqr package. 2011-11-28 Douglas Bates * R/profile.R: Got profile working for cases where the number of fixed-effects is greater than 1. Need a "do nothing gracefully" clause for p == 1. * R/lmer.R: Use the value of emptyenv(), not the funtion itself. Add ... to refitML generic and method * R/lmer.R: Use separate mkdevfun in glmer. Switch devFunOnly to an integer value where 1 and 2 refer to different stages. 2011-11-17 Douglas Bates * R/AllClass.R: Correct and extend the allInfo method for the glmResp class. * ToDo: Need to come up with a crafty way of creating a copy of the reference class object with the external pointer. It may work to just copy it then set the PTR to be a NULL pointer. 2011-11-16 Douglas Bates * src/Gauss_Hermite.cpp, src/Gauss_Hermite.h, src/external.cpp: Add another method of creating Gaussian quadrature rules. Export the GHQ class. * tests/lmer-1.R: Comment out enough tests to make R CMD check succeed. * R/lmer.R: Clean up some functions and methods that were causing problems with the tests. * man/glmFamily-class.Rd, man/glmFamily.Rd, man/lmResp-class.Rd, man/lmResp.Rd: Document the class generator object and the reference class (for now). * NAMESPACE: Remove redundant S3 method vcov.summary.mer 2011-11-04 Douglas Bates * src/external.cpp: Correct the argument counts for externally visible glmFamily accessors * man/sleepstudy.Rd: disable a test - need to check what rcond(fm@re) did in lme4a * man/reTrms.Rd: No longer used * man/profile-methods.Rd: Don't run examples until the code has been fixed * man/merPredD-class.Rd, man/merPredD.Rd: Try to document reference class generator object this way * inst/unitTests/runit.compDev.R, inst/unitTests/runit.link.R, inst/unitTests/runit.lmerResp.R: update tests (compDev is inert at present but could be activated for glmer tests) 2011-11-02 Douglas Bates * DESCRIPTION: Bump the version number. * NAMESPACE, man/glmFamily-class.Rd: Export and document the glmFamily reference class and generator object * src/Makevars, src/Makevars.win: Add a Makevars.win file. Make the factory-fresh setting of CPPFLAGS suppress warnings. * man/lmerMod-class.Rd, man/merMod-class.Rd, man/merPredD-class.Rd: incorporate documentation for [gn]lmerMod-class in the merMod-class docs; document merPredD-class * inst/doc/PLSvGLS.Rnw, inst/doc/PLSvGLS.pdf, inst/doc/Theory.Rnw, inst/doc/Theory.pdf, inst/doc/lme4.bib, vignettes, vignettes/PLSvGLS.Rnw, vignettes/PLSvGLS.pdf, vignettes/Theory.Rnw, vignettes/Theory.pdf, vignettes/lme4.bib: Move vignette sources to a vignettes directory per recommendations for R-2.14.0 2011-10-18 Douglas Bates * man/mkdevfun.Rd: Cleanup. * NAMESPACE: Export S3 method for devcomp. * man/lmResp-class.Rd: Document response reference classes and constructor objects * man/chmSp.Rd, man/deFeMod.Rd, man/feModule-class.Rd, man/glmFamily.Rd, man/glmerResp.Rd, man/lmerResp-class.Rd, man/lmerResp.Rd, man/reModule-class.Rd, man/reModule.Rd: Remove documentation of no-longer-used classes from Rcpp modules * man/cbpp.Rd: From R-2.14.0 on getCall is imported from the stats package. * R/lmer.R: Getter and setter for REML field in lmerResp should be reml, not REML. 2011-10-17 Douglas Bates * src/respModule.cpp, src/respModule.h: Change working weights to be a matrix. * src/predModule.cpp: Thinko regarding 0-based indices. 2011-10-14 Douglas Bates * DESCRIPTION, NAMESPACE, R/AllClass.R, R/lmer.R, src/external.cpp, src/predModule.cpp, src/predModule.h, src/respModule.cpp, src/respModule.h: nlmer added. Increment calculation for PWRSS works but not yet incorporated in R code. 2011-10-03 Douglas Bates * R/lmer.R: Small but important change in checking for object weights in environment rho in mkRespMod2 2011-09-30 Douglas Bates * R/AllClass.R, R/lmer.R: Use inheritance on reference classes, being careful about package installation. Create a cleaner version of mkRespMod2. * NAMESPACE: export more classes * DESCRIPTION: new version and date 2011-09-29 Douglas Bates * R/lmer.R: Modify mkRespMod for nlmer response. * src/external.cpp: Add isNullExtPtr .Call'able function for Ptr/ptr formulation. * NAMESPACE, R/AllClass.R: new organization of response classes. Use Ptr/ptr formulation to generate external pointers. 2011-09-27 Douglas Bates * R/lmer.R: More components/slots/etc. available in getME() * R/AllClass.R, R/lmer.R: Reinstitute the Gp slot in merMod objects 2011-09-23 Martin Maechler * R/lmer.R, man/ranef.Rd: *must* use lme4Eigen::: inside devFun() [evaluated from C++] * man/refitML.Rd: add doc. + example * man/Pastes.Rd, man/Penicillin.Rd: reactivate the image(L) plots 2011-09-22 Martin Maechler * NAMESPACE, R/AllClass.R, R/lmer.R: tolPwrss - for now 2011-09-22 Douglas Bates * data/VerbAgg.rda: Correct labels on Gender, use camelCase consistently on item labels. * data/sleepstudy.rda: switch to bzip2 compression for smaller file size. 2011-09-21 Douglas Bates * src/external.cpp: Added a function to check on the SIMD instruction sets in use by Eigen. 2011-09-20 Douglas Bates * R/lmer.R: Do the same number of pwrssUpdate calls with compDev=TRUE or FALSE * src/external.cpp, src/predModule.cpp, src/predModule.h: Remove debugging code. solve and solveU methods for merPredD class now return the numerator of the convergence criterion. * R/lmer.R: Need to pass the pointer, not the reference class object. Modifications to glmer, pwrssUpdate, etc. to get glmer working. 2011-09-20 Martin Maechler * R/lmer.R, man/lmer.Rd, src/external.cpp: non-hardcorded PWRSS tolerance 2011-09-19 Douglas Bates * NAMESPACE, R/AllClass.R, R/lmer.R, src/external.cpp, src/glmFamily.h, src/respModule.cpp: created a glmFamily reference class and allowed for compiled version of glmer update using working residuals and weights (not currently working properly, use compDev=FALSE argument to glmer) * DESCRIPTION: new version and date * src/external.cpp, src/predModule.cpp, src/predModule.h, src/respModule.cpp, src/respModule.h: Moved all externally .Call'able function definitions to external.cpp. external.h and init.cpp are no longer needed. 2011-09-19 Douglas Bates * R/lmer.R: Clean up printMer and summary.merMod * src/external.cpp, src/external.h, src/lmer.cpp, src/lmer.h: rename lmer.[h,cpp] to external.[h,cpp] * R/lmer.R: Initial iterations in glmer (the nAGQ=0L part) now working. Later iterations still need work. 2011-09-16 Douglas Bates * R/lmer.R: Use fac argument in call to sqrL() method. glmer now iterates but does not yet converge. * src/predModule.cpp: Add the - u_i on the rhs of the equation in the solve method. * R/AllClass.R, src/init.cpp, src/predModule.cpp, src/predModule.h: New 'allInfo' method for glmerResp reference class. Added .Call'able extractors for Utr and Vtr to merPredD class. 2011-09-14 Douglas Bates * R/lmer.R: Modified glmer to return a meaningful object when doFit=FALSE. * R/AllClass.R, src/init.cpp, src/respModule.cpp, src/respModule.h: Added methods and new classes for response modules. Modified names of .Call'able functions to make them easier to understand. * src/predModule.cpp: Use d_LamtUt instead of recomputing d_Lambdat * d_Ut * inst/unitTests/runit.link.R: Modified link/muEta/variance unit tests to use a glmerResp object. 2011-09-13 Douglas Bates * src/Makevars: Add more explanation about the -DNDEBUG compiler flag and when to use it. * R/AllClass.R, R/lmer.R, src/init.cpp, src/predModule.cpp, src/predModule.h, src/respModule.cpp, src/respModule.h: Many more methods added to the reference class definitions, as well as documentation. glmer is now working in the sense that it doesn't segfault, however it is not yet performing the calculations correctly. * DESCRIPTION: Remove RcppModule specification. 2011-09-12 Douglas Bates * src/respModule.h: Clean up calculation of working residuals. * R/lmer.R: Still working on glmer, not there yet. * R/AllClass.R, src/init.cpp, src/predModule.cpp, src/predModule.h, src/respModule.cpp, src/respModule.h: Added many more R-callable entry points in respModule and predModule, incorporating them as methods in the reference class definitions. * src/Makevars: Allow for suppression of assert statements with -DNDEBUG (R CMD check complains) 2011-09-12 Martin Maechler * DESCRIPTION, NAMESPACE, R/AllClass.R, R/lmer.R, inst/unitTests/runTests.R, tests/doRunit.R, tests/drop.R, tests/extras.R, tests/lmer-1.Rout.save, tests/lmer.R, tests/lmer2_ex.R, tests/nlmer-conv.R, tests/nlmer.R, tests/throw.R: more updates * man/Dyestuff.Rd, man/VarCorr.Rd, man/cbpp.Rd, man/getME.Rd, man/lmer.Rd, man/lmerMod-class.Rd, man/merMod-class.Rd, man/mkdevfun.Rd, man/ranef.Rd, man/reModule-class.Rd: considerably more documentation 2011-09-11 Douglas Bates * NAMESPACE, R/AllClass.R, R/lmer.R, src/init.cpp, src/respModule.cpp, src/respModule.h: Added glmerResp class and began glmer function. Still needs work. 2011-09-11 Douglas Bates * src/predModule.[h,cpp]: Wrote native C++ L() method. Somehow calling ::M_chm_factor_as_SEXP was messing up memory. * tests/vcov-etc.R, tests/lmer-conv.R: Test using this package not lme4a * R/AllClass.R, src/init.cpp, src/predModule.cpp, src/predModule.h: Add capability of extracting L from a merPredD object 2011-09-10 Martin Maechler * DESCRIPTION, NAMESPACE, R/lmer.R, man/Pastes.Rd, man/Penicillin.Rd, man/bootMer.Rd, man/getL.Rd, man/getME.Rd, man/merMod-class.Rd: getME() for all three(!) versions of lme4 -- deprecate getL() where it exists 2011-09-02 Douglas Bates * src/init.cpp, src/predModule.cpp, src/predModule.h: Drop the check for diagonal Lambda. Cache the value of LamtUt and update it in place with new method updateLamtUt. 2011-08-31 Douglas Bates * src/init.cpp, src/predModule.cpp, src/predModule.h: Finally got a work-around for the "pruning of sparse product" problem. Also added a diagonalLambda method. * R/AllClass.R: Add a "fitted" method to the lmerResp reference class. Re-arrange code. 2011-08-30 Douglas Bates * src/predModule.cpp, src/predModule.h: Drop some debugging code. Isolate the calculation of LamtUt to try to find out what goes wrong in there. * R/lmer.R: Update the ranef method for merPredD storing Lambdat, not Lambda 2011-08-29 Douglas Bates * R/AllGeneric.R, R/utilities.R, src/init.cpp, src/predModule.cpp, src/respModule.cpp, src/respModule.h: Code cleanup - remove exception declarations, use specific 'using' statements within blocks instead of 'using namespace' statements. 2011-08-28 Douglas Bates * NAMESPACE, src/eigen.h, src/glmFamily.cpp, src/glmFamily.h, src/lmer.cpp, src/predModule.cpp, src/predModule.h, src/respModule.cpp, src/respModule.h: Initialize d_delb and d_delu in predModule to zero (not doing so was causing hard-to-debug errors). Remove exception declarations as suggested for Rcpp. Make declaration of short names for Eigen classes and constants namespace-specific. 2011-08-11 Douglas Bates * src/predModule.cpp: Using solveInPlace to try to avoid memory problems. 2011-07-31 Douglas Bates * src/lmer.cpp, src/predModule.cpp, src/predModule.h: Trying to track dowm memory problem in the evaluation of delu. It looks like it is in the CholmodSupport.h file in Eigen but my intended fix apparently didn't succeed. * R/AllClass.R: Modified according to John Chambers' suggestions. 2011-07-29 Douglas Bates * src/respModule.cpp, src/respModule.h: Flailing around trying to find the source of the memory problems. valgrind claims there is an uninitialized value being used in a log call within the Laplace method but I can't find it. * src/predModule.h: Remove unneeded template keywords (caught by an old compiler). * R/AllClass.R: Realized that the initialize method should return an object. * R/AllClass.R, R/lmer.R, src/init.cpp, src/predModule.cpp, src/predModule.h: Switch to Lambdat and Zt and the CHOLMOD factorization. Special code for diagonal Lambda. * src/predModule.cpp: One more attempt. Still failing on the boundary when the number of nonzeros changes. 2011-07-28 Douglas Bates * src/init.cpp, src/predModule.cpp, src/predModule.h: First shot at a version with the Eigen/Matrix/CHOLMOD links. Compiles and loads but not yet tested. Checking in so I can access it from home. * src/init.cpp, src/lmer.cpp, src/predModule.cpp, src/predModule.h: More getter methods defined in C++ code and reference class. Remove some debugging code. * R/AllClass.R, R/AllGeneric.R, R/lmList.R, R/lmer.R: More changes to use S3 methods when dispatching on the first argument only. * DESCRIPTION, NAMESPACE: Change dependencies and imports. 2011-07-26 Douglas Bates * * initialize this archive. lme4/data/0000755000176200001440000000000013751775607012046 5ustar liggesuserslme4/data/Arabidopsis.rda0000644000176200001440000000560113751775607015000 0ustar liggesusers\[o$GLO=w;$Őd7%($XI 7 iݘxm3!^@H$@ xG #,]OWrz6KHgԹSս]~W._i+bD?JU=9wxXWtŵS) qH>Kౙ_>dž4mbWG)ۧO72%M^Fߥ.}dxlcIϦ/l82s*RaE\rߗ6F|I }b?L:'y>^d+ժ$>l}emlяGNO-N{kߦ֋;g1M=#xc;9ٶ1qaoCɠU$ۂ@8!>2l>r}Ĉ!Ôʼn_3=C GGKR))eD'c2P$3UWIqJ}-5T&Ϙ cS&9/c9ְm23&7p}8n>4M!{7 3Lc9C4R֎ Ho1A61y4x!W՘O-}EmEEnsr'j#N dzD$sKUs[$ ݓ9TUcrl45hzkcxLoeNvq3)bWοD}0ZZ')/-Mɵ1tV^ nLKdH]}/Wt)x[wNӵ+,0_: ЭX2`ks X6 [Ss>)E&* G*m (w^tV@3yI>|D00:Ka(O1 y09\y"V@xtB%[vt?'^=<`}_M(n~DJ>cDjqم)9Ȱ fq4by8p kç\,=`rQRJ_Tn2PNPN/` `'kKkX(y\$#_;ٌ쳥zFbb9)z[}0FK4!}Ycn{\7"|";3;\`}TKV sOh1$+&]h_T=3=@ޜ\/}/C/FC  C/vmtcl>.Qd<:"[R[J_; v%12>!Ko%4\:G*_i nP$)w!DYĞz$P} J֍CJD];Iy\{> hrM 7w_u= {Hbc]en~oϳ,rJO!yDo 8c(};W~>i.̓Pr8" }5DjQ˧z;=|zץ/NV{II|#A@B{:&`y]C6}zw>熐}}v<7#dc'/$@B4C2!I%qw?3a($It =K2 #g }8Xw83ܒ>{Hޫ}GZ f;i]sVߒ U:YI꭯FHcMP u/uuܶNCGۦcXtL|a! U?ngʕ>^69]GB7j<Il튽+Qa5?T$ާgy !^6~}]yuK^_= MoB(Wlo7i|KjOG_]=]5NL+:) /:o׎0TCyK[ִn1z*h?Q3_  U~Ҭu.Sx,^5GOTU؀'\utCλڑ0С)MМg#0,/ײY_Gem @d~>vopYGS:MM:{VGu4+/)? ׺XyZ+k|1S}wK n#>M|x6C2cۀOi6ѼzPG<>yy^|}zvkȷC t%|𞚮¼ #O{r^퇠e̽5Q߁ <p_o}~[W?M@,7 ˳hTeTտ s05:FLƣt脺o{<} ]$Іdv<NNq7?9 oO&ǎ]gp2,P I[÷I%g?o7jE}?1Qlme4/data/sleepstudy.rda0000644000176200001440000000307313751775607014742 0ustar liggesusersWgTW^V=D#h J4ذ+RvwJbK`XD, HTX*j 7Սsw7}{ΆzZZd2S-yܔD!  CB/l|]$@,; B.*MPB#.1ĽFߖvК}+d]J'f!#A "LvK:[nQmXyt.cYMO5ËoWjLfW<#LY@t]2oH8k2Ws-A[H8]mVo 7݊65G;Hg2 ;l{ ][\Ѿ>>,ks:&Vk(+ 8q?p{źsWz[U@{ꍲ&e`и=T]XzjVC]"غܟչwm8oL*)Z8ϺB2#B?@dK7 A0ad(kǰ$+`<:=-ó5$-*-gAL ;$}]hG_0+!{DX_ E/L`N ~q?FB>X] YLdw?iTwXhmn@ UɩW^_z}WL&a*fa. $B",%J"a- %DHDc&T"*N _ͼ{YG?4^FYфQQQQ(g,*!ďOUDK5 򃸙UGQûy"3#gz,A?ȣn(hVKST\ݒ k lme4/data/Dyestuff.rda0000644000176200001440000000043613751775607014332 0ustar liggesusers r0b```b`@& `bN pL-.)MKc``c`*dALX03̂bl}l9e9@THp1a pC359'f$ܢ" a 8Lk@36@i(( 3E3POjLߴ'P 9k(i{ } &&SbIr(\@#Bh!ϕXV lme4/data/cake.rda0000644000176200001440000000133513751775607013443 0ustar liggesusersXr@^OX 'RP,-Hc>W4iEiˤ>3|'9ehger9ۓN$'"IIS$$ HIR:%VaK҄&d4aIhBVr w5aEV5\-Q%]IvJh#OK9" V{7bu"uZMGu'd\&c7yԸfb>a {M k\>(K2FoFo7 #&LF ƴNwafY0-] #L{*ђؑKtCoXc$!|R@e6PpуdE @-M`Cn bc:/;w37Go=<(f"C\A )f5lxK϶\詄.[3 {/@gv9?/[ηcW(~qۯYYOzSb~O/MMΟWգ?EjZ'$!JvD"hh(K#: :$:":&k/9c"o<ڀt/W x<@ C`0L_bɶgRtv0_0 #oö3jiaܢo;@pxXf1emw9ho3r;NPrpʷ{Cy2\0e>IIVbwYf?\u lme4/data/InstEval.rda0000644000176200001440000040770313751775607014276 0ustar liggesusersBZh91AY&SYѤ"&?xP! (Pm@ ld$ж6,mm$k1*ւZbAJ- iEcm)0[e) ղd5IkB5љAhTٰؑM j5If*ж-%ZmuJ ueYdiMClUePJklŬ 62-b6Z ժHYDvZيmZūk+Erk4Y̶e@D(Zf"X6M*d0V͘[+L(5(i! [2ZPƛ(RBH(PT.2@HR P@(@QDELM4`#BfL#F@&&DmCA7CHƈƃF4ʠToU*?3Pi4b4ѡɀ#L!ai"&FC d`bTT2Ꟃb)b {Bia='SCFM4<6hb#GLGM%4!hѡ0C4I~F~##T'mOMO)!#=Oj6)CSF'T UJ?UU@ h4ѧxS0D?oTRT4d14l`@z?Tb dhߪ@F@@e2d;"TȽb) L@R BTPHB9a%B( R$ZȡRBT! HLB@`T1$c%BIX,BTdbT  *IR@TTbAH $BH(%I&0 @+ E(@Z1JI\d +1$& b*Hb&2l )$ LB#21$ E(B5RB TTc Lk,dYT Y XT!ALH J`$r`LH \d!rVA@ b1 Qd+$ BT%@%H(cH .R+*md,1*2I,*Bc E !c!*B@$ H%@@Y BLa12%`bE@a °RTRJ[i2I@1*H&2*b(IRf2b@XFLI ȠbH2)&2@%`JI`(b!1CpBJf!SP a1b,1T+P VI2J̴PR)&&2Lf$*Ɉc"JYIPE &1Hc2TʁLf$T *A` $Rq[ +$ c b³IY đ`C & bLJLI cc eBLH¸dHV&2d%a+E$*Xd@I ȡ,0Ơ(T2b @1TJ$ d+ T$&$$d1 H, P1!'p/E+۪^$@=%Vr/cޟ]_EU]R gREdE!X rr1!Y J+VLIRc B)[`Z&$1$Vc (ed G,T$g$yu>`&w=:XmbxTr[`R;a?%X\ K˶nM:mʳyxH+}'vXxN΍gH,2k}~\j# -"\RR[3|X}efh]\e{KY&~_ Zz{OMEMsnv_::/~(J%J"eWJ$czc0s/f9Ԓ{]H:}F}8SOIt|q!7Q=ǼR2^A>G='q'׃.=G]]Kq:{}Nu/#GztG>G9ԾK|FGtqt̎.]Hq>3q/n.$ÇOIu:9ԺsuȕuoΣuĽ˩^|8>Hϣt̎:|$Hu:ot}}`'I|Kqu$ΡK%ԗ0q O9]KӯIO#u'\9Ԏ%N{::rI#D7đ%{O=/g0q.q:c闸#uԾ\z87qu8=N9ӝ:θq:pSON^$sÝ8s:uqu.t>=˧OI{>@$׷>^u ]I{gӉ{G:q{.]Hpt˩u##Ϲ=R8Ďtg\>}<8%Ժq}Nu>K= 9Ӟq:8Q\^䓮:d:=::t>#XtθQ=$z%n!t{%KG%.q9$K| q|sێNt.s9Խ 7̎{q%ӝK:Oz|8{7O~q87Rt=$|dLq'O~u#.'LsGu0˨%ӝKۉ%ԓGΧ\N]Itq qq3G{z|=#uC'\H$7Ntק$|1n#uľz]I2_pI8|N>:>~.d=g$}8tGt'^㎸Ν={3/=9Iu=I Ã{: u'G|o:tӮ!\9Ӌٺupuu]9:2uGrN=$Op=/r]9N.KXY^}8q#:ˣ.=YeYyQ$H/kǶD ]onˏ;C ץ?;whi$$k.[V._C+į7BN'-^U^E͋ȣQյ'EjEkءl*}*Ҳ:;˷ 2k>FYkiljҼçeKX둷AHoY͹5-g^!5 C}BEbRϋZЯyyKZ 'byqYcȎl:}ob 0驋OgjLCs'znMg҆-ͽ|#T&HOHb%uy_yuΐjk{lSus=G7ITF5wB5_kg$8\Oǣ:ڮ?q6 f+F:vś?jӒOKT[ՊڋCnWSu'Yagyy1u:Э(ӷ?ͧJ;ța&Gjtfϯk36oowѵ>̢̛y^u[Vȹ'7R۽gvD/<uCэ9{q{&lˋ^..R@d{ ɢ˽Ko)ݝX%.cϓw^F%[J͓{E{ZKVnsqlOĝ7 }ß^T;T߭X`5K:+vO= 5^ xUE [0 &*tα̩ ֈi82ٲ`kO3U4IΒtbJ,:yzp1S翁y G/)o0+o!=\0CɩDVL([[ѱ|+qMu~yð4߶ nAB7)q ϻoZC#N}OZ2ncIȀaO;n j"@:7,9:OT}V@أEߚ ϳЖao\zGԨ{P3R/o+N!w0m[1JM0{$?`D1SVK.Z$k7D(ZUA}5]'Q^T ؎=(u,~`@b]qmP2[*`wQM紗q[uJmmݾUG7vϋyG{^4χ1C8>Cِd8HpEXN FAvw}nf_oֿ mmqlI'un FiÂV{:fij\A1 GNn4ėc&btZYw^ju*خUqB[yfm)6#:}KV1^b&݅m{IMDXSfq0B^d)Ԍ(Yj y߉H {n?e2ڈmgдxh[;?F%Ğ;w l2Nc9C '9= $ds'$s2Xĸ[V6.LYٽj5*QY qkr0jCv;Z2"[:3+]6nU~4T*H,GJ+];Ocb%/ƾYԓfko}݂ 3L}\cLbOI ^0jcSjŏ;iM΋gs_^\.F;m)ty_a5}Y'T\p'0Nkt.p_J]\, A_fsSt? ]JRkJ*?#OZ~GF?KQNH@ !#CLH[uj]d2Ҧh[J0R0p-],$ ߓښ04zNξ@@Vs_ ^1qwtTfABK/y'߂"/E/Q CU~ >%qO~W;EI=QbՏrۢF*zo I% @ AdyD6*aOV-vRjk/bZm.,C&"DYۗpgq;i3Ad}9+UmzQ@D 7ﻺݠ^y .i ,=CK i$X{_d Bg }M!AokEky'XJ7ԄpFctԙc')PBSbd ˲gS"g,´nUp Jp\LUerSh/|v$%U"KQ;-ܒHwx4GɡRQU6wy/«'`c'h,?7t[.iKcgK Zщ[)Aeh!ʛ>٭nsO͹c`u R '3s0䏎n ]_kj^92(6xveƊ x)4CؤE!HvlMrt>S ;.^0{L&5bJq˵dGJsnvW{,܇\M woxkAƓݹ+TfYũ~WkerKqָw QV|7(:-zsB¤ =_S1 2'ၾeHzPE D$!_ai>T=M7 ==r>ޞ|=s*^GyLspo{j:uA#FdtC/=kCǧ@QEL s9E `arn$Pt&F}GEߠA:7tE$)@>NJ2|u{ >QQDNLċ_DEG\c>ޮ$'wbUڥeeS9ڠ^i2UL%Ms9I_+ԣ+-6pp09>2$FUk.倴-wVjCddZ@CuXB:5IS!~h室=Eg) "?C>1m0=ZMаGx]hCOnC=m4!&|"s.bxZ86^uwoR@}$Qpbn@$RC]<`cTIr?pAZxzϙTZ`㶹iQ8&IB@EIJv((d)J4!E]&}2u5MYP;N#kva-tZwn9 b}$"ph.^w@\Cu*%2`jr}Ƣ;+&%b[C!DmE^97^ԙ\V{7MSLt4Xmim')! r5y#38E& edOCsJg'`7Kc.j~4{x̔C)6&!5I&߮r;KNK`J$A{py c,.h ⵓC(bݯ׀9P=R7 WNꃝ ~ 8M@l/1Z i NQK Y2Hp9qP>u˷3iZ;po^:ͳ %e˺:x HU\ _+_‡gӡ'8p~fkE$\aAjL-OtvOc/-&K1Z?.sԜ"ۇ.)J؝H(N$]TY8H6[y ur:/8]pr/3CY@ H$7mˠYNX"=򒥣_3]uxtv68H a'|I+-N_3Ng`*H:ϟ57][EϕsLj2Cc')Ne p9Wz@f߹Yy0- jQ[/"1_ qgey$3Q8C !Bw@V1:(vX1E 5 ,Y7tp$tV>ٖä&ܼ5f~Iu[lXo=鼇72S[1x#l8S#o;Abw٦!kPFei:;&>1V2neDGmgk0:M42etgm<i7LYLpGDʹvwN$Ne9Mhf>ɥ0Df9Xı,@PTV TSe%T]-Ue(WF'M5a(K5W~a!m3''$$*w/vmēyTQ_ iH5No~_ÓDwKCwBFgVi 4ߟ$<)tU`{9hrQ@b;^I; j($dK`;@Ll]#1%=w$; ޏ"q9 -  M7ٲdK Ty'򽯳U=(fd1gGdc_A+qH#F 1g@ĘO%CDbxlBT($)$3;/9[JWvۛ6/Ol%x`q*ݍ{q^AQaA8E srz Bzc 4R)DЉM/coA]. dQ`L萇z1Hq7%ndS9r{0HM;MCl:\2 1zMр)Ø,$"}aI}4x 9%[`H2Wdm""mq a{|_]0 ٫ajn{ j&2kd TxۦALُhz3?)8\5E fF}yΰ]{xB.*pR̈tI&6QI#9 EŠeD0kx2͂ˆ0#G9|#LKYݎMMwȢQPds2:,E(Rj y+ %sD ua"J)GP,T)\q.tg'Aw٥%Cb,e35E3ZVc*W_rׇhU˜!8Xs 6h$u7_:"P"2sΏ?p~6߄ iynہ;N|*6E S²ES3%k;$_M ^dD;a[/xt"' 87#s |+Y&6P4{TCLDQkb2TF9נ@P=dH_Lot0x)^ DH٧C`A>?&{EUeHi*~lCy;*mdh&hˏapĻWRt80a@9gI}rO0UEOd9\1f\r?bjr ;"bC1b&L>"vy F^63/081 ô7lm9vRNׄZ~QY;N#6Ɩ>%6hr8ڏ ?ikM&=c̈́@H ;Lܙå7}$d`I!Y.g&ՂT6vnYgud.-]vN@` wG2VE"!k!=V@A)@~jE@S%AH"gο;P}.o;Χ.V,mJ-VC3L01ЙUrԤ"fMR-dl6}][8*Yk X ,Ő$YfHvvD4J,?Ђj:ݳcpC{%^'k5m+mw2u"* dc&*ez{~/<r _C}ܫ_Ovt*6VWQEJwuΧ WgXŲ@޺Qv|ϫCm L*~ 1e.$;sRIXn]9TE3f^=K%mSs` <(u~òszl!q]46bPRM*wkS:52(](`}c: w%d'0{4#kRđΰH@6f6H >t[.ŋŸ}5[?b&v]km")CQ26uO)HS` |5_y"#i{G` 5~>~pDIXBC/ {t5":4E v2gutOSV_=i~$P1AtYFi)]/oh~;dl&|!z OwqFdIV96EӽOYUyٻw7c[7/95)r9&7'SX9 [~#y|FI+Wb >#GgR廌A'# i)( &I)+ZTCnLft((pJV~:47@G۶ͨ$qQ "UST6$&Aa>ħ]zzy=UpY"WZЀ6AP 3!1 /^p7a"7Xwj_~_+w馌!r8 `0-|?9P@2:J1S^{mmn`v$x"FdB=#E d`0v493GM;ώꧬ)` AHCaH" 0P`*O~wZx"?>m3wٽxݧVx*(*5D(P 4߳N609S5E9hoY4```r?&ad.߹۷{$'`dZV=ź2,Fau@rµm*bI?.|ʲ;J9_ek|Ӯ|ɔD]Dgh2PGmH$zzd K/ [pqTCкZY6!۸pP!H͒!4^J{@E0~PD\ \g(db[ˆi*E '&PْjE[%5d=d.Ң0氨ABEyoN;o Ww'd&qa2k,Mkܠ$cAb:OYJ _ϷU|h|Cǎ?yH>h/ LQ;Se^u,ړC*}FZ|n@ ŋ%M:xO OYE\c l>!It@d"2b154,Q8Lns]begm!'P8%Ax;eM {[8[$`~uߞ#ѥkrZ"3!8ȨPȊ|$fz7$ H%>fY_.A^&QsGp#)Ki!i7 0-"@Ը)[@iI9"$}6PH!v'$~ހ$݌`OrD݄>P*"/ $4>?Zqշ8ĊmfF:cu{1u }7m. =|kQѧMJ}z4}U?v*Qsv~ a/G1H@`Q1ton Y?#*GrH,@RYPlmFr~{` #Lh{C+\5t'\kB|[sKD69_[?]pmGv 'ojx"O+((t:I= 4h XoCjl 0`n6 'J]8eɶӦVh/GzHۤoo㰼+~Dwn*FU`)!D0g#d2Mj-LB*@.z6[KO-7n,YHCB?QTe $j/ &{*s#|q;zGxGXղ"uWHp'TT e;>y<۟4+?/o^B=j"D mv`-tbnjh1M$\w/^{g+f`sr ЄpL%@QQUyǡf=)7Dz~$  lğ‹:6#, Р-\ovܺn^BsbXk jJ3=ЄY SR'|7M=kt7gd9rEs{Q؏WKsqxuWMon&bH\EcJDwRL0 g xmA";q`Į|m0BP! 4H|E !bȱ~~C{fmTv =WXpiR+2#< (Fv)"؍aHT!;пM1K +Rʰ$iK|m!$f_AF3 #C[^*_DL'|Nڎd2m_pSXn.RX9|EƲ{ nvڇGh 6s t=+>(8RF"rn e`F&QvT)$5TtY uJ) #`^PRˆ`b5Ztg:=ItD.3Pk/d~Dl mk+_C"#IK IA@{eoGlOfT7QGOƚgdؿ(4"ї'mzCgϰE,8L/aNU'/k != F" PD_9!\0A= Pt:N|m4^ &Ow$^0"áM}gGA'3puQV(Mid&8</3lPj#I(N4 ˧J[*LLY7r6vAĿ̔,ܝEn(Ňk <h{ː/H4r9|WwI>18^tӻ@'* (Q4= d 4Q YPQF\(ty9-*HÕZ-Og"86txB馿ڷQtdVEȚ6I^=@漢>c?'pVho5ed Vt2ņl3 VIx#]!r)tP㰹BK mSe$,.xEvZ&E4p:j#uGAC[4 VK_;8;"Xz"{E*.$FI'SZGX׫uߥ{P0 PњȫRS˵ʼP ZBϊ͚p<N0Q`|E$ )s? xՒ(YE3-\H;o19NG]nh2 `KB+馜|ն\$ِ rnb>nф9nϢceJX5<n,\a(VJIɦXt(4LA4Ѵ_X)}eaP]Jҍ#K6Ƙ:=&cK\ȣP Ur5:THZj@Fz8w}T)n,"3)wM#V@Eܣ]A);N? yk.e=)i0@ۇ)=e('ːpN r^Ӝzl֡a[jw {3 {Ȑ(Cdnq1i XS%"i) @,>ف'C@ 0|{.;? nHsMd:9fwf&^GՐL9Of.u -)YIO#`v$ƯwHkRw'u?^~ ㌹ zDLԘR7?@QDA }i'=O0< ~J g vng *PLDhƙ"9񟣻C0+H ;r S`f!)?t-9;H w7\svğ}ڢQGs6`eDIKy_4j n_K =J8㊏D8YVzHL>V>R /|5SdmJ' 0P|D&D _IrƚZU-Nd4xtܸѧIW7, t)Ztj[% B3UܭgCi7BAe5qJ,D%>Ul5-y~&W?I!9c=$3X$4?P2X!E9 jLF.~w\㿴& xJ 7T1e\;%o"ꚘpEz֢:2I&Q O t`%#i1)GNkqB<9#8-r(9u-\زe-C`?RЊ/!mFamPV 8>1g9`)\dI$Q8E1PσId"wl7iS`SrQf?7wIIeV`:\ rWA3@Q AUtƵ&lKCbD@[r/\Z! [6Q$'sw:HlƆpdM*j`)&(稾 n4(/9Z־|x k??>j%$ЀWwO vYc#VؐA@Y#p -mt"/VK >A~w'yvn5l6MZ"L'KF˗S'o_ 6sv/@YJX$Ġܶc̋^¢hI*W >Oaek nLE|<܄!'>O_|нΊ>XRQ!ʈ.5zvI iLc<;W(Eb`_ `8muo'P8Bb^iXp2˯9[7k̝t}'{I 0 <"z9"+3 r1}'= wV}rȐ5D<dd`6aؠCIB3(`$""רvZb|:97!!Ş֩OhbitJ(W=½R"EW,4U z 87NB~.]f̫K@P;H'N3 !7:7f!Ⲋuc}v~&9.N1:MyAI!tPRhbZ! C`N]Ujir9XJڃ` FE;[4pٳYnЙ-6HviJJ.w~'/w*?!:sՓ,ObQ;S&V&~=Kӡ]զd&UPl=QK $lT Cwv1"Pz@{Ew؈5ʷp iz@ĚbՅ( hQ<\ kjh/ŹxsZћvWIt4sS@S66(BoV7>HFk~GoϿBm(W-tOAJWO5rHzlݯdusO@@8!A*|J8vb'#Q|f61+w[m!?w:r4갹SMhҢmmܓfwexЃgހ#9ka̱읛 d;~rwĚ.,s$rRq,;?! ;x)M??:=.A="KkMw9?7 ( 䲑Y2>/aRoUY;p"ҋg/*FfEQ`Mm#0k|O"D $}tI"z(t|{]enX\z s$#M"&W<WCȞנvLIm@'.`,p+Ԩ:[D'ydN} Ob;3۶} bஜ8nx{fQ@P\]xwtIZ{B֠=qIewտse}ezLG'.Mr5S<7#? O)cHZn_ʔhy Ʌx(pD  U؝ }iXwdS2;90{lnz3""v n (G3*JL5;YI0 |B}ievPd4&- !EAIɣNo ;1mY'2"<2N>oA '*D`>BbsDc\<ibOAR.Q{2@@n?5 ~;#e7ē5o ~*>4]yGO$^2UwjK_}u;[O}w7<\-xbPdq=QCR{=Jh璚BR4U[k'K]b$LPI;OWan/yͅIE*r ^6]=@9N_, ʟbrE3. = TR|L$kD{^]9X$hᏘljA .64E Ѿ-Pxw $CbQFJM`-'k^mnvt@æ!m!tG =fDK=~7nFƕiNdw-1rVWYӻ|Ŝ"fC$Z9ϾZ 7è5*iJA؄.MYD_|ijVCAsCws~Xx_ wrAau;El=a] +/BOH:ԓpWp[B Wj#q:0Mg_swl)۹eez yj! v$PDتFϼ;-Z12 ґ``2D'IN,#܃,/^92 Hh_&Gy~&UI> bwC? r gg:<)u\O6db/s^^~ϝ`w{H8hUPFA,e]E# " 3V}"Gl05ޥʘ >*xy \E.\ol?qg ("nЭ'n;9`%.BpPgo=+$s U8[1:ƀ3QA8f&w^$Poi`GoHnbYH@խEKf)K5C更}_+o$^^5~Jp{䡜ص])dǡb[_n+FQ{Kie%e|h$jkٷvY&wUd l۫P~7/cSDX>=Owc/E m*QHgcdDI<ܖ>2H0ib#tw!2 <ě>.C@햷i<b?DX2nP'>O̯k/szB *b5* v,2955{?BTJ%Rտ˅7WSfrP$ȌD e6HՓ'oWN~@h3}#\Z~nesp==Z) ՄH9u`cN2~蠀HeI}oPRjJCwz6%ssxyjNBuvv EAG)`.{kGҵqs-ڈKeQT:mDIH_OhJΈI@",&&RuEP$6 ڐR@U3^*0T$4H C [i? W<$ 0RCjy<~}ZFư>~6{;B k`k+{1=F? .[gL~  &NO@k ݆׿Xa%So N8NI^xn q YDuB,X,nD` !ý<+JsEy6r9@+;R_ \{N[\<83!:bFf^l/^˝B_G}/j[ zLm[Mc]ٔoe; Xd.boR:siMLi 2H?8dZ~]Ǽ`"KG̊^7]!u}FZȗ"}Z9ߖs+4ti]4kpFv/in͐\aZġE^FՏY#"hg%NT@Y" grd/7llaW{ DZv?k?@.7k|M>H6S1+-'sç \E٠ LppECOOj}bP_zֳ"zFx& ]JB~N\A@$P]\!bg?̜_@ml{:/,P]IL;NkkCruVg8qOA;:pn_ @8&#J;s/jtiQ9sֻr-|)Obtwl){]6va $^3yMuutw!i{[3/eAa=`bD-3$0h /9 pe<0a˗F u- knws~"iW+Fؾor9j(G&-H h Pv˃\ P>;AH(ģH%2}JMn C9P2"A!DhEVڦEyHU9lB(lI*x d,98LL`aa7s!3GS^bԑ< ϯ/HDWPPOkQ%h*I4LفnU?~:O >@e4`Q^ٙ{Hr#p:ݖ<$ Usdq7* YX(s?2S߹ L2z]_ ;nTC5PO"dZ^ރ#L!C|Gk>wi? $I֩a| l:)mIC ۦs>_yy̯Zr2݈ tˢ{QH%tn)5:_ ԇ)E<#o{~~ŀ6dR "UMNPs9 Us1oRc $K{E|,YA xe>'D |wp.BR\TUOï>6QWY@/ ÜЏFAC&? .lMo ?eaR{t/w$vAM=^V10w ֵr79 mC 1d*~;ͿHs0Y"齛Zyd$p\ld#(0P ߘI#mp;{t3ԟrPgGHF#'! LdO 9$߳#~f6(1ik4vÇygD ڮgT bRyjw)&,9§Imǃ/BݳmVm|d׼9pT}(jQv ڰUUyhoOȉP 6 x`%ْȄ]N͜-=VI?\ᡬw :|8HAeltbKZ;WE69,|bf#SU;H,N-stCd-%]h.B$@)ۃ~06{Q\7j ä %a(EDmsŹ,Dv(C#BǼ~}FTIA|bTȡi7ZDV5T 4Cj_M9;5a7$~nÝdWr\ֲL'H+\F x>#o'K^Q(676хҜՏfH9Do ǵ (Z~Fǔ$:Lo y_LW5uhb~ɦ@(=^?xQ*,?cV;?WMa^%OW8 ZAixdh#Oԝh#^I7$"}r d#5NOɈ$\[r"F +YzˁXc]Lhkl묆󞍒C JJ)tِo6ʽ_&)s}LJ!.I"R;,OBF tSQD(hn&:Pԧ1k Y2w P9솢lI?z^0 fv9HzJ"(9_Bݘ_Y$ p!HH3B"F'Dܠ1Q` I =I}gCa FY@H؁SۺpQ<O;5Y"9Cq"Oi/G9eyBx XGSO7{G#'{ߊ<>Jo*(°gK|լ{l*ID$ Opaj Sn7!M.i[n?儓rdf{wśb~D'gHʜȨ"=FBgy&(F702fY G:Y0QV(M~{%4/ٍjT7Z{ICo~sL͋'ǩ rGh w艟yK@A${mv.W5\a3mlw[: })"i]P;X̱műX 1|?t] Uh'y]N94S|uٸ澟~X;p4 $==B:xw;^]$yAUE ~jkEljŃI$S/{|)L-.?j7Ng !8iVtŧdZ }Ydqwe+e\9LikMjzn8gP݁1If.6m{41ӣd35Y.fh %S9Faj&[A- @ | _&'xi:PGRJ&bWquDOzPuӵtĢ1E 5EAE\'A\p{Vo@To+ 2,:;Tk*K:1CM H5[N({$OxRkR $Yh9 <@$2]EcE/s߳:uYxgd{Jʬ/_GK71>bg**,,„vQu= E!)IXTJ/QT9d0` Eׂ/|*9?ʟF59dpfBuy@CFwm SOBBn(_ cqGn^ߊv IL,V(:_)rkk ފkxY7ЉNd/2 yL?[CGZ#d{ Rį:(tf6'TdMSy7}RC;pQ&9dkV 0!lԇ'9_U@=ͺ3mj^6 W~k(۲[ @}I;/ u:[43>N5@۽6#Ie2 Pe@$A9)=SXptL T`&o~mI=A7]f.q D'ꓝ'L9$ "1M]ߋ 30hq Cf)d9ey9 㕛o@cɺw-X17_!aC܃[|3]Es* ynwqL6 3Ea e_$ cHnXP8'Ԝ˫ӂ`"4qiԖqGYmxa.hmO5i8Ce:&2 KFɬ罃 D `c{PD E/M/H?oD$܅$'ߪEOuљBIIcSN MD<#02 ͺYžT0૔E b+I ­s||쵌@y@EQ.[Z"^#͑x^r9JLMӒ]lDY %h[(0#rTVY+[d6%y9^jn#$ߛ!8hl @]cY`+ l%YJ`G941&E|Q(;}H rL;DX[@Eۋ~Mɑ)[b -7d,4teLBӳI4bQM۩XY+nNRZk;8ٿs 'rQkLɟ9Pa5$i8)|LEOI ]?('*|q٤_ܬB;(m7МtV~X)Px:!V|Z/ri6޳}IH.Ab3@MPQv  {%0ax' Xwr_G!uj$BhEDASOq뢤ue^!U¿7(( +PE((D o_173 aDId=CфCú@C]}{7MrpQ'7mh <:VVp/j|I!:a:+B ?Eg+V;ϱ:HD0B$=e|tRbM6LĄ ZR`*A,l;T0`w `@d eInߛ|tZh@t{5'q pt Ugd/GѣIp2frs,yB|q棧_AR"fS2:p@4EoX sZo5N kAZT.H|P2~u/87=޸.ٽ_B @@ .* QE{ح*m FTd3ir57&"gKN !R I>$ OJa!Sa *﫷p{׍$SߵZS4)"͘%JJp;Ԫ6"(uݩmmkنM2okMւcTAdRs@ohXs[~x~Skk/e{o, r0$ .tW]ձcP;am<#2LNHx7HO% n9Φ[lg"w XEsy^rWsg;Fr Tb{{D *Q @ݦsg=]hrٿX@MЕ%^#%'|̰f+@$3MТ !d h @1r8tG@F@=*.^[Щ $u\FG $%bP^Tr"e .$CM-cC"0Ak>H ʀ,KpEGC~+C+`" grL ,gpƫ.yHi=l`*+"sʏ dN{kc t rQ(G2/tc@Ї$ aNw;`К[ 2e;ΌE҃;gfTUC"2D!" )31QbGgN~^t_ I: yPڧ I} ߄A %QP~h#=\ g޻@keWkas7M3f2ۓZ5;Dvq0e+O}Է{C#7bfpBd;nn9}ٽt~u Xbq`#D*,˄#Z{Az$> ^6yŜ7sºD3ϑy**z/A)aƊ "H"d7{U-y[<vGlt}Q&I&S"r9 %iHZ%|䵤uXH=ОS J&U0LzVCKmyE2)m1gΡ`a 쟂C-\;M@9!?U7tA/@'L@9戱OzSs>@(g_QtxnkQ4,:WLZE:GOj>̛ uHɶZP3gE<{@ECu8櫋۰r0rrHP\i#MDUN_$CR' (D 73}@ $\IU!( Vk,0v>ə3;$]+{bu$ vD]տw<3D--ȏ\uE?Mߌ/`d#wuF* N["á3F妒K5Q:CL~@IF:rrλgOO9AJ怦2RU𴍓1kn:=I/խ}4VN] Y&3ލk2]P3$u2QU]t'fkȄTh)ɇ⪭RoU9dY|L۷Fￌȶ<(s1N1ߨ|kye͒2ȑ(*v[]:9k:+Bk4%Bu*{b7Ïs?ՂrTC͑G$OU)`]E$"A*4[I$r60`g U^2>W?;?;:׵qV_uu<{iެQ~ RH.ە:}}2c(;7h˖TOX{j_xFDQnwQ lsӓDliY Ư 1eÉN:" Zw ,m !G|ihI ƔEf9Jzr## GHpY{':|B'{b+}>6O^_ x\?29h SÞ ^nvHtSM[M-߼@\\EaQuRng9o7wIDGf(A;EʲT:Rtg5~dje9u"/$9O`&㴿I_暑,rA[+jw|,!lHgFM$#-< $|Ib꯵9SB4deRHMgN׽ڔ%-jۙ,턬ͷbϺʂML+]*C%TD%S$ZbHrxuM,m+?Y*Igm6vݏuT1MUU<&K*p ldy e|GjE4Xt4jlEP`UjQLS (E4v%H,j o0!+GY-R6DYUouՐ&@ղ[kOt]*4MN"6VؔZ>uԸB+8j, n@"H,Kw% ,,bEdSF~63훺4[O?+eWϡw:iU8>}jhI/4[fЩ|+~\YIqx<;>2\+<˙A*hx I6Zb^yY @L6( >hW?f 'eV*(L`| EwVzt< v1W3Px?x>? ?~^|Ud=I^Wb4?j/"/u+i_OV /,/B{h/ЇSI>L+|UOdKo O Qܟ4ڥSR)=r–Hj/؃U|T/Géz|x Rv#z{HE {% $zIj W=bȧʕUO+fJz_OZM'U*z{_Wɡj{jOw{Cj*OJG{x=q|Խ/ztTb{X||*>R^Η'ªTg#+{_1++Ֆ(/_$TJےzu=U=T{T,bi|1K/gb/L%b:SQ|zjOz{=:^/~/~V/QM -bȲ4122heZVUZ*Z Ui5SVRbjXVM&ieah jM,2)ST5MCIԚVKjhɪhM&edbѤdF  LZM+,VXFST-MS+Id5YU2MIb+%6&+%5Z)d2e,hdKBɡj, ZVX0`ҴL-&-SLZIdh5Ve2V,4hMTjZ-L0dLjL&T5F-+-SZ*-~5jʲ4YFS)`hZ%EjXF++-Y ZM-VMCj4YS TdY5VQhj5ZFUhȰҭZ`b014&TʙYVS SʴLUȵj&hiU45+jM#KJj+  +KVFYV%hi ,YZVK--&Պҵ102XVZDb5M0aFdi0i05MV+)dY-FԲK)Y4XYLPɪ14-CTj--SCQ14, )&FIѫ IɩaY,,E&U#+Ve5,hԲ0&)a2 Z-M CLUb1ajZjXZ+)RiXeXKFj1XL+Iɥd C&K &TjLMCFS%dU#QSEMU2ZbhV20XhťLZVCHł*Ҵ40Y--#)+*}IZMIV%heY5 EʵEѩi+S)d&ʬVTɅCSJс`X4YXbLKQjM#%UKHS *ɢiZ2ZXY4-FņšYS1eh2-M#!ŔbɩddMU`ɕh4K&j`2`ՕZZ4Lŕdjzi!*EĠ>a;/_(||>d ±XNF&Uc!r%jRadʲ;U{E^id-&X{EډjjLVXIMCTjhVjV-M2X%#Q=50i54~2Z^d5V!2=9q얩WFFHVECTi^ɩijYXAܠH;R´CBŊ(>4J9utGWTڡ&VMQ~5S!^"w&(Z +Ee0u>%LZV+(!WViVVAja.'uNw*wwwsN9S!J,UjieWh9;JKB^ĚV V=*;w9e^>/;S/ȿ#?#?%~G}$WW9˗.rr\s9$Du˜\˗9r.r˗]uuuut$]r˜r.\r.r]uuuuR$I!uu˜˜˜s.sW]$IH.r9sr.r˜WQ$Ds9r9r9s.\]uuD ]s9\r.\sW]]uP ]\.ss9s9\]]]uH$W\˜r\r˜.uuu]@$˜ss.\˗?̒H@D$$$ DI"H"HH"HH$뮺뫨H$D$HAD@ H,,,,lAA$ `K +}?$EzWWmlnmϊz}z/<]u]]uffl%628!ccc601`痗y"!}UשC615SfyI"@cW^UzzUzpCD6D161C=z||Wz//>$ 3366D1 c1 la  F]u$Gګׯ!8ln"Ȇ1"8n ٩333<33<9\ ~HE!w  """$YV+ µaN͑fXD ^^WׯW!!ncn"ln"^޽yy痗_h@ٞȈmm!l!lN멩3<333<,a M $lll c 痟i$A$1@d cd @d m6ml55S]ffffygyyy33@m66@d cd 1@]|"B$>}ע1 llll 333333<3</9I*}_a@I6PTJbŁ,YD%5mkk[ZmmZ}www߁9.}I*}+T//ֶ[mZw}$ mkkmmmkk[[ymwwww}H<5[kmmm}wxuuZZkmo6$O>}#/_~{!"@mmmD^y$y[mD$I<뭶mH^^DB@uֶmk[[mI<$Dkk[kk[Zmm$AyֶZ[kmmd$A Kq&&jOKK"HZ&$ &|_3_%)AuNj^ȽXԞzIw+,Xx $) =bh2{;\U-S(IiXd5S&R^}r#RxYS({O*0j~e=;u*T*xih&~>=PxT{B*+S){rĖIdjdLxY"N{JiL,- MC(F骘ҼIY,& U*]rUbQ,xaO1YQ2=ƀ!܎ڕŪ50܌2Lڥ4ZFVM軝Ɋ*yEjFQi4=SU{Rʙ&#RثuxԞWd2!- NCҫ!`j- j-!{R422ejzb *e4^ȲL1jg]wGʧʃbERO=JQ4Kڣ *ɒ5MWssEdidjM#ShU'5I1VKچS MSDEg$RBF aX  Bd$!$*CM RjbbT2S/ILFUYM5=VK#QdQ{]sIBjjC &E{c!9P Dy~Q~Q'G䟕?(:F#L-Qbh?WO|>j#q5/j?T_$W|MEΎU1Webb/ӫOO1}"TG;9ㄱ4'_-S!hjLN UwHW+FPj TIjYUYRj %qGSJŕbE5j+%2] DթY ZLHX~_*>K)>G_4~GN}TuU}#޾>FA=BUdբjehbU|)||KO|~A)I4W>SK䏚 JԴ+*Ū5--S'̋U|+_*>R|/(B\$}(R>KOOCU}WWо}*} ~S>_J>W}JdjҵZO_IU>ҧҟRŒwyJʲMY&Ud9hiY,,AMUTbai_a4MK%a45_S%jVFtveiZ V*bb (ѥhF ZYQ4p&'qu8ꝓ*YM+jaLUŒw+ #&% xɢɁz%ӉiVh0jL"vRj11X0 & M%X )Z2hZ4Bdt=(eUjw+S;wGtx楊aZOJs\Q԰IU~jQZCI$heݢb25Z)%L,ұdŪj $2O( 5ZZ_`9LS*jbj԰ij'ԦܪN;ЯHxKKҽDңҞGԣ^ N\:.A\:Gur<\C\.WKqutU..KtrNP]r9N'KϒrWSʸTptN/CNwGuO5zЯT=#q.K<]/IQz=I%w@t@ p}2o@6=U;4I^ J5 }{w0 lHEYE}ܺmelSif(wll@ bPj04}}>:5+@v3MGvdI*P (QoRMj5Jf Q@[5Ar4K=)p] ::=.ₐ:_6N@Z@+sei lįݓҭp}Is}I;]+p-`])v>-alҀV-{ض;pco7WYݲPo䪽Nv-籐PU(JYRPw`UAn`t`vYEPjl*e&];}ݹ髵2Z5}1{ekHOU"g֠ۯn}Ϡ)SPKܽ2#[VfssҠ:λ]vJwuuͺg)HhmOϥn]KOvt45S̾v'KS[ 1nfMiҞOH IJz Q*@O$QiRhh1$"QBhiTMi A`Y@ӲO6䖼sTkxk-kЛnmh65Ebk+r6 jܯ7 mj3b mشEh(\4WDZWX֊,VrTQ-l&hѢ~olDTXѱA$Wۑ&(4EFţ` +Wc|КEEyW+4h,mFE*ܪe;RTD۔Cj$bh$̖*kyrV%M4igݺ6w_nX#I$bجRJ&5ZmQeL12bK c ܘzCͲe\Q"o*e'{JIBh  5Hb#$ Q2 4 ׻v?^Y!4U 2$RX %36*Q1RAch+_lDM wW&hFP(I4+ ƍIFur EXPj4lPHaADһdd쌲?S_HbJi4P"&% TF i1 $,QX*@ۗ$4FM(cRhI}L h 1A !V(HF-j"A%D6!4m S"MJ*1aHI2( Z, DdiIF,lQ(Ũ5o'RD4{$>D2DS @bQRFLLfdE Y(E ƍbY5f!HɊ PѶ4ƤTQhƓBXoU d) KS# 4F$ %k.Y @ I"K!|.i3ƌf#0PdB E˲1d@KݮXƉ)(LIFc{ޗ^=s@f@)$ fĦ"(!ɴ?.`"D 2/uAa"6Dh0!ADLI$,!b$)!BL 4(J LD$ Y#3!ed0`šedze 45$Xi[24cDlRE0@▉(C"L3$I4TlL"&4 Q 0L0RQI=0є*|Y*$ٶ4ݖjG['XE (jYt$;|nkYdʥx4o&ZN5l@ck_Tmpn;E[$4d>|='b:Ij,bi6̲cS6J(DR$DP dd%fD( &I% QAPV)%`&Hb (H("̄22*4Q6&ɢ*!ILBQ%Ih5HAF;DH&e""dv!EsEI3c@Z#i0T&0 $I"]1&dE dII$a)&)%i @$&DHڒL1@I,j R"0 "[ԅw4fe2 DbXL%$% _6dآL%[dwg{LɓJI\owDb(vb3J5/u/)iŘ3)Hc&bB0!XѱpJY 3) LIAWvݍ6I0A%402dQ䆍cd( 4fb`e4L$7!W-`h2h&P("`H,"2,,D0`&H Af#~r! PH!&~vbQ34.nTQ(FK!fB,Hr"ݺwFHHlA$ݼ^i$¼Dbʆh1JF"1ftPE$R˩&E4B5)cA%FD%モHBSjHU J@+c=}z)Q2J2uԤ)f!I2K2"b QLCq3" ,hHEDLŔĉ44D !fc&@f1@FDM)2 ()&`S L*J"B IXJdAI%dC&LouoaH!"b d鑢O8Rf&0b0"oI S"!v "1)&Ebsv#b=RM F"hJ5H(Q$A!&!$J)"ҕ04i7%, Ibhad LY;d% DDJEH FF 0Q((MI!% JQ DIŌ fJAe,Li)([6Fpp`skȁo# dOðD4d%6:4ă8r $]uV:亶iAEzW{=#DVs=t#,=>'a{>ۢ4`d![Lζoyș=%3ڕW670N4䲅8!0K瘉̷{&V뻡ZTvh2ܽMNg cT<WJd1PDCm:F7l^BLzdMk+wԳQM01C>?'_QIg^0D~__8o7#/=,̘ЀB 1͠1$`ԑo 0K IS E)H s͢P #RF$Ѩ!f AJaD e,ɒF IH"Қ!IHbd`ђL(ɀх&)L%5 cDAY i,I$33($2ID 4HI c "RL@,&dF 0h@ &H(<騢H61B QdH i! l1eJ M22 bhc!,@dFi`,Y6BJ @bC b b!HRZ 1 I!D#b5fEn;˄lF,dS("Tبэf[_tM(J1.߿~$>nS1wwwn/1!$@ihC_~ndHG\Ǘh4RhI f1 E$hQP^1&Q 6ht%&! X3$A($&P!"͹WϾ141W1-߻2L2b ?.1+&(&$) !2$LhI"e0(٥&1K"b|Lh'rPDDa6 db& &Ht׻(w>q1.a|0l}X4Ȣ$J2$,4HX 2D4(J])"'hɍ$h&A% f4Pƒ4ݻCyċ~\F",a2i`͘ a6 !LɢS/i DfbSE 62FLK F)O2`%N2i#Db CH&Z q"0t"0d,DLFL &v2` !d()#2llt*!/vkB3P)R0hdHhA%Q 4ɐ,FCf"T`FDā ]I2JILIfIiI&d02 i "H%1ldFFA0Іeh 1#)FS0Rdl,&c2F٥2 Q242Ri9v=(ϝ}oB;ܿwpgI5 + `Mf,ɨ%$ H1QĬ S$bJHf"a %KCLhf&"-2QXLRcb0HԘ@IHHLH$%#(DRRjSc(R( ~(bCiF( %2h &IRJbdF4 SM (4@ LE"`FLHJf10-LԖ(Lc$3V`y韝#QA)0j62$Q762b 2@a(a!e $II0L3,DH0@&bD 2 "i#$"Ą!M(F `L)$Rf@d I 63I!$I$rWTtS,La$,ƠaR023(J_.i4 lE 0DS&m" 2d3&,3&&3H$I"0 e * &cCa24RQ)72a"a R%$@6HH$Ӝ,M("R%24Q 2$i"L$jC(hi4dS"R_7HF(JR$b[$M$$dԉJʼnƉ%h43I 2e4"4l! h34S1Id&D bXSE eˆbC0b)4L,lAT&dbRL,$% !2 A*b4164@fB0sej&n[qݻ{\ Fn ^9B !Ly鬂0džeK3ecn2hfl4RcXYd/k.6jz>x]Dy4v)#cpm}C=-4j v6]BV6aL8tjk$GaJͱ %8B8TDeBQmC(QdMe=ZKR 9jbBNj|Bf7s XXm[ -fMf2JHCLNu1eA$[ :kEFp2RbmnJFmdugdK;B W#o Eױ\j΄CewZb owv3Y<&|&Zm!2"MYIaȶ񰃹F#[g Ҕ9[8t۝?npӝN zI8+[č%Ԑ,9\5SzoM:1:-qAS$Sn_}BsUׄmI,lM3Nˇ,g_ Sp3/4zpwMQp2M.3nX|zzz&լl&ԁB;)vRLKFέ3nb2 :,0[jyGSl=}OQsi"#;PbhX׈ԉV)-CerG0d+d-4Yɼ =Fy*F%Tr}C3MyoֳA%buۣJ{76DOt%B&G|/*9r8'n MdXC1:4KoSgS<$L$cb,cRkbM& fɘH2%)Df0@Rd F @hhI%M "BTPLMIQ EAM%c0QScFHD ERmF4FL(JD &0K!&dIQP3%RRJLcIL4!DJa@@fE"RȬY"4Y&E#@)4BT41%4bH6C@HQ !Y@3a,$!da@2cQIH1Q W)4$S,BD$&BRMDS6FQB!HRhDQiI;#e$@ `I$<_Ϛ@ld$ LBR(&FDCISH" <&LRE)0D"8L$T4AbLȊ6H&M%$ MYw_{~U$  (E%@@ْ~ %\F`he)sJ$B #s$ D$TM$ID1M$Hi"1$&% " 4B#MR'I0 )F&6@aDkLLLl& !!V.{ۯwˍLߕD# JK@d 3IBD LS$,FY6W9 6.RɌff&>xw2XLLInLF/6JI_7 2o2>n R7)Mܓ`b46$J)Ho7Bɤ2R A,P )F1f!3J 4bI$$FH !C H% (IFB``H#AH$Dȥ/"\LAn d[J=@1) !HY.] ѕtJB`,@@ 6 a(),јj\F¤DɉF<`5u6~9zdQrU@E܃ÙE624YE %błAdR"j4XЅO3H͍SR2dW a FJiFF$0I21 `d4a!e! Fْh4Tli4̍ fQ%ƛ$bēDdgˠE2d&%$*I$( 4A7P($dQ2ERbY,D4YfMXHdbeH%f̤ɤɰS1F,1AQgk|۬A M! )T b0c2PLY1hfLL4)$i(Hn H VHWsc"]J!|#?upf$di$‚I$PA!1111 ) I b1 d0i54P3H#=rGdu}\Rbe2(w(\ I`ɩwr=DcO͸nBbb&@Pȴd̄HJJ#$A ,f%FI #5I*\]Mr d4ݘ&B $ ʒbC)1%K,`!g;ˆ$HP1庐(Kq1*B(d0aI11PHvBRb(FD4X112La Ō餂#&FB6BC2b 2ĜC HlP YTĀp*j6K/ &a4J4` $L3Dj2$&FC2!S0!Hf IA*c%DRJ$"C"0`IAdFJ(Yđ$`L o]<ԗ0 n0s 9I+*]ш ! @D#I]Գ+h@$0)Dͺ '09$Ԍfnzu&1Q+$77E<&$2U{+l."zF&m8[5 ilAFEL@"& $4 F RX3"142I,&L$I SM$f!MQ $$i %H521%&M#nf2@A &ԘER4PR #2A)L&C7L``HH&1@2!fL Xh)3a ! fcn\nb 1DQ i!$F1kXLe S1)!BB)3I I"#I2DFHі$c&F L)@Ff&#16ԓ HDeiD`A"Q$`#M%4\fFĊ1ŔS3,$b 2EWtw]% uh",XcAw\eLe) @JAD!B "aB"d(MI1s Y b0lC $Ji fJۄD&dEA#@X 64 2)b,&I33K$(0f I22c]A!4 6DeI<H4ys(1$F4ܻ!H̢HJ#I@JQLaI2M$44TLFyp3B2D#!7#"i 1)CByD "%4QтyQDD1LҊF3M[wUe2X-;VMJeȻś7- G˄LRH0BQE&!Qc=sc RHC0h l~"I)3II$B%0Jf,1 H3M(13$M0)13BbZi!wqHH%C$3M l(ғ4! Ya2(F#FmCb`A&%*E1I((dQA$*6f ŌJc "(!aH25Rc (K%S)GR}ܖ"d0fdc(!)B%(MS,""X&Pd >b42PEDJD$H"gvz{~13D6 CJ"ٙ"bdj-3FZ- &A&fbc4I% 06`#Ji"aHŔd{܃$FsDLB;VB2J-M(*5Ff`#1$6(MQbLi&E)DeD!$&#IAA_u aHGw)" >\L0(Xł1f#+ )30aJ"DI"cb&FX4i -(ŊLD2(" REE 0i3 !JLPlۥ I,B("h(;s^^4M(ʬDNpK V,MrmtJ) âtcϖ ݔ(. *@ 4,bbMSΓ.9D9p׷5uQn(5n(5/XyU " \ OuUvꍕ۶;)lmb&ۨX.LV% n.bLORԖ8`FM,}to*3˝"[b=Zt`u651Br2GbY qՔ*%bhS᧞)"uQcUlB,RXZ(6М6Qa:-eS(ԭYb"kc%VH&$ո.a(k9i*R$IЩ8(POi}کX1"d7(QU%:V:Ģ%EV5LWfI[QXVQ,ByTߟpu5-*Q7?gpw3{dOs՘!6 4cl[f̩3ar$Lo6`}g^$G·uPjFUAE 99\w`j9x+JReͬD`JUb!g^X[ I g6rw12J qܴuУ2;~zTr)yuƉ~ZQ2yOOq0rb\8'ri aIcKeJ]2΢)4:§QƠR'lvXb1+.k9t"PM$ΙlS8!A4kc))glFk9dM.02TK IX li n 1iǕM(Tgj̙ L$NiֱEAR0ʓ*|g>umboߒLEWZ p̆7 wbS 1j| l YVX&glň5SP0QIg5hq:r3b|q|R_'41h0UG:1B`ؗ}Ψ#CH!v&lOSo\۪)N,MNGq,;)vz3K5*_W_mcNt֨dENc㞒]6[ ׆)NR:J/eY=ZJ3ykp. _4.o\wx"46*cK-Y98XJXN-Rj:V撻RE̕d)a:eA<+|}==nv7""J0_%*֦wŠC) Fi16 `s|[Qdě"ŕqGvk#*5K 'Z=IUV!8+_EBLC'.fyԜ jQJ_ ֧*EG LU mUVGs.j}JR-'TjF1=T)jhVT/w_)+؛h崉iESQSs)WnvOM^^u%h4i"h&!7T~ͫk`m6,|cp!E:`LrgSmYr[GĢB wcQӌsp~☐E4٘2h&bQ EbdlʙbD aBFIIuFbRLdh[ĆR)cDɔMF#@F`ĘiF(#1@A%lXőDhĔZ)B`L00XCf IDk4R̲ 1#Ef4Pe4)5,$h6I2cJD1h{ 2eDZ"4 bF2$h60C $ТQd Y&%4J6$ԒiLњC)Q$$,D 4RQ$EFI$2!.nE0VII2&)RI45{?^h6DHŦ& F Ő&!1B34b R4E6&Eb(JQ&`Ȁ@$O깢 $44!K"EI@_:f`QL&"b$dA1&hP#@C1 LIC(4$2BcKt3ff341 & Dȑ00%D3"DR".JFƅ&BHcLL*m+8sC "B2&$`Hc2 1aiHD((,M&` 02%fl[_wHc&hE%#!XF¿9F61&ɲPA s~qotTQ"Q5WX6I3~@1 ^ܺتKtoWM1CQHĦ$td(%&, d2HH5/‰IB42a0"I)S&J%bd%߻2䟻a4&ŠLM%#0WH!hB!HASB2IIЉ1(4J u6ź!32,0@@CI0ȌY1 H &e %$ F f.&iLTRe1$LHdM"%4FH"H DٰT!JWUtٰ90MZ4 Yn(ɰ4Vpp$8I&a1(H́ 4FS1PF($ 10Ee&&!(؃b̥FM lEi4XF-ۆ""@M&|ё6,#2Hd22dL"621hȥchnA/vA` b64ibLVb`1 bILhLDB1)% 4P" Jf&a) &"I1ќqnf붼#0"ZL&F4%1DH)Ba)9\a"u0 LMQ2h2H&A2i(QM(c5B|,X"P65 (vJ&REf%,kI"̆$ 4i1 LL0 $ $ɒ0RDɐ&fgΘ(RR l 2 C& L$W-.oc5o߽t3A b&)1$Ĉ$#-һI"`I2`3B&HS1Ƣe#(C2 %$`,# L23-LF$/NJDLll1Dҙ2"B4۰,@PC$S!e )"J+`a)!b@2 WWt4(I)Zb 2,(M($JH&adC2HQJHFcA"3dCS6fBF !&1$$Hf $ɓ1$A$ 0RH%JMhFsS(T$ dR$I#"$10dMcL )b3#6f RFT#2SLdQ#k5櫞{6KC\Ѥ*$ e28V`V9u1ҴR4_{k)QIM" s[mE# ImRy{(tes0BiȰ״WU#|dT3aMERsZ-\Gz uG_ja@"F!- !i))4J,2Q6bLLd"e&H"6fK6h))6))2aH d,5c Q$(ŚKݘ&d 1,(QJA@A $חeJ6"̤IPI,!chJ#%B` S0}(RC416i0`w@HRCL`Ɇ02 O;$L"#E,T.|{%ƇuDQ )@l&HI (B rS3M fBCTH3_{te b162 i,$(`&0‰4Q !J )11uSBRA@V#21Q RhЙ,L KF)`% Q2R$3SE/qȓ%hL2bc_]K/LMLd wQ{\{yӜ,FJ1;n"d% F0wv6a(#4$X/7!1&)#a) ab6I 4ɳ2b ur +4FD?]ْ2҃lHJI$ƅ0v$I15_Mݮ|%Ę+nuM#y ];M 9lkY[`ѡ~iM2/(SdlIF) Œ( Q4D4"QuobJd H#y2K%@uB(b 2J2BBHHI~J%A) iƍM(b&DRʒceLPB41#.cOu }DI{4Tђ aA"%"be&LLe1!0@H)!7{`uBYʋ.2xB11BE bzoё0&ƄS1IDEbd Ac &rĿؐFdđ$(0I$F(j T4J@&J)0S2 E*RSItgΆ$ROu؄HlZH+(i#A2)H01!bdɔHI3L ɖ)fd3$2 "IMcΩ,ђ,h2ba04@"$F cA 12(H1#1Jh$e|F1f`!$&ɄwkQ4%HJ}ۅ|JhTȡ`X2He$RHX 6QF5`f J4JPə!03ė_vņb]d12 򛑿7eP F@))HDS1 02hFD)@RT44ibN]S21"hDD I(bBC2JPm(Lj)L,ЉHab #6̑03D 20d&R@ BH%" 2DL#D(c)paeF!$a``D&Adj5l0ȠI4`Cf !F!`6eb(҈ lC1 PhdC&&RB4 MediH &%(ȍ%6Rs̎|Fu"`8IʹafbUEZs7U ZX-Ȉmrݲ͇#3.[;maHkT2f&%Dj4:\Qhǔ NQl 1v0v*vӪhUDM^$Ib,$!e4rNw5\M*rۡ&o e7cbAF1a [K91Yef\^oGa.9e+CcnisRXRD+v]eUdEh]¶)UeX"1BJ\jZbϔWFh ƕL/T6ͶCiGa9m LuҹnrSWlKעܠj)86MDS-zס [5M+HR,li$q Bi:l ^N5}?b"HI&I̿;d # 1FD|aL4F0buԐC(Se4HI0PA&,SHDdMLd&,R$d hňd#)"c)Dd)@D`) D+$CHH/b@B(0Jd2QA%hS&D5FK2b mPb"@$Ȓ4QEE(c}6HŘ5MF 4EL#XlbNvKAalʄ##ݺ0žtP#IBYLm#Q%2CeI)$,^\h**I-0iAIK0]݀HFY0I,eF&baB`"bID!Dk}[FC,PP,1RhQL$H&&aS ddL)^k3!!(1f4, %'XQ"4I  /~1(ccI@&Pa2"B`0TRIIII")H 6hDB!4$hLF2 )De}>s jP4͍ $"ID$QD BY &dI)3) ҚhĦRK0$&@a^]$HҘ)A2bLkFɔ`0 R@#JS L${bDDXX4Af̓QdAHMQ]4Í!6YB0H休l*V&$˺PQ  EK$IfVLIE,Aa@"PJLJD `aF B&P D幐H(FXQ&@h03d2alE2eh S( "$ ( #!?w"-JYə@ $DDYu)LD̈Щ &0I`HR`A=ۓ FIDe~0HXɂ(B&RI $`)Jh%Gp5${yuӕcݹb$c!@a$̀2&Q $3FkXc$E)dc4h̩a$waMd2u٘]&E-Ie*M%Fl rDwws4I# Hv 0`D@(QAQ4F/ݫBiff" Hј 1L01&LBBYA1 c2ɩaF -"&A%&ɤ2a~P&hJ1cDa2he cdɛ,cHe(4 $Lؙ$JP͍M߻$h L0E$Ie$)"aK)F H D,&H m)LFH4BH i`#4Qc!&)0dƚjPD)" ,Jh2w]AIfE!a& $J1"h"d1H " ҆dwu*#d!B\mu#^H\%^l[uekJ'$4]/),t(ɲvQ[ٮBR"hvy6i$k6,=dQAq H)I1e%%,B(h4,BHdb#!"Bk Md0dC)@ɉb R2a20QJX1#$l&d L$ $ױ&)"d&&HHѰLJf!!00J&JOvF )dS% #"ff"(@HD|E4L!CF )BdBJ2i0RfeIH`"C!aktEaFHi&jf##f&RV)4,hLd4b L`Q3THi "XR(Q2\ ϯ]JRhBc&2bM2hT4aFd "$i1 @,0LCb(~\2B22 M 4i$rDE dR,S)692,撘EH%HI&L X4QF"2"Iљ%S/)21MD*CbPPd4bYe%YdQ dS BhQ2,B&d &h30FbF`QFld J" )0XKBBQJaD#GH{Re(,d2Q-%L !$% H$(d1iLJ&̤I3&"E#b?w_{Zd3D3H-TG]\"P$E@@~k˰eAAPs DI2Pc I!@Bɒ iL3!@ d0i6$$L"""a!%4(J$ 3"bI)L#M$?緈4 X"idBI H"L?: !)($& 02hhB0JY&1 &~^L1BE H0̄$L I(PD0R1i,ȓ&J)2RHDTh4Hb4`0R023!) 0MDCIB&3b$Ha#H"T:'uvk_4J HSdBYb@ifC 2IL4dQMH1JbSIHXDʐHD̄2 0 )h#JTFde}n F$lbRD50!b0F2b$1Q&i&$hRJH0C #UpB"d $32 "Q H(FF C BFe]c,XLh_Ӏ ̓D2B$lD($Ę4P$0L@I(FH#(D0JdR,ɑ&hR# 1&)"AhK6&J~ϚщFov2Ab)3$("$D(%$i4f[dfJhf)Ѡ|{sEFr)V)*# 8vT6J10 We$6D! ] S`6@6Kc6JBd^a'$'R7d6)9;=IMP(+"dql }F6Aa"xǹc2QP7wi5`$ dd#Cك^9{v;S@!) !jW- !r q(6|b8Wp;IԉTP`HuP TP "zAaP @D*|{J"Jq:nl/e ȑ):y{ 0P)Yv (#wzS*SQ+QX2k4O)uUަ&81-NmՀ( \q<RȊ@>{6rlX\)WڌqUܣze4#*Fej9W4R0^qdOlmbN2U tM;yZmRXk??$'dحM+Ĉjj5[ iuKo{@@*SMod,kXT?V~S-,dw*yRIW+v+-by۝H~)~&^Lތ!,Y(.%KCf˼mªXGsV@UtExM(;D8ÈH:"R /UgXIde ]h e絉 D֠ȕEN+(zT-[ d;fy9#7VBTT` @XE<)3 ]K@yzmve\ ,wto1{c3Ңqq4vYRFJjH62 lClg+B])mdCmzlcQׄnBf-NKuÂx3קs"{5(tqUץ1⾹T2 2dvFqaDY&GD&bC`N>Ytԭ VG!iI\{'1 a Э)dh<#sHY$^cung+1ޭOg4-+Vڦv+W,ǖnu9 eZdыl%c;enUYTvlpIvT[+g0A,Qpިk̔mnDyt9Y3Y]ZUbb27|r1d\;$"ME I N!KDhGKj Ą VZtzqEQĺ8է SzI&0Łژ!ne0 bע ¢p*i] ( 4RЊ!.JFXbX;svYSR둒錏L݃gacKTDm IXZ(Tn,D4xPV 6 tb,34RvhٽXXMbJ@rmHeT-&w6j.AFXZa-r'0%(q­!$V WaH^ٶ&`De5ERau"V-VImt:p*e1&cJEf%C7bUO N*J+NoѪ&KjQoŸ Q ă]ɯ}oxTta#Vd p6n[vi4XJ6} 7ViKj-uQMXѬR kZCv^UMs7nyj5Wt'%NVVFi 4@ؖƘzs #TRV֚PBqMVupfR۫η*"dPRJ1VnahD7cQ9Acs[[MiJDY-_ ,EdfX3eLuSleI89EPdTwH]7 g1: fFMmF52yÌ5Fm?ax:lHؙ6E%!9믈O%"·IFu(+NsKe,- D]cJZJu1"aًl@F;# R6Ֆd5,JAAyDj^%EJ]UfWi&9YGEӨ4}3Y)kvkɨБVRmMhm Ҽ[tQ**LżuD'hz!nZ]tR$hZdc#p=8TbXk^6JEK%i ;;EER"=1-RW688㒨eX`݁grpجXU5AW,RUnꤚʴ,ۯ67]Jԁ*F}j4 eyhsJT"hʹxB,8rLٜ:5)tyc5Q-2-m=Ď."}eRAH=*L,kn+jKM%[DEUM5uQ1xC5TW ^%Dc* dE-.F8-kT+"zEQFQϛy7j"nUi%$csk` 5E-0u67XtiѸ ܙ38/ |O@dHQ@{<.qPb$+!orq㊆cqQE*"PreAXAHP*~:8VOkOo{+Q&'>W3VX\)FUJЫQ4 J>&Ԭ!/ lB .n3W c 6đ FQTqu{$Yz2z]؟Fm MUurݦ JWFS`jb"I5˯'"Dڶفl4ԝ\ FBR+Lr%+o0ƋQA&Ը\RiswF*f2UIH'k3٣J"_&FqRgG=&̵](j2hKTHKn q9Eew/-EٮΜ,Qb4Y Jj1\w8]vS$q+kDET$$|#mir$FDgA>گK Sp6l:݉ wa~ JZ7%&raI HXșUs*cE LuVQz's5e}4vbnROtwiuLnmkͅGsP`T-{O2i.ƿ0 )AllnYwUiM4 PBrD 82v 2FvUvm  kaQlCc3Av@6U6JE6U;8|\/YXOPHԨq w.`u'=|q>@U! }i63~Ts"~{hJHd$yL=Cf R %QU0\Q禍П?c6l`f[n$AET"I-=<0wFߥI"(Ԩei1l9s4_Z]oO߭Ңebv9%ëT_ݩXYc"g֕ 颳켧g$&;#iMf*bC}6A}k."0@^eK<78P]Diq3] b$]N"@/f+gռIr!~"'SRB؅*\ᢞQڧ;Jgao`À9WR3ejftydM rhP2i( "=ߒ5:q-2Mt;$y-!RV%VݮA[q 5毰ұuHN!Z9n2,9X%F$+GI:_:y+hzeblk(MlX"7FUVWֳ =|џw߲sX{HZD)a*ZZ1Rr+K9Gg,ѵN[bKZVaݿW"5Sg ?IcH%fĀPu TX[zm U#f/wfYׄZ.V% 4!.̥D5R-d{JDT^Fӎ %B>Yyߦ{Jfأ:TL&/ }u5g)+"CYX[f*鐨0.?Ku)}TW-[{DDأs3bKtAlbhL~& x:WiŇPüԎ5VGj-6FՅ3)pGP P62i8y?s,f_\ srFƜ{[cބ5Ѻ%(,堬a> UEsը2TER&l$Iq6z=ѷ&}dVi L9e0+ZPƲ*8u2eV6WU$#v텚۲O"[HCs}90sV%JۓpƢʇ^ҩL+t {#t]D<=y7B Mh޲)&$\$8ejO Yhya)kr KZSpdq=6hAmt,ٶ!BkrX 鈬),QVlL5(Wi:H*ڼ΄3"j.m˼kfޜ0"|a̓1vw.XSε|uG4u_ڷai%qq*t9>vCh!_Mf7ILNVnW(^AqR[ ;9)Q3*cgh}noy F=XۖٛPb,5F3øig<3f/^w T=eιiVh-˝DQ1Д|S`Xg8jJ(sH"hڤ I|b$\kVщ+zFu(YZmjRTZ%$$qW\QC9<#ifC9]ZQ+فŪ (4*U*UYjq3L&aiV:XB=,(qSh;+={Ob~,m{ך~,PNTԟk׏_sQLTV[U@F JY*qѻv-Ԍ';ۻ+7Zx^4 zEFlQB@7F:ቫx=zmlHJҺSV$I ˚CG a̙Klg& CDIL>٨}秓MokJG}5/  hbC+ ͩQ9f7deC'ü̳쥵e):H=أ4;1iU ЖeZkdI--2U,sJbڼVUH*A̝7C@9w*35"P gyP:ѡΉe`h3GD#YRnxdO#qұݖ-Z#J &rK0&JV e!f *QcI4G/}sXS(ԝXFPq`,RN7qJ{:Շ-%z5 mD+'kҪ>UG42Nom#O!˥"XEik؇ i2vhn-0Q2['UbMP5YMLr TuEȦ:hhCŔO!ƢuFBFd T-CvbZZ3eVzYj8Py *{xl*Č\ mh" ,맊VW Kbg(٧6sd*H}_Bšavۻ~-p .oTP m b8+'u[SSh#Φ]%s\~sNNU}ɽۑZt2P ZjWE*Wy~f]$ې 9'[?v;8c!&ruwEJ7ȕ(4DB7Ᵹbw,¢bJQY_j+|#ĕLk^'kg?/h!lPH| 諹SS$gNu_ T֜ Z"RҘr*z}p\%t s%-`+e?R(Ml"Mc6z+V2 V*()P|eYmdCO"hȲWەX$ GI]i/p|^M-C蓪1r4sU.N9n Sb+u)EĠXgZTn\IjVQ5?:%3h%B C.as)ȬEg|˸ۏ6Y KW(FRԿ.3MJ\f`xmӾ~ Ȳ,󏾽ôSUF# e(UUE+=f US+<BIOoX0Q"1Ovm03j+bISh](Zlv#QV㶓E<{>,=$L^U9:%^=m]ƨ2R.e`媢t|S.yVQ1ѝ̻Тըz]RIācMd%66sm T\l <(8(=\4zxY'w2d̞@a2[YX]v-rT""9@I1KrvM% %!\@{vAZJ%,V|2 ]rJvX:9G ) Ll`U\"$.:Ȅ%,(`U &hU=pY//uUZNR1559b7*,EM;*hym TXrzWoy5BBIw6?˶({[.Tq-@S?5tVL O6'ET9lcΒfgA y{#;agڂ#A>g"魊L*ʽEBM( r gebm'X:ܔ& hqG[vٴU!.;H@kFq]tˆ5[ܐs+.0Ę蚃i Y2ծ|nⅇFqp!`#E-^x;ddfZ9k:1uݍkM7:!:WٶyEx: 9J ]+MPaZ(Z01s_,kigv\XNR1d )Ռ1՜Q T,UT.l~%RR4.ki@8cisK;k皪 NK-@jXؖRр(4;Bm |jלޮҽ5d_UM l[&ԅW#G]VS+e53pjHdEĈ۞oK)$ڈ)ݠb"Kz>OSn*)*ug- SUlQ&snn0M%3>wwmdJ#lᆩč YΔ+misr/Xd{:uf*P H?sq'S*-N,|R%kU{XֶR&%?5So|)큱T4P7/n0i2˔e:Kkb4XBdg 42x9d3[HƓ'&c>aB})mn\ވ2}^RE>r֮yؚYsX nܩH*,V3JfY<* ~`Q_.x\KlwYy?)08l4$EKqA9]-gSg0"߭n W`W'?$li)J[[SIYh2ޣiى̹DH'Y];_Z.W'wepP#vo8 30caJo"S;re'QHmܤ?wHjx ʇkӏPR*l;c*QQ1V=>|$?Y~e~KBي^۫!ڙ`>}Y3'x<\HF}w9h @Cki{lvXEMXfg1.ڮ9oLey1aXS)F#Y{l>ȑhםWLG@qG*E]dդ:Ii1J8V"^BձA- NZ0\8PPF9nGĔrh[v|jek,X؆E'Tb?=\#,*|@hHca8V-ynY@dig=Ahx p4$m7z);~+'XJ-"$"0HG(-G4l)Do{=ʛ+?a|X"| zjzTBjK(!Z-+4KO}#{ a1I GjpoP(EkFr_;<ZSٴƾ۹[?`4Y^=Jy,&e{b~f1UL:Z?rT=P9~~gqϺuԶgBKm nW4GQN6wz{ǓX>?3L9Pm`LBU";6D-S#5ܩF2S[?fX]+d\V9!o|r4غ:L7K秸k90QQCRA=S,y҆B?8O?~Ȣ4NK\Ay.\,u5yћq;J#qjbŅ3FrYvϙNewnȃ89Y KEs`U|(en[: ? ݁>OUxeX3>iANPyHn`wW5 nŏTs5*axiks#;j@4e[2ƜCz0#HJ;wRa=c%S1:ԭ(DEV+lŪmfTKGE.o[a&殐ݛB+%u'Jfq83Cje+ҳ7&rYeS3t%t}y׬+Ӯ3̪` [v"6!UmN8aelO9Q^Kd|"dѥd͔4aݒ ICT|xUabm6bf@hvMKxVkXZޢ^I4:S&-r ,)U`KHWrOw3[*{?>ub/\/8ZDLk!8zRf}MdcuGP]SۭNs^KQo GJ&yy GXaĠNeH YIHe]k4WindOUt6𙔋Vڗ#-+i+%}*u3tZ"gtYAG=ed*vLAm0(gjF3啵W4N왡(k1͕+w;kC]M5 dT ֵ,DY`dG&')󶒯)Fq^ E`:N&Px/{UQ)&X[EQQ/)#˧̲`#Rŝ7 UOte0289ߙ~7 0Q*{,3J |2'|55˪q0?#d),HT=OԿ5nCXg‹"&C; S`Z=?^yœT XaT!|%B6hȀd@~:P"2`-ܦ=f9bć3wUK[J-x?'hÖnfwg8Jsd 0Y:Y%ws2r(Y7s1Ut4C/q1HkNZ5E#ORa{xo[QIyʮt_2!J~[E[c[Dho__= OwkyQJqB7هd&&*NRk~ņ;lH)Kt@ĊaщybdLЪi9U1vԸsݏٮ>ZmKH㤳Uo5S*'\ճ [6V9-Z:@+4 Оj~^J=/KĮRg/ <*[1M9-vsXpdF?/{b#tD><f\.)QU!ڪs$޹y[ RɓJXJ}3^l3"CpBX"M7A]dҶD@lyV4jVR-rZWc:I}U"'_/[6BuYۉHS?QW w6b!N:C;E+P`Zͦ`RGfxZi9nD6XBrL6# 6H*.ЎރsraN)R1mOM <qUDzr棶`N-,5F5(7HkHK=M[i$ 5Wac4s7= YPQrBuIWjFIFOfykFBԪ3QR}cjm4G]FVmq\+. xoEpQvldPNмAEӝ"(ZjwoJldR_/~ԩPal[mGsLq&H!H|Z2V8W3X9Sv;$L)' -E\PF'6qZ#n҃DHG0{_VE :g׃-p{KZ7]q5ʔDc*Zo+QXm31'W fަXnu7'RDQ\$ 8d !52%.hŭ4H>UMBL2sBTńȹhW)鳱=@}Yhm@R ukL4(xj@tKƠШri<T"=hU#/5<7A@$!RݚL'[~ OUy(V ]0$e.4E%Vos8 [:~>:Ow.0Y]0E 'q30بQ϶+&X ,qϱ_``,dC H4Cۅ+)!C{'g_@+RekQXq; Q VO4*{ 7ʋ5ɅqS9C> 'LcR}_|k+㷒c#mT}x O/ZYU_}eS 6Yg/vTMϼ q]7 CDS}̑-{ ?: /뀹ItK,ZpD{8Y%R6}Ƽ`?%=XgGrZLg%̀$y"DD.n;riȤޥ< RKn촚 1CJM;k Zjĵ Qd4(6/ݴ!*TU0 甩?3<jI9*xV1Y)KVcZϰu{)?*n]E`]`wQ0R,-e=ǣdlᴷΕY VA^YmQ4tjZDL 86Wbd9QLeUc%UV\'_?{pqokc EX^ cאf,\={YƄcSixn{@A[S窛ǧ)6п#rLmGwoj}Wn.Jǎt޳7.4pPVZ-*&Q8(ssTe^Fخ@<  z@g+zKSV X8Vn=V((aP.'\Va8ok›1D ! 4iA,CM¦=0 ݥ9DŽON9$ C[ńV)$6hMQ%`lDbiNڣ{yˈ|@**zImat(dg8gTXϣw߶i>6$8}<_2QTh ?5A~]i9^SB*4\|͆gs!aDSU5A>2r  3(,Dg &jߕ^X| ďIő-Q2vWE}M}ZYFK^h ,ݹjtwwt3&'Ha׋fI=Tp=̰vpMvYaOgB%!\!-^#@y ĖHpwvsnٹKhؕi} Tͣ/nT$ ARZE 6H29F}KZW_e 0aw0V*Ҟy5d Il&e?>y2q*_Vj'LB-&{LpBEe"CiQE(%2G Ede{6bB_r}r\.__ 5XWu S5_U3OvJ5o^8I*P ͨIdӔDQ5ߟD|x ?]Nn oY82O|(<%`wuuNӺAr(sWyzsỤ󾨢b`mwL qz3͸AP Do0~Ik2M '],G=>ϛXyKM$^8!u$cfg=f&N'-gQwD'7 مU@0yFŢd9^:'^Kӥ:2K.8J 7!>E-?9SZY ov; ZSnkL "iFɪrk\&ѫeW35gHkv1Hij2.$ei$vCu/ݣSS@LA"OiŮCUŭ: 9(!J2v)iqZ@k#U nTJ64ltc98 􎪖ˮBR%ZY"ϱNU4SVį1[wFim%cD$ yoackn;+I] 0EC##4RU*"%Ph#b1E.5WY테Lk@C&utORFCfwH";aK.o6IC.qj|"1Xg`1ێj'Qѩ/V q@W!إ9:٤ Vu6Z)$g}}WPĪU2E,(ʆl̷3EJZih8! :Z[ejxx"`^lL)uVKiY drVXUj;ia(lZmzlMUUb]. NB HԲ#k:[a'Lֳ[.X̣jG[d%cC2=ߞã[B؉ S Uu3gDz:p  JI[/- zo~fM(Ϡ'm2m8isosN=l|S<#,1Y&UX!<;P ;ʷJDT؊("pP~H _:F-3ꐨr:k!<XQ ZXU6%zE ZæfVlh!Ge8gMrV:'@2mښ*ɵ J%euV2`Pݕ" ȍV&Liڂu7\̖&-.3ŏ3\*)RKNCY<.f\s m'UIK^+1Q`a񓄨 玍k!ͥFV֭΁ME C,{&qdLO=ǗB(&u׫2oȬEЪǾI@vSk.y5QQEG`[Gm4Y7l",YӍ WsWmKF']-ϵQ)E[ `:)hYePUnFM*:{{} Ũ)ifbd2m<8R’6 [hV'X4Y"=Ө75qiOȩ;Hӕ udom1lJhUQCvY)8@&m}DA11-X1oes|^fT`WWvl"Fȵ[`[gCu^KTY6k | Dw[FjLO9"wzfa` Q; Vծa`a2el:|_CKraOb8B3-ȷp{z6柊6PBr+HTxJ KXs)]Qlb:&Xe3xAl%;Ȏ WCĢO{oq 0Gc5Mݩ6GPTg=x*YU$WFWxYîKYbO͂ա](Oޖ>9snq]NqNhTk&խ5\W'\3jD!5j ݲ`Q\KYaVRe֥lLVV *4\ȃ~1|&PT󪍲Ն\gC]SɦW'"+lG|AVB7cJ̎)uCzdR_rC̢"%8ҥT5ɧ^X)fi\bY: 4 TG9%)3->B # Zѝϕ;;X/)"8DdjDZǮl;iz* :PRsrۇI]Dޜ8筋W8uokVqb|bxu P/wqg=k=o u"vhDsB\9_ｽevs{wp+w)i>֯Ұ[!p@q sNwi{z^3.SYs/Q*w)s9*s+(MWH.oKHLhKyt Vo!1co]"鵢=JN-c*`ќyl>4$X0z7ʟ4z?Bն9lS7,2وW# 7]$`" i53r]["DQ6lĺa(yS~g6]mpҝɱ ءKKk2g " zBw}s>xҨ{<8>",TLu±H)U6M+LlܴDfršQVTdf|s">jN"K>T)p[(B8xnt5nZj0Y~"=N]~Nj]mq㻔hcXv龳}6~m>3[*g\(5;_t}*"OzO sOFqcU8<$&>lvt')s[I;]$sƳF*Q$H[--y]!8s+ L5>/zYvade~Y3D'z9;?z'FP8n{sf9n^xӞ 2BGNsWvů .{Xj[B`pK`5ei? yR!(LӬM03ߜ e\-|nX _)c$"":W]7 dI+nJĬ*uk6H__ q}Y3 ƕi C2a^ _B' %_2;|VG%,R RKDX.{@)z@ IR*s[.w/svpd{rXBC(rbȪ/xܭ>e&C$gPv$aXN紷 1 Ys1 cqE2r !q|g\mL=H8b5 %?3=<17o3f<>zru:{JaJ'Dj.OZv[ixqBzK HihŝbnHv wCPWX`zyf!U;ۼZx:3l<:gd}MfY& k3͓#5LHB],ogfq=[%Kj▄Kq,f["8^Jj]#Y}^]eYc>v)D@@Y8JON*ornlj jT/ \;wU*TcO*}w$B\2t}yI^40˭`32=$LWCtZpxNS>RSƱTlXSxC >Y%|d29YD6Z۰S-~g~uBZOL:yO=H"S5ZUT5d#6:O*ܢ?+\DI"OL8*T:=oT(kVҲYT~[X.WͣE?.[gpFm֤]:PTG&"b)NN /L' 'T :\gdLCB*btܮ O`O&7vKg,9֞ #9#0>TQ3-2}/viK1J>%"q"#ndL"5[Ԁ;Ǣje L1u3EK rg2jjaENY P`>iF0hˬSƤ|M[ILnU; i!%,]oӞ*ʡ>m=eiPl.X@Kdpq?xak9O}|ؓiJE?~jȎ{Jr,r_KI!J"T7YPj\%w.PrjϊH-glU?{k"i41 kw1QeP ^&ޮo)QdyrTʕ9R1L5*VÄZMlI_wOY={함Ԭh|a~ AAgsyMOHL~)6REw IoJ7?KG4A*HY>e/_o&=f#f}W4ӓ0_qKg*#f|YSO X9YCA6| >Bw-| Y'~瓛s'zb-~!C@2._\f\KlcEu:y@ۙc{$%[iY3#R y}GzU*i;aE,j/䩉_yuTd9h6*|;t-M}N" R 9N`VPv1.Wij2|g1ɟt (xX[4b\edH>gQXu3<ӍקZWƦ(2AmLX/n)p2SYBs"0}olɅ_ͻf.f6NȮj4q C!vm\gk7lnurmES;HqY+a֊&FS|t(:QG! B39lSY da b {_-wkx4PKO%x;uY2@ff:vjaDTu,!6˻{{a &RQ ckMS3 xĦ!z<8%@PQ>Sv!;ۮ :D{۰Xb@yf.s)HX=IX, δP!R( M+ )Ƭ-֙{0}tgGTҷ ̔8MK_Ta<-052(W#9Ϻn Ya)'3RVB)|auSǷg,"ۊ9sJCF&u9\T5 TS3tXkVE:a,;Oy$0ňekoY \%+D̍>sihԯyryh7"~& s5.+L4$bҪTQn;糺ԏ֯" WJr97*"T2SmmKH}k]&z5‰f[KȨ9BIeGug]Pi'p"%ĺws%d l's2(Q& Fu"hCiRҍz *.6J&V 2q~ITN5ߊ1zwA.Ⱥ}=R 2lLRUdYEFzQ,"ӛIK3- nqZ'otŌw'6=HI. l3̵?vQ&x)~:dbP%Hq'b$+ J=5Tc&&{" uܧ&ֲ~d2PqnJq?S)]V Imd ++Pii+:gVEf.S;iW^]R˚BLB&52M )5΂,.*(Z~e'?w׻^kQg{zǫ6xc=mJZ3D4ӓGKUKzu`S./Bp͊Tk}r7 Vu7>s!a  /]@)w*gQ@V$,v!}s4!YE=0#xԿl7Q Ŷ-)R:(;jTLjVB)0 ɌN&!^c s_ÑfG z4H >@f>i18 $,'}ØgO 9i%xHm_2wjmʟrɪ{UQުU#ڊA$?j!N00ZkU۶0D-n&rR ]1ZRk1қ:tdt Go/CQE.f$q<˽c'z|r)+wKBS:dkIhZyO'/?(z c ۔\Ȝ u\ϖiY}g%]Nnp uOS ̠k-hy O̷&%_ıˑ ύFz aey}3>SYFV#qF/dO8H~lfn52dC^ A'ZX)F<(IU_Kn9n- 44-Rzh; -$ٛ>`ic`bKWMߛeO~%n>3N''WeI$y٪s,L rqiRݛ>~h"Vb%sˠ~'Rᄸ h xXﵭZ4*2oҰfc&ٯ.ڗerTYM "ZLikyD3_y+:}R^g u%OH[gQc X)*J4]^U/0g{D3:Ğ9>zjPaWuL6=7 O4SHɹgWs\%h-uvk=ET:bI7jvܹO9:򦱋Xp^+c]/9ǡ|<;zdwţ @:b]K~w:;m& 89:WHpC8}j'^#Kϟw{8ԗkIf5NZqWa{CSFqߜHNH@ 5n%͸v6FʅkѼͩS%gX|NR o;B+ć`F X.B}+ҸAD!Xs(<TzL?ysd # "^,tHDhM-g7NVZY—M[UaNo[CD37\U݉DZ"mZK7VIY"xԒRw~ 5 d\lĕnk24ZL7ȶ]u5M Qde!s*ȓ %0%vܴIJѪ3-wJ` BmkL06{1e*,*)?sӝls㳤?2X&S7_ċ. Q?(|fpUO9J~ U7K;U[XY*JȾi='R9J@ iD!dTZ~j =O^"}\u'J d\$ =ɫ[5U,.;> ;׶,=@'Yk؅Z}Yg*Χ1Hy6 >|/BYܰXݷXQB9\ScJF+qMJtƖgrWSZ:@DQf+:9sW;UA $|m~_S|>"RTjas)$ũ[d}w*ɱx{MBYPb7 ycG\e"$ܫZek+~_UmtiVXN}Q;Vuς.2POm挥۽st S"KF~DφɧCDtO{2#)nq"lo3I5j~fmrYneo|Lf"ÛTE^!HZy*CE:va?\%S+ (ĭ5d)cYm ry-\SII۽ ;k ~+}+S&N! BcM.|uu)JҹN9RփSS9 OXةØ>K$s$SZ?zOJalX֟kUWʈJ;9$[![h%:jRc;lS)pͩUR "~q ^evt *rba3aw9BS'$9ǝgd53-X+*bHܸ]lt!AX>Ϝ1q b+9`ɮ:ov,ܥ̭`DIu5isS p%$iDG*mdPP-%TQa k~3ͼ[4a(BĄDn94)6ڵnH)'2 ܺ189wXWPV9R%h*e54IR˶>2h|ڧY OZˣpƯfyeE9E*75s4!g^r1\Wgwо[ 61ܤdN %|-ݩW4>}mj5[0$T݉fV+p[YD,(#qm tZY J(/7!Qw3%lc&"d3,dQqaXٮmu:uoNͪg1Z7f3Uw"c%3Փ^ݥC7U_7@f$repFalTiNY+1̖eĬ)}0~#9ZXXD<(rV; 5zz̃qS;f9ޜ-Me1Jacs][d+*m)dTsRI!Am`PV4Խ' *.XLߦ:&Zfs>Ř۬x,T,KHYs!t&g1Qg+RLj I?|fY{B\aJES,m*H;ywx`G%aD'11M?wfZM_uRGIr>}}W\D&:[;tIUnx?oXrjם7⺲.`p"`DU'aiForRcM s?utM@1+&hmSjP-eMI1U?}[&CQ%R޲"aV%2lE]L$\ua++b*5 ?VOOw|娍W{GF%Jn ~|;əIO(bo~&rf$`❇̽ mB~I׌RyF)qZ`b2ܥztM,1*f3t|10Sdduj!s8IuaVnD۲HrIy-,Bb|ܖ%JODskrOZ0'.7'Z"yN`v ZːɅZr2v5Pwޅ^Ҭs L^'0뢶a`T~#di5;n CLaYA:08H˪ꅿ͹MI#I[,2lS.Rڶj/TAV#]D) o9PusyjnsM KˮR KH簒`3k vQukUgǠe_UgYv?G)0H [OxpݫmPa`4WY)N\nҶm[knܧA+n.3j;SvֶsTv2iۻpe) lfe[6[ikm,kvW[뎹Rvˤ՚+v+ݖn a&r2nQ;*ګJحiusp1]j\Kv/{ު)W9SI2k4ݕiw niwuӕR諫]9ͷSmT]复۝@n]uIkNݭv J'Ed.;;Iv5գ]ӛkN;HeMv;n.M%GO5_s3nƭwvc] θ]SlTNwwXpr2r`̶mݻ9Sj2.m6kcGO!(?& T4 Pi=4#z4TQdh%= @*7ђA* Hi%tji5l?d}j`Gi4vD*:Vvv "磵V ł9xO0=q ѧW wIøatS޺zlt6#`Q=rui 99$5I6j\ c\j{wObuzzee)Ҋ[bJ;h撏Xa6 V/5%zZGԒtj[!eܘJݬX eůW֣FgeM˶[ļ*q'p;Pct{z63Ƹ۬8ۦz:'tcď3v$ nN!ljlt%O7U Ëvq\ (^UMSXwn8ƞ_X sfMOFW0c^MmhttI$vҜuM,.[g/!ьry1{RI] 5vm'kiSyxaVM1"HGht\G/k<ձIV]E&sdF6 Wnfd@5.fbDnS6[6eE*mک] BCEz{n%`Ҩ]dqӟ$]Vۨ1jz;u$Y=p>j7n6 ۛպՃ8 q HeO4[r@.D!Y8]ȋKu|viB(On8:6{7NMFT}mŽvnhN9l"c[f=nٳق7jX봇#Fx,نrqvH3E'.l6Tƺ-u%R:ǎud)랲uئ|N1sǭ3o=]&)^9zB t\|^]uZxnʜZt㪞z'0ZL6+fRD-6Qn6ڃݖ1|mv^9:$MEإxٞw6uAڗQqV#=rIf}X 5͹dqh8Fxܼ9ϒNtsÝ6$ul,n; P$3\붤lԙ&=b. Z:cv\;B%IZu|9WsՕkq$Z0'*v9&t[ c#A #:7GISlW{Yv8a.`(p!h OʝQc@u1n&˺.Ս ]Yx>+فmz\s7![ 1;%n:SPU'XtTcWl!rtLtlZU$xջkӜ[<8WIݣ7]ۆNݴ*=ǧV[E5bWFvYSFE2)Ofk2--CEАǿbRjiэ&X6\M IIWqaWWWn>..j$v΄mY'm&Ɨ&Kamy;oo2ժFYfL7mS7AEL1꘷(/xpkMta<T:VWk27b1H'&gɵkQd9GCyəz#8x\l3ֶCu "sgqgn9Z\uWcZ㚳k]$ δڋsmnl1NѺC`.`iɁW཈vrנmpK'[fsӒIjōhG\3VӔvmS{hړ]%vsHiM-`I[wA %K!f㞫nۓv瘅÷97Bd,bMJlI&bU:8՞_L^j*S;KµIjd]/#n: VbAs.KD*vw# r隨G {\h:ݹq,K]7awjyi\7N[CF؇#=PۓfK5nqI# /l)h26IEKw>m7 1d;.1ZK&67,A; .;E.z*QC$Qv65ь趗e!Ͷ㞞bvz ]Xz[ z6M[ Iܰ\AY9dHpKl$57cc*t5ٸgZP+:n̲AnPQ:{QoXD4%g<}V{@޴=k+;h'jXQ>c%fa5|ՎiWݩl4aDXVvfx"o骞|_+Nc[uVۈ ݯOMPNشtlgפ~Y[)fd-k m9hc̻'Nc{aN]hN]l%'$vԧ$lv(]$"s!7[Ʌ윺$gU;Xr5vϜWQJxQ-qtk,.^c:x]ׇap&[0 cvfSyGq˻undt&uɬ²EZ8ST77^ XN.N:9xfC:k;XtzzcuIkY<"bRՇK<8R:'gQ<G' &3:uLZEvFIƓY≬(xGhvruWy抧#KŬӬ%dƠʅz_msu] qz6Ovq47=y:E۰.1h\tmukXEsځA);Nt,\|AΝz%ԛY \&qʛSڬ+Y0ЃjZBv*TG(ZFl8щev$Ò1Q$-% vi9f{snGRvwDW.wo^+V ks`Ԕ&"4'7ݍ2B}v̾jUP<ᵷ91-hLhGsVKkQ+nyfٙuF87d [ӷR=qՑ7qзS4[$ngCc`9 pO5S cr^cJ֚ u"teԓg:j]I9B vJ2=yU8frrk(R{kXZ:;IHwZs'nbk$kۄ[ \S;|v;8۽d̻⹡E•ۈؘ4.-,ևi^< -kv۱<#t@&<FwgK 6n ^)mv7:Ѣ`̓#a=vƊG:4{@l61sq)f..K,Qy\׮ufmϪ=H:9G>;+/>>&n>kӥ7Ivwk]Ztx(U \smkk1:^:%3;ٞ.>}vϤPMpez8YwG*Uc7./xyflp *YDӮf+Ys\+ݷ B˖,[WlZylw=.@ll/<8/D7<%Dv4hk]&OltV.GE3r1$XzRLf֓.@˷I;ʹJMۤv%dσn+4;[6{(Lp\m=A:٧\ń51stjw%vx]S냇mp4[QFqѷZEr^'0"w6`3Aits:<ݥ]:YWC5F/f\AlsbR8.PgnܐW,A+fk[cLeq7$COQɷ֔n$yн3svG'tp])Ptq1ۇCw\9+׶t.MTc85ή9*5OGܗHF[x v1lHot}I1㥀gʗr;I#1{tE afL׹y{9Hך$8N  ve.pjUvt4U 3Q+I$;hFqzVrlUS F;@Sqfjtr8Cԧ`&B6QJqnkNm][kuuxaU'/h]q l^Lڛ3X64c!ePڹ1G7Crrv-)qn&cڊC:vIVCb ݝƭiBxPv\* DGwPg[kJe aGe̜UU8 *5xnm fE+yWmIݭStڏ^BZa.3ܝf1s׳[DIKhqGaauq=2n7<=Y Gەzp]g 1t0ss׌= 4q=ŶC1tuޕqb,<qŎMv(CGL< S^Hx|1rB17_Knw7Knij! P̩4躘"]B>|s5Q6[XTK$I<74Prˎ-i,)k\oKؙ4GM=q]=.R([jxѮS<$[b)MA ؏zz 3Sϩ\js8uD-\FaD%vvlqitL5"ϖ/ 4y8u͹yBAH< hf;lTԇ%OnpuƷcI68+XzC\(*’PlHInbt3t"ۥn>00P~;/j[\2kM{nmΎy|c(YpTf{{c^xŻ/d" vjy.S-8^%vPN5=ncV 9C<]\>=`byyj紲TS*5+;uǓx9pͶu 5(꧎gq-87DXn"^JX,y\:7iHK\R gn=^$| sC;W!j#8Jyݝɂ-v`֛7dugY:"ui|\{vu넻PT;=Oؖ7J)NT!! G-܊Vɢ@n*zE\ڀNv-P<шU3AOv"њP>{v #Uk"{#bV㔐SP7ctk[%<*zy9#WZ-:hzPzy;m|HYQe1 aJc  ̔7<447[;˘6\8 VRJسCRu#7,6<65ڋ=ƥ9j/ Qsr/mxYڣ7#ŷ)Wu@]=:vEFuчnـs Ƌ\ IP)9nYڽWݣe* l]Vs.cX4f6[ETή1Wh )97,pkC]۰e(Zuyc$ua]qկBstC"*ra6v؅ۜQ$HWۉnW(tv!Q4Pqc];vL;vn{JŒ\%w1`c8<ε&=q.Y29؈΋1oEEa 4=r $v0;\˜Lc˻&nz56<[˫ZI[F^;GYq#Nsrѻ\iͮPڭP^U(h6]Z'$'kxwgvu95pͨm㗎3sa7@t>x9=S=\$iy3!@yMàҙ Kd .x%WC&"ݎtOzY{'kdVN99y@艸khڹ\Y깜Eryurrs5>dbkF/qrϹjHq`ӂ8)c7jgplV[+b#A:3]ŐAV2F(DkҎz5`۫Ӟק>VhW&k&KYN`u] p p=;9PY}B*\J>Crsmՠ:]FjN1L63nppapu¦=sdvJl]icZ lKU(;BӢ3Op;w6؍zu7]sL9`/^Э\筣h4%Ykڍ)Ocv#6,UX_Z*7{n@XIq [P];p\nnqpFيmЃysIxקKlu[Y&^ mu=f26CA竡cŴ;9vS,G嚹I3BR[<$Ye1󮣻6p\qVs#SĹ@9 L)wȣ[sLcN0 z=rmPo{D6R3"q+i,Ha.Au1=ru;voB \WF]pv9E"ӖE8D7@= LuqۺjJخh9Nm`Vz6S 2Dۍ:DumMhm\ ۱Ǯxgӽ\=[F{¤Edm\D:1:F#H䫢{wtWž);CCas$mkhcMY-rmTX;Xݡf.swMA.^ǥp֤:-9Ǯ5^q5ɶіϮA7 6h5FJT1֜4,ǫ]VZWa7V*;NrG9(Ŵ4X|wKxi2V3ɬ,f6ivv]DnHkpgd\<=: y0sҼu!1Ѝ39N' ص@tsPEfvs+;M,IZ(uЋg6t*#LQ-Ŭui(1^W="/arFGڢ<ݣI,%-{ Wx:9sB-xֆqا+W]u jCz*6 zYv<{8WΖ%IDk%j(kdƺI+֌0\Tus-xt4v:0XU.Z)nݱ\L=KEgۭ^CܳԼ5[]Ȉ=e1s^9U@sp=۝KjB$ jMEDG=/cr{trs u͒k;T>1c7T[t K4<R;ԗ AzzNYv a/@O)۵m'n44${I%I)kYrN̞R3g.wS|t;wͥ&N=q;v% 6tjv)8M\BMQZfV(q&Ιka9W}g)=Ɗ͊R#H%cjZnJ]qdqmsƼOvmsq2e)ǟb9{x\'Q༺քU^.L+;nd-6זqmC.;1<փ麸ty\3ǴRtGN9Rc6݆GfRccu {u5eᡨ]Ov8uvbuԌrI^{hz.un \t8y%G(v+e73u>We:V<@J8mJv-kzmN8 .gQA`"\ъCT|&Kv)4Ul ABU0$䧆Rymo\D |nܧFv7'KN3Gf7o ll#&*n`6Tx)|S !+>J1n!@š;]nZSk9z=뎈ι=lM֪[ 4\BRrZR;ghp]7nz`ϯO7^Y s,zÛtpBJ/7<S4 FY;jFʎE%sx^5?W˒g'=WG [eY]%FI<,$%HієFsqLChxIRjݠΆͷnn 5#Kɬ&3#%Zz4ЗMuA_S/ ߏ/vy,]KX7Ec{}~~~}ǥniaMؓNhBz0F=)x*V@H3О(k5E*xKs2$LŨ qڕS@y2qa8,|#N1\ 2gL^1z}?oq}{wqߧwq PIi"ڧ}].+ql֝>*BaJR˷ 88.p JYlme4/data/Pastes.rda0000644000176200001440000000110313751775607013770 0ustar liggesusersݕn@vДr++]Qpn(m/X973QX2g˜3{zTBXªlRR9I'Bْ҆;'͛x?T ujbޜ97==1yz i_0cѿ=;|/zǹ·ss)zCys!uhzú=-ĥ|t\k{F%,emPɠU1h͠AZq|UM!:LLLLLLw5˄Ɍd^L]zgdp36ݟ$3$i&.X,]hA=hmA!z =v39Z]nHC:u 4h0`eee@&-Z h3f@ t2c@jn{^\\˳v^ ֵzf}K\KI|1=!h(ӈH&@">cCzcʽDE)?rlme4/data/cbpp.rda0000644000176200001440000000066713751775607013473 0ustar liggesusersTJPMҚF],"BJR\/pmLR Զ$ETo̥9&NΙ{Μo~ߩw/cV!<-ہx lCK?e 1w&*OO⪽Q"Nǔ!ɔ`gt>S8o= 08 ݌~K?$zeXq f3^tn9%xy,d%}flme4/data/VerbAgg.rda0000644000176200001440000001157413751775607014063 0ustar liggesusers7zXZi"6!X==])TW"nRʟXaqjnj-&kf83ur#|Z&0X~C-W1Zp_v驏,ͼuJQ"qՏ@`Fsɬ⨒&&1w΃7 @;ǁ% S 7\u1"\c2&6͜rMH+NnCPRp2ln`a.Wk3Du$yl"2|ƙ?(3k;ȅE燍zΏ5]8/(1&۰+KFN8]lnU )ל"9JM.}G}Nn%)̻}w_Ƚ1•Ebt]=neA&`T綂. \r,&M<#B}ػfD䙹Y칒;g#ScbZϞ(P*M=ԑ7W`RT558'95SoՏ &ڱx/bL~+_!R#C;ܴO$gRFd02R]HrpNfMУ5 aINb2fh7E wZ(V'#M3t+msI>q9KV.D_ L.V DW2J,-X6R] þ(D^ƵT|*]SFzR!]Z*F`Fn E5fD^kj=<7b \9Kv82SGFKx^M˄*Eq˜ͪ:KPZӏ rp ]}n8]!~G7pG4KEcgmHGt*ryVYdϭ:,)dҘpr ?I ox C1خfIJG0jyQB=Yn2`ذPRڶ.-o*!=ND]f>|JVAm!?ig͒zc '.H73R4\Kq45=C $:y&35,̓6|?/8fqz a4豍BSlƛB8~kc yTJ+oOMFՕZK*ɡy4z), <#aՠ:2OM@󓓅TYBq%RMO\O _3L9՛>ȌBjub6zk+駜=D; U$&hGWGY_XF41ۘeB*EL"eyfN}NkxgB#FU5e>4o]$7uՃvPfLJv_>l ^K)K*kK:1ƾ~?y_ڼ.OC dwFi'-nCמR5ezb}U;Z2S]WEUK;048<`<,.Uq3,;a126X:bؚ.3ƈ6 F $/K4Y`UZ~xM=k`t Xp{((-CV0uuk=7E7~̽:@R330 ,{:u8R oy3vܫ'>B&"t9A LUۋ 6ҿ**y_RA!oig#0fCb2Pu9c{هeI{KF`bՖGP[RVRF~9+\+dT͔ ;.g8-`gWNֈHÜ<ɉ Y(mL\m)JĚP>M H""s E E\ikv]` 1odDވʳ*@VEZ-hЫz5Qqd{aͦ(g e3NUynv1<M|fAdkx|5q 3iu)֖w4aX7U;N i}f}$Imx;y>YB;u;13y8(nXWH.]xe2K_]s ucr5 V>}"awPfp&i`]A{^@&Z ;:?9I&h!8~vC#`34zK+aafRR_LihAC9}떼x!LúO'ÂuᇁfZic DvyOr&-_y;"K vx5Rr=16ObK+mW/tΦ _=,mdHitx/ ^uTB$$&,`pD,TA^T;&ڑE3mݳoGX$~+eC!fﾂ^;LѠQId9{ʡ\wc\g-"M+M9:S&z8jq<¿N~/ͰkT7ucR1X cbFe*Ec@3֫nb(z3D]x1kKc<2aSoϏ}8?=PŃw/+G#U3X’W N~3U ՚HG2#uj)Uh'$$aï_=&"@-U;EզI˶NDY cu|2b_j7pEC+Z^( =[鈺'i0 uH= Ua=Gt+Ӱڥ(t{ %U3!8voʳ'}ɲ(3U26Ԣ-gl}Ãy]k6h,c=xNp {aE?'ނ9jvu֞qc g8:{&U>0 YZlme4/data/Dyestuff2.rda0000644000176200001440000000065113751775607014413 0ustar liggesusers r0b```b`@& `bNvL-.)MK3b``+d`d*BLX03̂blŁl9e9@THp1a pC359'f$ܢ" APeŕ|Gf/}ÁOhwz?F㛃Cu"U,#|/?.ٓUd7STh4h:]2A랩}ۉb\s9(w]I/EA8h‘92quJ_|csPA] tѯ$Jf Ȗ{[D9+<` r Nsc+qz0%‚ &XDf椠'r=VPRbjQ-RKҊZplme4/data/grouseticks.rda0000644000176200001440000001263313751775607015105 0ustar liggesusers\ \E} $<7B!^B $wf9pO^#/ ! @/! ܶ>jTK4Z-}ǭZ[j6hR@;gΙ{h˗y}3vvGj))'#;u S kv]nvnՎ8 +l/\>v0 8{Mm}Dv<Z t; 1d`6p*pt`.<8 ,s@4`&1- 8X ,XV`X e&rEO/^ x9p%~ \l^\ x\\nvhM-ۀہ`/pp'0 ~9o~x# /~xK*k[oun7o~ x.^}~?O?_50 a#G |; |pp?iA y+oa |*#< 75 uǁ'o|]{Sn+     Wu       ĿB+ĿB+ĿB+ĿB+ĿB+ĿB+ĿB+ĿjWWWWWWWWWWWWWW@+ĿB+ĿB+ĿB+ĿB+ĿB+ĿB+ĿB-_!_!_!_!_!_!_!_       j@+ĿB+ĿB+ĿB+ĿB+ĿB+ĿB+ĿB}_!;%#oe+ջgǎveNSv"ىe'Δw{t{ۋ^Znihvihvihqiaqiaqi4Fi4Fi4Fi4Fi4FiDN#rӈF4"9iDN#rӈF4b;iN#vӈF48i$N#qHF4r-r-r-r-r-vmvmvmvmvm8n?w5w w܍s7nTZ?O~SjTZ?4444444444 ՚TkRI&՚TkRI&՚TkR-ZDj"ETQ-ZDj1bTS-ZLj1%TKP-ZBj %TkQEZTkQEZTkQE6TkSM6TkSM6%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%^b%MzI^Ҥ4;^uЍv"WmΈmgx;6ӖN:z+ ,Yr-9^9f]/l-[nX^?57Y\PzyN:W_g??Z?_qʟwϕ#AGݲtƾnx,Wql|rWNN8]_G+lN^wsB9{΋`9z,/XSuqNY^9f A[ȻOBҏYwW{|ɿ.p~BU q=/oz ?ϳ^{>T_ :;\@By4|ݲE9zڪj,lPS3Ulvd pB fD'e0˃d4eqdA$[*28Z>J2B8, `Q`qL/3%05f "qI Z%hט]&8KKL2 Ԙcy+2fIF .1ǥ@2|l`c $Npy/lWԘ%j\Y- Y2ؖH`֘9c{;jB, vyLD5f%"rαѳcj"G8>q|>|A#G8(qP>|A#G8(qP>H|đ#GR8m,#G8 q~=yǍ >8RU~y7c}|0ϡ#{c?ԞG&p6&@rrBc6+C6'A6'SOgֺ$em0X-CO xGc'bliLs=OyX3_w\0.|ݛxY+'z}\Y| /ؽtcO ^v[/p:ϻg}ϼyusPyVUCG>:8 U|g>3ڴ#Fr">B|y>_Oڵ..96^<ڰGX=VKY}ˣ(_p6.}cUJ<^}\*mze*UJ[j\[H:NSߡCOuUC7 -zn{ `rkja˂QxʩJa;ڡKv\ݝ\ [ygnx/ dƶª驖euqm{_4O7\r/Ogwϟa{4p+g}[}[;ܯ <08M翏X{9<{OЎ{.]t_:߾yO\=_^yfr[t}_4s}>\==yo>K9[ʒֻm}'{ϲ1זouIaվ-g:#>"4փ>U>ac~t)^_&zǥ-W/<;QL](#} m϶8ͶOpuGw_qW}o_X=o<>>=slw帠/OջO^OR9}Gܷ>n3^5m8{\}V@]yN~(:/+K%us)Vwuy=[1.N7ڸaAx *-z m[3nx0|}J]L+׸_֭c׵/ۯW_>?~?xN- Z36Zp=oSʯ>_uWXE'Ƿt n$juZp5-7ګjKChUSaS#>UHEV_SXSCp}~joKh*^ (W_ZP!@m\=>_ }% :<Ȁ/}5IdY*Y**Q?C4)ٙlMɼ KɞIoHɀFdlvdMUlf\'cYw,lVdI\6-Vhl5Nihݽll4| ee^XeVgmYY~vU(kςf fE^P(;g4^L!nVl?)d{8 ?K"g1Y ~B {^aVߟ}͖W~flshٟ5-Yکnb6;:cǶ벓oڕ}}:Cou:/ *wlme4/man/0000755000176200001440000000000014176255662011704 5ustar liggesuserslme4/man/GQdk.Rd0000644000176200001440000000336013751775607013027 0ustar liggesusers\name{GQdk} \title{Sparse Gaussian / Gauss-Hermite Quadrature grid} \alias{GQdk} \alias{GQN} \description{ Generate the sparse multidimensional Gaussian quadrature grids. Currently unused. See \code{\link{GHrule}()} for the version currently in use in package \pkg{lme4}. } \usage{ GQdk(d = 1L, k = 1L) GQN } \arguments{ \item{d}{integer scalar - the dimension of the function to be integrated with respect to the standard \code{d}-dimensional Gaussian density.} \item{k}{integer scalar - the order of the grid. A grid of order \code{k} provides an exact result for a polynomial of total order of \code{2k - 1} or less.} } \value{ \code{GQdk()} returns a matrix with \code{d + 1} columns. The first column is the weights and the remaining \code{d} columns are the node coordinates. \code{GQN} is a \code{\link{list}} of lists, containing the non-redundant quadrature nodes and weights for integration of a scalar function of a \code{d}-dimensional argument with respect to the density function of the \code{d}-dimensional Gaussian density function. \cr The outer list is indexed by the dimension, \code{d}, in the range of 1 to 20. The inner list is indexed by \code{k}, the order of the quadrature. } \note{ \code{GQN} contains only the non-redundant nodes. To regenerate the whole array of nodes, all possible permutations of axes and all possible combinations of \eqn{\pm 1}{+/- 1} must be applied to the axes. This entire array of nodes is exactly what \code{\link{GQdk}()} reproduces. The number of nodes gets very large very quickly with increasing \code{d} and \code{k}. See the charts at \url{http://www.sparse-grids.de}. } \examples{ GQdk(2,5) # 53 x 3 GQN[[3]][[5]] # a 14 x 4 matrix } lme4/man/refitML.Rd0000644000176200001440000000160413751775607013542 0ustar liggesusers\name{refitML} \title{Refit a Model by Maximum Likelihood Criterion} \alias{refitML} \alias{refitML.merMod} \description{ Refit a (\code{merMod}) model using the maximum likelihood criterion. } \usage{ refitML(x, \dots) \method{refitML}{merMod} (x, optimizer = "bobyqa", \dots) } \arguments{ \item{x}{a fitted model, usually of class \code{"\linkS4class{lmerMod}"}, to be refit according to the maximum likelihood criterion.} \item{\dots}{optional additional parameters. None are used at present.} \item{optimizer}{a string indicating the optimizer to be used.} } \value{ an object like \code{x} but fit by maximum likelihood } \details{ This function is primarily used to get a maximum likelihood fit of a linear mixed-effects model for an \code{\link{anova}} comparison. } \seealso{ \code{\link{refit}} and \code{\link{update.merMod}} for more extensive refitting. } lme4/man/mkSimulationTemplate.Rd0000644000176200001440000000175313751775607016355 0ustar liggesusers\name{mkSimulateTemplate} \title{Make templates suitable for guiding mixed model simulations} \alias{mkParsTemplate} \alias{mkDataTemplate} \description{ Make data and parameter templates suitable for guiding mixed model simulations, by specifying a model formula and other information (EXPERIMENTAL). Most useful for simulating balanced designs and for getting started on unbalanced simulations. } \usage{ mkParsTemplate(formula, data) mkDataTemplate(formula, data, nGrps = 2, nPerGrp = 1, rfunc = NULL, ...) } \arguments{ \item{formula}{A mixed model formula (see \code{\link{lmer}}).} \item{data}{A data frame containing the names in \code{formula}.} \item{nGrps}{Number of levels of a grouping factor.} \item{nPerGrp}{Number of observations per level.} \item{rfunc}{Function for generating covariate data (e.g. \code{\link{rnorm}}.} \item{...}{Additional parameters for \code{rfunc}.} } \seealso{ These functions are designed to be used with \code{\link{simulate.merMod}}. } lme4/man/Arabidopsis.Rd0000644000176200001440000000374614063503234014427 0ustar liggesusers\name{Arabidopsis} \alias{Arabidopsis} \docType{data} \title{ Arabidopsis clipping/fertilization data } \description{ Data on genetic variation in responses to fertilization and simulated herbivory in \emph{Arabidopsis} } \usage{data("Arabidopsis")} \format{ A data frame with 625 observations on the following 8 variables. \describe{ \item{\code{reg}}{region: a factor with 3 levels \code{NL} (Netherlands), \code{SP} (Spain), \code{SW} (Sweden)} \item{\code{popu}}{population: a factor with the form \code{n.R} representing a population in region \code{R}} \item{\code{gen}}{genotype: a factor with 24 (numeric-valued) levels} \item{\code{rack}}{a nuisance factor with 2 levels, one for each of two greenhouse racks} \item{\code{nutrient}}{fertilization treatment/nutrient level (1, minimal nutrients or 8, added nutrients)} \item{\code{amd}}{simulated herbivory or "clipping" (apical meristem damage): \code{unclipped} (baseline) or \code{clipped}} \item{\code{status}}{a nuisance factor for germination method (\code{Normal}, \code{Petri.Plate}, or \code{Transplant})} \item{\code{total.fruits}}{total fruit set per plant (integer)} } } \source{ From Josh Banta } \references{ Joshua A. Banta, Martin H. H Stevens, and Massimo Pigliucci (2010) A comprehensive test of the 'limiting resources' framework applied to plant tolerance to apical meristem damage. \emph{Oikos} \bold{119}(2), 359--369; \doi{10.1111/j.1600-0706.2009.17726.x} } \examples{ data(Arabidopsis) summary(Arabidopsis[,"total.fruits"]) table(gsub("[0-9].","",levels(Arabidopsis[,"popu"]))) library(lattice) stripplot(log(total.fruits+1) ~ amd|nutrient, data = Arabidopsis, groups = gen, strip=strip.custom(strip.names=c(TRUE,TRUE)), type=c('p','a'), ## points and panel-average value -- ## see ?panel.xyplot scales=list(x=list(rot=90)), main="Panel: nutrient, Color: genotype") } \keyword{datasets} lme4/man/Pastes.Rd0000644000176200001440000000541013751775607013436 0ustar liggesusers\docType{data} \name{Pastes} \alias{Pastes} \title{Paste strength by batch and cask} \format{A data frame with 60 observations on the following 4 variables. \describe{ \item{\code{strength}}{paste strength.} \item{\code{batch}}{delivery batch from which the sample was sample. A factor with 10 levels: \sQuote{A} to \sQuote{J}.} \item{\code{cask}}{cask within the delivery batch from which the sample was chosen. A factor with 3 levels: \sQuote{a} to \sQuote{c}.} \item{\code{sample}}{the sample of paste whose strength was assayed, two assays per sample. A factor with 30 levels: \sQuote{A:a} to \sQuote{J:c}.} }} \source{ O.L. Davies and P.L. Goldsmith (eds), \emph{Statistical Methods in Research and Production, 4th ed.}, Oliver and Boyd, (1972), section 6.5 } \description{ Strength of a chemical paste product; its quality depending on the delivery batch, and the cask within the delivery. } \details{ The data are described in Davies and Goldsmith (1972) as coming from \dQuote{ deliveries of a chemical paste product contained in casks where, in addition to sampling and testing errors, there are variations in quality between deliveries \dots{} As a routine, three casks selected at random from each delivery were sampled and the samples were kept for reference. \dots{} Ten of the delivery batches were sampled at random and two analytical tests carried out on each of the 30 samples}. } \examples{ str(Pastes) require(lattice) dotplot(cask ~ strength | reorder(batch, strength), Pastes, strip = FALSE, strip.left = TRUE, layout = c(1, 10), ylab = "Cask within batch", xlab = "Paste strength", jitter.y = TRUE) ## Modifying the factors to enhance the plot Pastes <- within(Pastes, batch <- reorder(batch, strength)) Pastes <- within(Pastes, sample <- reorder(reorder(sample, strength), as.numeric(batch))) dotplot(sample ~ strength | batch, Pastes, strip = FALSE, strip.left = TRUE, layout = c(1, 10), scales = list(y = list(relation = "free")), ylab = "Sample within batch", xlab = "Paste strength", jitter.y = TRUE) ## Four equivalent models differing only in specification (fm1 <- lmer(strength ~ (1|batch) + (1|sample), Pastes)) (fm2 <- lmer(strength ~ (1|batch/cask), Pastes)) (fm3 <- lmer(strength ~ (1|batch) + (1|batch:cask), Pastes)) (fm4 <- lmer(strength ~ (1|batch/sample), Pastes)) ## fm4 results in redundant labels on the sample:batch interaction head(ranef(fm4)[[1]]) ## compare to fm1 head(ranef(fm1)[[1]]) ## This model is different and NOT appropriate for these data (fm5 <- lmer(strength ~ (1|batch) + (1|cask), Pastes)) L <- getME(fm1, "L") Matrix::image(L, sub = "Structure of random effects interaction in pastes model") } \keyword{datasets} lme4/man/glmerLaplaceHandle.Rd0000644000176200001440000000112413751775607015701 0ustar liggesusers\name{glmerLaplaceHandle} \alias{glmerLaplaceHandle} \title{Handle for \code{glmerLaplace}} \usage{ glmerLaplaceHandle(pp, resp, nAGQ, tol, maxit, verbose) } \arguments{ \item{pp}{\code{\link{merPredD}} object} \item{resp}{\code{\link{lmResp}} object} \item{nAGQ}{see \code{\link{glmer}}} \item{tol}{tolerance} \item{maxit}{maximum number of pwrss iterations} \item{verbose}{display optimizer progress} } \description{ Handle for calling the \code{glmerLaplace} \code{C++} function. Not intended for routine use. } \value{ Value of the objective function } \keyword{utilities} lme4/man/NelderMead-class.Rd0000644000176200001440000000330113751775607015277 0ustar liggesusers\docType{class} \name{NelderMead-class} \alias{NelderMead} \alias{NelderMead-class} \title{Class \code{"NelderMead"} of Nelder-Mead optimizers and its Generator} \description{ Class \code{"NelderMead"} is a reference class for a Nelder-Mead simplex optimizer allowing box constraints on the parameters and using reverse communication. The \code{NelderMead()} function conveniently generates such objects. } \usage{ NelderMead(...) } \arguments{ \item{\dots}{Argument list (see Note below).} } \note{ This is the default optimizer for the second stage of \code{\link{glmer}} and \code{\link{nlmer}} fits. We found that it was more reliable and often faster than more sophisticated optimizers. Arguments to \code{NelderMead()} and the \code{\link{new}} method must be named arguments: \describe{ \item{lower}{numeric vector of lower bounds - elements may be \code{-Inf}.} \item{upper}{numeric vector of upper bounds - elements may be \code{Inf}.} \item{xst}{numeric vector of initial step sizes to establish the simplex - all elements must be non-zero.} \item{x0}{numeric vector of starting values for the parameters.} \item{xt}{numeric vector of tolerances on the parameters.} } } \section{Methods}{ \describe{\code{NelderMead$new(lower, upper, xst, x0, xt)}}{Create a new \code{\linkS4class{NelderMead}} object} } \section{Extends}{ All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. } \references{ Based on code in the NLopt collection. } \seealso{ \code{\link{Nelder_Mead}}, the typical \dQuote{constructor}. Further, \code{\link{glmer}}, \code{\link{nlmer}} } \examples{ showClass("NelderMead") } \keyword{classes} lme4/man/isNested.Rd0000644000176200001440000000106413751775607013756 0ustar liggesusers\name{isNested} \alias{isNested} \title{Is f1 nested within f2?} \usage{ isNested(f1, f2) } \arguments{ \item{f1}{factor 1} \item{f2}{factor 2} } \value{ TRUE if factor 1 is nested within factor 2 } \description{ Does every level of f1 occur in conjunction with exactly one level of f2? The function is based on converting a triplet sparse matrix to a compressed column-oriented form in which the nesting can be quickly evaluated. } \examples{ with(Pastes, isNested(cask, batch)) ## => FALSE with(Pastes, isNested(sample, batch)) ## => TRUE } lme4/man/nlformula.Rd0000644000176200001440000000364613751775607014207 0ustar liggesusers\name{nlformula} \alias{nlformula} \title{Manipulate a Nonlinear Model Formula} \description{ Check and manipulate the formula for a nonlinear model, such as specified in \code{\link{nlmer}}. } \usage{ nlformula(mc) } \arguments{ \item{mc}{matched call from the calling function, typically \code{\link{nlmer}()}. Should have arguments named \describe{ \item{formula:}{a formula of the form \code{resp ~ nlmod ~ meform} where \code{resp} is an expression for the response, \code{nlmod} is the nonlinear model expression and \code{meform} is the mixed-effects model formula. \code{resp} can be omitted when, e.g., optimizing a design.} \item{data:}{a data frame in which to evaluate the model function} \item{start:}{either a numeric vector containing initial estimates for the nonlinear model parameters or a list with components \describe{ \item{\code{nlpars}:}{the initial estimates of the nonlinear model parameters} \item{\code{theta}:}{the initial estimates of the variance component parameters} } } } } } \value{ a list with components \item{"respMod"}{a response module of class \code{"\linkS4class{nlsResp}"}} \item{"frame"}{the model frame, including a terms attribute} \item{"X"}{the fixed-effects model matrix} \item{"reTrms"}{the random-effects terms object} } \details{ The model formula for a nonlinear mixed-effects model is of the form \code{resp ~ nlmod ~ mixed} where \code{resp} is an expression (usually just a name) for the response, \code{nlmod} is the call to the nonlinear model function, and \code{mixed} is the mixed-effects formula defining the linear predictor for the parameter matrix. If the formula is to be used for optimizing designs, the \code{resp} part can be omitted. } \seealso{ Other utilities: \code{\link{findbars}}, \code{\link{mkRespMod}}, \code{\link{mkReTrms}}, \code{\link{nobars}}, \code{\link{subbars}} } lme4/man/lme4_testlevel.Rd0000644000176200001440000000061614063503234015110 0ustar liggesusers\name{lme4_testlevel} \alias{lme4_testlevel} \title{Detect testing level for lme4 examples and tests} \description{ Reads the environment variable \code{LME4_TEST_LEVEL} to determine which tests and examples to run } \usage{ lme4_testlevel() } \value{ a numeric value: 1 for standard/'light' testing, larger values for more testing. Defaults to 1 if the environment variable is not set. } lme4/man/cake.Rd0000644000176200001440000000415613751775607013110 0ustar liggesusers\docType{data} \name{cake} \alias{cake} \title{Breakage Angle of Chocolate Cakes} \format{A data frame with 270 observations on the following 5 variables. \describe{ \item{\code{replicate}}{a factor with levels \code{1} to \code{15}} \item{\code{recipe}}{a factor with levels \code{A}, \code{B} and \code{C}} \item{\code{temperature}}{an ordered factor with levels \code{175} < \code{185} < \code{195} < \code{205} < \code{215} < \code{225}} \item{\code{angle}}{a numeric vector giving the angle at which the cake broke.} \item{\code{temp}}{numeric value of the baking temperature (degrees F).} }} \source{ Original data were presented in Cook (1938), and reported in Cochran and Cox (1957, p. 300). Also cited in Lee, Nelder and Pawitan (2006). } \description{ Data on the breakage angle of chocolate cakes made with three different recipes and baked at six different temperatures. This is a split-plot design with the recipes being whole-units and the different temperatures being applied to sub-units (within replicates). The experimental notes suggest that the replicate numbering represents temporal ordering. } \details{ The \code{replicate} factor is nested within the \code{recipe} factor, and \code{temperature} is nested within \code{replicate}. } \references{ Cook, F. E. (1938) \emph{Chocolate cake, I. Optimum baking temperature}. Master's Thesis, Iowa State College. Cochran, W. G., and Cox, G. M. (1957) \emph{Experimental designs}, 2nd Ed. New York, John Wiley \& Sons. Lee, Y., Nelder, J. A., and Pawitan, Y. (2006) \emph{Generalized linear models with random effects. Unified analysis via H-likelihood}. Boca Raton, Chapman and Hall/CRC. } \examples{ str(cake) ## 'temp' is continuous, 'temperature' an ordered factor with 6 levels (fm1 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake, REML= FALSE)) (fm2 <- lmer(angle ~ recipe + temperature + (1|recipe:replicate), cake, REML= FALSE)) (fm3 <- lmer(angle ~ recipe + temp + (1|recipe:replicate), cake, REML= FALSE)) ## and now "choose" : anova(fm3, fm2, fm1) } \keyword{datasets} lme4/man/allFit.Rd0000644000176200001440000001157214063503234013376 0ustar liggesusers\name{allFit} \alias{allFit} \title{Refit a fitted model with all available optimizers} \usage{ allFit(object, meth.tab = NULL, data=NULL, verbose = TRUE, show.meth.tab = FALSE, maxfun = 1e5, parallel = c("no", "multicore", "snow"), ncpus = getOption("allFit.ncpus", 1L), cl = NULL, catch.errs = TRUE) } \arguments{ \item{object}{a fitted model} \item{meth.tab}{a matrix (or data.frame) with columns \describe{ \item{method}{the name of a specific optimization method to pass to the optimizer (leave blank for built-in optimizers)} \item{optimizer}{the \code{optimizer} function to use} } } \item{data}{data to be included with result (for later debugging etc.)} \item{verbose}{logical: report progress in detail?} \item{show.meth.tab}{logical: return table of methods?} \item{maxfun}{passed as part of \code{optCtrl} (see \code{\link{lmeControl}})} \item{parallel}{The type of parallel operation to be used (if any). If missing, the default is taken from the option \code{"boot.parallel"} (and if that is not set, \code{"no"}).} \item{ncpus}{integer: number of processes to be used in parallel operation: typically one would choose this to be the number of available CPUs. Use \code{options(allFit.ncpus=X)} to set the default value to \code{X} for the duration of an R session.} \item{cl}{An optional \pkg{parallel} or \pkg{snow} cluster for use if \code{parallel = "snow"}. If not supplied, a cluster on the local machine is created for the duration of the \code{boot} call.} \item{catch.errs}{(logical) Wrap model fits in \code{tryCatch} clause to skip over errors? (\code{catch.errs=FALSE} is probably only useful for debugging)} } \value{ an object of type \code{allFit}, which is a list of fitted \code{merMod} objects (unless \code{show.meth.tab} is specified, in which case a data frame of methods is returned). The \code{summary} method for this class extracts tables with a variety of useful information about the different fits (see examples). } \description{ Attempt to re-fit a [g]lmer model with a range of optimizers. The default is to use all known optimizers for R that satisfy the requirements (i.e. they do not require functions and allow box constraints: see \sQuote{optimizer} in \code{\link{lmerControl}}). These optimizers fall in four categories; (i) built-in (minqa::bobyqa, lme4::Nelder_Mead, nlminbwrap), (ii) wrapped via optimx (most of optimx's optimizers that allow box constraints require an explicit gradient function to be specified; the two provided here are the base R functions that can be accessed via optimx), (iii) wrapped via nloptr (see examples for the list of options), (iv) \sQuote{dfoptim::nmkb} (via the (unexported) \code{nmkbw} wrapper: this appears as \sQuote{nmkbw} in \code{meth.tab}) } \details{ \itemize{ \item Needs packages \code{optimx}, and \code{dfoptim} to use all optimizers \item If you are using \code{parallel="snow"} (e.g. when running in parallel on Windows), you will need to set up a cluster yourself and run \code{clusterEvalQ(cl,library("lme4"))} before calling \code{allFit} to make sure that the \code{lme4} package is loaded on all of the workers \item Control arguments in \code{control$optCtrl} that are unused by a particular optimizer will be \emph{silently} ignored (in particular, the \code{maxfun} specification is only respected by \code{bobyqa}, \code{Nelder_Mead}, and \code{nmkbw}) \item Because \code{allFit} works by calling \code{update}, it may be fragile if the original model call contains references to variables, especially if they were originally defined in other environments or no longer exist when \code{allFit} is called. } } \seealso{\code{slice},\code{slice2D} from the \CRANpkg{bbmle} package} \examples{ if (interactive()) { library(lme4) gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) ## show available methods allFit(show.meth.tab=TRUE) gm_all <- allFit(gm1) ss <- summary(gm_all) ss$which.OK ## logical vector: which optimizers worked? ## the other components only contain values for the optimizers that worked ss$llik ## vector of log-likelihoods ss$fixef ## table of fixed effects ss$sdcor ## table of random effect SDs and correlations ss$theta ## table of random effects parameters, Cholesky scale } %% interactive() \dontrun{ ## Parallel examples for Windows nc <- detectCores()-1 optCls <- makeCluster(nc, type = "SOCK") clusterEvalQ(optCls,library("lme4")) ### not necessary here because using a built-in ## data set, but in general you should clusterExport() your data clusterExport(optCls, "cbpp") system.time(af1 <- allFit(m0, parallel = 'snow', ncpus = nc, cl=optCls)) stopCluster(optCls) } %% dontrun } %% examples \keyword{models} lme4/man/nloptwrap.Rd0000644000176200001440000001006313751775607014225 0ustar liggesusers\name{nloptwrap} \alias{nloptwrap} \alias{nlminbwrap} \title{Wrappers for additional optimizers} \description{ Wrappers to allow use of alternative optimizers, from the \command{NLopt} library (via \CRANpkg{nloptr}) or elsewhere, for the nonlinear optimization stage. } \usage{ nloptwrap (par, fn, lower, upper, control = list(), ...) nlminbwrap(par, fn, lower, upper, control = list(), ...) } \arguments{ \item{par}{starting parameter vector} \item{fn}{objective function} \item{lower, upper}{numeric vector of lower and upper bounds.} \item{control}{\code{\link{list}} of control parameters, corresponding to \code{optCtrl = *}, e.g., in \code{\link{lmerControl}()}. For \code{nloptwrap}, see \code{defaultControl} in \sQuote{Details}.} \item{\dots}{additional arguments to be passed to objective function} } \value{ \item{par}{estimated parameters} \item{fval}{objective function value at minimum} \item{feval}{number of function evaluations} \item{conv}{convergence code (0 if no error)} \item{message}{convergence message} } \details{ Using alternative optimizers is an important trouble-shooting tool for mixed models. These wrappers provide convenient access to the optimizers provided by Steven Johnson's \code{NLopt} library (via the \CRANpkg{nloptr} R package), and to the \code{\link{nlminb}} optimizer from base R. \code{nlminb} is also available via the \CRANpkg{optimx} package; this wrapper provides access to \code{nlminb()} without the need to install/link the package, and without the additional post-fitting checks that are implemented by \CRANpkg{optimx} (see examples below). One important difference between the \CRANpkg{nloptr}-provided implementation of BOBYQA and the \CRANpkg{minqa}-provided version accessible via \code{optimizer="bobyqa"} is that it provides simpler access to optimization tolerances. \code{\link[minqa]{bobyqa}} provides only the \code{rhoend} parameter (\dQuote{[t]he smallest value of the trust region radius that is allowed}), while \pkg{nloptr} provides a more standard set of tolerances for relative or absolute change in the objective function or the parameter values (\code{ftol_rel}, \code{ftol_abs}, \code{xtol_rel}, \code{xtol_abs}). The default (empty) \code{control} list corresponds to the following settings: \describe{ \item{\code{nlminbwrap}:}{\code{control} exactly corresponds to \code{\link{nlminb}()}'s defaults, see there.} \item{\code{nloptwrap}:}{\code{environment(nloptwrap)$defaultControl} contains the defaults, notably \code{algorithm = "NLOPT_LN_BOBYQA"}. \code{nloptr::nloptr.print.options()} shows and explains the many possible algorithm and options.} } } \examples{ library(lme4) ls.str(environment(nloptwrap)) # 'defaultControl' algorithm "NLOPT_LN_BOBYQA" ## Note that 'optimizer = "nloptwrap"' is now the default for lmer() : fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ## tighten tolerances fm1B <- update(fm1, control= lmerControl(optCtrl = list(xtol_abs=1e-8, ftol_abs=1e-8))) ## run for longer (no effect in this case) fm1C <- update(fm1,control = lmerControl(optCtrl = list(maxeval=10000))) logLik(fm1B) - logLik(fm1) ## small difference in log likelihood c(logLik(fm1C) - logLik(fm1)) ## no difference in LL ## Nelder-Mead fm1_nloptr_NM <- update(fm1, control= lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD"))) ## other nlOpt algorithm options include NLOPT_LN_COBYLA, NLOPT_LN_SBPLX, see if(interactive())% (the package *is* installed w/ 'lme4') nloptr::nloptr.print.options() fm1_nlminb <- update(fm1, control=lmerControl(optimizer = "nlminbwrap")) if (require(optimx)) { ## the 'optimx'-based nlminb : fm1_nlminb2 <- update(fm1, control= lmerControl(optimizer = "optimx", optCtrl = list(method="nlminb", kkt=FALSE))) cat("Likelihood difference (typically zero): ", c(logLik(fm1_nlminb) - logLik(fm1_nlminb2)), "\n") } } \author{Gabor Grothendieck (\code{nlminbwrap})}% Ben Bolker for nloptwrap lme4/man/nobars.Rd0000644000176200001440000000161213751775607013463 0ustar liggesusers\name{nobars} \alias{nobars} \title{Omit terms separated by vertical bars in a formula} \usage{ nobars(term) } \arguments{ \item{term}{the right-hand side of a mixed-model formula} } \value{ the fixed-effects part of the formula } \description{ Remove the random-effects terms from a mixed-effects formula, thereby producing the fixed-effects formula. } \note{ This function is called recursively on individual terms in the model, which is why the argument is called \code{term} and not a name like \code{form}, indicating a formula. } \examples{ nobars(Reaction ~ Days + (Days|Subject)) ## => Reaction ~ Days } \seealso{ \code{\link{formula}}, \code{\link{model.frame}}, \code{\link{model.matrix}}. Other utilities: \code{\link{findbars}}, \code{\link{mkRespMod}}, \code{\link{mkReTrms}}, \code{\link{nlformula}}, \code{\link{subbars}} } \keyword{models} \keyword{utilities} lme4/man/merPredD-class.Rd0000644000176200001440000000275713751775607015017 0ustar liggesusers\name{merPredD-class} \alias{merPredD-class} \title{Class \code{"merPredD"} - a Dense Predictor Reference Class} \description{ A reference class (see mother class definition \code{"\linkS4class{envRefClass}"} for a mixed-effects model predictor module with a dense model matrix for the fixed-effects parameters. The reference class is associated with a C++ class of the same name. As is customary, the generator object, \code{\link{merPredD}}, for the class has the same name as the class. } \note{ Objects from this reference class correspond to objects in a C++ class. Methods are invoked on the C++ class object using the external pointer in the \code{Ptr} field. When saving such an object the external pointer is converted to a null pointer, which is why there are redundant fields containing enough information as \R objects to be able to regenerate the C++ object. The convention is that a field whose name begins with an upper-case letter is an \R object and the corresponding field, whose name begins with the lower-case letter is a method. References to the external pointer should be through the method, not directly through the \code{Ptr} field. } \examples{ showClass("merPredD") pp <- slot(lmer(Yield ~ 1|Batch, Dyestuff), "pp") stopifnot(is(pp, "merPredD")) str(pp) # an overview of all fields and methods' names. } \seealso{ \code{\link{lmer}}, \code{\link{glmer}}, \code{\link{nlmer}}, \code{\link{merPredD}}, \code{\linkS4class{merMod}}. } \keyword{classes} lme4/man/glmFamily.Rd0000644000176200001440000000114713751775607014123 0ustar liggesusers\name{glmFamily} \alias{glmFamily} \title{Generator object for the \code{\linkS4class{glmFamily}} class} \usage{ glmFamily(...) } \arguments{ \item{...}{Named argument (see Note below)} } \description{ The generator object for the \code{\linkS4class{glmFamily}} reference class. Such an object is primarily used through its \code{new} method. } \note{ Arguments to the \code{new} method must be named arguments. } \section{Methods}{ \describe{ \item{\code{new(family=family)}}{Create a new \code{\linkS4class{glmFamily}} object} } } \seealso{ \code{\linkS4class{glmFamily}} } \keyword{classes} lme4/man/lmResp-class.Rd0000644000176200001440000000340313751775607014544 0ustar liggesusers\name{lmResp-class} \title{Reference Classes for Response Modules, \code{"(lm|glm|nls|lmer)Resp"}} \alias{glmResp-class} \alias{lmerResp-class} \alias{lmResp-class} \alias{nlsResp-class} \description{ Reference classes for response modules, including linear models, \code{"lmResp"}, generalized linear models, \code{"glmResp"}, nonlinear models, \code{"nlsResp"} and linear mixed-effects models, \code{"lmerResp"}. Each reference class is associated with a C++ class of the same name. As is customary, the generator object for each class has the same name as the class. } \section{Extends}{ All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. Furthermore, \code{"glmResp"}, \code{"nlsResp"} and \code{"lmerResp"} all extend the \code{"lmResp"} class. } \note{ Objects from these reference classes correspond to objects in C++ classes. Methods are invoked on the C++ classes using the external pointer in the \code{ptr} field. When saving such an object the external pointer is converted to a null pointer, which is why there are redundant fields containing enough information as R objects to be able to regenerate the C++ object. The convention is that a field whose name begins with an upper-case letter is an R object and the corresponding field whose name begins with the lower-case letter is a method. Access to the external pointer should be through the method, not through the field. } \examples{ showClass("lmResp") str(lmResp$new(y=1:4)) showClass("glmResp") str(glmResp$new(family=poisson(), y=1:4)) showClass("nlsResp") showClass("lmerResp") str(lmerResp$new(y=1:4)) } \seealso{ \code{\link{lmer}}, \code{\link{glmer}}, \code{\link{nlmer}}, \code{\linkS4class{merMod}}. } \keyword{classes} lme4/man/GHrule.Rd0000644000176200001440000000257013751775607013371 0ustar liggesusers\name{GHrule} \alias{GHrule} \title{Univariate Gauss-Hermite quadrature rule} \description{ Create a univariate Gauss-Hermite quadrature rule. } \usage{ GHrule(ord, asMatrix = TRUE) } \arguments{ \item{ord}{scalar integer between 1 and 25 - the order, or number of nodes and weights, in the rule. When the function being multiplied by the standard normal density is a polynomial of order 2k-1 the rule of order k integrates the product exactly.} \item{asMatrix}{logical scalar - should the result be returned as a matrix. If \code{FALSE} a data frame is returned. Defaults to \code{TRUE}.} } \value{ a matrix (or data frame, is \code{asMatrix} is false) with \code{ord} rows and three columns which are \code{z} the node positions, \code{w} the weights and \code{ldnorm}, the logarithm of the normal density evaluated at the nodes. } \details{ This version of Gauss-Hermite quadrature provides the node positions and weights for a scalar integral of a function multiplied by the standard normal density. Originally based on package \pkg{SparseGrid}'s hidden \code{GQN()}. } \seealso{a different interface is available via \code{\link{GQdk}()}. } \examples{ (r5 <- GHrule(5, asMatrix=FALSE)) ## second, fourth, sixth, eighth and tenth central moments of the ## standard Gaussian density with(r5, sapply(seq(2, 10, 2), function(p) sum(w * z^p))) } lme4/man/mkVarCorr.Rd0000644000176200001440000000114013751775607014101 0ustar liggesusers\name{mkVarCorr} \title{Make Variance and Correlation Matrices from \code{theta}} \alias{mkVarCorr} \usage{ mkVarCorr(sc, cnms, nc, theta, nms) } \description{ Make variance and correlation matrices from \code{theta} } \arguments{ \item{sc}{scale factor (residual standard deviation).} \item{cnms}{component names.} \item{nc}{numeric vector: number of terms in each RE component.} \item{theta}{theta vector (lower-triangle of Cholesky factors).} \item{nms}{component names (FIXME: nms/cnms redundant: nms=names(cnms)?)} } \value{ A \code{\link{matrix}} } \seealso{ \code{\link{VarCorr}} } lme4/man/ranef.Rd0000644000176200001440000001340414062244632013255 0ustar liggesusers\name{ranef} \alias{ranef} \alias{ranef.merMod} \alias{dotplot.ranef.mer} \alias{qqmath.ranef.mer} \alias{as.data.frame.ranef.mer} \title{Extract the modes of the random effects} \usage{ \method{ranef}{merMod} (object, condVar = TRUE, drop = FALSE, whichel = names(ans), postVar = FALSE, ...) \method{dotplot}{ranef.mer} (x, data, main = TRUE, transf = I, ...) \method{qqmath}{ranef.mer} (x, data, main = TRUE, ...) \method{as.data.frame}{ranef.mer} (x, ..., stringsAsFactors = default.stringsAsFactors()) } \arguments{ \item{object}{an object of a class of fitted models with random effects, typically a \code{\linkS4class{merMod}} object.} \item{condVar}{a logical argument indicating if the conditional variance-covariance matrices of the random effects should be added as an attribute.} \item{drop}{should components of the return value that would be data frames with a single column, usually a column called \sQuote{\code{(Intercept)}}, be returned as named vectors instead?} \item{whichel}{character vector of names of grouping factors for which the random effects should be returned.} \item{postVar}{a (deprecated) synonym for \code{condVar}} \item{x}{a random-effects object (of class \code{ranef.mer}) produced by \code{ranef}} \item{main}{include a main title, indicating the grouping factor, on each sub-plot?} \item{transf}{transformation for random effects: for example, \code{exp} for plotting parameters from a (generalized) logistic regression on the odds rather than log-odds scale} \item{data}{This argument is required by the \code{dotplot} and \code{qqmath} generic methods, but is not actually used.} \item{stringsAsFactors}{see \code{\link{data.frame}}} \item{\dots}{some methods for these generic functions require additional arguments.} } \value{ \itemize{ \item{ From \code{ranef}: An object of class \code{ranef.mer} composed of a list of data frames, one for each grouping factor for the random effects. The number of rows in the data frame is the number of levels of the grouping factor. The number of columns is the dimension of the random effect associated with each level of the factor. If \code{condVar} is \code{TRUE} each of the data frames has an attribute called \code{"postVar"}. \itemize{ \item If there is a single random-effects term for a given grouping factor, this attribute is a three-dimensional array with symmetric faces; each face contains the variance-covariance matrix for a particular level of the grouping factor. \item If there is more than one random-effects term for a given grouping factor (e.g. \code{(1|f) + (0+x|f)}), this attribute is a list of arrays as described above, one for each term. } (The name of this attribute is a historical artifact, and may be changed to \code{condVar} at some point in the future.) When \code{drop} is \code{TRUE} any components that would be data frames of a single column are converted to named numeric vectors. } \item{ From \code{as.data.frame}: This function converts the random effects to a "long format" data frame with columns \describe{ \item{grpvar}{grouping variable} \item{term}{random-effects term, e.g. \dQuote{(Intercept)} or \dQuote{Days}} \item{grp}{level of the grouping variable (e.g., which Subject)} \item{condval}{value of the conditional mean} \item{condsd}{conditional standard deviation} } } % as.data.frame value } % itemize } % value \description{ A generic function to extract the conditional modes of the random effects from a fitted model object. For linear mixed models the conditional modes of the random effects are also the conditional means. } \details{ If grouping factor i has k levels and j random effects per level the ith component of the list returned by \code{ranef} is a data frame with k rows and j columns. If \code{condVar} is \code{TRUE} the \code{"postVar"} attribute is an array of dimension j by j by k (or a list of such arrays). The kth face of this array is a positive definite symmetric j by j matrix. If there is only one grouping factor in the model the variance-covariance matrix for the entire random effects vector, conditional on the estimates of the model parameters and on the data, will be block diagonal; this j by j matrix is the kth diagonal block. With multiple grouping factors the faces of the \code{"postVar"} attributes are still the diagonal blocks of this conditional variance-covariance matrix but the matrix itself is no longer block diagonal. } \note{ To produce a (list of) \dQuote{caterpillar plots} of the random effects apply \code{\link[lattice:xyplot]{dotplot}} to the result of a call to \code{ranef} with \code{condVar = TRUE}; \code{\link[lattice:xyplot]{qqmath}} will generate a list of Q-Q plots. } \examples{ library(lattice) ## for dotplot, qqmath fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm2 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy) fm3 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin) ranef(fm1) str(rr1 <- ranef(fm1)) dotplot(rr1) ## default qqmath(rr1) ## specify free scales in order to make Day effects more visible dotplot(rr1,scales = list(x = list(relation = 'free')))[["Subject"]] ranef(fm2) op <- options(digits = 4) ranef(fm3, drop = TRUE) options(op) ## as.data.frame() provides RE's and conditional standard deviations: str(dd <- as.data.frame(rr1)) if (require(ggplot2)) { ggplot(dd, aes(y=grp,x=condval)) + geom_point() + facet_wrap(~term,scales="free_x") + geom_errorbarh(aes(xmin=condval -2*condsd, xmax=condval +2*condsd), height=0) } } \keyword{methods} \keyword{models} lme4/man/mkReTrms.Rd0000644000176200001440000001014514136006216013721 0ustar liggesusers\name{mkReTrms} \alias{mkReTrms} \alias{mkNewReTrms} \title{Make Random Effect Terms: Create Z, Lambda, Lind, etc.} \description{ From the result of \code{\link{findbars}} applied to a model formula and the evaluation frame \code{fr}, create the model matrix \code{Zt}, etc, associated with the random-effects terms. } \usage{ mkReTrms(bars, fr, drop.unused.levels=TRUE, reorder.terms=TRUE, reorder.vars=FALSE) mkNewReTrms(object, newdata, re.form=NULL, na.action=na.pass, allow.new.levels=FALSE, sparse = max(lengths(orig.random.levs)) > 100) } \arguments{ \item{bars}{a list of parsed random-effects terms} \item{fr}{a model frame in which to evaluate these terms} \item{drop.unused.levels}{(logical) drop unused factor levels?} \item{reorder.terms}{arrange random effects terms in decreasing order of number of groups (factor levels)?} \item{reorder.vars}{arrange columns of individual random effects terms in alphabetical order?} \item{object}{a fitted \code{merMod} object} \item{newdata}{data frame for which to create new RE terms object} \item{re.form}{(formula, \code{NULL}, or \code{NA}) specify which random effects to condition on when predicting. If \code{NULL}, include all random effects; if \code{NA} or \code{~0}, include no random effects} \item{na.action}{function determining what should be done with missing values for fixed effects in \code{newdata}} \item{allow.new.levels}{(logical) if new levels (or NA values) in \code{newdata} are allowed. If FALSE (default), such new values in \code{newdata} will trigger an error; if TRUE, then the prediction will use the unconditional (population-level) values for data with previously unobserved levels (or NAs)} \item{sparse}{generate sparse contrast matrices?} } \value{ a \code{\link{list}} with components \item{Zt}{transpose of the sparse model matrix for the random effects} \item{theta}{initial values of the covariance parameters} \item{Lind}{an integer vector of indices determining the mapping of the elements of the \code{theta} vector to the \code{"x"} slot of \code{Lambdat}} \item{Gp}{a vector indexing the association of elements of the conditional mode vector with random-effect terms; if \code{nb} is the vector of numbers of conditional modes per term (i.e. number of groups times number of effects per group), \code{Gp} is \code{c(0,cumsum(nb))} (and conversely \code{nb} is \code{diff(Gp)})} \item{lower}{lower bounds on the covariance parameters} \item{Lambdat}{transpose of the sparse relative covariance factor} \item{flist}{list of grouping factors used in the random-effects terms} \item{cnms}{a list of column names of the random effects according to the grouping factors} \item{Ztlist}{list of components of the transpose of the random-effects model matrix, separated by random-effects term} } \note{\code{mkNewReTrms} is used in the context of prediction, to generate a new "random effects terms" object from an already fitted model} \seealso{ Other utilities: \code{\link{findbars}}, \code{\link{mkRespMod}}, \code{\link{nlformula}}, \code{\link{nobars}}, \code{\link{subbars}}. \code{\link{getME}} can retrieve these components from a fitted model, although their values and/or forms may be slightly different in the final fitted model from their original values as returned from \code{mkReTrms}. } \examples{ data("Pixel", package="nlme") mform <- pixel ~ day + I(day^2) + (day | Dog) + (1 | Side/Dog) (bar.f <- findbars(mform)) # list with 3 terms mf <- model.frame(subbars(mform),data=Pixel) rt <- mkReTrms(bar.f,mf) names(rt) } %fm1 <- lmer(mform,Pixel) %rt2 <- getME(fm1,names(rt)) %for (i in seq_along(rt)) % cat(names(rt)[[i]], % isTRUE(all.equal(rt[[i]],rt2[[i]])), % "\n") % ## theta and Lambda components have the same structure, but have % ## been updated in the fitting; flist is a data frame in reTrms % ## but converted to a list; Ztlist is quite different (has been % ## decomposed in getME() \keyword{utilities} lme4/man/modular.Rd0000644000176200001440000002731714063503234013632 0ustar liggesusers\name{modular} \title{Modular Functions for Mixed Model Fits} \alias{glFormula} \alias{lFormula} \alias{mkGlmerDevfun} \alias{mkLmerDevfun} \alias{modular} \alias{optimizeGlmer} \alias{optimizeLmer} \alias{updateGlmerDevfun} \usage{ lFormula(formula, data = NULL, REML = TRUE, subset, weights, na.action, offset, contrasts = NULL, control = lmerControl(), ...) mkLmerDevfun(fr, X, reTrms, REML = TRUE, start = NULL, verbose = 0, control = lmerControl(), ...) optimizeLmer(devfun, optimizer = formals(lmerControl)$optimizer, restart_edge = formals(lmerControl)$restart_edge, boundary.tol = formals(lmerControl)$boundary.tol, start = NULL, verbose = 0L, control = list(), ...) glFormula(formula, data = NULL, family = gaussian, subset, weights, na.action, offset, contrasts = NULL, start, mustart, etastart, control = glmerControl(), ...) mkGlmerDevfun(fr, X, reTrms, family, nAGQ = 1L, verbose = 0L, maxit = 100L, control = glmerControl(), ...) optimizeGlmer(devfun, optimizer = if(stage == 1) "bobyqa" else "Nelder_Mead", restart_edge = FALSE, boundary.tol = formals(glmerControl)$boundary.tol, verbose = 0L, control = list(), nAGQ = 1L, stage = 1, start = NULL, ...) updateGlmerDevfun(devfun, reTrms, nAGQ = 1L) } \arguments{ \item{formula}{a two-sided linear formula object describing both the fixed-effects and random-effects parts of the model, with the response on the left of a \code{~} operator and the terms, separated by \code{+} operators, on the right. Random-effects terms are distinguished by vertical bars (\code{"|"}) separating expressions for design matrices from grouping factors.} \item{data}{an optional data frame containing the variables named in \code{formula}. By default the variables are taken from the environment from which \code{lmer} is called. While \code{data} is optional, the package authors \emph{strongly} recommend its use, especially when later applying methods such as \code{update} and \code{drop1} to the fitted model (\emph{such methods are not guaranteed to work properly if \code{data} is omitted}). If \code{data} is omitted, variables will be taken from the environment of \code{formula} (if specified as a formula) or from the parent frame (if specified as a character vector).} \item{REML}{(logical) indicating to fit \bold{re}stricted maximum likelihood model.} \item{subset}{an optional expression indicating the subset of the rows of \code{data} that should be used in the fit. This can be a logical vector, or a numeric vector indicating which observation numbers are to be included, or a character vector of the row names to be included. All observations are included by default.} \item{weights}{an optional vector of \sQuote{prior weights} to be used in the fitting process. Should be \code{NULL} or a numeric vector.} \item{na.action}{a function that indicates what should happen when the data contain \code{NA}s. The default action (\code{na.omit}, inherited from the 'factory fresh' value of \code{getOption("na.action")}) strips any observations with any missing values in any variables.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. This should be \code{NULL} or a numeric vector of length equal to the number of cases. One or more \code{\link{offset}} terms can be included in the formula instead or as well, and if more than one is specified their sum is used. See \code{\link{model.offset}}.} \item{contrasts}{an optional \code{\link{list}}. See the \code{contrasts.arg} of \code{\link{model.matrix.default}}.} \item{control}{a list giving \describe{ \item{for \code{[g]lFormula}:}{all options for running the model, see \code{\link{lmerControl}};} \item{for \code{mkLmerDevfun,mkGlmerDevfun}:}{options for the inner optimization step;} \item{for \code{optimizeLmer} and \code{optimizeGlmer}:}{control parameters for nonlinear optimizer (typically inherited from the \dots argument to \code{\link{lmerControl}}).} % FIXME: reference optCtrl } } \item{fr}{A model frame containing the variables needed to create an \code{\link{lmerResp}} or \code{\link{glmResp}} instance.} \item{X}{fixed-effects design matrix} \item{reTrms}{information on random effects structure (see \code{\link{mkReTrms}}).} \item{start}{starting values (see \code{\link{lmer}}; for \code{glFormula}, should be just a numeric vector of fixed-effect coefficients)} \item{verbose}{print output?} \item{maxit}{maximal number of Pwrss update iterations.} \item{devfun}{a deviance function, as generated by \code{\link{mkLmerDevfun}}} \item{nAGQ}{number of Gauss-Hermite quadrature points} \item{stage}{optimization stage (1: nAGQ=0, optimize over theta only; 2: nAGQ possibly >0, optimize over theta and beta)} \item{optimizer}{character - name of optimizing function(s). A character vector or list of functions: length 1 for \code{lmer} or \code{glmer}, possibly length 2 for \code{glmer}. The built-in optimizers are \code{"\link{Nelder_Mead}"} and \code{"\link[minqa]{bobyqa}"} (from the \CRANpkg{minqa} package). Any minimizing function that allows box constraints can be used provided that it \enumerate{ \item{takes input parameters \code{fn} (function to be optimized), \code{par} (starting parameter values), \code{lower} (lower bounds) and \code{control} (control parameters, passed through from the \code{control} argument) and} \item{returns a list with (at least) elements \code{par} (best-fit parameters), \code{fval} (best-fit function value), \code{conv} (convergence code) and (optionally) \code{message} (informational message, or explanation of convergence failure)}. } Special provisions are made for \code{\link{bobyqa}}, \code{\link{Nelder_Mead}}, and optimizers wrapped in the \CRANpkg{optimx} package; to use \pkg{optimx} optimizers (including \code{L-BFGS-B} from base \code{\link{optim}} and \code{\link{nlminb}}), pass the \code{method} argument to \code{optim} in the \code{control} argument. For \code{glmer}, if \code{length(optimizer)==2}, the first element will be used for the preliminary (random effects parameters only) optimization, while the second will be used for the final (random effects plus fixed effect parameters) phase. See \code{\link{modular}} for more information on these two phases. } \item{restart_edge}{see \code{\link{lmerControl}}} \item{boundary.tol}{see \code{\link{lmerControl}}} \item{family}{a GLM family; see \code{\link[stats]{glm}} and \code{\link[stats]{family}}.} \item{mustart}{optional starting values on the scale of the conditional mean; see \code{\link[stats]{glm}} for details.} \item{etastart}{optional starting values on the scale of the unbounded predictor; see \code{\link[stats]{glm}} for details.} \item{\dots}{other potential arguments; for \code{optimizeLmer} and \code{optimizeGlmer}, these are passed to internal function \code{optwrap}, which has relevant parameters \code{calc.derivs} and \code{use.last.params} (see \code{\link{lmerControl}}).} } \value{ \code{lFormula} and \code{glFormula} return a list containing components: \describe{ \item{fr}{model frame} \item{X}{fixed-effect design matrix} \item{reTrms}{list containing information on random effects structure: result of \code{\link{mkReTrms}}} \item{REML}{(lFormula only): logical indicating if restricted maximum likelihood was used (Copy of argument.)} } \code{mkLmerDevfun} and \code{mkGlmerDevfun} return a function to calculate deviance (or restricted deviance) as a function of the theta (random-effect) parameters. \code{updateGlmerDevfun} returns a function to calculate the deviance as a function of a concatenation of theta and beta (fixed-effect) parameters. These deviance functions have an environment containing objects required for their evaluation. CAUTION: The \code{\link{environment}} of functions returned by \code{mk(Gl|L)merDevfun} contains reference class objects (see \code{\link{ReferenceClasses}}, \code{\link{merPredD-class}}, \code{\link{lmResp-class}}), which behave in ways that may surprise many users. For example, if the output of \code{mk(Gl|L)merDevfun} is naively copied, then modifications to the original will also appear in the copy (and vice versa). To avoid this behavior one must make a deep copy (see \code{\link{ReferenceClasses}} for details). \code{optimizeLmer} and \code{optimizeGlmer} return the results of an optimization. } \description{ Modular functions for mixed model fits } \details{ These functions make up the internal components of an [gn]lmer fit. \itemize{ \item \code{[g]lFormula} takes the arguments that would normally be passed to \code{[g]lmer}, checking for errors and processing the formula and data input to create a list of objects required to fit a mixed model. \item \code{mk(Gl|L)merDevfun} takes the output of the previous step (minus the \code{formula} component) and creates a deviance function \item \code{optimize(Gl|L)mer} takes a deviance function and optimizes over \code{theta} (or over \code{theta} and \code{beta}, if \code{stage} is set to 2 for \code{optimizeGlmer} \item \code{updateGlmerDevfun} takes the first stage of a GLMM optimization (with \code{nAGQ=0}, optimizing over \code{theta} only) and produces a second-stage deviance function \item \code{\link{mkMerMod}} takes the \emph{environment} of a deviance function, the results of an optimization, a list of random-effect terms, a model frame, and a model all and produces a \code{[g]lmerMod} object. } } \examples{ ### Fitting a linear mixed model in 4 modularized steps ## 1. Parse the data and formula: lmod <- lFormula(Reaction ~ Days + (Days|Subject), sleepstudy) names(lmod) ## 2. Create the deviance function to be optimized: (devfun <- do.call(mkLmerDevfun, lmod)) ls(environment(devfun)) # the environment of 'devfun' contains objects # required for its evaluation ## 3. Optimize the deviance function: opt <- optimizeLmer(devfun) opt[1:3] ## 4. Package up the results: mkMerMod(environment(devfun), opt, lmod$reTrms, fr = lmod$fr) ### Same model in one line lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ### Fitting a generalized linear mixed model in six modularized steps ## 1. Parse the data and formula: glmod <- glFormula(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) #.... see what've got : str(glmod, max=1, give.attr=FALSE) ## 2. Create the deviance function for optimizing over theta: (devfun <- do.call(mkGlmerDevfun, glmod)) ls(environment(devfun)) # the environment of devfun contains lots of info ## 3. Optimize over theta using a rough approximation (i.e. nAGQ = 0): (opt <- optimizeGlmer(devfun)) ## 4. Update the deviance function for optimizing over theta and beta: (devfun <- updateGlmerDevfun(devfun, glmod$reTrms)) ## 5. Optimize over theta and beta: opt <- optimizeGlmer(devfun, stage=2) str(opt, max=1) # seeing what we'got ## 6. Package up the results: (fMod <- mkMerMod(environment(devfun), opt, glmod$reTrms, fr = glmod$fr)) ### Same model in one line fM <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) all.equal(fMod, fM, check.attributes=FALSE, tolerance = 1e-12) # ---- -- even tolerance = 0 may work } \keyword{models} lme4/man/simulate.formula.Rd0000644000176200001440000000441514063503234015450 0ustar liggesusers\name{simulate.formula} \alias{simulate.formula} \title{A \code{simulate} Method for \code{formula} objects that dispatches based on the Left-Hand Side} \description{ This method evaluates the left-hand side (LHS) of the given formula and dispatches it to an appropriate method based on the result by setting an nonce class name on the formula. } \usage{ \method{simulate}{formula}(object, nsim = 1 , seed = NULL, \dots, basis, newdata, data) } \arguments{ \item{object}{a one- or two-sided \code{\link{formula}}.} \item{nsim,seed}{number of realisations to simulate and the random seed to use; see \code{\link{simulate}}} \item{...}{additional arguments to methods} \item{basis}{if given, overrides the LHS of the formula for the purposes of dispatching} \item{newdata,data}{if passed, the \code{object}'s LHS is evaluated in this environment; at most one of the two may be passed.} } \details{ The dispatching works as follows: \enumerate{ \item If \code{basis} is not passed, and the formula has an LHS the expression on the LHS of the formula in the \code{object} is evaluated in the environment \code{newdata} or \code{data} (if given), in any case enclosed by the environment of \code{object}. Otherwise, \code{basis} is used. \item The result is set as an attribute \code{".Basis"} on \code{object}. If there is no \code{basis} or LHS, it is not set. \item The class vector of \code{object} has \code{c("formula_lhs_\var{CLASS}", "formula_lhs")} prepended to it, where \var{CLASS} is the class of the LHS value or \code{basis}. If LHS or \code{basis} has multiple classes, they are all prepended; if there is no LHS or \code{basis}, \code{c("formula_lhs_", "formula_lhs")} is. \item \code{\link{simulate}} generic is evaluated on the new \code{object}, with all arguments passed on, excluding \code{basis}; if \code{newdata} or \code{data} are missing, they too are not passed on. The evaluation takes place in the parent's environment. } A "method" to receive a formula whose LHS evaluates to \var{CLASS} can therefore be implemented by a function \code{simulate.formula_lhs_\var{CLASS}()}. This function can expect a \code{\link{formula}} object, with additional attribute \code{.Basis} giving the evaluated LHS (so that it does not need to be evaluated again). } lme4/man/findbars.Rd0000644000176200001440000000305113751775607013766 0ustar liggesusers\name{findbars} \alias{findbars} \title{Determine random-effects expressions from a formula} \usage{ findbars(term) } \arguments{ \item{term}{a mixed-model formula} } \description{ From the right hand side of a formula for a mixed-effects model, determine the pairs of expressions that are separated by the vertical bar operator. Also expand the slash operator in grouping factor expressions and expand terms with the double vertical bar operator into separate, independent random effect terms. } \value{ pairs of expressions that were separated by vertical bars } \note{ This function is called recursively on individual terms in the model, which is why the argument is called \code{term} and not a name like \code{form}, indicating a formula. } \seealso{ \code{\link{formula}}, \code{\link{model.frame}}, \code{\link{model.matrix}}. Other utilities: \code{\link{mkRespMod}}, \code{\link{mkReTrms}}, \code{\link{nlformula}}, \code{\link{nobars}}, \code{\link{subbars}} } \examples{ findbars(f1 <- Reaction ~ Days + (Days | Subject)) ## => list( Days | Subject ) ## These two are equivalent:% tests in ../inst/tests/test-doubleVertNotation.R findbars(y ~ Days + (1 | Subject) + (0 + Days | Subject)) findbars(y ~ Days + (Days || Subject)) ## => list of length 2: list ( 1 | Subject , 0 + Days | Subject) findbars(~ 1 + (1 | batch / cask)) ## => list of length 2: list ( 1 | cask:batch , 1 | batch) \dontshow{ stopifnot(identical(findbars(f1), list(quote(Days | Subject)))) } } \keyword{models} \keyword{utilities} lme4/man/rePos-class.Rd0000644000176200001440000000064513751775607014377 0ustar liggesusers\docType{class} \name{rePos-class} \alias{rePos-class} \title{Class \code{"rePos"}} \description{ A reference class for determining the positions in the random-effects vector that correspond to particular random-effects terms in the model formula } \section{Extends}{ All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. } \examples{ showClass("rePos") } \keyword{classes} lme4/man/isREML.Rd0000644000176200001440000000261313751775607013274 0ustar liggesusers\name{isREML} \alias{isGLMM} \alias{isLMM} \alias{isNLMM} \alias{isREML} \alias{isGLMM.merMod} \alias{isLMM.merMod} \alias{isNLMM.merMod} \alias{isREML.merMod} \title{Check characteristics of models} \usage{ isREML(x, ...) isLMM(x, ...) isNLMM(x, ...) isGLMM(x, ...) } \arguments{ \item{x}{a fitted model.} \item{...}{additional, optional arguments. (None are used in the merMod methods)} } \value{ a logical value } \description{ Check characteristics of models: whether a model fit corresponds to a linear (LMM), generalized linear (GLMM), or nonlinear (NLMM) mixed model, and whether a linear mixed model has been fitted by REML or not (\code{isREML(x)} is always \code{FALSE} for GLMMs and NLMMs). } \details{ These are generic functions. At present the only methods are for mixed-effects models of class \code{\linkS4class{merMod}}. } \examples{ fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = c(Asym = 200, xmid = 725, scal = 350)) isLMM(fm1) isGLMM(gm1) ## check all : is.MM <- function(x) c(LMM = isLMM(x), GLMM= isGLMM(x), NLMM= isNLMM(x)) stopifnot(cbind(is.MM(fm1), is.MM(gm1), is.MM(nm1)) == diag(rep(TRUE,3))) } \seealso{ getME } lme4/man/mkRespMod.Rd0000644000176200001440000000165713751775607014111 0ustar liggesusers\name{mkRespMod} \alias{mkRespMod} \title{Create an lmerResp, glmResp or nlsResp instance} \usage{ mkRespMod(fr, REML = NULL, family = NULL, nlenv = NULL, nlmod = NULL, ...) } \arguments{ \item{fr}{a model frame} \item{REML}{logical scalar, value of REML for an lmerResp instance} \item{family}{the optional glm family (glmResp only)} \item{nlenv}{the nonlinear model evaluation environment (nlsResp only)} \item{nlmod}{the nonlinear model function (nlsResp only)} \item{...}{where to look for response information if \code{fr} is missing. Can contain a model response, \code{y}, offset, \code{offset}, and weights, \code{weights}.} } \value{ an lmerResp or glmResp or nlsResp instance } \description{ Create an lmerResp, glmResp or nlsResp instance } \seealso{ Other utilities: \code{\link{findbars}}, \code{\link{mkReTrms}}, \code{\link{nlformula}}, \code{\link{nobars}}, \code{\link{subbars}} } lme4/man/pvalues.Rd0000644000176200001440000000577214173373114013653 0ustar liggesusers\name{pvalues} \alias{mcmcsamp} \alias{pvalues} \title{Getting p-values for fitted models} \description{ One of the most frequently asked questions about \code{lme4} is "how do I calculate p-values for estimated parameters?" Previous versions of \code{lme4} provided the \code{mcmcsamp} function, which efficiently generated a Markov chain Monte Carlo sample from the posterior distribution of the parameters, assuming flat (scaled likelihood) priors. Due to difficulty in constructing a version of \code{mcmcsamp} that was reliable even in cases where the estimated random effect variances were near zero (e.g. \url{https://stat.ethz.ch/pipermail/r-sig-mixed-models/2009q4/003115.html}), \code{mcmcsamp} has been withdrawn (or more precisely, not updated to work with \code{lme4} versions >=1.0.0). Many users, including users of the \code{aovlmer.fnc} function from the \code{languageR} package which relies on \code{mcmcsamp}, will be deeply disappointed by this lacuna. Users who need p-values have a variety of options. In the list below, the methods marked \code{MC} provide explicit model comparisons; \code{CI} denotes confidence intervals; and \code{P} denotes parameter-level or sequential tests of all effects in a model. The starred (*) suggestions provide finite-size corrections (important when the number of groups is <50); those marked (+) support GLMMs as well as LMMs. \itemize{ \item likelihood ratio tests via \code{anova} or \code{drop1} (MC,+) \item{profile confidence intervals via \code{\link{profile.merMod}} and \code{\link{confint.merMod}} (CI,+) } \item{parametric bootstrap confidence intervals and model comparisons via \code{\link{bootMer}} (or \code{PBmodcomp} in the \code{pbkrtest} package) (MC/CI,*,+) } \item{for random effects, simulation tests via the \code{RLRsim} package (MC,*) } \item{for fixed effects, F tests via Kenward-Roger approximation using \code{KRmodcomp} from the \code{pbkrtest} package (MC,*) } \item{\code{car::Anova} and \code{lmerTest::anova} provide wrappers for Kenward-Roger-corrected tests using \code{pbkrtest}: \code{lmerTest::anova} also provides t tests via the Satterthwaite approximation (P,*) } \item{\code{afex::mixed} is another wrapper for \code{pbkrtest} and \code{anova} providing "Type 3" tests of all effects (P,*,+) } } \code{arm::sim}, or \code{\link{bootMer}}, can be used to compute confidence intervals on predictions. For \code{glmer} models, the \code{summary} output provides p-values based on asymptotic Wald tests (P); while this is standard practice for generalized linear models, these tests make assumptions both about the shape of the log-likelihood surface and about the accuracy of a chi-squared approximation to differences in log-likelihoods. When all else fails, don't forget to keep p-values in perspective: \url{https://phdcomics.com/comics/archive.php?comicid=905} } lme4/man/merPredD.Rd0000644000176200001440000000265313751775607013707 0ustar liggesusers\name{merPredD} \alias{merPredD} \title{Generator object for the \code{\linkS4class{merPredD}} class} \usage{ merPredD(...) } \arguments{ \item{...}{List of arguments (see Note).} } \description{ The generator object for the \code{\linkS4class{merPredD}} reference class. Such an object is primarily used through its \code{new} method. } \note{ \code{merPredD(...)} is a short form of \code{new("merPredD", ...)} to create a new \code{\linkS4class{merPredD}} object and the \code{...} must be named arguments, \code{(X, Zt, Lambdat, Lind, theta,n)}: \describe{ \item{\code{X}:}{dense model matrix for the fixed-effects parameters, to be stored in the \code{X} field.} \item{\code{Zt}:}{transpose of the sparse model matrix for the random effects. It is stored in the \code{Zt} field.} \item{\code{Lambdat}:}{transpose of the sparse lower triangular relative variance factor (stored in the \code{Lambdat} field).} \item{\code{Lind}:}{integer vector of the same length as the \code{x} slot in the \code{Lambdat} field. Its elements should be in the range 1 to the length of the \code{theta} field.} \item{\code{theta}:}{numeric vector of variance component parameters (stored in the \code{theta} field).} \item{\code{n}:}{sample size, usually \code{nrow(X)}.} } } \seealso{ The class definition, \code{\linkS4class{merPredD}}, also for examples. } \keyword{classes} lme4/man/lmerControl.Rd0000644000176200001440000003724413751775607014511 0ustar liggesusers\name{lmerControl} \title{Control of Mixed Model Fitting} \alias{glmerControl} \alias{lmerControl} \alias{nlmerControl} \alias{.makeCC} \description{ Construct control structures for mixed model fitting. All arguments have defaults, and can be grouped into \itemize{ \item general control parameters, most importantly \code{optimizer}, further \code{restart_edge}, etc; \item model- or data-checking specifications, in short \dQuote{checking options}, such as \code{check.nobs.vs.rankZ}, or \code{check.rankX} (currently not for \code{nlmerControl}); \item all the parameters to be passed to the optimizer, e.g., maximal number of iterations, passed via the \code{optCtrl} list argument. } } \usage{ lmerControl(optimizer = "nloptwrap",% was "Nelder_Mead" till Dec.2013, % then "bobyqa" till Oct 2018; CRAN till 1.1-20 (2019-02-04) restart_edge = TRUE, boundary.tol = 1e-5, calc.derivs = TRUE, use.last.params = FALSE, sparseX = FALSE, standardize.X = FALSE, ## input checking options check.nobs.vs.rankZ = "ignore", check.nobs.vs.nlev = "stop", check.nlev.gtreq.5 = "ignore", check.nlev.gtr.1 = "stop", check.nobs.vs.nRE= "stop", check.rankX = c("message+drop.cols", "silent.drop.cols", "warn+drop.cols", "stop.deficient", "ignore"), check.scaleX = c("warning","stop","silent.rescale", "message+rescale","warn+rescale","ignore"), check.formula.LHS = "stop", ## convergence checking options check.conv.grad = .makeCC("warning", tol = 2e-3, relTol = NULL), check.conv.singular = .makeCC(action = "message", tol = formals(isSingular)$tol), check.conv.hess = .makeCC(action = "warning", tol = 1e-6), ## optimizer args optCtrl = list(), mod.type = "lmer" ) glmerControl(optimizer = c("bobyqa", "Nelder_Mead"), restart_edge = FALSE, boundary.tol = 1e-5, calc.derivs = TRUE, use.last.params = FALSE, sparseX = FALSE, standardize.X = FALSE, ## input checking options check.nobs.vs.rankZ = "ignore", check.nobs.vs.nlev = "stop", check.nlev.gtreq.5 = "ignore", check.nlev.gtr.1 = "stop", check.nobs.vs.nRE= "stop", check.rankX = c("message+drop.cols", "silent.drop.cols", "warn+drop.cols", "stop.deficient", "ignore"), check.scaleX = c("warning","stop","silent.rescale", "message+rescale","warn+rescale","ignore"), check.formula.LHS = "stop", ## convergence checking options check.conv.grad = .makeCC("warning", tol = 2e-3, relTol = NULL), check.conv.singular = .makeCC(action = "message", tol = formals(isSingular)$tol), check.conv.hess = .makeCC(action = "warning", tol = 1e-6), ## optimizer args optCtrl = list(), mod.type = "glmer", tolPwrss = 1e-7, compDev = TRUE, nAGQ0initStep = TRUE, check.response.not.const = "stop" ) nlmerControl(optimizer = "Nelder_Mead", tolPwrss = 1e-10, optCtrl = list()) .makeCC(action, tol, relTol, \dots) } \arguments{ \item{optimizer}{character - name of optimizing function(s). A \code{\link{character}} vector or list of functions: length 1 for \code{lmer} or \code{glmer}, possibly length 2 for \code{glmer}). Built-in optimizers are \code{"\link{Nelder_Mead}"}, \code{"\link[minqa]{bobyqa}"} (from the \CRANpkg{minqa} package), \code{"\link{nlminbwrap}"} (using base \R's \code{\link{nlminb}}) and the default for \code{lmerControl()}, \code{"\link{nloptwrap}"}. Any minimizing function that allows box constraints can be used provided that it \describe{ \item{(1)}{takes input parameters \code{fn} (function to be optimized), \code{par} (starting parameter values), \code{lower} and \code{upper} (parameter bounds) and \code{control} (control parameters, passed through from the \code{control} argument) and} \item{(2)}{returns a list with (at least) elements \code{par} (best-fit parameters), \code{fval} (best-fit function value), \code{conv} (convergence code, equal to zero for successful convergence) and (optionally) \code{message} (informational message, or explanation of convergence failure).} } Special provisions are made for \code{\link{bobyqa}}, \code{\link{Nelder_Mead}}, and optimizers wrapped in the \CRANpkg{optimx} package; to use the \pkg{optimx} optimizers (including \code{L-BFGS-B} from base \code{\link{optim}} and \code{\link{nlminb}}), pass the \code{method} argument to \code{optim} in the \code{optCtrl} argument (you may need to load the \pkg{optimx} package manually using \code{\link{library}(optimx)}). For \code{glmer}, if \code{length(optimizer)==2}, the first element will be used for the preliminary (random effects parameters only) optimization, while the second will be used for the final (random effects plus fixed effect parameters) phase. See \code{\link{modular}} for more information on these two phases. If \code{optimizer} is \code{NULL} (at present for \code{lmer} only), all of the model structures will be set up, but no optimization will be done (e.g. parameters will all be returned as \code{NA}). } \item{calc.derivs}{logical - compute gradient and Hessian of nonlinear optimization solution?} \item{use.last.params}{logical - should the last value of the parameters evaluated (\code{TRUE}), rather than the value of the parameters corresponding to the minimum deviance, be returned? This is a "backward bug-compatibility" option; use \code{TRUE} only when trying to match previous results.} \item{sparseX}{logical - should a sparse model matrix be used for the fixed-effects terms? Currently inactive.} \item{restart_edge}{logical - should the optimizer attempt a restart when it finds a solution at the boundary (i.e. zero random-effect variances or perfect +/-1 correlations)? (Currently only implemented for \code{lmerControl}.)} \item{boundary.tol}{numeric - within what distance of a boundary should the boundary be checked for a better fit? (Set to zero to disable boundary checking.)} \item{tolPwrss}{numeric scalar - the tolerance for declaring convergence in the penalized iteratively weighted residual sum-of-squares step.} \item{compDev}{logical scalar - should compiled code be used for the deviance evaluation during the optimization of the parameter estimates?} \item{nAGQ0initStep}{Run an initial optimization phase with \code{nAGQ = 0}. While the initial optimization usually provides a good starting point for subsequent fitting (thus increasing overall computational speed), setting this option to \code{FALSE} can be useful in cases where the initial phase results in bad fixed-effect estimates (seen most often in binomial models with \code{link="cloglog"} and offsets).} \item{check.nlev.gtreq.5}{character - rules for checking whether all random effects have >= 5 levels. See \code{action}.} \item{check.nlev.gtr.1}{character - rules for checking whether all random effects have > 1 level. See \code{action}.} \item{check.nobs.vs.rankZ}{character - rules for checking whether the number of observations is greater than (or greater than or equal to) the rank of the random effects design matrix (Z), usually necessary for identifiable variances. As for \code{action}, with the addition of \code{"warningSmall"} and \code{"stopSmall"}, which run the test only if the dimensions of \code{Z} are < 1e6. \code{nobs > rank(Z)} will be tested for LMMs and GLMMs with estimated scale parameters; \code{nobs >= rank(Z)} will be tested for GLMMs with fixed scale parameter. The rank test is done using the \code{method="qr"} option of the \code{\link[Matrix]{rankMatrix}} function. } \item{check.nobs.vs.nlev}{ character - rules for checking whether the number of observations is less than (or less than or equal to) the number of levels of every grouping factor, usually necessary for identifiable variances. As for \code{action}. \code{nobs ../tests/refit.Rlme4/man/lmResp.Rd0000644000176200001440000000263013751775607013442 0ustar liggesusers\name{lmResp} \alias{glmResp} \alias{lmerResp} \alias{lmResp} \alias{nlsResp} \title{Generator objects for the response classes} \usage{ lmResp(...) } \arguments{ \item{...}{List of arguments (see Note).} } \description{ The generator objects for the \code{\linkS4class{lmResp}}, \code{\linkS4class{lmerResp}}, \code{\linkS4class{glmResp}} and \code{\linkS4class{nlsResp}} reference classes. Such objects are primarily used through their \code{new} methods. } \note{ Arguments to the \code{new} methods must be named arguments. \itemize{ \item{y}{ the numeric response vector} \item{family}{ a \code{\link{family}} object} \item{nlmod}{ the nonlinear model function} \item{nlenv}{ an environment holding data objects for evaluation of \code{nlmod}} \item{pnames}{ a character vector of parameter names} \item{gam}{ a numeric vector - the initial linear predictor} } } \section{Methods}{ \describe{ \item{\code{new(y=y)}:}{Create a new \code{\linkS4class{lmResp}} or \code{\linkS4class{lmerResp}} object.} \item{\code{new(family=family, y=y)}:}{Create a new \code{\linkS4class{glmResp}} object.} \item{\code{new(y=y, nlmod=nlmod, nlenv=nlenv, pnames=pnames, gam=gam)}:}{Create a new \code{\linkS4class{nlsResp}} object.} } } \seealso{ \code{\linkS4class{lmResp}}, \code{\linkS4class{lmerResp}}, \code{\linkS4class{glmResp}}, \code{\linkS4class{nlsResp}} } \keyword{classes} lme4/man/glmer.nb.Rd0000644000176200001440000000770214063503234013667 0ustar liggesusers\name{glmer.nb} \title{Fitting Negative Binomial GLMMs} \alias{glmer.nb} \alias{negative.binomial}% re-exported, needed e.g. in update() \concept{GLMM} \description{ Fits a generalized linear mixed-effects model (GLMM) for the negative binomial family, building on \code{\link{glmer}}, and initializing via \code{\link[MASS]{theta.ml}} from \pkg{MASS}. } \usage{ glmer.nb(\dots, interval = log(th) + c(-3, 3), tol = 5e-5, verbose = FALSE, nb.control = NULL, initCtrl = list(limit = 20, eps = 2*tol, trace = verbose, theta = NULL)) } \arguments{ \item{\dots}{arguments as for \code{glmer(.)} such as \code{formula}, \code{data}, \code{control}, etc, but \emph{not} \code{family}!} \item{interval}{interval in which to start the optimization. The default is symmetric on log scale around the initially estimated theta.} \item{tol}{tolerance for the optimization via \code{\link{optimize}}.} \item{verbose}{\code{\link{logical}} indicating how much progress information should be printed during the optimization. Use \code{verbose = 2} (or larger) to enable \code{verbose=TRUE} in the \code{\link{glmer}()} calls.} \item{nb.control}{optional \code{\link{list}}, like the output of \code{\link{glmerControl}()}, used in \code{\link{refit}(*, control = control.nb)} during the optimization (\code{control}, if included in \code{\dots}, will be used in the initial-stage \code{glmer(...,family=poisson)} fit, and passed on to the later optimization stages as well)} \item{initCtrl}{(\emph{\bold{experimental}, do not rely on this}:) a \code{\link{list}} with named components as in the default, passed to \code{\link[MASS]{theta.ml}} (package \CRANpkg{MASS}) for the initial value of the negative binomial parameter \code{theta}. May also include a \code{theta} component, in which case the initial estimation step is skipped} } \value{ An object of class \code{glmerMod}, for which many methods are available (e.g. \code{methods(class="glmerMod")}), see \code{\link{glmer}}. } \note{For historical reasons, the shape parameter of the negative binomial and the random effects parameters in our (G)LMM models are both called \code{theta} (\eqn{\theta}), but are unrelated here. The negative binomial \eqn{\theta} can be extracted from a fit \code{g <- glmer.nb()} by \code{\link{getME}(g, "glmer.nb.theta")}. Parts of \code{glmer.nb()} are still experimental and methods are still missing or suboptimal. In particular, there is no inference available for the dispersion parameter \eqn{\theta}, yet. To fit a negative binomial model with \emph{known} overdispersion parameter (e.g. as part of a model comparison exercise, use \code{glmer} with the \code{\link[MASS]{negative.binomial}} family from the \code{MASS} package, e.g. \code{glmer(...,family=MASS::negative.binomial(theta=1.75))}. } \seealso{ \code{\link{glmer}}; from package \CRANpkg{MASS}, \code{\link[MASS]{negative.binomial}} (which we re-export currently) and \code{\link[MASS]{theta.ml}}, the latter for initialization of optimization. The \sQuote{Details} of \code{\link{pnbinom}} for the definition of the negative binomial distribution. } \examples{ set.seed(101) dd <- expand.grid(f1 = factor(1:3), f2 = LETTERS[1:2], g=1:9, rep=1:15, KEEP.OUT.ATTRS=FALSE) summary(mu <- 5*(-4 + with(dd, as.integer(f1) + 4*as.numeric(f2)))) dd$y <- rnbinom(nrow(dd), mu = mu, size = 0.5) str(dd) require("MASS")## and use its glm.nb() - as indeed we have zero random effect: \dontrun{ m.glm <- glm.nb(y ~ f1*f2, data=dd, trace=TRUE) summary(m.glm) m.nb <- glmer.nb(y ~ f1*f2 + (1|g), data=dd, verbose=TRUE) m.nb ## The neg.binomial theta parameter: getME(m.nb, "glmer.nb.theta") LL <- logLik(m.nb) ## mixed model has 1 additional parameter (RE variance) stopifnot(attr(LL,"df")==attr(logLik(m.glm),"df")+1) plot(m.nb, resid(.) ~ g)# works, as long as data 'dd' is found } } \keyword{models} lme4/man/golden-class.Rd0000644000176200001440000000150413751775607014552 0ustar liggesusers\name{golden-class} \docType{class} \title{Class \code{"golden"} and Generator for Golden Search Optimizer Class} \alias{golden-class} \alias{golden} \description{ \code{"golden"} is a reference class for a golden search scalar optimizer, for a parameter within an interval. \code{golden()} is the generator for the \code{"golden"} class. The optimizer uses reverse communications. } \usage{ golden(...) } \arguments{ \item{\dots}{(partly optional) arguments passed to \code{\link{new}()} must be named arguments. \code{lower} and \code{upper} are the bounds for the scalar parameter; they must be finite.} } \section{Extends}{ All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. } \examples{ showClass("golden") golden(lower= -100, upper= 1e100) } \keyword{classes} lme4/man/devfun2.Rd0000644000176200001440000000461213751775607013553 0ustar liggesusers\name{devfun2} \alias{devfun2} \title{Deviance Function in Terms of Standard Deviations/Correlations} \description{ The deviance is profiled with respect to the fixed-effects parameters but not with respect to sigma; that is, the function takes parameters for the variance-covariance parameters and for the residual standard deviation. The random-effects variance-covariance parameters are on the standard deviation/correlation scale, not the theta (Cholesky factor) scale. } \usage{ devfun2(fm, useSc = if(isLMM(fm)) TRUE else NA, transfuns = list(from.chol = Cv_to_Sv, to.chol = Sv_to_Cv, to.sd = identity), ...) } \arguments{ \item{fm}{a fitted model inheriting from class \code{"\linkS4class{merMod}"}.} \item{useSc}{(\code{\link{logical}}) indicating whether a scale parameter has been in the model or should be used.}% FIXME, see also ../R/profile.R \item{transfuns}{a \code{\link{list}} of \code{\link{function}}s for converting parameters to and from the Cholesky-factor scale } \item{\dots}{ arguments passed to the internal \code{profnames} function (\code{signames=TRUE} to use old-style \code{.sigxx names}, \code{FALSE} uses (sd_cor|xx); also \code{prefix=c("sd","cor")}) } } \value{ Returns a function that takes a vector of standard deviations and correlations and returns the deviance (or REML criterion). The function has additional attributes \describe{ \item{optimum}{a named vector giving the parameter values at the optimum} \item{basedev}{the deviance at the optimum, (i.e., \emph{not} the REML criterion).} \item{thopt}{the optimal variance-covariance parameters on the \dQuote{theta} (Cholesky factor) scale} \item{stderr}{standard errors of fixed effect parameters} } } \note{ Even if the original model was fitted using \code{REML=TRUE} as by default with \code{\link{lmer}()}, this returns the deviance, i.e., the objective function for maximum (log) likelihood (ML). For the REML objective function, use \code{\link{getME}(fm, "devfun")} instead. } \examples{ m1 <- lmer(Reaction~Days+(Days|Subject),sleepstudy) dd <- devfun2(m1, useSc=TRUE) pp <- attr(dd,"optimum") ## extract variance-covariance and residual std dev parameters sigpars <- pp[grepl("^\\\\.sig",names(pp))] all.equal(unname(dd(sigpars)),deviance(refitML(m1))) } \keyword{utilities} lme4/man/VarCorr.Rd0000644000176200001440000000754213751775607013565 0ustar liggesusers\name{VarCorr} \title{Extract Variance and Correlation Components} \alias{VarCorr} \alias{VarCorr.merMod} \alias{as.data.frame.VarCorr.merMod} \alias{print.VarCorr.merMod} \usage{ \method{VarCorr}{merMod}(x, sigma=1, \dots) %% documented because of "surprising arguments": \method{as.data.frame}{VarCorr.merMod}(x, row.names = NULL, optional = FALSE, order = c("cov.last", "lower.tri"), \dots) \method{print}{VarCorr.merMod}(x, digits = max(3, getOption("digits") - 2), comp = "Std.Dev.", formatter = format, \dots) } \arguments{ \item{x}{for \code{VarCorr}: a fitted model object, usually an object inheriting from class \code{\linkS4class{merMod}}. For \code{as.data.frame}, a \code{VarCorr.merMod} object returned from \code{VarCorr}.} \item{sigma}{an optional numeric value used as a multiplier for the standard deviations.} \item{digits}{an optional integer value specifying the number of digits} \item{order}{arrange data frame with variances/standard deviations first and covariances/correlations last for each random effects term (\code{"cov.last"}), or in the order of the lower triangle of the variance-covariance matrix (\code{"lower.tri"})?} \item{row.names, optional}{Ignored: necessary for the \code{as.data.frame} method.} \item{\dots}{Ignored for the \code{as.data.frame} method; passed to other \code{\link{print}()} methods for the \code{print()} method.} %% print(): \item{comp}{a \code{\link{character}} vector, specifying the components to be printed; simply passed to \code{\link{formatVC}()}.} \item{formatter}{a \code{\link{function}} for formatting the numbers; simply passed to \code{\link{formatVC}()}.} } \description{ This function calculates the estimated variances, standard deviations, and correlations between the random-effects terms in a mixed-effects model, of class \code{\linkS4class{merMod}} (linear, generalized or nonlinear). The within-group error variance and standard deviation are also calculated. } \value{ An object of class \code{VarCorr.merMod}. The internal structure of the object is a list of matrices, one for each random effects grouping term. For each grouping term, the standard deviations and correlation matrices for each grouping term are stored as attributes \code{"stddev"} and \code{"correlation"}, respectively, of the variance-covariance matrix, and the residual standard deviation is stored as attribute \code{"sc"} (for \code{glmer} fits, this attribute stores the scale parameter of the model). The \code{as.data.frame} method produces a combined data frame with one row for each variance or covariance parameter (and a row for the residual error term where applicable) and the following columns: \describe{ \item{grp}{grouping factor} \item{var1}{first variable} \item{var2}{second variable (\code{NA} for variance parameters)} \item{vcov}{variances or covariances} \item{sdcor}{standard deviations or correlations} } } \details{ The \code{print} method for \code{VarCorr.merMod} objects has optional arguments \code{digits} (specify digits of precision for printing) and \code{comp}: the latter is a character vector with any combination of \code{"Variance"} and \code{"Std.Dev."}, to specify whether variances, standard deviations, or both should be printed. } \author{ This is modeled after \code{\link[nlme]{VarCorr}} from package \CRANpkg{nlme}, by Jose Pinheiro and Douglas Bates. } \seealso{ \code{\link{lmer}}, \code{\link{nlmer}} } \examples{ data(Orthodont, package="nlme") fm1 <- lmer(distance ~ age + (age|Subject), data = Orthodont) (vc <- VarCorr(fm1)) ## default print method: standard dev and corr ## both variance and std.dev. print(vc,comp=c("Variance","Std.Dev."),digits=2) ## variance only print(vc,comp=c("Variance")) as.data.frame(vc) as.data.frame(vc,order="lower.tri") } \keyword{models} lme4/man/profile-methods.Rd0000644000176200001440000002417214063503234015264 0ustar liggesusers\name{profile-methods} \title{Profile method for merMod objects} \docType{methods} \alias{as.data.frame.thpr} \alias{log.thpr} \alias{logProf} \alias{varianceProf} \alias{profile-methods} \alias{profile.merMod} \description{ Methods for \code{\link{profile}}() of [ng]\code{\link{lmer}} fitted models. The \code{log()} method and the more flexible \code{logProf()} utility transform a \code{lmer} profile into one where logarithms of standard deviations are used, while \code{varianceProf} converts from the standard-deviation to the variance scale; see Details. } \usage{ \method{profile}{merMod}(fitted, which = NULL, alphamax = 0.01, maxpts = 100, delta = NULL, delta.cutoff = 1/8, verbose = 0, devtol = 1e-09, maxmult = 10, startmethod = "prev", optimizer = NULL, control=NULL, signames = TRUE, parallel = c("no", "multicore", "snow"), ncpus = getOption("profile.ncpus", 1L), cl = NULL, prof.scale = c("sdcor","varcov"), \dots) \method{as.data.frame}{thpr} (x, ...) \method{log}{thpr}(x, base = exp(1)) logProf(x, base = exp(1), ranef = TRUE, sigIni = if(ranef) "sig" else "sigma") varianceProf(x, ranef = TRUE) } \arguments{ \item{fitted}{a fitted model, e.g., the result of \code{\link{lmer}(..)}.} \item{which}{NULL value, integer or character vector indicating which parameters to profile: default (NULL) is all parameters. For integer, i.e., indexing, the parameters are ordered as follows: \describe{ \item{(1)}{random effects (theta) parameters; these are ordered as in \code{getME(.,"theta")}, i.e., as the lower triangle of a matrix with standard deviations on the diagonal and correlations off the diagonal.} \item{(2)}{residual standard deviation (or scale parameter for GLMMs where appropriate).} \item{(3)}{fixed effect (beta) parameters.} } Alternatively, \code{which} may be a character, containing \code{"beta_"} or \code{"theta_"} denoting the fixed or random effects parameters, respectively, or also containing parameter names, such as \code{".sigma"} or \code{"(Intercept)"}. } \item{alphamax}{a number in \eqn{(0,1)}, such that \code{1 - alphamax} is the maximum alpha value for likelihood ratio confidence regions; used to establish the range of values to be profiled.} \item{maxpts}{maximum number of points (in each direction, for each parameter) to evaluate in attempting to construct the profile.} \item{delta}{stepping scale for deciding on next point to profile. The code uses the local derivative of the profile at the current step to establish a change in the focal parameter that will lead to a step of \code{delta} on the square-root-deviance scale. If \code{NULL}, the \code{delta.cutoff} parameter will be used to determine the stepping scale.} \item{delta.cutoff}{stepping scale (see \code{delta}) expressed as a fraction of the target maximum value of the profile on the square-root-deviance scale. Thus a \code{delta.cutoff} setting of \code{1/n} will lead to a profile with approximately \code{2*n} calculated points for each parameter (i.e., \code{n} points in each direction, below and above the estimate for each parameter).} \item{verbose}{level of output from internal calculations.} \item{devtol}{tolerance for fitted deviances less than baseline (supposedly minimum) deviance.} \item{maxmult}{maximum multiplier of the original step size allowed, defaults to 10.} \item{startmethod}{method for picking starting conditions for optimization (STUB).} \item{optimizer}{(character or function) optimizer to use (see \code{\link{lmer}} for details); default is to use the optimizer from the original model fit.} \item{control}{a \code{\link{list}} of options controlling the profiling (see \code{\link{lmerControl}}): default is to use the control settings from the original model fit.} \item{signames}{logical indicating if abbreviated names of the form \code{.sigNN} should be used; otherwise, names are more meaningful (but longer) of the form \code{(sd|cor)_(effects)|(group)}. Note that some code for profile transformations (e.g., \code{log()} or \code{\link{varianceProf}}) depends on \code{signames==TRUE}.} \item{\dots}{potential further arguments for various methods.} \item{x}{an object of class \code{thpr} (i.e., output of \code{profile})} \item{base}{the base of the logarithm. Defaults to natural logarithms.} \item{ranef}{logical indicating if the sigmas of the random effects should be \code{log()} transformed as well. If false, only \eqn{\sigma} (standard deviation of errors) is transformed.} \item{sigIni}{character string specifying the initial part of the sigma parameters to be log transformed.} \item{parallel}{The type of parallel operation to be used (if any). If missing, the default is taken from the option \code{"profile.parallel"} (and if that is not set, \code{"no"}).} \item{ncpus}{integer: number of processes to be used in parallel operation: typically one would choose this to be the number of available CPUs.} \item{cl}{An optional \pkg{parallel} or \pkg{snow} cluster for use if \code{parallel = "snow"}. If not supplied, a cluster on the local machine is created for the duration of the \code{profile} call.} \item{prof.scale}{whether to profile on the standard deviation-correlation scale (\code{"sdcor"}) or on the variance-covariance scale (\code{"varcov"}) } } \value{ \code{profile()} returns an object of S3 class \code{"thpr"}, %% = th[eta] pr[ofile], now a misnomer, as we also profile beta's which is \code{\link{data.frame}}-like. Notable methods for such a profile object \code{\link{confint}()}, which returns the confidence intervals based on the profile, and three plotting methods (which require the \pkg{lattice} package), \code{\link[=xyplot.thpr]{xyplot}}, \code{densityplot}, and \code{splom}. In addition, the \code{\link{log}()} (see above) and \code{\link{as.data.frame}()} methods can transform \code{"thpr"} objects in useful ways. } \details{ The \code{\link{log}} method and the more flexible \code{logProf()} function transform the profile into one where \eqn{\log(\sigma)} is used instead of \eqn{\sigma}. By default all sigmas including the standard deviations of the random effects are transformed i.e., the methods return a profile with all of the \code{.sigNN} parameters replaced by \code{.lsigNN}. If \code{ranef} is false, only \code{".sigma"}, the standard deviation of the errors, is transformed (as it should never be zero, whereas random effect standard deviations (\code{.sigNN}) can be reasonably be zero). \cr The forward and backward splines for the log-transformed parameters are recalculated. Note that correlation parameters are not handled sensibly at present (i.e., they are logged rather than taking a more applicable transformation such as an arc-hyperbolic tangent, \code{atanh(x)}=\eqn{\log((1+x)/(1-x))/2}{log((1+x)/(1-x))/2}). The \code{varianceProf} function works similarly, including non-sensibility for correlation parameters, by squaring all parameter values, changing the names by appending \code{sq} appropriately (e.g. \code{.sigNN} to \code{.sigsqNN}). Setting \code{prof.scale="varcov"} in the original \code{profile()} call is a more computationally intensive, but more correct, way to compute confidence intervals for covariance parameters. Methods for function \code{\link{profile}} (package \pkg{stats}), here for profiling (fitted) mixed effect models. %% FIXME: ../inst/doc/profiling.txt contains motivation and more by %% Doug Bates. Should add here (partly), or "link to there". } \seealso{ The plotting methods \code{\link[=xyplot.thpr]{xyplot}} etc, for class \code{"thpr"}. For (more expensive) alternative confidence intervals: \code{\link{bootMer}}. } \examples{ if (interactive()) { fm01ML <- lmer(Yield ~ 1|Batch, Dyestuff, REML = FALSE) system.time( tpr <- profile(fm01ML, optimizer="Nelder_Mead", which="beta_") )## fast; as only *one* beta parameter is profiled over ## full profiling (default which means 'all) needs ## ~2.6s (on a 2010 Macbook Pro) system.time( tpr <- profile(fm01ML)) ## ~1s, + possible warning about bobyqa convergence (confint(tpr) -> CIpr) \dontrun{% too much precision (etc). but just FYI: stopifnot(all.equal(unname(CIpr), array(c(12.1985292, 38.2299848, 1486.4515, 84.0630513, 67.6576964, 1568.54849), dim = 3:2), tol= 1e-07))# 1.37e-9 {64b} } library("lattice") xyplot(tpr) xyplot(tpr, absVal=TRUE) # easier to see conf.int.s (and check symmetry) xyplot(tpr, conf = c(0.95, 0.99), # (instead of all five 50, 80,...) main = "95\% and 99\% profile() intervals") xyplot(logProf(tpr, ranef=FALSE), main = expression("lmer profile()s"~~ log(sigma)*" (only log)")) densityplot(tpr, main="densityplot( profile(lmer(..)) )") densityplot(varianceProf(tpr), main=" varianceProf( profile(lmer(..)) )") splom(tpr) splom(logProf(tpr, ranef=FALSE)) doMore <- lme4:::testLevel() > 2 %% even more --> ../tests/profile.R if(doMore) { ## not typically, for time constraint reasons ## Batch and residual variance only system.time(tpr2 <- profile(fm01ML, which=1:2, optimizer="Nelder_Mead")) print( xyplot(tpr2) ) print( xyplot(log(tpr2)) )# log(sigma) is better print( xyplot(logProf(tpr2, ranef=FALSE)) ) ## GLMM example gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) ## running ~ 10-12 seconds on a modern machine {-> "verbose" while you wait}: print( system.time(pr4 <- profile(gm1, verbose=TRUE)) ) print( xyplot(pr4, layout=c(5,1), as.table=TRUE) ) print( xyplot(log(pr4), absVal=TRUE) ) # log(sigma_1) print( splom(pr4) ) print( system.time( # quicker: only sig01 and one fixed effect pr2 <- profile(gm1, which=c("theta_", "period2")))) print( confint(pr2) ) ## delta..: higher underlying resolution, only for 'sigma_1': print( system.time( pr4.hr <- profile(gm1, which="theta_", delta.cutoff=1/16))) print( xyplot(pr4.hr) ) } %% doMore } %% interactive() } \keyword{methods} lme4/man/ngrps.Rd0000644000176200001440000000174413751775607013336 0ustar liggesusers\name{ngrps} \alias{ngrps} \title{Number of Levels of a Factor or a "merMod" Model} \description{ Returns the number of levels of a \code{\link{factor}} or a set of factors, currently e.g., for each of the grouping factors of \code{\link{lmer}()}, \code{\link{glmer}()}, etc. } \usage{ ngrps(object, \dots) } \arguments{ \item{object}{an \code{R} object, see Details.} \item{\dots}{currently ignored.} } \value{ The number of levels (of a factor) or vector of number of levels for each \dQuote{grouping factor} of a } \details{ Currently there are methods for objects of class \code{\linkS4class{merMod}}, i.e., the result of \code{\link{lmer}()} etc, and \code{\link{factor}} objects. } \examples{ ngrps(factor(seq(1,10,2))) ngrps(lmer(Reaction ~ 1|Subject, sleepstudy)) ## A named vector if there's more than one grouping factor : ngrps(lmer(strength ~ (1|batch/cask), Pastes)) ## cask:batch batch ## 30 10 methods(ngrps) # -> "factor" and "merMod" } lme4/man/InstEval.Rd0000644000176200001440000000406713751775607013733 0ustar liggesusers\docType{data} \name{InstEval} \alias{InstEval} \title{University Lecture/Instructor Evaluations by Students at ETH} \format{A data frame with 73421 observations on the following 7 variables. \describe{ \item{\code{s}}{a factor with levels \code{1:2972} denoting individual students.} \item{\code{d}}{a factor with 1128 levels from \code{1:2160}, denoting individual professors or lecturers.}% ("d": \dQuote{Dozierende} in German) \item{\code{studage}}{an ordered factor with levels \code{2} < \code{4} < \code{6} < \code{8}, denoting student's \dQuote{age} measured in the \emph{semester} number the student has been enrolled.} \item{\code{lectage}}{an ordered factor with 6 levels, \code{1} < \code{2} < ... < \code{6}, measuring how many semesters back the lecture rated had taken place.} \item{\code{service}}{a binary factor with levels \code{0} and \code{1}; a lecture is a \dQuote{service}, if held for a different department than the lecturer's main one.} \item{\code{dept}}{a factor with 14 levels from \code{1:15}, using a random code for the department of the lecture.} \item{\code{y}}{a numeric vector of \emph{ratings} of lectures by the students, using the discrete scale \code{1:5}, with meanings of \sQuote{poor} to \sQuote{very good}.} } Each observation is one student's rating for a specific lecture (of one lecturer, during one semester in the past).} \description{ University lecture evaluations by students at ETH Zurich, anonymized for privacy protection. This is an interesting \dQuote{medium} sized example of a \emph{partially} nested mixed effect model. } \details{ The main goal of the survey is to find \dQuote{the best liked prof}, according to the lectures given. Statistical analysis of such data has been the basis for a (student) jury selecting the final winners. The present data set has been anonymized and slightly simplified on purpose. } \examples{ str(InstEval) head(InstEval, 16) xtabs(~ service + dept, InstEval) } \keyword{datasets} lme4/man/nlmer.Rd0000644000176200001440000001577113751775607013327 0ustar liggesusers\name{nlmer} \title{Fitting Nonlinear Mixed-Effects Models} \alias{nlmer} \concept{NLMM} \description{ Fit a nonlinear mixed-effects model (NLMM) to data, via maximum likelihood. } \usage{ nlmer(formula, data = NULL, control = nlmerControl(), start = NULL, verbose = 0L, nAGQ = 1L, subset, weights, na.action, offset, contrasts = NULL, devFunOnly = FALSE) } \arguments{ \item{formula}{a three-part \dQuote{nonlinear mixed model} formula, of the form \code{resp ~ Nonlin(...) ~ fixed + random}, where the third part is similar to the RHS formula of, e.g., \code{\link{lmer}}. %% (see detailed documentation) FIXME! where would that be? Currently, the \code{Nonlin(..)} formula part must not only return a numeric vector, but also must have a \code{"gradient"} attribute, a \code{\link{matrix}}. The functions \code{\link{SSbiexp}}, \code{\link{SSlogis}}, etc, see \code{\link{selfStart}}, provide this (and more). Alternatively, you can use \code{\link{deriv}()} to automatically produce such functions or expressions.} \item{data}{an optional data frame containing the variables named in \code{formula}. By default the variables are taken from the environment from which \code{lmer} is called. While \code{data} is optional, the package authors \emph{strongly} recommend its use, especially when later applying methods such as \code{\link{update}} and \code{\link{drop1}} to the fitted model (\emph{such methods are not guaranteed to work properly if \code{data} is omitted}). If \code{data} is omitted, variables will be taken from the environment of \code{formula} (if specified as a formula) or from the parent frame (if specified as a character vector).} \item{control}{a list (of correct class, resulting from \code{\link{lmerControl}()} or \code{\link{glmerControl}()} respectively) containing control parameters, including the nonlinear optimizer to be used and parameters to be passed through to the nonlinear optimizer, see the \code{*lmerControl} documentation for details.} \item{start}{starting estimates for the nonlinear model parameters, as a named numeric vector or as a list with components \describe{ \item{nlpars}{required numeric vector of starting values for the nonlinear model parameters} \item{theta}{optional numeric vector of starting values for the covariance parameters} } } \item{verbose}{integer scalar. If \code{> 0} verbose output is generated during the optimization of the parameter estimates. If \code{> 1} verbose output is generated during the individual PIRLS steps (PIRLS aka PRSS, e.g. in the C++ sources).} \item{nAGQ}{integer scalar - the number of points per axis for evaluating the adaptive Gauss-Hermite approximation to the log-likelihood. Defaults to 1, corresponding to the Laplace approximation. Values greater than 1 produce greater accuracy in the evaluation of the log-likelihood at the expense of speed. A value of zero uses a faster but less exact form of parameter estimation for GLMMs by optimizing the random effects and the fixed-effects coefficients in the penalized iteratively reweighted least squares (PIRLS) step.} \item{subset}{an optional expression indicating the subset of the rows of \code{data} that should be used in the fit. This can be a logical vector, or a numeric vector indicating which observation numbers are to be included, or a character vector of the row names to be included. All observations are included by default.} \item{weights}{an optional vector of \sQuote{prior weights} to be used in the fitting process. Should be \code{NULL} or a numeric vector.} \item{na.action}{a function that indicates what should happen when the data contain \code{NA}s. The default action (\code{na.omit}, inherited from the \sQuote{factory fresh} value of \code{\link{getOption}("na.action")}) strips any observations with any missing values in any variables.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. This should be \code{NULL} or a numeric vector of length equal to the number of cases. One or more \code{\link{offset}} terms can be included in the formula instead or as well, and if more than one is specified their sum is used. See \code{\link{model.offset}}.} \item{contrasts}{an optional \code{\link{list}}. See the \code{contrasts.arg} of \code{\link{model.matrix.default}}.} \item{devFunOnly}{logical - return only the deviance evaluation function. Note that because the deviance function operates on variables stored in its environment, it may not return \emph{exactly} the same values on subsequent calls (but the results should always be within machine tolerance).} } \details{ Fit nonlinear mixed-effects models, such as those used in population pharmacokinetics. } \note{ Adaptive Gauss-Hermite quadrature (\code{nAGQ > 1}) is not currently implemented for \code{nlmer}. Several other methods, such as simulation or prediction with new data, are unimplemented or very lightly tested. A \code{method} argument was used in earlier versions of the \pkg{lme4} package. Its functionality has been replaced by the \code{nAGQ} argument. } \examples{ ## nonlinear mixed models --- 3-part formulas --- ## 1. basic nonlinear fit. Use stats::SSlogis for its ## implementation of the 3-parameter logistic curve. ## "SS" stands for "self-starting logistic", but the ## "self-starting" part is not currently used by nlmer ... 'start' is ## necessary startvec <- c(Asym = 200, xmid = 725, scal = 350) (nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = startvec)) ## 2. re-run with "quick and dirty" PIRLS step (nm1a <- update(nm1, nAGQ = 0L)) ## 3. Fit the same model with a user-built function: ## a. Define formula nform <- ~Asym/(1+exp((xmid-input)/scal)) ## b. Use deriv() to construct function: nfun <- deriv(nform,namevec=c("Asym","xmid","scal"), function.arg=c("input","Asym","xmid","scal")) nm1b <- update(nm1,circumference ~ nfun(age, Asym, xmid, scal) ~ Asym | Tree) ## 4. User-built function without using derivs(): ## derivatives could be computed more efficiently ## by pre-computing components, but these are essentially ## the gradients as one would derive them by hand nfun2 <- function(input, Asym, xmid, scal) { value <- Asym/(1+exp((xmid-input)/scal)) grad <- cbind(Asym=1/(1+exp((xmid-input)/scal)), xmid=-Asym/(1+exp((xmid-input)/scal))^2*1/scal* exp((xmid-input)/scal), scal=-Asym/(1+exp((xmid-input)/scal))^2* -(xmid-input)/scal^2*exp((xmid-input)/scal)) attr(value,"gradient") <- grad value } stopifnot(all.equal(attr(nfun(2,1,3,4),"gradient"), attr(nfun(2,1,3,4),"gradient"))) nm1c <- update(nm1,circumference ~ nfun2(age, Asym, xmid, scal) ~ Asym | Tree) } \keyword{models} lme4/man/vcconv.Rd0000644000176200001440000000633113751775607013500 0ustar liggesusers\name{vcconv} \alias{vcconv} \alias{mlist2vec} \alias{vec2mlist} \alias{vec2STlist} \alias{sdcor2cov} \alias{cov2sdcor} \alias{Vv_to_Cv} \alias{Sv_to_Cv} \alias{Cv_to_Vv} \alias{Cv_to_Sv} \title{Convert between representations of (co-)variance structures} \description{ Convert between representations of (co-)variance structures (EXPERIMENTAL). See source code for details. } \usage{ mlist2vec(L) vec2mlist(v, n = NULL, symm = TRUE) vec2STlist(v, n = NULL) sdcor2cov(m) cov2sdcor(V) Vv_to_Cv(v, n = NULL, s = 1) Sv_to_Cv(v, n = NULL, s = 1) Cv_to_Vv(v, n = NULL, s = 1) Cv_to_Sv(v, n = NULL, s = 1) } \arguments{ \item{L}{List of symmetric, upper-triangular, or lower-triangular square matrices.} \item{v}{Concatenated vector containing the elements of the lower-triangle (including the diagonal) of a symmetric or triangular matrix.} \item{n}{Number of rows (and columns) of the resulting matrix.} \item{symm}{Return symmetric matrix if \code{TRUE} or lower-triangular if \code{FALSE}.} \item{m}{Standard deviation-correlation matrix.} \item{V}{Covariance matrix.} \item{s}{Scale parameter.} } \value{ (Co-)variance structure } \details{ \itemize{ \item{\code{mlist2vec}}{Convert list of matrices to concatenated vector of lower triangles with an attribute that gives the dimension of each matrix in the original list. This attribute may be used to reconstruct the matrices. Returns a concatenation of the elements in one triangle of each matrix. An attribute \code{"clen"} gives the dimension of each matrix.} \item{\code{vec2mlist}}{Convert concatenated vector to list of matrices (lower triangle or symmetric). These matrices could represent Cholesky factors, covariance matrices, or correlation matrices (with standard deviations on the diagonal).} \item{\code{vec2STlist}}{Convert concatenated vector to list of ST matrices.} \item{\code{sdcor2cov}}{Standard deviation-correlation matrix to covariance matrix convert 'sdcor' format (std dev on diagonal, cor on off-diag) to and from variance-covariance matrix.} \item{\code{cov2sdcor}}{Covariance matrix to standard deviation-correlation matrix (i.e. standard deviations on the diagonal and correlations off the diagonal).} \item{\code{Vv_to_Cv}}{Variance-covariance to relative covariance factor. Returns a vector of elements from the lower triangle of a relative covariance factor.} \item{\code{Sv_to_Cv}}{Standard-deviation-correlation to relative covariance factor. Returns a vector of elements from the lower triangle of a relative covariance factor.} \item{\code{Cv_to_Vv}}{Relative covariance factor to variance-covariance. From unscaled Cholesky vector to (possibly scaled) variance-covariance vector. Returns a vector of elements from the lower triangle of a variance-covariance matrix.} \item{\code{Cv_to_Sv}}{Relative covariance factor to standard-deviation-correlation. From unscaled Chol to sd-cor vector. Returns a vector of elements from the lower triangle of a standard-deviation-correlation matrix.} } } \examples{ vec2mlist(1:6) mlist2vec(vec2mlist(1:6)) # approximate inverse } lme4/man/merMod-class.Rd0000644000176200001440000003665213751775607014541 0ustar liggesusers\docType{class} \name{merMod-class} \title{Class "merMod" of Fitted Mixed-Effect Models} \alias{anova.merMod} \alias{as.function.merMod} \alias{coef.merMod} \alias{deviance.merMod} \alias{df.residual.merMod} \alias{extractAIC.merMod} \alias{family.merMod} \alias{fitted.merMod} \alias{formula.merMod} \alias{glmerMod-class} \alias{lmerMod-class} \alias{logLik.merMod} \alias{merMod} \alias{merMod-class} \alias{model.frame.merMod} \alias{model.matrix.merMod} \alias{ngrps.merMod} \alias{nobs.merMod} \alias{nobs} \alias{nlmerMod-class} \alias{print.merMod} \alias{print.summary.merMod} \alias{show,merMod-method} \alias{show.merMod} \alias{show.summary.merMod} \alias{summary.merMod} \alias{summary.summary.merMod} \alias{terms.merMod} \alias{update.merMod} \alias{vcov.merMod} \alias{vcov.summary.merMod} \alias{weights.merMod} \alias{REMLcrit} \description{ A mixed-effects model is represented as a \code{\linkS4class{merPredD}} object and a response module of a class that inherits from class \code{\linkS4class{lmResp}}. A model with a \code{\linkS4class{lmerResp}} response has class \code{lmerMod}; a \code{\linkS4class{glmResp}} response has class \code{glmerMod}; and a \code{\linkS4class{nlsResp}} response has class \code{nlmerMod}. } \usage{ \S3method{anova}{merMod}(object, ..., refit = TRUE, model.names=NULL) \S3method{as.function}{merMod}(x, ...) \S3method{coef}{merMod}(object, ...) \S3method{deviance}{merMod}(object, REML = NULL, ...) REMLcrit(object) \S3method{extractAIC}{merMod}(fit, scale = 0, k = 2, ...) \S3method{family}{merMod}(object, ...) \S3method{formula}{merMod}(x, fixed.only = FALSE, random.only = FALSE, ...) \S3method{fitted}{merMod}(object, ...) \S3method{logLik}{merMod}(object, REML = NULL, ...) \S3method{nobs}{merMod}(object, ...) \S3method{ngrps}{merMod}(object, ...) \S3method{terms}{merMod}(x, fixed.only = TRUE, random.only = FALSE, \dots) \S3method{vcov}{merMod}(object, correlation = TRUE, sigm = sigma(object), use.hessian = NULL, \dots) \S3method{model.frame}{merMod}(formula, fixed.only = FALSE, ...) \S3method{model.matrix}{merMod}(object, type = c("fixed", "random", "randomListRaw"), ...) \S3method{print}{merMod}(x, digits = max(3, getOption("digits") - 3), correlation = NULL, symbolic.cor = FALSE, signif.stars = getOption("show.signif.stars"), ranef.comp = "Std.Dev.", ...) \S3method{summary}{merMod}(object, correlation = , use.hessian = NULL, \dots) \S3method{print}{summary.merMod}(x, digits = max(3, getOption("digits") - 3), correlation = NULL, symbolic.cor = FALSE, signif.stars = getOption("show.signif.stars"), ranef.comp = c("Variance", "Std.Dev."), show.resids = TRUE, ...) \S3method{update}{merMod}(object, formula., ..., evaluate = TRUE) \S3method{weights}{merMod}(object, type = c("prior", "working"), ...) } \arguments{ \item{object}{an \R object of class \code{\linkS4class{merMod}}, i.e., as resulting from \code{\link{lmer}()}, or \code{\link{glmer}()}, etc.} \item{x}{an \R object of class \code{merMod} or \code{summary.merMod}, respectively, the latter resulting from \code{summary()}.} \item{fit}{an \R object of class \code{\linkS4class{merMod}}.} \item{formula}{in the case of \code{model.frame}, a \code{\linkS4class{merMod}} object.} \item{refit}{logical indicating if objects of class \code{lmerMod} should be refitted with ML before comparing models. The default is \code{TRUE} to prevent the common mistake of inappropriately comparing REML-fitted models with different fixed effects, whose likelihoods are not directly comparable.} \item{model.names}{character vectors of model names to be used in the anova table.} \item{scale}{Not currently used (see \code{\link{extractAIC}}).} \item{k}{see \code{\link{extractAIC}}.} \item{REML}{Logical. If \code{TRUE}, return the restricted log-likelihood rather than the log-likelihood. If \code{NULL} (the default), set \code{REML} to \code{isREML(object)} (see \code{\link{isREML}}).} \item{fixed.only}{logical indicating if only the fixed effects components (terms or formula elements) are sought. If false, all components, including random ones, are returned.} \item{random.only}{complement of \code{fixed.only}; indicates whether random components only are sought. (Trying to specify \code{fixed.only} and \code{random.only} at the same time will produce an error.)} \item{correlation}{(logical) for \code{vcov}, indicates whether the correlation matrix as well as the variance-covariance matrix is desired; for \code{summary.merMod}, indicates whether the correlation matrix should be computed and stored along with the covariance; for \code{print.summary.merMod}, indicates whether the correlation matrix of the fixed-effects parameters should be printed. In the latter case, when \code{NULL} (the default), the correlation matrix is printed when it has been computed by \code{summary(.)}, and when \eqn{p <= 20}.}% and '20' can be changed by options(lme4.summary.cor.max = ) \item{use.hessian}{(logical) indicates whether to use the finite-difference Hessian of the deviance function to compute standard errors of the fixed effects, rather estimating based on internal information about the inverse of the model matrix (see \code{\link{getME}(.,"RX")}). The default is to to use the Hessian whenever the fixed effect parameters are arguments to the deviance function (i.e. for GLMMs with \code{nAGQ>0}), and to use \code{\link{getME}(.,"RX")} whenever the fixed effect parameters are profiled out (i.e. for GLMMs with \code{nAGQ==0} or LMMs). \code{use.hessian=FALSE} is backward-compatible with older versions of \code{lme4}, but may give less accurate SE estimates when the estimates of the fixed-effect (see \code{\link{getME}(.,"beta")}) and random-effect (see \code{\link{getME}(.,"theta")}) parameters are correlated. } \item{sigm}{the residual standard error; by default \code{\link{sigma}(object)}.} \item{digits}{number of significant digits for printing} \item{symbolic.cor}{should a symbolic encoding of the fixed-effects correlation matrix be printed? If so, the \code{\link{symnum}} function is used.} \item{signif.stars}{(logical) should significance stars be used?} \item{ranef.comp}{character vector of length one or two, indicating if random-effects parameters should be reported on the variance and/or standard deviation scale.} \item{show.resids}{should the quantiles of the scaled residuals be printed?} \item{formula.}{see \code{\link{update.formula}}.} \item{evaluate}{see \code{\link{update}}.} \item{type}{For \describe{ \item{\code{weights()}, }{type of weights to be returned; either \code{"prior"} for the initially supplied weights or \code{"working"} for the weights at the final iteration of the penalized iteratively reweighted least squares algorithm (PIRLS).} \item{\code{model.matrix()}, }{type of model matrix to return: one of \code{"fixed"} giving the fixed effects model matrix, \code{"random"} giving the random effects model matrix, or \code{"randomListRaw"} giving a list of the raw random effects model matrices associated with each random effects term.} }} \item{\dots}{potentially further arguments passed from other methods.} } \section{Objects from the Class}{ Objects of class \code{merMod} are created by calls to \code{\link{lmer}}, \code{\link{glmer}} or \code{\link{nlmer}}. } \section{S3 methods}{ The following S3 methods with arguments given above exist (this list is currently not complete): \describe{ %% TODO: document differences between update and update.merMod \item{\code{anova}:}{returns the sequential decomposition of the contributions of fixed-effects terms or, for multiple arguments, model comparison statistics. For objects of class \code{lmerMod} the default behavior is to refit the models with ML if fitted with \code{REML = TRUE}, this can be controlled via the \code{refit} argument. See also \code{\link{anova}}.} \item{\code{as.function}:}{returns the deviance function, the same as \code{\link{lmer}(*, devFunOnly=TRUE)}, and \code{\link{mkLmerDevfun}()} or \code{\link{mkGlmerDevfun}()}, respectively.} \item{\code{coef}:}{Computes the sum of the random and fixed effects coefficients for each explanatory variable for each level of each grouping factor.} \item{\code{extractAIC}:}{Computes the (generalized) Akaike An Information Criterion. If \code{isREML(fit)}, then \code{fit} is refitted using maximum likelihood.} \item{\code{family}:}{\code{\link{family}} of fitted GLMM. (\emph{Warning:} this accessor may not work properly with customized families/link functions.)} \item{\code{fitted}:}{Fitted values, given the conditional modes of the random effects. For more flexible access to fitted values, use \code{\link{predict.merMod}}.} \item{\code{logLik}:}{Log-likelihood at the fitted value of the parameters. Note that for GLMMs, the returned value is only proportional to the log probability density (or distribution) of the response variable. See \code{\link{logLik}}. } \item{\code{model.frame}:}{returns the \code{frame} slot of \code{\linkS4class{merMod}}.} \item{\code{model.matrix}:}{returns the fixed effects model matrix.} \item{\code{nobs}, \code{ngrps}:}{Number of observations and vector of the numbers of levels in each grouping factor. See \code{\link{ngrps}}.} \item{\code{summary}:}{Computes and returns a list of summary statistics of the fitted model, the amount of output can be controlled via the \code{print} method, see also \code{\link{summary}}.} \item{\code{print.summary}:}{Controls the output for the summary method.} \item{\code{vcov}:}{Calculate variance-covariance matrix of the \emph{fixed} effect terms, see also \code{\link{vcov}}.} \item{\code{update}:}{See \code{\link{update}}.} } } \section{Deviance and log-likelihood of GLMMs}{ One must be careful when defining the deviance of a GLM. For example, should the deviance be defined as minus twice the log-likelihood or does it involve subtracting the deviance for a saturated model? To distinguish these two possibilities we refer to absolute deviance (minus twice the log-likelihood) and relative deviance (relative to a saturated model, e.g. Section 2.3.1 in McCullagh and Nelder 1989). With GLMMs however, there is an additional complication involving the distinction between the likelihood and the conditional likelihood. The latter is the likelihood obtained by conditioning on the estimates of the conditional modes of the spherical random effects coefficients, whereas the likelihood itself (i.e. the unconditional likelihood) involves integrating out these coefficients. The following table summarizes how to extract the various types of deviance for a \code{glmerMod} object: \tabular{lrr}{ \tab conditional \tab unconditional \cr relative \tab \code{deviance(object)} \tab NA in \code{lme4} \cr absolute \tab \code{object@resp$aic()} \tab \code{-2*logLik(object)} } This table requires two caveats: \itemize{ \item If the link function involves a scale parameter (e.g. \code{Gamma}) then \code{object@resp$aic() - 2 * getME(object, "devcomp")$dims["useSc"]} is required for the absolute-conditional case. \item If adaptive Gauss-Hermite quadrature is used, then \code{logLik(object)} is currently only proportional to the absolute-unconditional log-likelihood. } For more information about this topic see the \code{misc/logLikGLMM}% ../misc/logLikGLMM/ directory in the package source. %% We define the conditional likelihood as the density of the response %% variable, \eqn{y}, conditional on the spherical random effects, %% \eqn{u}: %% \deqn{f_{\theta,\beta}(y|u)}{f(y|u)} %% which depends on the fixed effect and covariance parameters, %% \eqn{\beta} and \eqn{\theta}. We define the likelihood itself as: %% \deqn{f_{\theta,\beta}(y) = \int f_{\theta,\beta}(y|u) f(u)}{f(y) = integral(f(y|u)f(u))} %% where \eqn{f(u)} is an independent multivariate normal. It is not %% typically possible to evaluate this integral for GLMMs. In %% \code{lme4} we approximate it using the Laplace approximation and %% adaptive Gauss-Hermite quadrature. %% For canonical links, the Laplace approximation to the log-likelihood %% is: %% \deqn{log f_{\theta,\beta}(y | u)-0.5|u|^2 - log|L_{\theta}|} %% {log f(y|u) - 0.5|u|^2 - log|L|} %% where \eqn{|u|^2} is the squared length of the vector of spherical %% random effects, \eqn{u}, and \eqn{|L_{\theta}|}{|L|} is the %% determinant of the Cholesky factor for the cross-product matrix for %% the random effects (\code{\link{getME}(., "L")}). Note that in the %% non-canonical link case, the above equation is technically an %% approximation to the Laplace approximation. %% For models with a single scalar random effect one may also obtain an %% approximate log-likelihood using adaptive Gauss-Hermite quadrature as: %% \deqn{-\log|\bm L| - \frac{q}{2}\log(2\pi) + \sum_j^q \log \left[\sum_k^{N_{AGQ}} w_k f(y, u_{jk}) e^{-\frac{1}{2}u_{jk}^2 - l_k}\right]} %% where \eqn{N_{AGQ}} is the number of quadrature nodes, \eqn{q} is the %% number of levels of the random effect, the \eqn{w_k} and \eqn{l_k} are %% weights and log of the normal density associated with the \eqn{k}th %% quadrature node (\code{\link{GHrule}}), and \eqn{u_{jk}} is the value %% of the spherical random effect coefficient associated with the %% \eqn{j}th level of the grouping factor and \eqn{k}th quadrature node. } \section{Slots}{ \describe{ \item{\code{resp}:}{A reference class object for an \pkg{lme4} response module (\code{\link{lmResp-class}}).} \item{\code{Gp}:}{See \code{\link{getME}}.} \item{\code{call}:}{The matched call.} \item{\code{frame}:}{The model frame containing all of the variables required to parse the model formula.} \item{\code{flist}:}{See \code{\link{getME}}.} \item{\code{cnms}:}{See \code{\link{getME}}.} \item{\code{lower}:}{See \code{\link{getME}}.} \item{\code{theta}:}{Covariance parameter vector.} \item{\code{beta}:}{Fixed effects coefficients.} \item{\code{u}:}{Conditional model of spherical random effects coefficients.} \item{\code{devcomp}:}{See \code{\link{getME}}.} \item{\code{pp}:}{A reference class object for an \pkg{lme4} predictor module (\code{\link{merPredD-class}}).} \item{\code{optinfo}:}{List containing information about the nonlinear optimization.} } } \seealso{ \code{\link{lmer}}, \code{\link{glmer}}, \code{\link{nlmer}}, \code{\linkS4class{merPredD}}, \code{\linkS4class{lmerResp}}, \code{\linkS4class{glmResp}}, \code{\linkS4class{nlsResp}} Other methods for \code{merMod} objects documented elsewhere include: \code{\link{fortify.merMod}}, \code{\link{drop1.merMod}}, \code{\link{isLMM.merMod}}, \code{\link{isGLMM.merMod}}, \code{\link{isNLMM.merMod}}, \code{\link{isREML.merMod}}, \code{\link{plot.merMod}}, \code{\link{predict.merMod}}, \code{\link{profile.merMod}}, \code{\link{ranef.merMod}}, \code{\link{refit.merMod}}, \code{\link{refitML.merMod}}, \code{\link{residuals.merMod}}, \code{\link{sigma.merMod}}, \code{\link{simulate.merMod}}, \code{\link{summary.merMod}}. } \examples{ showClass("merMod") methods(class="merMod")## over 30 (S3) methods available ## -> example(lmer) for an example of vcov.merMod() } \keyword{classes} lme4/man/plot.merMod.Rd0000644000176200001440000001351214147555751014375 0ustar liggesusers\name{plot.merMod} \title{Diagnostic Plots for 'merMod' Fits} \alias{plot.merMod} \alias{qqmath.merMod} \usage{ \method{plot}{merMod}(x, form = resid(., type = "pearson") ~ fitted(.), abline, id = NULL, idLabels = NULL, grid, \dots) \method{qqmath}{merMod}(x, id = NULL, idLabels = NULL, \dots) } \arguments{ \item{x}{a fitted [ng]lmer model} \item{form}{an optional formula specifying the desired type of plot. Any variable present in the original data frame used to obtain \code{x} can be referenced. In addition, \code{x} itself can be referenced in the formula using the symbol \code{"."}. Conditional expressions on the right of a \code{|} operator can be used to define separate panels in a lattice display. Default is \code{resid(., type = "pearson") ~ fitted(.)}, corresponding to a plot of the standardized residuals versus fitted values.} \item{abline}{an optional numeric value, or numeric vector of length two. If given as a single value, a horizontal line will be added to the plot at that coordinate; else, if given as a vector, its values are used as the intercept and slope for a line added to the plot. If missing, no lines are added to the plot.} \item{id}{an optional numeric value, or one-sided formula. If given as a value, it is used as a significance level for a two-sided outlier test for the standardized, or normalized residuals. Observations with absolute standardized (normalized) residuals greater than the \eqn{1-value/2} quantile of the standard normal distribution are identified in the plot using \code{idLabels}. If given as a one-sided formula, its right hand side must evaluate to a logical, integer, or character vector which is used to identify observations in the plot. If missing, no observations are identified.} \item{idLabels}{an optional vector, or one-sided formula. If given as a vector, it is converted to character and used to label the observations identified according to \code{id}. If given as a vector, it is converted to character and used to label the observations identified according to \code{id}. If given as a one-sided formula, its right hand side must evaluate to a vector which is converted to character and used to label the identified observations. Default is the interaction of all the grouping variables in the data frame. The special formula \code{idLabels=~.obs} will label the observations according to observation number.} \item{grid}{an optional logical value indicating whether a grid should be added to plot. Default depends on the type of lattice plot used: if \code{xyplot} defaults to \code{TRUE}, else defaults to \code{FALSE}.} \item{\dots}{optional arguments passed to the lattice plot function.} } \description{ diagnostic plots for merMod fits } \details{ Diagnostic plots for the linear mixed-effects fit are obtained. The \code{form} argument gives considerable flexibility in the type of plot specification. A conditioning expression (on the right side of a \code{|} operator) always implies that different panels are used for each level of the conditioning factor, according to a lattice display. If \code{form} is a one-sided formula, histograms of the variable on the right hand side of the formula, before a \code{|} operator, are displayed (the lattice function \code{histogram} is used). If \code{form} is two-sided and both its left and right hand side variables are numeric, scatter plots are displayed (the lattice function \code{xyplot} is used). Finally, if \code{form} is two-sided and its left had side variable is a factor, box-plots of the right hand side variable by the levels of the left hand side variable are displayed (the lattice function \code{bwplot} is used). \code{qqmath} produces a Q-Q plot of the residuals (see \code{\link{qqmath.ranef.mer}} for Q-Q plots of the conditional mode values). } \seealso{\code{influencePlot} in the \code{car} package} \author{ original version in \CRANpkg{nlme} package by Jose Pinheiro and Douglas Bates. } \examples{ data(Orthodont,package="nlme") fm1 <- lmer(distance ~ age + (age|Subject), data=Orthodont) ## standardized residuals versus fitted values by gender plot(fm1, resid(., scaled=TRUE) ~ fitted(.) | Sex, abline = 0) ## box-plots of residuals by Subject plot(fm1, Subject ~ resid(., scaled=TRUE)) ## observed versus fitted values by Subject plot(fm1, distance ~ fitted(.) | Subject, abline = c(0,1)) ## residuals by age, separated by Subject plot(fm1, resid(., scaled=TRUE) ~ age | Sex, abline = 0) ## scale-location plot, with red smoothed line scale_loc_plot <- function(m, line.col = "red", line.lty = 1, line.lwd = 2) { plot(fm1, sqrt(abs(resid(.))) ~ fitted(.), type = c("p", "smooth"), par.settings = list(plot.line = list(alpha=1, col = line.col, lty = line.lty, lwd = line.lwd))) } scale_loc_plot(fm1) ## Q-Q plot lattice::qqmath(fm1, id=0.05) ggp.there <- "package:ggplot2" \%in\% search() if (ggp.there || require("ggplot2")) { ## we can create the same plots using ggplot2 and the fortify() function fm1F <- fortify.merMod(fm1) ggplot(fm1F, aes(.fitted, .resid)) + geom_point(colour="blue") + facet_grid(. ~ Sex) + geom_hline(yintercept=0) ## note: Subjects are ordered by mean distance ggplot(fm1F, aes(Subject,.resid)) + geom_boxplot() + coord_flip() ggplot(fm1F, aes(.fitted,distance)) + geom_point(colour="blue") + facet_wrap(~Subject) +geom_abline(intercept=0,slope=1) ggplot(fm1F, aes(age,.resid)) + geom_point(colour="blue") + facet_grid(.~Sex) + geom_hline(yintercept=0)+ geom_line(aes(group=Subject),alpha=0.4) + geom_smooth(method="loess") ## (warnings about loess are due to having only 4 unique x values) if(!ggp.there) detach("package:ggplot2") } } lme4/man/expandDoubleVerts.Rd0000644000176200001440000000340313751775607015635 0ustar liggesusers\name{expandDoubleVerts} \alias{expandDoubleVerts} \alias{||} \title{Expand terms with \code{'||'} notation into separate \code{'|'} terms} \usage{ expandDoubleVerts(term) } \arguments{ \item{term}{a mixed-model formula} } \value{ the modified term } \description{ From the right hand side of a formula for a mixed-effects model, expand terms with the double vertical bar operator into separate, independent random effect terms. } \note{ Because \code{||} works at the level of formula parsing, it has no way of knowing whether a variable is a factor. It just takes the terms within a random-effects term and literally splits them into the intercept and separate no-intercept terms, e.g. \code{(1+x+y|f)} would be split into \code{(1|f) + (0+x|f) + (0+y|f)}. However, \code{||} will fail to break up factors into separate terms; the \code{\link{dummy}} function can be useful in this case, although it is not as convenient as \code{||}. } \examples{ m <- ~ x + (x || g) expandDoubleVerts(m) set.seed(101) dd <- expand.grid(f=factor(letters[1:3]),g=factor(1:200),rep=1:3) dd$y <- simulate(~f + (1|g) + (0+dummy(f,"b")|g) + (0+dummy(f,"c")|g), newdata=dd, newparams=list(beta=rep(0,3), theta=c(1,2,1), sigma=1), family=gaussian)[[1]] m1 <- lmer(y~f+(f|g),data=dd) VarCorr(m1) m2 <- lmer(y~f+(1|g) + (0+dummy(f,"b")|g) + (0+dummy(f,"c")|g), data=dd) VarCorr(m2) } \seealso{ \code{\link{formula}}, \code{\link{model.frame}}, \code{\link{model.matrix}}, \code{\link{dummy}}. Other utilities: \code{\link{mkRespMod}}, \code{\link{mkReTrms}}, \code{\link{nlformula}}, \code{\link{nobars}}, \code{\link{subbars}} } \keyword{models} \keyword{utilities} lme4/man/cbpp.Rd0000644000176200001440000000455513751775607013134 0ustar liggesusers\docType{data} \name{cbpp} \alias{cbpp} \title{Contagious bovine pleuropneumonia} \format{A data frame with 56 observations on the following 4 variables. \describe{ \item{\code{herd}}{A factor identifying the herd (1 to 15).} \item{\code{incidence}}{The number of new serological cases for a given herd and time period.} \item{\code{size}}{A numeric vector describing herd size at the beginning of a given time period.} \item{\code{period}}{A factor with levels \code{1} to \code{4}.} }} \source{ Lesnoff, M., Laval, G., Bonnet, P., Abdicho, S., Workalemahu, A., Kifle, D., Peyraud, A., Lancelot, R., Thiaucourt, F. (2004) Within-herd spread of contagious bovine pleuropneumonia in Ethiopian highlands. \emph{Preventive Veterinary Medicine} \bold{64}, 27--40. } \description{ Contagious bovine pleuropneumonia (CBPP) is a major disease of cattle in Africa, caused by a mycoplasma. This dataset describes the serological incidence of CBPP in zebu cattle during a follow-up survey implemented in 15 commercial herds located in the Boji district of Ethiopia. The goal of the survey was to study the within-herd spread of CBPP in newly infected herds. Blood samples were quarterly collected from all animals of these herds to determine their CBPP status. These data were used to compute the serological incidence of CBPP (new cases occurring during a given time period). Some data are missing (lost to follow-up). } \details{ Serological status was determined using a competitive enzyme-linked immuno-sorbent assay (cELISA). } \examples{ ## response as a matrix (m1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp)) ## response as a vector of probabilities and usage of argument "weights" m1p <- glmer(incidence / size ~ period + (1 | herd), weights = size, family = binomial, data = cbpp) ## Confirm that these are equivalent: stopifnot(all.equal(fixef(m1), fixef(m1p), tolerance = 1e-5), all.equal(ranef(m1), ranef(m1p), tolerance = 1e-5)) %% more extensive variations of the above --> ../tests/glmer-1.R ## GLMM with individual-level variability (accounting for overdispersion) cbpp$obs <- 1:nrow(cbpp) (m2 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd) + (1|obs), family = binomial, data = cbpp)) } \keyword{datasets} lme4/man/checkConv.Rd0000644000176200001440000000220513751775607014101 0ustar liggesusers\name{checkConv} \alias{checkConv} \title{ Extended Convergence Checking } \description{ Primarily internal code for checking optimization convergence, see \link{convergence} for a more detailed discussion. } \usage{ checkConv(derivs, coefs, ctrl, lbound, debug = FALSE) } \arguments{ \item{derivs}{typically the "derivs" attribute of \code{optimizeLmer()}; with "gradients" and possibly "Hessian" component} \item{coefs}{ current coefficient estimates} \item{ctrl}{list of lists, each with \code{action} character strings specifying what should happen when a check triggers, and \code{tol} numerical tolerances, as is the result of \code{\link{lmerControl}()$checkConv}.} \item{lbound}{vector of lower bounds \emph{for random-effects parameters only} (length is taken to determine number of RE parameters)} \item{debug}{enable debugging output, useful if some checks are on "ignore", but would "trigger"} } \value{ A result list containing \item{code }{The return code for the check} \item{messages }{A character vector of warnings and messages generated by the check} } \seealso{ \code{\link{convergence}} } lme4/man/drop1.merMod.Rd0000644000176200001440000000734113751775607014453 0ustar liggesusers\name{drop1.merMod} \alias{drop1.merMod} \title{Drop all possible single fixed-effect terms from a mixed effect model} \description{ Drop allowable single terms from the model: see \code{\link{drop1}} for details of how the appropriate scope for dropping terms is determined. } \usage{ \method{drop1}{merMod}(object, scope, scale = 0, test = c("none", "Chisq", "user"), k = 2, trace = FALSE, sumFun, \dots) } \arguments{ \item{object}{a fitted \code{merMod} object.} \item{scope}{a formula giving the terms to be considered for adding or dropping.} \item{scale}{Currently ignored (included for S3 method compatibility)} \item{test}{should the results include a test statistic relative to the original model? The \eqn{\chi^2}{Chisq} test is a likelihood-ratio test, which is approximate due to finite-size effects. } \item{k}{the penalty constant in AIC} \item{trace}{print tracing information?} \item{sumFun}{a summary \code{\link{function}} to be used when \code{test=="user"}. It must allow arguments \code{scale} and \code{k}, but these may be ignored (e.g. swallowed by \code{\dots}, see the examples). The first two arguments must be \code{object}, the full model fit, and \code{objectDrop}, a reduced model. If \code{objectDrop} is missing, \code{sumFun(*)} should return a vector with the appropriate length and names (the actual contents are ignored). } \item{\dots}{other arguments (ignored)} } \value{ An object of class \code{anova} summarizing the differences in fit between the models. } \details{ \code{drop1} relies on being able to find the appropriate information within the environment of the formula of the original model. If the formula is created in an environment that does not contain the data, or other variables passed to the original model (for example, if a separate function is called to define the formula), then \code{drop1} will fail. A workaround (see example below) is to manually specify an appropriate environment for the formula. } \examples{ fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ## likelihood ratio tests drop1(fm1,test="Chisq") ## use Kenward-Roger corrected F test, or parametric bootstrap, ## to test the significance of each dropped predictor if (require(pbkrtest) && packageVersion("pbkrtest")>="0.3.8") { KRSumFun <- function(object, objectDrop, ...) { krnames <- c("ndf","ddf","Fstat","p.value","F.scaling") r <- if (missing(objectDrop)) { setNames(rep(NA,length(krnames)),krnames) } else { krtest <- KRmodcomp(object,objectDrop) unlist(krtest$stats[krnames]) } attr(r,"method") <- c("Kenward-Roger via pbkrtest package") r } drop1(fm1, test="user", sumFun=KRSumFun) if(lme4:::testLevel() >= 3) { ## takes about 16 sec nsim <- 100 PBSumFun <- function(object, objectDrop, ...) { pbnames <- c("stat","p.value") r <- if (missing(objectDrop)) { setNames(rep(NA,length(pbnames)),pbnames) } else { pbtest <- PBmodcomp(object,objectDrop,nsim=nsim) unlist(pbtest$test[2,pbnames]) } attr(r,"method") <- c("Parametric bootstrap via pbkrtest package") r } system.time(drop1(fm1, test="user", sumFun=PBSumFun)) } } ## workaround for creating a formula in a separate environment createFormula <- function(resp, fixed, rand) { f <- reformulate(c(fixed,rand),response=resp) ## use the parent (createModel) environment, not the ## environment of this function (which does not contain 'data') environment(f) <- parent.frame() f } createModel <- function(data) { mf.final <- createFormula("Reaction", "Days", "(Days|Subject)") lmer(mf.final, data=data) } drop1(createModel(data=sleepstudy)) } \keyword{misc} lme4/man/lmer.Rd0000644000176200001440000002137013751775607013141 0ustar liggesusers\name{lmer} \title{Fit Linear Mixed-Effects Models} \alias{lmer} \concept{ LMM } \description{ Fit a linear mixed-effects model (LMM) to data, via REML or maximum likelihood. } \usage{ lmer(formula, data = NULL, REML = TRUE, control = lmerControl(), start = NULL, verbose = 0L, subset, weights, na.action, offset, contrasts = NULL, devFunOnly = FALSE) } \arguments{ \item{formula}{a two-sided linear formula object describing both the fixed-effects and random-effects part of the model, with the response on the left of a \code{~} operator and the terms, separated by \code{+} operators, on the right. Random-effects terms are distinguished by vertical bars (\code{|}) separating expressions for design matrices from grouping factors. Two vertical bars (\code{||}) can be used to specify multiple uncorrelated random effects for the same grouping variable. %---------- (Because of the way it is implemented, the \code{||}-syntax \emph{works only for design matrices containing numeric (continuous) predictors}; to fit models with independent categorical effects, see \code{\link{dummy}} or the \code{lmer_alt} function from the \CRANpkg{afex} package.) } \item{data}{an optional data frame containing the variables named in \code{formula}. By default the variables are taken from the environment from which \code{lmer} is called. While \code{data} is optional, the package authors \emph{strongly} recommend its use, especially when later applying methods such as \code{update} and \code{drop1} to the fitted model (\emph{such methods are not guaranteed to work properly if \code{data} is omitted}). If \code{data} is omitted, variables will be taken from the environment of \code{formula} (if specified as a formula) or from the parent frame (if specified as a character vector).} \item{REML}{logical scalar - Should the estimates be chosen to optimize the REML criterion (as opposed to the log-likelihood)?} \item{control}{a list (of correct class, resulting from \code{\link{lmerControl}()} or \code{\link{glmerControl}()} respectively) containing control parameters, including the nonlinear optimizer to be used and parameters to be passed through to the nonlinear optimizer, see the \code{*lmerControl} documentation for details.} \item{start}{a named \code{\link{list}} of starting values for the parameters in the model. For \code{lmer} this can be a numeric vector or a list with one component named \code{"theta"}.} \item{verbose}{integer scalar. If \code{> 0} verbose output is generated during the optimization of the parameter estimates. If \code{> 1} verbose output is generated during the individual penalized iteratively reweighted least squares (PIRLS) steps.} \item{subset}{an optional expression indicating the subset of the rows of \code{data} that should be used in the fit. This can be a logical vector, or a numeric vector indicating which observation numbers are to be included, or a character vector of the row names to be included. All observations are included by default.} \item{weights}{an optional vector of \sQuote{prior weights} to be used in the fitting process. Should be \code{NULL} or a numeric vector. Prior \code{weights} are \emph{not} normalized or standardized in any way. In particular, the diagonal of the residual covariance matrix is the squared residual standard deviation parameter \code{\link{sigma}} times the vector of inverse \code{weights}. Therefore, if the \code{weights} have relatively large magnitudes, then in order to compensate, the \code{\link{sigma}} parameter will also need to have a relatively large magnitude.} \item{na.action}{a function that indicates what should happen when the data contain \code{NA}s. The default action (\code{na.omit}, inherited from the 'factory fresh' value of \code{getOption("na.action")}) strips any observations with any missing values in any variables.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. This should be \code{NULL} or a numeric vector of length equal to the number of cases. One or more \code{\link{offset}} terms can be included in the formula instead or as well, and if more than one is specified their sum is used. See \code{\link{model.offset}}.} \item{contrasts}{an optional list. See the \code{contrasts.arg} of \code{model.matrix.default}.} \item{devFunOnly}{logical - return only the deviance evaluation function. Note that because the deviance function operates on variables stored in its environment, it may not return \emph{exactly} the same values on subsequent calls (but the results should always be within machine tolerance).} } \value{ An object of class \code{\link[=merMod-class]{merMod}} (more specifically, an object of \emph{subclass} \code{lmerMod}), for which many methods are available (e.g. \code{methods(class="merMod")}) } \note{ In earlier version of the \pkg{lme4} package, a \code{method} argument was used. Its functionality has been replaced by the \code{REML} argument. Also, \code{lmer(.)} allowed a \code{family} argument (to effectively switch to \code{glmer(.)}). This has been deprecated in summer 2013, and been disabled in spring 2019. } \details{ \itemize{ \item{If the \code{formula} argument is specified as a character vector, the function will attempt to coerce it to a formula. However, this is not recommended (users who want to construct formulas by pasting together components are advised to use \code{\link{as.formula}} or \code{\link{reformulate}}); model fits will work but subsequent methods such as \code{\link{drop1}}, \code{\link{update}} may fail.} \item{When handling perfectly collinear predictor variables (i.e. design matrices of less than full rank), \code{[gn]lmer} is not quite as sophisticated as some simpler modeling frameworks such as \code{\link{lm}} and \code{\link{glm}}. While it does automatically drop collinear variables (with a message rather than a warning), it does not automatically fill in \code{NA} values for the dropped coefficients; these can be added via \code{fixef(fitted.model,add.dropped=TRUE)}. This information can also be retrieved via \code{attr(getME(fitted.model,"X"),"col.dropped")}. } \item{the deviance function returned when \code{devFunOnly} is \code{TRUE} takes a single numeric vector argument, representing the \code{theta} vector. This vector defines the scaled variance-covariance matrices of the random effects, in the Cholesky parameterization. For models with only simple (intercept-only) random effects, \code{theta} is a vector of the standard deviations of the random effects. For more complex or multiple random effects, running \code{getME(.,"theta")} to retrieve the \code{theta} vector for a fitted model and examining the names of the vector is probably the easiest way to determine the correspondence between the elements of the \code{theta} vector and elements of the lower triangles of the Cholesky factors of the random effects.} } } \seealso{ \code{\link[stats]{lm}} for linear models; \code{\link{glmer}} for generalized linear; and \code{\link{nlmer}} for nonlinear mixed models. } \examples{ ## linear mixed models - reference values from older code (fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)) summary(fm1)# (with its own print method; see class?merMod % ./merMod-class.Rd str(terms(fm1)) stopifnot(identical(terms(fm1, fixed.only=FALSE), terms(model.frame(fm1)))) attr(terms(fm1, FALSE), "dataClasses") # fixed.only=FALSE needed for dataCl. ## Maximum Likelihood (ML), and "monitor" iterations via 'verbose': fm1_ML <- update(fm1, REML=FALSE, verbose = 1) (fm2 <- lmer(Reaction ~ Days + (Days || Subject), sleepstudy)) anova(fm1, fm2) sm2 <- summary(fm2) print(fm2, digits=7, ranef.comp="Var") # the print.merMod() method print(sm2, digits=3, corr=FALSE) # the print.summary.merMod() method (vv <- vcov.merMod(fm2, corr=TRUE)) as(vv, "corMatrix")# extracts the ("hidden") 'correlation' entry in @factors ## Fit sex-specific variances by constructing numeric dummy variables ## for sex and sex:age; in this case the estimated variance differences ## between groups in both intercept and slope are zero ... data(Orthodont,package="nlme") Orthodont$nsex <- as.numeric(Orthodont$Sex=="Male") Orthodont$nsexage <- with(Orthodont, nsex*age) lmer(distance ~ age + (age|Subject) + (0+nsex|Subject) + (0 + nsexage|Subject), data=Orthodont) } \keyword{models} lme4/man/rePos.Rd0000644000176200001440000000134513751775607013272 0ustar liggesusers\name{rePos} \alias{rePos} \title{Generator object for the rePos (random-effects positions) class} \usage{ rePos(...) } \arguments{ \item{\dots}{Argument list (see Note).} } \description{ The generator object for the \code{\linkS4class{rePos}} class used to determine the positions and orders of random effects associated with particular random-effects terms in the model. } \note{ Arguments to the \code{new} methods must be named arguments. \code{mer}, an object of class \code{"\linkS4class{merMod}"}, is the only required/expected argument. } \section{Methods}{ \describe{ \item{\code{new(mer=mer)}}{Create a new \code{\linkS4class{rePos}} object.} } } \seealso{ \code{\linkS4class{rePos}} } \keyword{classes} lme4/man/mkMerMod.Rd0000644000176200001440000000210513751775607013710 0ustar liggesusers\name{mkMerMod} \title{Create a 'merMod' Object} \alias{mkMerMod} \description{ Create an object of (a subclass of) class \code{\linkS4class{merMod}} from the environment of the objective function and the value returned by the optimizer. } \usage{ mkMerMod(rho, opt, reTrms, fr, mc, lme4conv = NULL) } \arguments{ \item{rho}{the environment of the objective function} \item{opt}{the optimization result returned by the optimizer (a \code{\link{list}}: see \code{\link{lmerControl}} for required elements)} \item{reTrms}{random effects structure from the calling function (see \code{\link{mkReTrms}} for required elements)} \item{fr}{model frame (see \code{\link{model.frame}})} \item{mc}{matched call from the calling function} \item{lme4conv}{lme4-specific convergence information (results of \code{checkConv})} } \value{ an object from a class that inherits from \code{\linkS4class{merMod}}. } %% FIXME: TODO %% \examples{ %% ## 1) An "empty" merMod object : %% ## 2) A "lmer()-like" merMod object, using our "modular" approach instead of lmer() %% } lme4/man/lmList4-class.Rd0000644000176200001440000000341513751775607014635 0ustar liggesusers\docType{class} \name{lmList4-class} \alias{lmList4-class} \alias{show,lmList4-method} \title{Class "lmList4" of 'lm' Objects on Common Model} \description{ Class \code{"lmList4"} is an S4 class with basically a \code{\link{list}} of objects of class \code{\link{lm}} with a common model (but different data); see \code{\link{lmList}()} which returns these. Package \pkg{nlme}'s \code{\link[nlme]{lmList}()} returns objects of S3 class \code{"lmList"} and provides methods for them, on which our methods partly build. } \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("lmList4", ...)} or, more commonly, by a call to \code{\link{lmList}()}. } \section{Methods}{ A dozen \code{\link{methods}} are provided. Currently, S4 methods for \code{\link{show}}, coercion (\code{\link{as}(.,.)}) and others inherited via \code{"list"}, and S3 methods for \code{\link{coef}}, \code{\link{confint}}, \code{\link{fitted}}, \code{\link{fixef}}, \code{\link{formula}}, \code{\link{logLik}}, \code{\link{pairs}}, \code{\link{plot}}, \code{\link{predict}}, \code{\link{print}}, \code{\link{qqnorm}}, \code{\link{ranef}}, \code{\link{residuals}}, \code{\link{sigma}}, \code{\link{summary}}, and \code{\link{update}}. \describe{ \item{sigma(object)}{returns the standard deviation \eqn{\hat{\sigma}}{\sigma-hat} (of the errors in the linear models), assuming a \emph{common} variance \eqn{\sigma^2} by pooling (even when \code{pool = FALSE} was used in the fit).} } } \seealso{\code{\link{lmList}}} \examples{ if(getRversion() >= "3.2.0") { (mm <- methods(class = "lmList4")) ## The S3 ("not S4") ones : mm[!attr(mm,"info")[,"isS4"]] } ## For more examples: example(lmList) i.e., ?lmList } \keyword{classes} lme4/man/influence.merMod.Rd0000644000176200001440000001411314063503234015347 0ustar liggesusers\name{influence.merMod} \title{Influence Diagnostics for Mixed-Effects Models} \alias{influence.merMod} \alias{dfbeta.influence.merMod} \alias{dfbetas.influence.merMod} \alias{cooks.distance.influence.merMod} \alias{cooks.distance.merMod} \description{ These functions compute deletion influence diagnostics for linear (fit by \code{\link{lmer}}) and generalized linear mixed-effects models (fit by \code{\link[lme4]{glmer}}). The main functions are methods for the \code{\link{influence}} generic function. Other functions are provided for computing \code{\link{dfbeta}}, \code{\link{dfbetas}}, \code{\link{cooks.distance}}, and influence on variance-covariance components based on the objects computed by \code{influence.merMod} } \usage{ \method{influence}{merMod}(model, groups, data, maxfun = 1000, do.coef = TRUE, ncores = getOption("mc.cores",1), start, ...) \method{cooks.distance}{influence.merMod}(model, ...) \method{dfbeta}{influence.merMod}(model, which = c("fixed", "var.cov"), ...) \method{dfbetas}{influence.merMod}(model, ...) } \arguments{ \item{model}{in the case of \code{influence.merMod}, a model of class \code{"merMod"}; in the case of \code{cooks.distance}, \code{dfbeta}, or \code{dfbetas}, an object returned by \code{influence.merMod}} \item{groups}{a character vector containing the name of a grouping factor or names of grouping factors; if more than one name is supplied, then groups are defined by all combinations of levels of the grouping factors that appear in the data. If omitted, then each individual row of the data matrix is treated as a "group" to be deleted in turn.} \item{data}{an optional data frame with the data to which \code{model} was fit; \code{influence.merMod} can usually retrieve the data used to fit the model, unless it can't be found in the current environment, so it's usually unnecessary to supply this argument.} \item{maxfun}{The maximum number of function evaluations (for \code{influence.merMod}) to perform after deleting each group; the defaults are large enough so that the iterations will typically continue to convergence. Setting to \code{maxfun=20} for an \code{lmer} model or \code{100} for a \code{glmer} model will typically produce a faster reasonable approximation. An even smaller value can be used if interest is only in influence on the fixed effects.} \item{which}{if \code{"fixed.effects"} (the default), return influence on the fixed effects; if \code{"var.cov"}, return influence on the variance-covariance components.} \item{do.coef}{if \code{FALSE}, skip potentially time-consuming computations, returning just a list containing hat values.} \item{ncores}{number of computational cores to use if run in parallel; directly passed to \code{\link[parallel]{makeCluster}()} from \R's \pkg{parallel} package.} \item{start}{starting value for new fits (set to optimal values from original fit by default)} \item{\dots}{ignored.} } \details{ \code{influence.merMod} start with the estimated variance-covariance components from \code{model} and then refit the model omitting each group in turn, not necessarily iterating to completion. For example, \code{maxfun=20} takes up to 20 function evaluations step away from the ML or REML solution for the full data, which usually provides decent approximations to the fully iterated estimates. The other functions are methods for the \code{\link{dfbeta}}, \code{\link{dfbetas}}, and \code{\link{cooks.distance}} generics, to be applied to the \code{"influence.merMod"} object produced by the \code{influence} function; the \code{dfbeta} methods can also return influence on the variance-covariance components. } \value{\code{influence.merMod} returns objects of class \code{"influence.merMod"}, which contain the following elements: \describe{ \item{\code{"fixed.effects"}}{the estimated fixed effects for the model.} \item{\code{"fixed.effects[-groups]"}}{a matrix with columns corresponding to the fixed-effects coefficients and rows corresponding to groups, giving the estimated fixed effects with each group deleted in turn; \emph{groups} is formed from the name(s) of the grouping factor(s).} \item{\code{"var.cov.comps"}}{the estimated variance-covariance parameters for the model.} \item{\code{"var.cov.comps[-groups]"}}{a matrix with the estimated covariance parameters (in columns) with each group deleted in turn.} \item{\code{"vcov"}}{The estimated covariance matrix of the fixed-effects coefficients.} \item{\code{"vcov[-groups]"}}{a list each of whose elements is the estimated covariance matrix of the fixed-effects coefficients with one group deleted.} \item{\code{"groups"}}{a character vector giving the names of the grouping factors.} \item{\code{"deleted"}}{the possibly composite grouping factor, each of whose elements is deleted in turn.} \item{\code{"converged"}}{for \code{influence.merMod}, a logical vector indicating whether the computation converged for each group.} \item{\code{"function.evals"}}{for \code{influence.merMod}, a vector of the number of function evaluations performed for each group.} } For plotting \code{"influence.merMod"} objects, see \code{\link[car]{infIndexPlot}}. } \references{ Fox, J. and Weisberg, S. (2019) \emph{An R Companion to Applied Regression}, Third Edition, Sage. } \author{ J. Fox \email{jfox@mcmaster.ca} } \seealso{ \code{\link[car]{infIndexPlot}}, \code{\link{influence.measures}} } \examples{ if (interactive()) { fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) inf_fm1 <- influence(fm1, "Subject") if (require("car")) { infIndexPlot(inf_fm1) } dfbeta(inf_fm1) dfbetas(inf_fm1) gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) inf_gm1 <- influence(gm1, "herd", maxfun=100) gm1.11 <- update(gm1, subset = herd != 11) # check deleting herd 11 if (require("car")) { infIndexPlot(inf_gm1) compareCoefs(gm1, gm1.11) } if(packageVersion("car") >= "3.0.10") { dfbeta(inf_gm1) dfbetas(inf_gm1) } } %% interactive() } %% examples \keyword{models} lme4/man/sleepstudy.Rd0000644000176200001440000000337414063503234014365 0ustar liggesusers\docType{data} \name{sleepstudy} \alias{sleepstudy} \title{Reaction times in a sleep deprivation study} \format{A data frame with 180 observations on the following 3 variables. \describe{ \item{\code{Reaction}}{Average reaction time (ms)} \item{\code{Days}}{Number of days of sleep deprivation} \item{\code{Subject}}{Subject number on which the observation was made.} }} \description{ The average reaction time per day (in milliseconds) for subjects in a sleep deprivation study. Days 0-1 were adaptation and training (T1/T2), day 2 was baseline (B); sleep deprivation started after day 2. } \details{ These data are from the study described in Belenky et al. (2003), for the most sleep-deprived group (3 hours time-in-bed) and for the first 10 days of the study, up to the recovery period. The original study analyzed speed (1/(reaction time)) and treated day as a categorical rather than a continuous predictor. } \examples{ str(sleepstudy) require(lattice) xyplot(Reaction ~ Days | Subject, sleepstudy, type = c("g","p","r"), index = function(x,y) coef(lm(y ~ x))[1], xlab = "Days of sleep deprivation", ylab = "Average reaction time (ms)", aspect = "xy") (fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, subset=Days>=2)) ## independent model (fm2 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy, subset=Days>=2)) } \references{ Gregory Belenky, Nancy J. Wesensten, David R. Thorne, Maria L. Thomas, Helen C. Sing, Daniel P. Redmond, Michael B. Russo and Thomas J. Balkin (2003) Patterns of performance degradation and restoration during sleep restriction and subsequent recovery: a sleep dose-response study. \emph{Journal of Sleep Research} \bold{12}, 1--12. } \keyword{datasets} lme4/man/sigma.Rd0000644000176200001440000000200613751775607013275 0ustar liggesusers\name{sigma} \title{Extract Residual Standard Deviation 'Sigma'} \alias{sigma} \alias{sigma.merMod} \description{ Extract the estimated standard deviation of the errors, the \dQuote{residual standard deviation} (also misnamed the \dQuote{residual standard error}), from a fitted model. } \usage{ \S3method{sigma}{merMod}(object, \dots) } \arguments{ \item{object}{a fitted model.} \item{\dots}{additional, optional arguments, passed from or to methods. (None currently in our two methods.)} } \value{ Typically a number, the estimated standard deviation of the errors (\dQuote{residual standard deviation}) for Gaussian models, and - less interpretably - the square root of the residual deviance per degree of freedom in more general models. } \details{ Package \pkg{lme4} provides methods for mixed-effects models of class \code{\linkS4class{merMod}} and lists of linear models, \code{\linkS4class{lmList4}}. } \examples{ methods(sigma)# from R 3.3.0 on, shows methods from pkgs 'stats' *and* 'lme4' } lme4/man/plots.thpr.Rd0000644000176200001440000000556714063503234014307 0ustar liggesusers\name{plots.thpr} \title{Mixed-Effects Profile Plots (Regular / Density / Pairs)} \alias{xyplot.thpr} \alias{densityplot.thpr} \alias{splom.thpr} \description{ Xyplot, Densityplot, and Pairs plot methods for a mixed-effects model profile. \code{xyplot()} draws \dQuote{zeta diagrams}, also visualizing confidence intervals and their asymmetry. \code{densityplot()} draws the profile densities. \code{splom()} draws profile pairs plots. Contours are for the marginal two-dimensional regions (i.e. using df = 2). } \usage{ \method{xyplot}{thpr}(x, data = NULL, levels = sqrt(qchisq(pmax.int(0, pmin.int(1, conf)), df = 1)), conf = c(50, 80, 90, 95, 99)/100, absVal = FALSE, scales=NULL, which = 1:nptot, \dots) \method{densityplot}{thpr}(x, data, npts = 201, upper = 0.999, \dots) \method{splom}{thpr}(x, data, levels = sqrt(qchisq(pmax.int(0, pmin.int(1, conf)), 2)), conf = c(50, 80, 90, 95, 99)/100, which = 1:nptot, draw.lower = TRUE, draw.upper = TRUE, \dots) } \arguments{ \item{x}{a mixed-effects profile, i.e., of class \code{"thpr"}, typically resulting from \code{\link{profile}(fm)} where \code{fm} is a fitted model from \code{\link{lmer}} (or its generalizations).} \item{data}{unused - only for compatibility with generic.} \item{npts}{the number of points to use for the \code{densityplot()}.} \item{upper}{a number in \eqn{(0,1)} to specify upper (and lower) boundaries as \code{+/- qnorm(upper)}.} \item{levels}{the contour levels to be shown; usually derived from \code{conf}.} \item{conf}{numeric vector of confidence levels to be shown as contours.} \item{absVal}{logical indicating if \code{\link{abs}(.)}olute values should be plotted, often preferred for confidence interval visualization.} \item{scales}{plotting options to be passed to \code{\link{xyplot}}} \item{which}{integer or character vector indicating which parameters to profile: default is all parameters (see \code{\link{profile-methods}} for details).} \item{draw.lower}{(logical) draw lower-triangle (zeta scale) panels?} \item{draw.upper}{(logical) draw upper-triangle (standard dev/cor scale) panels?} \item{\dots}{further arguments passed to \code{\link{xyplot}}, \code{\link{densityplot}}, or \code{\link{splom}} from package \CRANpkg{lattice}, respectively.} } \seealso{ \code{\link[=profile-methods]{profile}}, notably for an example. } \value{ \describe{ \item{xyplot:}{a density plot, a \code{"trellis"} object (\pkg{lattice} package) which when \code{\link{print}()}ed produces plots on the current graphic device.} \item{densityplot:}{a density plot, a \code{"trellis"} object, see above.} \item{splom:}{a pairs plot, aka \bold{s}catter\bold{plo}t \bold{m}atrix, a \code{"trellis"} object, see above.} } } \examples{ ## see example("profile.merMod") } lme4/man/getME.Rd0000644000176200001440000002267214063503234013167 0ustar liggesusers\name{getME} \title{Extract or Get Generalized Components from a Fitted Mixed Effects Model} \alias{getL} \alias{getL,merMod-method} \alias{getME} \alias{getME.merMod} \usage{ getME(object, name, ...) \S3method{getME}{merMod}(object, name = c("X", "Z", "Zt", "Ztlist", "mmList", "y", "mu", "u", "b", "Gp", "Tp", "L", "Lambda", "Lambdat", "Lind", "Tlist", "A", "RX", "RZX", "sigma", "flist", "fixef", "beta", "theta", "ST", "REML", "is_REML", "n_rtrms", "n_rfacs", "N", "n", "p", "q", "p_i", "l_i", "q_i", "k", "m_i", "m", "cnms", "devcomp", "offset", "lower", "devfun", "glmer.nb.theta"), \dots) } \arguments{ \item{object}{a fitted mixed-effects model of class \code{"\linkS4class{merMod}"}, i.e., typically the result of \code{\link{lmer}()}, \code{\link{glmer}()} or \code{\link{nlmer}()}.} \item{name}{a character vector specifying the name(s) of the \dQuote{component}. If \code{length(name) > 1} or if \code{name = "ALL"}, a named \code{\link{list}} of components will be returned. Possible values are:\cr \describe{ \item{\code{"X"}:}{fixed-effects model matrix} \item{\code{"Z"}:}{random-effects model matrix} \item{\code{"Zt"}:}{transpose of random-effects model matrix. Note that the structure of \code{Zt} has changed since \code{lme4.0}; to get a backward-compatible structure, use \code{do.call(Matrix::rBind,getME(.,"Ztlist"))}} \item{\code{"Ztlist"}:}{list of components of the transpose of the random-effects model matrix, separated by individual variance component} \item{\code{"mmList"}:}{list of raw model matrices associated with random effects terms} \item{\code{"y"}:}{response vector} \item{\code{"mu"}:}{conditional mean of the response} \item{\code{"u"}:}{conditional mode of the \dQuote{spherical} random effects variable} \item{\code{"b"}:}{conditional mode of the random effects variable} \item{\code{"Gp"}:}{groups pointer vector. A pointer to the beginning of each group of random effects corresponding to the random-effects terms, beginning with 0 and including a final element giving the total number of random effects} \item{\code{"Tp"}:}{theta pointer vector. A pointer to the beginning of the theta sub-vectors corresponding to the random-effects terms, beginning with 0 and including a final element giving the number of thetas.} \item{\code{"L"}:}{sparse Cholesky factor of the penalized random-effects model.} \item{\code{"Lambda"}:}{relative covariance factor \eqn{\Lambda}{Lambda} of the random effects.} \item{\code{"Lambdat"}:}{transpose \eqn{\Lambda'}{Lambda'} of \eqn{\Lambda}{Lambda} above.} \item{\code{"Lind"}:}{index vector for inserting elements of \eqn{\theta}{theta} into the nonzeros of \eqn{\Lambda}{Lambda}.} \item{\code{"Tlist"}:}{vector of template matrices from which the blocks of \eqn{\Lambda}{Lambda} are generated.} \item{\code{"A"}:}{Scaled sparse model matrix (class \code{"\link[Matrix:dgCMatrix-class]{dgCMatrix}"}) for the unit, orthogonal random effects, \eqn{U}, equal to \code{getME(.,"Zt") \%*\% getME(.,"Lambdat")}} \item{\code{"RX"}:}{Cholesky factor for the fixed-effects parameters} \item{\code{"RZX"}:}{cross-term in the full Cholesky factor} \item{\code{"sigma"}:}{residual standard error; note that \code{sigma(object)} is preferred.} \item{\code{"flist"}:}{a list of the grouping variables (factors) involved in the random effect terms} \item{\code{"fixef"}:}{fixed-effects parameter estimates} \item{\code{"beta"}:}{fixed-effects parameter estimates (identical to the result of \code{\link{fixef}}, but without names)} \item{\code{"theta"}:}{random-effects parameter estimates: these are parameterized as the relative Cholesky factors of each random effect term} \item{\code{"ST"}:}{A list of S and T factors in the TSST' Cholesky factorization of the relative variance matrices of the random effects associated with each random-effects term. The unit lower triangular matrix, \eqn{T}, and the diagonal matrix, \eqn{S}, for each term are stored as a single matrix with diagonal elements from \eqn{S} and off-diagonal elements from \eqn{T}.} \item{\code{"n_rtrms"}:}{number of random-effects terms} \item{\code{"n_rfacs"}:}{number of distinct random-effects grouping factors} \item{\code{"N"}:}{number of rows of \code{X}} \item{\code{"n"}:}{length of the response vector, \code{y}} \item{\code{"p"}:}{number of columns of the fixed effects model matrix, \code{X}} \item{\code{"q"}:}{number of columns of the random effects model matrix, \code{Z}} \item{\code{"p_i"}:}{numbers of columns of the raw model matrices, \code{mmList}} \item{\code{"l_i"}:}{numbers of levels of the grouping factors} \item{\code{"q_i"}:}{numbers of columns of the term-wise model matrices, \code{ZtList}} \item{\code{"k"}:}{number of random effects terms} \item{\code{"m_i"}:}{numbers of covariance parameters in each term} \item{\code{"m"}:}{total number of covariance parameters, i.e., the same as \code{dims@nth} below.} \item{\code{"cnms"}:}{the \dQuote{component names}, a \code{\link{list}}.} \item{\code{"REML"}:}{\code{0} indicates the model was fitted by maximum likelihood, any other positive integer indicates fitting by restricted maximum likelihood} \item{\code{"is_REML"}:}{same as the result of \code{\link{isREML}(.)}} \item{\code{"devcomp"}:}{a list consisting of a named numeric vector, \code{cmp}, and a named integer vector, \code{dims}, describing the fitted model. The elements of \code{cmp} are:\cr \describe{ \item{ldL2}{twice the log determinant of \code{L}} \item{ldRX2}{twice the log determinant of \code{RX}} \item{wrss}{weighted residual sum of squares} \item{ussq}{squared length of \code{u}} \item{pwrss}{penalized weighted residual sum of squares, \dQuote{wrss + ussq}} \item{drsum}{sum of residual deviance (GLMMs only)} \item{REML}{REML criterion at optimum (LMMs fit by REML only)} \item{dev}{deviance criterion at optimum (models fit by ML only)} \item{sigmaML}{ML estimate of residual standard deviation} \item{sigmaREML}{REML estimate of residual standard deviation} \item{tolPwrss}{tolerance for declaring convergence in the penalized iteratively weighted residual sum-of-squares (GLMMs only)} } The elements of \code{dims} are:\cr \describe{ \item{N}{number of rows of \code{X}} \item{n}{length of \code{y}} \item{p}{number of columns of \code{X}} \item{nmp}{\code{n-p}} \item{nth}{length of \code{theta}} \item{q}{number of columns of \code{Z}} \item{nAGQ}{see \code{\link{glmer}}} \item{compDev}{see \code{\link{glmerControl}}} \item{useSc}{\code{TRUE} if model has a scale parameter} \item{reTrms}{number of random effects terms} \item{REML}{\code{0} indicates the model was fitted by maximum likelihood, any other positive integer indicates fitting by restricted maximum likelihood} \item{GLMM}{\code{TRUE} if a GLMM} \item{NLMM}{\code{TRUE} if an NLMM} } } \item{\code{"offset"}:}{model offset} \item{\code{"lower"}:}{lower bounds on random-effects model parameters (i.e, "theta" parameters). In order to constrain random effects covariance matrices to be semi-positive-definite, this vector is equal to 0 for elements of the \code{theta} vector corresponding to diagonal elements of the Cholesky factor, \code{-Inf} otherwise. (\code{getME(.,"lower")==0} can be used as a test to identify diagonal elements, as in \code{isSingular}.) } \item{\code{"devfun"}:}{deviance function (so far only available for LMMs)} \item{\code{"glmer.nb.theta"}:}{negative binomial \eqn{\theta} parameter, only for \code{\link{glmer.nb}}.} %% -- keep at the very end: \item{\code{"ALL"}:}{get all of the above as a \code{\link{list}}.} } } \item{\dots}{currently unused in \pkg{lme4}, potentially further arguments in methods.} } \value{ Unspecified, as very much depending on the \code{\link{name}}. } \description{ Extract (or \dQuote{get}) \dQuote{components} -- in a generalized sense -- from a fitted mixed-effects model, i.e., (in this version of the package) from an object of class \code{"\linkS4class{merMod}"}. } \details{ The goal is to provide \dQuote{everything a user may want} from a fitted \code{"merMod"} object \emph{as far} as it is not available by methods, such as \code{\link{fixef}}, \code{\link{ranef}}, \code{\link{vcov}}, etc. } \seealso{ \code{\link{getCall}()}. More standard methods for \code{"merMod"} objects, such as \code{\link{ranef}}, \code{\link{fixef}}, \code{\link{vcov}}, etc.: see \code{methods(class="merMod")} } \examples{ ## shows many methods you should consider *before* using getME(): methods(class = "merMod") (fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)) Z <- getME(fm1, "Z") stopifnot(is(Z, "CsparseMatrix"), c(180,36) == dim(Z), all.equal(fixef(fm1), b1 <- getME(fm1, "beta"), check.attributes=FALSE, tolerance = 0)) ## A way to get *all* getME()s : ## internal consistency check ensuring that all work: parts <- getME(fm1, "ALL") str(parts, max=2) stopifnot(identical(Z, parts $ Z), identical(b1, parts $ beta)) } \keyword{utilities} lme4/man/simulate.merMod.Rd0000644000176200001440000001631114063503234015224 0ustar liggesusers\name{simulate.merMod} \title{Simulate Responses From \code{\linkS4class{merMod}} Object} \alias{simulate.merMod} \alias{.simulateFun} \description{ Simulate responses from a \code{"merMod"} fitted model object, i.e., from the model represented by it. } \usage{ \method{simulate}{merMod}(object, nsim = 1, seed = NULL, use.u = FALSE, re.form = NA, ReForm, REForm, REform, newdata=NULL, newparams=NULL, family=NULL, allow.new.levels = FALSE, na.action = na.pass, \dots) .simulateFun(object, nsim = 1, seed = NULL, use.u = FALSE, re.form = NA, ReForm, REForm, REform, newdata=NULL, newparams=NULL, formula=NULL, family=NULL, weights=NULL, offset=NULL, allow.new.levels = FALSE, na.action = na.pass, cond.sim = TRUE, \dots) } \arguments{ \item{object}{(for \code{simulate.merMod}) a fitted model object or (for \code{simulate.formula}) a (one-sided) mixed model formula, as described for \code{\link{lmer}}.} \item{nsim}{positive integer scalar - the number of responses to simulate.} \item{seed}{an optional seed to be used in \code{\link{set.seed}} immediately before the simulation so as to generate a reproducible sample.} \item{use.u}{(logical) if \code{TRUE}, generate a simulation conditional on the current random-effects estimates; if \code{FALSE} generate new Normally distributed random-effects values. (Redundant with \code{re.form}, which is preferred: \code{TRUE} corresponds to \code{re.form = NULL} (condition on all random effects), while \code{FALSE} corresponds to \code{re.form = ~0} (condition on none of the random effects).)} \item{re.form}{formula for random effects to condition on. If \code{NULL}, condition on all random effects; if \code{NA} or \code{~0}, condition on no random effects. See Details.} \item{ReForm, REForm, REform}{deprecated: \code{re.form} is now the preferred argument name.} \item{newdata}{data frame for which to evaluate predictions.} \item{newparams}{new parameters to use in evaluating predictions, specified as in the \code{start} parameter for \code{\link{lmer}} or \code{\link{glmer}} -- a list with components \code{theta} and \code{beta} and (for LMMs or GLMMs that estimate a scale parameter) \code{sigma}} \item{formula}{a (one-sided) mixed model formula, as described for \code{\link{lmer}}.} \item{family}{a GLM family, as in \code{\link{glmer}}.} \item{weights}{prior weights, as in \code{\link{lmer}} or \code{\link{glmer}}.} \item{offset}{offset, as in \code{\link{glmer}}.} \item{allow.new.levels}{(logical) if FALSE (default), then any new levels (or \code{NA} values) detected in \code{newdata} will trigger an error; if TRUE, then the prediction will use the unconditional (population-level) values for data with previously unobserved levels (or \code{NA}s).} \item{na.action}{what to do with \code{NA} values in new data: see \code{\link{na.fail}}} \item{cond.sim}{(experimental) simulate the conditional distribution? if \code{FALSE}, simulate only random effects; do not simulate from the conditional distribution, rather return the predicted group-level values} \item{\dots}{optional additional arguments (none are used in \code{.simulateFormula})} } \seealso{ \code{\link{bootMer}} for \dQuote{simulestimate}, i.e., where each simulation is followed by refitting the model. } \details{ \itemize{ \item{ordinarily \code{simulate} is used to generate new values from an existing, fitted model (\code{merMod} object): however, if \code{formula}, \code{newdata}, and \code{newparams} are specified, \code{simulate} generates the appropriate model structure to simulate from. \code{formula} must be a \emph{one-sided} formula (i.e. with an empty left-hand side); in general, if \code{f} is a two-sided formula, \code{f[-2]} can be used to drop the LHS.} \item{The \code{re.form} argument allows the user to specify how the random effects are incorporated in the simulation. All of the random effects terms included in \code{re.form} will be \emph{conditioned on} - that is, the conditional modes of those random effects will be included in the deterministic part of the simulation. (If new levels are used (and \code{allow.new.levels} is \code{TRUE}), the conditional modes for these levels will be set to the population mode, i.e. values of zero will be used for the random effects.) Conversely, the random effect terms that are \emph{not} included in \code{re.form} will be \emph{simulated from} - that is, new values will be chosen for each group based on the estimated random-effects variances. The default behaviour (using \code{re.form=NA}) is to condition on none of the random effects, simulating new values for all of the random effects. } \item{For Gaussian fits, \code{sigma} specifies the residual standard deviation; for Gamma fits, it specifies the shape parameter (the rate parameter for each observation i is calculated as shape/mean(i)). For negative binomial fits, the overdispersion parameter is specified via the family, e.g. \code{simulate(..., family=negative.binomial(theta=1.5))}. } \item{For binomial models, \code{simulate.formula} looks for the binomial size first in the \code{weights} argument (if it's supplied), second from the left-hand side of the formula (if the formula has been specified in success/failure form), and defaults to 1 if neither of those have been supplied. Simulated responses will be given as proportions, unless the supplied formula has a matrix-valued left-hand side, in which case they will be given in matrix form. If a left-hand side is given, variables in that expression must be available in \code{newdata}. } \item{For negative binomial models, use the \code{negative.binomial} family (from the \CRANpkg{MASS} package) and specify the overdispersion parameter via the \code{theta} (sic) parameter of the family function, e.g. \code{simulate(...,family=negative.binomial(theta=1))} to simulate from a geometric distribution (negative binomial with overdispersion parameter 1). } } } \examples{ ## test whether fitted models are consistent with the ## observed number of zeros in CBPP data set: gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) gg <- simulate(gm1,1000) zeros <- sapply(gg,function(x) sum(x[,"incidence"]==0)) plot(table(zeros)) abline(v=sum(cbpp$incidence==0),col=2) ## ## simulate from a non-fitted model; in this case we are just ## replicating the previous model, but starting from scratch params <- list(theta=0.5,beta=c(2,-1,-2,-3)) simdat <- with(cbpp,expand.grid(herd=levels(herd),period=factor(1:4))) simdat$size <- 15 simdat$incidence <- sample(0:1,size=nrow(simdat),replace=TRUE) form <- formula(gm1)[-2] ## RHS of equation only simulate(form,newdata=simdat,family=binomial, newparams=params) ## simulate from negative binomial distribution instead simulate(form,newdata=simdat,family=negative.binomial(theta=2.5), newparams=params) } lme4/man/lmList.Rd0000644000176200001440000001021613751775607013443 0ustar liggesusers\name{lmList} \alias{lmList} \alias{plot.lmList} \title{Fit List of lm or glm Objects with a Common Model} \description{ Fit a list of \code{\link{lm}} or \code{\link{glm}} objects with a common model for different subgroups of the data. } \usage{ lmList(formula, data, family, subset, weights, na.action, offset, pool = !isGLM || .hasScale(family2char(family)), warn = TRUE, \dots) } \arguments{ \item{formula}{a linear \code{\link{formula}} object of the form \code{y ~ x1+...+xn | g}. In the formula object, \code{y} represents the response, \code{x1,...,xn} the covariates, and \code{g} the grouping factor specifying the partitioning of the data according to which different \code{lm} fits should be performed.} \item{family}{an optional \code{\link{family}} specification for a generalized linear model (\code{\link{glm}}).} \item{data}{an optional data frame containing the variables named in \code{formula}. By default the variables are taken from the environment from which \code{lmer} is called. See Details.} \item{subset}{an optional expression indicating the subset of the rows of \code{data} that should be used in the fit. This can be a logical vector, or a numeric vector indicating which observation numbers are to be included, or a character vector of the row names to be included. All observations are included by default.} \item{weights}{an optional vector of \sQuote{prior weights} to be used in the fitting process. Should be \code{NULL} or a numeric vector.} \item{na.action}{a function that indicates what should happen when the data contain \code{NA}s. The default action (\code{na.omit}, inherited from the \sQuote{factory fresh} value of \code{getOption("na.action")}) strips any observations with any missing values in any variables.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. This should be \code{NULL} or a numeric vector of length equal to the number of cases. One or more \code{\link{offset}} terms can be included in the formula instead or as well, and if more than one is specified their sum is used. See \code{\link{model.offset}}.} \item{pool}{logical scalar indicating if the variance estimate should pool the residual sums of squares. By default true if the model has a scale parameter (which includes all linear, \code{\link{lmer}()}, ones).} \item{warn}{indicating if errors in the single fits should signal a \dQuote{summary} \code{\link{warning}}.} \item{\dots}{additional, optional arguments to be passed to the model function or family evaluation.} } \value{an object of \code{\link{class}} \code{\linkS4class{lmList4}} (see there, notably for the \code{\link{methods}} defined). } \details{ \itemize{ \item While \code{data} is optional, the package authors \emph{strongly} recommend its use, especially when later applying methods such as \code{update} and \code{drop1} to the fitted model (\emph{such methods are not guaranteed to work properly if \code{data} is omitted}). If \code{data} is omitted, variables will be taken from the environment of \code{formula} (if specified as a formula) or from the parent frame (if specified as a character vector). \item Since \pkg{lme4} version 1.1-16, if there are errors (see \code{\link{stop}}) in the single (\code{lm()} or \code{glm()}) fits, they are summarized to a warning message which is returned as attribute \code{"warnMessage"} and signalled as \code{\link{warning}()} when the \code{warn} argument is true. In previous \pkg{lme4} versions, a general (different) warning had been signalled in this case. } } \examples{ fm.plm <- lmList(Reaction ~ Days | Subject, sleepstudy) coef(fm.plm) fm.2 <- update(fm.plm, pool = FALSE) ## coefficients are the same, "pooled or unpooled": stopifnot( all.equal(coef(fm.2), coef(fm.plm)) ) (ci <- confint(fm.plm)) # print and rather *see* : plot(ci) # how widely they vary for the individuals } \seealso{\code{\linkS4class{lmList4}}} \keyword{models}lme4/man/predict.merMod.Rd0000644000176200001440000000764614062244632015051 0ustar liggesusers\name{predict.merMod} \alias{predict.merMod} \title{Predictions from a model at new data values} \description{ The \code{\link{predict}} method for \code{\linkS4class{merMod}} objects, i.e. results of \code{\link{lmer}()}, \code{\link{glmer}()}, etc. } \usage{ \method{predict}{merMod}(object, newdata = NULL, newparams = NULL, re.form = NULL, ReForm, REForm, REform, random.only=FALSE, terms = NULL, type = c("link", "response"), allow.new.levels = FALSE, na.action = na.pass, \dots) } \arguments{ \item{object}{a fitted model object} \item{newdata}{data frame for which to evaluate predictions.} \item{newparams}{new parameters to use in evaluating predictions, specified as in the \code{start} parameter for \code{\link{lmer}} or \code{\link{glmer}} -- a list with components \code{theta} and/or (for GLMMs) \code{beta}.} \item{re.form}{(formula, \code{NULL}, or \code{NA}) specify which random effects to condition on when predicting. If \code{NULL}, include all random effects; if \code{NA} or \code{~0}, include no random effects.} \item{ReForm, REForm, REform}{allowed for backward compatibility: \code{re.form} is now the preferred argument name.} \item{random.only}{(logical) ignore fixed effects, making predictions only using random effects?} \item{terms}{a \code{\link{terms}} object - unused at present.} \item{type}{character string - either \code{"link"}, the default, or \code{"response"} indicating the type of prediction object returned.} \item{allow.new.levels}{logical if new levels (or NA values) in \code{newdata} are allowed. If FALSE (default), such new values in \code{newdata} will trigger an error; if TRUE, then the prediction will use the unconditional (population-level) values for data with previously unobserved levels (or NAs).} \item{na.action}{\code{\link{function}} determining what should be done with missing values for fixed effects in \code{newdata}. The default is to predict \code{NA}: see \code{\link{na.pass}}.} \item{...}{optional additional parameters. None are used at present.} } \value{ a numeric vector of predicted values } \details{ \itemize{ \item If any random effects are included in \code{re.form} (i.e. it is not \code{~0} or \code{NA}), \code{newdata} \emph{must} contain columns corresponding to all of the grouping variables and random effects used in the original model, even if not all are used in prediction; however, they can be safely set to \code{NA} in this case. \item There is no option for computing standard errors of predictions because it is difficult to define an efficient method that incorporates uncertainty in the variance parameters; we recommend \code{\link{bootMer}} for this task. } } \examples{ (gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 |herd), cbpp, binomial)) str(p0 <- predict(gm1)) # fitted values str(p1 <- predict(gm1,re.form=NA)) # fitted values, unconditional (level-0) newdata <- with(cbpp, expand.grid(period=unique(period), herd=unique(herd))) str(p2 <- predict(gm1,newdata)) # new data, all RE str(p3 <- predict(gm1,newdata,re.form=NA)) # new data, level-0 str(p4 <- predict(gm1,newdata,re.form= ~(1|herd))) # explicitly specify RE stopifnot(identical(p2, p4)) \dontshow{%back compatibility - as long as we have it: ReForm, REForm, REform, suppressWarnings(stopifnot(identical(p1, predict(gm1,ReForm=NA)))) suppressWarnings(stopifnot(identical(p3, predict(gm1,newdata,REForm=NA)))) suppressWarnings(stopifnot(identical(p4, predict(gm1,newdata,REform=~(1|herd))))) ## predict() should work with variable names with spaces [as lm() does]: dd <- expand.grid(y=1:3, "Animal ID" = 1:9) fm <- lmer(y ~ 1 + (1 | `Animal ID`), dd) summary(fm) isel <- c(7, 9, 11, 13:17, 20:22) stopifnot(all.equal(vcov(fm)[1,1], 0.02564102564), all.equal(unname(predict(fm, newdata = dd[isel,])), unname( fitted(fm) [isel]))) }%dont } lme4/man/convergence.Rd0000644000176200001440000001740514063503234014462 0ustar liggesusers\name{convergence} \alias{convergence} \title{Assessing Convergence for Fitted Models} \description{ \code{[g]lmer} fits may produce convergence warnings; these do \strong{not} necessarily mean the fit is incorrect (see \dQuote{Theoretical details} below). The following steps are recommended assessing and resolving convergence warnings (also see examples below): \itemize{ \item double-check the model specification and the data \item adjust stopping (convergence) tolerances for the nonlinear optimizer, using the \code{optCtrl} argument to \code{[g]lmerControl} (see \dQuote{Convergence controls} below) \item center and scale continuous predictor variables (e.g. with \code{\link{scale}}) \item double-check the Hessian calculation with the more expensive Richardson extrapolation method (see examples) \item restart the fit from the reported optimum, or from a point perturbed slightly away from the reported optimum \item use \code{\link{allFit}} to try the fit with all available optimizers (e.g. several different implementations of BOBYQA and Nelder-Mead, L-BFGS-B from \code{optim}, \code{nlminb}, \dots). While this will of course be slow for large fits, we consider it the gold standard; if all optimizers converge to values that are practically equivalent, then we would consider the convergence warnings to be false positives. } % end itemize } % end description \details{ \subsection{Convergence controls}{ \itemize{ \item the controls for the \code{nloptwrap} optimizer (the default for \code{lmer}) are \describe{ \item{ftol_abs}{(default 1e-6) stop on small change in deviance} \item{ftol_rel}{(default 0) stop on small relative change in deviance} \item{xtol_abs}{(default 1e-6) stop on small change of parameter values} \item{xtol_rel}{(default 0) stop on small relative change of parameter values} \item{maxeval}{(default 1000) maximum number of function evaluations} } Changing \code{ftol_abs} and \code{xtol_abs} to stricter values (e.g. 1e-8) is a good first step for resolving convergence problems, at the cost of slowing down model fits. \item the controls for \code{minqa::bobyqa} (default for \code{glmer} first-stage optimization) are \describe{ \item{rhobeg}{(default 2e-3) initial radius of the trust region} \item{rhoend}{(default 2e-7) final radius of the trust region} \item{maxfun}{(default 10000) maximum number of function evaluations} } \code{rhoend}, which describes the scale of parameter uncertainty on convergence, is approximately analogous to \code{xtol_abs}. \item the controls for \code{Nelder_Mead} (default for \code{glmer} second-stage optimization) are \describe{ \item{FtolAbs}{(default 1e-5) stop on small change in deviance} \item{FtolRel}{(default 1e-15) stop on small relative change in deviance} \item{XtolRel}{(default 1e-7) stop on small change of parameter values} \item{maxfun}{(default 10000) maximum number of function evaluations} } % Nelder_Mead controls } % list of optimizers } % convergence controls \subsection{Theoretical issues}{\pkg{lme4} uses general-purpose nonlinear optimizers (e.g. Nelder-Mead or Powell's BOBYQA method) to estimate the variance-covariance matrices of the random effects. Assessing the convergence of such algorithms reliably is difficult. For example, evaluating the \href{https://en.wikipedia.org/wiki/Karush\%E2\%80\%93Kuhn\%E2\%80\%93Tucker_conditions}{Karush-Kuhn-Tucker conditions} (convergence criteria which reduce in simple cases to showing that the gradient is zero and the Hessian is positive definite) is challenging because of the difficulty of evaluating the gradient and Hessian. We (the \code{lme4} authors and maintainers) are still in the process of finding the best strategies for testing convergence. Some of the relevant issues are \itemize{ \item the gradient and Hessian are the basic ingredients of KKT-style testing, but (at least for now) \code{lme4} estimates them by finite-difference approximations which are sometimes unreliable. \item The Hessian computation in particular represents a difficult tradeoff between computational expense and accuracy. At present the Hessian computations used for convergence checking (and for estimating standard errors of fixed-effect parameters for GLMMs) follow the \CRANpkg{ordinal} package in using a naive but computationally cheap centered finite difference computation (with a fixed step size of \eqn{10^{-4}}{1e-4}). A more reliable but more expensive approach is to use \href{https://en.wikipedia.org/wiki/Richardson_extrapolation}{Richardson extrapolation}, as implemented in the \CRANpkg{numDeriv} package. \item it is important to scale the estimated gradient at the estimate appropriately; two reasonable approaches are \enumerate{ \item scale gradients by the inverse Cholesky factor of the Hessian, equivalent to scaling gradients by the estimated Wald standard error of the estimated parameters. \code{lme4} uses this approach; it requires the Hessian to be estimated (although the Hessian is required \href{https://github.com/lme4/lme4/issues/47}{for reliable estimation of the fixed-effect standard errors for GLMMs} in any case). \item use unscaled gradients on the random-effects parameters, since these are essentially already unitless (for LMMs they are scaled relative to the residual variance; for GLMMs they are scaled relative to the sampling variance of the conditional distribution); for GLMMs, scale fixed-effect gradients by the standard deviations of the corresponding input variable } \item Exploratory analyses suggest that (1) the naive estimation of the Hessian may fail for large data sets (number of observations greater than approximately \eqn{10^{5}}{1e5}); (2) the magnitude of the scaled gradient increases with sample size, so that warnings will occur even for apparently well-behaved fits with large data sets. } % itemize } % theoretical issues } % details \examples{ if (interactive()) { fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) ## 1. decrease stopping tolerances strict_tol <- lmerControl(optCtrl=list(xtol_abs=1e-8, ftol_abs=1e-8)) if (all(fm1@optinfo$optimizer=="nloptwrap")) { fm1.tol <- update(fm1, control=strict_tol) } ## 2. center and scale predictors: ss.CS <- transform(sleepstudy, Days=scale(Days)) fm1.CS <- update(fm1, data=ss.CS) ## 3. recompute gradient and Hessian with Richardson extrapolation devfun <- update(fm1, devFunOnly=TRUE) if (isLMM(fm1)) { pars <- getME(fm1,"theta") } else { ## GLMM: requires both random and fixed parameters pars <- getME(fm1, c("theta","fixef")) } if (require("numDeriv")) { cat("hess:\n"); print(hess <- hessian(devfun, unlist(pars))) cat("grad:\n"); print(grad <- grad(devfun, unlist(pars))) cat("scaled gradient:\n") print(scgrad <- solve(chol(hess), grad)) } ## compare with internal calculations: fm1@optinfo$derivs ## 4. restart the fit from the original value (or ## a slightly perturbed value): fm1.restart <- update(fm1, start=pars) set.seed(101) pars_x <- runif(length(pars),pars/1.01,pars*1.01) fm1.restart2 <- update(fm1, start=pars_x, control=strict_tol) ## 5. try all available optimizers fm1.all <- allFit(fm1) ss <- summary(fm1.all) ss$ fixef ## fixed effects ss$ llik ## log-likelihoods ss$ sdcor ## SDs and correlations ss$ theta ## Cholesky factors ss$ which.OK ## which fits worked } %% interactive() } % examples \seealso{\code{\link{lmerControl}}, \code{\link{isSingular}}} lme4/man/isSingular.Rd0000644000176200001440000001220013751775607014312 0ustar liggesusers\name{isSingular} \title{Test Fitted Model for (Near) Singularity} \alias{isSingular} \concept{boundary} \description{ Evaluates whether a fitted mixed model is (almost / near) singular, i.e., the parameters are on the boundary of the feasible parameter space: variances of one or more linear combinations of effects are (close to) zero. } \usage{ isSingular(x, tol = 1e-4) } \arguments{ \item{x}{a fitted \code{merMod} object (result of \code{lmer} or \code{glmer}).} \item{tol}{numerical tolerance for detecting singularity.} } \details{ Complex mixed-effect models (i.e., those with a large number of variance-covariance parameters) frequently result in \emph{singular} fits, i.e. estimated variance-covariance matrices with less than full rank. Less technically, this means that some "dimensions" of the variance-covariance matrix have been estimated as exactly zero. For scalar random effects such as intercept-only models, or 2-dimensional random effects such as intercept+slope models, singularity is relatively easy to detect because it leads to random-effect variance estimates of (nearly) zero, or estimates of correlations that are (almost) exactly -1 or 1. However, for more complex models (variance-covariance matrices of dimension >=3) singularity can be hard to detect; models can often be singular without any of their individual variances being close to zero or correlations being close to +/-1. This function performs a simple test to determine whether any of the random effects covariance matrices of a fitted model are singular. The \code{\link{rePCA}} method provides more detail about the singularity pattern, showing the standard deviations of orthogonal variance components and the mapping from variance terms in the model to orthogonal components (i.e., eigenvector/rotation matrices). While singular models are statistically well defined (it is theoretically sensible for the true maximum likelihood estimate to correspond to a singular fit), there are real concerns that (1) singular fits correspond to overfitted models that may have poor power; (2) chances of numerical problems and mis-convergence are higher for singular models (e.g. it may be computationally difficult to compute profile confidence intervals for such models); (3) standard inferential procedures such as Wald statistics and likelihood ratio tests may be inappropriate. There is not yet consensus about how to deal with singularity, or more generally to choose which random-effects specification (from a range of choices of varying complexity) to use. Some proposals include: \itemize{ \item avoid fitting overly complex models in the first place, i.e. design experiments/restrict models \emph{a priori} such that the variance-covariance matrices can be estimated precisely enough to avoid singularity (Matuschek et al 2017) \item use some form of model selection to choose a model that balances predictive accuracy and overfitting/type I error (Bates et al 2015, Matuschek et al 2017) \item \dQuote{keep it maximal}, i.e. fit the most complex model consistent with the experimental design, removing only terms required to allow a non-singular fit (Barr et al. 2013), or removing further terms based on p-values or AIC \item use a partially Bayesian method that produces maximum \emph{a posteriori} (MAP) estimates using \emph{regularizing} priors to force the estimated random-effects variance-covariance matrices away from singularity (Chung et al 2013, \CRANpkg{blme} package) \item use a fully Bayesian method that both regularizes the model via informative priors and gives estimates and credible intervals for all parameters that average over the uncertainty in the random effects parameters (Gelman and Hill 2006, McElreath 2015; \CRANpkg{MCMCglmm}, \CRANpkg{rstanarm} and \CRANpkg{brms} packages) } } \value{ a logical value } \seealso{\code{\link{getME}}, \code{\link{rePCA}}} \references{ Dale J. Barr, Roger Levy, Christoph Scheepers, and Harry J. Tily (2013). Random effects structure for confirmatory hypothesis testing: Keep it maximal; \emph{Journal of Memory and Language} \bold{68}(3), 255--278. Douglas Bates, Reinhold Kliegl, Shravan Vasishth, and Harald Baayen (2015). \emph{Parsimonious Mixed Models}; preprint (\url{https://arxiv.org/abs/1506.04967}). Yeojin Chung, Sophia Rabe-Hesketh, Vincent Dorie, Andrew Gelman, and Jingchen Liu (2013). A nondegenerate penalized likelihood estimator for variance parameters in multilevel models; \emph{Psychometrika} \bold{78}, 685--709; \doi{10.1007/S11336-013-9328-2}. Andrew Gelman and Jennifer Hill (2006). \emph{Data Analysis Using Regression and Multilevel/Hierarchical Models}. Cambridge University Press. Hannes Matuschek, Reinhold Kliegl, Shravan Vasishth, Harald Baayen, and Douglas Bates (2017). Balancing type I error and power in linear mixed models. \emph{Journal of Memory and Language} \bold{94}, 305–315. Richard McElreath (2015) \emph{Statistical Rethinking: A Bayesian Course with Examples in R and Stan}. Chapman and Hall/CRC. } \keyword{utilities} lme4/man/utilities.Rd0000644000176200001440000001436213751775607014220 0ustar liggesusers\name{prt-utilities} \title{Print and Summary Method Utilities for Mixed Effects} \alias{.prt.methTit} \alias{.prt.VC} \alias{.prt.aictab} \alias{.prt.call} \alias{.prt.family} \alias{.prt.grps} \alias{.prt.methTit} \alias{.prt.resids} \alias{.prt.warn} \alias{formatVC} \alias{llikAIC} \alias{methTitle} \description{ The \code{\link{print}}, \code{\link{summary}} methods (including the \code{print} for the \code{summary()} result) in \pkg{lme4} are modular, using about ten small utility functions. Other packages, building on \pkg{lme4} can use the same utilities for ease of programming and consistency of output. Notably see the Examples. \code{llikAIC()} extracts the log likelihood, AIC, and related statics from a Fitted LMM. \code{formatVC()} \dQuote{format()}s the \code{\link{VarCorr}} matrix of the random effects -- for \code{\link{print}()}ing and \code{\link{show}()}ing; it is also the \dQuote{workhorse} of \code{.prt.VC()}, and returns a \code{\link{character}} matrix. \code{.prt.*()} all use \code{\link{cat}} and \code{\link{print}} to produce output. } \usage{ llikAIC(object, devianceFUN = devCrit, chkREML = TRUE, devcomp = object@devcomp) methTitle(dims) .prt.methTit(mtit, class) .prt.family (famL) .prt.resids (resids, digits, title = "Scaled residuals:", \dots) .prt.call (call, long = TRUE) .prt.aictab (aictab, digits = 1) .prt.grps (ngrps, nobs) .prt.warn (optinfo, summary = FALSE, \dots) .prt.VC (varcor, digits, comp, formatter = format, \dots) formatVC(varcor, digits = max(3, getOption("digits") - 2), comp = "Std.Dev.", formatter = format, useScale = attr(varcor, "useSc"), \dots) } \arguments{ %% llikAIC() : \item{object}{a LMM model fit} \item{devianceFUN}{the function to be used for computing the deviance; should not be changed for \pkg{lme4} created objects.} \item{chkREML}{optional logical indicating if \code{object} maybe a REML fit.}% use TRUE for \pkg{lme4} fits \item{devcomp}{for \pkg{lme4} always the equivalent of \code{object@devcomp}; here a \code{\link{list}}}%... FIXME %% methTitle(): \item{dims}{for \pkg{lme4} always the equivalent of \code{object@devcomp$dims}, a named vector or list with components \code{"GLMM"}, \code{"NLMM"}, \code{"REML"}, and \code{"nAGQ"} of which the first two are \code{\link{logical}} scalars, and the latter two typically are \code{FALSE} or \code{\link{numeric}}.} %% .prt.methTit \item{mtit}{the result of \code{methTitle(object)}} \item{class}{typically \code{\link{class}(object)}.} %% .prt.family (famL) \item{famL}{a \code{\link{list}} with components \code{family} and \code{link}, each a \code{\link{character}} string; note that standard \R \code{\link{family}} objects can be used directly, as well.} %% .prt.resids (resids, digits, title = "Scaled residuals:", \dots) \item{resids}{numeric vector of model \code{\link{residuals}}.} \item{digits}{non-negative integer of (significant) digits to print minimally.} \item{title}{\code{\link{character}} string.} \item{\dots}{optional arguments passed on, e.g., to \code{\link{residuals}()}.} %% .prt.call (call, long = TRUE) \item{call}{the \code{\link{call}} of the model fit; e.g., available via (generic) function \code{\link{getCall}()}.} \item{long}{logical indicating if the output may be long, e.g., printing the \code{control} part of the call if there is one.} %% .prt.aictab (aictab, digits = 1) \item{aictab}{typically the \code{AICtab} component of the result of \code{llikAIC()}.} %% .prt.VC (varcor, digits, comp, formatter = format, \dots) \item{varcor}{typically the result of \code{\link{VarCorr}()}.} \item{comp}{optional ...}% ... FIXME \item{formatter}{a \code{\link{function}} used for formatting the numbers.} %% .prt.grps (ngrps, nobs) \item{ngrps}{integer (vector), typically the result of \code{\link{ngrps}(object)}.} \item{nobs}{integer; the number of observations, e.g., the result of \code{\link{nobs}}.} %% .prt.warn (optinfo, summary = FALSE, \dots) \item{optinfo}{typically \code{object @ optinfo}, the optimization infos, including warnings if there were.} \item{summary}{logical} %% formatVC \item{useScale}{(logical) whether the parent model estimates a scale parameter} } \value{ \code{llikAIC()} returns a \code{\link{list}} with components \item{logLik}{which is \code{\link{logLik}(object)}, and} \item{AICtab}{ a \dQuote{table} of \code{\link{AIC}}, \code{\link{BIC}}, \code{\link{logLik}}, deviance and \code{\link{df.residual}()} values.} } \examples{ ## Create a few "lme4 standard" models ------------------------------ fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) fmM <- update(fm1, REML=FALSE) # -> Maximum Likelihood gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) gmA <- update(gm1, nAGQ = 5) (lA1 <- llikAIC(fm1)) (lAM <- llikAIC(fmM)) (lAg <- llikAIC(gmA)) (m1 <- methTitle(fm1 @ devcomp $ dims)) (mM <- methTitle(fmM @ devcomp $ dims)) (mG <- methTitle(gm1 @ devcomp $ dims)) (mA <- methTitle(gmA @ devcomp $ dims)) .prt.methTit(m1, class(fm1)) .prt.methTit(mA, class(gmA)) .prt.family(gaussian()) .prt.family(binomial()) .prt.family( poisson()) .prt.resids(residuals(fm1), digits = 4) .prt.resids(residuals(fmM), digits = 2) .prt.call(getCall(fm1)) .prt.call(getCall(gm1)) .prt.aictab ( lA1 $ AICtab ) # REML .prt.aictab ( lAM $ AICtab ) # ML --> AIC, BIC, ... V1 <- VarCorr(fm1) m <- formatVC(V1) stopifnot(is.matrix(m), is.character(m), ncol(m) == 4) print(m, quote = FALSE) ## prints all but the first line of .prt.VC() below: .prt.VC( V1, digits = 4, formatter = format) ## Random effects: ## Groups Name Std.Dev. Corr ## Subject (Intercept) 24.740 ## Days 5.922 0.07 ## Residual 25.592 p1 <- capture.output(V1) p2 <- capture.output( print(m, quote=FALSE) ) pX <- capture.output( .prt.VC(V1, digits = max(3, getOption("digits")-2)) ) stopifnot(identical(p1, p2), identical(p1, pX[-1])) # [-1] : dropping 1st line .prt.grps(ngrps = ngrps(fm1), nobs = nobs (fm1)) ## --> Number of obs: 180, groups: Subject, 18 .prt.warn(fm1 @ optinfo) # nothing .. had no warnings } \keyword{utilities} lme4/man/Dyestuff.Rd0000644000176200001440000000710713751775607013775 0ustar liggesusers\docType{data} \name{Dyestuff} \alias{Dyestuff} \alias{Dyestuff2} \title{Yield of dyestuff by batch} \format{Data frames, each with 30 observations on the following 2 variables. \describe{ \item{\code{Batch}}{a factor indicating the batch of the intermediate product from which the preparation was created.} \item{\code{Yield}}{the yield of dyestuff from the preparation (grams of standard color).} }} \source{ O.L. Davies and P.L. Goldsmith (eds), \emph{Statistical Methods in Research and Production, 4th ed.}, Oliver and Boyd, (1972), section 6.4 G.E.P. Box and G.C. Tiao, \emph{Bayesian Inference in Statistical Analysis}, Addison-Wesley, (1973), section 5.1.2 } \description{ The \code{Dyestuff} data frame provides the yield of dyestuff (Naphthalene Black 12B) from 5 different preparations from each of 6 different batchs of an intermediate product (H-acid). The \code{Dyestuff2} data were generated data in the same structure but with a large residual variance relative to the batch variance. } \details{ The \code{Dyestuff} data are described in Davies and Goldsmith (1972) as coming from \dQuote{an investigation to find out how much the variation from batch to batch in the quality of an intermediate product (H-acid) contributes to the variation in the yield of the dyestuff (Naphthalene Black 12B) made from it. In the experiment six samples of the intermediate, representing different batches of works manufacture, were obtained, and five preparations of the dyestuff were made in the laboratory from each sample. The equivalent yield of each preparation as grams of standard colour was determined by dye-trial.} The \code{Dyestuff2} data are described in Box and Tiao (1973) as illustrating \dQuote{ the case where between-batches mean square is less than the within-batches mean square. These data had to be constructed for although examples of this sort undoubtably occur in practice, they seem to be rarely published.} } \examples{ \dontshow{ # useful for the lme4-authors --- development, debugging, etc: commandArgs()[-1] if(FALSE) ## R environment variables: local({ ne <- names(e <- Sys.getenv()) list(R = e[grep("^R", ne)], "_R" = e[grep("^_R",ne)]) }) Sys.getenv("R_ENVIRON") Sys.getenv("R_PROFILE") cat("R_LIBS:\\n"); (RL <- strsplit(Sys.getenv("R_LIBS"), ":")[[1]]) nRL <- normalizePath(RL) cat("and extra(:= not in R_LIBS) .libPaths():\\n") .libPaths()[is.na(match(.libPaths(), nRL))] structure(Sys.info()[c(4,5,1:3)], class="simple.list") #-> 'nodename' .. sessionInfo() searchpaths() pkgI <- function(pkgname) { pd <- tryCatch(packageDescription(pkgname), error=function(e)e, warning=function(w)w) if(inherits(pd, "error") || inherits(pd, "warning")) cat(sprintf("packageDescription(\\"\%s\\") \%s: \%s\\n", pkgname, class(pd)[2], pd$message)) else cat(sprintf("\%s -- built: \%s\\n\%*s -- dir : \%s\\n", pkgname, pd$Built, nchar(pkgname), "", dirname(dirname(attr(pd, "file"))))) } pkgI("Matrix") pkgI("Rcpp") ## 2012-03-12{MM}: fails with --as-cran pkgI("RcppEigen") pkgI("minqa") pkgI("lme4") } require(lattice) str(Dyestuff) dotplot(reorder(Batch, Yield) ~ Yield, Dyestuff, ylab = "Batch", jitter.y = TRUE, aspect = 0.3, type = c("p", "a")) dotplot(reorder(Batch, Yield) ~ Yield, Dyestuff2, ylab = "Batch", jitter.y = TRUE, aspect = 0.3, type = c("p", "a")) (fm1 <- lmer(Yield ~ 1|Batch, Dyestuff)) (fm2 <- lmer(Yield ~ 1|Batch, Dyestuff2)) } \keyword{datasets} lme4/man/Penicillin.Rd0000644000176200001440000000437713751775607014300 0ustar liggesusers\docType{data} \name{Penicillin} \alias{Penicillin} \title{Variation in penicillin testing} \format{A data frame with 144 observations on the following 3 variables. \describe{ \item{\code{diameter}}{diameter (mm) of the zone of inhibition of the growth of the organism.} \item{\code{plate}}{assay plate. A factor with levels \sQuote{a} to \sQuote{x}.} \item{\code{sample}}{penicillin sample. A factor with levels \sQuote{A} to \sQuote{F}.} }} \source{ O.L. Davies and P.L. Goldsmith (eds), \emph{Statistical Methods in Research and Production, 4th ed.}, Oliver and Boyd, (1972), section 6.6 } \description{ Six samples of penicillin were tested using the \emph{B. subtilis} plate method on each of 24 plates. The response is the diameter (mm) of the zone of inhibition of growth of the organism. } \details{ The data are described in Davies and Goldsmith (1972) as coming from an investigation to \dQuote{assess the variability between samples of penicillin by the \emph{B. subtilis} method. In this test method a bulk-inoculated nutrient agar medium is poured into a Petri dish of approximately 90 mm. diameter, known as a plate. When the medium has set, six small hollow cylinders or pots (about 4 mm. in diameter) are cemented onto the surface at equally spaced intervals. A few drops of the penicillin solutions to be compared are placed in the respective cylinders, and the whole plate is placed in an incubator for a given time. Penicillin diffuses from the pots into the agar, and this produces a clear circular zone of inhibition of growth of the organisms, which can be readily measured. The diameter of the zone is related in a known way to the concentration of penicillin in the solution.} } \examples{ str(Penicillin) require(lattice) dotplot(reorder(plate, diameter) ~ diameter, Penicillin, groups = sample, ylab = "Plate", xlab = "Diameter of growth inhibition zone (mm)", type = c("p", "a"), auto.key = list(columns = 3, lines = TRUE, title = "Penicillin sample")) (fm1 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin)) L <- getME(fm1, "L") Matrix::image(L, main = "L", sub = "Penicillin: Structure of random effects interaction") } \keyword{datasets} lme4/man/confint.merMod.Rd0000644000176200001440000001160314063503234015040 0ustar liggesusers\name{confint.merMod} \alias{confint.merMod} \alias{confint.thpr} \title{Compute Confidence Intervals for Parameters of a [ng]lmer Fit} \description{ Compute confidence intervals on the parameters of a \code{*lmer()} model fit (of class\code{"\linkS4class{merMod}"}). } \usage{ \method{confint}{merMod}(object, parm, level = 0.95, method = c("profile", "Wald", "boot"), zeta, nsim = 500, boot.type = c("perc","basic","norm"), FUN = NULL, quiet = FALSE, oldNames = TRUE, ...) \method{confint}{thpr}(object, parm, level = 0.95, zeta, non.mono.tol=1e-2, ...) } \arguments{ \item{object}{a fitted [ng]lmer model or profile} \item{parm}{parameters for which intervals are sought. Specified by an integer vector of positions, \code{\link{character}} vector of parameter names, or (unless doing parametric bootstrapping with a user-specified bootstrap function) \code{"theta_"} or \code{"beta_"} to specify variance-covariance or fixed effects parameters only: see the \code{which} parameter of \code{\link[=profile.merMod]{profile}}.} \item{level}{confidence level \eqn{< 1}, typically above 0.90.} \item{method}{a \code{\link{character}} string determining the method for computing the confidence intervals.} \item{zeta}{(for \code{method = "profile"} only:) likelihood cutoff (if not specified, as by default, computed from \code{level}).} \item{nsim}{number of simulations for parametric bootstrap intervals.} \item{FUN}{bootstrap function; if \code{NULL}, an internal function that returns the fixed-effect parameters as well as the random-effect parameters on the standard deviation/correlation scale will be used. See \code{\link{bootMer}} for details.} \item{boot.type}{bootstrap confidence interval type, as described in \code{\link[boot]{boot.ci}}. (Methods \sQuote{stud} and \sQuote{bca} are unavailable because they require additional components to be calculated.)} \item{quiet}{(logical) suppress messages about computationally intensive profiling?} \item{oldNames}{(logical) use old-style names for variance-covariance parameters, e.g. \code{".sig01"}, rather than newer (more informative) names such as \code{"sd_(Intercept)|Subject"}? (See \code{signames} argument to \code{\link{profile}}).} \item{non.mono.tol}{tolerance for detecting a non-monotonic profile and warning/falling back to linear interpolation} \item{\dots}{additional parameters to be passed to \code{\link{profile.merMod}} or \code{\link{bootMer}}, respectively.} } \value{ a numeric table (\code{\link{matrix}} with column and row names) of confidence intervals; the confidence intervals are computed on the standard deviation scale. } \note{ The default method \code{"profile"} amounts to \preformatted{ confint(profile(object, which=parm), signames=oldNames, ...), level, zeta)} where the \code{\link{profile}} method \code{\link{profile.merMod}} does almost all the computations. Therefore it is typically advisable to store the \link[=profile.merMod]{profile(.)} result, say in \code{pp}, and then use \code{confint(pp, level=*)} e.g., for different levels. } \details{ Depending on the \code{method} specified, \code{confint()} computes confidence intervals by \describe{ \item{\code{"profile"}:}{computing a likelihood profile and finding the appropriate cutoffs based on the likelihood ratio test;} \item{\code{"Wald"}:}{approximating the confidence intervals (of fixed-effect parameters only; all variance-covariance parameters CIs will be returned as \code{NA}) based on the estimated local curvature of the likelihood surface;} \item{\code{"boot"}:}{performing parametric bootstrapping with confidence intervals computed from the bootstrap distribution according to \code{boot.type} (see \code{\link{bootMer}}, \code{\link[boot]{boot.ci}}).} } } \examples{ if (interactive() || lme4_testlevel() >= 3) { fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm1W <- confint(fm1, method="Wald")# very fast, but .... fm1W (fm2 <- lmer(Reaction ~ Days + (Days || Subject), sleepstudy)) (CI2 <- confint(fm2, maxpts = 8)) # method = "profile"; 8: to be much faster \dontshow{ stopifnot(all.equal(tolerance = 5e-6, signif(unname(CI2), 7), array(c(15.25847, 3.964157, 22.88062, 237.5732, 7.33431, 37.78184, 8.768238, 28.78768, 265.2383, 13.60057), dim = c(5L, 2L)))) } if (lme4_testlevel() >= 3) { ## ~20 seconds, MacBook Pro laptop system.time(fm1P <- confint(fm1, method="profile", ## default oldNames = FALSE)) ## ~ 40 seconds system.time(fm1B <- confint(fm1, method="boot", .progress="txt", PBargs=list(style=3))) } else { load(system.file("testdata","confint_ex.rda",package="lme4")) } fm1P fm1B } ## if interactive && testlevel>=3 } lme4/man/fortify.Rd0000644000176200001440000000331214062244632013641 0ustar liggesusers\name{fortify} \alias{fortify} \alias{fortify.merMod} \alias{getData} \alias{getData.merMod} \title{add information to data based on a fitted model} \usage{ fortify.merMod(model, data = getData(model), ...) \method{getData}{merMod}(object) } \arguments{ \item{model}{fitted model} \item{object}{fitted model} \item{data}{original data set, if needed} \item{\dots}{additional arguments} } \description{ \code{fortify} adds information to data based on a fitted model; \code{getData} retrieves data as specified in the \code{data} argument } \details{ \itemize{ \item{\code{fortify} is defined in the \CRANpkg{ggplot2} package, q.v. for more details. \code{fortify} is \emph{not} defined here, and \code{fortify.merMod} is defined as a function rather than an S3 method, to avoid (1) inducing a dependency on \pkg{ggplot2} or (2) masking methods from \pkg{ggplot2}. This feature is both experimental and semi-deprecated, as the help page for \code{fortify} itself says: \dQuote{Rather than using this function, I now recommend using the \code{broom} package, which implements a much wider range of methods. \code{fortify} may be deprecated in the future.} The \code{broom.mixed} package is recommended for mixed models in general. } \item{ \code{getData} is a bare-bones implementation; it relies on a \code{data} argument having been specified and the data being available in the environment of the formula. Unlike the functions in the \code{nlme} package, it does not do anything special with \code{na.action} or \code{subset}. } } } \examples{ fm1 <- lmer(Reaction~Days+(1|Subject),sleepstudy) names(fortify.merMod(fm1)) } lme4/man/fixef.Rd0000644000176200001440000000216013751775607013277 0ustar liggesusers\docType{methods} \name{fixef} \alias{fixed.effects} \alias{fixef} \alias{fixef.merMod} \title{Extract fixed-effects estimates} \usage{ \method{fixef}{merMod} (object, add.dropped=FALSE, ...) } \arguments{ \item{object}{any fitted model object from which fixed effects estimates can be extracted.} \item{add.dropped}{for models with rank-deficient design matrix, reconstitute the full-length parameter vector by adding \code{NA} values in appropriate locations?} \item{\dots}{optional additional arguments. Currently none are used in any methods.} } \value{ a named, numeric vector of fixed-effects estimates. } \description{ Extract the fixed-effects estimates } \details{ Extract the estimates of the fixed-effects parameters from a fitted model. } \examples{ fixef(lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)) fm2 <- lmer(Reaction ~ Days + Days2 + (1|Subject), data=transform(sleepstudy,Days2=Days)) fixef(fm2,add.dropped=TRUE) ## first two parameters are the same ... stopifnot(all.equal(fixef(fm2,add.dropped=TRUE)[1:2], fixef(fm2))) } \keyword{models} lme4/man/glmFamily-class.Rd0000644000176200001440000000250513751775607015225 0ustar liggesusers\docType{class} \name{glmFamily-class} \alias{glmFamily-class} \title{Class \code{"glmFamily"} - a reference class for \code{\link{family}}} \description{ This class is a wrapper class for \code{\link{family}} objects specifying a distibution family and link function for a generalized linear model (\code{\link{glm}}). The reference class contains an external pointer to a C++ object representing the class. For common families and link functions the functions in the family are implemented in compiled code so they can be accessed from other compiled code and for a speed boost. } \note{ Objects from this reference class correspond to objects in a C++ class. Methods are invoked on the C++ class using the external pointer in the \code{Ptr} field. When saving such an object the external pointer is converted to a null pointer, which is why there is a redundant field \code{ptr} that is an active-binding function returning the external pointer. If the \code{Ptr} field is a null pointer, the external pointer is regenerated for the stored \code{family} field. } \section{Extends}{ All reference classes extend and inherit methods from \code{"\linkS4class{envRefClass}"}. } \examples{ str(glmFamily$new(family=poisson())) } \seealso{ \code{\link{family}}, \code{\link{glmFamily}} } \keyword{classes} lme4/man/troubleshooting.Rd0000644000176200001440000000663414136006216015414 0ustar liggesusers\name{troubleshooting} \alias{troubleshooting} \title{Troubleshooting} \description{ This page attempts to summarize some of the common problems with fitting \code{[gn]lmer} models and how to troubleshoot them. Most of the symptoms/diagnoses/workarounds listed below are due to various issues in the actual mixed model fitting process. You may run into problems due to multicollinearity or variables that are incorrectly typed (e.g. a variable is accidentally coded as character or factor rather than numeric). These problems can often be isolated by trying a \code{lm} or \code{glm} fit or attempting to construct the design matrix via \code{model.matrix()} (in each case with the random effects in your model excluded). If these tests fail then the problem is likely not specifically an \code{lme4} issue. \itemize{ \item \code{failure to converge in (xxxx) evaluations} The optimizer hit its maximum limit of function evaluations. To increase this, use the \code{optControl} argument of \code{[g]lmerControl} -- for \code{Nelder_Mead} and \code{bobyqa} the relevant parameter is \code{maxfun}; for \code{optim} and \code{optimx}-wrapped optimizers, including \code{nlminbwrap}, it's \code{maxit}; for \code{nloptwrap}, it's \code{maxeval}. \item \code{Model failed to converge with max|grad| ...} The scaled gradient at the fitted (RE)ML estimates is worryingly large. Try \itemize{ \item refitting the parameters starting at the current estimates: getting consistent results (with no warning) suggests a false positive \item switching optimizers: getting consistent results suggests there is not really a problem; getting a similar log-likelihood with different parameter estimates suggests that the parameters are poorly determined (possibly the result of a misspecified or overfitted model) \item compute values of the deviance in the neighbourhood of the estimated parameters to double-check that \code{lme4} has really found a local optimum. } \item \code{Hessian is numerically singular: parameters are not uniquely determined} The Hessian (inverse curvature matrix) at the maximum likelihood or REML estimates has a very large eigenvalue, indicating that (within numerical tolerances) the surface is completely flat in some direction. The model may be misspecified, or extremely badly scaled (see \code{"Model is nearly unidentifiable"}). \item \code{Model is nearly unidentifiable ... Rescale variables?} The Hessian (inverse curvature matrix) at the maximum likelihood or REML estimates has a large eigenvalue, indicating that the surface is nearly flat in some direction. Consider centering and/or scaling continuous predictor variables. \item \code{Contrasts can be applied only to factors with 2 or more levels} One or more of the categorical predictors in the model has fewer than two levels. This may be due to user error when converting these predictors to factors prior to modeling, or it may result from some factor levels being eliminated due to \code{NA}s in other predictors. Double-check the number of data points in each factor level to see which one is the culprit: \code{lapply(na.omit(df[,vars]), table)} (where \code{df} is the \code{data.frame} and \code{vars} are the column names of your predictor variables). } } lme4/man/hatvalues.merMod.Rd0000644000176200001440000000151713751775607015421 0ustar liggesusers\name{hatvalues.merMod} \alias{hatvalues.merMod} \title{Diagonal elements of the hat matrix} \usage{ \method{hatvalues}{merMod} (model, fullHatMatrix = FALSE, ...) } \arguments{ \item{model}{An object of class \code{\link{merMod}}.} \item{fullHatMatrix}{Return full hat matrix (not just diagonal values)?} \item{...}{Not currently used} } \value{ The diagonal elements of the hat matrix. } \description{ Returns the values on the diagonal of the hat matrix, which is the matrix that transforms the response vector (minus any offset) into the fitted values (minus any offset). Note that this method should only be used for linear mixed models. It is not clear if the hat matrix concept even makes sense for generalized linear mixed models. } \examples{ m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) hatvalues(m) } lme4/man/subbars.Rd0000644000176200001440000000144313751775607013642 0ustar liggesusers\name{subbars} \alias{subbars} \title{"Sub[stitute] Bars"} \usage{ subbars(term) } \arguments{ \item{term}{a mixed-model formula} } \value{ the formula with all | operators replaced by + } \description{ Substitute the '+' function for the '|' function in a mixed-model formula, recursively (hence the argument name \code{term}). This provides a formula suitable for the current \code{\link{model.frame}} function. } \seealso{ \code{\link{formula}}, \code{\link{model.frame}}, \code{\link{model.matrix}}. Other utilities: \code{\link{findbars}}, \code{\link{nobars}}, \code{\link{mkRespMod}}, \code{\link{mkReTrms}}, \code{\link{nlformula}}. } \examples{ subbars(Reaction ~ Days + (Days|Subject)) ## => Reaction ~ Days + (Days + Subject) } \keyword{models} \keyword{utilities} lme4/man/devcomp.Rd0000644000176200001440000000116513751775607013637 0ustar liggesusers\name{devcomp} \alias{devcomp} \title{Extract the deviance component list} \usage{ devcomp(x) } \arguments{ \item{x}{a fitted model of class \code{\linkS4class{merMod}}} } \value{ a list with components \item{dims}{a named integer vector of various dimensions} \item{cmp}{a named numeric vector of components of the deviance} } \description{ Return the deviance component list } \details{ A fitted model of class \code{\linkS4class{merMod}} has a \code{devcomp} slot as described in the value section. } \note{ This function is deprecated, use \code{\link{getME}(., "devcomp")} %% ---------- } lme4/man/rePCA.Rd0000644000176200001440000000155213751775607013134 0ustar liggesusers\name{rePCA} \alias{rePCA} \title{PCA of random-effects covariance matrix} \usage{ rePCA(x) } \arguments{ \item{x}{a \code{merMod} object} } \value{ a \code{prcomplist} object } \description{ PCA of random-effects variance-covariance estimates } \details{ Perform a Principal Components Analysis (PCA) of the random-effects variance-covariance estimates from a fitted mixed-effects model. This allows the user to detect and diagnose overfitting problems in the random effects model (see Bates et al. 2015 for details). } \examples{ fm1 <- lmer(Reaction~Days+(Days|Subject), sleepstudy) rePCA(fm1) } \author{ Douglas Bates } \seealso{\code{\link{isSingular}}} \references{ \itemize{ \item Douglas Bates, Reinhold Kliegl, Shravan Vasishth, and Harald Baayen. Parsimonious Mixed Models. arXiv:1506.04967 [stat], June 2015. arXiv: 1506.04967. } } lme4/man/factorize.Rd0000644000176200001440000000111013751775607014156 0ustar liggesusers\name{factorize} \alias{factorize} \title{Attempt to convert grouping variables to factors} \usage{ factorize(x,frloc,char.only=FALSE) } \arguments{ \item{x}{a formula} \item{frloc}{a data frame} \item{char.only}{(logical) convert only \code{character} variables to factors?} } \description{ If variables within a data frame are not factors, try to convert them. Not intended for end-user use; this is a utility function that needs to be exported, for technical reasons. } \value{ a copy of the data frame with factors converted } \keyword{models} \keyword{utilities} lme4/man/dummy.Rd0000644000176200001440000000166313751775607013340 0ustar liggesusers\name{dummy} \alias{dummy} \title{Dummy variables (experimental)} \usage{ dummy(f, levelsToKeep) } \arguments{ \item{f}{An object coercible to \code{\link{factor}}.} \item{levelsToKeep}{An optional character vector giving the subset of \code{levels(f)} to be converted to dummy variables.} } \value{ A \code{\link{model.matrix}} with dummy variables as columns. } \description{ Largely a wrapper for \code{\link{model.matrix}} that accepts a factor, \code{f}, and returns a dummy matrix with \code{nlevels(f)-1} columns (the first column is dropped by default). Useful whenever one wishes to avoid the behaviour of \code{model.matrix} of always returning an \code{nlevels(f)}-column matrix, either by the addition of an intercept column, or by keeping one column for all levels. } \examples{ data(Orthodont,package="nlme") lmer(distance ~ age + (age|Subject) + (0+dummy(Sex, "Female")|Subject), data = Orthodont) } lme4/man/VerbAgg.Rd0000644000176200001440000000510014176255662013504 0ustar liggesusers\docType{data} \name{VerbAgg} \alias{VerbAgg} \title{Verbal Aggression item responses} \format{A data frame with 7584 observations on the following 13 variables. \describe{ \item{\code{Anger}}{the subject's Trait Anger score as measured on the State-Trait Anger Expression Inventory (STAXI)} \item{\code{Gender}}{the subject's gender - a factor with levels \code{M} and \code{F}} \item{\code{item}}{the item on the questionaire, as a factor} \item{\code{resp}}{the subject's response to the item - an ordered factor with levels \code{no} < \code{perhaps} < \code{yes}} \item{\code{id}}{the subject identifier, as a factor} \item{\code{btype}}{behavior type - a factor with levels \code{curse}, \code{scold} and \code{shout}} \item{\code{situ}}{situation type - a factor with levels \code{other} and \code{self} indicating other-to-blame and self-to-blame} \item{\code{mode}}{behavior mode - a factor with levels \code{want} and \code{do}} \item{\code{r2}}{dichotomous version of the response - a factor with levels \code{N} and \code{Y}} } } \source{ Data available from the UC Berkeley BEAR Center (web page at \url{https://bearcenter.berkeley.edu/page/materials-explanatory-item-response-models}). } \description{ These are the item responses to a questionaire on verbal aggression. These data are used throughout De Boeck and Wilson (2004) to illustrate various forms of item response models. } \examples{ str(VerbAgg) ## Show how r2 := h(resp) is defined: with(VerbAgg, stopifnot( identical(r2, { r <- factor(resp, ordered=FALSE); levels(r) <- c("N","Y","Y"); r}))) xtabs(~ item + resp, VerbAgg) xtabs(~ btype + resp, VerbAgg) round(100 * ftable(prop.table(xtabs(~ situ + mode + resp, VerbAgg), 1:2), 1)) person <- unique(subset(VerbAgg, select = c(id, Gender, Anger))) require(lattice) densityplot(~ Anger, person, groups = Gender, auto.key = list(columns = 2), xlab = "Trait Anger score (STAXI)") if(lme4:::testLevel() >= 3) { ## takes about 15 sec print(fmVA <- glmer(r2 ~ (Anger + Gender + btype + situ)^2 + (1|id) + (1|item), family = binomial, data = VerbAgg), corr=FALSE) } ## testLevel() >= 3 if (interactive()) { ## much faster but less accurate print(fmVA0 <- glmer(r2 ~ (Anger + Gender + btype + situ)^2 + (1|id) + (1|item), family = binomial, data = VerbAgg, nAGQ=0L), corr=FALSE) } ## interactive() } \references{ De Boeck and Wilson (2004), \emph{Explanatory Item Response Models}, Springer. } \keyword{datasets} lme4/man/lme4-package.Rd0000644000176200001440000000750413751775607014437 0ustar liggesusers\name{lme4-package} \alias{lme4} \alias{lme4-package} \docType{package} \title{Linear, generalized linear, and nonlinear mixed models} \description{ \code{lme4} provides functions for fitting and analyzing mixed models: linear (\code{\link{lmer}}), generalized linear (\code{\link{glmer}}) and nonlinear (\code{\link{nlmer}}.) } \section{Differences between \pkg{nlme} and \pkg{lme4}}{ \pkg{lme4} covers approximately the same ground as the earlier \pkg{nlme} package. The most important differences are: \itemize{ \item \pkg{lme4} uses modern, efficient linear algebra methods as implemented in the \code{Eigen} package, and uses reference classes to avoid undue copying of large objects; it is therefore likely to be faster and more memory-efficient than \pkg{nlme}. \item \pkg{lme4} includes generalized linear mixed model (GLMM) capabilities, via the \code{\link{glmer}} function. \item \pkg{lme4} does \emph{not} currently implement \pkg{nlme}'s features for modeling heteroscedasticity and correlation of residuals. \item \pkg{lme4} does not currently offer the same flexibility as \pkg{nlme} for composing complex variance-covariance structures, but it does implement crossed random effects in a way that is both easier for the user and much faster. \item \pkg{lme4} offers built-in facilities for likelihood profiling and parametric bootstrapping. \item \pkg{lme4} is designed to be more modular than \pkg{nlme}, making it easier for downstream package developers and end-users to re-use its components for extensions of the basic mixed model framework. It also allows more flexibility for specifying different functions for optimizing over the random-effects variance-covariance parameters. \item \pkg{lme4} is not (yet) as well-documented as \pkg{nlme}. } } \section{Differences between current (1.0.+) and previous versions of \pkg{lme4}}{ \itemize{ \item \code{[gn]lmer} now produces objects of class \code{\linkS4class{merMod}} rather than class \code{mer} as before \item the new version uses a combination of S3 and reference classes (see \code{\link{ReferenceClasses}}, \code{\link{merPredD-class}}, and \code{\link{lmResp-class}}) as well as S4 classes; partly for this reason it is more interoperable with \pkg{nlme} \item The internal structure of [gn]lmer is now more modular, allowing finer control of the different steps of argument checking; construction of design matrices and data structures; parameter estimation; and construction of the final \code{merMod} object (see \code{\link{modular}}) \item profiling and parametric bootstrapping are new in the current version \item the new version of \pkg{lme4} does \emph{not} provide an \code{mcmcsamp} (post-hoc MCMC sampling) method, because this was deemed to be unreliable. Alternatives for computing p-values include parametric bootstrapping (\code{\link{bootMer}}) or methods implemented in the \pkg{pbkrtest} package and leveraged by the \pkg{lmerTest} package and the \code{Anova} function in the \pkg{car} package (see \code{\link{pvalues}} for more details). } } \section{Caveats and trouble-shooting}{ \itemize{ \item Some users who have previously installed versions of the RcppEigen and minqa packages may encounter segmentation faults (!!); the solution is to make sure to re-install these packages before installing \pkg{lme4}. (Because the problem is not with the explicit \emph{version} of the packages, but with running packages that were built with different versions of \pkg{Rcpp} in conjunction with each other, simply making sure you have the latest version, or using \code{update.packages}, will not necessarily solve the problem; you must actually re-install the packages. The problem is most likely with \pkg{minqa}.) } } lme4/man/grouseticks.Rd0000644000176200001440000000415514063503234014524 0ustar liggesusers\name{grouseticks} \alias{grouseticks} \alias{grouseticks_agg} \docType{data} \title{ Data on red grouse ticks from Elston et al. 2001 } \description{ Number of ticks on the heads of red grouse chicks sampled in the field (\code{grouseticks}) and an aggregated version (\code{grouseticks_agg}); see original source for more details } \usage{data(grouseticks)} \format{ \describe{ \item{\code{INDEX}}{(factor) chick number (observation level)} \item{\code{TICKS}}{number of ticks sampled} \item{\code{BROOD}}{(factor) brood number} \item{\code{HEIGHT}}{height above sea level (meters)} \item{\code{YEAR}}{year (-1900)} \item{\code{LOCATION}}{(factor) geographic location code} \item{\code{cHEIGHT}}{centered height, derived from \code{HEIGHT}} \item{\code{meanTICKS}}{mean number of ticks by brood} \item{\code{varTICKS}}{variance of number of ticks by brood} } } \source{ Robert Moss, via David Elston } \details{\code{grouseticks_agg} is just a brood-level aggregation of the data} \references{ Elston, D. A., R. Moss, T. Boulinier, C. Arrowsmith, and X. Lambin. 2001. "Analysis of Aggregation, a Worked Example: Numbers of Ticks on Red Grouse Chicks." Parasitology 122 (05): 563-569. doi:10.1017/S0031182001007740. \url{http://journals.cambridge.org/action/displayAbstract?fromPage=online&aid=82701}. } \examples{ if (interactive()) { data(grouseticks) ## Figure 1a from Elston et al par(las=1,bty="l") tvec <- c(0,1,2,5,20,40,80) pvec <- c(4,1,3) with(grouseticks_agg,plot(1+meanTICKS~HEIGHT, pch=pvec[factor(YEAR)], log="y",axes=FALSE, xlab="Altitude (m)", ylab="Brood mean ticks")) axis(side=1) axis(side=2,at=tvec+1,label=tvec) box() abline(v=405,lty=2) ## Figure 1b with(grouseticks_agg,plot(varTICKS~meanTICKS, pch=4, xlab="Brood mean ticks", ylab="Within-brood variance")) curve(1*x,from=0,to=70,add=TRUE) ## Model fitting form <- TICKS~YEAR+HEIGHT+(1|BROOD)+(1|INDEX)+(1|LOCATION) (full_mod1 <- glmer(form, family="poisson",data=grouseticks)) } } \keyword{datasets} lme4/man/Nelder_Mead.Rd0000644000176200001440000000726713751775607014352 0ustar liggesusers\name{NelderMead} \alias{Nelder_Mead} \title{Nelder-Mead Optimization of Parameters, Possibly (Box) Constrained} \description{ Nelder-Mead optimization of parameters, allowing optimization subject to box constraints (contrary to the default, \code{method = "Nelder-Mead"}, in \R's \code{\link{optim}()}), and using reverse communications. } \usage{ Nelder_Mead(fn, par, lower = rep.int(-Inf, n), upper = rep.int(Inf, n), control = list()) } \arguments{ \item{fn}{a \code{\link{function}} of a single numeric vector argument returning a numeric scalar.} \item{par}{numeric vector of starting values for the parameters.} \item{lower}{numeric vector of lower bounds (elements may be \code{-Inf}).} \item{upper}{numeric vector of upper bounds (elements may be \code{Inf}).} \item{control}{a named list of control settings. Possible settings are \describe{ \item{iprint}{numeric scalar - frequency of printing evaluation information. Defaults to 0 indicating no printing.} \item{maxfun}{numeric scalar - maximum number of function evaluations allowed (default:10000).} \item{FtolAbs}{numeric scalar - absolute tolerance on change in function values (default: 1e-5)} \item{FtolRel}{numeric scalar - relative tolerance on change in function values (default:1e-15)} \item{XtolRel}{numeric scalar - relative tolerance on change in parameter values (default: 1e-7)} \item{MinfMax}{numeric scalar - maximum value of the minimum (default: .Machine$double.xmin)} \item{xst}{numeric vector of initial step sizes to establish the simplex - all elements must be non-zero (default: rep(0.02,length(par)))} \item{xt}{numeric vector of tolerances on the parameters (default: xst*5e-4)} \item{verbose}{numeric value: 0=no printing, 1=print every 20 evaluations, 2=print every 10 evalutions, 3=print every evaluation. Sets \sQuote{iprint}, if specified, but does not override it.} \item{warnOnly}{a logical indicating if non-convergence (codes -1,-2,-3) should not \code{\link{stop}(.)}, but rather only call \code{\link{warning}} and return a result which might inspected. Defaults to \code{FALSE}, i.e., stop on non-convergence.} } } } \value{ a \code{\link{list}} with components \item{fval}{numeric scalar - the minimum function value achieved} \item{par}{numeric vector - the value of \code{x} providing the minimum} \item{convergence}{integer valued scalar, if not \code{0}, an error code: \describe{ \item{-4}{\code{nm_evals}: maximum evaluations reached} \item{-3}{\code{nm_forced}: ?} \item{-2}{\code{nm_nofeasible}: cannot generate a feasible simplex} \item{-1}{\code{nm_x0notfeasible}: initial x is not feasible (?)} \item{0}{successful convergence} } } \item{message}{a string specifying the kind of convergence.} \item{control}{the \code{\link{list}} of control settings after substituting for defaults.} \item{feval}{the number of function evaluations.} } \seealso{ The \code{\linkS4class{NelderMead}} class definition and generator function. } \examples{ fr <- function(x) { ## Rosenbrock Banana function x1 <- x[1] x2 <- x[2] 100 * (x2 - x1 * x1)^2 + (1 - x1)^2 } p0 <- c(-1.2, 1) oo <- optim(p0, fr) ## also uses Nelder-Mead by default o. <- Nelder_Mead(fr, p0) o.1 <- Nelder_Mead(fr, p0, control=list(verbose=1))# -> some iteration output stopifnot(identical(o.[1:4], o.1[1:4]), all.equal(o.$par, oo$par, tolerance=1e-3))# diff: 0.0003865 %%## but this shows that something "does not work" o.2 <- Nelder_Mead(fr, p0, control=list(verbose=3, XtolRel=1e-15, FtolAbs= 1e-14)) all.equal(o.2[-5],o.1[-5], tolerance=1e-15)# TRUE, unexpectedly } \keyword{classes} lme4/man/bootMer.Rd0000644000176200001440000001733414063503234013574 0ustar liggesusers\name{bootMer} \alias{bootMer} \title{Model-based (Semi-)Parametric Bootstrap for Mixed Models} \usage{ bootMer(x, FUN, nsim = 1, seed = NULL, use.u = FALSE, re.form=NA, type = c("parametric", "semiparametric"), verbose = FALSE, .progress = "none", PBargs = list(), parallel = c("no", "multicore", "snow"), ncpus = getOption("boot.ncpus", 1L), cl = NULL) } \arguments{ \item{x}{a fitted \code{merMod} object: see \code{\link{lmer}}, \code{\link{glmer}}, etc.} \item{FUN}{a function taking a fitted \code{merMod} object as input and returning the \emph{statistic} of interest, which must be a (possibly named) numeric vector.} \item{nsim}{number of simulations, positive integer; the bootstrap \eqn{B} (or \eqn{R}).} \item{seed}{optional argument to \code{\link{set.seed}}.} \item{use.u}{logical, indicating whether the spherical random effects should be simulated / bootstrapped as well. If \code{TRUE}, they are not changed, and all inference is conditional on these values. If \code{FALSE}, new normal deviates are drawn (see Details).} \item{re.form}{formula, \code{NA} (equivalent to \code{use.u=FALSE}), or \code{NULL} (equivalent to \code{use.u=TRUE}): alternative to \code{use.u} for specifying which random effects to incorporate. See \code{\link{simulate.merMod}} for details.} \item{type}{character string specifying the type of bootstrap, \code{"parametric"} or \code{"semiparametric"}; partial matching is allowed.} \item{verbose}{logical indicating if progress should print output} \item{.progress}{character string - type of progress bar to display. Default is \code{"none"}; the function will look for a relevant \code{*ProgressBar} function, so \code{"txt"} will work in general; \code{"tk"} is available if the \pkg{tcltk} package is loaded; or \code{"win"} on Windows systems. Progress bars are disabled (with a message) for parallel operation.} \item{PBargs}{a list of additional arguments to the progress bar function (the package authors like \code{list(style=3)}).} \item{parallel}{The type of parallel operation to be used (if any). If missing, the default is taken from the option \code{"boot.parallel"} (and if that is not set, \code{"no"}).} \item{ncpus}{integer: number of processes to be used in parallel operation: typically one would choose this to be the number of available CPUs.} \item{cl}{An optional \pkg{parallel} or \pkg{snow} cluster for use if \code{parallel = "snow"}. If not supplied, a cluster on the local machine is created for the duration of the \code{boot} call.} } \value{ an object of S3 \code{\link{class}} \code{"boot"}, compatible with \CRANpkg{boot} package's \code{\link[boot]{boot}()} result. } \description{ Perform model-based (Semi-)parametric bootstrap for mixed models. } \note{ If you are using \code{parallel="snow"}, you will need to run \code{clusterEvalQ(cl,library("lme4"))} before calling \code{bootMer} to make sure that the \code{lme4} package is loaded on all of the workers; you may additionally need to use \code{\link[parallel]{clusterExport}} if you are using a summary function that calls any objects from the environment. } \details{ The semi-parametric variant is only partially implemented, and we only provide a method for \code{\link{lmer}} and \code{\link{glmer}} results. The working name for bootMer() was \dQuote{simulestimate()}, as it is an extension of \code{simulate} (see \link{simulate.merMod}), but we want to emphasize its potential for valid inference. \itemize{ \item If \code{use.u} is \code{FALSE} and \code{type} is \code{"parametric"}, each simulation generates new values of both the \dQuote{\emph{spherical}} random effects \eqn{u} and the i.i.d. errors \eqn{\epsilon}, using \code{\link{rnorm}()} with parameters corresponding to the fitted model \code{x}. \item If \code{use.u} is \code{TRUE} and \code{type=="parametric"}, only the i.i.d. errors (or, for GLMMs, response values drawn from the appropriate distributions) are resampled, with the values of \eqn{u} staying fixed at their estimated values. \item If \code{use.u} is \code{TRUE} and \code{type=="semiparametric"}, the i.i.d. errors are sampled from the distribution of (response) residuals. (For GLMMs, the resulting sample will no longer have the same properties as the original sample, and the method may not make sense; a warning is generated.) The semiparametric bootstrap is currently an experimental feature, and therefore may not be stable. \item The case where \code{use.u} is \code{FALSE} and \code{type=="semiparametric"} is not implemented; Morris (2002) suggests that resampling from the estimated values of \eqn{u} is not good practice. } %% itemize } %% details \references{ Davison, A.C. and Hinkley, D.V. (1997) \emph{Bootstrap Methods and Their Application}. Cambridge University Press. Morris, J. S. (2002). The BLUPs Are Not \sQuote{best} When It Comes to Bootstrapping. \emph{Statistics & Probability Letters} \bold{56}(4): 425--430. doi:10.1016/S0167-7152(02)00041-X. } \seealso{ \itemize{ \item \code{\link{confint.merMod}}, for a more specific approach to bootstrap confidence intervals on parameters. \item \code{\link{refit}()}, or \code{\link[pbkrtest]{PBmodcomp}()} from the \CRANpkg{pbkrtest} package, for parametric bootstrap comparison of models. \item \code{\link[boot]{boot}()}, and then \code{\link[boot]{boot.ci}}, from the \pkg{boot} package. \item \code{\link{profile-methods}}, for likelihood-based inference, including confidence intervals. \item \code{\link{pvalues}}, for more general approaches to inference and p-value computation in mixed models. } } \examples{ if (interactive()) { fm01ML <- lmer(Yield ~ 1|Batch, Dyestuff, REML = FALSE) ## see ?"profile-methods" mySumm <- function(.) { s <- sigma(.) c(beta =getME(., "beta"), sigma = s, sig01 = unname(s * getME(., "theta"))) } (t0 <- mySumm(fm01ML)) # just three parameters ## alternatively: mySumm2 <- function(.) { c(beta=fixef(.),sigma=sigma(.), sig01=sqrt(unlist(VarCorr(.)))) } set.seed(101) ## 3.8s (on a 5600 MIPS 64bit fast(year 2009) desktop "AMD Phenom(tm) II X4 925"): system.time( boo01 <- bootMer(fm01ML, mySumm, nsim = 100) ) ## to "look" at it if (requireNamespace("boot")) { boo01 ## note large estimated bias for sig01 ## (~30\% low, decreases _slightly_ for nsim = 1000) ## extract the bootstrapped values as a data frame ... head(as.data.frame(boo01)) ## ------ Bootstrap-based confidence intervals ------------ ## warnings about "Some ... intervals may be unstable" go away ## for larger bootstrap samples, e.g. nsim=500 ## intercept (bCI.1 <- boot::boot.ci(boo01, index=1, type=c("norm", "basic", "perc")))# beta ## Residual standard deviation - original scale: (bCI.2 <- boot::boot.ci(boo01, index=2, type=c("norm", "basic", "perc"))) ## Residual SD - transform to log scale: (bCI.2L <- boot::boot.ci(boo01, index=2, type=c("norm", "basic", "perc"), h = log, hdot = function(.) 1/., hinv = exp)) ## Among-batch variance: (bCI.3 <- boot::boot.ci(boo01, index=3, type=c("norm", "basic", "perc"))) # sig01 confint(boo01) confint(boo01,type="norm") confint(boo01,type="basic") ## Graphical examination: plot(boo01,index=3) ## Check stored values from a longer (1000-replicate) run: (load(system.file("testdata","boo01L.RData", package="lme4")))# "boo01L" plot(boo01L, index=3) mean(boo01L$t[,"sig01"]==0) ## note point mass at zero! } %% if boot package available } %% interactive } \keyword{htest} \keyword{models} lme4/man/glmer.Rd0000644000176200001440000002260714063503234013272 0ustar liggesusers\name{glmer} \title{Fitting Generalized Linear Mixed-Effects Models} \alias{glmer} \concept{ GLMM } \description{ Fit a generalized linear mixed-effects model (GLMM). Both fixed effects and random effects are specified via the model \code{formula}. } \usage{ glmer(formula, data = NULL, family = gaussian , control = glmerControl() , start = NULL , verbose = 0L , nAGQ = 1L , subset, weights, na.action, offset, contrasts = NULL , mustart, etastart , devFunOnly = FALSE) } \arguments{ \item{formula}{a two-sided linear formula object describing both the fixed-effects and random-effects part of the model, with the response on the left of a \code{~} operator and the terms, separated by \code{+} operators, on the right. Random-effects terms are distinguished by vertical bars (\code{"|"}) separating expressions for design matrices from grouping factors.} \item{data}{an optional data frame containing the variables named in \code{formula}. By default the variables are taken from the environment from which \code{lmer} is called. While \code{data} is optional, the package authors \emph{strongly} recommend its use, especially when later applying methods such as \code{update} and \code{drop1} to the fitted model (\emph{such methods are not guaranteed to work properly if \code{data} is omitted}). If \code{data} is omitted, variables will be taken from the environment of \code{formula} (if specified as a formula) or from the parent frame (if specified as a character vector).} \item{family}{a GLM family, see \code{\link[stats]{glm}} and \code{\link[stats]{family}}.} \item{control}{a list (of correct class, resulting from \code{\link{lmerControl}()} or \code{\link{glmerControl}()} respectively) containing control parameters, including the nonlinear optimizer to be used and parameters to be passed through to the nonlinear optimizer, see the \code{*lmerControl} documentation for details.} \item{start}{a named list of starting values for the parameters in the model, or a numeric vector. A numeric \code{start} argument will be used as the starting value of \code{theta}. If \code{start} is a list, the \code{theta} element (a numeric vector) is used as the starting value for the first optimization step (default=1 for diagonal elements and 0 for off-diagonal elements of the lower Cholesky factor); the fitted value of \code{theta} from the first step, plus \code{start[["fixef"]]}, are used as starting values for the second optimization step. If \code{start} has both \code{fixef} and \code{theta} elements, the first optimization step is skipped. For more details or finer control of optimization, see \code{\link{modular}}.} \item{verbose}{integer scalar. If \code{> 0} verbose output is generated during the optimization of the parameter estimates. If \code{> 1} verbose output is generated during the individual penalized iteratively reweighted least squares (PIRLS) steps.} \item{nAGQ}{integer scalar - the number of points per axis for evaluating the adaptive Gauss-Hermite approximation to the log-likelihood. Defaults to 1, corresponding to the Laplace approximation. Values greater than 1 produce greater accuracy in the evaluation of the log-likelihood at the expense of speed. A value of zero uses a faster but less exact form of parameter estimation for GLMMs by optimizing the random effects and the fixed-effects coefficients in the penalized iteratively reweighted least squares step. (See Details.)} \item{subset}{an optional expression indicating the subset of the rows of \code{data} that should be used in the fit. This can be a logical vector, or a numeric vector indicating which observation numbers are to be included, or a character vector of the row names to be included. All observations are included by default.} \item{weights}{an optional vector of \sQuote{prior weights} to be used in the fitting process. Should be \code{NULL} or a numeric vector.} \item{na.action}{a function that indicates what should happen when the data contain \code{NA}s. The default action (\code{na.omit}, inherited from the \sQuote{factory fresh} value of \code{getOption("na.action")}) strips any observations with any missing values in any variables.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. This should be \code{NULL} or a numeric vector of length equal to the number of cases. One or more \code{\link{offset}} terms can be included in the formula instead or as well, and if more than one is specified their sum is used. See \code{\link{model.offset}}.} \item{contrasts}{an optional list. See the \code{contrasts.arg} of \code{\link{model.matrix.default}}.} \item{mustart}{optional starting values on the scale of the conditional mean, as in \code{\link[stats]{glm}}; see there for details.} \item{etastart}{optional starting values on the scale of the unbounded predictor as in \code{\link[stats]{glm}}; see there for details.} \item{devFunOnly}{logical - return only the deviance evaluation function. Note that because the deviance function operates on variables stored in its environment, it may not return \emph{exactly} the same values on subsequent calls (but the results should always be within machine tolerance).} } \value{ An object of class \code{\link[=merMod-class]{merMod}} (more specifically, an object of \emph{subclass} \code{glmerMod}) for which many methods are available (e.g. \code{methods(class="merMod")}) } \note{ In earlier version of the \pkg{lme4} package, a \code{method} argument was used. Its functionality has been replaced by the \code{nAGQ} argument. } \details{ Fit a generalized linear mixed model, which incorporates both fixed-effects parameters and random effects in a linear predictor, via maximum likelihood. The linear predictor is related to the conditional mean of the response through the inverse link function defined in the GLM \code{family}. The expression for the likelihood of a mixed-effects model is an integral over the random effects space. For a linear mixed-effects model (LMM), as fit by \code{\link{lmer}}, this integral can be evaluated exactly. For a GLMM the integral must be approximated. The most reliable approximation for GLMMs is adaptive Gauss-Hermite quadrature, at present implemented only for models with a single scalar random effect. The \code{nAGQ} argument controls the number of nodes in the quadrature formula. A model with a single, scalar random-effects term could reasonably use up to 25 quadrature points per scalar integral. % With vector-valued random effects the complexity of the Gauss-Hermite % quadrature formulas increases dramatically with the dimension. For a % 3-dimensional vector-valued random effect \code{nAGQ=5} requires 93 % evaluations of the GLM deviance per evaluation of the approximate GLMM % deviance. For 20-dimensional evaluations of the GLM deviance per % evaluation of the approximate GLMM deviance. % The default approximation is the Laplace approximation, % corresponding to \code{nAGQ=1}. } \seealso{ \code{\link{lmer}} (for details on formulas and parameterization); \code{\link[stats]{glm}} for Generalized Linear Models (\emph{without} random effects). \code{\link{nlmer}} for nonlinear mixed-effects models. \code{\link{glmer.nb}} to fit negative binomial GLMMs. } \examples{ ## generalized linear mixed model library(lattice) xyplot(incidence/size ~ period|herd, cbpp, type=c('g','p','l'), layout=c(3,5), index.cond = function(x,y)max(y)) (gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial)) ## using nAGQ=0 only gets close to the optimum (gm1a <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), cbpp, binomial, nAGQ = 0)) ## using nAGQ = 9 provides a better evaluation of the deviance ## Currently the internal calculations use the sum of deviance residuals, ## which is not directly comparable with the nAGQ=0 or nAGQ=1 result. ## 'verbose = 1' monitors iteratin a bit; (verbose = 2 does more): (gm1a <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), cbpp, binomial, verbose = 1, nAGQ = 9)) ## GLMM with individual-level variability (accounting for overdispersion) ## For this data set the model is the same as one allowing for a period:herd ## interaction, which the plot indicates could be needed. cbpp$obs <- 1:nrow(cbpp) (gm2 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd) + (1|obs), family = binomial, data = cbpp)) anova(gm1,gm2) ## glmer and glm log-likelihoods are consistent gm1Devfun <- update(gm1,devFunOnly=TRUE) gm0 <- glm(cbind(incidence, size - incidence) ~ period, family = binomial, data = cbpp) ## evaluate GLMM deviance at RE variance=theta=0, beta=(GLM coeffs) gm1Dev0 <- gm1Devfun(c(0,coef(gm0))) ## compare stopifnot(all.equal(gm1Dev0,c(-2*logLik(gm0)))) ## the toenail oncholysis data from Backer et al 1998 ## these data are notoriously difficult to fit \dontrun{ if (require("HSAUR3")) { gm2 <- glmer(outcome~treatment*visit+(1|patientID), data=toenail, family=binomial,nAGQ=20) } } } \keyword{models} lme4/DESCRIPTION0000644000176200001440000000572514177343542012644 0ustar liggesusersPackage: lme4 Version: 1.1-28 Title: Linear Mixed-Effects Models using 'Eigen' and S4 Authors@R: c( person("Douglas","Bates", role="aut", comment=c(ORCID="0000-0001-8316-9503")), person("Martin","Maechler", role="aut", comment=c(ORCID="0000-0002-8685-9910")), person("Ben","Bolker",email="bbolker+lme4@gmail.com", role=c("aut","cre"), comment=c(ORCID="0000-0002-2127-0443")), person("Steven","Walker",role="aut", comment=c(ORCID="0000-0002-4394-9078")), person("Rune Haubo Bojesen","Christensen", role="ctb", comment=c(ORCID="0000-0002-4494-3399")), person("Henrik","Singmann", role="ctb", comment=c(ORCID="0000-0002-4842-3657")), person("Bin", "Dai", role="ctb"), person("Fabian", "Scheipl", role="ctb", comment=c(ORCID="0000-0001-8172-3603")), person("Gabor", "Grothendieck", role="ctb"), person("Peter", "Green", role="ctb", comment=c(ORCID="0000-0002-0238-9852")), person("John", "Fox", role="ctb"), person("Alexander", "Bauer", role="ctb"), person("Pavel N.", "Krivitsky", role=c("ctb","cph"), comment=c(ORCID="0000-0002-9101-3362", "shared copyright on simulate.formula")) ) Contact: LME4 Authors Description: Fit linear and generalized linear mixed-effects models. The models and their components are represented using S4 classes and methods. The core computational algorithms are implemented using the 'Eigen' C++ library for numerical linear algebra and 'RcppEigen' "glue". Depends: R (>= 3.2.0), Matrix (>= 1.2-1), methods, stats LinkingTo: Rcpp (>= 0.10.5), RcppEigen Imports: graphics, grid, splines, utils, parallel, MASS, lattice, boot, nlme (>= 3.1-123), minqa (>= 1.1.15), nloptr (>= 1.0.4) Suggests: knitr, rmarkdown, PKPDmodels, MEMSS, testthat (>= 0.8.1), ggplot2, mlmRev, optimx (>= 2013.8.6), gamm4, pbkrtest, HSAUR3, numDeriv, car, dfoptim, mgcv, statmod, rr2, semEff, tibble VignetteBuilder: knitr LazyData: yes License: GPL (>= 2) URL: https://github.com/lme4/lme4/ BugReports: https://github.com/lme4/lme4/issues Encoding: UTF-8 NeedsCompilation: yes Packaged: 2022-02-02 23:35:16 UTC; bolker Author: Douglas Bates [aut] (), Martin Maechler [aut] (), Ben Bolker [aut, cre] (), Steven Walker [aut] (), Rune Haubo Bojesen Christensen [ctb] (), Henrik Singmann [ctb] (), Bin Dai [ctb], Fabian Scheipl [ctb] (), Gabor Grothendieck [ctb], Peter Green [ctb] (), John Fox [ctb], Alexander Bauer [ctb], Pavel N. Krivitsky [ctb, cph] (, shared copyright on simulate.formula) Maintainer: Ben Bolker Repository: CRAN Date/Publication: 2022-02-05 00:40:02 UTC lme4/build/0000755000176200001440000000000014176612460012221 5ustar liggesuserslme4/build/vignette.rds0000644000176200001440000000053014176612460014556 0ustar liggesusersuRn0 $?Aizh"!ЫE6`ɱ#@ë5ءAT# Q{\~CwU*YU8.^A}2; |;۷l~ڂLTK _ȪjZ2I1LHPEr kYh&m=l5RV`J幾(i6h.Vg4ib|3swCf^I0pcgmZ\\]47V)4 NRwA4nTۉJldn%Wɸ&xD?rqlme4/build/partial.rdb0000644000176200001440000002422514176612363014355 0ustar liggesusers}vF&un_kbtLMے|,)m;Pv0dD ([k֚w-ϙ5:څ  tZmܻj_jD"1fy;1x=IRR+FRn[[2J['7-l=jI#A[[{FGΟ2=޼*}FEի<+ujy~vb <_U[7D]/u?\a;v}_ݺ}L@elVv-6x-VY_XZ.f늞)T<,U1e؊DgM!ŊQ~}sT)O_%TpTqF)\'b&DYRF5#=jڪت0YyPsC۪Y(~[.zƢ3X|jMfHV@1UhTjE-bäd@M Y Q zSSlZ!5j<%ED#y_}A:'iQ `{ 1t'ҟ,VU6u߁!L%UE#m!9+Xl*Z 6|$N8 x+16MK5ӨH_g3$:D l\왬Dީvܝ_"Fɢo,hL%{X.B;JIVF 3R 7"dI9e9nQlFLZL sH!4e4yC*y amtqhjV-^D\Bz)e0J{Q]GH?k OD1>%O%eXld-yO4>Kݑx3ϑY t"h$wu$]dsHb|dL2Ž2t~o@-61|y1x灀 M95OSFF)0g|a4H M I0aTy qpCI):ҡ:)[EDzN'dŤ ZT#59ÓYG# lϐy9nvw瑞? d . 3ICJuY:@ihoE̳06K$7TEkJ ;!{)O gw0`\@|`ѩFM/aBORaOM7UK˴Н戡 Pִ@KkHE6Y'JF=b3HդTMЪlGHjC7 X&m,c  DsF؂΅(I*'֒ H2?'k` g_!Ud8aj]ш+EX?GJV+;t0tS!h f?$ $\ºCҭ+@LtݾFKA ~+ucͺfIRiex[̚em3PQJVd2iO67yM6u^T@7GĐ3"Dk"%ŢU ҡB#hh qP">@:\;N;l"j7Z; ک+)qD륀][!n5, >ǝ@CkH?]3t3Ǩ9r6lEMՖNZ@3bma5#jM^#M$<۔e/'HJW\3t' v-`) >Qsi#E[~u7,d=~ `?* >1xV")Xjn gSD|euܰj [һV j,gc4he?7n LniLf3H ٧E4qdl+i<%6=57n+ V5Y.$9REJB:2l&1Jlj|F-M|Iӳn9>Q MbKPS:J&m؆FM>vb3[b?oD_&"žI+uߐ]iL" nMNEyarZ@|bRH>B Q2JO/'ZS,q:9# KUYa &>x#ﵷr浟o:.w#MͶ9f!?ahJ{[1lWeOϙ\.3{fov WeAL"-]âՕixȊ6Kl>h@RBRaW+z|SxBjݰVYaVl;R YUDhcPE(TٷJ~5HbΟkhuT㭒ɺàw8J)V:>uwbX#gǭ,_:2m>y0P3^&vQf8QY' ]eXz(7胨bR'.wI2;tq^;sr+uƏS=GU2<8Ӻi  &4/fl?͊? {;# {׆3UYJK/sy;)yP`HߍijɄfg[-Sy1k8r=lSm44NjF5)jN>E(r9=ό wX ' rTMٰUˋE}ŻCwܴltOvXN.ٚR)ys(2}G->lzfBjܚJ͑7IPa̗5ji倚JȣkHE.v117\@Zy :#KyK1TNw4˹0 ]hK[WT i C3}(bg)bʨ&RohT -%"S%`?,`Dk EICI\'aMV - S'\Gxaa,8o|g/OXPvO?{=V#,jőb^;h{Twy>ݷҘ祓EMw;N}*{>i޲u3^SM ְ{}ѮZt^z^ .kt:Vũb}ת,{^x+{zLYhY@d:u=Nߕ uE;]nz*)6SՃ6euEgPgu~y%uﭛT{[7}߁dc"kӃtJ=@ctWE*MVf7OOE1=M珍qHǭ}SWYx%M=45vyCǏ'ZŰ;$ڄķNwNt1)H^(d=⑼G[bS1tDOĆ/w%*lDhsO} U3%:UBT3teӠs HC?^w녳;LšMxkxCS@ lϠ0Q:zxM3z^aنҦ^: jC%|qƷB-h'Gd0QRSi{'N8˱7&}kPyPS5EmfGf( OM GM$K ]{0<'9PzGbG'h*<@ )f.δ3&򪺊.~iKPB^ E=ڽ875V"\ya `~(myGqviY(+ZVSKB֪)&*Yߘavi/ F^N!*\Wq7Fq ¹#'4/{m>~>_CqsW2NQ~j -fVZ{n桤ob c|GPcG\1=Fa%q.??34?N_q!+>EFz;"/t&_.cIsHثOWk3V7[|4*7gQHi~qК| :bmgkwlW/㩋I Cp}P}GG=raq⨂U #~K XDK<ĭq;g/~Yg]}o+κU:I:DqaJA% '&m.T <71t)`:sJvUG"UP{'HW6xdV{/}[S69_ ð*v3mtU>۳B ?H]_0D sɗT1SUjJJ :E:Fj_zcM]Ix‡TDXP ΄Bjq7+YQ-%WSWBDO"}1p\=+9|8N%:~#`?, >!p&'b\i'spyH4(= P8I:"}+x ^fF\f/Q9p"iD$y79$aęy~ښl!:h_~2q*tDFEֱAicSH߈lQ*t YEcSҨVA*ZMo_Mt|*ZJo_JtRE! 7ވM'cհJyQ&+_EL ~71e# Ouqac&#@TUф!aL:{e~ƥ֔5mx*ҫoڟ9>@AMy( >1cѷoZ+(?bd?U ">ke vJwX3>e$"v ]'K摞, an]ŀ5!sGue%3_Ci(vHq_6z޶>2CIO[ 84؍ I<"*>t,gPVA?+c {H[m">CYd1R}w,hа希>AIr<&b32&[=ƩbyNB,*1T=FqBl{n9|# ڡ3c/?sI!IH0nLDYE< !Ows&X!9ċH7e;x K1 v㈗Csvilp6;3Wא^,ζv=b ,"NȎrO{Ͻ/d]{+@b= JQW (ўi\1ru63Qyc\(ZDaNn0ƺOwhUP:k6q<%5)So16jM;yuǺ3|XFn&YMּxj|OR:\I-K3skMjY'O5fd!_:Db;J[1,He혔{!sVS>{|@G\&-O ַS)֕CrQtxFq *IΧHZ؞(c*z,U8D8,`|KƚZIf`ܛN-FEޞZ) $f=@V2^fYz 9b,orj< j!dTgcAi5UXXM OM\KRuFu(,ϑj{3]k{7yg9&HM 6 W¼eN',cn-"J߸&q,Q7$`2Kev '1OvrdXXoIJ!ȳ"}A!gU ٴh]PðX sb|%&ZBWd2PkLyxG|^'?3,tbZ@ƳDyD8X&! Y1ђu=v qʁVP8<,yc 閩=OWVuB7XeYJZIWQǀB"8քBjjW^ #U,viDNǻC!@ϑ~Y m8^"0Yo _hVoO&%.L? pq1M\ea,ٚIO 7P B3C34RXMݺ:e$34,]!TQKJz ͏@%EsTX(ri*CޝrFqf"PӔ'kKCO,͑Xg v>  g]f=V}Mc}ݧ9gBx oe<8ld|"㔋eId7!3<(j,t%@vh{֍EO$EɌ3UyJi;h膞!ؙ2 *Ę܃f&__Xd4#*g #1օ 2Ae`;_Ps/K({XB ěBb^^iTi}ݷQ9jEN# @C:TV# ".t BdIWaͦat#'>g'KuBmͦS#E,[BaM:=}/s,Us,75[p7tn {3ɘٱ5U+!DD"8f؍ ^@:T_R{4q :׏?v $z=Ggyj@ScyK7LfeβjS*?} CVVV ۊ&gogS$|.ewiz 9 K#~5ңb)ގ%ePha<߷I`3Mu)t6-&aע`v en(8oy#=[S BE;(o+Z5ůngTr9 5ŘD|W0A|t#N0P%ST)yԴP2kH_xτ=R$lme4/tests/0000755000176200001440000000000014176612464012270 5ustar liggesuserslme4/tests/lmer-0.R0000644000176200001440000001177514174542124013513 0ustar liggesusersrequire(lme4) source(system.file("test-tools-1.R", package = "Matrix"))# identical3() etc ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } ## Check that quasi families throw an error assertError(lmer(cbind(incidence, size - incidence) ~ period + (1|herd), data = cbpp, family = quasibinomial)) assertError(lmer(incidence ~ period + (1|herd), data = cbpp, family = quasipoisson)) assertError(lmer(incidence ~ period + (1|herd), data = cbpp, family = quasi)) ## check bug found by Kevin Buhr set.seed(7) n <- 10 X <- data.frame(y=runif(n), x=rnorm(n), z=sample(c("A","B"), n, TRUE)) fm <- lmer(log(y) ~ x | z, data=X) ## ignore grouping factors with ## gave error inside model.frame() stopifnot(all.equal(c(`(Intercept)` = -0.834544), fixef(fm), tolerance=.01)) ## is "Nelder_Mead" default optimizer? isNM <- formals(lmerControl)$optimizer == "Nelder_Mead" isOldB <- formals(lmerControl)$optimizer == "bobyqa" isOldTol <- environment(nloptwrap)$defaultControl$xtol_abs == 1e-6 if (.Platform$OS.type != "windows") withAutoprint({ source(system.file("testdata", "lme-tst-funs.R", package="lme4", mustWork=TRUE))# -> uc() ## check working of Matrix methods on vcov(.) etc ---------------------- fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) V <- vcov(fm) V1 <- vcov(fm1) TOL <- 0 # to show the differences below TOL <- 1e-5 # for the check stopifnot(exprs = { all.equal(diag(V), uc("(Intercept)" = if(isNM) 0.176076 else if(isOldB) 0.176068575 else if (isOldTol) 0.1761714 else 0.1760782 ), tolerance = TOL) # seen 7.8e-8 all.equal(as.numeric(chol(V)), if(isNM) 0.4196165 else if(isOldB) 0.41960526 else if(isOldTol) 0.4197278 else 0.4196167, tolerance=TOL) # 3.2e-8 all.equal(diag(V1), uc(`(Intercept)` = 46.5751, Days = 2.38947), tolerance = 40*TOL)# 5e-7 (for "all" algos) dim(C1 <- chol(V1)) == c(2,2) all.equal(as.numeric(C1), c(6.82377, 0, -0.212575, 1.53127), tolerance=20*TOL)# 1.2e-4 ("all" algos) dim(chol(crossprod(getME(fm1, "Z")))) == 36 }) ## printing signif(chol(crossprod(getME(fm, "Z"))), 5) # -> simple 4 x 4 sparse showProc.time() # ## From: Stephane Laurent ## To: r-sig-mixed-models@.. ## "crash with the latest update of lme4" ## ## .. example for which lmer() crashes with the last update of lme4 ...{R-forge}, ## .. but not with version CRAN version (0.999999-0) lsDat <- data.frame( Operator = as.factor(rep(1:5, c(3,4,8,8,8))), Part = as.factor( c(2L, 3L, 5L, 1L, 1L, 2L, 3L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 5L, 1L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 1L, 2L, 2L, 3L, 3L, 4L, 5L, 5L)), y = c(0.34, -1.23, -2.46, -0.84, -1.57,-0.31, -0.18, -0.94, -0.81, 0.77, 0.4, -2.37, -2.78, 1.29, -0.95, -1.58, -2.06, -3.11,-3.2, -0.1, -0.49,-2.02, -0.75, 1.71, -0.85, -1.19, 0.13, 1.35, 1.92, 1.04, 1.08)) xtabs( ~ Operator + Part, data=lsDat) # --> 4 empty cells, quite a few with only one obs.: ## Part ## Operator 1 2 3 4 5 ## 1 0 1 1 0 1 ## 2 2 1 1 0 0 ## 3 2 2 2 1 1 ## 4 1 1 2 2 2 ## 5 1 2 2 1 2 lsD29 <- lsDat[1:29, ] ## FIXME: rank-Z test should probably not happen in this case: (sm3 <- summary(m3 <- lm(y ~ Part*Operator, data=lsDat)))# ok: some interactions not estimable stopifnot(21 == nrow(coef(sm3)))# 21 *are* estimable sm4 <- summary(m4 <- lm(y ~ Part*Operator, data=lsD29)) stopifnot(20 == nrow(coef(sm4)))# 20 *are* estimable lf <- lFormula(y ~ (1|Part) + (1|Operator) + (1|Part:Operator), data = lsDat) dim(Zt <- lf$reTrms$Zt)## 31 x 31 c(rankMatrix(Zt)) ## 21 c(rankMatrix(Zt,method="qr")) ## 31 || 29 (64 bit Lnx), then 21 (!) c(rankMatrix(t(Zt),method="qr")) ## 30, then 21 ! nrow(lsDat) fm3 <- lmer(y ~ (1|Part) + (1|Operator) + (1|Part:Operator), data = lsDat, control=lmerControl(check.nobs.vs.rankZ="warningSmall")) lf29 <- lFormula(y ~ (1|Part) + (1|Operator) + (1|Part:Operator), data = lsD29) (fm4 <- update(fm3, data=lsD29)) fm4. <- update(fm4, REML=FALSE, control=lmerControl(optimizer="nloptwrap", optCtrl=list(ftol_abs=1e-6, xtol_abs=1e-6))) ## summary(fm4.) stopifnot( all.equal(as.numeric(formatVC(VarCorr(fm4.), digits = 7)[,"Std.Dev."]), c(1.040664, 0.6359187, 0.5291422, 0.4824796), tol = 1e-4) ) showProc.time() }) ## skip on windows (for speed) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' lme4/tests/methods.R0000644000176200001440000000166514063503234014053 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) library(testthat) fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) expect_equal(colnames(model.frame(fm1)),c("Reaction","Days","Subject")) expect_equal(colnames(model.frame(fm1,fixed.only=TRUE)),c("Reaction","Days")) expect_equal(formula(fm1),Reaction ~ Days + (Days | Subject)) expect_equal(formula(fm1,fixed.only=TRUE),Reaction ~ Days) ## ugly example: model frame with compound elements fm2 <- lmer(log(Reaction) ~ splines::ns(Days,3) + + I(1+Days^3) + (Days|Subject), sleepstudy) expect_equal(names(model.frame(fm2)), c("log(Reaction)", "splines::ns(Days, 3)", "I(1 + Days^3)", "Days", "Subject")) expect_equal(names(model.frame(fm2,fixed.only=TRUE)), c("log(Reaction)", "splines::ns(Days, 3)", "I(1 + Days^3)")) } ## skip on windows (for speed) lme4/tests/predsim.R0000644000176200001440000000460014063503234014043 0ustar liggesusers## compare range, average, etc. of simulations to ## conditional and unconditional prediction library(lme4) do.plot <- FALSE if (.Platform$OS.type != "windows") { ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } fm1 <- lmer(Reaction~Days+(1|Subject),sleepstudy) set.seed(101) pp <- predict(fm1) rr <- range(usim2 <- simulate(fm1,1,use.u=TRUE)[[1]]) stopifnot(all.equal(rr,c(159.3896,439.1616),tolerance=1e-6)) if (do.plot) { plot(pp,ylim=rr) lines(sleepstudy$Reaction) points(simulate(fm1,1)[[1]],col=4) points(usim2,col=2) } set.seed(101) ## conditional prediction ss <- simulate(fm1,1000,use.u=TRUE) ss_sum <- t(apply(ss,1,quantile,c(0.025,0.5,0.975))) plot(pp) matlines(ss_sum,col=c(1,2,1),lty=c(2,1,2)) stopifnot(all.equal(ss_sum[,2],pp,tolerance=5e-3)) ## population-level prediction pp2 <- predict(fm1,ReForm=NA) ss2 <- simulate(fm1,1000,use.u=FALSE) ss_sum2 <- t(apply(ss2,1,quantile,c(0.025,0.5,0.975))) if (do.plot) { plot(pp2,ylim=c(200,400)) matlines(ss_sum2,col=c(1,2,1),lty=c(2,1,2)) } stopifnot(all.equal(ss_sum2[,2],pp2,tolerance=8e-3)) ## predict(...,newdata=...) on models with derived variables in the random effects ## e.g. (f:g, f/g) set.seed(101) d <- expand.grid(f=factor(letters[1:10]),g=factor(letters[1:10]), rep=1:10) d$y <- rnorm(nrow(d)) m1 <- lmer(y~(1|f:g),d) p1A <- predict(m1) p1B <- predict(m1,newdata=d) stopifnot(all.equal(p1A,p1B)) m2 <- lmer(y~(1|f/g),d) p2A <- predict(m2) p2B <- predict(m2,newdata=d) stopifnot(all.equal(p2A,p2B)) ## with numeric grouping variables dn <- transform(d,f=as.numeric(f),g=as.numeric(g)) m1N <- update(m1,data=dn) p1NA <- predict(m1N) p1NB <- predict(m1N,newdata=dn) stopifnot(all.equal(p1NA,p1NB)) ## simulate with modified parameters set.seed(1) s1 <- simulate(fm1) set.seed(1) s2 <- simulate(fm1,newdata=model.frame(fm1), newparams=getME(fm1,c("theta","beta","sigma"))) all.equal(s1,s2) fm0 <- update(fm1,.~.-Days) ## ## sim() -> simulate() -> refit() -> deviance ## ## predictions and simulations with offsets set.seed(101) d <- data.frame(y=rpois(100,5),x=rlnorm(100,1,1), f=factor(sample(10,size=100,replace=TRUE))) gm1 <- glmer(y~offset(log(x))+(1|f),data=d, family=poisson) s1 <- simulate(gm1) } ## skip on windows (for speed) lme4/tests/ST.R0000644000176200001440000000067613751775607012761 0ustar liggesusersrequire(lme4) # sorry for fitting yet another sleepstudy model in the tests m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) ST <- getME(m, "ST")$Subject # copied from vince dorie's simmer.R in arm: dimension <- nrow(ST) T <- ST diag(T) <- rep(1, dimension) S <- diag(diag(ST), dimension) vc0 <- getME(m, 'sigma')^2*tcrossprod(T %*% S) vc1 <- VarCorr(m)$Subject[,] dimnames(vc0) <- dimnames(vc1) all.equal(vc0, vc1, tolerance = 1e-6) lme4/tests/README0000644000176200001440000000125513751775607013162 0ustar liggesusersCatalog of currently-failing examples (commented out, testsx, etc.): glmmExt.R: "fail for MM" on Gaussian/inverse examples -- seems fine for me lmer-0.R: sstudy9 example. Should *not* work; is a meaningful error message possible? prLogistic.R: Thailand/clustered-data example from ?prLogisticDelta example in prLogistic package Presumably the problem is that 100/411 random-effect levels have only zeros -- but should this mess things up? glmmML and lme4.0 give nearly identical answers profile.R: fails on CBPP profiling from testsx: testcolonizer: definite case where complete separation occurs, GLM does not really give a fit testcrabs: ?? not sure ?? lme4/tests/varcorr.R0000644000176200001440000000113614063503234014057 0ustar liggesuserslibrary(lme4) if (.Platform$OS.type != "windows") { data(Orthodont, package="nlme") fm1 <- lmer(distance ~ age + (age|Subject), data = Orthodont) VarCorr(fm1) fm2ML <- lmer(diameter ~ 1 + (1|plate) + (1|sample), Penicillin, REML=0) VarCorr(fm2ML) gm1 <- glmer(cbind(incidence,size-incidence) ~ period + (1|herd),data=cbpp, family=binomial) VarCorr(gm1) cbpp$obs <- factor(seq(nrow(cbpp))) gm2 <- update(gm1,.~.+(1|obs)) VarCorr(gm2) if (FALSE) { ## testing lme4/lme4 incompatibility ## library(lme4) VarCorr(fm1) lme4:::VarCorr.merMod(fm1) ## OK } } ## skip on windows (for speed) lme4/tests/glmmWeights.R0000644000176200001440000000741614063503234014677 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) library(testthat) source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##-> gSim(), a general simulation function ... ## hand-coded Pearson residuals {for sumFun() } mypresid <- function(x) { mu <- fitted(x) (getME(x,"y") - mu) * sqrt(weights(x)) / sqrt(x@resp$family$variance(mu)) } ## should be equal (up to numerical error) to weights(.,type="working") workingWeights <- function(mod) mod@resp$weights*(mod@resp$muEta()^2)/mod@resp$variance() ##' Sum of weighted residuals, 4 ways; the last three are identical sumFun <- function(m) { wrss1 <- m@devcomp$cmp["wrss"] wrss2 <- sum(residuals(m,type="pearson")^2) wrss3 <- sum(m@resp$wtres^2) ## compare to hand-fitted Pearson resids ... wrss4 <- sum(mypresid(m)^2) c(wrss1,wrss2,wrss3,wrss4) } ## The relative "error"/differences of the weights w[] entries rel.diff <- function(w) abs(1 - w[-1]/w[1]) set.seed(101) ## GAMMA g0 <- glmer(y~x+(1|block),data=gSim(),family=Gamma) expect_true(all(rel.diff(sumFun(g0)) < 1e-13)) expect_equal(weights(g0, type = "working"), workingWeights(g0), tolerance = 1e-4) ## FIXME: why is such a high tolerance required? ## BERNOULLI g1 <- glmer(y~x+(1|block),data=gSim(family=binomial(),nbinom=1), family=binomial) expect_true(all(rel.diff(sumFun(g1)) < 1e-13)) expect_equal(weights(g1, type = "working"), workingWeights(g1), tolerance = 1e-5) ## FIXME: why is such a high tolerance required? ## POISSON (n <- nrow(d.P <- gSim(family=poisson()))) g2 <- glmer(y ~ x + (1|block), data = d.P, family=poisson) g2W <- glmer(y ~ x + (1|block), data = d.P, family=poisson, weights = rep(2,n)) expect_true(all(rel.diff(sumFun(g2 )) < 1e-13)) expect_true(all(rel.diff(sumFun(g2W)) < 1e-13)) ## correct expect_equal(weights(g2, type = "working"), workingWeights(g2), tolerance = 1e-5) ## FIXME: why is such a high tolerance required? expect_equal(weights(g2W, type = "working"), workingWeights(g2W), tolerance = 1e-5) ## FIXME: why is such a high tolerance required? ## non-Bernoulli BINOMIAL g3 <- glmer(y ~ x + (1|block), data= gSim(family=binomial(), nbinom=10), family=binomial) expect_true(all(rel.diff(sumFun(g3)) < 1e-13)) expect_equal(weights(g3, type = "working"), workingWeights(g3), tolerance = 1e-4) ## FIXME: why is such a high tolerance required? d.b.2 <- gSim(nperblk = 2, family=binomial()) g.b.2 <- glmer(y ~ x + (1|block), data=d.b.2, family=binomial) expect_true(all(rel.diff(sumFun(g.b.2 )) < 1e-13)) ## Many blocks of only 2 observations each - (but nicely balanced) ## Want this "as" https://github.com/lme4/lme4/issues/47 ## (but it "FAILS" survival already): ## ## n2 = n/2 : n2 <- 2048 if(FALSE) n2 <- 100 # for building/testing set.seed(47) dB2 <- gSim(n2, nperblk = 2, x= rep(0:1, each= n2), family=binomial()) ## -- -- --- -------- gB2 <- glmer(y ~ x + (1|block), data=dB2, family=binomial) expect_true(all(rel.diff(sumFun(gB2)) < 1e-13)) ## NB: Finite sample bias of \hat\sigma_1 and \hat\beta_1 ("Intercept") ## tend to zero only slowly for n2 -> Inf, e.g., for ## n2 = 2048, b1 ~= 4.3 (instead of 4); s1 ~= 1.3 (instead of 1) ## FAILS ----- ## library(survival) ## (gSurv.B2 <- clogit(y ~ x + strata(block), data=dB2)) ## ## --> Error in Surv(rep(1, 200L), y) : Time and status are different lengths ## summary(gSurv.B2) ## (SE.surf <- sqrt(diag(vcov(gSurv.B2)))) g3 <- glmer(y ~ x + (1|block),data=gSim(family=binomial(),nbinom=10), family=binomial) expect_equal(var(sumFun(g3)),0) ## check dispersion parameter ## (lowered tolerance to pass checks on my machine -- SCW) expect_equal(sigma(g0)^2, 0.4888248, tolerance=1e-4) } ## skip on windows (for speed) lme4/tests/evalCall.R0000644000176200001440000000073214063503234014125 0ustar liggesusersif (.Platform$OS.type != "windows") { ## see if we can still run lme4 functions when lme4 is not attached if ("package:lme4" %in% search()) detach("package:lme4") data(sleepstudy,package="lme4") data(cbpp,package="lme4") fm1 <- lme4::lmer(Reaction ~ Days + (Days|Subject), sleepstudy) gm1 <- lme4::glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) } ## skip on windows (for speed) lme4/tests/confint.R0000644000176200001440000000272014063503234014041 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type!="windows") { library("lme4") library("testthat") L <- load(system.file("testdata", "lme-tst-fits.rda", package="lme4", mustWork=TRUE)) fm1 <- fit_sleepstudy_2 c0 <- confint(fm1, method="Wald") c0B <- confint(fm1, method="Wald",parm="Days") expect_equal(c0["Days",],c0B["Days",]) expect_equal(c(c0B),c(7.437592,13.496980),tolerance=1e-6) set.seed(101) for (bt in c("norm","basic", "perc")) { suppressWarnings( confint(fm1, method="boot", boot.type=bt, nsim=10,quiet=TRUE)) } for (bt in c("stud","bca","junk")) { expect_error(confint(fm1, method="boot", boot.type=bt, nsim=10), "should be one of") } if((testLevel <- lme4:::testLevel()) > 1) { c1 <- confint(fm1,method="profile",parm=5:6) expect_equal(c0[5:6,],c1,tolerance=2e-3) ## expect Wald and profile _reasonably_ close print(c1,digits=3) c2 <- confint(fm1,method="boot",nsim=50,parm=5:6) ## expect_error(confint(fm1,method="boot",nsim=50,parm="Days"), ## "must be specified as an integer") expect_equal(c1,c2,tolerance=2e-2) print(c2,digits=3) } if (testLevel > 10) { print(c1B <- confint(fm1, method="profile")) print(c2B <- confint(fm1, method="boot")) expect_equal(unname(c1B), unname(c2B), tolerance=2e-2) } } ## skip if windows/testLevel<1 lme4/tests/predict_basis.R0000644000176200001440000000303313751775607015234 0ustar liggesusers## test for models containing data-defined bases ## ?makepredictcall ## ?model.frame ## ???? data(sleepstudy,package="lme4") library(splines) ## lm0 <- lm(Reaction~ns(Days,2),sleepstudy) ## attr(terms(lm0),"predvars") ## library(nlme) ## lme1 <- lme(Reaction~ns(Days,2),random=~1|Subject,sleepstudy) ## attr(terms(lme1),"predvars") ## no! ## attr(lme1$terms,"predvars") ## yes ## detach("package:nlme") library(lme4) fm1 <- lmer(Reaction ~ ns(Days,2) + (1|Subject), sleepstudy) fm2 <- lmer(Reaction ~ poly(Days,2) + (1|Subject), sleepstudy) fm3 <- lmer(Reaction ~ poly(Days,2,raw=TRUE) + (1|Subject), sleepstudy) newdat0 <- data.frame(Days = unique(sleepstudy$Days)) newdat <- data.frame(Days = 5:12) tmpf <- function(fit) { with(sleepstudy, { plot (Reaction~Days, xlim=c(0,12)) points(Days, predict(fit), col=2) }) lines(newdat0$ Days, predict(fit,ReForm=NA,newdata=newdat0), col=4) lines(newdat $ Days, predict(fit,ReForm=NA,newdata=newdat ), col=5) } stopifnot(all.equal(predict(fm2,newdat,ReForm=NA), predict(fm3,newdat,ReForm=NA))) ## pictures tmpf(fm1) tmpf(fm2) tmpf(fm3) ## test for GLMMs set.seed(101) d <- data.frame(y=rbinom(10,size=1,prob=0.5), x=1:10, f=factor(rep(1:5,each=2))) gm1 <- glmer(y ~ poly(x,2) + (1|f), d, family=binomial) gm2 <- glmer(y ~ poly(x,2,raw=TRUE) + (1|f), d, family=binomial) newdat <- data.frame(x=c(1,4,6)) stopifnot(all.equal(predict(gm1,newdat,ReForm=NA), predict(gm2,newdat,ReForm=NA),tolerance=3e-6)) lme4/tests/nlmer.R0000644000176200001440000000447014063503234013522 0ustar liggesuserslibrary(lme4) allEQ <- function(x,y, tolerance = 4e-4, ...) all.equal.numeric(x,y, tolerance=tolerance, ...) (nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ (Asym|Tree), Orange, start = c(Asym = 200, xmid = 725, scal = 350))) fixef(nm1) if (lme4:::testLevel() > 2) { ## 'Theoph' Data modeling Th.start <- c(lKe = -2.5, lKa = 0.5, lCl = -3) system.time(nm2 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKe+lKa+lCl|Subject), Theoph, start = Th.start, control=nlmerControl(tolPwrss=1e-8))) print(nm2, corr=FALSE) system.time(nm3 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKe|Subject) + (lKa|Subject) + (lCl|Subject), Theoph, start = Th.start)) print(nm3, corr=FALSE) ## dropping lKe from random effects: system.time(nm4 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKa+lCl|Subject), Theoph, start = Th.start, control=nlmerControl(tolPwrss=1e-8))) print(nm4, corr=FALSE) system.time(nm5 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKa|Subject) + (lCl|Subject), Theoph, start = Th.start, control=nlmerControl(tolPwrss=1e-8))) print(nm5, corr=FALSE) if (require("PKPDmodels")) { oral1cptSdlkalVlCl <- PKmod("oral", "sd", list(ka ~ exp(lka), Cl ~ exp(lCl), V ~ exp(lV))) if (FALSE) { ## FIXME: Error in get(nm, envir = nlenv) : object 'k' not found ## probably with environments/call stack etc.? ## 'pnames' is c("lV","lka","k") -- not ("lV","lka","lCl") ## nlmer -> nlformula -> MkRespMod ## pnames are OK in nlformula, but in MkRespMod we try to recover ## them from the column names of the gradient attribute of the ## model evaluated in nlenv -- which are wrong. system.time(nm2a <- nlmer(conc ~ oral1cptSdlkalVlCl(Dose, Time, lV, lka, lCl) ~ (lV+lka+lCl|Subject), Theoph, start = c(lV=-1, lka=-0.5, lCl=-3), tolPwrss=1e-8)) print(nm2a, corr=FALSE) } } } ## testLevel > 2 lme4/tests/nlmer.Rout.save0000644000176200001440000000730614063503234015210 0ustar liggesusers R Under development (unstable) (2020-08-25 r79080) -- "Unsuffered Consequences" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(lme4) Loading required package: Matrix > > allEQ <- function(x,y, tolerance = 4e-4, ...) + all.equal.numeric(x,y, tolerance=tolerance, ...) > > (nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ (Asym|Tree), + Orange, start = c(Asym = 200, xmid = 725, scal = 350))) Nonlinear mixed model fit by maximum likelihood ['nlmerMod'] Formula: circumference ~ SSlogis(age, Asym, xmid, scal) ~ (Asym | Tree) Data: Orange AIC BIC logLik deviance df.resid 273.1438 280.9205 -131.5719 263.1438 30 Random effects: Groups Name Std.Dev. Tree Asym 31.646 Residual 7.843 Number of obs: 35, groups: Tree, 5 Fixed Effects: Asym xmid scal 192.1 727.9 348.1 > fixef(nm1) Asym xmid scal 192.0528 727.9045 348.0721 > > if (lme4:::testLevel() > 2) { + ## 'Theoph' Data modeling + Th.start <- c(lKe = -2.5, lKa = 0.5, lCl = -3) + + system.time(nm2 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ + (lKe+lKa+lCl|Subject), + Theoph, start = Th.start, + control=nlmerControl(tolPwrss=1e-8))) + print(nm2, corr=FALSE) + + system.time(nm3 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ + (lKe|Subject) + (lKa|Subject) + (lCl|Subject), + Theoph, start = Th.start)) + print(nm3, corr=FALSE) + + ## dropping lKe from random effects: + system.time(nm4 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKa+lCl|Subject), + Theoph, start = Th.start, + control=nlmerControl(tolPwrss=1e-8))) + print(nm4, corr=FALSE) + + system.time(nm5 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ + (lKa|Subject) + (lCl|Subject), + Theoph, + start = Th.start, + control=nlmerControl(tolPwrss=1e-8))) + print(nm5, corr=FALSE) + + if (require("PKPDmodels")) { + oral1cptSdlkalVlCl <- + PKmod("oral", "sd", list(ka ~ exp(lka), Cl ~ exp(lCl), V ~ exp(lV))) + if (FALSE) { + ## FIXME: Error in get(nm, envir = nlenv) : object 'k' not found + ## probably with environments/call stack etc.? + ## 'pnames' is c("lV","lka","k") -- not ("lV","lka","lCl") + ## nlmer -> nlformula -> MkRespMod + ## pnames are OK in nlformula, but in MkRespMod we try to recover + ## them from the column names of the gradient attribute of the + ## model evaluated in nlenv -- which are wrong. + system.time(nm2a <- nlmer(conc ~ oral1cptSdlkalVlCl(Dose, Time, lV, lka, lCl) ~ + (lV+lka+lCl|Subject), + Theoph, start = c(lV=-1, lka=-0.5, lCl=-3), tolPwrss=1e-8)) + print(nm2a, corr=FALSE) + } + } + } ## testLevel > 2 > > proc.time() user system elapsed 1.232 0.067 1.270 lme4/tests/glmmExt.R0000644000176200001440000001174714063503234014027 0ustar liggesusers## Tests of a variety of GLMM families and links ## coding: family {g=Gamma, P=Poisson, G=Gaussian, B=binomial} ## link {l=log, i=inverse, c=cloglog, i=identity} ## model {1 = intercept-only, 2 = with continuous predictor} library("lme4") source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##-> gSim(), a general simulation function ... str(gSim) ## function (nblk = 26, nperblk = 100, sigma = 1, beta = c(4, 3), ## x = runif(n), shape = 2, nbinom = 10, family = Gamma()) if (.Platform$OS.type != "windows") { set.seed(101) ## Gamma, inverse link (= default) : d <- gSim() ## Gamma, log link eta = log(mu) : dgl <- gSim(dInitial = d, family = Gamma(link = log)) ## Poisson, log link dP <- gSim(dInitial = d, family = poisson()) ## Gaussian, log link --- need to use a non-identity link, otherwise glmer calls lmer dG <- gSim(dInitial = d, family = gaussian(link = log), sd = 2) ## Gaussian with inverse link : (sd small enough to avoid negative values) : dGi <- gSim(dInitial = d, family = gaussian(link = inverse), sd = 0.01) ## binomial with cloglog link dBc <- d dBc$eta <- d$eta - 5 # <==> beta intercept 5 less: otherwise y will be constant dBc <- gSim(dInitial = dBc, ## beta = c(-1, 3), nbinom = 1, family = binomial(link="cloglog")) ## binomial with identity link dBi <- d dBc$eta <- d$eta / 10 # <==> beta slope / 10 : scale so range goes from 0.2-0.8 dBi <- gSim(dInitial = dBc, ## beta = c(4, 3/10), nbinom = 1, family = binomial(link="identity")) ############ ## Gamma/inverse ## GLMs gm0 <- glm(y ~ 1, data=d, family=Gamma) gm1 <- glm(y ~ block-1, data=d, family=Gamma) stopifnot(all.equal(sd(coef(gm1)),1.00753942148611)) gm2 <- glmer(y ~ 1 + (1|block), d, Gamma, nAGQ=0) gm3 <- glmer(y ~ x + (1|block), d, Gamma, nAGQ=0) gm2B <- glmer(y ~ 1 + (1|block), d, Gamma) gm3B <- glmer(y ~ x + (1|block), d, Gamma) ## y ~ x + (1|block), Gamma is TRUE model summary(gm3) summary(gm3B)# should be better ## Both have "correct" beta ~= (4, 3) -- but *too* small (sigma_B, sigma) !! stopifnot(exprs = { all.equal(fixef(gm3 ), c(`(Intercept)` = 4.07253, x = 3.080585), tol = 1e-5) # 1.21e-7 all.equal(fixef(gm3B), c(`(Intercept)` = 4.159398, x = 3.058521),tol = 1e-5) # 1.13e-7 }) VarCorr(gm3) # both variances / std.dev. should be ~ 1 but are too small ## ## library(hglm) ## h1 <- hglm2(y~x+(1|block), data=d, family=Gamma()) ## lme4.0 fails on all of these ... ## Gamma/log ggl1 <- glmer(y ~ 1 + (1|block), data=dgl, family=Gamma(link="log")) ggl2 <- glmer(y ~ x + (1|block), data=dgl, family=Gamma(link="log"))# true model (h.1.2 <- anova(ggl1, ggl2)) stopifnot( all.equal(unlist(h.1.2[2,]), c(npar = 4, AIC = 34216.014, BIC = 34239.467, logLik = -17104.007, deviance = 34208.014, Chisq = 2458.5792, Df = 1, `Pr(>Chisq)` = 0)) ) ## "true" model : summary(ggl2) VarCorr(ggl2) ## ## library(lme4.0) ## ggl1 <- glmer(y ~ 1 + (1|block), data=dgl, family=Gamma(link="log"), verbose= 2) ## fails ## Poisson/log gP1 <- glmer(y ~ 1 + (1|block), data=dP, family=poisson) gP2 <- glmer(y ~ x + (1|block), data=dP, family=poisson) ## Gaussian/log gG1 <- glmer(y ~ 1 + (1|block), data=dG, family=gaussian(link="log")) gG2 <- glmer(y ~ x + (1|block), data=dG, family=gaussian(link="log")) ## works with lme4.0 but AIC/BIC/logLik are crazy, and scale ## parameter is not reported ## glmmML etc. doesn't allow models with scale parameters ## gG1B <- glmmadmb(y ~ 1 + (1|block), data=dG, ## family="gaussian",link="log",verbose=TRUE) ## what is the best guess at the estimate of the scale parameter? ## is it the same as sigma? ## gG1B$alpha ## if(Sys.info()["user"] != "maechler") { # <- seg.faults (MM) ## Gaussian/inverse gGi1 <- glmer(y ~ 1 + (1|block), data=dGi, family=gaussian(link="inverse")) gGi2 <- glmer(y ~ x + (1|block), data=dGi, family=gaussian(link="inverse")) ## Binomial/cloglog gBc1 <- glmer(y ~ 1 + (1|block), data=dBc, family=binomial(link="cloglog")) gBc2 <- glmer(y ~ x + (1|block), data=dBc, family=binomial(link="cloglog")) ## library("glmmADMB") ## glmmadmbfit <- glmmadmb(y ~ x + (1|block), data=dBc, ## family="binomial",link="cloglog") glmmadmbfit <- list(fixef = c("(Intercept)" = -0.717146132730349, x =2.83642900561633), VarCorr = structure(list( block = structure(0.79992, .Dim = c(1L, 1L), .Dimnames = list("(Intercept)", "(Intercept)"))), class = "VarCorr")) stopifnot(all.equal(fixef(gBc2), glmmadmbfit$fixef, tolerance=5e-3)) ## pretty loose tolerance ... stopifnot(all.equal(unname(unlist(VarCorr(gBc2))), c(glmmadmbfit$VarCorr$block), tolerance=2e-2)) gBi1 <- glmer(y ~ 1 + (1|block), data=dBi, family=binomial(link="identity")) gBi2 <- glmer(y ~ x + (1|block), data=dBi, family=binomial(link="identity")) ## FIXME: should test more of the *results* of these efforts, not ## just that they run without crashing ... } ## skip on windows (for speed) lme4/tests/testOptControl.R0000644000176200001440000000327213751775607015431 0ustar liggesusers## https://github.com/lme4/lme4/issues/59 library(lme4) dat <- read.csv(system.file("testdata","dat20101314.csv",package="lme4")) NMcopy <- lme4:::Nelder_Mead cc <- capture.output(lmer(y ~ (1|Operator)+(1|Part)+(1|Part:Operator), data=dat, control= lmerControl("NMcopy", optCtrl= list(iprint=20)))) ## check that printing goes through step 140 twice and up to 240 once ## findStep <- function(str,n) sum(grepl(paste0("\\(NM\\) ",n,": "),str)) cc <- paste(cc,collapse="") countStep <- function(str,n) { length(gregexpr(paste0("\\(NM\\) ",n,": "),str)[[1]]) } stopifnot(countStep(cc,140)==2 && countStep(cc,240)==1) ## testStr <- ## "(NM) 20: f = -53.3709 at 0.706667 0.813333 1.46444(NM) 40: f = -147.132 at 0 0 19.18(NM) 60: f = -147.159 at 0 0 17.4275(NM) 80: f = -147.159 at 0 0 17.5615(NM) 100: f = -147.159 at 0 0 17.5754(NM) 120: f = -147.159 at 0 0 17.5769(NM) 140: f = -147.159 at 0 0 17.5768(NM) 20: f = -165.55 at 0.0933333 0.573333 17.3168(NM) 40: f = -173.704 at 0.23799 1.4697 16.9728(NM) 60: f = -173.849 at 0.449634 1.39998 16.9452(NM) 80: f = -174.421 at 0.52329 1.69123 18.1534(NM) 100: f = -176.747 at 0.762043 1.88271 32.8993(NM) 120: f = -176.839 at 0.751206 1.75371 37.2128(NM) 140: f = -176.853 at 0.706425 1.7307 35.7528(NM) 160: f = -176.853 at 0.710803 1.73476 35.7032(NM) 180: f = -176.853 at 0.710159 1.73449 35.6699(NM) 200: f = -176.853 at 0.710271 1.73461 35.6689(NM) 220: f = -176.853 at 0.710259 1.7346 35.6684(NM) 240: f = -176.853 at 0.710257 1.73459 35.6685Linear mixed model fit by REML ['lmerMod']" lme4/tests/modFormula.R0000644000176200001440000000501114063503234014502 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) library(testthat) .get.checkingOpts <- lme4:::.get.checkingOpts stopifnot(identical( .get.checkingOpts( c("CheckMe", "check.foo", "check.conv.1", "check.rankZ", "check.rankX")) , c("check.foo", "check.rankZ"))) lmod <- lFormula(Reaction ~ Days + (Days|Subject), sleepstudy) devfun <- do.call(mkLmerDevfun, lmod) opt <- optimizeLmer(devfun) cc <- lme4:::checkConv(attr(opt,"derivs"), opt$par, ctrl = lmerControl()$checkConv, lbound=environment(devfun)$lower) fm1 <- mkMerMod(environment(devfun), opt, lmod$reTrms, fr = lmod$fr, lme4conv=cc) fm2 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ## basic equivalence fm1C <- fm1 fm1C@call <- fm2@call expect_equal(fm2,fm1C) expect_equal(range(residuals(fm1)), c(-101.18, 132.547), tolerance = 1e-5) # these are "outliers"! expect_is(model.frame(fm1),"data.frame") ## formulae mfm1 <- model.frame(fm1) expect_equal(formula(fm1), Reaction ~ Days + (Days | Subject)) expect_equal(formula(terms(mfm1)), Reaction ~ Days + (Days + Subject)) new_form_modframe <- (getRversion() >= "3.6.0" && as.numeric(version[["svn rev"]]) >= 75891) expect_equal(formula(mfm1), if(new_form_modframe) { Reaction ~ Days + (Days + Subject) } else Reaction ~ Days + Subject ) ## predictions expect_equal(predict(fm1,newdata=sleepstudy[1:10,],re.form=NULL), predict(fm2,newdata=sleepstudy[1:10,],re.form=NULL)) expect_equal(predict(fm1,newdata=sleepstudy), predict(fm1)) lmodOff <- lFormula(Reaction ~ Days + (Days|Subject) + offset(0.5*Days), sleepstudy) devfunOff <- do.call(mkLmerDevfun, lmodOff) opt <- optimizeLmer(devfunOff) fm1Off <- mkMerMod(environment(devfunOff), opt, lmodOff$reTrms, fr = lmodOff$fr) fm2Off <- lmer(Reaction ~ Days + (Days|Subject) + offset(0.5*Days), sleepstudy) expect_equal(predict(fm1Off,newdata=sleepstudy[1:10,],re.form=NULL), predict(fm2Off,newdata=sleepstudy[1:10,],re.form=NULL)) ## FIXME: need more torture tests with offset specified, in different environments ... ## FIXME: drop1(.) doesn't work with modular objects ... hard to see how it ## could, though ... ## drop1(fm1Off) drop1(fm2Off) } ## skip on windows (for speed) lme4/tests/resids.R0000644000176200001440000000115113751775607013711 0ustar liggesuserslibrary(lme4) ## raw residuals for LMMs fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) stopifnot(all.equal(residuals(fm1),sleepstudy$Reaction-fitted(fm1))) r1 <- residuals(fm1,type="pearson") ## deviance/Pearson residuals for GLMMs gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp) p <- fitted(gm1) n <- cbpp$size v <- n*p*(1-p) obs_p <- cbpp$incidence/cbpp$size rp <- residuals(gm1,"pearson") rp1 <- (obs_p-p)/sqrt(p*(1-p)) rp2 <- rp1*n ## FIXME:: restore this test ## stopifnot(all.equal(rp,rp2)) r2 <- residuals(gm1,type="deviance") lme4/tests/drop1contrasts.R0000644000176200001440000000142514063503234015370 0ustar liggesusers## drop1 may not work right with contrasts: make up an example something like this ... ## options(contrasts=c("contr.sum","contr.poly")) ## drop1(fecpoiss_lm3,test="Chisq",scope=.~.) if (.Platform$OS.type != "windows") { library(lme4) oldopts <- options(contrasts=c("contr.sum","contr.poly")) fm1 <- lmer(Reaction~Days+(Days|Subject),data=sleepstudy) drop1(fm1,test="Chisq") ## debug(lme4:::drop1.merMod) drop1(fm1,test="Chisq",scope=.~.) fm0 <- lm(Reaction~Days+Subject,data=sleepstudy) drop1(fm0,test="Chisq",scope=.~.) options(oldopts) ## restore original contrasts ff <- function() { lmer(Reaction~Days+(Days|Subject),data=sleepstudy) } drop1(ff()) ## OK because sleepstudy is accessible! } ## skip on windows (for speed) lme4/tests/testthat/0000755000176200001440000000000014176366175014135 5ustar liggesuserslme4/tests/testthat/test-simulate_formula.R0000644000176200001440000000471714063503234020576 0ustar liggesuserslibrary("testthat") library("lme4") quietly <- TRUE ## factory for making methods mk_method <- function(class, print_dims=FALSE) { method <- sprintf("simulate.formula_lhs_%s",class) sim_generic <- function(object, nsim=1, seed=NULL, ...) { if (!quietly) message(sprintf("%s called",method)) if (!quietly) cat(".Basis from attributes:\n") if (!quietly) print(attr(object,".Basis")) # NULL if (print_dims) { if (!quietly) print(dim(attr(object,".Basis"))) } return(attr(object,".Basis")) } assign(method,sim_generic,.GlobalEnv) invisible(NULL) } ## (**) these methods should (??) _mask_ package versions ... ## works in source(), not in devtools::test() ... mk_method("NULL") mk_method("numeric") mk_method("array",print_dims=TRUE) mk_method("") test_that("simple numerics", { ## expect_equal(simulate(1~.),1) ## FIXME re-enable if we resolve (**) above ## One-sided formula is not the same as an LHS that evaluates to NULL: expect_equal(simulate(NULL~.),NULL) }) test_that("raw formulas", { expect_error(suppressWarnings(simulate(x~.)), "Error evaluating") }) simulate.formula_lhs_character <- function(object, nsim=1, seed=NULL, ...) { if (!quietly) message("simulate.formula_lhs_character() called.") if (!quietly) print(ls(all.names=TRUE)) NextMethod() # Calls simulate.formula(), resulting in an infinite recursion. } test_that("prevent recursion", { expect_error(simulate("a"~.), "No applicable method") }) dd <- expand.grid(A=factor(1:3),B=factor(1:10),rep=1:10) test_that("two-sided formula warning", { expect_error(suppressMessages(simulate(.~1 + (A|B), newdata=dd, newparams=list(beta=1,theta=rep(1,6), sigma=1), family=gaussian, seed=101))[[1]], "object '.' not found") }) ## cleanup ## I can't figure out what environments these things actually live in so I'm going to ## give up and try() to remove them ... ## rmx <- function(s) if (exists(s, parent.frame())) rm(list=s, envir=parent.frame()) ## rmx("simulate.formula_lhs_character") ## rmx("simulate.formula_lhs_") ## rmx("simulate.formula_lhs_numeric") suppressWarnings(try(rm(list = c("simulate.formula_lhs_", "simulate.formula_lhs_numeric")),silent=TRUE)) lme4/tests/testthat/test-lmer.R0000644000176200001440000004340214063503234016157 0ustar liggesusersstopifnot(require("testthat"), require("lme4")) ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } context("fitting lmer models") ## is "Nelder_Mead" default optimizer? -- no longer (isNM <- formals(lmerControl)$optimizer == "Nelder_Mead") test_that("lmer", { set.seed(101) d <- data.frame(z=rnorm(200), f=factor(sample(1:10,200, replace=TRUE))) ## Using 'method=*' defunct in 2019-05 (after 6 years of deprecation) ## expect_warning(lmer(z~ 1|f, d, method="abc"),"Use the REML argument") ## expect_warning(lmer(z~ 1|f, d, method="Laplace"),"Use the REML argument") ##sp No '...' anymore ##sp expect_warning(lmer(z~ 1|f, d, sparseX=TRUE),"has no effect at present") expect_error(lmer(z~ 1|f, ddd), "bad 'data': object 'ddd' not found") expect_error(lmer(z~ 1|f), "object 'z' not found") expect_error(lmer(z~ 1|f, d[,1:1000]), "bad 'data': undefined columns selected") expect_is(fm1 <- lmer(Yield ~ 1|Batch, Dyestuff), "lmerMod") expect_is(fm1_noCD <- update(fm1,control=lmerControl(calc.derivs=FALSE)), "lmerMod") expect_equal(VarCorr(fm1),VarCorr(fm1_noCD)) ## backward compatibility version {for optimizer="Nelder-Mead" only}: if(isNM) expect_is(fm1.old <- update(fm1,control=lmerControl(use.last.params=TRUE)), "lmerMod") expect_is(fm1@resp, "lmerResp") expect_is(fm1@pp, "merPredD") expect_that(fe1 <- fixef(fm1), is_equivalent_to(1527.5)) expect_that(VarCorr(fm1)[[1]][1,1], ## "bobyqa" : 1764.050060 equals(1764.0375195, tolerance = 1e-5)) ## back-compatibility ... if(isNM) expect_that(VarCorr(fm1.old)[[1]][1,1], equals(1764.0726543)) expect_that(isREML(fm1), equals(TRUE)) expect_is(REMLfun <- as.function(fm1), "function") expect_that(REMLfun(1), equals(319.792389042002)) expect_that(REMLfun(0), equals(326.023232155879)) expect_that(family(fm1), equals(gaussian())) expect_that(isREML(fm1ML <- refitML(fm1)), equals(FALSE)) expect_that(REMLcrit(fm1), equals(319.654276842342)) expect_that(deviance(fm1ML), equals(327.327059881135)) ## "bobyqa": 49.51009984775 expect_that(sigma(fm1), equals(49.5101272946856, tolerance=1e-6)) if(isNM) expect_that(sigma(fm1.old), equals(49.5100503990048)) expect_that(sigma(fm1ML), equals(49.5100999308089)) expect_that(extractAIC(fm1), equals(c(3, 333.327059881135))) expect_that(extractAIC(fm1ML), equals(c(3, 333.327059881135))) ## "bobyqa": 375.71667627943 expect_that(vcov(fm1) [1,1], equals(375.714676744, tolerance=1e-5)) if(isNM) expect_that(vcov(fm1.old)[1,1], equals(375.72027872986)) expect_that(vcov(fm1ML) [1,1], equals(313.09721874266, tolerance=1e-7)) # was 313.0972246957 expect_is(fm2 <- refit(fm1, Dyestuff2$Yield), "lmerMod") expect_that(fixef(fm2), is_equivalent_to(5.6656)) expect_that(VarCorr(fm2)[[1]][1,1], is_equivalent_to(0)) expect_that(getME(fm2, "theta"), is_equivalent_to(0)) expect_that(X <- getME(fm1, "X"), is_equivalent_to(array(1, c(1, 30)))) expect_is(Zt <- getME(fm1, "Zt"), "dgCMatrix") expect_that(dim(Zt), equals(c(6L, 30L))) expect_that(Zt@x, equals(rep.int(1, 30L))) expect_equal(dimnames(Zt), list(levels(Dyestuff$Batch), rownames(Dyestuff))) ## "bobyqa": 0.8483237982 expect_that(theta <- getME(fm1, "theta"), equals(0.84832031, tolerance=6e-6, check.attributes=FALSE)) if(isNM) expect_that(getME(fm1.old, "theta"), is_equivalent_to(0.848330078)) expect_is(Lambdat <- getME(fm1, "Lambdat"), "dgCMatrix") expect_that(as(Lambdat, "matrix"), is_equivalent_to(diag(theta, 6L, 6L))) expect_is(fm3 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy), "lmerMod") expect_that(getME(fm3,"n_rtrms"), equals(2L)) expect_that(getME(fm3,"n_rfacs"), equals(1L)) expect_equal(getME(fm3, "lower"), c(`Subject.(Intercept)` = 0, Subject.Days = 0)) expect_error(fm4 <- lmer(Reaction ~ Days + (1|Subject), subset(sleepstudy,Subject==levels(Subject)[1])), "must have > 1") expect_warning(fm4 <- lFormula(Reaction ~ Days + (1|Subject), subset(sleepstudy,Subject==levels(Subject)[1]), control=lmerControl(check.nlev.gtr.1="warning")), "must have > 1") expect_warning(fm4 <- lmer(Reaction ~ Days + (1|Subject), subset(sleepstudy,Subject %in% levels(Subject)[1:4]), control=lmerControl(check.nlev.gtreq.5="warning")), "< 5 sampled levels") sstudy9 <- subset(sleepstudy, Days == 1 | Days == 9) expect_error(lmer(Reaction ~ 1 + Days + (1 + Days | Subject), data = sleepstudy, subset = (Days == 1 | Days == 9)), "number of observations \\(=36\\) <= number of random effects \\(=36\\)") expect_error(lFormula(Reaction ~ 1 + Days + (1 + Days | Subject), data = sleepstudy, subset = (Days == 1 | Days == 9)), "number of observations \\(=36\\) <= number of random effects \\(=36\\)") ## with most recent Matrix (1.1-1), should *not* flag this ## for insufficient rank dat <- readRDS(system.file("testdata", "rankMatrix.rds", package="lme4")) expect_is(lFormula(y ~ (1|sample) + (1|day) + (1|day:sample) + (1|operator) + (1|day:operator) + (1|sample:operator) + (1|day:sample:operator), data = dat, control = lmerControl(check.nobs.vs.rankZ = "stop")), "list") ## check scale ss <- within(sleepstudy, Days <- Days*1e6) expect_warning(lmer(Reaction ~ Days + (1|Subject), data=ss), "predictor variables are on very different scales") ## Promote warning to error so that warnings or errors will stop the test: options(warn=2) expect_is(lmer(Yield ~ 1|Batch, Dyestuff, REML=TRUE), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, start=NULL), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, verbose=0L), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, subset=TRUE), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, weights=rep(1,nrow(Dyestuff))), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, na.action="na.exclude"), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, offset=rep(0,nrow(Dyestuff))), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, contrasts=NULL), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, devFunOnly=FALSE), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl(optimizer="Nelder_Mead")), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl()), "lmerMod") ## avoid _R_CHECK_LENGTH_1_LOGIC2_ errors ... if (getRversion() < "3.6.0" || packageVersion("optimx")>"2018.7.10") { expect_error(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl(optimizer="optimx")),"must specify") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl(optimizer="optimx", optCtrl=list(method="L-BFGS-B"))), "lmerMod") } expect_error(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl(optimizer="junk")), "couldn't find optimizer function") ## disable test ... should be no warning expect_is(lmer(Reaction ~ 1 + Days + (1 + Days | Subject), data = sleepstudy, subset = (Days == 1 | Days == 9), control=lmerControl(check.nobs.vs.rankZ="ignore", check.nobs.vs.nRE="ignore", check.conv.hess="ignore", ## need to ignore relative gradient check too; ## surface is flat so *relative* gradient gets large check.conv.grad="ignore")), "merMod") expect_is(lmer(Reaction ~ 1 + Days + (1|obs), data = transform(sleepstudy,obs=seq(nrow(sleepstudy))), control=lmerControl(check.nobs.vs.nlev="ignore", check.nobs.vs.nRE="ignore", check.nobs.vs.rankZ="ignore")), "merMod") expect_error(lmer(Reaction ~ 1 + Days + (1|obs), data = transform(sleepstudy,obs=seq(nrow(sleepstudy))), "number of levels of each grouping factor")) ## check for errors with illegal input checking options flags <- lme4:::.get.checkingOpts(names(formals(lmerControl))) .t <- lapply(flags, function(OPT) { ## set each to invalid string: ## cat(OPT,"\n") expect_error(lFormula(Reaction~1+Days+(1|Subject), data = sleepstudy, control = do.call(lmerControl, ## Deliberate: fake typo ## vvv setNames(list("warnign"), OPT))), "invalid control level") }) ## disable warning via options options(lmerControl=list(check.nobs.vs.rankZ="ignore",check.nobs.vs.nRE="ignore")) expect_is(fm4 <- lmer(Reaction ~ Days + (1|Subject), subset(sleepstudy,Subject %in% levels(Subject)[1:4])), "merMod") expect_is(lmer(Reaction ~ 1 + Days + (1 + Days | Subject), data = sleepstudy, subset = (Days == 1 | Days == 9), control=lmerControl(check.conv.hess="ignore", check.conv.grad="ignore")), "merMod") options(lmerControl=NULL) ## check for when ignored options are set options(lmerControl=list(junk=1,check.conv.grad="ignore")) expect_warning(lmer(Reaction ~ Days + (1|Subject),sleepstudy), "some options") options(lmerControl=NULL) options(warn=0) expect_error(lmer(Yield ~ 1|Batch, Dyestuff, junkArg=TRUE), "unused argument") expect_warning(lmer(Yield ~ 1|Batch, Dyestuff, control=list()), "passing control as list is deprecated") if(FALSE) ## Hadley broke this expect_warning(lmer(Yield ~ 1|Batch, Dyestuff, control=glmerControl()), "passing control as list is deprecated") ss <- transform(sleepstudy,obs=factor(seq(nrow(sleepstudy)))) expect_warning(lmer(Reaction ~ 1 + (1|obs), data=ss, control=lmerControl(check.nobs.vs.nlev="warning", check.nobs.vs.nRE="ignore")), "number of levels of each grouping factor") ## test deparsing of very long terms inside mkReTrms set.seed(101) longNames <- sapply(letters[1:25], function(x) paste(rep(x,8),collapse="")) tstdat <- data.frame(Y=rnorm(10), F=factor(1:10), matrix(runif(250),ncol=25, dimnames=list(NULL, longNames))) expect_is(lFormula(Y~1+(aaaaaaaa+bbbbbbbb+cccccccc+dddddddd+ eeeeeeee+ffffffff+gggggggg+hhhhhhhh+ iiiiiiii+jjjjjjjj+kkkkkkkk+llllllll|F), data=tstdat, control=lmerControl(check.nobs.vs.nlev="ignore", check.nobs.vs.nRE="ignore", check.nobs.vs.rankZ="ignore")),"list") ## do.call(new,...) bug new <- "foo" expect_is(refit(fm1),"merMod") rm("new") ## test subset-with-( printing from summary fm1 <- lmer(z~1|f,d,subset=(z<1e9)) expect_equal(sum(grepl("Subset: \\(",capture.output(summary(fm1)))),1) ## test messed-up Hessian fm1 <- lmer(z~ as.numeric(f) + 1|f, d) fm1@optinfo$derivs$Hessian[2,2] <- NA expect_warning(lme4:::checkConv(fm1@optinfo$derivs, coefs=c(1,1), ctrl=lmerControl()$checkConv,lbound=0), "Problem with Hessian check") ## test ordering of Ztlist names ## this is a silly model, just using it for a case ## where nlevs(RE term 1) < nlevs(RE term 2)x data(cbpp) cbpp <- transform(cbpp,obs=factor(1:nrow(cbpp))) fm0 <- lmer(incidence~1+(1|herd)+(1|obs),cbpp, control=lmerControl(check.nobs.vs.nlev="ignore", check.nobs.vs.rankZ="ignore", check.nobs.vs.nRE="ignore", check.conv.grad="ignore", check.conv.singular="ignore", check.conv.hess="ignore")) fm0B <- update(fm0, .~1+(1|obs)+(1|herd)) expect_equal(names(getME(fm0,"Ztlist")), c("obs.(Intercept)", "herd.(Intercept)")) ## stable regardless of order in formula expect_equal(getME(fm0,"Ztlist"),getME(fm0B,"Ztlist")) ## no optimization (GH #408) fm_noopt <- lmer(z~1|f,d, control=lmerControl(optimizer=NULL)) expect_equal(unname(unlist(getME(fm_noopt,c("theta","beta")))), c(0.244179074357121, -0.0336616441209862)) expect_error(lmer(z~1|f,d, control=lmerControl(optimizer="none")), "deprecated use") my_opt <- function(fn,par,lower,upper,control) { opt <- optim(fn=fn,par=par,lower=lower, upper=upper,control=control,,method="L-BFGS-B") return(list(par=opt$par,fval=opt$value,conv=opt$convergence)) } expect_is(fm_noopt <- lmer(z~1|f,d, control=lmerControl(optimizer=my_opt)),"merMod") ## test verbose option for nloptwrap cc <- capture.output(lmer(Reaction~1+(1|Subject), data=sleepstudy, control=lmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6)), verbose=5)) expect_equal(sum(grepl("^iteration:",cc)),14) }) ## test_that(..) test_that("coef_lmer", { ## test coefficient extraction in the case where RE contain ## terms that are missing from the FE ... set.seed(101) d <- data.frame(resp=runif(100), var1=factor(sample(1:5,size=100,replace=TRUE)), var2=runif(100), var3=factor(sample(1:5,size=100,replace=TRUE))) library(lme4) mix1 <- lmer(resp ~ 0 + var1 + var1:var2 + (1|var3), data=d) c1 <- coef(mix1) expect_is(c1, "coef.mer") cd1 <- c1$var3 expect_is (cd1, "data.frame") n1 <- paste0("var1", 1:5) nn <- c(n1, paste(n1, "var2", sep=":")) expect_identical(names(cd1), c("(Intercept)", nn)) expect_equal(fixef(mix1), setNames(c(0.2703951, 0.3832911, 0.451279, 0.6528842, 0.6109819, 0.4949802, 0.1222705, 0.08702069, -0.2856431, -0.01596725), nn), tolerance= 6e-6)# 64-bit: 6.73e-9 }) test_that("getCall", { ## GH #535 getClass <- function() "foo" expect_is(glmer(round(Reaction) ~ 1 + (1|Subject), sleepstudy, family=poisson), "glmerMod") rm(getClass) }) test_that("better info about optimizer convergence", { set.seed(14) cbpp$var <- rnorm(nrow(cbpp), 10, 10) suppressWarnings(gm2 <- glmer(cbind(incidence, size - incidence) ~ period * var + (1 | herd), data = cbpp, family = binomial, control=glmerControl(optimizer=c("bobyqa","Nelder_Mead"))) ) ## FIXME: with new update, suppressWarnings(update(gm2)) will give ## Error in as.list.environment(X[[i]], ...) : ## promise already under evaluation: recursive default argument reference or earlier problems? op <- options(warn=-1) gm3 <- update(gm2, control=glmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2))) options(op) cc <-capture.output(print(summary(gm2))) expect_equal(tail(cc,3)[1], "optimizer (Nelder_Mead) convergence code: 0 (OK)") }) context("convergence warnings etc.") fm1 <- lmer(Reaction~ Days + (Days|Subject), sleepstudy) suppressMessages(fm0 <- lmer(Reaction~ Days + (Days|Subject), sleepstudy[1:20,])) msg_in_output <- function(x, str) { cc <- capture.output(.prt.warn(x)) any(grepl(str , cc)) } test_that("convergence warnings from limited evals", { expect_warning(fm1B <- update(fm1, control=lmerControl(optCtrl=list(maxeval=3))), "convergence code 5") expect_true(msg_in_output(fm1B@optinfo, "convergence code: 5")) expect_warning(fm1C <- update(fm1, control=lmerControl(optimizer="bobyqa",optCtrl=list(maxfun=3))), "maximum number of function evaluations exceeded") expect_true(msg_in_output(fm1C@optinfo, "maximum number of function evaluations exceeded")) ## one extra (spurious) warning here ... expect_warning(fm1D <- update(fm1, control=lmerControl(optimizer="Nelder_Mead",optCtrl=list(maxfun=3))), "failure to converge in 3 evaluations") expect_true(msg_in_output(fm1D@optinfo, "failure to converge in 3 evaluations")) expect_message(fm0D <- update(fm0, control=lmerControl(optimizer="Nelder_Mead")), "boundary") expect_true(msg_in_output(fm0D@optinfo, "(OK)")) }) ## GH 533 test_that("test for zero non-NA cases", { data_bad <- sleepstudy data_bad$Days <- NA_real_ expect_error(lmer(Reaction ~ Days + (1| Subject), data_bad), "0 \\(non-NA\\) cases") }) lme4/tests/testthat/test-stepHalving.R0000644000176200001440000000061013751775607017520 0ustar liggesuserslibrary(lme4) library(testthat) load(system.file("testdata","survdat_reduced.Rda",package="lme4")) test_that('Step-halving works properly', { # this example is known to require step-halving (or at least has in the past # required step-halving) form <- survprop~(1|nobs) m <- glmer(form,weights=eggs,data=survdat_reduced,family=binomial,nAGQ=1L) expect_that(m, is_a("glmerMod")) }) lme4/tests/testthat/test-predict.R0000644000176200001440000004005514174542124016657 0ustar liggesuserslibrary("testthat") library("lme4") library("lattice") testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } do.plots <- TRUE L <- load(system.file("testdata/lme-tst-fits.rda", package="lme4", mustWork=TRUE)) if (getRversion() > "3.0.0") { ## saved fits are not safe with old R versions gm1 <- fit_cbpp_1 fm1 <- fit_sleepstudy_1 fm2 <- fit_sleepstudy_2 fm3 <- fit_penicillin_1 fm4 <- fit_cake_1 } else { gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) fm1 <- lmer(Reaction ~ Days + (1|Subject), sleepstudy) fm2 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm3 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin) fm4 <- lmer(angle ~ temp + recipe + (1 | replicate), data=cake) } if (testLevel>1) { context("predict") test_that("fitted values", { p0 <- predict(gm1) p0B <- predict(gm1,newdata=cbpp) expect_equal(p0, p0B, tolerance=2e-5) ## ? not sure why high tolerance necessary ? works OK on Linux/R 3.5.0 ## fitted values, unconditional (level-0) p1 <- predict(gm1, re.form=NA) expect_true(length(unique(p1))==length(unique(cbpp$period))) ## fitted values, random-only p1R <- predict(gm1, random.only=TRUE) expect_equal(p1+p1R,p0) if (do.plots) matplot(cbind(p0,p1),col=1:2,type="b") ## neither fixed nor random -- all zero expect_equal(unique(predict(gm1,re.form=NA,random.only=TRUE)),0) }) test_that("predict with newdata", { newdata <- with(cbpp,expand.grid(period=unique(period),herd=unique(herd))) ## new data, all RE p2 <- predict(gm1,newdata) ## new data, level-0 p3 <- predict(gm1,newdata, re.form=NA) p3R <- predict(gm1,newdata, random.only=TRUE) expect_equal(p3+p3R,p2) if (do.plots) matplot(cbind(p2,p3),col=1:2,type="b") }) test_that("predict on response scale", { p0 <- predict(gm1) p5 <- predict(gm1,type="response") expect_equal(p5, plogis(p0)) }) test_that("predict with newdata and RE", { newdata <- with(cbpp,expand.grid(period=unique(period),herd=unique(herd))) ## explicitly specify RE p2 <- predict(gm1,newdata) p4 <- predict(gm1,newdata, re.form=~(1|herd)) expect_equal(p2, p4) }) test_that("effects of new RE levels", { newdata <- with(cbpp,expand.grid(period=unique(period),herd=unique(herd))) newdata2 <- rbind(newdata, data.frame(period=as.character(1:4),herd=rep("new",4))) expect_error(predict(gm1,newdata2), "new levels detected") p2 <- predict(gm1,newdata) p6 <- predict(gm1,newdata2,allow.new.levels=TRUE) expect_equal(p2, p6[1:length(p2)]) ## original values should match ## last 4 values should match unconditional values expect_true(all(tail(p6,4) == predict(gm1, newdata=data.frame(period=factor(1:4)), re.form=NA))) }) test_that("multi-group model", { ## fitted values p0 <- predict(fm3) expect_equal(head(round(p0,4)), c(`1` = 25.9638, `2` = 22.7663, `3` = 25.7147, `4` = 23.6799, `5` = 23.7629, `6` = 20.773)) ## fitted values, unconditional (level-0) p1 <- predict(fm3, re.form=NA) expect_equal(unique(p1),22.9722222222251) if (do.plots) matplot(cbind(p0,p1),col=1:2,type="b") }) test_that("multi-group model with new data", { newdata <- with(Penicillin,expand.grid(plate=unique(plate),sample=unique(sample))) ## new data, all RE p2 <- predict(fm3,newdata) ## new data, level-0 p3 <- predict(fm3,newdata, re.form=NA) ## explicitly specify RE p4 <- predict(fm3,newdata, re.form= ~(1|plate)+(~1|sample)) p4B <- predict(fm3,newdata, re.form= ~(1|sample)+(~1|plate)) ## **** expect_equal(p2,p4) expect_equal(p4,p4B) p5 <- predict(fm3,newdata, re.form=~(1|sample)) p6 <- predict(fm3,newdata, re.form=~(1|plate)) if (do.plots) matplot(cbind(p2,p3,p5,p6),type="b",lty=1,pch=16) }) test_that("random-slopes model", { p0 <- predict(fm2) p1 <- predict(fm2, re.form=NA) ## linear model, so results should be identical patterns but smaller -- ## not including intermediate days newdata <- with(sleepstudy,expand.grid(Days=range(Days),Subject=unique(Subject))) newdata$p2 <- predict(fm2,newdata) newdata$p3 <- predict(fm2,newdata, re.form=NA) newdata$p4 <- predict(fm2,newdata, re.form=~(0+Days|Subject)) newdata$p5 <- predict(fm2,newdata, re.form=~(1|Subject)) ## reference values from an apparently-working run refval <- structure( list(Days = c(0, 9, 0, 9, 0, 9), Subject = structure(c(1L, 1L, 2L, 2L, 3L, 3L), .Label = c("308", "309", "310", "330", "331", "332", "333", "334", "335", "337", "349", "350", "351", "352", "369", "370", "371", "372"), class = "factor"), p2 = c(253.663652396798, 430.66001930835, 211.006415533628, 227.634788908917, 212.444742696829, 257.61053840953), p3 = c(251.405104848485, 345.610678484848, 251.405104848485, 345.610678484848, 251.405104848485, 345.610678484848), p4 = c(251.405104848485, 428.401471760037, 251.405104848485, 268.033478223774, 251.405104848485, 296.570900561186), p5 = c(253.663652396798, 347.869226033161, 211.006415533628, 305.211989169991, 212.444742696829, 306.650316333193)), out.attrs = list(dim = c(Days = 2L, Subject = 18L), dimnames = list( Days = c("Days=0", "Days=9"), Subject = c("Subject=308", "Subject=309", "Subject=310", "Subject=330", "Subject=331", "Subject=332", "Subject=333", "Subject=334", "Subject=335", "Subject=337", "Subject=349", "Subject=350", "Subject=351", "Subject=352", "Subject=369", "Subject=370", "Subject=371", "Subject=372")) ), row.names = c(NA, 6L), class = "data.frame") expect_equal(head(newdata), refval, tol=5e-7) }) test_that("predict and plot random slopes", { tmpf <- function(data,...) { data$Reaction <- predict(fm2,data,...) if (do.plots) xyplot(Reaction~Days,group=Subject,data=data,type="l") return(unname(head(round(data$Reaction,3)))) } expect_equal(tmpf(sleepstudy),c(253.664, 273.33, 292.996, 312.662, 332.329, 351.995)) expect_equal(tmpf(sleepstudy, re.form=NA), c(251.405, 261.872, 272.34, 282.807, 293.274, 303.742)) expect_equal(tmpf(sleepstudy, re.form= ~(0+Days|Subject)), c(251.405, 271.071, 290.738, 310.404, 330.07, 349.736)) expect_equal(tmpf(sleepstudy, re.form= ~(1|Subject)), c(253.664, 264.131, 274.598, 285.066, 295.533, 306)) }) test_that("fewer random effect levels than original", { ## from 'Colonel Triq' summary(fm4) ## replicate 1 only appears in rows 1:18. ## rownames(cake[cake$replicate==1,]) predict(fm4, newdata=cake[-1:-17,], re.form=~ (1 | replicate)) predict(fm4, newdata=cake[-1:-18,], re.form=NA) predict(fm4, newdata=cake[-1:-18,], re.form=~ (1 | replicate)) predict(fm4, newdata=cake[-1:-18,], re.form=~ (1 | replicate), allow.new.levels=TRUE) ## p0 <- predict(fm1,newdata=data.frame(Days=6,Subject=c("308","309"))) p1 <- predict(fm1,newdata=data.frame(Days=rep(6,4), Subject=c("308","309"))) expect_equal(rep(unname(p0),2),unname(p1)) p2 <- predict(fm1,newdata=data.frame(Days=6,Subject="308")) nd <- data.frame(Days=6, Subject=factor("308",levels=levels(sleepstudy$Subject))) p3 <- predict(fm1,newdata=nd) expect_equal(p2,p3) expect_equal(p2,p0[1]) }) test_that("only drop columns when using new data", { ## Stack Overflow 34221564: ## should only drop columns from model matrix when using *new* data ## NB: Fit depends on optimizer somewhat: "nloptwrap" is really better than "bobyqa" library(splines) sleep <- sleepstudy #get the sleep data set.seed(1234567) sleep$age <- as.factor(sample(1:3,length(sleep),rep=TRUE)) form1 <- Reaction ~ Days + ns(Days, df=4) + age + Days:age + (Days | Subject) m4 <- lmer(form1, sleep) # fixed-effect model matrix is rank deficient so dropping 1 column / coefficient expect_lte(REMLcrit(m4), 1713.171) # FIXME !? why this regression?? had 1700.6431; "bobyqa" gave 1713.171 expect_equal(unname(head(predict(m4, re.form=NA))), c(255.203, 259.688, 265.71, 282.583, 294.784, 304.933), tolerance = 0.008) }) test_that("only look for columns that exist in re.form", { ## GH 457 set.seed(101) n <- 200 dd <- data.frame(x=1:n, f=factor(rep(1:10,n/10)), g=factor(rep(1:20,each=n/20)), h=factor(rep(1:5,n/5)), y=rnorm(n)) m1 <- lmer(y~1 + f + (1|h/f) + (poly(x,2)|g), data=dd, control=lmerControl(calc.derivs=FALSE)) expect_equal(unname(predict(m1,re.form= ~1 | h/f, newdata=dd[1,])), 0.14786, tolerance=1e-4) expect_equal(unname(predict(m1,re.form= ~poly(x,2) | g, newdata=dd[1,])), 0.1533, tolerance=.001) ## *last* RE not included (off-by-one error) m1B <- lmer(y~1 + f + (1|g) + (1|h), data=dd, control=lmerControl(calc.derivs=FALSE)) expect_equal(unname(predict(m1B,re.form=~(1|g),newdata=data.frame(f="1",g="2"))),0.1512895,tolerance=1e-5) set.seed(101) n <- 100 xx <- c("r1", "r2", "r3", "r4", "r5") xxx <- c("e1", "e2", "e3") p <- 0.3 School <- factor(sample(xxx, n, replace=TRUE), levels=xxx, ordered=FALSE) Rank <- factor(sample(xx, n, replace=TRUE), levels=xx, ordered=FALSE) df1 <- data.frame( ID = as.integer(runif(n, min = 1, max = n/7)), xx1 = runif(n, min = 0, max = 10), xx2 = runif(n, min = 0, max = 10), xx3 = runif(n, min = 0, max = 10), School, Rank, yx = as.factor(rbinom(n, size = 1, prob = p)) ) df1 <- df1[order(df1$ID, decreasing=FALSE),] mm2 <- glmer(yx ~ xx1 + xx2 + xx3 + Rank + (1 | ID) + (1 | School / Rank), data = df1, family = "binomial",control = glmerControl(calc.derivs =FALSE)) n11 <- data.frame(School= factor("e1", levels = levels(df1$School),ordered=FALSE), Rank = factor("r1", levels = levels(df1$Rank), ordered=FALSE), xx1=8.58, xx2=8.75, xx3=7.92) expect_equal(unname(predict(mm2, n11, type="response",re.form= ~(1 | School / Rank))), 0.1174628,tolerance=1e-5) ## bad factor levels mm3 <- update(mm2, . ~ . - (1|ID)) n12 = data.frame(School="e3",Rank="r2",xx1=8.58,xx2=8.75,xx3=7.92) expect_equal(unname(predict(mm3, n12, type="response")),0.1832894,tolerance=1e-5) ## GH #452 ## FIXME: would like to find a smaller/faster example that would test the same warning (10+ seconds) set.seed(101) n <- 300 df2 <- data.frame( xx1 = runif(n, min = 0, max = 10), xx2 = runif(n, min = 0, max = 10), xx3 = runif(n, min = 0, max = 10), School = factor(sample(xxx, n,replace=TRUE)), Rank = factor(sample(xx, n, replace=TRUE)), yx = as.factor(rbinom(n, size = 1, prob = p)) ) mm4 <- suppressWarnings(glmer(yx ~ xx1 + xx2 + xx3 + Rank + (Rank|School), data = df2, family = "binomial",control = glmerControl(calc.derivs =FALSE))) ## set tolerance to 0.1 (!) to pass win-builder on R-devel/i386 (only: ## tolerance = 3e-5 is OK for other combinations of (R-release, R-devel) x (i386,x64) expect_equal(unname(predict(mm4, n11, type="response")), 0.2675081, tolerance=0.1) }) test_that("simulation works with non-factor", { set.seed(12345) dd <- data.frame(a=gl(10,100), b = rnorm(1000)) test2 <- suppressMessages(simulate(~1+(b|a), newdata=dd, family=poisson, newparams= list(beta = c("(Intercept)" = 1), theta = c(1,1,1)))) expect_is(test2,"data.frame") }) set.seed(666) n <- 500 df <- data.frame(y=statmod::rinvgauss(n, mean=1, shape=2), id=factor(1:20)) model_fit <- glmer(y ~ 1 + (1|id), family = inverse.gaussian(link = "inverse"), data = df, control=glmerControl(check.conv.singular="ignore")) test_that("simulation works for inverse gaussian", { expect_equal(mean(simulate(model_fit)[[1]]), 1.02704392575914, tolerance=1e-5) }) test_that("simulation complains appropriately about bad family", { ig <- inverse.gaussian() ig$family <- "junk" model_fit2 <- glmer(y ~ 1 + (1|id), family = ig, data = df, control=glmerControl(check.conv.singular="ignore")) expect_error(simulate(model_fit2),"simulation not implemented for family") }) test_that("prediction from large factors", { set.seed(101) N <- 50000 X <- data.frame(y=rpois(N, 5), obs=as.factor(1:N)) fm <- glmer(y ~ (1|obs), family="poisson", data=X, control=glmerControl(check.conv.singular="ignore")) ## FIXME: weak tests. The main issue here is that these should ## be reasonably speedy and non-memory-hogging, but those are ## hard to test portably ... expect_is(predict(fm, re.form=~(1|obs)), "numeric") expect_is(predict(fm, newdata=X), "numeric") }) test_that("prediction with gamm4", { if (suppressWarnings(requireNamespace("gamm4"))) { ## loading gamm4 warngs "replacing previous import 'Matrix::update' by 'lme4::update' when loading 'gamm4'" ## from ?gamm4 set.seed(0) ## simulate 4 term additive truth dat <- mgcv::gamSim(1,n=400,scale=2,verbose=FALSE) ## Now add 20 level random effect `fac'... dat$fac <- fac <- as.factor(sample(1:20,400,replace=TRUE)) dat$y <- dat$y + model.matrix(~fac-1)%*%rnorm(20)*.5 br <- gamm4::gamm4(y~s(x0)+x1+s(x2),data=dat,random=~(1|fac)) expect_warning(ss <- simulate(br$mer), "modified RE names") expect_equal(dim(ss), c(400,1)) } }) test_that("prediction with spaces in variable names", { cbpp$`silly period` <- cbpp$period m <- glmer(cbind(incidence,size-incidence) ~ `silly period` + (1|herd), family=binomial, data=cbpp) expect_equal(round(head(predict(m)),3), c(`1` = -0.809, `2` = -1.801, `3` = -1.937, `4` = -2.388, `5` = -1.697, `6` = -2.689)) }) if (requireNamespace("statmod")) { test_that("simulate with rinvgauss", { dd <- data.frame(f=factor(rep(1:20,each=10))) dd$y <- simulate(~1+(1|f), seed=101, family=inverse.gaussian, newdata=dd, ## ?? gives NaN (sqrt(eta)) for low beta ? newparams=list(beta=5,theta=1,sigma=1))[[1]] suppressMessages(m <- glmer(y~1+(1|f), family=inverse.gaussian, data=dd)) set.seed(101) expect_equal(head(unlist(simulate(m))), c(sim_11 = 0.451329390087728, sim_12 = 0.629516371309772, sim_13 = 0.481236633500098, sim_14 = 0.170060386109077, sim_15 = 0.258742371516342, sim_16 = 0.949617440586848)) }) } ## GH 631 test_that("sparse contrasts don't mess up predict()", { dd <- expand.grid(f = factor(1:101), rep1 = factor(1:2), rep2 = 1:2) dd$y <- suppressMessages(simulate(~1 + (rep1|f), seed = 101, newdata = dd, newparams = list(beta = 1, theta = rep(1,3), sigma = 1), family = gaussian)[[1]]) m1 <- lmer( y ~ 1 + (1|f), data = dd) p1 <- predict(m1) p2 <- predict(m1, newdata = dd) expect_identical(p1, p2) }) } ## testLevel>1 lme4/tests/testthat/test-resids.R0000644000176200001440000000622414062244632016515 0ustar liggesuserslibrary("testthat") library("lme4") context("residuals") test_that("lmer", { C1 <- lmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6)) fm1 <- lmer(Reaction ~ Days + (Days|Subject),sleepstudy, control=C1) fm2 <- lmer(Reaction ~ Days + (Days|Subject),sleepstudy, control=lmerControl(calc.derivs=FALSE, optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6))) expect_equal(resid(fm1), resid(fm2)) expect_equal(range(resid(fm1)), c(-101.17996, 132.54664), tolerance=1e-6) expect_equal(range(resid(fm1, scaled=TRUE)), c(-3.9536067, 5.1792598), tolerance=1e-6) expect_equal(resid(fm1,"response"),resid(fm1)) expect_equal(resid(fm1,"response"),resid(fm1,type="working")) expect_equal(resid(fm1,"deviance"),resid(fm1,type="pearson")) expect_equal(resid(fm1),resid(fm1,type="pearson")) ## because no weights given expect_error(residuals(fm1,"partial"), "partial residuals are not implemented yet") sleepstudyNA <- sleepstudy na_ind <- c(10,50) sleepstudyNA[na_ind,"Days"] <- NA fm1NA <- update(fm1,data=sleepstudyNA) fm1NA_exclude <- update(fm1,data=sleepstudyNA,na.action="na.exclude") expect_equal(length(resid(fm1)),length(resid(fm1NA_exclude))) expect_true(all(is.na(resid(fm1NA_exclude)[na_ind]))) expect_true(!any(is.na(resid(fm1NA_exclude)[-na_ind]))) }) test_that("glmer", { gm1 <- glmer(incidence/size ~ period + (1|herd), cbpp, family=binomial, weights=size) gm2 <- update(gm1,control=glmerControl(calc.derivs=FALSE)) gm1.old <- update(gm1,control=glmerControl(calc.derivs=FALSE, use.last.params=TRUE)) expect_equal(resid(gm1),resid(gm2)) ## y, wtres, mu change ?? ## FIX ME:: why does turning on derivative calculation make these tests fail??? expect_equal(range(resid(gm1.old)), c(-3.197512,2.356677), tolerance=1e-6) expect_equal(range(resid(gm1)), c(-3.1975034,2.35668826), tolerance=1e-6) expect_equal(range(resid(gm1.old, "response")), c(-0.1946736,0.3184579), tolerance=1e-6) expect_equal(range(resid(gm1,"response")),c(-0.194674747774946, 0.318458889275477)) expect_equal(range(resid(gm1.old, "pearson")), c(-2.381643,2.879069),tolerance=1e-5) expect_equal(range(resid(gm1,"pearson")), c(-2.38163599828335, 2.87908806084918)) expect_equal(range(resid(gm1.old, "working")), c(-1.241733,5.410587),tolerance=1e-5) expect_equal(range(resid(gm1, "working")), c(-1.24173431447365, 5.41064465283686)) expect_equal(resid(gm1),resid(gm1,scaled=TRUE)) ## since sigma==1 expect_error(resid(gm1,"partial"), "partial residuals are not implemented yet") cbppNA <- cbpp na_ind <- c(10,50) cbppNA[na_ind,"period"] <- NA gm1NA <- update(gm1,data=cbppNA) gm1NA_exclude <- update(gm1,data=cbppNA,na.action="na.exclude") expect_equal(length(resid(gm1)),length(resid(gm1NA_exclude))) expect_true(all(is.na(resid(gm1NA_exclude)[na_ind]))) expect_true(!any(is.na(resid(gm1NA_exclude)[-na_ind]))) }) lme4/tests/testthat/test-catch.R0000644000176200001440000000105713751775607016324 0ustar liggesuserslibrary("testthat") library("lme4") context("storing warnings, convergence status, etc.") test_that("storewarning", { gCtrl <- glmerControl(optimizer = "Nelder_Mead", optCtrl = list(maxfun=3)) expect_warning(gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data=cbpp, family=binomial, control=gCtrl), "failure to converge in 3") expect_equal(gm1@optinfo$warnings[[1]],"failure to converge in 3 evaluations") ## FIXME: why is conv==0 here? }) lme4/tests/testthat/test-rank.R0000644000176200001440000000750614062244632016163 0ustar liggesuserslibrary("testthat") library("lme4") context("testing fixed-effect design matrices for full rank") test_that("lmerRank", { set.seed(101) n <- 20 x <- y <- rnorm(n) d <- data.frame(x,y, z = rnorm(n), r = sample(1:5, size=n, replace=TRUE), y2 = y + c(0.001, rep(0,n-1))) expect_message(fm <- lmer( z ~ x + y + (1|r), data=d), "fixed-effect model matrix is .*rank deficient") ## test reconstitution of full parameter vector (with NAs) expect_equal(names(fixef(fm,add.dropped=TRUE)), c("(Intercept)","x","y")) expect_equal(fixef(fm,add.dropped=TRUE)[1:2], fixef(fm)) expect_equal(nrow(anova(fm)), 1L) expect_error(lmer( z ~ x + y + (1|r), data=d, control=lmerControl(check.rankX="stop")), "rank deficient") expect_error(lmer( z ~ x + y + (1|r), data=d, control=lmerControl(check.rankX="ignore")), "not positive definite") ## should work: expect_is(lmer( z ~ x + y2 + (1|r), data=d), "lmerMod") d2 <- expand.grid(a=factor(1:4),b=factor(1:4),rep=1:10) n <- nrow(d2) d2 <- transform(d2,r=sample(1:5, size=n, replace=TRUE), z=rnorm(n)) d2 <- subset(d2,!(a=="4" & b=="4")) expect_error(lmer( z ~ a*b + (1|r), data=d2, control=lmerControl(check.rankX="stop")), "rank deficient") expect_message(fm <- lmer( z ~ a*b + (1|r), data=d2), "fixed-effect model matrix is rank deficient") d2 <- transform(d2, ab=droplevels(interaction(a,b))) ## should work: expect_is(fm2 <- lmer( z ~ ab + (1|r), data=d2), "lmerMod") expect_equal(logLik(fm), logLik(fm2)) expect_equal(sum(anova(fm)[, "npar"]), anova(fm2)[, "npar"]) expect_equal(sum(anova(fm)[, "Sum Sq"]), anova(fm2)[, "Sum Sq"]) }) test_that("glmerRank", { set.seed(111) n <- 100 x <- y <- rnorm(n) d <- data.frame(x, y, z = rbinom(n,size=1,prob=0.5), r = sample(1:5, size=n, replace=TRUE), y2 = ## y + c(0.001,rep(0,n-1)), ## too small: get convergence failures ## FIXME: figure out how small a difference will still fail? rnorm(n)) expect_message(fm <- glmer( z ~ x + y + (1|r), data=d, family=binomial), "fixed-effect model matrix is rank deficient") expect_error(glmer( z ~ x + y + (1|r), data=d, family=binomial, control=glmerControl(check.rankX="stop")), "rank deficient.*rank.X.") expect_is(glmer( z ~ x + y2 + (1|r), data=d, family=binomial), "glmerMod") }) test_that("nlmerRank", { set.seed(101) n <- 1000 nblock <- 15 x <- abs(rnorm(n)) y <- rnorm(n) z <- rnorm(n,mean=x^y) r <- sample(1:nblock, size=n, replace=TRUE) d <- data.frame(x,y,z,r) ## save("d","nlmerRank.RData") ## see what's going on with difference in contexts fModel <- function(a,b) (exp(a)*x)^(b*y) fModf <- deriv(body(fModel), namevec = c("a","b"), func = fModel) fModel2 <- function(a,b,c) (exp(a+c)*x)^(b*y) fModf2 <- deriv(body(fModel2), namevec = c("a","b","c"), func = fModel2) ## should be OK: fails in test mode? nlmer(y ~ fModf(a,b) ~ a|r, d, start = c(a=1,b=1)) ## FIXME: this doesn't get caught where I expected expect_error(nlmer(y ~ fModf2(a,b,c) ~ a|r, d, start = c(a=1,b=1,c=1)),"Downdated VtV") }) test_that("ranksim", { set.seed(101) x <- data.frame(id = factor(sample(10, 100, replace = TRUE))) x$y <- rnorm(nrow(x)) x$x1 <- 1 x$x2 <- ifelse(x$y<0, rnorm(nrow(x), mean=1), rnorm(nrow(x), mean=-1)) m <- suppressMessages(lmer(y ~ x1 + x2 + (1 | id), data=x)) expect_equal(simulate(m, nsim = 1, use.u = FALSE, newdata=x, seed=101), simulate(m, nsim = 1, use.u = FALSE, seed=101)) }) lme4/tests/testthat/test-summary.R0000644000176200001440000000340514062244632016717 0ustar liggesuserslibrary("testthat") library("lme4") context("summarizing/printing models") test_that("lmer", { set.seed(0) J <- 8 n <- 10 N <- J * n beta <- c(5, 2, 4) u <- matrix(rnorm(J * 3), J, 3) x.1 <- rnorm(N) x.2 <- rnorm(N) g <- rep(1:J, rep(n, J)) y <- 1 * (beta[1] + u[g,1]) + x.1 * (beta[2] + u[g,2]) + x.2 * (beta[3] + u[g,3]) + rnorm(N) tmpf <- function(x) capture.output(print(summary(x),digits=1)) tfun <- function(cc) { w <- grep("Fixed effects:",cc) cc[w:length(cc)] } C1 <- lmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6)) cc1 <- tmpf(lmer(y ~ x.1 + x.2 + (1 + x.1 | g), control=C1)) cc2 <- tmpf(lmer(y ~ x.1 + x.2 + (1 + x.1 + x.2 | g), control=C1)) expect_equal(tfun(cc1), c("Fixed effects:", " Estimate Std. Error t value", "(Intercept) 5.4 0.5 12", "x.1 1.9 0.4 5", "x.2 4.0 0.1 28", "", "Correlation of Fixed Effects:", " (Intr) x.1 ", "x.1 -0.019 ", "x.2 0.029 -0.043" )) expect_equal(tfun(cc2), c("Fixed effects:", " Estimate Std. Error t value", "(Intercept) 5.4 0.4 12", "x.1 2.0 0.4 5", "x.2 4.0 0.3 15", "", "Correlation of Fixed Effects:", " (Intr) x.1 ", "x.1 -0.069 ", "x.2 0.136 -0.103" )) }) lme4/tests/testthat/test-glmFamily.R0000644000176200001440000001177413751775607017172 0ustar liggesuserslibrary("testthat") library("lme4") eps <- .Machine$double.eps oneMeps <- 1 - eps set.seed(1) ## sample linear predictor values for the unconstrained families etas <- list(seq.int(-8, 8, by=1), # equal spacing to asymptotic area runif(17, -8, 8), # random sample from wide uniform dist rnorm(17, 0, 8), # random sample from wide normal dist c(-10^30, rnorm(15, 0, 4), 10^30)) ## sample linear predictor values for the families in which eta must be positive etapos <- list(seq.int(1, 20, by=1), rexp(20), rgamma(20, 3), pmax(.Machine$double.eps, rnorm(20, 2, 1))) ## values of mu in the (0,1) interval mubinom <- list(runif(100, 0, 1), rbeta(100, 1, 3), pmin(pmax(eps, rbeta(100, 0.1, 3)), oneMeps), pmin(pmax(eps, rbeta(100, 3, 0.1)), oneMeps)) context("glmFamily linkInv and muEta") test_that("inverse link and muEta functions", { tst.lnki <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$linkinv(x), equals(ff$linkInv(x)))) } tst.muEta <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$mu.eta(x), equals(ff$muEta(x)))) } tst.lnki(binomial(), etas) # binomial with logit link tst.muEta(binomial(), etas) tst.lnki(binomial("probit"), etas) # binomial with probit link tst.muEta(binomial("probit"), etas) tst.lnki(binomial("cloglog"), etas) # binomial with cloglog link tst.muEta(binomial("cloglog"), etas) tst.lnki(binomial("cauchit"), etas) # binomial with cauchit link tst.muEta(binomial("cauchit"), etas) tst.lnki(poisson(), etas) # Poisson with log link tst.muEta(poisson(), etas) tst.lnki(gaussian(), etas) # Gaussian with identity link tst.muEta(gaussian(), etas) tst.lnki(Gamma(), etapos) # gamma family tst.muEta(Gamma(), etapos) tst.lnki(inverse.gaussian(), etapos) # inverse Gaussian tst.muEta(inverse.gaussian(), etapos) }) context("glmFamily linkFun and variance") test_that("link and variance functions", { tst.link <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$linkfun(x), equals(ff$link(x)))) } tst.variance <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$variance(x), equals(ff$variance(x)))) } tst.link( binomial(), mubinom) tst.variance(binomial(), mubinom) tst.link( binomial("probit"), mubinom) tst.link( binomial("cauchit"), mubinom) tst.link( gaussian(), etas) tst.variance(gaussian(), etas) tst.link( Gamma(), etapos) tst.variance(Gamma(), etapos) tst.link( inverse.gaussian(), etapos) tst.variance(inverse.gaussian(), etapos) tst.variance(MASS::negative.binomial(1), etapos) tst.variance(MASS::negative.binomial(0.5), etapos) tst.link( poisson(), etapos) tst.variance(poisson(), etapos) }) context("glmFamily devResid and aic") test_that("devResid and aic", { tst.devres <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) { nn <- length(x) wt <- rep.int(1, nn) n <- wt y <- switch(fam$family, binomial = rbinom(nn, 1L, x), gaussian = rnorm(nn, x), poisson = rpois(nn, x), error("Unknown family")) dev <- ff$devResid(y, x, wt) expect_that(fam$dev.resids(y, x, wt), equals(dev)) dd <- sum(dev) expect_that(fam$aic(y, n, x, wt, dd), equals(ff$aic(y, n, x, wt, dd))) }) } tst.devres(binomial(), mubinom) tst.devres(gaussian(), etas) tst.devres(poisson(), etapos) }) context("negative binomial") test_that("variance", { tst.variance <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$variance(x), equals(ff$variance(x)))) } tst.variance(MASS::negative.binomial(1.), etapos) nb1 <- MASS::negative.binomial(1.) cppnb1 <- glmFamily$new(family=nb1) expect_that(cppnb1$theta(), equals(1)) nb2 <- MASS::negative.binomial(2.) cppnb1$setTheta(2) sapply(etapos, function(x) expect_that(cppnb1$variance(x), equals(nb2$variance(x)))) bfam <- glmFamily$new(family=binomial()) if (FALSE) { ## segfaults on MacOS mavericks 3.1.0 ... ?? expect_error(bfam$theta())#, "theta accessor applies only to negative binomial") expect_error(bfam$setTheta(2))#, "setTheta applies only to negative binomial") } }) lme4/tests/testthat/test-nlmer.R0000644000176200001440000000074614063503234016341 0ustar liggesuserslibrary("testthat") library("lme4") testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 context("lower/upper bounds on nlmer models") test_that("nlmer", { startvec <- c(Asym = 200, xmid = 725, scal = 350) nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = startvec, control=nlmerControl(optCtrl=list(lower=c(0,200,-Inf,-Inf)))) expect_equal(unname(fixef(nm1)[1]),200) }) lme4/tests/testthat/test-eval.R0000644000176200001440000000445614147555751016173 0ustar liggesusers## examples for eval lookup testthat::skip_on_cran() if (require(car, quietly = TRUE)) { test_that("infIndexPlot env lookup OK", { fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) ## silly test; the point is to see if this errors out with ## Error in as.list.environment(X[[i]], ...) : ## promise already under evaluation: recursive default argument reference or earlier problems? ## Calls: infIndexPlot -> influence -> influence.merMod -> lapply -> FUN expect_equal(car::infIndexPlot(influence(fm1, "Subject")), NULL) }) } if (require(rr2, quietly = TRUE)) { test_that("rr2 env lookup OK", { ## Error under alternate eval lookup ## Error: bad 'data': object 'd' not found set.seed(123456) p1 <- 10; nsample <- 20; n <- p1 * nsample d <- data.frame(x1 = rnorm(n = n), x2 = rnorm(n = n), u1 = rep(1:p1, each = nsample), u2 = rep(1:p1, times = nsample)) d$u1 <- as.factor(d$u1); d$u2 <- as.factor(d$u2) ## LMM: y with random intercept b1 <- 1; b2 <- -1; sd1 <- 1.5 d$y_re_intercept <- b1 * d$x1 + b2 * d$x2 + rep(rnorm(n = p1, sd = sd1), each = nsample) + # random intercept u1 rep(rnorm(n = p1, sd = sd1), times = nsample) + # random intercept u2 rnorm(n = n) z.f2 <- lme4::lmer(y_re_intercept ~ x1 + x2 + (1 | u1) + (1 | u2), data = d, REML = T) ## NOTE, fails to produce warnings on second run of devtools::test() ## (possible interference from lmerTest methods being loaded ...?) expect_warning(R2(z.f2), "mod updated with REML = F") }) } ## semEff::VIF() is here being applied to a previously fitted lmer ## model (shipley.growth[[3]]) ## previous messing around with env evaluation had messed this up if (suppressWarnings(require(semEff))) { ## suppress warning about 'cov2cor' import replacement test_that("semEff env lookup OK", { ## Error in as.list.environment(X[[i]], ...) : ## promise already under evaluation: recursive default argument reference or earlier problems? ## Calls: VIF ... update.merMod -> do.call -> lapply -> FUN -> as.list.environment m <- shipley.growth[[3]] expect_equal(VIF(m), c(Date = 6.06283840168881, DD = 6.07741017455859, lat = 1.01215136160858) ) }) } lme4/tests/testthat/test-factors.R0000644000176200001440000000357514136006216016667 0ustar liggesuserslibrary("testthat") library("lme4") test_that("factors", { set.seed(101) d <- data.frame(x=runif(1000),y=runif(1000),f1=rep(1:10,each=100),f2=rep(1:10,100)) d2 <- transform(d,f1=factor(f1),f2=factor(f2)) expect_that(lm1 <- lmer(y~x+(1|f1/f2),data=d), is_a("lmerMod")) expect_that(lm2 <- lmer(y~x+(1|f1/f2),data=d2),is_a("lmerMod")) expect_equivalent(lm1,lm2) }) ## this will fail/take a long time unless we handle interactions carefully test_that("savvy interactions", { dd <- data.frame(y = 1:10000, f1 = factor(1:10000), f2 = factor(1:10000)) F1 <- lFormula(y ~ 1 + (1|f1/f2), data =dd, control = lmerControl(check.nobs.vs.nlev = "ignore", check.nobs.vs.nRE = "ignore")) expect_equal(dim(F1$reTrms$Zt), c(20000, 10000)) }) test_that("savvy factor level ordering", { check_f <- function(n = 200, frac = 0.7, fix_order = TRUE, check_order = TRUE) { dd <- expand.grid(f1 = seq(n), f2 = seq(n)) dd <- within(dd, { f1 <- factor(f1, levels = sample(unique(f1))) f2 <- factor(f2, levels = sample(unique(f2))) }) dd <- dd[sample(nrow(dd), size = round(frac*nrow(dd)), replace = FALSE), ] dd <- within(dd, { f12 <- f1:f2 f12d <- droplevels(f12) }) new_levels <- with(dd, levels(`%i%`(f1,f2, fix.order = fix_order))) ## don't want to pay the cost of checking if unneeded {for benchmarking} if (fix_order && check_order) { stopifnot(identical(levels(dd$f12d), new_levels)) } return(TRUE) } ## should fail within check_f() if levels don't match expect_true(check_f(), "'savvy' factor levels match brute-force version") ## library(microbenchmark) ## set.seed(101) ## m1 <- microbenchmark(check_f(fix_order = TRUE, check_order = FALSE), ## check_f(fix_order = FALSE)) }) lme4/tests/testthat/test-formulaEval.R0000644000176200001440000002020514173315411017471 0ustar liggesuserslibrary("testthat") library("lme4") context("data= argument and formula evaluation") ## intercept context-dependent errors ... it's too bad that ## these errors differ between devtools::test() and ## R CMD check, but finding the difference is too much ## of a nightmare ## n.b. could break in other locales *if* we ever do internationalization ... data_RE <- "(bad 'data'|variable lengths differ)" test_that("glmerFormX", { set.seed(101) n <- 50 x <- rbinom(n, 1, 1/2) y <- rnorm(n) z <- rnorm(n) r <- sample(1:5, size=n, replace=TRUE) d <- data.frame(x,y,z,r) F <- "z" rF <- "(1|r)" modStr <- (paste("x ~", "y +", F, "+", rF)) modForm <- as.formula(modStr) ## WARNING: these drop/environment tests are extremely sensitive to environment ## they may fail/not fail, or fail differently, within a "testthat" environment vs. ## when run interactively expect_that(m_data.3 <- glmer( modStr , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.4 <- glmer( "x ~ y + z + (1|r)" , data=d, family="binomial"), is_a("glmerMod")) ## interactively: (interactive() is TRUE {i.e. doesn't behave as I would expect} within testing environment ... ## if (interactive()) { ## AICvec <- c(77.0516381151634, 75.0819116367084, 75.1915023640827) ## expect_equal(drop1(m_data.3)$AIC,AICvec) ## expect_equal(drop1(m_data.4)$AIC,AICvec) ## } else { ## in test environment [NOT test_ expect_error(drop1(m_data.3),data_RE) expect_error(drop1(m_data.4),data_RE) ##} }) test_that("glmerForm", { set.seed(101) n <- 50 x <- rbinom(n, 1, 1/2) y <- rnorm(n) z <- rnorm(n) r <- sample(1:5, size=n, replace=TRUE) d <- data.frame(x,y,z,r) F <- "z" rF <- "(1|r)" modStr <- (paste("x ~", "y +", F, "+", rF)) modForm <- as.formula(modStr) ## formulas have environments associated, but character vectors don't ## data argument not specified: ## should work, but documentation warns against it expect_that(m_nodata.0 <- glmer( x ~ y + z + (1|r) , family="binomial"), is_a("glmerMod")) expect_that(m_nodata.1 <- glmer( as.formula(modStr) , family="binomial"), is_a("glmerMod")) expect_that(m_nodata.2 <- glmer( modForm , family="binomial"), is_a("glmerMod")) expect_that(m_nodata.3 <- glmer( modStr , family="binomial"), is_a("glmerMod")) expect_that(m_nodata.4 <- glmer( "x ~ y + z + (1|r)" , family="binomial"), is_a("glmerMod")) ## apply drop1 to all of these ... m_nodata_List <- list(m_nodata.0, m_nodata.1,m_nodata.2,m_nodata.3,m_nodata.4) d_nodata_List <- lapply(m_nodata_List,drop1) rm(list=c("x","y","z","r")) ## data argument specified expect_that(m_data.0 <- glmer( x ~ y + z + (1|r) , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.1 <- glmer( as.formula(modStr) , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.2 <- glmer( modForm , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.3 <- glmer( modStr , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.4 <- glmer( "x ~ y + z + (1|r)" , data=d, family="binomial"), is_a("glmerMod")) ff <- function() { set.seed(101) n <- 50 x <- rbinom(n, 1, 1/2) y <- rnorm(n) z <- rnorm(n) r <- sample(1:5, size=n, replace=TRUE) d2 <- data.frame(x,y,z,r) glmer( x ~ y + z + (1|r), data=d2, family="binomial") } m_data.5 <- ff() ff2 <- function() { set.seed(101) n <- 50 x <- rbinom(n, 1, 1/2) y <- rnorm(n) z <- rnorm(n) r <- sample(1:5, size=n, replace=TRUE) glmer( x ~ y + z + (1|r), family="binomial") } m_data.6 <- ff2() m_data_List <- list(m_data.0,m_data.1,m_data.2,m_data.3,m_data.4,m_data.5,m_data.6) badNums <- 4:5 d_data_List <- lapply(m_data_List[-badNums],drop1) ## these do NOT fail if there is a variable 'd' living in the global environment -- ## they DO fail in the testthat context expect_error(drop1(m_data.3),data_RE) expect_error(drop1(m_data.4),data_RE) ## expect_error(lapply(m_data_List[4],drop1)) ## expect_error(lapply(m_data_List[5],drop1)) ## d_data_List <- lapply(m_data_List,drop1,evalhack="parent") ## fails on element 1 ## d_data_List <- lapply(m_data_List,drop1,evalhack="formulaenv") ## fails on element 4 ## d_data_List <- lapply(m_data_List,drop1,evalhack="nulldata") ## succeeds ## drop1(m_data.5,evalhack="parent") ## 'd2' not found ## drop1(m_data.5,evalhack="nulldata") ## 'x' not found (d2 is in environment ...) ## should we try to make update smarter ... ?? ## test equivalence of (i vs i+1) for all models, all drop1() results for (i in 1:(length(m_nodata_List)-1)) { expect_equivalent(m_nodata_List[[i]],m_nodata_List[[i+1]]) expect_equivalent(d_nodata_List[[i]],d_nodata_List[[i+1]]) } expect_equivalent(m_nodata_List[[1]],m_data_List[[1]]) expect_equivalent(d_nodata_List[[1]],d_data_List[[1]]) for (i in 1:(length(m_data_List)-1)) { expect_equivalent(m_data_List[[i]],m_data_List[[i+1]]) } ## allow for dropped 'bad' vals for (i in 1:(length(d_data_List)-1)) { expect_equivalent(d_data_List[[i]],d_data_List[[i+1]]) } }) test_that("lmerForm", { set.seed(101) x <- rnorm(10) y <- rnorm(10) z <- rnorm(10) r <- sample(1:3, size=10, replace=TRUE) d <- data.frame(x,y,z,r) ## example from Joehanes Roeby m2 <- suppressWarnings(lmer(x ~ y + z + (1|r), data=d)) ff <- function() { m1 <- suppressWarnings(lmer(x ~ y + z + (1|r), data=d)) return(anova(m1)) } ff1 <- Reaction ~ Days + (Days|Subject) fm1 <- lmer(ff1, sleepstudy) fun <- function () { ff1 <- Reaction ~ Days + (Days|Subject) fm1 <- suppressWarnings(lmer(ff1, sleepstudy)) return (anova(fm1)) } anova(m2) ff() expect_equal(anova(m2),ff()) anova(fm1) fun() expect_equal(anova(fm1),fun()) ## test deparsing of long RE terms varChr <- paste0("varname_",outer(letters,letters,paste0)[1:100]) rvars <- varChr[1:9] form <- as.formula(paste("y ~",paste(varChr,collapse="+"), "+", paste0("(",paste(rvars,collapse="+"),"|f)"))) ff <- lme4:::reOnly(form) environment(ff) <- .GlobalEnv expect_equal(ff, ~(varname_aa + varname_ba + varname_ca + varname_da + varname_ea + varname_fa + varname_ga + varname_ha + varname_ia | f)) }) test_that("lapply etc.", { ## copied from dplyr failwith <- function (default = NULL, f, quiet = FALSE) { function(...) { out <- default try(out <- f(...), silent = quiet) out } } lmer_fw <- failwith(NULL,function(...) lmer(...) ,quiet=TRUE) expect_is(lmer_fw(Yield ~ 1|Batch, Dyestuff, REML = FALSE), "merMod") ## GH 369 listOfFormulas <- list( cbind(incidence, size - incidence) ~ 1 + (1 | herd), cbind(incidence, size - incidence) ~ period + (1 | herd)) expect_is(lapply(listOfFormulas,glmer,family=binomial,data=cbpp),"list") }) test_that("formula and data validation work with do.call() in artificial environment", { ## This ensures compatibility of lmer when it's called from the ## C-level Rf_eval() with an environment that doesn't exist on the ## stack (i.e. C implementation in magrittr 2.0) e <- new.env() e$. <- mtcars expect_is( do.call(lme4::lmer, list("disp ~ (1 | cyl)", quote(.)), envir = e), "merMod" ) fn <- function(data) { lme4::lmer("disp ~ (1 | cyl)", data = data) } expect_is( do.call(fn, list(quote(.)), envir = e), "merMod" ) }) test_that("correct environment on reOnly()", { ## GH 654 f <- Reaction ~ Days + (1 | Subject) e <- environment(f) m <- lmer(f, data = sleepstudy) expect_identical(environment(formula(m)), e) # TRUE expect_identical(environment(formula(m, fixed.only = TRUE)), e) # TRUE expect_identical(ee <- environment(formula(m, random.only = TRUE)), e) # FALSE }) lme4/tests/testthat/test-lmList.R0000644000176200001440000001730514176366175016507 0ustar liggesuserslibrary(lme4) library(testthat) ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } context("lmList") test_that("basic lmList", { set.seed(17) fm1. <- lmList(Reaction ~ Days | Subject, sleepstudy, pool=FALSE) fm1 <- lmList(Reaction ~ Days | Subject, sleepstudy) cf.fm1 <- data.frame( `(Intercept)` = c(244.19267, 205.05495, 203.48423, 289.68509, 285.73897, 264.25161, 275.01911, 240.16291, 263.03469, 290.10413, 215.11177, 225.8346, 261.14701, 276.37207, 254.96815, 210.44909, 253.63604, 267.0448), Days = c(21.764702, 2.2617855, 6.1148988, 3.0080727, 5.2660188, 9.5667679, 9.1420455, 12.253141, -2.8810339, 19.025974, 13.493933, 19.504017, 6.4334976, 13.566549, 11.348109, 18.056151, 9.1884448, 11.298073)) expect_equal(signif(coef(fm1), 8), cf.fm1, tolerance = 1e-7, check.attributes=FALSE) expect_equal(coef(fm1.), coef(fm1)) expect_true(inherits(formula(fm1), "formula")) ## <- had been wrong till 2015-04-09 sm1. <- summary(fm1.) sm1 <- summary(fm1) expect_equal(sm1$RSE, 25.5918156267, tolerance = 1e-10) cf1 <- confint(fm1) ## Calling the plot.lmList4.confint() method : expect_true(inherits(pcf1 <- plot(cf1), "trellis")) }) test_that("orthodont", { data(Orthodont, package="nlme") fm2 <- lmList(distance ~ age | Subject, Orthodont) fe2 <- fixef(fm2) expect_equal(fe2, c("(Intercept)" = 16.7611111111111, age = 0.660185185185185)) expect_true(inherits(pairs(fm2), "trellis")) }) test_that("simulated", { set.seed(12) d <- data.frame( g = sample(c("A","B","C","D","E"), 250, replace=TRUE), y1 = runif(250, max=100), y2 = sample(c(0,1), 250, replace=TRUE) ) fm3.1 <- lmList(y1 ~ 1 | g, data=d) expect_equal(coef(fm3.1), structure(list(`(Intercept)` = c(45.8945525606396, 50.1127995110841, 49.5320538515225, 52.4286874305165, 48.7716343882989)), .Names = "(Intercept)", row.names = c("A", "B", "C", "D", "E"), class = "data.frame", label = "Coefficients", effectNames = "(Intercept)", standardized = FALSE)) cf31 <- confint(fm3.1) expect_true(inherits(plot(cf31), "trellis")) fm3.2 <- lmList(y2 ~ 1 | g, data=d, family=binomial) ## ^^^^^^^^ "glmList" cf32 <- suppressMessages(confint(fm3.2,quiet=TRUE)) expect_identical(dim(cf32), c(5L,2:1)) expect_true(inherits(plot(cf32), "trellis")) expect_equal(unname(getDataPart(signif(drop(cf32), 6))), cbind(c(-0.400041, -0.311489, -1.07774, -0.841075, -0.273828), c( 0.743188, 0.768538, 0.0723138, 0.274392, 0.890795))) }) test_that("cbpp", { ## "glmList" (2) -- here, herd == 8 has only one observation => not estimable expect_warning(fm4 <- lmList(cbind(incidence, size - incidence) ~ period | herd, family=binomial, data=cbpp), "Fitting failed for ") cf4 <- coef(fm4) # with some 5 NA's ## match NA locations expect_equal(dim(cf4),c(15,4)) expect_identical(which(is.na(cf4)), sort(as.integer(c(8+15*(0:3), 47)))) expect_warning(fm4B <- lme4::lmList(incidence ~ period | herd, data=cbpp), "Fitting failed") if(FALSE) { ## FIXME: this is actually an nlme bug ... ## https://bugs.r-project.org/bugzilla/show_bug.cgi?id=16542 try(summary(fm4)) ## Error in `[<-`(`*tmp*`, use, use, ii, value = lst[[ii]]) : ## subscript out of bounds library(nlme) data("cbpp",package="lme4") fm6 <- nlme::lmList(incidence ~ period | herd, data=cbpp) try(coef(fm6)) ## coef does *not* work here try(summary(fm6)) ## this is a slightly odd example because the residual df from ## these fits are in fact zero ... so pooled.SD fails, as it should } }) test_that("NA,weights,offsets", { ## from GH #320 set.seed(101) x <- 1:8 y <- c(2,2,5,4,3,1,2,1) g <- c(1,1,1,2,2,3,3,3) dat <- data.frame(x=x, y=y, g=g) m1 <- lmList(y ~ x | g, data=dat) expect_false(any(is.na(coef(m1)))) w <- runif(nrow(sleepstudy)) m2 <- lmList(Reaction ~ Days | Subject, weights=w, sleepstudy) ss <- subset(sleepstudy,Subject==levels(Subject)[1]) m2X <- lm(Reaction ~ Days, ss, weights=w[1:nrow(ss)]) expect_equal(coef(m2X),as.matrix(coef(m2))[1,]) m3 <- lmList(Reaction ~ Days | Subject, sleepstudy) m4 <- lmList(Reaction ~ Days | Subject, offset=w, sleepstudy) m4X <- lm(Reaction ~ Days, ss, offset=w[1:nrow(ss)]) expect_equal(coef(m4X),as.matrix(coef(m4))[1,]) expect_false(identical(m2,m3)) expect_false(identical(m4,m3)) m5 <- lmList(Reaction ~ Days + offset(w) | Subject, sleepstudy) expect_equal(coef(m5),coef(m4)) ## more from GH 320 dat2 <- data.frame(dat,xx=c(NA,NA,NA,1:4,NA)) m5 <- lmList(y ~ x | g, data=dat2) expect_equal(unlist(coef(m5)[1,]), coef(lm(y~x,subset=(g==1)))) expect_equal(unlist(coef(m5)[3,]), coef(lm(y~x,subset=(g==3)))) }) test_that("pooled", { ## GH #26 fm_lme4 <- lme4:::lmList(Reaction ~ Days | Subject, sleepstudy) fm_nlme <- nlme:::lmList(Reaction ~ Days | Subject, sleepstudy) fm_nlme_nopool <- nlme:::lmList(Reaction ~ Days | Subject, sleepstudy, pool=FALSE) ci_lme4_pooled <- confint(fm_lme4,pool=TRUE) #get low and high CI estimates and pooled sd ci_nlme_pooled <- nlme:::intervals(fm_nlme,pool=TRUE) expect_equal(unname(ci_lme4_pooled[,,1]),unname(ci_nlme_pooled[,c(1,3),1])) ci_lme4_nopool1 <- confint(fm_lme4,pool=FALSE) ci_lme4_nopool2 <- confint(fm_lme4) expect_identical(ci_lme4_nopool1,ci_lme4_nopool2) ## BUG in nlme::intervals ... ? can't get CIs on unpooled fits ## nlme::intervals(fm_nlme,pool=FALSE) ## nlme::intervals(fm_nlme_nopool) expect_equal(ci_lme4_nopool1[1:3,,1], structure(c(179.433862895996, 193.026448122379, 186.785722998616, 308.951475285822, 217.083442786712, 220.182727910474), .Dim = c(3L, 2L), .Dimnames = list(c("308", "309", "310"), c("2.5 %", "97.5 %")))) }) test_that("derived variables", { fm_lme4 <- lme4:::lmList(log(Reaction) ~ Days | Subject, sleepstudy) fm_nlme <- nlme:::lmList(log(Reaction) ~ Days | Subject, sleepstudy) expect_equal(c(coef(fm_lme4)),c(coef(fm_nlme)),tolerance=1e-5) }) test_that("subset", { data(MathAchieve, package="nlme") data(MathAchSchool, package="nlme") RB <- merge(MathAchieve, MathAchSchool[, c("School", "Sector")], by="School") names(RB) <- tolower(names(RB)) RB$cses <- with(RB, ses - meanses) cat.list.nlme <- nlme::lmList(mathach ~ cses | school, subset = sector=="Catholic", data=RB) cat.list.lme4 <- lme4::lmList(mathach ~ cses | school, subset = sector=="Catholic", data=RB) expect_equal(c(coef(cat.list.lme4)), c(coef(cat.list.nlme)),tolerance=1e-5) }) if (requireNamespace("tibble")) { test_that("avoid tibble warnings", { ## GH 645 op <- options(warn = 2) m1 <- lmList(Reaction ~ Days | Subject, data = sleepstudy) m2 <- lmList(Reaction ~ Days | Subject, data = tibble::as_tibble(sleepstudy)) expect_identical(coef(m1), coef(m2)) options(op) }) } lme4/tests/testthat/test-ranef.R0000644000176200001440000000735614062244632016326 0ustar liggesusersstopifnot(require("testthat"), require("lme4")) set.seed(101) n <- 500 d <- data.frame(x=rnorm(n), f=factor(sample(1:10,n,replace=TRUE), labels=LETTERS[1:10]), g=factor(sample(1:25,n,replace=TRUE), labels=letters[1:25])) d$y <- suppressMessages(simulate(~1+x+(1|f)+(x|g),family=binomial, newdata=d, newparams=list(beta=c(0,1), theta=c(1,1,2,1)))[[1]]) fm1 <- glmer(y~(1|f)+(x|g),family=binomial,data=d) context("ranef") test_that("warn extra args", { expect_warning(ranef(fm1,transf=exp),"additional arguments") }) test_that("dotplot_ranef", { rr <- ranef(fm1,condVar=TRUE) expect_is(lattice::dotplot(rr,scales=list(x = list(relation = 'free')))$g, "trellis") expect_is(lattice::dotplot(rr,transf=exp, scales=list(x = list(relation = 'free')))$g, "trellis") expect_is(as.data.frame(rr),"data.frame") rr0 <- ranef(fm1) expect_is(as.data.frame(rr0),"data.frame") }) test_that("Dyestuff consistent with lme4.0", { lme4.0condVarDyestuff <- c(362.3583, 362.3583, 362.3583, 362.3583, 362.3583, 362.3583) fm <- lmer(Yield ~ 1|Batch, Dyestuff, REML=FALSE) lme4condVarDyestuff <- drop(attr(ranef(fm,condVar=TRUE)$Batch,"postVar")) expect_equal(lme4.0condVarDyestuff, lme4condVarDyestuff, tolerance = 1e-3) }) test_that("sleepstudy consistent with lme4.0", { lme4.0condVarsleepstudy <- matrix(c(145.71273, -21.440414, -21.44041, 5.310927), 2, 2) fm <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) lme4condVarsleepstudy <- attr(ranef(fm,condVar=TRUE)$Subject,"postVar")[,,1] expect_equal(lme4.0condVarsleepstudy, lme4condVarsleepstudy, tolerance = 2e-4) }) test_that("cbpp consistent with lme4.0", { lme4.0condVarcbpp <- c(0.12128867, 0.13363275, 0.08839850, 0.17337928, 0.12277914, 0.14436663, 0.10658333, 0.10309812, 0.21289738, 0.13740279, 0.09555677, 0.19460241, 0.14808316, 0.12631006, 0.15816769) gm <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) lme4condVarcbpp <- as.numeric(attr(ranef(gm,condVar=TRUE)$herd,"postVar")) expect_equal(lme4.0condVarcbpp, lme4condVarcbpp, tolerance = 1e-3) }) context("multiple terms per factor") test_that("multiple terms work", { fm <- lmer(Reaction ~ Days + (1|Subject)+ (0+Days | Subject), sleepstudy, control=lmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6))) rr <- ranef(fm, condVar=TRUE) expect_equal(as.data.frame(rr)[c(1,19),], structure( list(grpvar = c("Subject", "Subject"), term = structure(1:2, .Label = c("(Intercept)", "Days"), class = "factor"), grp = structure(c(9L, 9L), .Label = c("309", "310", "370", "349", "350", "334", "335", "371", "308", "369", "351", "332", "372", "333", "352", "331", "330", "337"), class = "factor"), condval = c(1.5116973008, 9.32373076098), condsd = c(12.238845590, 2.33546851406)), row.names = c(1L, 19L), class = "data.frame"), tolerance = 1e-5) cv <- attr(rr$Subject, "postVar") expect_equal(lapply(cv, drop), list(`(Intercept)` = rep(149.79166, 18), Days = rep(5.4543894, 18)), tolerance = 1e-4) }) lme4/tests/testthat/test-oldRZXfailure.R0000644000176200001440000000076213751775607017776 0ustar liggesuserslibrary(lme4) library(testthat) load(system.file("testdata","crabs_randdata00.Rda",package="lme4")) test_that('RZX is being calculated properly', { # this is a test for an old problem, documented here: # http://stevencarlislewalker.github.io/notebook/RZX_problems.html fr <- cbind(final.snail.density, snails.lost) ~ crab.speciesS + crab.sizeS + crab.speciesS:crab.sizeS + (snail.size | plot) m <- glmer(fr, data = randdata00, family = binomial) expect_that(m, is_a("glmerMod")) }) lme4/tests/testthat/test-doubleVertNotation.R0000644000176200001440000000617213751775607021074 0ustar liggesuserslibrary("lme4") library("testthat") context("testing '||' notation for independent ranefs") test_that("basic intercept + slope '||' works", { expect_equivalent( lFormula(Reaction ~ Days + (Days||Subject), sleepstudy)$reTrms, lFormula(Reaction ~ Days + (1|Subject) + (0 + Days|Subject), sleepstudy)$reTrms ) expect_equivalent( fitted(lmer(Reaction ~ Days + (Days||Subject), sleepstudy)), fitted(lmer(Reaction ~ Days + (1|Subject) + (0 + Days|Subject), sleepstudy)) ) }) test_that("'||' works with nested, multiple, or interaction terms" , { #works with nested expect_equivalent(findbars(y ~ (x || id / id2)), findbars(y ~ (1 | id / id2) + (0 + x | id / id2))) #works with multiple expect_equivalent(findbars(y ~ (x1 + x2 || id / id2) + (x3 | id3) + (x4 || id4)), findbars(y ~ (1 | id / id2) + (0 + x1 | id / id2) + (0 + x2 | id / id2) + (x3 | id3) + (1 | id4) + (0 + x4| id4))) #interactions: expect_equivalent(findbars(y ~ (x1*x2 || id)), findbars(y ~ (1 | id) + (0+x1 | id) + (0 + x2 | id) + (0 + x1:x2 | id))) }) test_that("quoted terms work", { ## used to fail in test-oldRZXFailure.R f <- quote(crab.speciesS + crab.sizeS + crab.speciesS:crab.sizeS + (snail.size | plot)) expect_equivalent(findbars(f)[[1]], (~(snail.size|plot))[[2]][[2]] ) }) test_that("leaves superfluous '||' alone", { expect_equivalent(findbars(y ~ z + (0 + x || id)), findbars(y ~ z + (0 + x | id))) }) test_that("plays nice with parens in fixed or random formulas", { expect_equivalent(findbars(y ~ (z + x)^2 + (x || id)), findbars(y ~ (z + x)^2 + (1 | id) + (0 + x | id))) expect_equivalent(findbars(y ~ ((x || id)) + (x2|id)), findbars(y ~ (1 | id) + (0 + x | id) + (x2|id))) }) test_that("update works as expected", { m <- lmer(Reaction ~ Days + (Days || Subject), sleepstudy) expect_equivalent(fitted(update(m, .~.-(0 + Days | Subject))), fitted(lmer(Reaction ~ Days + (1|Subject), sleepstudy))) }) test_that("long formulas work",{ form <- log.corti~z.n.fert.females*z.n.males+ is.alpha2*(z.infanticide.susceptibility+z.min.co.res+ z.co.res+z.log.tenure)+ z.xtime+z.age.at.sample+sin.season+cos.season+ (1 +z.n.fert.females +z.n.males +is.alpha2.subordinate +z.infanticide.susceptibility +z.min.co.res +z.log.tenure +z.co.res +z.xtime +z.age.at.sample +sin.season +cos.season +I(z.n.fert.females*z.n.males) +I(is.alpha2.subordinate*z.min.co.res) +I(z.co.res*is.alpha2.subordinate) +I(is.alpha2.subordinate*z.co.res) +int.is.a.log.ten ||monkeyid) expStr <- paste(deparse(expandDoubleVerts(form),width=500),collapse="") ## check: no spurious ~ induced expect_equal(1,sum(grepl("~",strsplit(expStr,"")[[1]]))) }) lme4/tests/testthat/test-nbinom.R0000644000176200001440000001042314063503234016477 0ustar liggesuserslibrary("lme4") library("testthat") testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 set.seed(101) dd <- expand.grid(f1 = factor(1:3), f2 = LETTERS[1:2], g=1:9, rep=1:15, KEEP.OUT.ATTRS=FALSE) mu <- 5*(-4 + with(dd, as.integer(f1) + 4*as.numeric(f2))) dd$y <- rnbinom(nrow(dd), mu = mu, size = 0.5) ## mimic glmer.nb protocol if (testLevel>1) { test_that("most messages suppressed", { expect_message(glmer.nb(y ~ f1 + (1|g), data=dd[1:10,]), "singular") }) test_that("ok with negative.binomial masking", { negative.binomial <- function() {} ## use shortened version of data for speed ... m.base <- glmer.nb(y ~ f1 + (1|g), data=dd[1:200,]) expect_is(m.base,"merMod") }) test_that("ok with Poisson masking", { poisson <- NA ## use shortened version of data for speed ... m.base <- glmer.nb(y ~ f1 + (1|g), data=dd[1:200,]) expect_is(m.base,"merMod") rm(poisson) }) if (testLevel>2) { context("testing glmer refit") test_that("glmer refit", { ## basic Poisson fit m.base <- glmer(y ~ f1*f2 + (1|g), data=dd, family=poisson) expect_equal(m.base@beta,(m.base.r <- refit(m.base))@beta, tolerance = 1e-5) th <- lme4:::est_theta(m.base,limit=20,eps=1e-4,trace=FALSE) th0 <- structure(0.482681268108477, SE = 0.0244825021248148) th1 <- structure(0.482681277470945) th2 <- 0.482681268108477 th3 <- 0.4826813 ## NB update with raw number m.numth1 <- update(m.base,family=MASS::negative.binomial(theta=0.4826813)) expect_equal(m.numth1@beta,(m.numth1.r <- refit(m.numth1))@beta) ## strip NB value m.symth4 <- update(m.base,family=MASS::negative.binomial(theta=c(th))) expect_equal(m.symth4@beta,(m.symth4.r <- refit(m.symth4))@beta) ## IDENTICAL numeric value to case #1 above m.symth6 <- update(m.base,family=MASS::negative.binomial(theta=th3)) expect_equal(m.symth6@beta,(m.symth6.r <- refit(m.symth6))@beta) ## standard NB update with computed theta from est_theta (incl SE attribute) m.symth <- update(m.base,family=MASS::negative.binomial(theta=th)) expect_equal(m.symth@beta,(m.symth.r <- refit(m.symth))@beta) ## NB update with equivalent value m.symth2 <- update(m.base,family=MASS::negative.binomial(theta=th0)) expect_equal(m.symth2@beta,(m.symth2.r <- refit(m.symth2))@beta) ## NB update with theta value (stored as variable, no SE) only m.symth3 <- update(m.base,family=MASS::negative.binomial(theta=th1)) expect_equal(m.symth3@beta,(m.symth3.r <- refit(m.symth3))@beta) ## strip NB value (off by 5e-16) m.symth5 <- update(m.base,family=MASS::negative.binomial(theta=th2)) expect_equal(m.symth5@beta,(m.symth5.r <- refit(m.symth5))@beta) }) ## GH #399 test_that("na_exclude", { dd1 <- dd[1:200,] dd1$f1[1:5] <- NA expect_error(glmer.nb(y ~ f1 + (1|g), data=dd1, na.action=na.fail), "missing values in object") m1 <- glmer.nb(y ~ f1 + (1|g), data=dd1, na.action=na.omit) m2 <- glmer.nb(y ~ f1 + (1|g), data=dd1, na.action=na.exclude) expect_equal(fixef(m1),fixef(m1)) expect_equal(length(predict(m2))-length(predict(m1)),5) }) ## GH 423 test_that("start_vals", { dd1 <- dd[1:200,] g1 <- glmer.nb(y ~ f1 + (1|g), data=dd1) g2 <- glmer.nb(y ~ f1 + (1|g), data=dd1, initCtrl=list(theta=getME(g1,"glmer.nb.theta"))) expect_equal(fixef(g1),fixef(g2),tol=1e-5) }) test_that("control arguments", { dd1 <- dd[1:200,] g1 <- glmer.nb(y ~ f1 + (1|g), data=dd1, initCtrl=list(theta=10)) expect_is(g1,"merMod") ## dumb test - just checking for run w/o error suppressWarnings(g1 <- glmer.nb(y ~ f1 + (1|g), data=dd1, nb.control=glmerControl(optimizer="bobyqa"))) expect_equal(g1@optinfo$optimizer, "bobyqa") suppressWarnings(g1 <- glmer.nb(y ~ f1 + (1|g), data=dd1, nb.control=glmerControl(optCtrl=list(maxfun=2)))) expect_equal(g1@optinfo$feval,3) }) } ## testLevel>2 } ## testLevel>1 lme4/tests/testthat/test-allFit.R0000644000176200001440000000703614063503234016436 0ustar liggesuserstestLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 if (testLevel>1) { library("testthat") library("lme4") L <- load(system.file("testdata", "lme-tst-fits.rda", package="lme4", mustWork=TRUE)) gm_all <- allFit(fit_cbpp_1, verbose=FALSE) context("Show basic allFit results") test_that("allFit print/summary is fine", { expect_is(gm_all, "allFit") expect_is(summary(gm_all), "summary.allFit") }) test_that("nloptwrap switches optimizer correctly", { expect_equal(attr(gm_all[["nloptwrap.NLOPT_LN_BOBYQA"]],"optCtrl"), list(algorithm = "NLOPT_LN_BOBYQA")) expect_equal(attr(gm_all[["nloptwrap.NLOPT_LN_NELDERMEAD"]],"optCtrl"), list(algorithm = "NLOPT_LN_NELDERMEAD")) }) test_that("lmerControl() arg works too", { fm0 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) fm <- update(fm0, control = lmerControl(optCtrl = list(xtol_rel = 1e-8, ftol_rel = 1e-8), calc.derivs=FALSE)) afm0 <- allFit(fm0,verbose=FALSE) afm <- allFit(fm,verbose=FALSE) # used to fail drop_ <- function(x) { x[setdiff(names(x), c("times","feval"))] } ## should be approximately the same expect_equal(drop_(summary(afm0)), drop_(summary(afm)), tolerance = 1e-2) ## should NOT be the same! expect_false(isTRUE(all.equal(drop_(summary(afm0)), drop_(summary(afm)), tolerance=1e-10))) }) test_that("glmerControl() arg + optimizer", { ## GH #523? fit_cbpp_1u <- update(fit_cbpp_1, control=glmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-10, ftol_abs=1e-10))) af2 <- allFit(fit_cbpp_1u, verbose=FALSE) expect_equal(class(af2),"allFit") }) test_that("i in model call is OK", { ## GH #538 ## ugh, testthat scoping is insane ... ## if d and i are ## assigned normally with <- outside expect_true(), test fails ## BUT global assignment of 'd' breaks downstream tests in ## 'data= argument and formula evaluation' (test-formulaEval.R) ## ddd breaks similar test in 'fitting lmer models' (test-lmer.R) ## (where 'd' is supposed to be nonexistent) ## if we do global assignment with <<- ## can't figure out how to remove d (or ddd) after it's created to leave ## the environment clean ... ## tried to encapsulate all the necessary assignments ## within expect_true({ ... }) but that fails in other ways nr <- nrow(sleepstudy) ..dd <<- list(sleepstudy[1:nr,], sleepstudy[-(1:nr)]) i <<- 1 fm0 <- lmer(Reaction ~ Days + (1 | Subject), data=..dd[[i]]) aa <- allFit(fm0, verbose=FALSE) expect_true( all(summary(aa)$which.OK) ) }) test_that("allFit/update scoping", { ## GH #601 fit_func <- function(dataset) { gm1 <- glmer( cbind(incidence, size - incidence) ~ period + (1 | herd), data = dataset, family = binomial ) allFit(gm1, catch.errs=FALSE) } cc <- capture.output(ff <- fit_func(cbpp)) expect_true(all(summary(ff)$which.OK)) }) } ## testLevel lme4/tests/testthat/test-lmerResp.R0000644000176200001440000000435713751775607017041 0ustar liggesuserslibrary("lme4") library("testthat") data(Dyestuff, package="lme4") n <- nrow(Dyestuff) ones <- rep.int(1, n) zeros <- rep.int(0, n) YY <- Dyestuff$Yield mYY <- mean(YY) context("lmerResp objects") test_that("lmerResp", { mres <- YY - mYY rr <- lmerResp$new(y=YY) expect_that(rr$weights, equals(ones)) expect_that(rr$sqrtrwt, equals(ones)) expect_that(rr$sqrtXwt, equals(ones)) expect_that(rr$offset, equals(zeros)) expect_that(rr$mu, equals(zeros)) expect_that(rr$wtres, equals(YY)) expect_that(rr$wrss(), equals(sum(YY^2))) expect_that(rr$updateMu(rep.int(mYY, n)), equals(sum(mres^2))) expect_that(rr$REML, equals(0L)) rr$REML <- 1L expect_that(rr$REML, equals(1L)) }) mlYY <- mean(log(YY)) gmeanYY <- exp(mlYY) # geometric mean context("glmResp objects") test_that("glmResp", { mres <- YY - gmeanYY gmean <- rep.int(gmeanYY, n) rr <- glmResp$new(family=poisson(), y=YY) expect_that(rr$weights, equals(ones)) expect_that(rr$sqrtrwt, equals(ones)) expect_that(rr$sqrtXwt, equals(ones)) expect_that(rr$offset, equals(zeros)) expect_that(rr$mu, equals(zeros)) expect_that(rr$wtres, equals(YY)) expect_that(rr$n, equals(ones)) ## wrss() causes an update of mu which becomes ones, wtres also changes expect_that(rr$wrss(), equals(sum((YY-1)^2))) expect_that(rr$mu, equals(ones)) expect_that(rr$wtres, equals(YY-ones)) expect_that(rr$updateMu(rep.int(mlYY, n)), equals(sum(mres^2))) expect_that(rr$mu, equals(gmean)) expect_that(rr$muEta(), equals(gmean)) expect_that(rr$variance(), equals(gmean)) rr$updateWts() expect_that(1/sqrt(rr$variance()), equals(rr$sqrtrwt)) expect_that(as.vector(rr$sqrtXwt), equals(rr$sqrtrwt * rr$muEta())) }) lme4/tests/testthat/test-glmmFail.R0000644000176200001440000000263313751775607016773 0ustar liggesuserslibrary("testthat") library("lme4") source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##-> gSim(), a general simulation function ... set.seed(101) dBc <- gSim(family=binomial(link="cloglog"), nbinom = 1) # {0,1} Binomial ## 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")), "Response is constant") expect_error(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, REML=TRUE), "unused argument.*REML") expect_warning(glmer(Reaction ~ Days + (Days|Subject), sleepstudy), "calling glmer.*family=gaussian.*deprecated") expect_warning(glmer(Reaction ~ Days + (Days|Subject), sleepstudy, family=gaussian), "calling glmer.*family=gaussian.*deprecated") m3 <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy)) m4 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) m5 <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy, family=gaussian)) expect_equal(fixef(m3),fixef(m5)) m3@call[[1]] <- m5@call[[1]] <- quote(lmer) ## hack call expect_equal(m3,m4) expect_equal(m3,m5) }) lme4/tests/testthat/test-NAhandling.R0000644000176200001440000002016113751775607017242 0ustar liggesusersstopifnot(require("testthat"), require("lme4")) context("NA (and Inf) handling") ## Modified sleepstudy data : sleepst.a <- sleepstudy rownames(sleepst.a) <- paste0("a", rownames(sleepstudy)) sleepstudyNA <- within(sleepst.a, Reaction[1:3] <- NA) sleepstudyNA2 <- within(sleepst.a, Days[1:3] <- NA) sleepInf <- within(sleepstudy, Reaction[Reaction > 400] <- Inf) ## Modified cake data : cakeNA <- rbind(cake, tail(cake,1)) cakeNA[nrow(cakeNA), "angle"] <- NA ## Create new data frame with some NAs in fixed effect cakeNA.X <- within(cake, temp[1:5] <- NA) ## NA values in random effects -- should get treated cakeNA.Z <- within(cake, replicate[1:5] <- NA) test_that("naming", { ## baseline model fm1 <- lmer(Reaction~Days+(Days|Subject), sleepst.a) ## default: na.omit fm2 <- update(fm1, data=sleepstudyNA, control=lmerControl(check.conv.grad="ignore")) expect_equal(head(names(fitted(fm1))), paste0("a",1:6)) expect_equal(head(names(fitted(fm2))), paste0("a",4:9)) expect_equal(names(predict(fm2)), names(fitted(fm2))) expect_equal(length(p1 <- predict(fm2)), 177) ## predict with na.exclude -> has 3 NA's, but otherwise identical: expect_equal(length(p2 <- predict(fm2, na.action=na.exclude)), 180) expect_identical(p1, p2[!is.na(p2)]) expect_equal(length((s1 <- simulate(fm1,1))[[1]]),180) expect_equal(length((s2 <- simulate(fm2,1))[[1]]),177) expect_equal(head(rownames(s1)),paste0("a",1:6)) expect_equal(head(rownames(s2)),paste0("a",4:9)) ## test simulation expect_is(attr(simulate(fm2),"na.action"),"omit") expect_is(refit(fm2,simulate(fm2)),"merMod") expect_equal(fixef(fm2), fixef(refit(fm2, sleepstudyNA$Reaction)), tolerance = 1e-5) fm2ex <- update(fm2, na.action=na.exclude) expect_equal(nrow(ss2 <- simulate(fm2ex)),180) expect_is(refit(fm2,ss2[[1]]),"merMod") ## issue #197, 18 new subjects; some with NA in y d2 <- sleepstudyNA[c(1:180, 1:180),] d2[,"Subject"] <- factor(rep(1:36, each=10)) d2[d2$Subject == 19, "Reaction"] <- NA expect_equal(dim( simulate(fm1, newdata=d2, allow.new.levels=TRUE) ), c(360,1)) ## na.pass (pretty messed up) expect_error(update(fm1,data=sleepstudyNA, control=lmerControl(check.conv.grad="ignore"), na.action=na.pass), "NA/NaN/Inf in 'y'") sleepstudyNA2 <- within(sleepst.a, Days[1:3] <- NA) expect_error(fm4 <- update(fm1, data = sleepstudyNA2, control=lmerControl(check.conv.grad="ignore"), na.action=na.pass),"NA in Z") expect_is(suppressWarnings(confint(fm2,method="boot",nsim=3, quiet=TRUE)),"matrix") expect_error(update(fm1, data = sleepstudyNA2, control = lmerControl(check.conv.grad="ignore"), na.action = na.pass), "NA in Z") expect_is(suppressWarnings( ci2 <- confint(fm2, method="boot", nsim=3, quiet=TRUE)), "matrix") }) test_that("other_NA", { expect_error(lmer(Reaction ~ Days + (Days | Subject), sleepInf), "\\") fm0 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake) ## NA's in response : fm1 <- update(fm0, data = cakeNA) expect_true(all.equal( fixef(fm0), fixef(fm1))) expect_true(all.equal(VarCorr(fm0),VarCorr(fm1))) expect_true(all.equal( ranef(fm0), ranef(fm1))) fm1_omit <- update(fm1, na.action = na.omit) fm1_excl <- update(fm1, na.action = na.exclude) expect_error(update(fm1, na.action = na.pass), "NA/NaN") expect_error(update(fm1, na.action = na.fail), "missing values in object") fm1_omit@call <- fm1@call ## <- just for comparing: expect_equal(fm1, fm1_omit) expect_equal(length(fitted(fm1_omit)), 270) expect_equal(length(fitted(fm1_excl)), 271) expect_true(is.na(tail(predict(fm1_excl),1))) ## test predict.lm d <- data.frame(x = 1:10, y = c(rnorm(9),NA)) lm1 <- lm(y~x, data=d, na.action=na.exclude) expect_is(predict(lm1), "numeric") expect_equal(1, sum(is.na(predict(lm1, newdata = data.frame(x=c(1:4,NA)))))) ## Triq examples ... m.lmer <- lmer (angle ~ temp + (1 | recipe) + (1 | replicate), data=cake) ## NAs in fixed effect p1_pass <- predict(m.lmer, newdata=cakeNA.X, re.form=NA, na.action=na.pass) expect_true(length(p1_pass)==nrow(cakeNA.X)) expect_true(all(is.na(p1_pass[1:5]))) p1_omit <- predict(m.lmer, newdata=cakeNA.X, re.form=NA, na.action=na.omit) p1_exclude <- predict(m.lmer, newdata=cakeNA.X, re.form=NA, na.action=na.exclude) expect_true(length(p1_omit)==nrow(na.omit(cakeNA.X))) expect_true(length(p1_exclude)==nrow(cakeNA.X)) expect_true(all.equal(c(na.omit(p1_exclude)),p1_omit)) expect_error(predict(m.lmer, newdata=cakeNA.X, re.form=NA, na.action=na.fail), "missing values in object") ## now try it with re.form==NULL p2_pass <- predict(m.lmer, newdata=cakeNA.X, re.form=NULL, na.action=na.pass) expect_true(length(p2_pass)==nrow(cakeNA.X)) expect_true(all(is.na(p2_pass[1:5]))) p2_omit <- predict(m.lmer, newdata=cakeNA.X, re.form=NULL, na.action=na.omit) p2_exclude <- predict(m.lmer, newdata=cakeNA.X, re.form=NULL, na.action=na.exclude) expect_true(length(p2_omit)==nrow(na.omit(cakeNA.X))) expect_true(all.equal(c(na.omit(p2_exclude)),p2_omit)) expect_error(predict(m.lmer, newdata=cakeNA.X, re.form=NULL, na.action=na.fail), "missing values in object") ## experiment with NA values in random effects -- should get treated expect_error(predict(m.lmer, newdata=cakeNA.Z, re.form=NULL), "NAs are not allowed in prediction data") p4 <- predict(m.lmer, newdata=cakeNA.Z, re.form=NULL, allow.new.levels=TRUE) p4B <- predict(m.lmer, newdata=cakeNA.Z, re.form=~1|recipe, allow.new.levels=TRUE) expect_true(all.equal(p4[1:5],p4B[1:5])) p4C <- predict(m.lmer, newdata=cakeNA.Z, re.form=NA) d <- data.frame(x=runif(100),f=factor(rep(1:10,10))) set.seed(101) u <- rnorm(10) d <- transform(d,y=rnorm(100,1+2*x+u[f],0.2)) d0 <- d d[c(3,5,7),"x"] <- NA ## 'omit' and 'exclude' are the only choices under which ## we will see NA values in the results fm0 <- lmer(y~x+(1|f), data=d0) ## no 'na.action' attribute because no NAs in this data set expect_equal(attr(model.frame(fm0),"na.action"),NULL) fm1 <- update(fm0, data=d) ## no NAs in predict or residuals because na.omit expect_false(any(is.na(predict(fm1)))) expect_false(any(is.na(residuals(fm1)))) fm2 <- update(fm1,na.action="na.exclude") ## no NAs in predict or residuals because na.omit nNA <- sum(is.na(d$x)) expect_equal(sum(is.na(predict(fm2))),nNA) expect_equal(sum(is.na(residuals(fm2))),nNA) expect_error(fm3 <- lmer(y~x+(1|f), data=d, na.action="na.pass"), "(Error in qr.default|NA/NaN/Inf in foreign function call)") expect_is(refit(fm0),"merMod") expect_is(refit(fm1),"merMod") expect_is(refit(fm2),"merMod") ## GH 420: NAs in training data should *not* get ## carried over into predictions! fm4 <- lmer(Reaction~Days+(1|Subject),sleepstudyNA2) pp4 <- predict(fm4,newdata=sleepstudy) expect_equal(length(pp4),nrow(sleepstudy)) expect_equal(sum(is.na(pp4)),0) }) test_that("NAs in fitting data ignored in newdata with random.only=TRUE", { set.seed(101) dd <- data.frame(x=c(rnorm(199),NA),y=rnorm(200), f=factor(rep(1:10,each=20)), g=factor(rep(1:20,each=10))) m1 <- lmer(y~x+(1|f)+(1|g),data=dd,na.action=na.exclude) expect_equal(length(predict(m1,newdata=dd[1:5,],random.only=TRUE)),5) nd.NA <- dd[1:5,] nd.NA$x[5] <- NA ## ?? not *quite* sure what should happen here ... predict(m1,newdata=nd.NA,random.only=TRUE) }) lme4/tests/testthat/test-methods.R0000644000176200001440000010503314063773252016673 0ustar liggesuserslibrary("testthat") library("lme4") testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } L <- load(system.file("testdata", "lme-tst-fits.rda", package="lme4", mustWork=TRUE)) ## FIXME: should test for old R versions, skip reloading test data in that ## case? fm0 <- fit_sleepstudy_0 fm1 <- fit_sleepstudy_1 fm2 <- fit_sleepstudy_2 gm1 <- fit_cbpp_1 gm2 <- fit_cbpp_2 gm3 <- fit_cbpp_3 ## More objects to use in all contexts : set.seed(101) dNA <- data.frame( xfac= sample(letters[1:10], 100, replace=TRUE), xcov= runif(100), resp= rnorm(100)) dNA[sample(1:100, 10), "xcov"] <- NA CI.boot <- function(fm, nsim=10, seed=101, ...) suppressWarnings(confint(fm, method="boot", nsim=nsim, quiet=TRUE, seed=seed, ...)) ## rSimple <- function(rep = 2, m.u = 2, kinds = c('fun', 'boring', 'meh')) { stopifnot(is.numeric(rep), rep >= 1, is.numeric(m.u), m.u >= 1, is.character(kinds), (nk <- length(kinds)) >= 1) nobs <- rep * m.u * nk data.frame(kind= rep(kinds, each=rep*m.u), unit = gl(m.u, 1, nobs), y = round(50*rnorm(nobs))) } d12 <- rSimple() data("Pixel", package="nlme") nPix <- nrow(Pixel) fmPix <- lmer(pixel ~ day + I(day^2) + (day | Dog) + (1 | Side/Dog), data = Pixel) test_that("summary", { ## test for multiple-correlation-warning bug and other 'correlation = *' variants ## Have 2 summary() versions, each with 3 print(.) ==> 6 x capture.output(.) sf.aa <- summary(fit_agridat_archbold) msg1 <- "Correlation.* not shown by default" ## message => *not* part of capture.*(.) expect_message(c1 <- capture.output(sf.aa), msg1) # correlation = NULL - default cF <- capture.output(print(sf.aa, correlation=FALSE)) ## TODO? ensure the above gives *no* message/warning/error expect_identical(c1, cF) expect_message( cT <- capture.output(print(sf.aa, correlation=TRUE)) , "Correlation.* could have been required in summary()") expect_identical(cF, cT[seq_along(cF)]) sfT.aa <- summary(fit_agridat_archbold, correlation=TRUE) expect_message(cT2 <- capture.output(sfT.aa), msg1) expect_identical(cF, cT2) cT3 <- capture.output(print(sfT.aa, correlation=TRUE)) expect_identical(cT, cT3) cF2 <- capture.output(print(sfT.aa, correlation=FALSE)) expect_identical(cF, cF2) }) test_that("lmer anova", { aa <- suppressMessages(anova(fm0,fm1)) expect_that(aa, is_a("anova")) expect_equal(names(aa), c("npar", "AIC", "BIC", "logLik", "deviance", "Chisq", "Df", "Pr(>Chisq)")) expect_warning(suppressMessages(do.call(anova,list(fm0,fm1))), "assigning generic names") ## dat <- data.frame(y = 1:5, u = c(rep("A",2), rep("B",3)), t = c(rep("A",3), rep("B",2))) datfun <- function(x) dat aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa <- dat expect_is(stats::anova(lmer(y ~ u + (1 | t), dat = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, REML=FALSE), lmer(y ~ 1 + (1 | t), dat = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, REML=FALSE)), "anova") expect_equal(rownames(stats::anova(lmer(y ~ u + (1 | t), dat = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, REML=FALSE), lmer(y ~ 1 + (1 | t), dat = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, REML=FALSE), model.names=c("a","b"))), c("b","a")) ff <- function(form) { lmer(form, dat=dat, REML=FALSE, control=lmerControl(check.conv.singular="ignore")) } expect_error(rownames(stats::anova(ff(y ~ u + (1 | t)), ff(y ~ 1 + (1 | t)), model.names=c("a","b","c"))), "different lengths") z <- 1 ## output not tested (but shouldn't fail) ss <- stats::anova(lmer(y ~ u + (1 | t), data = datfun(z), REML=FALSE), lmer(y ~ 1 + (1 | t), data = datfun(z), REML=FALSE)) ## ## from Roger Mundry via Roman Lustrik full <- lmer(resp ~ xcov + (1|xfac), data=dNA) null <- lmer(resp ~ 1 + (1|xfac), data=dNA) expect_error(anova(null,full), "models were not all fitted to the same size of dataset") }) ## Github issue #256 from Jonas Lindeløv -- issue is *not* specific for this dataset test_that("Two models with subset() within lmer()", { full3 <- lmer(y ~ kind + (1|unit), subset(d12, kind != 'boring'), REML=FALSE) null3 <- update(full3, .~. - kind) op <- options(warn = 2) # no warnings! ano3 <- anova(full3, null3)## issue #256: had warning in data != data[[1]] : ... o3 <- capture.output(ano3) # now prints with only one 'Data:' expect_equal(1, grep("^Data:", o3)) d12sub <- subset(d12, kind != 'boring') expect_is(full3s <- lmer(y ~ kind + (1|unit), d12sub, REML=FALSE), "lmerMod") expect_is(null3s <- update(full3s, .~. - kind), "lmerMod") expect_is(ano3s <- anova(full3s, null3s), "anova") expect_equal(ano3, ano3s, check.attributes=FALSE) options(op) }) test_that("anova() of glmer+glm models", { dat <<- data.frame(y = 1:5, u = c(rep("A",2), rep("B",3)), t = c(rep("A",3), rep("B",2))) cs <- glmerControl(check.conv.singular = "ignore") ## ignore singular fits gm1 <- glmer(y~(1|u), data=dat[1:4,], family=poisson, control = cs) gm0 <- glm(y~1, data=dat[1:4,], family=poisson) gm2 <- glmer(y~(1|u), data=dat[1:4,], family=poisson,nAGQ=2, control = cs) aa <- anova(gm1,gm0) expect_equal(aa[2,"Chisq"],0) expect_error(anova(gm2,gm0),"incommensurate") }) test_that("anova() of lmer+glm models", { dat2 <- dat set.seed(101) dat2$y <- rnorm(5) fm1 <- lmer(y~(1|u),data=dat2,REML=FALSE) fm0 <- lm(y~1,data=dat2) aa2 <- anova(fm1,fm0) expect_equal(aa2[2,"Chisq"],0) expect_warning(anova(fm1,type="III"),"additional arguments ignored") }) test_that("set p-values to NA for equivalent models: #583", { fm0B <- fm0 aa <- suppressMessages(anova(fm0B,fm0)) expect_true(all(is.na(aa[["Pr(>Chisq)"]]))) }) test_that("long names", { ## GH names(sleepstudy) <- c("Reaction", "Days", "Subject_xxxxxxxxxxxxxxxxxxxxxxxxxxx") fm1 <- lmer(Reaction ~ Days + (Days | Subject_xxxxxxxxxxxxxxxxxxxxxxxxxxx), sleepstudy) fm2 <- lmer(Reaction ~ Days + (Days || Subject_xxxxxxxxxxxxxxxxxxxxxxxxxxx), sleepstudy) expect_equal(length(attributes(suppressMessages(anova(fm1,fm2)))$heading),4) }) if (testLevel>1) { context("bootMer confint()") set.seed(47) test_that("bootMer", { ## testing bug-fix for ordering of sd/cor components in sd/cor matrix with >2 rows ## FIXME: This model makes no sense [and CI.boot() fails for "nloptwrap"!] dd <- expand.grid(A=factor(1:3),B=factor(1:10),rep=1:10) dd$y <- suppressMessages(simulate(~1 + (A|B), newdata=dd, newparams=list(beta=1,theta=rep(1,6), sigma=1), family=gaussian, seed=101))[[1]] m1 <- lmer(y ~ 1 + (A|B), data=dd, control=lmerControl(calc.deriv=FALSE)) ci <- CI.boot(m1,seed=101) ci2 <- CI.boot(m1,seed=101) expect_equal(ci,ci2) ci_50 <- CI.boot(m1,level=0.5,seed=101) expect_true(all(ci_50[,"25 %"]>ci[,"2.5 %"])) expect_true(all(ci_50[,"75 %"]1 context("confint_other") test_that("confint", { load(system.file("testdata", "gotway_hessianfly.rda", package = "lme4")) ## generated via: ## gotway_hessianfly_fit <- glmer(cbind(y, n-y) ~ gen + (1|block), ## data=gotway.hessianfly, family=binomial, ## control=glmerControl(check.nlev.gtreq.5="ignore")) ## gotway_hessianfly_prof <- profile(gotway_hessianfly_fit,which=1) ## save(list=ls(pattern="gotway"),file="gotway_hessianfly.rda") expect_equal(confint(gotway_hessianfly_prof)[1,1],0) ## FIXME: should add tests for {-1,1} bounds on correlations as well expect_equal(c(confint(fm1,method="Wald",parm="beta_")), c(232.301892,8.891041,270.508318,12.043531), tolerance=1e-5) ## Wald gives NA for theta values expect_true(all(is.na(confint(fm1,method="Wald",parm="theta_")))) ## check names ci1.p <- suppressWarnings(confint(fm1,quiet=TRUE)) ci1.w <- confint(fm1,method="Wald") ci1.b <- CI.boot(fm1, nsim=2) expect_equal(dimnames(ci1.p), list(c(".sig01", ".sigma", "(Intercept)", "Days"), c("2.5 %", "97.5 %"))) expect_equal(dimnames(ci1.p),dimnames(ci1.w)) expect_equal(dimnames(ci1.p),dimnames(ci1.b)) ci1.p.n <- suppressWarnings(confint(fm1,quiet=TRUE,oldNames=FALSE)) ci1.w.n <- confint(fm1,method="Wald", oldNames=FALSE) ci1.b.n <- CI.boot(fm1, nsim=2, oldNames=FALSE) expect_equal(dimnames(ci1.p.n), list(c("sd_(Intercept)|Subject", "sigma", "(Intercept)", "Days"), c("2.5 %", "97.5 %"))) expect_equal(dimnames(ci1.p.n),dimnames(ci1.w.n)) expect_equal(dimnames(ci1.p.n),dimnames(ci1.b.n)) ## test case of slightly wonky (spline fit fails) but monotonic profiles: ## simfun <- function(J,n_j,g00,g10,g01,g11,sig2_0,sig01,sig2_1){ N <- sum(rep(n_j,J)) x <- rnorm(N) z <- rnorm(J) mu <- c(0,0) sig <- matrix(c(sig2_0,sig01,sig01,sig2_1),ncol=2) u <- MASS::mvrnorm(J,mu=mu,Sigma=sig) b_0j <- g00 + g01*z + u[,1] b_1j <- g10 + g11*z + u[,2] y <- rep(b_0j,each=n_j)+rep(b_1j,each=n_j)*x + rnorm(N,0,sqrt(0.5)) sim_data <- data.frame(Y=y,X=x,Z=rep(z,each=n_j), group=rep(1:J,each=n_j)) } set.seed(102) dat <- simfun(10,5,1,.3,.3,.3,(1/18),0,(1/18)) fit <- lmer(Y~X+Z+X:Z+(X||group),data=dat) if (Sys.info()["sysname"] != "SunOS" && .Platform$OS.type != "windows") { ## doesn't produce warnings on Solaris, or win-builder ... expect_warning(pp <- profile(fit,"theta_"), "non-monotonic profile") expect_warning(cc <- confint(pp),"falling back to linear interpolation") ## very small/unstable problem, needs large tolerance expect_equal(unname(cc[2,]), c(0, 0.509), tolerance=0.09) # "bobyqa" had 0.54276 } badprof <- readRDS(system.file("testdata","badprof.rds", package="lme4")) expect_warning(cc <- confint(badprof), "falling back to linear") expect_equal(cc, array(c(0, -1, 2.50856219044636, 48.8305727797906, NA, NA, 33.1204478717389, 1, 7.33374326592662, 68.7254711217912, -6.90462047196017, NA), dim = c(6L, 2L), dimnames = list(c(".sig01", ".sig02", ".sig03", ".sigma", "(Intercept)", "cYear"), c("2.5 %", "97.5 %"))), tolerance=1e-3) }) context("refit") test_that("refit", { s1 <- simulate(fm1) expect_is(refit(fm1,s1), "merMod") s2 <- simulate(fm1,2) expect_error(refit(fm1,s2), "refit not implemented .* lists") data(Orthodont,package = "nlme") fmOrth <- fm <- lmer(distance ~ I(age - 11) + (I(age - 11) | Subject), data = Orthodont) expect_equal(s1 <- simulate(fm,newdata = Orthodont,seed = 101), s2 <- simulate(fm,seed = 101)) ## works *without* offset ... m5 <- glmer(round(Reaction) ~ Days + (1|Subject), data = sleepstudy, family=poisson, offset=rep(0,nrow(sleepstudy))) m5R <- refit(m5) ## lots of fussy details make expect_equal() on the whole object difficult expect_equal(coef(m5),coef(m5R),tolerance=3e-6) expect_equal(VarCorr(m5),VarCorr(m5R),tolerance=1e-6) expect_equal(logLik(m5),logLik(m5R)) }) if (testLevel>1) { context("predict method") test_that("predict", { d1 <- with(cbpp, expand.grid(period = unique(period), herd = unique(herd))) d2 <- data.frame(period = "1", herd = unique(cbpp$herd)) d3 <- expand.grid(period = as.character(1:3), herd = unique(cbpp$herd)) p0 <- predict(gm1) p1 <- predict(gm1,d1) p2 <- predict(gm1,d2) p3 <- predict(gm1,d3) expect_equal(p0[1], p1[1]) expect_equal(p0[1], p2[1]) expect_equal(p0[1], p3[1]) expect_warning(predict(gm1, ReForm=NA), "is deprecated") ## matrix-valued predictors: Github #201 from Fabian S. sleepstudy$X <- cbind(1, sleepstudy$Days) m <- lmer(Reaction ~ -1 + X + (Days | Subject), sleepstudy) pm <- predict(m, newdata=sleepstudy) expect_is(pm, "numeric") expect_equal(quantile(pm, names = FALSE), c(211.0108, 260.9496, 296.873, 328.6378, 458.1584), tol=1e-5) op <- options(warn = 2) # there should be no warnings! if (require("MEMSS",quietly=TRUE)) { ## test spurious warning with factor as response variable data("Orthodont", package = "MEMSS") # (differently "coded" from the 'default' "nlme" one) silly <- glmer(Sex ~ distance + (1|Subject), data = Orthodont, family = binomial) sillypred <- data.frame(distance = c(20, 25)) ps <- predict(silly, sillypred, re.form=NA, type = "response") expect_is(ps, "numeric") expect_equal(unname(ps), c(0.999989632, 0.999997201), tolerance=1e-6) detach("package:MEMSS") } ## a case with interactions (failed in one temporary version): expect_warning(fmPixS <<- update(fmPix, .~. + Side), "nearly unidentifiable|unable to evaluate scaled gradient|failed to converge") ## (1|2|3); 2 and 3 seen (as Error??) on CRAN's Windows 32bit options(op) set.seed(1); ii <- sample(nrow(Pixel), 16) expect_equal(predict(fmPix, newdata = Pixel[ii,]), fitted(fmPix )[ii]) expect_equal(predict(fmPixS, newdata = Pixel[ii,]), fitted(fmPixS)[ii]) set.seed(7); n <- 100; y <- rnorm(n) dd <- data.frame(id = factor(sample(10, n, replace = TRUE)), x1 = 1, y = y, x2 = rnorm(n, mean = sign(y))) expect_message(m <- lmer(y ~ x1 + x2 + (1 | id), data = dd), "fixed-effect model matrix is rank deficient") expect_is(summary(m),"summary.merMod") ii <- sample(n, 16) expect_equal(predict(m, newdata = dd[ii,]), fitted(m)[ii]) ## predict(*, new..) gave Error in X %*% fixef(object) - now also drops col. ## predict(*, new..) with NA in data {and non-simple model}, issue #246: m1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) sleepst.NA <- sleepstudy ; sleepst.NA$Days[2] <- NA m2 <- update(fm1, data = sleepst.NA) ## maybe tricky for evaluation; fm1 was defined elsewhere, so data expect_equal(length(predict(m2, sleepst.NA[1:4,])),4) ## Wrong 'b' constructed in mkNewReTrms() -- issue #257 data(Orthodont,package="nlme") Orthodont <- within(Orthodont, nsex <- as.numeric(Sex == "Male")) m3 <- lmer(distance ~ age + (age|Subject) + (0 + Sex |Subject), data=Orthodont, control=lmerControl(check.conv.hess="ignore", check.conv.grad="ignore")) m4 <- lmer(distance ~ age + (age|Subject) + (0 + nsex|Subject), data=Orthodont) expect_equal(p3 <- predict(m3, Orthodont), fitted(m3), tolerance=1e-14) expect_equal(p4 <- predict(m4, Orthodont), fitted(m4), tolerance=1e-14) ## related to GH #275 (*passes*), ss <- sleepstudy set.seed(1) ss$noiseChar <- ifelse(runif(nrow(sleepstudy)) > 0.8, "Yes", "No") ss$noiseFactor <- factor(ss$noiseChar) fm4 <- lmer(Reaction ~ Days + noiseChar + (Days | Subject), ss) expect_equal(predict(fm4, newdata = model.frame(fm4)[2:3, ])[2], predict(fm4, newdata = model.frame(fm4)[3, ])) fm3 <- lmer(Reaction ~ Days + noiseFactor + (Days | Subject), ss) expect_equal(predict(fm3, newdata = model.frame(fm3)[2:3, ])[2], predict(fm3, newdata = model.frame(fm3)[3, ])) ## complex-basis functions in RANDOM effect fm5 <- lmer(Reaction~Days+(poly(Days,2)|Subject),sleepstudy) expect_equal(predict(fm5,sleepstudy[1,]),fitted(fm5)[1]) ## complex-basis functions in FIXED effect fm6 <- lmer(Reaction~poly(Days,2)+(1|Subject),sleepstudy) expect_equal(predict(fm6,sleepstudy[1,]),fitted(fm6)[1]) ## GH #414: no warning about dropping contrasts on random effects op <- options(warn = 2) # there should be no warnings! set.seed(1) dat <- data.frame( fac = factor(rep(c("a", "b"), 100)), grp = rep(1:25, each = 4)) dat$y <- 0 contr <- 0.5 * contr.sum(2) rownames(contr) <- c("a", "b") colnames(contr) <- "a" contrasts(dat$fac) <- contr m1_contr <- lmer(y~fac+(fac|grp),dat) pp <- predict(m1_contr,newdata=dat) options(op) }) ## testLevel>1 context("simulate") test_that("simulate", { expect_is(simulate(gm2), "data.frame") expect_warning(simulate(gm2, ReForm = NA), "is deprecated") expect_warning(simulate(gm2, REForm = NA), "is deprecated") p1 <- simulate(gm2, re.form = NULL, seed = 101) p2 <- simulate(gm2, re.form = ~0, seed = 101) p3 <- simulate(gm2, re.form = NA, seed = 101) p4 <- simulate(gm2, re.form = NULL, seed = 101) expect_warning(p5 <- simulate(gm2, ReForm = ~0, seed = 101), "is deprecated") p6 <- simulate(gm2, re.form = NA, seed = 101) expect_warning(p7 <- simulate(gm2, REForm = NULL, seed = 101), "is deprecated") p8 <- simulate(gm2, re.form = ~0, seed = 101) p9 <- simulate(gm2, re.form = NA, seed = 101) p10 <- simulate(gm2,use.u = FALSE, seed = 101) p11 <- simulate(gm2,use.u = TRUE, seed = 101) ## minimal check of content: expect_identical(colSums(p1[,1]), c(incidence = 95, 747)) expect_identical(colSums(p2[,1]), c(incidence = 109, 733)) ## equivalences: ## group ~0: expect_equal(p2,p3) expect_equal(p2,p5) expect_equal(p2,p6) expect_equal(p2,p8) expect_equal(p2,p9) expect_equal(p2,p10) ## group 1: expect_equal(p1,p4) expect_equal(p1,p7) expect_equal(p1,p11) expect_error(simulate(gm2,use.u = TRUE, re.form = NA), "should specify only one") ## ## hack: test with three REs p1 <- lmer(diameter ~ (1|plate) + (1|plate) + (1|sample), Penicillin, control = lmerControl(check.conv.hess = "ignore", check.conv.grad = "ignore")) expect_is(sp1 <- simulate(p1, seed=123), "data.frame") expect_identical(dim(sp1), c(nrow(Penicillin), 1L)) expect_equal(fivenum(sp1[,1]), c(20.864, 22.587, 23.616, 24.756, 28.599), tolerance=0.01) ## Pixel example expect_identical(dim(simulate(fmPixS)), c(nPix, 1L)) expect_identical(dim(simulate(fmPix )), c(nPix, 1L)) ## simulation with newdata smaller/larger different from original fm <- lmer(diameter ~ 1 + (1|plate) + (1|sample), Penicillin) expect_is(simulate(fm,newdata=Penicillin[1:10,],allow.new.levels=TRUE),"data.frame") expect_is(simulate(fm,newdata=do.call(rbind,replicate(4,Penicillin,simplify=FALSE))),"data.frame") ## negative binomial sims set.seed(101) dd <- data.frame(f=factor(rep(1:10,each=20)), x=runif(200), y=rnbinom(200,size=2,mu=2)) g1 <- glmer.nb(y ~ x + (1|f), data=dd) th.g1 <- getME(g1, "glmer.nb.theta") ## changed to setting seed internally ts1 <- table(s1 <- simulate(g1,seed=101)[,1]) ## ts1B <- table(s1 <- simulate(g1,seed=101)[,1]) expect_equal(fixef(g1), c("(Intercept)" = 0.630067, x = -0.0167248), tolerance = 1e-4) ## ?? Travis is getting hung up here/ignoring tolerance spec?? expect_equal(th.g1, 2.013, tolerance = 1e-4) expect_equal(th.g1, g1@call$family[["theta"]])# <- important for pkg{effects} eval() expect_identical(sum(s1), 413) expect_identical(as.vector(ts1[as.character(0:5)]), ## c(51L, 54L, 36L, 21L, 14L, 9L)) c(49L,56L,32L,25L,11L,9L)) ## de novo NB simulation ... s2 <- simulate(~x + (1|f),seed=101, family=MASS::negative.binomial(theta=th.g1), newparams=getME(g1,c("theta","beta")), newdata=dd)[,1] expect_equal(s1,s2) ## Simulate with newdata with *new* RE levels: d <- sleepstudy[-1] # droping the response ("Reaction") ## d$Subject <- factor(rep(1:18, each=10)) ## Add 18 new subjects: d <- rbind(d, d) d$Subject <- factor(rep(1:36, each=10)) d$simulated <- simulate(fm1, seed=1, newdata = d, re.form=NULL, allow.new.levels = TRUE)[,1] expect_equal(mean(d$simulated), 299.9384608) ## Simulate with weights: newdata <- with(cbpp, expand.grid(period=unique(period), herd=unique(herd))) ss <- simulate(gm1, newdata=newdata[1:3,], weights=20, seed=101)[[1]] expect_equal(ss, matrix(c(4,2,0,16,18,20),nrow=3, dimnames=list(NULL,c("incidence","")))) ss <- simulate(gm3, newdata=newdata[1:3,], weights=20, seed=101)[[1]] expect_equal(ss,c(0.2,0.1,0.0)) ss <- simulate(gm1, newdata=newdata[1,], weights=20, seed=101)[[1]] expect_equal(unname(ss),matrix(c(4,16),nrow=1)) ## simulate Gamma, from function and de novo set.seed(102) dd <- data.frame(x=rep(seq(-2,2,length=15),10), f=factor(rep(1:10,each=15))) u <- rnorm(10) dd$y <- with(dd, rgamma(nrow(dd),shape=2, scale=exp(2+1*x+u[as.numeric(f)])/2)) g1 <- glmer(y~x+(1|f),family=Gamma(link="log"),dd) s1 <- simulate(g1,seed=101) s2 <- suppressMessages(simulate(~x+(1|f), family=Gamma(link="log"), seed=101, newdata=dd, newparams=getME(g1,c("theta","beta","sigma")))) expect_equal(s1,s2) dd$y2 <- s2[[1]] g2 <- glmer(y2~x+(1|f),family=Gamma(link="log"),dd) expect_equal(fixef(g2), tolerance = 4e-7, # 32-bit windows showed 1.34e-7 c("(Intercept)" = 2.81887136759369, x= 1.06543222163626)) }) context("misc") test_that("misc", { expect_equal(df.residual(fm1),176) if (suppressWarnings(require(ggplot2))) { ## ggplot calls sample() [for silly start-up messages ## throws warning because we're using backward-compatible RNGkind expect_is(fortify.merMod(fm1), "data.frame") expect_is(fortify.merMod(gm1), "data.frame") } expect_is(as.data.frame(VarCorr(fm1)), "data.frame") }) } ## testLevel>1 context("plot") test_that("plot", { ## test getData() within plot function: reported by Dieter Menne doFit <- function(){ data(Orthodont,package = "nlme") data1 <- Orthodont lmer(distance ~ age + (age|Subject), data = data1) } data(Orthodont, package = "nlme") fm0 <- lmer(distance ~ age + (age|Subject), data = Orthodont) expect_is(plot(fm0), "trellis") suppressWarnings(rm("Orthodont")) fm <- doFit() pp <- plot(fm, resid(., scaled = TRUE) ~ fitted(.) | Sex, abline = 0) expect_is(pp, "trellis") ## test qqmath/getIDLabels() expect_is(q1 <- lattice::qqmath(fm,id=0.05),"trellis") cake2 <- transform(cake,replicate=as.numeric(replicate), recipe=as.numeric(recipe)) fm2 <- lmer(angle ~ recipe + temp + (1|recipe:replicate), cake2, REML= FALSE) expect_is(lattice::qqmath(fm2,id=0.05), "trellis") expect_is(lattice::qqmath(fm2,id=0.05, idLabels=~recipe), "trellis") }) context("misc") test_that("summary", { ## test that family() works when $family element is weird ## FIXME: is convergence warning here a false positive? gnb <- suppressWarnings(glmer(TICKS~1+(1|BROOD), family=MASS::negative.binomial(theta=2), data=grouseticks)) expect_is(family(gnb),"family") }) if (testLevel>1) { context("profile") test_that("profile", { ## FIXME: can we deal with convergence warning messages here ... ? ## fit profile on default sd/cor scale ... p1 <- suppressWarnings(profile(fm1,which="theta_")) ## and now on var/cov scale ... p2 <- suppressWarnings(profile(fm1,which="theta_", prof.scale="varcov")) ## because there are no correlations, squaring the sd results ## gives the same result as profiling on the variance scale ## in the first place expect_equal(confint(p1)^2,confint(p2), tolerance=1e-5) ## or via built-in varianceProf() function expect_equal(unname(confint(varianceProf(p1))), unname(confint(p2)), tolerance=1e-5) p3 <- profile(fm2,which=c(1,3,4)) p4 <- suppressWarnings(profile(fm2,which="theta_",prof.scale="varcov", signames=FALSE)) ## compare only for sd/var components, not corr component ## FAILS on r-patched-solaris-x86 2018-03-30 ??? ## 2/6 mismatches (average diff: 4.62) ## [1] 207 - 216 == -9.23697 ## [4] 1422 - 1422 == -0.00301 if (Sys.info()["sysname"] != "SunOS") { expect_equal(unname(confint(p3)^2), unname(confint(p4)[c(1,3,4),]), tolerance=1e-3) } ## check naming convention properly adjusted expect_equal(as.character(unique(p4$.par)), c("var_(Intercept)|Subject", "cov_Days.(Intercept)|Subject", "var_Days|Subject", "sigma")) }) test_that("densityplot is robust", { p <- readRDS(system.file("testdata","harmel_profile.rds", package="lme4")) expect_warning(lattice::densityplot(p), "unreliable profiles for some variables") }) } ## testLevel>1 context("model.frame") test_that("model.frame", { ## non-syntactic names d <- sleepstudy names(d)[1] <- "Reaction Time" ee <- function(m,nm) { expect_equal(names(model.frame(m, fixed.only=TRUE)),nm) } m <- lmer(Reaction ~ 1 + (1 | Subject), sleepstudy) ee(m,"Reaction") m2 <- lmer(Reaction ~ Days + (1 | Subject), sleepstudy) ee(m2,c("Reaction","Days")) m3 <- lmer(`Reaction Time` ~ Days + (1 | Subject), d) ee(m3, c("Reaction Time","Days")) m4 <- lmer(Reaction ~ log(1+Days) + (1 | Subject), sleepstudy) ee(m4, c("Reaction","log(1 + Days)")) }) context("influence measures") d <- as.data.frame(ChickWeight) colnames(d) <- c("y", "x", "subj", "tx") dNAs <- d dNAs$y[c(1, 3, 5)] <- NA fitNAs <- lmer(y ~ tx*x + (x | subj), data = dNAs, na.action=na.exclude) test_that("influence/hatvalues works", { ifm1 <- influence(fm1, do.coef=FALSE) expect_equal(unname(head(ifm1$hat)), c(0.107483311203734, 0.102096105816528, 0.0980557017761242, 0.0953620990825215, 0.0940152977357202, 0.0940152977357202), tolerance=1e-6) expect_equal(nrow(dNAs),length(hatvalues(fitNAs))) }) test_that("rstudent", { rfm1 <- rstudent(fm1) expect_equal(unname(head(rfm1)), c(-1.45598270922089, -1.49664543508657, -2.11747425025103, -0.0729690066951975, 0.772716397142335, 2.37859408861768), tolerance=1e-6) expect_equal(nrow(dNAs),length(rstudent(fitNAs))) }) test_that("cooks distance", { expect_equal( unname(head(cooks.distance(fm1))), c(0.127645976734753, 0.127346548123793, 0.243724627125036, 0.000280638917214881, 0.0309804642689636, 0.293554225380831), tolerance=1e-6) expect_equal(nrow(dNAs),length(cooks.distance(fitNAs))) }) test_that("cooks distance on subject-level influence", { ifm1S <- influence(fm1, "Subject", ncores=1) expect_equal( unname(head(cooks.distance(ifm1S))), c(0.000503486560509076, 0.000361036591569186, 0.000152245842071491, 0.000147177769821806, 7.16702770634741e-05, 4.68752602437635e-06), tolerance = 1e-6) }) test_that("cooks distance on glmer models", { inf <- influence(gm1) inf.h <- influence(gm1, "herd", ncores=1) cook <- cooks.distance(inf) expect_equal(unname(head(cook, 3)), c(0.0533565328359536, 0.0371799913466958, 0.205950448747651), tolerance = 1e-6) cook.h <- cooks.distance(inf.h) expect_equal(unname(head(cook.h, 3)), c(0.276877818905867, 0.0064606582914577, 0.127335873462638), tolerance = 1e-6) }) ## tweaked example so estimated var = 0 zerodat <- data.frame(x=seq(0,1,length.out=120), f=rep(1:3,each=40)) zerodat$y1 <- simulate(~x+(1|f), family=gaussian, seed=102, newparams=list(beta=c(1,1), theta=c(0.001), sigma=1), newdata=zerodat)[[1]] zerodat$y2 <- simulate(~x+(1|f), family=poisson, seed=102, newparams=list(beta=c(1,1), theta=c(0.001)), newdata=zerodat)[[1]] test_that("rstudent matches for zero-var cases", { lmer_zero <- lmer(y1~x+(1|f), data=zerodat) glmer_zero <- glmer(y2~x+(1|f),family=poisson, data=zerodat) lm_zero <- lm(y1~x, data=zerodat) glm_zero <- glm(y2~x,family=poisson, data=zerodat) expect_equal(suppressWarnings(rstudent(glmer_zero)), rstudent(glm_zero), tolerance=0.01) expect_equal(suppressWarnings(rstudent(lmer_zero)), rstudent(lm_zero),tolerance=0.01) }) if (testLevel>1) { ## n.b. influence() doesn't work under system.time(); ## weird evaluation stuff ? ## FIXME: work on timing some more i1 <- influence(fm1, ncores=1) test_that("full version of influence", { expect_equal(c(head(i1[["fixed.effects[-case]"]],1)), c(252.323536264131, 10.3222704729148)) }) cooks.distance(i1) if (parallel::detectCores()>1) { test_that("parallel influence", { i2 <- suppressMessages(influence(fm1,ncores=2)) expect_equal(i1,i2) }) } } ## car method testing: influence timing with ncores > 1 ... ## car version 3.0.10. ## L <- load(system.file("testdata", "lme-tst-fits.rda", ## package="lme4", mustWork=TRUE)) ## data("sleepstudy", package="lme4") ## library(lme4) ## library(car) ## WANT warning about S3 method overwrite ... ## fm1 <- fit_sleepstudy_1 ## library(pracma) ## because system.time() is weird ## tic(); i1 <- influence(fm1); toc() ## 2+ seconds ## tic(); i2 <- influence(fm1, ncores=8); toc() ## 3.4 seconds test_that("influence with nAGQ=0", { gm1Q0 <- update(gm1, nAGQ=0) expect_is(influence(gm1Q0), "influence.merMod") }) lme4/tests/testthat/test-utils.R0000644000176200001440000000456314063503234016365 0ustar liggesuserslibrary("testthat") library("lme4") ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } context("Utilities (including *non*-exported ones)") test_that("namedList", { nList <- lme4:::namedList a <- b <- c <- 1 expect_identical(nList(a,b,c), list(a = 1, b = 1, c = 1)) expect_identical(nList(a,b,d=c),list(a = 1, b = 1, d = 1)) expect_identical(nList(a, d=pi, c), list(a = 1, d = pi, c = 1)) }) test_that("Var-Cov factor conversions", { ## from ../../R/vcconv.R mlist2vec <- lme4:::mlist2vec Cv_to_Vv <- lme4:::Cv_to_Vv Cv_to_Sv <- lme4:::Cv_to_Sv Sv_to_Cv <- lme4:::Sv_to_Cv Vv_to_Cv <- lme4:::Vv_to_Cv ## set.seed(1); cvec1 <- sample(10, 6) v1 <- Cv_to_Vv(cvec1) expect_equal(unname(v1), structure(c(9, 12, 15, 65, 34, 93), clen = 3)) expect_equal(2, as.vector(Vv_to_Cv(Cv_to_Vv(2)))) expect_equivalent(c(v1, 1), Cv_to_Vv(cvec1, s=3) / 3^2) expect_equal(as.vector(ss1 <- Sv_to_Cv(Cv_to_Sv(cvec1))), cvec1) expect_equal(as.vector(vv1 <- Vv_to_Cv(Cv_to_Vv(cvec1))), cvec1) ## for length-1 matrices, Cv_to_Sv should be equivalent ## to multiplying Cv by sigma and appending sigma .... clist2 <- list(matrix(1),matrix(2),matrix(3)) cvec2 <- mlist2vec(clist2) expect_equal(cvec2, structure(1:3, clen = rep(1,3)), tolerance=0) expect_true(all((cvec3 <- Cv_to_Sv(cvec2, s=2)) == c(cvec2*2,2))) n3 <- length(cvec3) expect_equivalent(Sv_to_Cv(cvec3, n=rep(1,3), s=2), cvec3[-n3]/cvec3[n3]) }) test_that("nobar", { rr <- lme4:::RHSForm expect_equal(nobars(y~1+(1|g)), y~1) expect_equal(nobars(y~1|g), y~1) expect_equal(nobars(y~1+(1||g)), y~1) expect_equal(nobars(y~1||g), y~1) expect_equal(nobars(y~1+(x:z|g)), y~1) expect_equal(nobars(y~1+(x*z|g/h)), y~1) expect_equal(nobars(y~(1|g)+x+(x|h)), y~x) expect_equal(nobars(y~(1|g)+x+(x+z|h)), y~x) expect_equal(nobars(~1+(1|g)), ~1) expect_equal(nobars(~(1|g)), ~1) expect_equal(nobars(rr(y~1+(1|g))), 1) expect_equal(nobars(rr(y~(1|g))), 1) }) lme4/tests/testthat/test-glmer.R0000644000176200001440000003772214174542124016342 0ustar liggesuserslibrary("testthat") library("lme4") source(system.file("testdata", "lme-tst-funs.R", package="lme4", mustWork=TRUE))# -> uc() testLevel <- lme4:::testLevel() gives_error_or_warning <- function (regexp = NULL, all = FALSE, ...) { function(expr) { res <- try(evaluate_promise(expr),silent=TRUE) no_error <- !inherits(res, "try-error") if (no_error) { warnings <- res$warnings if (!is.null(regexp) && length(warnings) > 0) { return(matches(regexp, all = FALSE, ...)(warnings)) } else { return(expectation(length(warnings) > 0, "no warnings or errors given", paste0(length(warnings), " warnings created"))) } } if (!is.null(regexp)) { return(matches(regexp, ...)(res)) } else { expectation(TRUE, "no error thrown", "threw an error") } } } ## expect_that(stop("foo"),gives_error_or_warning("foo")) ## expect_that(warning("foo"),gives_error_or_warning("foo")) ## expect_that(TRUE,gives_error_or_warning("foo")) ## expect_that(stop("bar"),gives_error_or_warning("foo")) ## expect_that(warning("bar"),gives_error_or_warning("foo")) if(testLevel > 1) { context("fitting glmer models") test_that("glmer", { set.seed(101) d <- data.frame(z=rbinom(200,size=1,prob=0.5), f=factor(sample(1:10,200,replace=TRUE))) ## Using 'method=*' defunct in 2019-05 (after 6 years of deprecation) ## expect_warning(glmer(z~ 1|f, d, family=binomial, method="abc"),"Use the nAGQ argument") ## expect_warning(glmer(z~ 1|f, d, family=binomial, method="Laplace"),"Use the nAGQ argument") ##sp expect_warning(glmer(z~ 1|f, d, sparseX=TRUE),"has no effect at present") expect_that(gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial), is_a("glmerMod")) expect_that(gm1@resp, is_a("glmResp")) expect_that(gm1@pp, is_a("merPredD")) expect_equal(ge1 <- unname(fixef(gm1)), c(-1.39854982537216, -0.992335519118859, -1.12867532780426, -1.58030423764517), tolerance=5e-4) expect_equal(c(VarCorr(gm1)[[1]]), 0.41245527438386, tolerance=6e-4) ### expect_that(family(gm1), equals(binomial())) ### ?? binomial() has an 'initialize' component ... and the order is different expect_equal(deviance(gm1), 73.47428, tolerance=1e-5) ## was -2L = 184.05267459802 expect_equal(sigma(gm1), 1) expect_equal(extractAIC(gm1), c(5, 194.052674598026), tolerance=1e-5) expect_equal(theta <- unname(getME(gm1, "theta")), 0.642226809144453, tolerance=6e-4) expect_that(X <- getME(gm1, "X"), is_equivalent_to( model.matrix(model.frame(~ period, data=cbpp), cbpp))) expect_that(Zt <- getME(gm1, "Zt"), is_a("dgCMatrix")) expect_equal(dim(Zt), c(15L, 56L)) expect_equal(Zt@x, rep.int(1, 56L)) expect_that(Lambdat <- getME(gm1, "Lambdat"), is_a("dgCMatrix")) expect_equivalent(as(Lambdat, "matrix"), diag(theta, 15L, 15L)) expect_is(gm1_probit <- update(gm1,family=binomial(link="probit")),"merMod") expect_equal(family(gm1_probit)$link,"probit") ## FIXME: test user-specified/custom family? expect_error(glFormula(cbind(incidence, size - incidence) ~ period + (1 | herd), data = subset(cbpp, herd==levels(herd)[1]), family = binomial), "must have > 1") expect_warning(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = subset(cbpp, herd %in% levels(herd)[1:4]), family = binomial, control=glmerControl(check.nlev.gtreq.5="warning")), "< 5 sampled levels") expect_warning(fm1. <- glmer(Reaction ~ Days + (Days|Subject), sleepstudy), regexp="calling .* with family=gaussian .* as a shortcut") options(warn=2) options(glmerControl=list(junk=1,check.conv.grad="ignore")) expect_warning(glmer(z~ 1|f, d, family=binomial), "some options") options(glmerControl=NULL) cbppX <- transform(cbpp,prop=incidence/size) expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, start=NULL), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, verbose=0L), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, subset=TRUE), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, na.action="na.exclude"), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, offset=rep(0,nrow(cbppX))), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, contrasts=NULL), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, devFunOnly=FALSE), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, control=glmerControl(optimizer="Nelder_Mead")), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, control=glmerControl()), "glmerMod") options(warn=0) expect_error(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, junkArg=TRUE), "unused argument") if(FALSE) { ## Hadley broke this expect_warning(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial, control=list()), "instead of passing a list of class") expect_warning(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial, control=lmerControl()), "instead of passing a list of class") } ## load(system.file("testdata","radinger_dat.RData",package="lme4")) mod <- glmer(presabs~predictor+(1|species),family=binomial, radinger_dat) expect_is(mod,"merMod") ## tolerance: 32-bit Windows (CRAN) reported ave.diff of 5.33e-8 ## 64-bit Win-builder r73242 now reports ave. diff of 1.31e-5 ... expect_equal(unname(fixef(mod)), c(0.5425528,6.4289962), tolerance = 1e-4) set.seed(101) ## complete separation case d <- data.frame(y=rbinom(1000,size=1,p=0.5), x=runif(1000), f=factor(rep(1:20,each=50)), x2=rep(0:1,c(999,1))) expect_message(mod2 <- glmer(y~x+x2+(1|f),data=d,family=binomial, control=glmerControl(check.conv.hess="ignore", check.conv.grad="ignore")), "singular") expect_equal(unname(fixef(mod2))[1:2], c(-0.10036244,0.03548523), tolerance=1e-4) expect_true(unname(fixef(mod2)[3] < -10)) expect_message(mod3 <- update(mod2, family=binomial(link="probit")), "singular") # singular Hessian warning expect_equal(unname(fixef(mod3))[1:2], c(-0.062889, 0.022241), tolerance=1e-4) expect_true(fixef(mod3)[3] < -4) expect_message(mod4 <- update(mod2, family=binomial(link="cauchit"), control=glmerControl(check.conv.hess="ignore", check.conv.grad="ignore")))#--> singular Hessian warning ## on-the-fly creation of index variables if (FALSE) { ## FIXME: fails in testthat context -- 'd' is not found ## in the parent environment of glmer() -- but works fine ## otherwise ... set.seed(101) d <- data.frame(y1=rpois(100,1), x=rnorm(100), ID=1:100) fit1 <- glmer(y1 ~ x+(1|ID),data=d,family=poisson) fit2 <- update(fit1, .~ x+(1|rownames(d))) expect_equal(unname(unlist(VarCorr(fit1))), unname(unlist(VarCorr(fit2)))) } ## if(testLevel > 2) { load(system.file("testdata","mastitis.rda",package="lme4")) t1 <- system.time(g1 <- suppressWarnings(glmer(NCM ~ birth + calvingYear + (1|sire) + (1|herd), mastitis, poisson, ## current (2014-04-24) default: --> Warning control=glmerControl( # max|grad| = 0.021 .. optimizer=c("bobyqa","Nelder_Mead"))))) t2 <- system.time(g2 <- update(g1, control=glmerControl(optimizer="bobyqa"))) ## rbind(t1,t2)[,"elapsed"] ## 20 (then 13.0) seconds N-M vs 8 (then 4.8) seconds bobyqa ... ## print(t1[3] / t2[3]) # 0.37; => 1.25 should be on the safe side expect_lte(t2[3], 1.25 * t1[3]) ## problem is fairly ill-conditioned so parameters ## are relatively far apart even though likelihoods are OK expect_equal(logLik(g1),logLik(g2),tolerance=2e-7) } ## test bootstrap/refit with nAGQ>1 gm1AGQ <- update(gm1,nAGQ=2) s1 <- simulate(gm1AGQ) expect_equal(attr(bootMer(gm1AGQ,fixef),"bootFail"),0) ## do.call(new,...) bug new <- "foo" expect_that(gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial), is_a("glmerMod")) rm("new") ## test issue #47, from Wolfgang Viechtbauer ## create some data n <- 100 ai <- rep(0:1, each = n/2) bi <- 1-ai ci <- c(rep(0,42), rep(1,8), rep(0,18), rep(1,32)) di <- 1-ci event <- c(rbind(ai,ci)) group <- rep(c(1,0), times=n) id <- rep(1:n, each=2) gm3 <- glmer(event ~ group + (1 | id), family=binomial, nAGQ=21) sd3 <- sqrt(diag(vcov(gm3))) expect_equal(uc(`(Intercept)` = 0.42542855, group = 0.42492581), sd3, tolerance=1e-5) # 7e-9 {Lnx} expect_warning(vcov(gm3,use.hessian=FALSE), "finite-difference Hessian") expect_equal(suppressWarnings(sqrt(diag(vcov(gm3,use.hessian=FALSE)))), uc(`(Intercept)` = 0.3840921, group = 0.3768747), tolerance=1e-7) # 6.5e-8 expect_equal(sd3, unn(coef(summary(gm3))[,"Std. Error"])) ## test non-pos-def finite-difference Hessian ... if(getRversion() > "3.0.0") { ## saved fits are not safe with old R versions L <- load(system.file("testdata","polytomous_vcov_ex.RData", package="lme4", mustWork=TRUE)) expect_warning(vcov(polytomous_vcov_ex),"falling back to var-cov") } ## damage Hessian to make it singular ## (example thanks to J. Dushoff) gm1H <- gm1 gm1H@optinfo$derivs$Hessian[5,] <- 0 expect_warning(vcov(gm1H),"falling back to var-cov") ## test convergence warnings L <- load(system.file("testdata","gopherdat2.RData", package="lme4", mustWork=TRUE)) g0 <- glmer(shells~prev + (1|Site)+offset(log(Area)), family=poisson, data=Gdat) ## fit year as factor: OK gc <- glmerControl(check.conv.grad="stop") expect_is(update(g0,.~.+factor(year), control=gc), "glmerMod") ## error/warning with year as numeric: ## don't have full knowledge of which platforms lead to which ## results, and can't detect whether we're running on valgrind, ## which changes the result on 32-bit linux ... ## SEGFAULT on MacOS? why? if (FALSE) { expect_that(update(g0,.~.+year), gives_error_or_warning("(failed to converge|pwrssUpdate did not converge)")) } ## ("(failed to converge|pwrssUpdate did not converge in)")) ## if (sessionInfo()$platform=="i686-pc-linux-gnu (32-bit)") { ## expect_warning(update(g0, .~. +year), "failed to converge") ## } else { ## ## MacOS x86_64-apple-darwin10.8.0 (64-bit) ## ## MM's platform ## ## "pwrssUpdate did not converge in (maxit) iterations" ## expect_error(update(g0, .~. +year), "pwrssUpdate did not converge in") ## } ## OK if we scale & center it expect_is(update(g0,.~. + scale(year), control=gc), "glmerMod") ## not OK if we scale and don't center expect_warning(update(g0,.~. + scale(year,center=FALSE)), "failed to converge with max|grad|") ## OK if center and don't scale expect_is(update(g0,.~. + scale(year,center=TRUE,scale=FALSE), control=gc), "glmerMod") ## try higher-order AGQ expect_is (update(gm1,nAGQ=90), "glmerMod") expect_error(update(gm1,nAGQ=101),"ord < 101L") ## non-numeric response variables ss <- transform(sleepstudy, Reaction = as.character(Reaction)) expect_error(glmer(Reaction~(1|Days), family="poisson", data=ss), "response must be numeric") expect_error(glmer(Reaction~(1|Days), family="binomial", data=ss), "response must be numeric or factor") ss2 <- transform(ss,rr=rep(c(TRUE,FALSE),length.out=nrow(ss))) ## should work OK with logical too expect_is(glmer(rr~(1|Days),family="binomial",data=ss2),"merMod") ## starting values with log(.) link -- thanks to Eric Weese @ Yale: grp <- rep(letters[1:5], 20); set.seed(1); x <- rnorm(100) expect_error(glmer(x ~ 1 + (1|grp), family=gaussian(link="log")), "valid starting values") ## related to GH 231 ## fails on some platforms, skip for now if (FALSE) { rr <- gm1@resp$copy() ff <- setdiff(ls(gm1@resp),c("copy","initialize","initialize#lmResp","ptr", "updateMu","updateWts","resDev","setOffset","wrss")) for (i in ff) { expect_equal(gm1@resp[[i]],rr[[i]]) } } ## bad start case load(system.file("testdata","fakesim.RData",package="lme4")) rfit <- glmer(Inew/S ~ R0-1 + offset(log(I/N)) + (1|R0:trial) , family=binomial(link="cloglog") , data=dat , weight=S , control=glmerControl(optimizer="bobyqa", nAGQ0initStep=FALSE) , start = list(fixef=c(0,0,0),theta=1)) expect_equal(exp(fixef(rfit)), c(R01 = 1.2735051, R02 = 2.0330635, R03 = 2.9764088), tolerance=1e-5) ## gaussian with log link and zero values in response ... ## fixed simulation code, passing mustart properly dd <- expand.grid(x = seq(-2,3,length.out=10), f = factor(1:10)) dd$y <- simulate(~x+(1|f), family=gaussian(link="log"), newdata=dd, newparams=list(beta=c(0,1),theta=1,sigma=1), seed=101)[[1]] dd$y <- pmax(dd$y,0) expect_error(glmer (y ~ x + (1|f), family = gaussian(link="log"), data=dd),"cannot find valid starting values") g1 <- glmer (y ~ x + (1|f), family = gaussian(link="log"), data=dd, mustart=pmax(dd$y,0.1)) msum <- c(fixef(g1),unlist(c(VarCorr(g1))),c(logLik(g1))) expect_equal(msum, c(`(Intercept)` = 0.23389405, x = 1.0017436, f = 0.24602992, -156.7773), tolerance=1e-5) ## GH 415 expect_warning(glmer (round(Reaction) ~ Days + (1|Subject), data=sleepstudy[1:100,], family=poisson, control=lmerControl()), "please use glmerControl") }) } ## testlevel>1 lme4/tests/testthat/test-start.R0000644000176200001440000000643314063503234016360 0ustar liggesuserslibrary("testthat") library("lme4") context("specifying starting values") ##' Update 'mod', copying .@call and attr(.@frame, "start") from 'from' copysome <- function(mod, from) { stopifnot(all.equal(class(mod), class(from)), isS4(mod)) mod@call <- from@call attr(mod@frame, "start") <- attr(from@frame, "start") mod } ## is "Nelder_Mead" default optimizer? isNM <- formals(lmerControl)$optimizer == "Nelder_Mead" stMsg <- "'start' must be .* a numeric vector .* list" test_that("lmer", { frm <- Reaction ~ Days + (Days|Subject) ctrl <- lmerControl(optCtrl = list(maxfun= if(isNM) 50 else 100)) x <- suppressWarnings(lmer(frm, data=sleepstudy, control=ctrl, REML=FALSE)) x2 <- suppressWarnings(update(x,start=c(1,0,1))) x3 <- suppressWarnings(update(x,start=list(theta=c(1,0,1)))) ff <- update(x,devFunOnly=TRUE) x2@call <- x3@call <- x@call ## hack call component expect_equal(x,x2) expect_equal(x,x3) ## warning on deprecated list ... suppressWarnings(expect_error(update(x, start = "a"), stMsg)) ## misspelled suppressWarnings( expect_error(update(x,start=list(Theta=c(1,0,1))),"incorrect components") ) th0 <- getME(x,"theta") y <- suppressWarnings(update(x,start=th0)) if(isNM) { expect_equal(AIC(x), 1768.025, tolerance=1e-6) expect_equal(AIC(y), 1763.949, tolerance=1e-6) } else { ## only "bobyqa" tested: expect_equal(AIC(x), 1763.939344, tolerance=1e-6) expect_equal(AIC(x), AIC(y)) } if(isNM) expect_equal(suppressWarnings(optimizeLmer(ff,control=list(maxfun=50), start=c(1,0,1))$fval), unname(deviance(x))) expect_equal(suppressWarnings(optimizeLmer(ff,control=list(maxfun=50), start=th0)$fval), unname(deviance(y))) }) test_that("glmer", { ctrl <- glmerControl(optCtrl=list(maxfun=50)) # -> non-convergence warnings x <- suppressWarnings(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial, control=ctrl)) ## theta only x2 <- suppressWarnings(update(x, start= 1)) x3 <- suppressWarnings(update(x, start= list(theta = 1))) ff <- update(x,devFunOnly=TRUE) x2@call <- x3@call <- x@call ## hack call component expect_equal(x,x2) expect_equal(x,x3) expect_error(update(x, start="a"), stMsg) expect_error(update(x, start=list(Theta=1)), "bad name\\(s\\)") th0 <- getME(x,"theta") y <- suppressWarnings(update(x, start=th0)) # expect_equal() fails: optinfo -> derivs -> Hessian ## theta and beta x0 <- update(x,nAGQ=0) x4 <- suppressWarnings(update(x, start = list(theta=1, fixef=fixef(x0)))) expect_equal(x, copysome(x4, from=x)) x5 <- suppressWarnings(update(x, start = list(theta=1, fixef=rep(0,4)))) expect_equal(AIC(x5), 221.5823, tolerance=1e-6) x6 <- expect_error(update(x, start = list(theta=1, fixef=rep(0,5))), "incorrect number of fixef components") ## beta only x7 <- suppressWarnings(update(x,start=list(fixef=fixef(x0)))) expect_equal(x, copysome(x7, from=x)) x8 <- suppressWarnings(update(x,start=list(fixef=rep(0,4)))) expect_equal(x5, copysome(x8, from=x5)) }) lme4/tests/testthat/test-glmernb.R0000644000176200001440000000501614063503234016645 0ustar liggesuserslibrary("testthat") library("lme4") testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 if (testLevel>1) { context("glmer.nb") test_that("basic", { set.seed(101) dd <- expand.grid(f1 = factor(1:3), f2 = LETTERS[1:2], g=1:9, rep=1:15, KEEP.OUT.ATTRS=FALSE) mu <- 5*(-4 + with(dd, as.integer(f1) + 4*as.numeric(f2))) dd$y <- rnbinom(nrow(dd), mu = mu, size = 0.5) require("MASS") m.glm <- glm.nb(y ~ f1*f2, data=dd) m.nb <- glmer.nb(y ~ f1*f2 + (1|g), data=dd) expect_equal(unname(fixef(m.nb)), c(1.65008, 0.76715, 1.01147, 1.51241, -0.61506, -0.6104), tol=1e-5) expect_is(m.nb,"glmerMod") ## 'family' properly quoted/not expanded in call? expect_true(grepl("negative\\.binomial\\(theta *= *[0-9]*\\.[0-9]+\\)", deparse(m.nb@call$family))) expect_null(m.nb@call$verbose) ## check: GH #321 expect_equal(fixef(m.nb), coef (m.glm), tol=1e-5) ## GH #319 ## GH #285 m.nb1 <- glmer(Reaction > 250 ~ Days + (1|Subject), data = sleepstudy, family=poisson) ## previously failing on Travis-CI m.nb2 <- glmer.nb(y ~ f1*f2 + (1|g), data=dd, subset = g!=8) expect_equal(unname(ngrps(m.nb2)),8) ## expect parameters, ngrps *not* to equal full model expect_equal(unname(fixef(m.nb2)), c(1.629240234, 0.76028840, 1.008629913, 1.6172507, -0.6814426, -0.66468330),tol=1e-5) ## control handling ... this should suppress warnings ... old.opts <- options(warning=2) m.nb2 <- glmer.nb(round(Reaction) ~ Days + (1|Subject), data = sleepstudy, subset = Subject != 370, control=glmerControl(check.conv.grad="ignore")) expect_is(m.nb2,"glmerMod") options(old.opts) m.nb3 <- glmer.nb(y~f1+(1|g), data=dd, contrasts=list(f1=contr.sum)) ## make sure *different* fixed effects from previous fit ... expect_equal(fixef(m.nb3), structure(c(2.93061, -0.29779, 0.02586), .Names = c("(Intercept)", "f11", "f12")),tol=1e-5) ## make sure 'data' is in call even if unnamed m.nb4 <- glmer.nb(y~f1+(1|g), dd) expect_equal(names(m.nb4@call),c("","formula","data","family")) ## GH 322; allow offset m.nb2 <- glmer.nb(y~f1+(1|g), data=dd, offset=rep(0,nrow(dd))) }) } ## testLevel > 1 lme4/tests/is.R0000644000176200001440000000160614063503234013016 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) stopifnot(isREML(fm1), isLMM(fm1), !isGLMM(fm1), !isNLMM(fm1)) fm1ML <- refitML(fm1) stopifnot(!isREML(fm1ML), isLMM(fm1ML), !isGLMM(fm1ML), !isNLMM(fm1ML)) gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) stopifnot(!isREML(gm1), !isLMM(gm1), isGLMM(gm1), !isNLMM(gm1)) nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = c(Asym = 200, xmid = 725, scal = 350)) stopifnot(!isREML(nm1), !isLMM(nm1), !isGLMM(nm1), isNLMM(nm1)) } ## skip on windows (for speed) lme4/tests/bootMer.R0000644000176200001440000000636314063503234014017 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) mySumm <- function(.) { s <- sigma(.) c(beta =getME(., "beta"), sigma = s, sig01 = unname(s * getME(., "theta"))) } fm1 <- lmer(Yield ~ 1|Batch, Dyestuff) boo01 <- bootMer(fm1, mySumm, nsim = 10) boo02 <- bootMer(fm1, mySumm, nsim = 10, use.u = TRUE) ## boo02 <- bootMer(fm1, mySumm, nsim = 500, use.u = TRUE) if (require(boot)) { boot.ci(boo02,index=2,type="perc") } fm2 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake) boo03 <- bootMer(fm2, mySumm, nsim = 10) boo04 <- bootMer(fm2, mySumm, nsim = 10, use.u = TRUE) if (lme4:::testLevel() > 1) { gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) boo05 <- bootMer(gm1, mySumm, nsim = 10) boo06 <- bootMer(gm1, mySumm, nsim = 10, use.u = TRUE) cbpp$obs <- factor(seq(nrow(cbpp))) gm2 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd) + (1|obs), family = binomial, data = cbpp) boo03 <- bootMer(gm2, mySumm, nsim = 10) boo04 <- bootMer(gm2, mySumm, nsim = 10, use.u = TRUE) } load(system.file("testdata","culcita_dat.RData",package="lme4")) cmod <- glmer(predation~ttt+(1|block),family=binomial,data=culcita_dat) set.seed(101) ## FIXME: sensitive to step-halving PIRLS tests ## expect_warning(cc <- confint(cmod,method="boot",nsim=10,quiet=TRUE, ## .progress="txt",PBargs=list(style=3)),"some bootstrap runs failed") library(parallel) if (detectCores()>1) { ## http://stackoverflow.com/questions/12983137/how-do-detect-if-travis-ci-or-not travis <- nchar(Sys.getenv("TRAVIS"))>0 if(.Platform$OS.type != "windows" && !travis) { boo01P <- bootMer(fm1, mySumm, nsim = 10, parallel="multicore", ncpus=2) } ## works in Solaris from an interactive console but not ??? ## via R CMD BATCH if (Sys.info()["sysname"] != "SunOS") boo01P.snow <- bootMer(fm1, mySumm, nsim = 10, parallel="snow", ncpus=2) } set.seed(101) dd <- data.frame(x=runif(200), f=rep(1:20,each=10), o=rnorm(200,mean=2)) dd$y <- suppressMessages(simulate(~x+(1|f)+offset(o), family="poisson", newdata=dd, newparams=list(theta=1,beta=c(0,2)))[[1]]) ## fails under flexLambda dd$y2 <- suppressMessages(simulate(~x+(1|f)+offset(o), family="gaussian", newdata=dd, newparams=list(theta=1,beta=c(0,2),sigma=1))[[1]]) fm3 <- glmer(y~x+(1|f)+offset(o), data=dd,family="poisson") fm4 <- lmer(y2~x+(1|f)+offset(o), data=dd) mySumm2 <- function(fit) return(c(fixef(fit),getME(fit,'theta'))) ## still some issues to fix here bb <- bootMer(fm3,mySumm2,nsim=10) attr(bb,"boot.fail.msgs") bb2 <- bootMer(fm4,mySumm2,nsim=10) } ## skip on windows (for speed) lme4/tests/refit.R0000644000176200001440000001546014063503234013517 0ustar liggesusers#### Testing refit() #### ---------------- library(lme4) set.seed(101) testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 ## for each type of model, should be able to ## (1) refit with same data and get the same answer, ## at least structurally (small numerical differences ## are probably unavoidable) ## (2) refit with simulate()d data if (testLevel>1) { getinfo <- function(x) { c(fixef(x), logLik(x), unlist(ranef(x)), unlist(VarCorr(x))) } dropterms <- function(x) { attr(x@frame,"terms") <- NULL x } if (getRversion() >= "3.0.0") { attach(system.file("testdata", "lme-tst-fits.rda", package="lme4")) } else { ## saved fits are not safe with old R versions; just re-compute ("cheat"!): fit_sleepstudy_2 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) cbpp$obs <- factor(seq(nrow(cbpp))) ## intercept-only fixed effect fit_cbpp_0 <- glmer(cbind(incidence, size-incidence) ~ 1 + (1|herd), cbpp, family=binomial) ## include fixed effect of period fit_cbpp_1 <- update(fit_cbpp_0, . ~ . + period) if(FALSE) ## include observation-level RE fit_cbpp_2 <- update(fit_cbpp_1, . ~ . + (1|obs)) ## specify formula by proportion/weights instead fit_cbpp_3 <- update(fit_cbpp_1, incidence/size ~ period + (1 | herd), weights = size) } ## LMM fm1 <- fit_sleepstudy_2 fm1R <- refit(fm1, sleepstudy$Reaction) fm1S <- refit(fm1, simulate(fm1)[[1]]) stopifnot(all.equal(getinfo(fm1 ), getinfo(fm1R), tolerance = 6e-3), all.equal(getinfo(fm1 ), getinfo(fm1S), tolerance = 0.5) # <- simulate() ) if(FALSE) { ## show all differences sapply(slotNames(fm1), function(.) all.equal( slot(fm1,.), slot(fm1R,.), tolerance=0)) } if (getRversion() >= "3.4.0") { ## differences: FALSE for resp, theta, u, devcomp, pp, optinfo? ## FIXME: this isn't actually tested in any way ... sapply(slotNames(fm1), function(.) isTRUE(all.equal( slot(fm1,.), slot(fm1R,.), tolerance= 1.5e-5))) str(fm1 @ optinfo) str(fm1R@ optinfo) } fm1ML <- refitML(fm1) stopifnot( all.equal(getinfo(fm1), getinfo(fm1ML), tolerance=0.05)# 0.029998 ) ## binomial GLMM (two-column) gm1 <- fit_cbpp_1 gm1R <- refit(gm1, with(cbpp, cbind(incidence,size-incidence))) sim1Z <- simulate(gm1)[[1]] sim1Z[4,] <- c(0,0) (gm1. <- refit(gm1, sim1Z)) # earlier gave Error: ... PIRLS ... failed ... all.equal(getinfo(gm1), getinfo(gm1R), tolerance=0) # to see it --> 5.52e-4 # because glmer() uses Laplace approx. (? -- still, have *same* y !) stopifnot(all.equal(getinfo(gm1), getinfo(gm1R), tolerance = 1e-4)) gm1S <- refit(gm1, simulate(gm1)[[1]]) all.equal(getinfo(gm1), getinfo(gm1S), tolerance=0) # to see: stopifnot(all.equal(getinfo(gm1), getinfo(gm1S), tolerance = 0.4)) ## binomial GLMM (prob/weights) formula(gm2 <- fit_cbpp_3) ## glmer(incidence/size ~ period + (1 | herd), cbpp, binomial, weights=size) gm2R <- refit(gm2, with(cbpp, incidence/size)) all.equal(getinfo(gm2), getinfo(gm2R), tolerance= 0) stopifnot(all.equal(getinfo(gm2), getinfo(gm2R), tolerance= 6e-4)) ## FIXME: check on Windows == 2015-06: be brave gm2S <- refit(gm2, simulate(gm2)[[1]]) all.equal(getinfo(gm2), getinfo(gm2S), tolerance=0)# 0.17 .. upto 0.28 stopifnot(all.equal(getinfo(gm2), getinfo(gm2S), tolerance=0.40)) ## from Alexandra Kuznetsova set.seed(101) Y <- matrix(rnorm(1000),ncol=2) d <- data.frame(y1=Y[,1], x=rnorm(100), f=rep(1:10,10)) fit1 <- lmer(y1 ~ x+(1|f),data=d) fit2 <- refit(fit1, newresp = Y[,2], rename.response=TRUE) ## check, but ignore terms attribute of model frame ... tools::assertWarning(refit(fit1, newresp = Y[,2], junk=TRUE)) if (isTRUE(all.equal(fit1,fit2))) stop("fit1 and fit2 should not be equal") ## hack number of function evaluations u2 <- update(fit2) fit2@optinfo$feval <- u2@optinfo$feval <- NA d1 <- dropterms(fit2) d2 <- dropterms( u2 ) ## They are not "all equal", but mostly : for (i in slotNames(d1)) { ae <- all.equal(slot(d1,i), slot(d2,i)) cat(sprintf("%10s: %s\n", i, if(isTRUE(ae)) "all.equal" else paste(ae, collapse="\n "))) } all.equal(getinfo(d1), getinfo(d2), tolerance = 0)# -> 0.00126 stopifnot(all.equal(getinfo(d1), getinfo(d2), tolerance = 0.005)) ## Bernoulli GLMM (specified as factor) if (requireNamespace("mlmRev")) { data(Contraception, package="mlmRev") gm3 <- glmer(use ~ urban + age + livch + (1|district), Contraception, binomial) gm3R <- refit(gm3, Contraception$use) gm3S <- refit(gm3, simulate(gm3)[[1]]) stopifnot(all.equal(getinfo(gm3 ), getinfo(gm3R), tolerance = 1e-5),# 64b_Lx: 7.99e-7 all.equal(getinfo(gm3 ), getinfo(gm3S), tolerance = 0.05) # <- simulated data ) cat("gm3: glmer(..):\n" ); print(getinfo(gm3)) cat("gm3R: refit(*, y):\n" ); print(getinfo(gm3R)) cat("gm3S: refit(*, sim.()):\n"); print(getinfo(gm3S)) data(Mmmec, package="mlmRev") if (lme4:::testLevel() > 1) { gm4 <- glmer(deaths ~ uvb + (1|region), data=Mmmec, family = poisson, offset = log(expected)) ## FIXME: Fails to converge (with larger maxit: "downdate .. not pos.def..") try( gm4R <- refit(gm4, Mmmec $ deaths) ) try( gm4S <- refit(gm4, simulate(gm4)[[1]]) ) if(FALSE) { ## FIXME (above) cat("gm4R: refit(*,y):\n" ); print( getinfo(gm4R) ) cat("gm4S: refit(*,y):\n" ); print( getinfo(gm4S) ) stopifnot(all.equal(getinfo(gm4),getinfo(gm4R),tolerance=6e-5)) } } } ## ---------------------------------------------------------------------- ## issue: #231, http://ms.mcmaster.ca/~bolker/misc/boot_reset.html ## commits: 1a34cd0, e33d698, 53ce966, 7dbfff1, 73aa1bb, a693ba9, 8dc8cf0 ## ---------------------------------------------------------------------- formGrouse <- TICKS ~ YEAR + scale(HEIGHT) + (1 | BROOD) + (1 | INDEX) + (1 | LOCATION) gmGrouse <- glmer(formGrouse, family = "poisson", data = grouseticks) set.seed(105) simTICKS <- simulate(gmGrouse)[[1]] newdata <- transform(grouseticks, TICKS = simTICKS) gmGrouseUpdate <- update(gmGrouse, data = newdata) gmGrouseRefit <- refit(gmGrouse, newresp = simTICKS) ## compute and print tolerances all.equal(bet.U <- fixef(gmGrouseUpdate), bet.R <- fixef(gmGrouseRefit), tolerance = 0) all.equal(th.U <- getME(gmGrouseUpdate, "theta"), th.R <- getME(gmGrouseRefit, "theta"), tolerance = 0) all.equal(dev.U <- deviance(gmGrouseUpdate), dev.R <- deviance(gmGrouseRefit), tolerance = 0) stopifnot( all.equal(bet.U, bet.R, tolerance = 6e-5), # saw 1.0e-5 all.equal( th.U, th.R, tolerance = 4e-5), # saw 1.2e-5 all.equal(dev.U, dev.R, tolerance = 2e-5)) # saw 4.6e-6 } ## testLevel>1 lme4/tests/falsezero_dorie.R0000644000176200001440000000156014063503234015556 0ustar liggesusersif (.Platform$OS.type != "windows") { ## test of false zero problem reported by Vince Dorie ## (no longer occurs with current development lme4) ## https://github.com/lme4/lme4/issues/17 library(lme4) sigma.eps <- 2 sigma.the <- 0.75 mu <- 2 n <- 5 J <- 10 g <- gl(J, n) set.seed(1) theta <- rnorm(J, 0, sigma.eps * sigma.the) y <- rnorm(n * J, mu + theta[g], sigma.eps) lmerFit <- lmer(y ~ 1 + (1 | g), REML = FALSE, verbose=TRUE) y.bar <- mean(y) y.bar.j <- sapply(1:J, function(j) mean(y[g == j])) S.w <- sum((y - y.bar.j[g])^2) S.b <- n * sum((y.bar.j - y.bar)^2) R <- S.b / S.w sigma.the.hat <- sqrt(max((n - 1) * R / n - 1 / n, 0)) stopifnot(all.equal(sigma.the.hat,lme4Sigma <- unname(getME(lmerFit,"theta")), tolerance=2e-5)) } ## skip on windows (for speed) lme4/tests/boundary.R0000644000176200001440000002103114063503234014220 0ustar liggesusers## In both of these cases boundary fit (i.e. estimate of zero RE ## variance) is *incorrect*. (Nelder_Mead, restart_edge=FALSE) is the ## only case where we get stuck; either optimizer=bobyqa or ## restart_edge=TRUE (default) works if (.Platform$OS.type != "windows") { library(lme4) library(testthat) if(!dev.interactive(orNone=TRUE)) pdf("boundary_plots.pdf") ## Stephane Laurent: dat <- read.csv(system.file("testdata","dat20101314.csv", package="lme4")) fit <- lmer(y ~ (1|Operator)+(1|Part)+(1|Part:Operator), data=dat, control= lmerControl(optimizer="Nelder_Mead")) fit_b <- lmer(y ~ (1|Operator)+(1|Part)+(1|Part:Operator), data=dat, control= lmerControl(optimizer="bobyqa", restart_edge=FALSE)) fit_c <- lmer(y ~ (1|Operator)+(1|Part)+(1|Part:Operator), data=dat, control= lmerControl(optimizer="Nelder_Mead", restart_edge=FALSE, check.conv.hess="ignore")) ## final fit gives degenerate-Hessian warning ## FIXME: use fit_c with expect_warning() as a check on convergence tests ## tolerance=1e-5 seems OK in interactive use but not in R CMD check ... ?? stopifnot(all.equal(getME(fit, "theta") -> th.f, getME(fit_b,"theta"), tolerance=5e-5), all(th.f > 0)) ## Manuel Koller source(system.file("testdata", "koller-data.R", package="lme4")) ldata <- getData(13) ## old (backward compatible/buggy) fm4 <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="Nelder_Mead", use.last.params=TRUE), start=list(theta=1)) fm4b <- lmer(y ~ (1|Var2), ldata, control = lmerControl(optimizer="Nelder_Mead", use.last.params=TRUE, restart_edge = FALSE, check.conv.hess="ignore", check.conv.grad="ignore"), start = list(theta=1)) ## FIXME: use as convergence test check stopifnot(getME(fm4b,"theta") == 0) fm4c <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="bobyqa", use.last.params=TRUE), start=list(theta=1)) stopifnot(all.equal(getME(fm4, "theta") -> th4, getME(fm4c,"theta"), tolerance=1e-4), th4 > 0) ## new: doesn't get stuck at edge any more, but gets stuck somewhere else ... fm5 <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="Nelder_Mead", check.conv.hess="ignore", check.conv.grad="ignore"), start=list(theta=1)) fm5b <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="Nelder_Mead", restart_edge=FALSE, check.conv.hess="ignore", check.conv.grad="ignore"), start = list(theta = 1)) fm5c <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="bobyqa"), start = list(theta = 1)) stopifnot(all.equal(unname(getME(fm5c,"theta")), 0.21067645, tolerance = 1e-7)) # 0.21067644264 [64-bit, lynne] ##{ ## additional stuff for diagnosing Nelder-Mead problems. library(optimx) fm5d <- update(fm5,control=lmerControl(optimizer="optimx", optCtrl=list(method="L-BFGS-B"))) fm5e <- update(fm5, control=lmerControl(optimizer="nloptwrap")) mList <- setNames(list(fm4,fm4b,fm4c,fm5,fm5b,fm5c,fm5d,fm5e), c("NM/uselast","NM/uselast/norestart","bobyqa/uselast", "NM","NM/norestart","bobyqa","LBFGSB","nloptr/bobyqa")) pp <- profile(fm5c,which=1) dd <- as.data.frame(pp) par(las=1,bty="l") v <- sapply(mList, function(x) sqrt(VarCorr(x)[[1]])) plot(.zeta^2~.sig01, data=dd, type="b") abline(v=v) res <- cbind(VCorr = sapply(mList, function(x) sqrt(VarCorr(x)[[1]])), theta = sapply(mList, getME,"theta"), loglik = sapply(mList, logLik)) res print(sessionInfo(), locale=FALSE) ##} ###################### library(lattice) ## testing boundary and near-boundary cases tmpf <- function(i,...) { set.seed(i) d <- data.frame(x=rnorm(60),f=factor(rep(1:6,each=10))) d$y <- simulate(~x+(1|f),family=gaussian,newdata=d, newparams=list(theta=0.01,beta=c(1,1),sigma=5))[[1]] lmer(y~x+(1|f),data=d,...) } sumf <- function(m) { unlist(VarCorr(m))[1] } if (FALSE) { ## figuring out which seeds will give boundary and ## near-boundary solutions mList <- lapply(1:201,tmpf) # [FIXME tons of messages "theta parameters vector not named"] ss <- sapply(mList,sumf)+1e-50 par(las=1,bty="l") hist(log(ss),col="gray",breaks=50) ## values lying on boundary which(log(ss)<(-40)) ## 5, 7-13, 15, 21, ... ## values close to boundary (if check.edge not set) which(log(ss)>(-40) & log(ss) <(-20)) ## 16, 44, 80, 86, 116, ... } ## diagnostic plot tmpplot <- function(i, FUN=tmpf) { dd <- FUN(i, devFunOnly=TRUE) x <- 10^seq(-10,-6.5,length=201) dvec <- sapply(x,dd) op <- par(las=1,bty="l"); on.exit(par(op)) plot(x,dvec-min(dvec)+1e-16, log="xy", type="b") r <- FUN(i) abline(v = getME(r,"theta"), col=2) invisible(r) } ## Case #1: boundary estimate with or without boundary.tol m5 <- tmpf(5) m5B <- tmpf(5,control=lmerControl(boundary.tol=0)) stopifnot(getME(m5, "theta")==0, getME(m5B,"theta")==0) p5 <- profile(m5) ## bobyqa warnings but results look reasonable xyplot(p5) ## reveals slight glitch (bottom row of plots doesn't look right) expect_warning(splom(p5),"unreliable for singular fits") p5B <- profile(m5, signames=FALSE) # -> bobyqa convergence warning (code 3) expect_warning(splom(p5B), "unreliable for singular fits") if(lme4:::testLevel() >= 2) { ## avoid failure to warn ## Case #2: near-boundary estimate, but boundary.tol can't fix it m16 <- tmpplot(16) ## sometimes[2014-11-11] fails (??) : p16 <- profile(m16) ## warning message*s* (non-monotonic profile and more) plotOb <- xyplot(p16) ## NB: It's the print()ing of 'plotOb' which warns ==> need to do this explicitly: expect_warning(print(plotOb), ## warns about linear interpolation in profile for variable 1 "using linear interpolation") d16 <- as.data.frame(p16) xyplot(.zeta ~ .focal|.par, data=d16, type=c("p","l"), scales = list(x=list(relation="free"))) try(splom(p16)) ## breaks when calling predict(.) } ## bottom line: ## * xyplot.thpr could still be improved ## * most of the near-boundary cases are noisy and can't easily be ## fixed tmpf2 <- function(i,...) { set.seed(i) d <- data.frame(x=rnorm(60),f=factor(rep(1:6,each=10)), w=rep(10,60)) d$y <- simulate(~x+(1|f),family=binomial, weights=d$w,newdata=d, newparams=list(theta=0.01,beta=c(1,1)))[[1]] glmer(y~x+(1|f),data=d,family=binomial,weights=w,...) } if (FALSE) { ## figuring out which seeds will give boundary and ## near-boundary solutions mList <- lapply(1:201,tmpf2) ss <- sapply(mList,sumf)+1e-50 par(las=1,bty="l") hist(log(ss),col="gray",breaks=50) ## values lying on boundary head(which(log(ss)<(-50))) ## 1-5, 7 ... ## values close to boundary (if check.edge not set) which(log(ss)>(-50) & log(ss) <(-20)) ## 44, 46, 52, ... } ## m1 <- tmpf2(1) ## FIXME: doesn't work if we generate m1 via tmpf2(1) -- ## some environment lookup problem ... set.seed(1) d <- data.frame(x=rnorm(60),f=factor(rep(1:6,each=10)), w=rep(10,60)) d$y <- simulate(~x+(1|f),family=binomial, weights=d$w,newdata=d, newparams=list(theta=0.01,beta=c(1,1)))[[1]] m1 <- glmer(y~x+(1|f),data=d,family=binomial,weights=w) p1 <- profile(m1) xyplot(p1) expect_warning(splom(p1),"splom is unreliable") } ## skip on windows (for speed) lme4/tests/polytomous.R0000644000176200001440000000247114063503234014636 0ustar liggesuserslibrary(lme4) ## setup ## library(polytomous) ## data(think) ## think.polytomous.lmer1 <- polytomous(Lexeme ~ Agent + Patient + (1|Register), ## data=think, heuristic="poisson.reformulation") ## save("formula.poisson","data.poisson",file="polytomous_test.RData") load(system.file("testdata","polytomous_test.RData",package="lme4")) if (FALSE) { ## infinite loop glmer(formula.poisson,data=data.poisson,family=poisson,verbose=10) ## Cholmod not positive definite -> infinite loop glmer(formula.poisson,data=data.poisson,family=poisson, verbose=10,control=glmerControl(optimizer="bobyqa")) ## caught warning: maxfun < 10 * length(par)^2 is not recommended. -> infinite loop } ## works but sloooow .... if (FALSE) { try(g1 <- glmer(formula.poisson,data=data.poisson,family=poisson, control=glmerControl(compDev=FALSE),verbose=1)) ## runs for 2880 steps until: ## Error in pp$updateDecomp() : Downdated VtV is not positive definite } (testLevel <- lme4:::testLevel()) if (testLevel > 2) { glmer(formula.poisson,data=data.poisson,family=poisson, control=glmerControl(compDev=FALSE,optimizer="bobyqa")) ## caught warning: maxfun < 10 * length(par)^2 is not recommended. ## but runs to completion } lme4/tests/lme4_nlme.R0000644000176200001440000000300114063503234014246 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type!="windows") { ## testing whether lme4 and nlme play nicely. Only known issue ## is lmList-masking ... library("lme4") library("nlme") fm1_lmer <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm1_lme <- lme (Reaction ~ Days, random = ~Days|Subject, sleepstudy) ## variance-covariance matrices: annoyingly different structures vc_lmer <- VarCorr(fm1_lmer) vc_lme <- VarCorr(fm1_lme, rdig = 8) suppressWarnings(storage.mode(vc_lme) <- "numeric")# 2 NAs vc_lmerx <- c(diag(vc_lmer[[1]]), attr(vc_lmer[[1]],"correlation")[1,2]) vc_lmex <- c( vc_lme[1:2,1], vc_lme[2,3]) stopifnot( all.equal(vc_lmex, vc_lmerx, tolerance= 4e-4) # had 3e-5, now see 0.000296 , ## fixed effects (much easier) : all.equal(fixef(fm1_lmer), fixef(fm1_lme)) # 3.6e-15 , all.equal(unname(unlist(unclass(ranef(fm1_lmer)))), unname(unlist(unclass(ranef(fm1_lme)))), tolerance = 2e-4) # had 2e-5, now see 8.41e-5 ) fm1L_lme <- nlme::lmList(distance ~ age | Subject, Orthodont) fm1L_lmer <- lme4::lmList(distance ~ age | Subject, Orthodont) stopifnot(all.equal(fixef(fm1L_lmer), fixef(fm1L_lme))) sm1L_e <- summary(fm1L_lme) sm1L_er <- summary(fm1L_lmer) stopifnot( all.equal(coef(sm1L_e), coef(sm1L_er), tol=1e-12)# even tol=0 works on some Lnx 64b ) ## FIXME: test opposite order } lme4/tests/lmer-1.Rout.save0000644000176200001440000000253714176510270015174 0ustar liggesusers R Under development (unstable) (2022-01-22 r81552) -- "Unsuffered Consequences" Copyright (C) 2022 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ### suppressPackageStartupMessages(...) as we have an *.Rout.save to Rdiff against > stopifnot(suppressPackageStartupMessages(require(lme4))) > options(show.signif.stars = FALSE, useFancyQuotes=FALSE) > > source(system.file("test-tools-1.R", package = "Matrix"))# identical3() etc Loading required package: tools > all.EQ <- function(u,v, ...) all.equal.X(u, v, except = c("call", "frame"), ...) > S4_2list <- function(obj) { # no longer used + sn <- slotNames(obj) + structure(lapply(sn, slot, object = obj), .Names = sn) + } > > if (lme4:::testLevel() <= 1) + quit("no") > proc.time() user system elapsed 0.926 0.084 1.005 lme4/tests/glmer-1.R0000644000176200001440000002656314063503234013660 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type!="windows") { ## generalized linear mixed model stopifnot(suppressPackageStartupMessages(require(lme4))) options(show.signif.stars = FALSE) source(system.file("test-tools-1.R", package = "Matrix"), keep.source = FALSE) ## ##' Check that coefficient +- "2" * SD contains true value ##' ##' @title Check that confidence interval for coefficients contains true value ##' @param fm fitted model, e.g., from lm(), lmer(), glmer(), .. ##' @param true.coef numeric vector of true (fixed effect) coefficients ##' @param conf.level confidence level for confidence interval ##' @param sd.factor the "2", i.e. default 1.96 factor for the confidence interval ##' @return TRUE or a string of "error" ##' @author Martin Maechler chkFixed <- function(fm, true.coef, conf.level = 0.95, sd.factor = qnorm((1+conf.level)/2)) { stopifnot(is.matrix(cf <- coefficients(summary(fm))), ncol(cf) >= 2) cc <- cf[,1] sd <- cf[,2] if(any(out1 <- true.coef < cc - sd.factor*sd)) return(sprintf("true coefficient[j], j=%s, is smaller than lower confidence limit", paste(which(out1), collapse=", "))) if(any(out2 <- true.coef > cc + sd.factor*sd)) return(sprintf("true coefficient[j], j=%s, is larger than upper confidence limit", paste(which(out2), collapse=", "))) ## else, return TRUE } ## TODO: (1) move these to ./glmer-ex.R [DONE] ## ---- (2) "rationalize" with ../man/cbpp.Rd #m1e <- glmer1(cbind(incidence, size - incidence) ~ period + (1 | herd), # family = binomial, data = cbpp, doFit = FALSE) ## now #bobyqa(m1e, control = list(iprint = 2L)) m1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp) m1. <- update(m1, start = getME(m1, c("theta", "fixef"))) dm1 <- drop1(m1) stopifnot(all.equal(drop1(m1.), dm1, tol = 1e-10))# Lnx(F28) 64b: 4e-12 ## response as a vector of probabilities and usage of argument "weights" m1p <- glmer(incidence / size ~ period + (1 | herd), weights = size, family = binomial, data = cbpp) ## Confirm that these are equivalent: stopifnot(all.equal(fixef(m1), fixef(m1p)), all.equal(ranef(m1), ranef(m1p)), TRUE) ## for(m in c(m1, m1p)) { ## cat("-------\\n\\nCall: ", ## paste(format(getCall(m)), collapse="\\n"), "\\n") ## print(logLik(m)); cat("AIC:", AIC(m), "\\n") ; cat("BIC:", BIC(m),"\\n") ## } stopifnot(all.equal(logLik(m1), logLik(m1p)), all.equal(AIC(m1), AIC(m1p)), all.equal(BIC(m1), BIC(m1p))) ## changed tolPwrss to 1e-7 to match other default m1b <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, verbose = 2L, control = glmerControl(optimizer="bobyqa", tolPwrss=1e-7, optCtrl=list(rhobeg=0.2, rhoend=2e-7))) ## using nAGQ=9L provides a better evaluation of the deviance m.9 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, nAGQ = 9) ## check with nAGQ = 25 m2 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, nAGQ = 25) ## loosened tolerance on parameters stopifnot(is((cm2 <- coef(m2)), "coef.mer"), dim(cm2$herd) == c(15,4), all.equal(fixef(m2), ### lme4a [from an Ubuntu 11.10 amd64 system] c(-1.39922533406847, -0.991407294757321, -1.12782184600404, -1.57946627431248), ##c(-1.3766013, -1.0058773, ## -1.1430128, -1.5922817), tolerance = 5.e-4, check.attributes=FALSE), all.equal(c(-2*logLik(m2)), 100.010030538022, tolerance=1e-9), all.equal(deviance(m2), 73.373, tolerance=1e-5) ## with bobyqa first (AGQ=0), then ##all.equal(deviance(m2), 101.119749563, tolerance=1e-9) ) ## 32-bit Ubuntu 10.04: coef_m1_lme4.0 <- structure(c(-1.39853505102576, -0.992334712470269, -1.12867541092127, -1.58037389566025), .Names = c("(Intercept)", "period2", "period3", "period4")) ## library(glmmADMB) ## mg <- glmmadmb(cbind(incidence, size - incidence) ~ period + (1 | herd), ## family = "binomial", data = cbpp) coef_m1_glmmadmb <- structure(c(-1.39853810064827, -0.99233330126975, -1.12867317840779, -1.58031150854503), .Names = c("(Intercept)", "period2", "period3", "period4")) ## library(glmmML) ## mm <- glmmML(cbind(incidence, size - incidence) ~ period, ## cluster=herd, ## family = "binomial", data = cbpp) coef_m1_glmmML <- structure(c(-1.39853234657711, -0.992336901732793, -1.12867036466201, -1.58030977686564), .Names = c("(Intercept)", "period2", "period3", "period4")) ## lme4[r 1636], 64-bit ubuntu 11.10: ## c(-1.3788385, -1.0589543, ## -1.1936382, -1.6306271), stopifnot(is((cm1 <- coef(m1b)), "coef.mer"), dim(cm1$herd) == c(15,4), all.equal(fixef(m1b),fixef(m1),tolerance=4e-5), is.all.equal4(fixef(m1b), coef_m1_glmmadmb, coef_m1_lme4.0, coef_m1_glmmML, tol = 5e-4) ) ## Deviance for the new algorithm is lower, eventually we should change the previous test ##stopifnot(deviance(m1) <= deviance(m1e)) showProc.time() # if (require('MASS', quietly = TRUE)) { bacteria$wk2 <- bacteria$week > 2 contrasts(bacteria$trt) <- structure(contr.sdif(3), dimnames = list(NULL, c("diag", "encourage"))) print(fm5 <- glmer(y ~ trt + wk2 + (1|ID), data=bacteria, family=binomial)) showProc.time() # stopifnot( all.equal(logLik(fm5), ## was -96.127838 structure(-96.13069, nobs = 220L, nall = 220L, df = 5L, REML = FALSE, class = "logLik"), tolerance = 5e-4, check.attributes = FALSE) , all.equal(fixef(fm5), ## was 2.834218798 -1.367099481 c("(Intercept)"= 2.831609490, "trtdiag"= -1.366722631, ## now 0.5842291915, -1.599148773 "trtencourage"=0.5840147802, "wk2TRUE"=-1.598591346), tolerance = 1e-4 ) ) } ## Failure to specify a random effects term - used to give an obscure message ## Ensure *NON*-translated message; works on Linux,... : if(.Platform$OS.type == "unix") { Sys.setlocale("LC_MESSAGES", "C") tc <- tryCatch( m2 <- glmer(incidence / size ~ period, weights = size, family = binomial, data = cbpp) , error = function(.) .) stopifnot(inherits(tc, "error"), identical(tc$message, "No random effects terms specified in formula")) } ## glmer - Modeling overdispersion as "mixture" aka ## ----- - *ONE* random effect *PER OBSERVATION" -- example inspired by Ben Bolker: ##' ##' ##'
##' @title ##' @param ng number of groups ##' @param nr number of "runs", i.e., observations per groups ##' @param sd standard deviations of group and "Individual" random effects, ##' (\sigma_f, \sigma_I) ##' @param b true beta (fixed effects) ##' @return a data frame (to be used in glmer()) with columns ##' (x, f, obs, eta0, eta, mu, y), where y ~ Pois(lambda(x)), ##' log(lambda(x_i)) = b_1 + b_2 * x + G_{f(i)} + I_i ##' and G_k ~ N(0, \sigma_f); I_i ~ N(0, \sigma_I) ##' @author Ben Bolker and Martin Maechler rPoisGLMMi <- function(ng, nr, sd=c(f = 1, ind = 0.5), b=c(1,2)) { stopifnot(nr >= 1, ng >= 1, is.numeric(sd), names(sd) %in% c("f","ind"), sd >= 0) ntot <- nr*ng b.reff <- rnorm(ng, sd= sd[["f"]]) b.rind <- rnorm(ntot,sd= sd[["ind"]]) x <- runif(ntot) within(data.frame(x, f = factor(rep(LETTERS[1:ng], each=nr)), obs = 1:ntot, eta0 = cbind(1, x) %*% b), { eta <- eta0 + b.reff[f] + b.rind[obs] mu <- exp(eta) y <- rpois(ntot, lambda=mu) }) } set.seed(1) dd <- rPoisGLMMi(12, 20) m0 <- glmer(y~x + (1|f), family="poisson", data=dd) m1 <- glmer(y~x + (1|f) + (1|obs), family="poisson", data=dd) stopifnot(isTRUE(chkFixed(m0, true.coef = c(1,2))), isTRUE(chkFixed(m1, true.coef = c(1,2)))) (a01 <- anova(m0, m1)) stopifnot(all.equal(a01$Chisq[2], 554.334056, tolerance=1e-5), all.equal(a01$logLik, c(-1073.77193, -796.604902), tolerance=1e-6), a01$ npar == 3:4, na.omit(a01$ Df) == 1) if(lme4:::testLevel() > 1) { nsim <- 10 set.seed(2) system.time( simR <- lapply(1:nsim, function(i) { cat(i,"", if(i %% 20 == 0)"\n") dd <- rPoisGLMMi(10 + rpois(1, lambda=3), 16 + rpois(1, lambda=5)) m0 <- glmer(y~x + (1|f), family="poisson", data=dd) m1 <- glmer(y~x + (1|f) + (1|obs), family="poisson", data=dd) a01 <- anova(m0, m1) stopifnot(a01$ npar == 3:4, na.omit(a01$ Df) == 1) list(chk0 = chkFixed(m0, true.coef = c(1,2)), chk1 = chkFixed(m1, true.coef = c(1,2)), chisq= a01$Chisq[2], lLik = a01$logLik) })) ## m0 is the wrong model, so we don't expect much here: table(unlist(lapply(simR, `[[`, "chk0"))) ## If the fixed effect estimates were unbiased and the standard errors correct, ## and N(0,sigma^2) instead of t_{nu} good enough for the fixed effects, ## the confidence interval should contain the true coef in ~95 out of 100: table(unlist(lapply(simR, `[[`, "chk1"))) ## The tests are all highly significantly in favor of m1 : summary(chi2s <- sapply(simR, `[[`, "chisq")) ## Min. 1st Qu. Median Mean 3rd Qu. Max. ## 158.9 439.0 611.4 698.2 864.3 2268.0 stopifnot(chi2s > qchisq(0.9999, df = 1)) } showProc.time() } ## skip if windows and testLevel<1 lme4/tests/drop.R0000644000176200001440000000125214063503234013344 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ## slightly weird model but plausible --- not that ## one would want to try drop1() on this model ... fm2 <- lmer(Reaction ~ 1+ (Days|Subject), sleepstudy) drop1(fm2) ## empty update(fm1, . ~ . - Days) anova(fm2) ## empty terms(fm1) terms(fm1,fixed.only=FALSE) extractAIC(fm1) drop1(fm1) drop1(fm1, test="Chisq") gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, nAGQ=25L) drop1(gm1, test="Chisq") } ## skip on windows (for speed) lme4/tests/simulate.R0000644000176200001440000001413614063503234014230 0ustar liggesuserslibrary(lme4) library(testthat) (testLevel <- lme4:::testLevel()) L <- load(system.file("testdata/lme-tst-fits.rda", package="lme4", mustWork=TRUE)) if (testLevel>1) { if (getRversion() > "3.0.0") { ## saved fits are not safe with old R versions fm1 <- fit_sleepstudy_1 s1 <- simulate(fm1,seed=101)[[1]] s2 <- simulate(fm1,seed=101,use.u=TRUE) s3 <- simulate(fm1,seed=101,nsim=10) s4 <- simulate(fm1,seed=101,use.u=TRUE,nsim=10) stopifnot(length(s3)==10,all(sapply(s3,length)==180), length(s4)==10,all(sapply(s4,length)==180)) ## binomial (2-column and prob/weights) gm1 <- fit_cbpp_1 gm2 <- fit_cbpp_3 gm1_s1 <- simulate(gm1,seed=101)[[1]] gm1_s2 <- simulate(gm2,seed=101)[[1]] stopifnot(all.equal(gm1_s1[,1]/rowSums(gm1_s1),gm1_s2)) gm1_s3 <- simulate(gm1,seed=101,use.u=TRUE) gm1_s4 <- simulate(gm1,seed=101,nsim=10) gm1_s5 <- simulate(gm2,seed=101,nsim=10) stopifnot(length(gm1_s4)==10,all(sapply(gm1_s4,ncol)==2),all(sapply(gm1_s4,nrow)==56)) stopifnot(length(gm1_s5)==10,all(sapply(gm1_s5,length)==56)) ## binomial (factor): Kubovy bug report 1 Aug 2013 d <- data.frame(y=factor(rep(letters[1:2],each=100)), f=factor(rep(1:10,10))) g1 <- glmer(y~(1|f),data=d,family=binomial) s6 <- simulate(g1,nsim=10) stopifnot(length(s6)==10,all(sapply(s6,length)==200)) ## test explicitly stated link function gm3 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial(link="logit")) s4 <- simulate(gm3,seed=101)[[1]] stopifnot(all.equal(gm1_s1,s4)) cbpp$obs <- factor(seq(nrow(cbpp))) gm4 <- fit_cbpp_2 ## glmer(cbind(incidence, size - incidence) ~ period + ## (1 | herd) + (1|obs), data = cbpp, family = binomial) s5 <- simulate(gm4,seed=101)[[1]] s6 <- simulate(gm4,seed=101,use.u=TRUE)[[1]] ## Bernoulli ## works, but too slow if (testLevel > 2) { if(require("mlmRev")) { data(guImmun, package="mlmRev") table(guImmun$immun) ## N Y ## 1195 964 g1i <- glmer(immun ~ kid2p+mom25p+ord+ethn+momEd+husEd+momWork+rural+pcInd81+ (1|comm/mom), family="binomial", data=guImmun) ## In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, : ## Model failed to converge with max|grad| = 0.326795 (tol = 0.002, component 1) sg1 <- simulate(g1i) if(FALSE) { ## similar: not relevant here {comment out for 'R CMD check'}: ## if(require("glmmTMB")) { g2 <- glmmTMB(immun ~ kid2p+mom25p+ord+ethn+momEd+husEd+momWork+rural+pcInd81+ (1|comm/mom), family="binomial", data=guImmun) sg2 <- simulate(g2) ## } } } } set.seed(101) d <- data.frame(f = factor(rep(LETTERS[1:10],each=10))) d$x <- runif(nrow(d)) u <- rnorm(10) d$eta <- with(d, 1 + 2*x + u[f]) d$y <- rbinom(nrow(d), size=1, prob = plogis(d$eta)) g1 <- glmer(y ~ x + (1|f), data=d, family="binomial") ## tolPwrss=1e-5: no longer necessary if (testLevel > 2) { ## trying a set of glmerControl(tolPwrss = 10^t) : allcoef <- function(x) c(dev = deviance(x), th = getME(x,"theta"), beta = getME(x,"beta")) tfun <- function(t) { gg <- try( ## << errors (too small tolPwrss) are still printed : glmer(y~x+(1|f),data=d,family="binomial", control = glmerControl(tolPwrss = 10^t))) if (inherits(gg,"try-error")) rep(NA,4) else allcoef(gg) } tvec <- seq(-4,-16,by=-0.25) tres <- cbind(t = tvec, t(sapply(tvec, tfun))) print(tres) } gm_s5 <- simulate(g1, seed=102)[[1]] d$y <- factor(c("N","Y")[d$y+1]) g1B <- glmer(y ~ x + (1|f), data=d, family="binomial") ## ,tolPwrss=1e-5) s1B <- simulate(g1B, seed=102)[[1]] stopifnot(all.equal(gm_s5,as.numeric(s1B)-1)) ## another Bernoulli if(requireNamespace("mlmRev")) { data(Contraception, package="mlmRev") gm5 <- glmer(use ~ urban+age+livch+(1|district), Contraception, binomial) s3 <- simulate(gm5) } d$y <- rpois(nrow(d),exp(d$eta)) gm6 <- glmer(y~x+(1|f),data=d,family="poisson") s4 <- simulate(gm6) ## simulation 'from scratch' with formulas: ## binomial ## form <- formula(gm1)[-2] form <- ~ (1|herd) + period gm1_s4 <- simulate(form,newdata=model.frame(gm1), newparams=list(theta=getME(gm1,"theta"), beta=fixef(gm1)), family=binomial, weights=rowSums(model.frame(gm1)[[1]]), seed=101)[[1]] stopifnot(all.equal(gm1_s2,gm1_s4)) gm1_s5 <- simulate(formula(gm1),newdata=cbpp, newparams=list(theta=getME(gm1,"theta"), beta=fixef(gm1)), family=binomial, seed=101)[[1]] stopifnot(all.equal(gm1_s1,gm1_s5)) tt <- getME(gm1,"theta") bb <- fixef(gm1) expect_message(simulate(form,newdata=model.frame(gm1), newparams=list(theta=unname(tt), beta=fixef(gm1)), family=binomial, weights=rowSums(model.frame(gm1)[[1]]), seed=101),"assuming same order") expect_error(simulate(form,newdata=model.frame(gm1), newparams=list(theta=setNames(tt,"abc"), beta=fixef(gm1)), family=binomial, weights=rowSums(model.frame(gm1)[[1]]), seed=101),"mismatch between") expect_message(simulate(form,newdata=model.frame(gm1), newparams=list(theta=tt, beta=unname(bb)), family=binomial, weights=rowSums(model.frame(gm1)[[1]]), seed=101),"assuming same order") expect_error(simulate(form,newdata=model.frame(gm1), newparams=list(theta=tt, beta=setNames(bb,c("abc",names(bb)[-1]))), family=binomial, weights=rowSums(model.frame(gm1)[[1]]), seed=101),"mismatch between") ## Gaussian form <- formula(fm1)[-2] s7 <- simulate(form,newdata=model.frame(fm1), newparams=list(theta=getME(fm1,"theta"), beta=fixef(fm1), sigma=sigma(fm1)), family=gaussian, seed=101)[[1]] stopifnot(all.equal(s7,s1)) ## TO DO: wider range of tests, including offsets ... }# R >= 3.0.0 } ## testLevel>1 lme4/tests/optimizer.R0000644000176200001440000000500414063503234014421 0ustar liggesuserslibrary(lme4) source(system.file("test-tools-1.R", package = "Matrix"), keep.source = FALSE) ## N.B. is.all.equal4() and assert.EQ() use 'tol', not 'tolerance' ## should be able to run any example with any bounds-constrained optimizer ... ## Nelder_Mead, bobyqa built in; optimx/nlminb, optimx/L-BFGS-B ## optimx/Rcgmin will require a bit more wrapping/interface work (requires gradient) if (.Platform$OS.type != "windows") { fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ## Nelder_Mead fm1B <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, control=lmerControl(optimizer="bobyqa")) stopifnot(all.equal(fixef(fm1),fixef(fm1B))) require(optimx) lmerCtrl.optx <- function(method, ...) lmerControl(optimizer="optimx", ..., optCtrl=list(method=method)) glmerCtrl.optx <- function(method, ...) glmerControl(optimizer="optimx", ..., optCtrl=list(method=method)) (testLevel <- lme4:::testLevel()) ## FAILS on Windows (on r-forge only, not win-builder)... 'function is infeasible at initial parameters' ## (can we test whether we are on r-forge??) if (.Platform$OS.type != "windows") { fm1C <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, control=lmerCtrl.optx(method="nlminb")) fm1D <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, control=lmerCtrl.optx(method="L-BFGS-B")) stopifnot(is.all.equal4(fixef(fm1),fixef(fm1B),fixef(fm1C),fixef(fm1D))) fm1E <- update(fm1,control=lmerCtrl.optx(method=c("nlminb","L-BFGS-B"))) ## hack equivalence of call and optinfo fm1E@call <- fm1C@call fm1E@optinfo <- fm1C@optinfo assert.EQ(fm1C,fm1E, tol=1e-5, giveRE=TRUE)# prints unless tolerance=0--equality } gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial, control=glmerControl(tolPwrss=1e-13)) gm1B <- update(gm1, control=glmerControl (tolPwrss=1e-13, optimizer="bobyqa")) gm1C <- update(gm1, control=glmerCtrl.optx(tolPwrss=1e-13, method="nlminb")) gm1D <- update(gm1, control=glmerCtrl.optx(tolPwrss=1e-13, method="L-BFGS-B")) stopifnot(is.all.equal4(fixef(gm1),fixef(gm1B),fixef(gm1C),fixef(gm1D), tol=1e-5)) if (testLevel > 1) { gm1E <- update(gm1, control= glmerCtrl.optx(tolPwrss=1e-13, method=c("nlminb","L-BFGS-B"))) ## hack equivalence of call and optinfo gm1E@call <- gm1C@call gm1E@optinfo <- gm1C@optinfo assert.EQ(gm1E,gm1C, tol=1e-5, giveRE=TRUE)# prints unless tol=0--equality } } ## skip on windows (for speed) lme4/tests/lmer2_ex.R0000644000176200001440000000564313751775607014147 0ustar liggesusersstopifnot(suppressPackageStartupMessages(require(lme4))) ## Using simple generated data -- fully balanced here, unbalanced later set.seed(1) dat <- within(data.frame(lagoon = factor(rep(1:4, each = 25)), habitat = factor(rep(1:20, each = 5))), { ## a simple lagoon effect but no random effect y <- round(10*rnorm(100, m = 10*as.numeric(lagoon))) ## Here, *with* an RE, sigma_a = 100 RE <- rep(round(rnorm(nlevels(habitat), sd = 100)), each = 5) y2 <- y + RE }) ## FIXME: want lmer(* , sparseX = TRUE ) {as in lme4a} if (FALSE) { # need to adapt to new structure ##' ##' ##'
##' @title Comparing the different versions of lmer() for same data & model ##' @param form ##' @param data ##' @param verbose ##' @return chkLmers <- function(form, data, verbose = FALSE, tol = 200e-7) # had tol = 7e-7 working .. { # m <- lmer1(form, data = data) # ok, and more clear # m. <- lmer1(form, data = data, sparseX = TRUE, verbose = verbose) m2 <- lmer (form, data = data, verbose = verbose) # lmem-dense m2. <- lmer (form, data = data, sparseX = TRUE, verbose = verbose) ## Eq <- function(x,y) all.equal(x,y, tolerance = tol) stopifnot(## Compare sparse & dense of the new class results identical(slotNames(m2), slotNames(m2.)) , identical(slotNames(m2@fe), slotNames(m2.@fe)) , Eq(m2@resp, m2.@resp) , Eq(m2@re, m2.@re) , Eq(m2@fe@coef, m2.@fe@coef) , ## and now compare with the "old" (class 'mer') # Eq(unname(fixef(m)), m2@fe@beta) # , # Eq(unname(fixef(m.)), m2.@fe@beta) # , ## to do ## all.equal(ranef(m)), m2@re) ## all.equal(ranef(m.)), m2.@re) TRUE) invisible(list(#m=m, m.=m., m2 = m2, m2. = m2.)) } chk1 <- chkLmers(y ~ 0+lagoon + (1|habitat), data = dat, verbose = TRUE) chk2 <- chkLmers(y2 ~ 0+lagoon + (1|habitat), data = dat, verbose = TRUE) chk1$m2 ## show( lmer() ) -- sigma_a == 0 chk2$m2. ## show( lmer( ) ) -- n <- nrow(dat) for(i in 1:20) { iOut <- sort(sample(n, 1+rpois(1, 3), replace=FALSE)) cat(i,": w/o ", paste(iOut, collapse=", ")," ") chkLmers(y ~ 0+lagoon + (1|habitat), data = dat[- iOut,]) chkLmers(y2 ~ lagoon + (1|habitat), data = dat[- iOut,]) cat("\n") } ## One (rare) example where the default tolerance is not sufficient: dat. <- dat[- c(14, 34, 66, 67, 71, 88),] try( chkLmers(y ~ 0+lagoon + (1|habitat), data = dat.) ) ## Error: Eq(unname(fixef(m)), m2@fe@beta) is not TRUE ## ## but higher tolerance works: chkLmers(y ~ 0+lagoon + (1|habitat), data = dat., tol = 2e-4, verbose=TRUE) } proc.time() sessionInfo() lme4/tests/throw.R0000644000176200001440000000157214063503234013550 0ustar liggesusers## original code was designed to detect segfaults/hangs from error handling library(lme4) set.seed(101) d <- expand.grid(block = LETTERS[1:26], rep = 1:100) d$x <- runif(nrow(d)) reff_f <- rnorm(length(levels(d$block)),sd=1) ## need intercept large enough to avoid negative values d$eta0 <- 4+3*d$x ## version without random effects d$eta <- d$eta0+reff_f[d$block] ## inverse link d$mu <- 1/d$eta d$y <- rgamma(nrow(d), scale=d$mu/2, shape=2) if (.Platform$OS.type != "windows") { gm0 <- glmer(y ~ 1|block, d, Gamma) gm0.A25 <- glmer(y ~ 1|block, d, Gamma, nAGQ=25L) gm1 <- glmer(y ~ x + (1|block), d, Gamma) gm1.A25 <- glmer(y ~ x + (1|block), d, Gamma, nAGQ=25L) ## strange things happening for logLik ==> AIC, etc for nAGQ ??? anova(gm0, gm1) anova(gm0, gm0.A25) anova(gm1, gm1.A25) summary(gm1) # "fine" summary(gm1.A25) # Inf logLik etc ? } lme4/tests/profile-tst.R0000644000176200001440000001353414063503234014656 0ustar liggesuserslibrary(lme4) library(testthat) library(lattice) testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 options(nwarnings = 5000)# instead of 50, and then use summary(warnings()) if (testLevel>1) { ### __ was ./profile_plots.R ___ fm1 <- lmer(Reaction~ Days + (Days|Subject), sleepstudy) pfile <- system.file("testdata","tprfm1.RData", package="lme4") if(file.exists(pfile)) print(load(pfile)) else withAutoprint({ system.time( tpr.fm1 <- profile(fm1, optimizer="Nelder_Mead") ) ## 5 sec (2018); >= 50 warnings !? save(tpr.fm1, file= "../../inst/testdata/tprfm1.RData") }) oo <- options(warn = 2) # {warnings are errors from here on} if(!dev.interactive(orNone=TRUE)) pdf("profile_plots.pdf") xyplot(tpr.fm1) splom(tpr.fm1) densityplot(tpr.fm1, main="densityplot( profile(lmer(..)) )") ## various scale options xyplot(tpr.fm1,scale=list(x=list(relation="same"))) ## stupid xyplot(tpr.fm1,scale=list(y=list(relation="same"))) xyplot(tpr.fm1,scale=list(y=list(relation="same"),tck=0)) ## expect_error(xyplot(tpr.fm1,conf=50),"must be strictly between 0 and 1") ### end {profile_plots.R} fm01ML <- lmer(Yield ~ 1|Batch, Dyestuff, REML = FALSE) ## 0.8s (on a 5600 MIPS 64bit fast(year 2009) desktop "AMD Phenom(tm) II X4 925"): ## system.time( tpr <- profile(fm01ML) ) ## test all combinations of 'which', including plots (but don't show plots) wlist <- list(1:3,1:2,1,2:3,2,3,c(1,3)) invisible(lapply(wlist,function(w) xyplot(profile(fm01ML,which=w)))) (confint(tpr) -> CIpr) print(xyplot(tpr)) ## comparing against lme4a reference values -- but lme4 returns sigma ## rather than log(sigma) stopifnot(dim(CIpr) == c(3,2), all.equal(unname(CIpr[".sigma",]),exp(c(3.64362, 4.21446)), tolerance=1e-6), all.equal(unname(CIpr["(Intercept)",]),c(1486.451500,1568.548494))) options(oo)# warnings allowed .. ## fixed-effect profiling with vector RE data(Pastes) fmoB <- lmer(strength ~ 1 + (cask | batch), data=Pastes, control = lmerControl(optimizer = "bobyqa")) (pfmoB <- profile(fmoB, which = "beta_", alphamax=.001)) xyplot(pfmoB)# nice and easy .. summary( fm <- lmer(strength ~ 1 + (cask | batch), data=Pastes, control = lmerControl(optimizer = "nloptwrap", calc.derivs= FALSE)) ) ls.str(environment(nloptwrap))# showing *its* defaults pfm <- profile(fm, which = "beta_", alphamax=.001) # 197 warnings for "nloptwrap" summary(warnings()) str(pfm) # only 3 rows, .zeta = c(0, NaN, Inf) !!! try( xyplot(pfm) ) ## FIXME or rather the profiling or rather the "wrap on nloptr" (testLevel <- lme4:::testLevel()) if(testLevel > 2) { ## 2D profiles fm2ML <- lmer(diameter ~ 1 + (1|plate) + (1|sample), Penicillin, REML=0) system.time(pr2 <- profile(fm2ML)) # 5.2 sec, 2018-05: 2.1" (confint(pr2) -> CIpr2) lme4a_CIpr2 <- structure(c(0.633565787613112, 1.09578224011285, -0.721864513060904, 21.2666273835452, 1.1821039843372, 3.55631937954106, -0.462903300019305, 24.6778176174587), .Dim = c(4L, 2L), .Dimnames = list(c(".sig01", ".sig02", ".lsig", "(Intercept)"), c("2.5 %", "97.5 %"))) lme4a_CIpr2[".lsig",] <- exp(lme4a_CIpr2[".lsig",]) stopifnot(all.equal(unname(CIpr2),unname(lme4a_CIpr2),tolerance=1e-6)) print(xyplot(pr2, absVal=0, aspect=1.3, layout=c(4,1))) print(splom(pr2)) gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) ## GLMM profiles system.time(pr4 <- profile(gm1)) ## ~ 10 seconds pr4.3 <- profile(gm1,which=3) xyplot(pr4,layout=c(5,1),as.table=TRUE) splom(pr4) ## used to fail because of NAs nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = c(Asym = 200, xmid = 725, scal = 350)) if (FALSE) { ## not working yet: detecting (slightly) lower deviance; not converging in 10k pr5 <- profile(nm1,which=1,verbose=1,maxmult=1.2) xyplot(.zeta~.focal|.par,type=c("l","p"),data=lme4:::as.data.frame.thpr(pr5), scale=list(x=list(relation="free")), as.table=TRUE) } } ## testLevel > 2 if (testLevel > 3) { fm3ML <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, REML=FALSE) ## ~ 4 theta-variables (+ 2 fixed), 19 seconds | 2018-05: 7.4" print(system.time(pr3 <- profile(fm3ML))) print(xyplot(pr3)) print(splom(pr3)) if (testLevel > 4) { if(requireNamespace("mlmRev")) { data("Contraception", package="mlmRev") ## fit already takes ~ 3 sec (2018-05) fm2 <- glmer(use ~ urban+age+livch + (urban|district), Contraception, binomial) print(system.time(pr5 <- profile(fm2,verbose=10))) # 2018-05: 462 sec = 7'42" ## -> 5 warnings notably "non-monotonic profile for .sig02" (the RE's corr.) print(xyplot(pr5)) } } ## testLevel > 4 } ## testLevel > 3 library("parallel") if (detectCores()>1) { p0 <- profile(fm1, which="theta_") ## http://stackoverflow.com/questions/12983137/how-do-detect-if-travis-ci-or-not travis <- nchar(Sys.getenv("TRAVIS")) > 0 if(.Platform$OS.type != "windows" && !travis) { prof01P <- profile(fm1, which="theta_", parallel="multicore", ncpus=2) stopifnot(all.equal(p0,prof01P)) } ## works in Solaris from an interactive console but not ??? ## via R CMD BATCH if (Sys.info()["sysname"] != "SunOS" && !travis) { prof01P.snow <- profile(fm1, which="theta_", parallel="snow", ncpus=2) stopifnot(all.equal(p0,prof01P.snow)) } } ## test profile/update from within functions foo <- function() { gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) ## return profile(gm1, which="theta_") } stopifnot(inherits(foo(), "thpr")) } ## testLevel>1 lme4/tests/glmerWarn.R0000644000176200001440000000451114063503234014337 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) library(testthat) ## [glmer(*, gaussian) warns to rather use lmer()] m3 <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy)) m4 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) m5 <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy, family=gaussian)) expect_equal(fixef(m3),fixef(m5)) ## hack call -- comes out unimportantly different m4@call[[1]] <- quote(lme4::lmer) expect_equal(m3,m4) expect_equal(m3,m5) ## would like m3==m5 != m4 ?? V4 <- VarCorr(m4) V5 <- VarCorr(m5) expect_equal(V4, V5, tolerance = 1e-14) th4 <- getME(m4,"theta") expect_equal(th4, getME(m5,"theta"), tolerance = 1e-14) ## glmer() - poly() + interaction if (requireNamespace("mlmRev")) { data(Contraception, package="mlmRev") ## ch := with child Contraception <- within(Contraception, ch <- livch != "0") ## gmC1 <- glmer(use ~ poly(age,2) + ch + age:ch + urban + (1|district), ## Contraception, binomial) ### not a 'warning' per se {cannot suppressWarnings(.)}: ### fixed-effect model matrix is rank deficient so dropping 1 column / coefficient ### also printed with print(): labeled as "fit warnings" ## ==> from ../R/modular.R chkRank.drop.cols() ## --> Use control = glmerControl(check.rankX = "ignore+drop.cols")) ## because further investigation shows "the problem" is really already ## in model.matrix(): set.seed(101) dd <- data.frame(ch = c("Y","N")[1+rbinom(12, 1, 0.7)], age = rlnorm(12, 16)) colnames(mm1 <- model.matrix( ~ poly(age,2) + ch + age:ch, dd)) ## "(Int.)" "poly(age, 2)1" "poly(age, 2)2" "chY" "chN:age" "chY:age" ## If we make the poly() columns to regular variables, can interact: d2 <- within(dd, { p2 <- poly(age,2); ageL <- p2[,1]; ageQ <- p2[,2]; rm(p2)}) ## then, we can easily get what want (mm2 <- model.matrix( ~ ageL+ageQ + ch + ageL:ch, d2)) ## actually even more compactly now ("drawback": 'ageQ' at end): (mm2. <- model.matrix( ~ ageL*ch + ageQ, d2)) cn2 <- colnames(mm2) stopifnot(identical(mm2[,cn2], mm2.[,cn2])) } } ## skip on windows (for speed) lme4/tests/fewlevels.R0000644000176200001440000000132014063503234014370 0ustar liggesusers#### example originally from Gabor Grothendieck source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##--> rSim.11() testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 if (testLevel>1) { set.seed(1) d1 <- rSim.11(10000, k=4) library(nlme) m.lme <- lme(y ~ x, random=~ 1|fac , data=d1) (VC.lme <- VarCorr(m.lme)) detach("package:nlme") ## library(lme4) fm.NM <- lmer(y ~ x + (1|fac), data=d1, control=lmerControl("Nelder_Mead")) fm.Bq <- update(fm.NM, control=lmerControl("bobyqa")) v.lmer <- VarCorr(fm.NM)[[1]][1,1] stopifnot(all.equal(v.lmer,19.55,tolerance=1e-3)) ## was 19.5482 with old starting values (1), 19.5493 with new start algorithm } ## testLevel>1 lme4/tests/getME.R0000644000176200001440000000430414063503234013402 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) #### tests of getME() ### are names correct? -------------- if(getRversion() < "2.15") paste0 <- function(...) paste(..., sep = '') hasInms <- function(x) grepl("(Intercept", names(x), fixed=TRUE) matchNms <- function(fm, PAR) { stopifnot(is.character(vnms <- names(fm@cnms))) mapply(grepl, paste0("^", vnms), names(PAR)) } chkIMod <- function(fm) {## check "intercept only" model b1 <- getME(fm,"beta") f1 <- fixef(fm) stopifnot(hasInms(f1), f1 == b1, hasInms(t1 <- getME(fm,"theta")), matchNms(fm, t1)) } fm1 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin) chkIMod(fm1) fm2 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake) stopifnot(fixef(fm2) == getME(fm2,"beta")) getME(fm2,"theta") getME(fm3 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy), "theta") getME(fm4 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy), "theta") ## internal consistency check ensuring that all allowed 'name's work (and are not empty): (nmME <- eval(formals(lme4:::getME.merMod)$name)) chkMEs <- function(fm, nms) { stopifnot(is.character(nms)) str(parts <- sapply(nms, getME, object = fm, simplify=FALSE)) isN <- sapply(parts, is.null) stopifnot(identical(names(isN), nms), !any(isN)) } chkMEs(fm1, nmME) chkMEs(fm2, nmME) chkMEs(fm3, nmME) chkMEs(fm4, nmME) ## multiple components can now be retrieved at once gg <- getME(fm2,c("theta","beta")) gg2 <- getME(fm2,c("theta","beta","X")) ## list of Zt for each random-effects factor lapply(getME(fm2,c("Ztlist")),dim) ## Cholesky factors returned as a list of matrices getME(fm1,"ST") getME(fm2,"ST") ## distinction between number of RE terms ## and number of RE grouping factors stopifnot(getME(fm2,"n_rtrms")==1) stopifnot(getME(fm2,"n_rfacs")==1) lapply(getME(fm4,c("Ztlist")),dim) stopifnot(getME(fm4,"n_rtrms")==2) stopifnot(getME(fm4,"n_rfacs")==1) stopifnot(getME(fm1,"sigma")==sigma(fm1)) } ## skip on windows (for speed) lme4/tests/offset.R0000644000176200001440000000263614174542124013701 0ustar liggesusers## simple examples with offsets, to exercise methods etc. library(lme4) if (.Platform$OS.type != "windows") { ## generate a basic Gamma/random effects sim set.seed(101) d <- expand.grid(block=LETTERS[1:26],rep=1:100) 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 ## version without random effects d$eta <- d$eta0+reff_f[d$block] ## lmer() test: d$mu <- d$eta d$y <- rnorm(nrow(d),mean=d$mu,sd=1) fm1 <- lmer(y~x+(1|block), data=d) fm1off <- lmer(y~x+(1|block)+offset(3*x),data=d) ## check equality stopifnot(all.equal(fixef(fm1)[2]-3,fixef(fm1off)[2])) p0 <- predict(fm1) p1 <- predict(fm1,newdata=d) p2 <- predict(fm1off,newdata=d) stopifnot(all.equal(p0,p1), all.equal(p1,p2)) ## glmer() test: d$mu <- exp(d$eta) d$y <- rpois(nrow(d),d$mu) gm1 <- glmer(y~x+(1|block), data=d,family=poisson, control=glmerControl(check.conv.grad="ignore")) gm1off <- glmer(y~x+(1|block)+offset(3*x),data=d,family=poisson, control=glmerControl(check.conv.grad="ignore")) ## check equality stopifnot(all.equal(fixef(gm1)[2]-3,fixef(gm1off)[2],tolerance=3e-4)) p0 <- predict(gm1) p1 <- predict(gm1,newdata=d) p2 <- predict(gm1off,newdata=d) stopifnot(all.equal(p0,p1), all.equal(p1,p2)) ## FIXME: should also test simulations } ## skip on windows (for speed) lme4/tests/minval.R0000644000176200001440000000242714063503234013673 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type!="windows") { ## example posted by Stéphane Laurent ## exercises bug where Nelder-Mead min objective function value was >0 set.seed(666) sims <- function(I, J, sigmab0, sigmaw0){ Mu <- rnorm(I, mean=0, sd=sigmab0) y <- c(sapply(Mu, function(mu) rnorm(J, mu, sigmaw0))) data.frame(y=y, group=gl(I,J)) } I <- 3 # number of groups J <- 8 # number of repeats per group sigmab0 <- 0.15 # between standard deviation sigmaw0 <- 0.15 # within standard deviation dat <- sims(I, J, sigmab0, sigmaw0) library(lme4) isOldTol <- environment(nloptwrap)$defaultControl$xtol_abs == 1e-6 fm3 <- lmer(y ~ (1|group), data=dat) stopifnot(all.equal(unname(unlist(VarCorr(fm3))), switch(fm3@optinfo$optimizer, "Nelder_Mead" = 0.029662844, "bobyqa" = 0.029662698, "nloptwrap" = if (isOldTol) 0.029679755 else 0.029662699, stop("need new case here: value is ",unname(unlist(VarCorr(fm3)))) ), tolerance = 1e-7)) } ## skip on windows (for speed) lme4/tests/HSAURtrees.R0000644000176200001440000000466114063503234014334 0ustar liggesusersif (.Platform$OS.type != "windows") { library("lme4") ## example from HSAUR2 package; data from 'multcomp'; see ../inst/testdata/trees513.R load(system.file("testdata","trees513.RData",package="lme4")) ## model formula: modForm <- damage ~ species - 1 + (1 | lattice / plot) dfun <- glmer(modForm, data = trees513B, family = binomial, devFunOnly = TRUE) ls.str(environment(dfun))# "for your information" .not.call <- function(x) x[names(x) != "call"] if(lme4:::testLevel() < 2) q("no") ## {{advantage to if(. >= 2) { ........} : autoprint of system.time() etc ## else (testLevel >= 2) : -------------------------------------------------- ## Generate oldres: ## ---------------- ## library(lme4.0) ## system.time(mmod0 <- glmer(damage ~ species - 1 + (1 | lattice / plot), ## data = trees513, family = binomial())) ## ## 4 seconds ## oldres <- c(fixef(mmod0),getME(mmod0,"theta")) ## detach("package:lme4.0") ## dput(oldres) oldres <- structure(c(5.23645064474105, 4.73568475545248, 2.65289926317093, 1.29043984816924, 1.59329381563025, 0.532663142106669, 1.16703186884403 ), .Names = c("speciesspruce", "speciespine", "speciesbeech", "speciesoak", "specieshardwood", "plot:lattice.(Intercept)", "lattice.(Intercept)")) system.time(mmodA <- glmer(modForm, data = trees513A, family = binomial())) ## 7 seconds newres <- c(fixef(mmodA), getME(mmodA,"theta")) stopifnot(all.equal(oldres, newres, tolerance=1.5e-3)) system.time(mmodB <- glmer(modForm, data = trees513B, family = binomial())) ## 10.4 seconds ## if(FALSE) { ## defuncted in 2019-05 [been deprecated since 2013-06] ## lmer( + family) -> diverts to glmer() with a warning [TODO: use assertWarning(.) eventually] system.time(lmodB <- lmer(modForm, data = trees513B, family = binomial())) stopifnot(all.equal(.not.call(summary(mmodB)), .not.call(summary(lmodB)))) newresB <- c(fixef(mmodB),getME(mmodB,"theta")) stopifnot(length(newresB) == length(oldres) + 1)# extra: species[ash/maple/elm/lime] } } ## skip on windows (for speed) lme4/tests/lmer-conv.R0000644000176200001440000000133214063503234014301 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type!="windows") { ### lmer() convergence testing / monitoring / ... ## ------------------ ### The output of tests here are *not* 'diff'ed (<==> no *.Rout.save file) library(lme4) ## convergence on boundary warnings load(system.file("external/test3comp.rda", package = "Matrix")) b3 <- lmer(Y3 ~ (1|Sample) + (1|Operator/Run), test3comp, verb = TRUE) if (isTRUE(try(data(Early, package = 'mlmRev')) == 'Early')) { Early$tos <- Early$age - 0.5 # time on study b1 <- lmer(cog ~ tos + trt:tos + (tos|id), Early, verb = TRUE) } cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' } ## skip on windows (for speed) lme4/tests/elston.R0000644000176200001440000000664314063503234013715 0ustar liggesusers## original code for reading/aggregating: ## tickdata <- read.table("Elston2001_tickdata.txt",header=TRUE, ## colClasses=c("factor","numeric","factor","numeric","factor","factor")) ## tickdata <- transform(tickdata,cHEIGHT=scale(HEIGHT,scale=FALSE)) ## for (i in names(tickdata)) { ## if (is.factor(tickdata[[i]])) { ## tickdata[[i]] <- factor(tickdata[[i]],levels=sort(as.numeric(levels(tickdata[[i]])))) ## } ## } ## summary(tickdata) ## grouseticks <- tickdata ## library(reshape) ## meantick <- rename(aggregate(TICKS~BROOD,data=tickdata,FUN=mean), ## c(TICKS="meanTICKS")) ## vartick <- rename(aggregate(TICKS~BROOD,data=tickdata,FUN=var), ## c(TICKS="varTICKS")) ## uniqtick <- unique(subset(tickdata,select=-c(INDEX,TICKS))) ## grouseticks_agg <- Reduce(merge,list(meantick,vartick,uniqtick)) ## save("grouseticks","grouseticks_agg",file="grouseticks.rda") if (.Platform$OS.type != "windows") { library(lme4) data(grouseticks) do.plots <- FALSE form <- TICKS~YEAR+HEIGHT+(1|BROOD)+(1|INDEX)+(1|LOCATION) ## fit with lme4 ## library(lme4) ## t1 <- system.time(full_mod1 <- glmer(form, family="poisson",data=grouseticks)) ## c1 <- c(fixef(full_mod1),unlist(VarCorr(full_mod1)), logLik=logLik(full_mod1),time=t1["elapsed"]) ## allcoefs1 <- c(unlist(full_mod1@ST),fixef(full_mod1)) ## detach("package:lme4") ## lme4 summary results: t1 <- structure(c(1.288, 0.048, 1.36, 0, 0), class = "proc_time", .Names = c("user.self", "sys.self", "elapsed", "user.child", "sys.child")) c1 <- structure(c(11.3559080756861, 1.1804105508475, -0.978704335712111, -0.0237607330254979, 0.293232458048324, 0.562551624933584, 0.279548178949372, -424.771990224991, 1.36), .Names = c("(Intercept)", "YEAR96", "YEAR97", "HEIGHT", "INDEX", "BROOD", "LOCATION", "logLik", "time.elapsed" )) allcoefs1 <- structure(c(0.541509425632023, 0.750034415832756, 0.528723159081737, 11.3559080756861, 1.1804105508475, -0.978704335712111, -0.0237607330254979 ), .Names = c("", "", "", "(Intercept)", "YEAR96", "YEAR97", "HEIGHT")) if (lme4:::testLevel() > 1) { t2 <- system.time(full_mod2 <- glmer(form, family="poisson",data=grouseticks)) c2 <- c(fixef(full_mod2),unlist(VarCorr(full_mod2)), logLik=logLik(full_mod2),time=t2["elapsed"]) ## refit ## FIXME: eventually would like to get _exactly_ identical answers on refit() full_mod3 <- refit(full_mod2,grouseticks$TICKS) tmpf <- function(x) unlist(getME(x,c("theta","beta"))) all.equal(tmpf(full_mod2),tmpf(full_mod3),tolerance=1e-5) } allcoefs <- function(x) c(getME(x,"theta"),getME(x,"beta")) ## deviance function ## FIXME: does compDev do _anything_ any more? mm <- glmer(form, family="poisson",data=grouseticks,devFunOnly=TRUE) mm2 <- glmer(form, family="poisson",data=grouseticks, devFunOnly=TRUE,control=glmerControl(compDev=TRUE)) stopifnot(all.equal(mm(allcoefs1),mm2(allcoefs1))) } ## skip on windows (for speed) lme4/tests/agridat_gotway.R0000644000176200001440000000462314063503234015412 0ustar liggesusers## require(agridat) ## dat <- gotway.hessianfly if (.Platform$OS.type != "windows") { ## don't actually use gotway_hessianfly_fit or gotway_hessianfly_prof, ## so we should be OK even with R< 3.0.1 load(system.file("testdata","gotway_hessianfly.rda",package="lme4")) # Block random. See Glimmix manual, output 1.18. # Note: (Different parameterization) ## require("lme4.0") ## fit2 <- glmer(cbind(y, n-y) ~ gen + (1|block), data=dat, family=binomial) ## params <- list(fixef=fixef(fit2),theta=getME(fit2,"theta")) ## detach("package:lme4.0") lme4.0fit <- structure(list(fixef = structure(c(1.50345713031203, -0.193853259383803, -0.540808391060274, -1.43419379979154, -0.203701042949808, -0.978322555343941, -0.604078624475678, -1.67742449813309, -1.39842466673692, -0.681709344788684, -1.46295367186169, -1.45908310198959, -3.55285756517073, -2.50731975980307, -2.08716296677356, -2.96974270029992), .Names = c("(Intercept)", "genG02", "genG03", "genG04", "genG05", "genG06", "genG07", "genG08", "genG09", "genG10", "genG11", "genG12", "genG13", "genG14", "genG15", "genG16")), theta = structure(0.0319087494293615, .Names = "block.(Intercept)")), .Names = c("fixef", "theta")) ## start doesn't work because we don't get there library(lme4) m1 <- glmer(cbind(y, n-y) ~ gen + (1|block), data=gotway.hessianfly, family=binomial) m1B <- update(m1,control=glmerControl(optimizer="bobyqa")) max(abs(m1@optinfo$derivs$gradient)) ## 0.0012 max(abs(m1B@optinfo$derivs$gradient)) ## 2.03e-5 abs(m1@optinfo$derivs$gradient)/abs(m1B@optinfo$derivs$gradient) ## bobyqa gets gradients *at least* 1.64* lower lme4fit <- list(fixef=fixef(m1),theta=getME(m1,"theta")) ## hack around slight naming differences lme4fit$theta <- unname(lme4fit$theta) lme4.0fit$theta <- unname(lme4.0fit$theta) ## difference in theta on x86_64-w64-mingw32 (64-bit) with r-devel is 0.000469576 stopifnot(all.equal(lme4fit, lme4.0fit, tolerance = 5e-4)) ## Fun stuff: visualize and alternative model ## library(ggplot2) ## dat$prop <- dat$y/dat$n ## theme_set(theme_bw()) ## ggplot(dat,aes(x=gen,y=prop,colour=block))+geom_point(aes(size=n))+ ## geom_line(aes(group=block,colour=block))+ ## geom_smooth(family=binomial,aes(weight=n,colour=block,group=block),method="glm", ## alpha=0.1) ## dat$obs <- factor(seq(nrow(dat))) ## m2 <- glmer(cbind(y, n-y) ~ block+ (1|gen) + (1|obs), data=dat, family=binomial) } ## not on windows/CRAN lme4/tests/testcrab.R0000644000176200001440000001056214063503234014213 0ustar liggesuserslibrary("lme4") L <- load(system.file("testdata","crabs_randdata2.Rda",package="lme4")) ## randdata0: simulated data, in form suitable for plotting ## randdata: simulated data, in form suitable for analysis ## fr ## alive/dead formula ## fr2 ## proportion alive formula (use with weights=initial.snail.density) ## FIXME: there are still bigger differences than I'd like between the approaches ## (mostly in the random-effects correlation). It's not clear who's right; ## lme4 thinks its parameters are better, but ?? Could be explored further. if (FALSE) { ## library(ggplot2) ## commented to avoid triggering Suggests: requirement library(grid) zmargin <- theme(panel.margin=unit(0,"lines")) theme_set(theme_bw()) g1 <- ggplot(randdata0,aes(x=snail.size,y=surv,colour=snail.size,fill=snail.size))+ geom_hline(yintercept=1,colour="black")+ stat_sum(aes(size=factor(..n..)),alpha=0.6)+ facet_grid(.~ttt)+zmargin+ geom_boxplot(fill=NA,outlier.colour=NULL,outlier.shape=3)+ ## set outliers to same colour as points ## (hard to see which are outliers, but it doesn't really matter in this case) scale_size_discrete("# obs",range=c(2,5)) } if (.Platform$OS.type != "windows") { t1 <- system.time(glmer1 <- glmer(fr2,weights=initial.snail.density, family ="binomial", data=randdata)) t1B <- system.time(glmer1B <- glmer(fr,family ="binomial", data=randdata)) res1 <- c(fixef(glmer1),c(VarCorr(glmer1)$plot)) res1B <- c(fixef(glmer1B),c(VarCorr(glmer1B)$plot)) p1 <- unlist(getME(glmer1,c("theta","beta"))) stopifnot(all.equal(res1,res1B)) dfun <- update(glmer1,devFunOnly=TRUE) stopifnot(all.equal(dfun(p1),c(-2*logLik(glmer1)))) ## ## library(lme4.0) ## version 0.999999.2 results ## t1_lme4.0 <- system.time(glmer1X <- ## glmer(fr2,weights=initial.snail.density, ## family ="binomial", data=randdata)) ## dput(c(fixef(glmer1X),c(VarCorr(glmer1X)$plot))) ## p1X <- c(getME(glmer1X,"theta"),getME(glmer1X,"beta")) p1X <- c(0.681301656652347, -1.14775239687404, 0.436143018123226, 2.77730476938968, 0.609023583738824, -1.60055813739844, 2.0324468778545, 0.624173873057839, -1.7908793509579, -2.44540201631615, -1.42365990002708, -2.26780929006268, 0.700928084600075, -1.26220238391029, 0.369024582097804, 3.44325347343035, 2.26400391093108) stopifnot(all.equal(unname(p1),p1X,tolerance=0.03)) dfun(p1X) dfun(p1) ## ~ 1.8 seconds elapsed time lme4.0_res <- structure(c(2.77730476938968, 0.609023583738824, -1.60055813739844, 2.0324468778545, 0.624173873057839, -1.7908793509579, -2.44540201631615, -1.42365990002708, -2.26780929006268, 0.700928084600075, -1.26220238391029, 0.369024582097804, 3.44325347343035, 2.26400391093108, 0.464171947357232, -0.532754465140956, -0.532754465140956, 0.801690946568518), .Names = c("(Intercept)", "crab.speciesS", "crab.speciesW", "crab.sizeS", "crab.sizeM", "snail.sizeS", "crab.speciesS:crab.sizeS", "crab.speciesS:crab.sizeM", "crab.speciesS:snail.sizeS", "crab.speciesW:snail.sizeS", "crab.sizeS:snail.sizeS", "crab.sizeM:snail.sizeS", "crab.speciesS:crab.sizeS:snail.sizeS", "crab.speciesS:crab.sizeM:snail.sizeS", "", "", "", "")) stopifnot(all.equal(res1,lme4.0_res,tolerance=0.015)) ## library("glmmADMB") ## prop/weights formulation: ~ 7 seconds ## t1_glmmadmb <- system.time(glmer1B <- glmmadmb(fr,family ="binomial", ## corStruct="full",data=randdata)) ## dput(c(fixef(glmer1B),c(VarCorr(glmer1B)$plot))) glmmADMB_res <- structure(c(2.7773101267224, 0.609026276823218, -1.60055704634712, 2.03244174458562, 0.624171008585953, -1.79088398816641, -2.44540300134182, -1.42366043619683, -2.26780858382505, 0.700927141726545, -1.26219964572264, 0.369029052442189, 3.44326297908383, 2.26403738918967, 0.46417, -0.53253, -0.53253, 0.80169), .Names = c("(Intercept)", "crab.speciesS", "crab.speciesW", "crab.sizeS", "crab.sizeM", "snail.sizeS", "crab.speciesS:crab.sizeS", "crab.speciesS:crab.sizeM", "crab.speciesS:snail.sizeS", "crab.speciesW:snail.sizeS", "crab.sizeS:snail.sizeS", "crab.sizeM:snail.sizeS", "crab.speciesS:crab.sizeS:snail.sizeS", "crab.speciesS:crab.sizeM:snail.sizeS", "", "", "", "")) stopifnot(all.equal(res1B,glmmADMB_res,tolerance=0.015)) } ## skip on windows (for speed) lme4/tests/priorWeightsModComp.R0000644000176200001440000000703514063503234016352 0ustar liggesuserslibrary(lme4) n <- nrow(sleepstudy) op <- options(warn = 1, # show as they happen ("false" convergence warnings) useFancyQuotes = FALSE) if (.Platform$OS.type != "windows") { ##' remove all attributes but names dropA <- function(x) `attributes<-`(x, list(names = names(x))) ##' transform result of "numeric" all.equal.list() to a named vector all.eqL <- function(x1, x2, ...) { r <- sub("^Component ", '', all.equal(x1, x2, tolerance = 0, ...)) r <- strsplit(sub(": Mean relative difference:", "&&", r), split="&&", fixed=TRUE) setNames(as.numeric(vapply(r, `[`, "1.234", 2L)), ## drop surrounding "..." nm = sub('"$', '', substring(vapply(r, `[`, "nam", 1L), first=2))) } seedF <- function(s) { if(s %in% c(6, 39, 52, 57, 63, 74, 76, 86)) switch(as.character(s) , "52"=, "63"=, "74" = 2 , "6"=, "39" = 3 , "86" = 8 # needs 4 on Lnx-64b , "76" = 70 # needs 42 on Lnx-64b , "57" = 90 # needs 52 on Lnx-64b ) else if(s %in% c(1, 12, 15, 34, 36, 41, 42, 43, 49, 55, 59, 67, 80, 85)) ## seeds 41,59, .. 15 1.0 else ## seeds 22, 20, and better 0.25 } ## be fast, running only 10 seeds by default: sMax <- if(lme4:::testLevel() > 1) 99L else 9L mySeeds <- 0L:sMax lapply(setNames(,mySeeds), function(seed) { cat("\n------ random seed =", seed, "---------\n") set.seed(seed) v <- rpois(n,1) + 1 w <- 1/v cat("weights w:\n") fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy, REML=FALSE, weights = w); cat("..2:\n") fm2 <- lmer(Reaction ~ Days + (1 | Subject), sleepstudy, REML=FALSE, weights = w) cat("weights w*10:\n") fm1.10 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy, REML=FALSE, weights = w*10);cat("..2:\n") fm2.10 <- lmer(Reaction ~ Days + (1 | Subject), sleepstudy, REML=FALSE, weights = w*10) ## ano12... <- dropA(anova(fm1, fm2 )) ano12.10 <- dropA(anova(fm1.10, fm2.10)) print(aEQ <- all.eqL(ano12..., ano12.10)) # showing differences if(!exists("notChisq")) notChisq <<- local({ n <- names(ano12...) grep("Chisq", n, value=TRUE, fixed=TRUE, invert=TRUE) }) stopifnot( all.equal(ano12...$Chisq, ano12.10$Chisq, tol = 1e-6 * seedF(seed)) , all.equal(ano12...[notChisq], ano12.10[notChisq], tol= 1.5e-8 * seedF(seed)) ) aEQ }) -> rallEQ cat("=====================================\n") rallEQ <- t(simplify2array(rallEQ)) notChisq <- intersect(notChisq, colnames(rallEQ)) ## sort according to "severity": srallEQ <- rallEQ[with(as.data.frame(rallEQ), order(AIC, Chisq)), ] round(log10(srallEQ), 2) saveRDS(srallEQ, "priorWeightsMod_relerr.rds") if(!dev.interactive(orNone=TRUE)) pdf("priorWeightsMod_relerr.pdf") matplot(mySeeds, log10(srallEQ), type="l", xlab=NA) ; grid() legend("topleft", ncol=3, bty="n", paste(1:6, colnames(srallEQ), sep = ": "), col=1:6, lty=1:6) tolD <- sqrt(.Machine$double.eps) # sqrt(eps_C) abline(h = log10(tolD), col = "forest green", lty=3) axis(4, at=log10(tolD), label=quote(sqrt(epsilon[c])), las=1) LRG <- which(srallEQ[,"AIC"] > tolD) if (length(LRG)>0) { text(LRG, log10(srallEQ[LRG, "AIC"]), names(LRG), cex = .8) } ## how close are we .. str(tF <- sapply(mySeeds, seedF)) round(sort( rallEQ[, "Chisq"] / (tF * 1e-6 ), decreasing=TRUE), 1) round(sort(apply(rallEQ[,notChisq] / (tF * 1.5e-8), 1, max), decreasing=TRUE), 1) } ## skip on windows (for speed) options(op) lme4/tests/glmerControlPass.R0000644000176200001440000000157214063503234015703 0ustar liggesusersif (.Platform$OS.type != "windows") { ## test redirection from lmer to glmer (correct options passed, ## specifically glmerControl -> tolPwrss library("lme4") library("testthat") ## data("trees513", package = "multcomp") load(system.file("testdata","trees513.RData",package="lme4")) expect_is(mmod1 <- glmer(damage ~ species - 1 + (1 | lattice / plot), data = trees513B, family = binomial()),"glmerMod") if(FALSE) { ## Now (2019-05) defunct; was deprecated since 2013-06: expect_warning(mmod2 <- lmer(damage ~ species - 1 + (1 | lattice / plot), data = trees513B, family = binomial()), "calling lmer with .* is deprecated") mmod2@call <- mmod1@call ## hack calls to equality expect_equal(mmod1,mmod2) } } ## skip on windows (for speed) lme4/tests/nbinom.R0000644000176200001440000001475014063503234013671 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) cat("lme4 testing level: ", testLevel <- lme4:::testLevel(), "\n") getNBdisp <- function(x) getME(x,"glmer.nb.theta") ## for now, use hidden functions [MM: this is a sign, we should *export* them] refitNB <- lme4:::refitNB simfun <- function(sd.u=1, NBtheta=0.5, nblock = 25, fform = ~x, beta = c(1,2), nrep = 40, seed) { levelset <- c(LETTERS,letters) stopifnot(2 <= nblock, nblock <= length(levelset)) if (!missing(seed)) set.seed(seed) ntot <- nblock*nrep d1 <- data.frame(x = runif(ntot), f = factor(rep(levelset[1:nblock], each=nrep))) u_f <- rnorm(nblock, sd=sd.u) X <- model.matrix(fform, data=d1) transform(d1, z = rnbinom(ntot, mu = exp(X %*% beta + u_f[f]), size = NBtheta)) } ##' simplified logLik() so we can compare with "glmmADMB" (and other) results logLik.m <- function(x) { L <- logLik(x) attributes(L) <- attributes(L)[c("class","df","nobs")] L } if (testLevel > 1) withAutoprint({ set.seed(102) d.1 <- simfun() t1 <- system.time(g1 <- glmer.nb(z ~ x + (1|f), data=d.1, verbose=TRUE)) g1 d1 <- getNBdisp(g1) (g1B <- refitNB(g1, theta = d1)) (ddev <- deviance(g1) - deviance(g1B)) (reld <- (fixef(g1) - fixef(g1B)) / fixef(g1)) stopifnot(abs(ddev) < 1e-6, # was 6.18e-7, 1.045e-6, -6.367e-5, now 0 abs(reld) < 1e-6)# 0, then 4.63e-6, now 0 ## 2 Aug 2015: ddev==reld==0 on 32-bit Ubuntu 12.04 if(FALSE) { ## comment out to avoid R CMD check warning : ## library(glmmADMB) t2 <- system.time(g2 <- glmmadmb(z~x+(1|f), data = d.1, family="nbinom")) ## matrix not pos definite in sparse choleski t2 # 17.1 sec elapsed glmmADMB_vals <- list(fixef= fixef(g2), LL = logLik(g2), theta= g2$alpha) } else { glmmADMB_vals <- list(fixef = c("(Intercept)" = 0.928710, x = 2.05072), LL = structure(-2944.62, class = "logLik", df = 4, nobs = 1000L), theta = 0.4487) } stopifnot(exprs = { all.equal( d1, glmmADMB_vals$ theta, tolerance=0.003) # 0.0015907 all.equal(fixef(g1B), glmmADMB_vals$ fixef, tolerance=0.02)# was 0.009387 ! ## Ubuntu 12.04/32-bit: 0.0094 all.equal(logLik.m(g1B), glmmADMB_vals$ LL, tolerance=1e-4)# 1.681e-5; Ubuntu 12.04/32-b: 1.61e-5 }) })## end if( testLevel > 1 ) if(FALSE) { ## simulation study -------------------- ## library(glmmADMB) ## avoid R CMD check warning simsumfun <- function(...) { d <- simfun(...) t1 <- system.time(g1 <- glmer.nb(z~x+(1|f),data=d)) t2 <- system.time(g2 <- glmmadmb(z~x+(1|f), data=d,family="nbinom")) c(t.glmer=unname(t1["elapsed"]),nevals.glmer=g1$nevals, theta.glmer=exp(g1$minimum), t.glmmadmb=unname(t2["elapsed"]),theta.glmmadmb=g2$alpha) } ## library(plyr) ## sim50 <- raply(50,simsumfun(),.progress="text") save("sim50",file="nbinomsim1.RData") ## library(reshape) ## m1 <- melt(data.frame(run=seq(nrow(sim50)),sim50),id.var="run") ## m1 <- data.frame(m1,colsplit(m1$variable,"\\.",c("v","method"))) ## m2 <- cast(subset(m1,v=="theta",select=c(run,value,method)), ## run~method) library(ggplot2) ggplot(subset(m1,v=="theta"),aes(x=method,y=value))+ geom_boxplot()+geom_point()+geom_hline(yintercept=0.5,colour="red") ggplot(subset(m1,v=="theta"),aes(x=method,y=value))+ stat_summary(fun.data=mean_cl_normal)+ geom_hline(yintercept=0.5,colour="red") ggplot(m2,aes(x=glmer-glmmadmb))+geom_histogram() ## glmer is slightly more biased (but maybe the MLE itself is biased???) }## end{simulation study}------------------------- ### epilepsy example: data(epil, package="MASS") epil2 <- transform(epil, Visit = (period-2.5)/5, Base = log(base/4), Age = log(age), subject= factor(subject)) if(FALSE) { ## comment out to avoid R CMD check warning : ## library(glmmADMB) t3 <- system.time(g3 <- glmmadmb(y~Base*trt+Age+Visit+(Visit|subject), data=epil2, family="nbinom")) # t3 : 8.67 sec glmmADMB_epil_vals <- list(fixef= fixef(g3), LL = logLik(g3), theta= g3$alpha) } else { glmmADMB_epil_vals <- list(fixef = c("(Intercept)"= -1.33, "Base"=0.8839167, "trtprogabide"= -0.9299658, "Age"= 0.4751434, "Visit"=-0.2701603, "Base:trtprogabide"=0.3372421), LL = structure(-624.551, class = "logLik", df = 9, nobs = 236L), theta = 7.4702) } if (testLevel > 2) withAutoprint({ ## "too slow" for regular testing -- 49 (MM@lynne: 33, then 26, then 14) seconds: (t4 <- system.time(g4 <- glmer.nb(y ~ Base*trt + Age + Visit + (Visit|subject), data = epil2, verbose=TRUE))) ## 1.1-7 : Warning in checkConv().. failed .. with max|grad| = 0.0089 (tol = 0.001, comp. 4) ## 1.1-21: 2 Warnings: max|grad| = 0.00859, then 0.1176 (0.002, comp. 1) stopifnot(exprs = { all.equal(getNBdisp(g4), glmmADMB_epil_vals$ theta, tolerance= 0.03) # 0.0019777 all.equal(fixef (g4), glmmADMB_epil_vals$ fixef, tolerance= 0.04) # 0.003731 (0.00374 on U 12.04) ## FIXME: even df differ (10 vs 9) ! ## all.equal(logLik.m(g4), - glmmADMB_epil_vals$ LL, tolerance= 0.0) ## was 0.0002 all.equal(logLik.m(g4), # for now {this is not *the* truth, just our current approximation of it}: structure(-624.48418, class = "logLik", df = 10, nobs = 236L)) }) }) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' } ## skip on windows (for speed) lme4/tests/REMLdev.R0000644000176200001440000000233013751775607013656 0ustar liggesuserslibrary(lme4) fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm1ML <- refitML(fm1) REMLcrit(fm1) deviance(fm1ML) deviance(fm1,REML=FALSE) ## FIXME: not working yet (NA) deviance(fm1,REML=TRUE) ## from lme4.0 oldvals <- c(REML=1743.6282722424, ML=1751.98581103058) ## leave out ML values for REML fits for now ... stopifnot( all.equal(REMLcrit(fm1),deviance(fm1,REML=TRUE),deviance(fm1ML,REML=TRUE),oldvals["REML"]), all.equal(deviance(fm1ML),deviance(fm1ML,REML=FALSE),oldvals["ML"]), all.equal(REMLcrit(fm1)/-2,c(logLik(fm1)),c(logLik(fm1ML,REML=TRUE)),c(logLik(fm1,REML=TRUE))), all.equal(deviance(fm1ML)/-2,c(logLik(fm1ML,REML=FALSE)), c(logLik(fm1ML,REML=FALSE)))) ## should be: ## stopifnot( ## all.equal(deviance(fm1),deviance(fm1,REML=TRUE),deviance(fm1ML,REML=TRUE),oldvals["REML"]), ## all.equal(deviance(fm1ML),deviance(fm1,REML=FALSE),deviance(fm1ML,REML=FALSE),oldvals["ML"]), ## all.equal(deviance(fm1)/2,c(logLik(fm1)),c(logLik(fm1ML,REML=TRUE)),c(logLik(fm1,REML=TRUE))), ## all.equal(deviance(fm1ML)/2,c(logLik(fm1,REML=FALSE)),c(logLik(fm1ML,REML=FALSE)), ## c(logLik(fm1ML,REML=FALSE)))) lme4/tests/nlmer-conv.R0000644000176200001440000000171213751775607014503 0ustar liggesusers### nlmer() convergence testing / monitoring / ... ## ------------------- ### The output of tests here are *not* 'diff'ed (<==> no *.Rout.save file) library(lme4) ## 'Theoph' Data modeling if (lme4:::testLevel() > 1) { Th.start <- c(lKe=-2.5, lKa=0.5, lCl=-3) (nm2 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ lKe + lKa + lCl|Subject, Theoph, start = Th.start)) (nm3 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKe|Subject) + (lKa|Subject) + (lCl|Subject), Theoph, start = Th.start)) ## dropping lKe from random effects: (nm4 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ lKa + lCl|Subject, Theoph, start = Th.start, control = nlmerControl(tolPwrss=1e-8))) (nm5 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKa|Subject) + (lCl|Subject), Theoph, start = Th.start)) } lme4/tests/extras.R0000644000176200001440000000153313751775607013732 0ustar liggesuserslibrary(lme4) ## This example takes long : only for testLevel >= 3 : d.ok <- isTRUE(try(data(star, package = 'mlmRev')) == 'star') if(!interactive() && (lme4:::testLevel() < 3 || !d.ok)) q("no") ## This worked in an *older* version of lme4.0 ## fm1 <- lme4:::carryOver(math ~ gr+sx*eth+cltype+(yrs|id)+(1|tch)+(yrs|sch), ## star, yrs ~ tch/id, ## control = list(msV = 1, nit = 0, grad = 0)) system.time( fm1 <- lmer(math ~ gr + sx*eth + cltype + schtype + hdeg + clad + exp + trace + (yrs | id) + (1 | tch) + (yrs | sch), data = star, verbose = TRUE) ) ## user system elapsed ## 34.991 0.037 35.132 -- lme4.0 ## 36.599 0.031 36.745 -- lme4 {bobyqa; 2014-01-09 @ lynne} sm1 <- summary(fm1) print(sm1, corr=TRUE, symbolic.cor=TRUE)# now message *and* gives the correlation lme4/tests/lmList-tst.R0000644000176200001440000000500313751775607014474 0ustar liggesuserslibrary(lme4) options(nwarnings = 1000) if(getRversion() < "3.2.0") { if(interactive()) break # gives an error else q() # <- undesirable when interactive ! } ## Try all "standard" (statistical) S3 methods: .S3generics <- function(class) { s3m <- .S3methods(class=class) ii <- attr(s3m, "info") ii[!ii[, "isS4"], "generic"] } set.seed(12) d <- data.frame( g = sample(c("A","B","C","D","E"), 250, replace=TRUE), y1 = runif(250, max=100), y2 = sample(c(0,1), 250, replace=TRUE) ) fm3.1 <- lmList(y1 ~ 1 | g, data=d) fm3.2 <- lmList(y2 ~ 1 | g, data=d, family=binomial) data(Orthodont, package="nlme") Orthodont <- as.data.frame(Orthodont) # no "groupedData" fm2 <- lmList(distance ~ age | Subject, Orthodont) s3fn <- .S3generics(class= class(fm3.1)[1]) ## works for "old and new" class noquote(s3fn <- s3fn[s3fn != "print"])# <-- it is show() not print() that works ## [1] coef confint fitted fixef formula logLik pairs plot ## [9] predict qqnorm ranef residuals sigma summary update ## In lme4 1.1-7 (July 2014), only these worked: ## coef(), confint(), formula(), logLik(), summary(), update() ## pairs() is excluded for fm3.1 which has only intercept: ## no errors otherwise: evs <- sapply(s3fn[s3fn != "pairs"], do.call, args = list(fm3.1)) cls <- sapply(evs, function(.) class(.)[1]) clsOk <- cls[c("confint", "fixef", "formula", "logLik", "ranef", "sigma", "summary", "update")] stopifnot(identical(unname(clsOk), c("lmList4.confint", "numeric", "formula", "logLik", "ranef.lmList", "numeric", "summary.lmList", "lmList4"))) ## --- fm2 --- non-trivial X: can use pairs(), too: evs2 <- sapply(s3fn, do.call, args = list(fm2)) ## --- fm3.2 --- no failures for this "glmList" : ss <- function(...) suppressMessages(suppressWarnings(...)) ss(evs3.2 <- sapply(s3fn[s3fn != "pairs"], do.call, args = list(fm3.2))) ## --- fm4 --- evs4 <- sapply(s3fn, function(fn) tryCatch(do.call(fn, list(fm4)), error=function(e) e)) length(warnings()) summary(warnings()) ## 4 kinds; glm.fit: fitted probabilities numerically 0 or 1 occurred str(sapply(evs4, class)) # more errors than above isok4 <- !sapply(evs4, is, class2="error") ## includes a nice pairs(): evs4[isok4] ## Error msgs of those with errors, first 5, now 3, then 2 : str(errs4 <- lapply(evs4[!isok4], conditionMessage)) ## $ logLik : chr "log-likelihood not available with NULL fits" ## $ summary: chr "subscript out of bounds" stopifnot(length(errs4) <= 2) lme4/tests/devCritFun.R0000644000176200001440000000165014063503234014453 0ustar liggesusersif (.Platform$OS.type!="windows") { library(lme4) ## ---------------------------------------------------------------------- ## test that deviance(REMLfit, REML = FALSE) gives the same answer as ## the ML objective function at the REML fit ## ---------------------------------------------------------------------- set.seed(1) w <- runif(nrow(sleepstudy)) fm <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy, weights = w) dfun <- update(fm, devFunOnly = TRUE, REML = FALSE) stopifnot(all.equal(deviance(fm, REML = FALSE), dfun(getME(fm, "theta")))) ## ---------------------------------------------------------------------- ## TODO: test the opposite case that deviance(MLfit, REML = TRUE) ## gives the same answer as the REML objective function at the ML fit ## ---------------------------------------------------------------------- } lme4/tests/lmer-1.R0000644000176200001440000003132314176255662013515 0ustar liggesusers### suppressPackageStartupMessages(...) as we have an *.Rout.save to Rdiff against stopifnot(suppressPackageStartupMessages(require(lme4))) options(show.signif.stars = FALSE, useFancyQuotes=FALSE) source(system.file("test-tools-1.R", package = "Matrix"))# identical3() etc all.EQ <- function(u,v, ...) all.equal.X(u, v, except = c("call", "frame"), ...) S4_2list <- function(obj) { # no longer used sn <- slotNames(obj) structure(lapply(sn, slot, object = obj), .Names = sn) } if (lme4:::testLevel() <= 1) quit("no") ## otherwise *print* normally: oldOpts <- options(digits=2) (fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)) (fm1a <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, REML = FALSE)) (fm2 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)) anova(fm1, fm2) ## Now works for glmer fm1. <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy)) ## default family=gaussian/identity link -> automatically calls lmer() (but with a warning) ## hack call -- comes out unimportantly different fm1.@call[[1]] <- quote(lmer) stopifnot(all.equal(fm1, fm1.)) ## Test against previous version in lmer1 (using bobyqa for consistency) #(fm1. <- lmer1(Reaction ~ Days + (Days|Subject), sleepstudy, opt = "bobyqa")) #stopifnot(all.equal(fm1@devcomp$cmp['REML'], fm1.@devcomp$cmp['REML']), # all.equal(fixef(fm1), fixef(fm1.)), # all.equal(fm1@re@theta, fm1.@theta, tolerance = 1.e-7), # all.equal(ranef(fm1), ranef(fm1.))) ## compDev = FALSE no longer applies to lmer ## Test 'compDev = FALSE' (vs TRUE) ## fm1. <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, ## compDev = FALSE)#--> use R code (not C++) for deviance computation ## stopifnot(all.equal(fm1@devcomp$cmp['REML'], fm1.@devcomp$cmp['REML']), ## all.equal(fixef(fm1), fixef(fm1.)), ## all.equal(fm1@re@theta, fm1.@re@theta, tolerance = 1.e-7), ## all.equal(ranef(fm1), ranef(fm1.), tolerance = 1.e-7)) stopifnot( all.equal(fixef(fm1), fixef(fm2), tolerance = 1.e-13) , all.equal(unname(fixef(fm1)), c(251.405104848485, 10.467285959595), tolerance = 1e-13) , all.equal(Matrix::cov2cor(vcov(fm1))["(Intercept)", "Days"], -0.1375, tolerance = 4e-4) ) fm1ML <- refitML(fm1) fm2ML <- refitML(fm2) (cbind(AIC= c(m1= AIC(fm1ML), m2= AIC(fm2ML)), BIC= c( BIC(fm1ML), BIC(fm2ML))) -> ICm) stopifnot(all.equal(c(ICm), c(1763.94, 1762, 1783.1, 1777.97), tolerance = 1e-5))# see 1.2e-6 (fm3 <- lmer(Yield ~ 1|Batch, Dyestuff2)) stopifnot(all.equal(coef(summary(fm3)), array(c(5.6656, 0.67838803150, 8.3515624346), c(1,3), dimnames = list("(Intercept)", c("Estimate", "Std. Error", "t value"))))) showProc.time() # ### {from ../man/lmer.Rd } --- compare lmer & lmer1 --------------- (fmX1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)) (fm.1 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)) #(fmX2 <- lmer2(Reaction ~ Days + (Days|Subject), sleepstudy)) #(fm.2 <- lmer2(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)) ## check update(, ): fm.3 <- update(fmX1, . ~ Days + (1|Subject) + (0+Days|Subject)) stopifnot(all.equal(fm.1, fm.3)) fmX1s <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy )# no longer:, sparseX=TRUE) #fmX2s <- lmer2(Reaction ~ Days + (Days|Subject), sleepstudy, sparseX=TRUE) options(oldOpts) ## restore digits showProc.time() # for(nm in c("coef", "fixef", "ranef", "sigma", "model.matrix", "model.frame" , "terms")) { cat(sprintf("%15s : ", nm)) FUN <- get(nm) F.fmX1s <- FUN(fmX1s) # F.fmX2s <- FUN(fmX2s) # if(nm == "model.matrix") { # F.fmX1s <- as(F.fmX1s, "denseMatrix") # F.fmX2s <- as(F.fmX2s, "denseMatrix") # FF <- function(.) {r <- FUN(.); row.names(r) <- NULL # as(r, "generalMatrix") } # } # else FF <- FUN stopifnot( all.equal( FF(fmX1), F.fmX1s, tolerance = 1e-6) # , # all.equal( FF(fmX2), F.fmX2s, tolerance = 1e-5) # , # all.equal( FF(fm.1), F.fmX2s, tolerance = 9e-6) ## these are different models # , # all.equal(F.fmX2s, F.fmX1s, tolerance = 6e-6) # , # all.equal(FUN(fm.1), FUN(fm.2), tolerance = 6e-6) , TRUE) cat("[Ok]\n") } ## transformed vars should work[even if non-sensical as here;failed in 0.995-1] fm2l <- lmer(log(Reaction) ~ log(Days+1) + (log(Days+1)|Subject), data = sleepstudy, REML = FALSE) ## no need for an expand method now : xfm2 <- expand(fm2) stopifnot(dim(ranef(fm2l)[[1]]) == c(18, 2), is((c3 <- coef(fm3)), "coef.mer"), all(fixef(fm3) == c3$Batch),## <-- IFF \hat{\sigma^2} == 0 TRUE) ## Simple example by Andrew Gelman (2006-01-10) ---- n.groups <- 10 ; n.reps <- 2 n <- length(group.id <- gl(n.groups, n.reps)) ## simulate the varying parameters and the data: set.seed(0) a.group <- rnorm(n.groups, 1, 2) y <- rnorm (n, a.group[group.id], 1) ## fit and summarize the model fit.1 <- lmer (y ~ 1 + (1 | group.id)) oldOpts <- options(digits=3) coef (fit.1) options(oldOpts) ## check show( <"summary.mer"> ): (sf1 <- summary(fit.1)) # --> now looks as for fit.1 stopifnot(all.equal(fixef(fit.1), c("(Intercept)" = 1.571312129)), all.equal(unname(ranef(fit.1, drop=TRUE)[["group.id"]]), structure( c(1.8046888, -1.8097665, 1.6146451, 1.5408268, -0.1331995, -3.3306655, -1.8259277, -0.8735145, -0.3591311, 3.3720441), postVar = rep.int(0.311091076, 10)), tolerance = 1e-5) ) ## ranef and coef rr <- ranef(fm1) stopifnot(is.list(rr), length(rr) == 1, is.data.frame(rr[[1]])) print(plot(rr)) stopifnot(is(cc <- coef(fm1), "coef.mer"), is.list(cc), length(cc) == 1, is.data.frame(cc[[1]])) print(plot(cc)) rr <- ranef(fm2) stopifnot(is.list(rr), length(rr) == 1, is.data.frame(rr[[1]])) print(plot(rr)) stopifnot(is(cc <- coef(fm2), "coef.mer"), is.list(cc), length(cc) == 1, is.data.frame(cc[[1]])) print(plot(cc)) showProc.time() # ## Invalid factor specification -- used to seg.fault: set.seed(1) dat <- within(data.frame(lagoon = factor(rep(1:4,each = 25)), habitat = factor(rep(1:20, each = 5))), { y <- round(10*rnorm(100, m = 10*as.numeric(lagoon))) }) tt <- suppressWarnings(try(reg <- lmer(y ~ habitat + (1|habitat*lagoon), data = dat) ) # did seg.fault) ) # now gives error ^- should be ":" ## suppress warning that uses different quoting conventions on ## R-release vs. R-devel ## ignore singular fits as well as hess/grad problems ## (Windows gets singular fits, other platforms don't ...) ctrl0 <- lmerControl( check.conv.singular="ignore", check.conv.hess="ignore", check.conv.grad="ignore") r1 <- lmer(y ~ 0+habitat + (1|habitat:lagoon), data = dat, control=ctrl0) # ok, but senseless r1b <- lmer(y ~ 0+habitat + (1|habitat), data = dat, control=ctrl0) # same model, clearly unidentifiable ## "TODO" : summary(r1) should ideally warn the user stopifnot(all.equal(fixef(r1), fixef(r1b), tolerance= 1e-15), all.equal(ranef(r1), ranef(r1b), tolerance= 1e-15, check.attributes=FALSE)) ## Use a more sensible model: r2.0 <- lmer(y ~ 0+lagoon + (1|habitat:lagoon), data = dat) # ok r2 <- lmer(y ~ 0+lagoon + (1|habitat), data = dat) # ok, and more clear stopifnot(all.equal(fixef(r2), fixef(r2.0), tolerance= 1e-15), all.equal(ranef(r2), ranef(r2.0), tolerance= 1e-15, check.attributes=FALSE)) V2 <- vcov(r2) assert.EQ.mat(V2, diag(x = 9.9833/3, nr = 4)) stopifnot(all.equal(unname(fixef(r2)) - (1:4)*100, c(1.72, 0.28, 1.76, 0.8), tolerance = 1e-13)) ## sparseX version should give same numbers: ## (only gives a warning now -- sparseX disregarded) if(FALSE) { ## no longer r2. <- lmer(y ~ 0+lagoon + (1|habitat), data = dat, sparseX = TRUE) ## the summary() components we do want to compare 'dense X' vs 'sparse X': nmsSumm <- c("methTitle", "devcomp", "logLik", "ngrps", "coefficients", "sigma", "REmat", "AICtab") sr2 <- summary(r2) sr2. <- summary(r2.) sr2.$devcomp$dims['spFe'] <- 0L # to allow for comparisons below stopifnot(all.equal(sr2[nmsSumm], sr2.[nmsSumm], tolerance= 1e-14) , all.equal(ranef(r2), ranef(r2.), tolerance= 1e-14) , Matrix:::isDiagonal(vcov(r2.)) # ok , all.equal(Matrix::diag(vcov(r2.)), rep.int(V2[1,1], 4), tolerance= 1e-13) # , all(vcov(r2.)@factors$correlation == diag(4)) # not sure why this fails , TRUE) r2. } ### mcmcsamp() : ## From: Andrew Gelman ## Date: Wed, 18 Jan 2006 22:00:53 -0500 if (FALSE) { # mcmcsamp still needs work ## NB: Need to restore coda to the Suggests: field of DESCRIPTION ## file if this code block is reinstated. ## has.coda <- require(coda) ## if(!has.coda) ## cat("'coda' package not available; some outputs will look suboptimal\n") ## Very simple example y <- 1:10 group <- gl(2,5) (M1 <- lmer (y ~ 1 + (1 | group))) # works fine (r1 <- mcmcsamp (M1)) # dito r2 <- mcmcsamp (M1, saveb = TRUE) # gave error in 0.99-* and 0.995-[12] (r10 <- mcmcsamp (M1, n = 10, saveb = TRUE)) ## another one, still simple y <- (1:20)*pi x <- (1:20)^2 group <- gl(2,10) M1 <- lmer (y ~ 1 | group) mcmcsamp (M1, n = 2, saveb=TRUE) # fine M2 <- lmer (y ~ 1 + x + (1 + x | group)) # false convergence ## should be identical (and is) M2 <- lmer (y ~ x + ( x | group))# false convergence -> simulation doesn't work: if(FALSE) ## try(..) fails here (in R CMD check) [[why ??]] mcmcsamp (M2, saveb=TRUE) ## Error: inconsistent degrees of freedom and dimension ... ## mcmc for glmer: rG1k <- mcmcsamp(m1, n = 1000) summary(rG1k) rG2 <- mcmcsamp(m1, n = 3, verbose = TRUE) } ## Spencer Graves' example (from a post to S-news, 2006-08-03) ---------------- ## it should give an error, rather than silent non-sense: tstDF <- data.frame(group = letters[1:5], y = 1:5) assertError(## Now throws an error, as desired : lmer(y ~ 1 + (1|group), data = tstDF) ) showProc.time() # ## Wrong formula gave a seg.fault at times: set.seed(2)# ! D <- data.frame(y= rnorm(12,10), ff = gl(3,2,12), x1=round(rnorm(12,3),1), x2=round(rnorm(12,7),1)) ## NB: The first two are the same, having a length-3 R.E. with 3 x 3 vcov-matrix: ## --> do need CPU ## suppressWarnings() for warning about too-few random effects levels tmpf <- function(form) lmer(form, data = D , control=lmerControl(check.conv.singular="ignore", check.nobs.vs.nRE="ignore", calc.derivs=FALSE)) m0 <- tmpf(y ~ (x1 + x2)|ff) m1 <- tmpf(y ~ x1 + x2|ff) m2 <- tmpf(y ~ x1 + (x2|ff)) m3 <- tmpf(y ~ (x2|ff) + x1) suppressWarnings(stopifnot(all.equal(ranef(m0), ranef(m1), tolerance = 1e-5), all.equal(ranef(m2), ranef(m3), tolerance = 1e-5), inherits(tryCatch(lmer(y ~ x2|ff + x1, data = D), error = function(e)e), "error"))) showProc.time() # ## Reordering of grouping factors should not change the internal structure #Pm1 <- lmer1(strength ~ (1|batch) + (1|sample), Pastes, doFit = FALSE) #Pm2 <- lmer1(strength ~ (1|sample) + (1|batch), Pastes, doFit = FALSE) #P2.1 <- lmer (strength ~ (1|batch) + (1|sample), Pastes, devFunOnly = TRUE) #P2.2 <- lmer (strength ~ (1|sample) + (1|batch), Pastes, devFunOnly = TRUE) ## The environments of Pm1 and Pm2 should be identical except for ## "call" and "frame": #stopifnot(## all.EQ(env(Pm1), env(Pm2)), # all.EQ(S4_2list(P2.1), # S4_2list(P2.2))) ## example from Kevin Thorpe: synthesized equivalent ## http://thread.gmane.org/gmane.comp.lang.r.lme4.devel/9835 ## NA issue: simpler example d <- data.frame(y=1:60,f=factor(rep(1:6,each=10))) d$y[2] <- NA d$f[3:4] <- NA lmer(y~(1|f),data=d) glmer(y~(1|f),data=d,family=poisson) ## we originally thought that these examples should be ## estimating non-zero variances, but they shouldn't ... ## number of levels with each level of replication levs <- c(800,300,150,100,50,50,50,20,20,5,2,2,2,2) n <- seq_along(levs) flevels <- seq(sum(levs)) set.seed(101) fakedat <- data.frame(DA = factor(rep(flevels,rep(n,levs))), zbmi=rnorm(sum(n*levs))) ## add NA values fakedat[sample(nrow(fakedat),100),"zbmi"] <- NA fakedat[sample(nrow(fakedat),100),"DA"] <- NA m5 <- lmer(zbmi ~ (1|DA) , data = fakedat, control=lmerControl(check.nobs.vs.rankZ="ignore")) m6 <- update(m5, data=na.omit(fakedat)) stopifnot(VarCorr(m5)[["DA"]] == 0, VarCorr(m6)[["DA"]] == 0) showProc.time() lme4/tests/respiratory.R0000644000176200001440000000150614063503234014765 0ustar liggesusers## Data originally from Davis 1991 Stat. Med., as packaged in geepack ## and transformed (center, id -> factor, idctr created, levels labeled) library(lme4) if (.Platform$OS.type != "windows") { load(system.file("testdata","respiratory.RData",package="lme4")) m_glmer_4.L <- glmer(outcome~center+treat+sex+age+baseline+(1|idctr), family=binomial,data=respiratory) m_glmer_4.GHQ5 <- glmer(outcome~center+treat+sex+age+baseline+(1|idctr), family=binomial,data=respiratory,nAGQ=5) m_glmer_4.GHQ8 <- glmer(outcome~center+treat+sex+age+baseline+(1|idctr), family=binomial,data=respiratory,nAGQ=8) m_glmer_4.GHQ16 <- glmer(outcome~center+treat+sex+age+baseline+(1|idctr), family=binomial,data=respiratory,nAGQ=16) } ## skip on windows (for speed) lme4/tests/prLogistic.R0000644000176200001440000000220513751775607014540 0ustar liggesusers## data set and formula extracted from ?prLogisticDelta example ## (Thailand, clustered-data) in prLogistic package load(system.file("testdata","prLogistic.RData",package="lme4")) library(lme4) (testLevel <- lme4:::testLevel()) if (testLevel > 2) { print(system.time( lme4_est <- glmer(rgi ~ sex + pped + (1|schoolid), data = dataset, family=binomial) )) lme4_results <- list(sigma= sqrt(unname(unlist(VarCorr(lme4_est)))), beta = fixef(lme4_est)) ## stored results from other pkgs glmmML_est <- list(sigma = 1.25365353546143, beta = c("(Intercept)" = -2.19478801858317, "sex" = 0.548884468743364, "pped"= -0.623835613907385)) lme4.0_est <- list(sigma = 1.25369539060849, beta = c("(Intercept)" = -2.19474529099587, "sex" = 0.548900267825802, "pped"= -0.623934772981894)) source(system.file("test-tools-1.R", package = "Matrix"))#-> assert.EQ() etc assert.EQ.(lme4_results, glmmML_est, tol=3e-3) assert.EQ.(lme4_results, lme4.0_est, tol=3e-3) print(lme4_est) } lme4/tests/vcov-etc.R0000644000176200001440000000753014174542124014137 0ustar liggesusersstopifnot(require(lme4)) (testLevel <- lme4:::testLevel()) source(system.file("testdata", "lme-tst-funs.R", package="lme4", mustWork=TRUE))# -> unn() ## "MEMSS" is just 'Suggest' -- must still work, when it's missing: if (suppressWarnings(!require(MEMSS, quietly=TRUE)) || (data(ergoStool, package="MEMSS") != "ergoStool")) { cat("'ergoStool' data from package 'MEMSS' is not available --> skipping test\n") } else { fm1 <- lmer (effort ~ Type + (1|Subject), data = ergoStool) ##sp no longer supported since ~ 2012-3: ##sp fm1.s <- lmer (effort ~ Type + (1|Subject), data = ergoStool, sparseX=TRUE) ## was segfaulting with sparseX (a while upto 2010-04-06) fe1 <- fixef(fm1) ##sp fe1.s <- fixef(fm1.s) print(s1.d <- summary(fm1)) ##sp print(s1.s <- summary(fm1.s)) Tse1.d <- c(0.57601226, rep(0.51868384, 3)) stopifnot(exprs = { ##sp all.equal(fe1, fe1.s, tolerance= 1e-12) all.equal(Tse1.d, unname(se1.d <- coef(s1.d)[,"Std. Error"]), tolerance = 1e-6) # std.err.: no too much accuracy is(V.d <- vcov(fm1), "symmetricMatrix") ##sp all.equal(se1.d, coef(s1.s)[,"Std. Error"])#, tol = 1e-10 ##sp all.equal( V.d, vcov(fm1.s))#, tol = 1e-9 all.equal(Matrix::diag(V.d), unn(se1.d)^2, tolerance= 1e-12) }) }## if( ergoStool is available from pkg MEMSS ) ### -------------------------- a "large" example ------------------------- str(InstEval) if (FALSE) { # sparse X is not currently implemented, so forget about this: system.time(## works with 'sparseX'; d has 1128 levels fm7 <- lmer(y ~ d + service + studage + lectage + (1|s), data = InstEval, sparseX=TRUE, verbose=1L, REML=FALSE) ) system.time(sfm7 <- summary(fm7)) fm7 # takes a while as it computes summary() again ! range(t.fm7 <- coef(sfm7)[,"t value"])## -10.94173 10.61535 for REML, -11.03438 10.70103 for ML m.t.7 <- mean(abs(t.fm7), trim = .01) #stopifnot(all.equal(m.t.7, 1.55326395545110, tolerance = 1.e-9)) ##REML value stopifnot(all.equal(m.t.7, 1.56642013605506, tolerance = 1.e-6)) ## ML hist.t <- cut(t.fm7, floor(min(t.fm7)) : ceiling(max(t.fm7))) cbind(table(hist.t)) }# fixed effect 'd' -- with 'sparseX' only -------------------------------- if(testLevel <= 1) { cat('Time elapsed: ', proc.time(),'\n'); q("no") } ## ELSE : (testLevel > 1) : library(lattice) source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##--> all.equal(), isOptimized(), ... system.time( fm8.N <- lmer(y ~ service * dept + studage + lectage + (1|s) + (1|d), InstEval, REML=FALSE, control=lmerControl("Nelder_Mead"), verbose = 1L) ) ## 62 sec [MM@lynne; 2013-11] ## 59.5 sec [nb-mm3; 2013-12-31] system.time( fm8.B <- lmer(y ~ service * dept + studage + lectage + (1|s) + (1|d), InstEval, REML=FALSE, control=lmerControl("bobyqa"), verbose = 2L) ) ## 34.1 sec [nb-mm3; 2013-12-31] stopifnot(isOptimized(fm8.N), isOptimized(fm8.B)) all.equal(fm8.B, fm8.N, tolerance=0) ## "Mean relative difference: 3.31 e-06" [nb-mm3; 2013-12-31] str(baseOpti(fm8.N)) str(baseOpti(fm8.B)) (sm8 <- summary(fm8.B)) str(r8 <- ranef(fm8.B)) sapply(r8, summary) r.m8 <- cov2cor(vcov(sm8)) Matrix::image(r.m8, main="cor()") if(testLevel <= 2) { cat('Time elapsed: ', proc.time(),'\n'); q("no") } ## ELSE: testLevel > 2 ## Clearly smaller X, but more RE pars ## ==> currently considerably slower than the above system.time( fm9 <- lmer(y ~ studage + lectage + (1|s) + (1|d) + (1|dept:service) + (1|dept), InstEval, verbose = 1L, REML=FALSE) ) ## 410 secs [MM@lynne; 2013-11] fm9 (sm9 <- summary(fm9)) rr <- ranef(fm9, condVar = TRUE) ## ~ 10 secs sapply(rr, summary) qqr <- qqmath(rr, strip=FALSE) qqr$d qqr$s dotplot(rr,strip=FALSE)$`dept:service` cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' lme4/tests/hatvalues.R0000644000176200001440000000247614174542124014411 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) source(system.file("testdata", "lme-tst-funs.R", package="lme4", mustWork=TRUE))# -> unn() m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) bruteForceHat <- function(object) { with(getME(object, c("Lambdat", "Lambda", "Zt", "Z", "q", "X")), { ## cp:= the cross product block matrix in (17) and (18): W <- Diagonal(x = weights(object)) I <- Diagonal(q) A.21 <- t(X) %*% W %*% Z %*% Lambda cp <- rbind(cbind(Lambdat %*% Zt %*% W %*% Z %*% Lambda + I, t(A.21)), cbind(A.21, t(X) %*% W %*% X)) mm <- cbind(Z %*% Lambda, X) ## a bit efficient: both cp and mm are typically quite sparse ## mm %*% solve(as.matrix(cp)) %*% t(mm) mm %*% solve(cp, t(mm), sparse=FALSE) }) } str(H <- bruteForceHat(m)) set.seed(7) ii <- sample(nrow(sleepstudy), 500, replace=TRUE) m2 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy[ii, ]) stopifnot(all.equal(diag(H), unn(lme4:::hatvalues.merMod(m)), tol= 1e-14), all.equal(diag(bruteForceHat(m2)), unn(lme4:::hatvalues.merMod(m2)), tol= 1e-14) ) } ## skip on windows (for speed) lme4/tests/AAAtest-all.R0000644000176200001440000000154614063503234014436 0ustar liggesusersif (base::require("testthat", quietly = TRUE)) { pkg <- "lme4" require(pkg, character.only=TRUE, quietly=TRUE) if(getRversion() < "3.5.0") { withAutoprint <- identity ; prt <- print } else { prt <- identity } if(Sys.getenv("USER") %in% c("maechler", "bbolker")) withAutoprint({ ## for developers' sake: lP <- .libPaths() # ---- .libPaths() : ---- prt(lP) ## ---- Entries in .libPaths()[1] : ---- prt(list.files(lP[1], include.dirs=TRUE)) prt(sessionInfo()) prt(packageDescription("Matrix")) ## 'lme4' from packageDescription "file" : prt(attr(packageDescription("lme4"), "file")) }) test_check(pkg) ##======== ^^^ print(warnings()) # TODO? catch most of these by expect_warning(..) } else { cat( "package 'testthat' not available, cannot run unit tests\n" ) } lme4/tests/dynload.R0000644000176200001440000000367113751775607014063 0ustar liggesusers## this is the simpler version of the code for testing/exercising ## https://github.com/lme4/lme4/issues/35 ## see also ../misc/issues/dynload.R for more complexity pkg <- so_name <- "lme4"; doUnload <- FALSE; doTest <- TRUE ## pkg <- so_name <- "RcppEigen"; doUnload <- TRUE; doTest <- TRUE ## need to deal with the fact that DLL name != package name for lme4.0 ... ### pkg <- "lme4.0"; so_name <- "lme4"; doUnload <- TRUE instPkgs <- as.data.frame(installed.packages(),stringsAsFactors=FALSE) Load <- function() { library(pkg,character.only=TRUE) } Unload <- function() { ld <- library.dynam() pnames <- sapply(ld,"[[","name") names(ld) <- pnames lp <- gsub("/libs/.*$","",ld[[so_name]][["path"]]) cat("unloading from",lp,"\n") library.dynam.unload(so_name, lp) } Detach <- function() { detach(paste0("package:",pkg),character.only=TRUE,unload=TRUE) if (doUnload) Unload() } tmpf <- function() { g <- getLoadedDLLs() lnames <- names(g)[is.na(instPkgs[names(g),"Priority"])] cat("loaded DLLs:",lnames,"\n") g <- g[na.omit(match(c(so_name,"nlme"),names(g)))] class(g) <- "DLLInfoList" g } test <- function() { if (doTest) { if (pkg %in% c("lme4","lme4.0")) { fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, devFunOnly=TRUE) } if (pkg=="RcppEigen") { data(trees, package="datasets") mm <- cbind(1, log(trees$Girth)) # model matrix y <- log(trees$Volume) # response ## bare-bones direct interface flm <- fastLmPure(mm, y) } } } if (FALSE) { ## FIXME: disabled test for now for (i in 1:6) { cat("Attempt #",i,"\n",sep="") cat("loading",pkg,"\n") Load() tmpf() test() cat("detaching",pkg,"\n") Detach() cat("loading nlme\n") library("nlme") tmpf() detach("package:nlme",unload=TRUE) cat("detaching nlme\n") } } lme4/tests/priorWeights.R0000644000176200001440000001340714063503234015073 0ustar liggesusers## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } compFunc <- function(lmeMod, lmerMod, tol = 1e-2){ lmeVarCorr <- nlme:::VarCorr(lmeMod)[,"StdDev"] lmeCoef <- summary(lmeMod)$tTable[,-c(3,5)] lmeOut <- c(as.numeric(lmeVarCorr), as.numeric(lmeCoef)) keep <- !is.na(lmeOut) lmeOut <- lmeOut[keep] dn <- dimnames(lmeCoef) if(is.null(dn)) dn <- list("", names(lmeCoef)) names(lmeOut) <- c( paste(names(lmeVarCorr), "Var"), as.character(do.call(outer, c(dn, list("paste")))))[keep] ## get nested RE variances in the same order as nlme ## FIXME: not sure if this works generally vcLmer <- VarCorr(lmerMod) vcLmer <- vcLmer[length(vcLmer):1] ## lmerVarCorr <- c(sapply(vcLmer, attr, "stddev"), attr(VarCorr(lmerMod), "sc")) ## differentiate lme4{new} and lme4.0 : lmerCoef <- if(is(lmerMod, "merMod")) summary(lmerMod)$coefficients else summary(lmerMod)@coefs lmerOut <- c(lmerVarCorr, as.numeric(lmerCoef)) names(lmerOut) <- names(lmeOut) return(list(target = lmeOut, current = lmerOut, tolerance = tol)) } if (.Platform$OS.type != "windows") { set.seed(1) nGroups <- 100 nObs <- 1000 # explanatory variable with a fixed effect explVar1 <- rnorm(nObs) explVar2 <- rnorm(nObs) # random intercept among levels of a grouping factor groupFac <- as.factor(rep(1:nGroups,each=nObs/nGroups)) randEff0 <- rep(rnorm(nGroups),each=nObs/nGroups) randEff1 <- rep(rnorm(nGroups),each=nObs/nGroups) randEff2 <- rep(rnorm(nGroups),each=nObs/nGroups) # residuals with heterogeneous variance residSD <- rpois(nObs,1) + 1 residError <- rnorm(nObs,sd=residSD) # response variable respVar <- randEff0 + (1+randEff1)*explVar1 + (1+randEff2)*explVar2 + residError # rename to fit models on one line y <- respVar x <- explVar1 z <- explVar2 g <- groupFac v <- residSD^2 w <- 1/v library("nlme") lmeMods <- list( ML1 = lme(y ~ x, random = ~ 1|g, weights = varFixed(~v), method = "ML"), REML1 = lme(y ~ x, random = ~ 1|g, weights = varFixed(~v), method = "REML"), ML2 = lme(y ~ x, random = ~ x|g, weights = varFixed(~v), method = "ML"), REML2 = lme(y ~ x, random = ~ x|g, weights = varFixed(~v), method = "REML"), ML1 = lme(y ~ x+z, random = ~ x+z|g, weights = varFixed(~v), method = "ML"), REML2 = lme(y ~ x+z, random = ~ x+z|g, weights = varFixed(~v), method = "REML")) library("lme4") lmerMods <- list( ML1 = lmer(y ~ x + (1|g), weights = w, REML = FALSE), REML1 = lmer(y ~ x + (1|g), weights = w, REML = TRUE), ML2 = lmer(y ~ x + (x|g), weights = w, REML = FALSE), REML2 = lmer(y ~ x + (x|g), weights = w, REML = TRUE), ML3 = lmer(y ~ x + z + (x+z|g), weights = w, REML = FALSE), REML3 = lmer(y ~ x + z + (x+z|g), weights = w, REML = TRUE)) comp <- mapply(compFunc, lmeMods, lmerMods, SIMPLIFY=FALSE) stopifnot(all(sapply(comp, do.call, what = all.equal))) ## Look at the relative differences: sapply(mapply(compFunc, lmeMods, lmerMods, SIMPLIFY=FALSE, tol = 0), do.call, what = all.equal) ## add simulated weights to the sleepstudy example n <- nrow(sleepstudy) v <- rpois(n,1) + 1 w <- 1/v sleepLme <- lme(Reaction ~ Days, random = ~ Days|Subject, sleepstudy, weights = varFixed(~v), method = "ML") sleepLmer <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, weights = w, REML = FALSE) sleepComp <- compFunc(sleepLme, sleepLmer) stopifnot(do.call(all.equal, sleepComp)) ## look at relative differences: sleepComp$tolerance <- 0 do.call(all.equal, sleepComp) if (require("mlmRev")) { n <- nrow(Chem97) v <- rpois(n,1) + 1 w <- 1/v Chem97Lme <- lme(score ~ 1, random = ~ 1|lea/school, Chem97) Chem97Lmer <- lmer(score ~ (1|lea/school), Chem97) Chem97Comp <- compFunc(Chem97Lme, Chem97Lmer) stopifnot(do.call(all.equal, Chem97Comp)) ## look at relative differences: Chem97Comp$tolerance <- 0 do.call(all.equal, Chem97Comp) } set.seed(2) n <- 40 w <- runif(n) x <- runif(n) g <- factor(sample(1:10,n,replace=TRUE)) Z <- model.matrix(~g-1); y <- Z%*%rnorm(ncol(Z)) + x + rnorm(n)/w^.5 m <- lmer(y ~ x + (1|g), weights=w, REML = TRUE) ## CRAN-forbidden: ## has4.0 <- require("lme4.0")) has4.0 <- FALSE if(has4.0) { ## m.0 <- lme4.0::lmer(y ~ x + (1|g), weights=w, REML = TRUE) lmer0 <- get("lmer", envir=asNamespace("lme4.0")) m.0 <- lmer0(y ~ x + (1|g), weights=w, REML = TRUE) dput(fixef(m.0)) # c(-0.73065400610675, 2.02895402562926) dput(sigma(m.0)) # 1.73614301673377 dput(VarCorr(m.0)$g[1,1]) # 2.35670451590395 dput(unname(coef(summary(m.0))[,"Std. Error"])) ## c(0.95070076853232, 1.37650858268602) } fixef_lme4.0 <- c(-0.7306540061, 2.0289540256) sigma_lme4.0 <- 1.7361430 Sigma_lme4.0 <- 2.3567045 SE_lme4.0 <- c(0.95070077, 1.37650858) if(has4.0) try(detach("package:lme4.0")) stopifnot(all.equal(unname(fixef(m)), fixef_lme4.0, tolerance = 1e-3)) all.equal(unname(fixef(m)), fixef_lme4.0, tolerance = 0) #-> 1.657e-5 ## but these are not at all equal : (all.equal(sigma(m), sigma_lme4.0, tolerance = 10^-3)) # 0.4276 (all.equal(as.vector(VarCorr(m)$g), Sigma_lme4.0, tolerance = 10^-3)) # 1.038 (all.equal(as.vector(summary(m)$coefficients[,2]), SE_lme4.0, tolerance = 10^-3)) # 0.4276 ## so, lme4.0 was clearly wrong here ##' make sure models that differ only in a constant ##' prior weight have identical deviance: fm <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy,REML=FALSE) fm_wt <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, weights = rep(5, nrow(sleepstudy)),REML=FALSE) all.equal(deviance(fm), deviance(fm_wt)) } ## skip on windows (for speed) lme4/tests/testcolonizer.R0000644000176200001440000000140314063503234015302 0ustar liggesusers## library(lme4.0) ## Emacs M- --> setwd() correctly ## m0.0 <- glm(colonizers~Treatment*homespecies*respspecies, data=randdat, family=poisson) ## with(randdat,tapply(colonizers,list(Treatment,homespecies,respspecies),sum)) ## summary(m1.0 <- glmer(form1, data=randdat, family=poisson)) ## summary(m2.0 <- glmer(form2, data=randdat, family=poisson)) ## detach("package:lme4.0", unload=TRUE) load(system.file("testdata","colonizer_rand.rda",package="lme4")) library("lme4") packageVersion("lme4") if (.Platform$OS.type != "windows") { m1 <- glmer(form1,data=randdat, family=poisson) ## PIRLS step failed m2 <- glmer(form1,data=randdat, family=poisson, nAGQ=0) ## OK m3 <- glmer(form2,data=randdat, family=poisson) ## ditto } ## skip on windows (for speed) lme4/src/0000755000176200001440000000000014176612464011715 5ustar liggesuserslme4/src/predModule.cpp0000644000176200001440000003663213751775607014542 0ustar liggesusers// // predModule.cpp: implementation of predictor module using Eigen // // Copyright (C) 2011-2013 Douglas Bates, Martin Maechler, Ben Bolker and Steve Walker // // This file is part of lme4. #include "predModule.h" namespace lme4 { using Rcpp::as; using std::invalid_argument; using std::runtime_error; using Eigen::ArrayXd; typedef Eigen::Map MMat; typedef Eigen::Map MVec; typedef Eigen::Map MiVec; merPredD::merPredD(SEXP X, SEXP Lambdat, SEXP LamtUt, SEXP Lind, SEXP RZX, SEXP Ut, SEXP Utr, SEXP V, SEXP VtV, SEXP Vtr, SEXP Xwts, SEXP Zt, SEXP beta0, SEXP delb, SEXP delu, SEXP theta, SEXP u0) : d_X( as(X)), d_RZX( as(RZX)), d_V( as(V)), d_VtV( as(VtV)), d_Zt( as(Zt)), d_Ut( as(Ut)), d_LamtUt( as(LamtUt)), d_Lambdat( as(Lambdat)), d_theta( as(theta)), d_Vtr( as(Vtr)), d_Utr( as(Utr)), d_Xwts( as(Xwts)), d_beta0( as(beta0)), d_delb( as(delb)), d_delu( as(delu)), d_u0( as(u0)), d_Lind( as(Lind)), d_N( d_X.rows()), d_p( d_X.cols()), d_q( d_Zt.rows()), d_RX( d_p) { // Check consistency of dimensions if (d_N != d_Zt.cols()) throw invalid_argument("Z dimension mismatch"); if (d_Lind.size() != d_Lambdat.nonZeros()) throw invalid_argument("size of Lind does not match nonzeros in Lambda"); // checking of the range of Lind is now done in R code for reference class // initialize beta0, u0, delb, delu and VtV d_VtV.setZero().selfadjointView().rankUpdate(d_V.adjoint()); d_RX.compute(d_VtV); // ensure d_RX is initialized even in the 0-column X case setTheta(d_theta); // starting values into Lambda d_L.cholmod().final_ll = 1; // force an LL' decomposition updateLamtUt(); d_L.analyzePattern(d_LamtUt * d_LamtUt.transpose()); // perform symbolic analysis if (d_L.info() != Eigen::Success) throw runtime_error("CholeskyDecomposition.analyzePattern failed"); } void merPredD::updateLamtUt() { // This complicated code bypasses problems caused by Eigen's // sparse/sparse matrix multiplication pruning zeros. The // Cholesky decomposition croaks if the structure of d_LamtUt changes. MVec(d_LamtUt.valuePtr(), d_LamtUt.nonZeros()).setZero(); for (Index j = 0; j < d_Ut.outerSize(); ++j) { for(MSpMatrixd::InnerIterator rhsIt(d_Ut, j); rhsIt; ++rhsIt) { Scalar y(rhsIt.value()); Index k(rhsIt.index()); MSpMatrixd::InnerIterator prdIt(d_LamtUt, j); for (MSpMatrixd::InnerIterator lhsIt(d_Lambdat, k); lhsIt; ++lhsIt) { Index i = lhsIt.index(); while (prdIt && prdIt.index() != i) ++prdIt; if (!prdIt) throw runtime_error("logic error in updateLamtUt"); prdIt.valueRef() += lhsIt.value() * y; } } } } VectorXd merPredD::b(const double& f) const {return d_Lambdat.adjoint() * u(f);} VectorXd merPredD::beta(const double& f) const {return d_beta0 + f * d_delb;} VectorXd merPredD::linPred(const double& f) const { return d_X * beta(f) + d_Zt.adjoint() * b(f); } Rcpp::List merPredD::condVar(const Rcpp::Environment& rho) const { const Rcpp::List ll(as(rho["flist"])), trmlst(as(rho["terms"])); const int nf(ll.size()); const MiVec nl(as(rho["nlevs"])), nct(as(rho["nctot"])), off(as(rho["offsets"])); // ll : flist // trmlst : terms : list with one element per factor, indicating corresponding term // nf : : number of unique factors // nl : nlevs : number of levels for each unique factor // nct : nctot : total number of components per factor // off : offsets : points to where each term starts Rcpp::List ans(nf); ans.names() = clone(as(ll.names())); const SpMatrixd d_Lambda(d_Lambdat.adjoint()); for (int i = 0; i < nf; i++) { int ncti(nct[i]), nli(nl[i]); Rcpp::NumericVector ansi(ncti * ncti * nli); ansi.attr("dim") = Rcpp::IntegerVector::create(ncti, ncti, nli); ans[i] = ansi; const MiVec trms(as(trmlst(i))); // ncti : total number of components in factor i // nli : number of levels in factor i // ansi : array in which to store condVar's for factor i // trms : pointers to terms corresponding to factor i if (trms.size() == 1) { // simple case int offset = off[trms[0] - 1]; for (int j = 0; j < nli; ++j) { MatrixXd LvT(d_Lambdat.innerVectors(offset + j * ncti, ncti)); MatrixXd Lv(LvT.adjoint()); d_L.solveInPlace(LvT, CHOLMOD_A); MatrixXd rr(Lv * LvT); std::copy(rr.data(), rr.data() + rr.size(), &ansi[j * ncti * ncti]); } } else { throw std::runtime_error("multiple terms per factor not yet written"); } } return ans; } VectorXd merPredD::u(const double& f) const {return d_u0 + f * d_delu;} merPredD::Scalar merPredD::sqrL(const double& f) const {return u(f).squaredNorm();} void merPredD::updateL() { updateLamtUt(); // More complicated code to handle the case of zeros in // potentially nonzero positions. The factorize_p method is // for a SparseMatrix, not a MappedSparseMatrix. SpMatrixd m(d_LamtUt.rows(), d_LamtUt.cols()); m.resizeNonZeros(d_LamtUt.nonZeros()); std::copy(d_LamtUt.valuePtr(), d_LamtUt.valuePtr() + d_LamtUt.nonZeros(), m.valuePtr()); std::copy(d_LamtUt.innerIndexPtr(), d_LamtUt.innerIndexPtr() + d_LamtUt.nonZeros(), m.innerIndexPtr()); std::copy(d_LamtUt.outerIndexPtr(), d_LamtUt.outerIndexPtr() + d_LamtUt.cols() + 1, m.outerIndexPtr()); d_L.factorize_p(m, Eigen::ArrayXi(), 1.); d_ldL2 = ::M_chm_factor_ldetL2(d_L.factor()); } void merPredD::setTheta(const VectorXd& theta) { if (theta.size() != d_theta.size()) { Rcpp::Rcout << "(" << theta.size() << "!=" << d_theta.size() << ")" << std::endl; // char errstr[100]; // sprintf(errstr,"theta size mismatch (%d != %d)", // theta.size(),d_theta.size()); throw invalid_argument("theta size mismatch"); } // update theta std::copy(theta.data(), theta.data() + theta.size(), d_theta.data()); // update Lambdat int *lipt = d_Lind.data(); double *LamX = d_Lambdat.valuePtr(), *thpt = d_theta.data(); for (int i = 0; i < d_Lind.size(); ++i) { LamX[i] = thpt[lipt[i] - 1]; } } void merPredD::setZt(const VectorXd& ZtNonZero) { double *ZtX = d_Zt.valuePtr(); // where the nonzero values of Zt live std::copy(ZtNonZero.data(), ZtNonZero.data() + ZtNonZero.size(), ZtX); } merPredD::Scalar merPredD::solve() { d_delu = d_Utr - d_u0; d_L.solveInPlace(d_delu, CHOLMOD_P); d_L.solveInPlace(d_delu, CHOLMOD_L); // d_delu now contains cu d_CcNumer = d_delu.squaredNorm(); // numerator of convergence criterion d_delb = d_RX.matrixL().solve(d_Vtr - d_RZX.adjoint() * d_delu); d_CcNumer += d_delb.squaredNorm(); // increment CcNumer d_RX.matrixU().solveInPlace(d_delb); d_delu -= d_RZX * d_delb; d_L.solveInPlace(d_delu, CHOLMOD_Lt); d_L.solveInPlace(d_delu, CHOLMOD_Pt); return d_CcNumer; } merPredD::Scalar merPredD::solveU() { d_delb.setZero(); // in calculation of linPred delb should be zero after solveU d_delu = d_Utr - d_u0; d_L.solveInPlace(d_delu, CHOLMOD_P); d_L.solveInPlace(d_delu, CHOLMOD_L); // d_delu now contains cu d_CcNumer = d_delu.squaredNorm(); // numerator of convergence criterion d_L.solveInPlace(d_delu, CHOLMOD_Lt); d_L.solveInPlace(d_delu, CHOLMOD_Pt); return d_CcNumer; } void merPredD::updateXwts(const ArrayXd& sqrtXwt) { if (d_Xwts.size() != sqrtXwt.size()) throw invalid_argument("updateXwts: dimension mismatch"); std::copy(sqrtXwt.data(), sqrtXwt.data() + sqrtXwt.size(), d_Xwts.data()); if (sqrtXwt.size() == d_V.rows()) { // W is diagonal d_V = d_Xwts.asDiagonal() * d_X; for (int j = 0; j < d_N; ++j) for (MSpMatrixd::InnerIterator Utj(d_Ut, j), Ztj(d_Zt, j); Utj && Ztj; ++Utj, ++Ztj) Utj.valueRef() = Ztj.value() * d_Xwts.data()[j]; } else { SpMatrixd W(d_V.rows(), sqrtXwt.size()); const double *pt = sqrtXwt.data(); W.reserve(sqrtXwt.size()); for (Index j = 0; j < W.cols(); ++j, ++pt) { W.startVec(j); W.insertBack(j % d_V.rows(), j) = *pt; } W.finalize(); d_V = W * d_X; SpMatrixd Ut(d_Zt * W.adjoint()); if (Ut.cols() != d_Ut.cols()) throw std::runtime_error("Size mismatch in updateXwts"); // More complex code to handle the pruning of zeros MVec(d_Ut.valuePtr(), d_Ut.nonZeros()).setZero(); for (int j = 0; j < d_Ut.outerSize(); ++j) { MSpMatrixd::InnerIterator lhsIt(d_Ut, j); for (SpMatrixd::InnerIterator rhsIt(Ut, j); rhsIt; ++rhsIt, ++lhsIt) { Index k(rhsIt.index()); while (lhsIt && lhsIt.index() != k) ++lhsIt; if (lhsIt.index() != k) throw std::runtime_error("Pattern mismatch in updateXwts"); lhsIt.valueRef() = rhsIt.value(); } } } d_VtV.setZero().selfadjointView().rankUpdate(d_V.adjoint()); updateL(); } void merPredD::updateDecomp() { updateDecomp(NULL); } // using a point so as to detect NULL void merPredD::updateDecomp(const MatrixXd* xPenalty) { // update L, RZX and RX int debug=0; if (debug) Rcpp::Rcout << "start updateDecomp" << std::endl; updateL(); if (debug) { Rcpp::Rcout << "updateDecomp 2: dimensions (RZX, LamtUt,V)" << d_RZX.cols() << " " << d_RZX.rows() << " " << d_LamtUt.cols() << " " << d_LamtUt.rows() << " " << d_V.cols() << " " << d_V.rows() << " " << std::endl; } if (d_LamtUt.cols() != d_V.rows()) { ::Rf_warning("dimension mismatch in updateDecomp()"); // Rcpp::Rcout << "WARNING: dimension mismatch in updateDecomp(): " << // " LamtUt=" << d_LamtUt.rows() << "x" << d_LamtUt.cols() << // "; V=" << d_V.rows() << "x" << d_V.cols() << " " << // std::endl; } d_RZX = d_LamtUt * d_V; if (debug) Rcpp::Rcout << "updateDecomp 3" << std::endl; if (d_p > 0) { d_L.solveInPlace(d_RZX, CHOLMOD_P); d_L.solveInPlace(d_RZX, CHOLMOD_L); if (debug) Rcpp::Rcout << "updateDecomp 4" << std::endl; MatrixXd VtVdown(d_VtV); if (xPenalty == NULL) d_RX.compute(VtVdown.selfadjointView().rankUpdate(d_RZX.adjoint(), -1)); else { d_RX.compute(VtVdown.selfadjointView().rankUpdate(d_RZX.adjoint(), -1).rankUpdate(*xPenalty, 1)); } if (debug) Rcpp::Rcout << "updateDecomp 5" << std::endl; if (d_RX.info() != Eigen::Success) ::Rf_error("Downdated VtV is not positive definite"); d_ldRX2 = 2. * d_RX.matrixLLT().diagonal().array().abs().log().sum(); if (debug) Rcpp::Rcout << "updateDecomp 6" << std::endl; } } void merPredD::updateRes(const VectorXd& wtres) { if (d_V.rows() != wtres.size()) throw invalid_argument("updateRes: dimension mismatch"); d_Vtr = d_V.adjoint() * wtres; d_Utr = d_LamtUt * wtres; } void merPredD::installPars(const Scalar& f) { d_u0 = u(f); d_beta0 = beta(f); d_delb.setZero(); d_delu.setZero(); } void merPredD::setBeta0(const VectorXd& nBeta) { if (nBeta.size() != d_p) throw invalid_argument("setBeta0: dimension mismatch"); std::copy(nBeta.data(), nBeta.data() + d_p, d_beta0.data()); } void merPredD::setDelb(const VectorXd& newDelb) { if (newDelb.size() != d_p) throw invalid_argument("setDelb: dimension mismatch"); std::copy(newDelb.data(), newDelb.data() + d_p, d_delb.data()); } void merPredD::setDelu(const VectorXd& newDelu) { if (newDelu.size() != d_q) throw invalid_argument("setDelu: dimension mismatch"); std::copy(newDelu.data(), newDelu.data() + d_q, d_delu.data()); } void merPredD::setU0(const VectorXd& newU0) { if (newU0.size() != d_q) throw invalid_argument("setU0: dimension mismatch"); std::copy(newU0.data(), newU0.data() + d_q, d_u0.data()); } template struct Norm_Rand : std::unary_function { const T operator()(const T& x) const {return ::norm_rand();} }; inline static VectorXd Random_Normal(int size, double sigma) { return ArrayXd(size).unaryExpr(Norm_Rand()) * sigma; } void merPredD::MCMC_beta_u(const Scalar& sigma) { VectorXd del2(d_RX.matrixU().solve(Random_Normal(d_p, sigma))); d_delb += del2; VectorXd del1(Random_Normal(d_q, sigma) - d_RZX * del2); d_L.solveInPlace(del1, CHOLMOD_Lt); d_delu += del1; } VectorXi merPredD::Pvec() const { int* ppt((int*)d_L.factor()->Perm); VectorXi ans(d_q); std::copy(ppt, ppt + d_q, ans.data()); return ans; } MatrixXd merPredD::RX() const { return d_RX.matrixU(); } MatrixXd merPredD::RXi() const { // inverse RX return d_RX.matrixU().solve(MatrixXd::Identity(d_p,d_p)); } MatrixXd merPredD::unsc() const { // unscaled var-cov mat of FE // R translation: tcrossprod(RXi) return MatrixXd(MatrixXd(d_p, d_p).setZero(). selfadjointView(). rankUpdate(RXi())); } VectorXd merPredD::RXdiag() const { return d_RX.matrixLLT().diagonal(); } } lme4/src/mcmcsamp.h0000644000176200001440000000226513751775607013702 0ustar liggesusers// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*- // // mcmcsamp.h: Markov-chain Monte Carlo sample class using Eigen // // Copyright (C) 2012 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #ifndef LME4_MCMCSAMP_H #define LME4_MCMCSAMP_H #include "predModule.h" #include "respModule.h" namespace lme4 { class mcmcsamp { public: typedef Eigen::ArrayXd Ar1; typedef Eigen::Map MAr1; typedef Eigen::VectorXd Vec; typedef Eigen::Map MVec; typedef Eigen::ArrayXXd Ar2; typedef Eigen::Map MAr2; typedef Eigen::MatrixXd Mat; typedef Eigen::Map MMat; protected: // lme4::merPredD *d_pred; // lme4::lmResp *d_resp; MVec d_dev; MMat d_fixef; MVec d_sigma; MMat d_ranef; public: // all the work is done in the constructor mcmcsamp(lme4::merPredD *pred, lme4::lmResp *resp, SEXP dev, SEXP fixef, SEXP sigma, SEXP ranef); }; } #endif /* LME4_GLMFAMILY_H */ lme4/src/glmFamily.cpp0000644000176200001440000005076614063503234014345 0ustar liggesusers// // glmFamily.cpp: implementation of glmFamily and related classes using Eigen // // Copyright (C) 2011-2012 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #include "glmFamily.h" #include #include #include #include #include using namespace Rcpp; namespace glm { /** Cumulative probability function of the complement of the Gumbel distribution * * (i.e. pgumbel(q,0.,1.,0) == 1 - pgumbel2(-q,0.,1.,0)) * * @param q the quantile at which to evaluate the cumulative probability * @param loc location parameter * @param scale scale parameter * @param lower_tail when zero evaluate the complement of the cdf * * @return Cumulative probability value or its complement, according to the value of lower_tail */ static inline double pgumbel2(const double& q, const double& loc, const double& scale, int lower_tail) { double qq = (q - loc) / scale; qq = -std::exp(qq); return lower_tail ? -expm1(qq) : std::exp(qq); } /** * density of the complement of the Gumbel distribution * * @param x numeric argument * @param loc location parameter * @param scale scale parameter * @param give_log should the logarithm of the density be returned * * @return density or its logarithm, according to the value of give_log */ static inline double dgumbel2(const double& x, const double& loc, const double& scale, int give_log) { double xx = (x - loc) / scale; xx = xx - std::exp(xx) - std::log(scale); return give_log ? xx : std::exp(xx); } //@{ Templated scalar functors used in links, inverse links, etc. template struct logN0 : public std::unary_function { const T operator()(const T& x) const {return x ? std::log(x) : T();} }; template struct safemult : public std::binary_function { const T operator()(const T& x, const T& y) const {return x ? (x*y) : T();} }; static inline ArrayXd Y_log_Y(const ArrayXd& y, const ArrayXd& mu) { // return y * (y/mu).unaryExpr(logN0()); return y * (y/mu).unaryExpr(logN0()); } static inline double Y_log_Y(const double y, const double mu) { double v=(y/mu); // BMB: could do this better if I understood templates return y * ( v ? std::log(v) : v ); } template struct Round : public std::unary_function { const T operator()(const T& x) const {return nearbyint(x);} }; template struct x1mx : public std::unary_function { const T operator() (const T& x) const { return T(std::max(std::numeric_limits::epsilon(), x * (1 - x))); } }; template struct Lgamma : public std::unary_function { const T operator() (const T& x) const { return lgamma(x); } }; template struct cauchitinv : public std::unary_function { const T operator() (const T& x) const { return T(std::min(1.-std::numeric_limits::epsilon(), ::Rf_pcauchy(double(x), 0., 1., 1, 0))); } }; template struct cauchit : public std::unary_function { const T operator() (const T& x) const { return T(::Rf_qcauchy(double(x), 0., 1., 1, 0)); } }; template struct cauchitmueta : public std::unary_function { const T operator() (const T& x) const { return T(::Rf_dcauchy(double(x), 0., 1., 0)); } }; // TODO: (re)consider clamping this (and the other inverse-link functions) // * warn on active clamp? // * clamp from both sides? // * intercept problems elsewhere? // * allow toggling of clamp activity by user? // (applies to logitmueta too) template struct logitinv : public std::unary_function { const T operator() (const T& x) const { return T(std::max(std::numeric_limits::epsilon(), std::min(1.-std::numeric_limits::epsilon(), Rf_plogis(double(x), 0., 1., 1, 0)))); } }; template struct logit : public std::unary_function { const T operator() (const T& x) const { return T(::Rf_qlogis(double(x), 0., 1., 1, 0)); } }; template struct logitmueta : public std::unary_function { const T operator() (const T& x) const { return T(std::max(std::numeric_limits::epsilon(), Rf_dlogis(double(x), 0., 1., 0))); } }; template struct probitinv : public std::unary_function { const T operator() (const T& x) const { return T(std::min(1.-std::numeric_limits::epsilon(), ::Rf_pnorm5(double(x), 0., 1., 1, 0))); } }; template struct probit : public std::unary_function { const T operator() (const T& x) const { return T(::Rf_qnorm5(double(x), 0., 1., 1, 0)); } }; template struct probitmueta : public std::unary_function { const T operator() (const T& x) const { return T(::Rf_dnorm4(double(x), 0., 1., 0)); } }; template struct clogloginv : public std::unary_function { const T operator() (const T& x) const { return T(std::max(std::numeric_limits::epsilon(), std::min(1.-std::numeric_limits::epsilon(), pgumbel2(double(x), 0., 1., 1)))); } }; template struct cloglogmueta : public std::unary_function { const T operator() (const T& x) const { return T(std::max(std::numeric_limits::epsilon(), dgumbel2(double(x), 0., 1., 0))); } }; //@} template struct boundexp : public std::unary_function { const T operator() (const T& x) const { return T(std::max(std::numeric_limits::epsilon(), exp(double(x)))); } }; template struct inverse : public std::unary_function { const T operator() (const T& x) const { return T(std::max(std::numeric_limits::epsilon(), pow(double(x), -1))); } }; //@{ double binomialDist::aic (const ArrayXd& y, const ArrayXd& n, const ArrayXd& mu, const ArrayXd& wt, double dev) const { ArrayXd m((n > 1).any() ? n : wt); ArrayXd yy((m * y).unaryExpr(Round())); m = m.unaryExpr(Round()); double ans(0.); for (int i=0; i < mu.size(); ++i) ans += (m[i] <= 0. ? 0. : wt[i]/m[i]) * ::Rf_dbinom(yy[i], m[i], mu[i], true); return (-2. * ans); } const ArrayXd binomialDist::devResid(const ArrayXd& y, const ArrayXd& mu, const ArrayXd& wt) const { int debug=0; if (debug) { for (int i=0; i < mu.size(); ++i) { double r = 2. * wt[i] * (Y_log_Y(y[i], mu[i]) + Y_log_Y(1. - y[i], 1. - mu[i])); if (r!=r) { // attempt to detect `nan` (needs cross-platform testing, but should compile // everywhere whether or not it actually works) Rcpp::Rcout << "(bD) " << "nan @ pos " << i << ": y= " << y[i] << "; mu=" << mu[i] << "; wt=" << wt[i] << "; 1-y=" << 1. - y[i] << "; 1-mu=" << 1. - mu[i] << "; ylogy=" << Y_log_Y(y[i], mu[i]) << "; cylogy=" << Y_log_Y(1.-y[i], 1.-mu[i]) << std::endl; } } } return 2. * wt * (Y_log_Y(y, mu) + Y_log_Y(1. - y, 1. - mu)); } const ArrayXd binomialDist::variance(const ArrayXd& mu) const {return mu.unaryExpr(x1mx());} //@} //@{ double gammaDist::aic (const ArrayXd& y, const ArrayXd& n, const ArrayXd& mu, const ArrayXd& wt, double dev) const { double nn(wt.sum()); double disp(dev/nn); double ans(0), invdisp(1./disp); for (int i = 0; i < mu.size(); ++i) ans += wt[i] * ::Rf_dgamma(y[i], invdisp, mu[i] * disp, true); return -2. * ans + 2.; } const ArrayXd gammaDist::devResid(const ArrayXd& y, const ArrayXd& mu, const ArrayXd& wt) const { int debug=0; if (debug) { for (int i=0; i < mu.size(); ++i) { double r; r = -2. * wt[i] * (log(y[i]/mu[i])- (y[i] - mu[i])/mu[i]); if (r!=r) { // detect 'nan' ArrayXd eta0 = mu.inverse(); Rcpp::Rcout << "(bG) " << "nan @ pos " << i << ": y= " << y[i] << "; mu=" << mu[i] << "; mu inv=" << eta0[i] << "; wt=" << wt[i] << "; y/mu=" << y[i]/mu[i] << "; log(y/mu) =" << log(y[i]/mu[i]) << std::endl; } } } // throw std::runtime_error("illegal values detected in Gamma response") return -2. * wt * ((y/mu).unaryExpr(logN0()) - (y - mu)/mu); } const ArrayXd gammaDist::variance(const ArrayXd& mu) const {return mu.square();} //@} //@{ double GaussianDist::aic (const ArrayXd& y, const ArrayXd& n, const ArrayXd& mu, const ArrayXd& wt, double dev) const { double nn(mu.size()); return nn * (std::log(2. * M_PI * dev/nn) + 1.) + 2. - wt.log().sum(); } const ArrayXd GaussianDist::devResid(const ArrayXd& y, const ArrayXd& mu, const ArrayXd& wt) const { int debug=0; if (debug) { Rcpp::Rcout << "gaussian devResid: " << " y.max=" << y.maxCoeff() << ", y.min=" << y.minCoeff() << " mu.max=" << mu.maxCoeff() << ", mu.min=" << mu.minCoeff() << " diff.max=" << (y-mu).maxCoeff() << ", diff.min=" << (y-mu).minCoeff() << std::endl; } return wt * (y - mu).square(); } const ArrayXd GaussianDist::variance(const ArrayXd& mu) const {return ArrayXd::Ones(mu.size());} //@} //@{ double inverseGaussianDist::aic (const ArrayXd& y, const ArrayXd& n, const ArrayXd& mu, const ArrayXd& wt, double dev) const { double wtsum(wt.sum()); return wtsum * (std::log(dev/wtsum * 2. * M_PI) + 1.) + 3. * (y.log() * wt).sum() + 2.; } const ArrayXd inverseGaussianDist::devResid(const ArrayXd& y, const ArrayXd& mu, const ArrayXd& wt) const { return wt * ((y - mu).square())/(y * mu.square()); } const ArrayXd inverseGaussianDist::variance(const ArrayXd& mu) const {return mu.cube();} //@} //@{ double negativeBinomialDist::aic (const ArrayXd& y, const ArrayXd& n, const ArrayXd& mu, const ArrayXd& wt, double dev) const { return 2. * (wt * (y + d_theta) * (mu + d_theta).log() - y * mu.log() + (y + 1).unaryExpr(Lgamma()) - d_theta * std::log(d_theta) + lgamma(d_theta) - (d_theta + y).unaryExpr(Lgamma())).sum(); } const ArrayXd negativeBinomialDist::devResid(const ArrayXd &y, const ArrayXd &mu, const ArrayXd &wt) const { return 2. * wt * (Y_log_Y(y, mu) - (y + d_theta) * ((y + d_theta)/(mu + d_theta)).log()); } const ArrayXd negativeBinomialDist::variance(const ArrayXd &mu) const { return mu + mu.square()/d_theta; } //@} //@{ double PoissonDist::aic (const ArrayXd& y, const ArrayXd& n, const ArrayXd& mu, const ArrayXd& wt, double dev) const { double ans(0.); for (int i = 0; i < mu.size(); ++i) ans += ::Rf_dpois(y[i], mu[i], true) * wt[i]; return (-2. * ans); } const ArrayXd PoissonDist::devResid(const ArrayXd& y, const ArrayXd& mu, const ArrayXd& wt) const { return 2. * wt * (y * (y/mu).unaryExpr(logN0()) - (y - mu)); } const ArrayXd PoissonDist::variance(const ArrayXd& mu) const {return mu;} //@} //@{ const ArrayXd cauchitLink::linkFun(const ArrayXd& mu) const {return mu.unaryExpr(cauchit());} const ArrayXd cauchitLink::linkInv(const ArrayXd& eta) const {return eta.unaryExpr(cauchitinv());} const ArrayXd cauchitLink::muEta( const ArrayXd& eta) const {return eta.unaryExpr(cauchitmueta());} //@} //@{ const ArrayXd logLink::linkFun(const ArrayXd& mu) const {return mu.log();} const ArrayXd logLink::linkInv(const ArrayXd& eta) const {return eta.unaryExpr(boundexp());} const ArrayXd logLink::muEta( const ArrayXd& eta) const {return eta.unaryExpr(boundexp());} //@} //@{ const ArrayXd logitLink::linkFun(const ArrayXd& mu) const {return mu.unaryExpr(logit());} const ArrayXd logitLink::linkInv(const ArrayXd& eta) const {return eta.unaryExpr(logitinv());} const ArrayXd logitLink::muEta( const ArrayXd& eta) const {return eta.unaryExpr(logitmueta());} //@} //@{ const ArrayXd probitLink::linkFun(const ArrayXd& mu) const {return mu.unaryExpr(probit());} const ArrayXd probitLink::linkInv(const ArrayXd& eta) const {return eta.unaryExpr(probitinv());} const ArrayXd probitLink::muEta( const ArrayXd& eta) const {return eta.unaryExpr(probitmueta());} //@} //@{ const ArrayXd identityLink::linkFun(const ArrayXd& mu) const {return mu;} const ArrayXd identityLink::linkInv(const ArrayXd& eta) const {return eta;} const ArrayXd identityLink::muEta( const ArrayXd& eta) const {return ArrayXd::Ones(eta.size());} //@} //@{ const ArrayXd inverseLink::linkFun(const ArrayXd& mu) const {return mu.inverse();} //const ArrayXd inverseLink::linkInv(const ArrayXd& eta) const {return eta.unaryExpr(inverse());} const ArrayXd inverseLink::linkInv(const ArrayXd& eta) const {return eta.inverse();} // const ArrayXd inverseLink::muEta( const ArrayXd& eta) const {return -(eta.unaryExpr(inverse()).square());} const ArrayXd inverseLink::muEta( const ArrayXd& eta) const {return -(eta.inverse().square());} //@} //@{ // const ArrayXd cloglogLink::linkFun(const ArrayXd& mu) const {return mu.unaryExpr(cloglog());} const ArrayXd cloglogLink::linkInv(const ArrayXd& eta) const {return eta.unaryExpr(clogloginv());} const ArrayXd cloglogLink::muEta( const ArrayXd& eta) const {return eta.unaryExpr(cloglogmueta());} //@} glmDist::glmDist(Rcpp::List& ll) : d_devRes (as(ll["dev.resids"])), d_variance(as(ll["variance"])), d_aic( as(ll["aic"])), d_rho( d_aic.environment()) { } glmLink::glmLink(Rcpp::List& ll) : d_linkFun(as(ll["linkfun"])), d_linkInv(as(ll["linkinv"])), d_muEta( as(ll["mu.eta"])), d_rho( d_linkFun.environment()) { } glmFamily::glmFamily(Rcpp::List ll) : d_family( as(as(ll["family"]))), d_linknam(as(as(ll["link"]))), d_dist( new glmDist(ll)), d_link( new glmLink(ll)) { if (!ll.inherits("family")) throw std::runtime_error("glmFamily requires a list of (S3) class \"family\""); if (d_linknam == "cauchit") {delete d_link; d_link = new cauchitLink(ll);} if (d_linknam == "cloglog") {delete d_link; d_link = new cloglogLink(ll);} if (d_linknam == "identity") {delete d_link; d_link = new identityLink(ll);} if (d_linknam == "inverse") {delete d_link; d_link = new inverseLink(ll);} if (d_linknam == "log") {delete d_link; d_link = new logLink(ll);} if (d_linknam == "logit") {delete d_link; d_link = new logitLink(ll);} if (d_linknam == "probit") {delete d_link; d_link = new probitLink(ll);} if (d_family == "binomial") {delete d_dist; d_dist = new binomialDist(ll);} if (d_family == "Gamma") {delete d_dist; d_dist = new gammaDist(ll);} if (d_family == "gaussian") {delete d_dist; d_dist = new GaussianDist(ll);} if (d_family == "inverse.gaussian") {delete d_dist; d_dist = new inverseGaussianDist(ll);} if (d_family.substr(0, 18) == "Negative Binomial(") {delete d_dist; d_dist = new negativeBinomialDist(ll);} if (d_family == "poisson") {delete d_dist; d_dist = new PoissonDist(ll);} } glmFamily::~glmFamily() { delete d_dist; delete d_link; } const ArrayXd glmFamily::devResid(const ArrayXd& y, const ArrayXd& mu, const ArrayXd& wt) const { return d_dist->devResid(y, mu, wt); } double glmFamily::aic(const ArrayXd& y, const ArrayXd& n, const ArrayXd& mu, const ArrayXd& wt, double dev) const { return d_dist->aic(y, n, mu, wt, dev); } const ArrayXd glmLink::linkFun(const ArrayXd& mu) const { ArrayXd res; SEXP tmp = PROTECT(::Rf_lang2(as(d_linkFun), as(Rcpp::NumericVector(mu.data(), mu.data() + mu.size())))); res = as(::Rf_eval(tmp, d_rho)); UNPROTECT(1); return res; } const ArrayXd glmLink::linkInv(const ArrayXd& eta) const { ArrayXd res; SEXP tmp = PROTECT(::Rf_lang2(as(d_linkInv), as(Rcpp::NumericVector(eta.data(), eta.data() + eta.size())))); res = as(::Rf_eval(tmp, d_rho)); UNPROTECT(1); return res; } const ArrayXd glmLink::muEta(const ArrayXd &eta) const { ArrayXd res; SEXP tmp = PROTECT(::Rf_lang2(as(d_muEta), as(Rcpp::NumericVector(eta.data(), eta.data() + eta.size())))); res = as(::Rf_eval(tmp, d_rho)); UNPROTECT(1); return(res); } const ArrayXd glmDist::variance(const ArrayXd &mu) const { ArrayXd res; SEXP tmp = PROTECT(::Rf_lang2(as(d_variance), as(Rcpp::NumericVector(mu.data(), mu.data() + mu.size())))); res = as(::Rf_eval(tmp, d_rho)); UNPROTECT(1); return(res); } const ArrayXd glmDist::devResid(const ArrayXd &y, const ArrayXd &mu, const ArrayXd &wt) const { int n = mu.size(); ArrayXd res; SEXP tmp = PROTECT(::Rf_lang4(as(d_devRes), as(NumericVector(y.data(), y.data() + n)), as(NumericVector(mu.data(), mu.data() + n)), as(NumericVector(wt.data(), wt.data() + n)))); res = as(::Rf_eval(tmp, d_rho)); UNPROTECT(1); return(res); } double glmDist::aic(const ArrayXd& y, const ArrayXd& n, const ArrayXd& mu, const ArrayXd& wt, double dev) const { int nn = mu.size(); SEXP tmp1 = PROTECT(::Rf_ScalarReal(dev)); SEXP tmp2 = PROTECT(::Rf_lang6( as(d_aic), as(NumericVector(y.data(), y.data() + nn)), as(NumericVector(n.data(), n.data() + nn)), as(NumericVector(mu.data(), mu.data() + nn)), as(NumericVector(wt.data(), wt.data() + nn)), tmp1)); SEXP tmp3 = PROTECT(::Rf_eval(tmp2,d_rho)); double ans = ::Rf_asReal(tmp3); UNPROTECT(3); return ans; } negativeBinomialDist::negativeBinomialDist(Rcpp::List& ll) : glmDist(ll), d_theta(::Rf_asReal(as(d_rho[".Theta"]))) {} double glmDist::theta() const { throw std::invalid_argument("theta accessor applies only to negative binomial"); } void glmDist::setTheta(const double& theta) { throw std::invalid_argument("setTheta applies only to negative binomial"); } } lme4/src/respModule.h0000644000176200001440000001310313751775607014212 0ustar liggesusers// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*- // // respModule.h: response modules using Eigen // // Copyright (C) 2011-2012 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #ifndef LME4_RESPMODULE_H #define LME4_RESPMODULE_H #include "glmFamily.h" namespace lme4 { typedef Eigen::Map MVec; using Rcpp::CharacterVector; using Rcpp::Environment; using Rcpp::Language; using Rcpp::NumericVector; using glm::glmFamily; class lmResp { protected: double d_wrss, /**< current weighted sum of squared residuals */ d_ldW; /**< sum of log prior weights (i.e. log determinant of * the diagonal weights matrix) */ MVec d_y, /**< response vector */ d_weights, /**< prior weights - always present even if unity */ d_offset, /**< offset in the model */ d_mu, /**< mean response from current linear predictor */ d_sqrtXwt, /**< Square roots of the "X weights". For * lmResp and lmerResp these are the same as * the sqrtrwt. For glmResp and nlsResp they * incorporate the gradient of the eta to mu * mapping.*/ d_sqrtrwt, /**< Square roots of the residual weights */ d_wtres; /**< Current weighted residuals */ public: lmResp(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); const MVec& sqrtXwt() const {return d_sqrtXwt;} /**< return a const reference to d_sqrtXwt */ const MVec& mu() const {return d_mu;} /**< return a const reference to d_mu */ const MVec& offset() const {return d_offset;} /**< return a const reference to d_offset */ const MVec& sqrtrwt() const {return d_sqrtrwt;} /**< return a const reference to d_sqrtrwt */ const MVec& weights() const {return d_weights;} /**< return a const reference to d_weights */ const MVec& wtres() const {return d_wtres;} /**< return a const reference to d_wtres */ const MVec& y() const {return d_y;} /**< return a const reference to d_y */ double wrss() const {return d_wrss;} /**< return the weighted sum of squared residuals */ double updateMu(const Eigen::VectorXd&); double updateWts() {return updateWrss();} /**< update the weights. For a * glmResp this done separately from * updating the mean, because of the * iterative reweighting. */ double updateWrss(); /**< update the weighted residuals and d_wrss */ void setOffset(const Eigen::VectorXd&); /**< set a new value of the offset */ void setResp(const Eigen::VectorXd&); /**< set a new value of the response, y */ void setWeights(const Eigen::VectorXd&); /**< set a new value of the prior weights */ }; class lmerResp : public lmResp { private: int d_reml; /**< 0 for evaluating the deviance, p * for evaluating the REML criterion. */ public: lmerResp(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); double Laplace(double,double,double) const; double Laplace(double,double,double,double) const; int REML() const {return d_reml;} void setReml(int); }; class glmResp : public lmResp { protected: glmFamily d_fam; MVec d_eta, d_n; public: glmResp(Rcpp::List,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); Eigen::ArrayXd devResid() const; Eigen::ArrayXd muEta() const; Eigen::ArrayXd sqrtWrkWt() const; Eigen::ArrayXd variance() const; Eigen::ArrayXd wrkResids() const; Eigen::ArrayXd wrkResp() const; Eigen::ArrayXd wtWrkResp() const; const MVec& eta() const {return d_eta;} const MVec& n() const {return d_n;} const std::string& family() const {return d_fam.fam();} const std::string& link() const {return d_fam.lnk();} double aic() const; double Laplace(double,double,double) const; double resDev() const; double theta() const {return d_fam.theta();} //< negative binomial distribution only double updateMu(const Eigen::VectorXd&); double updateWts(); void setN(const Eigen::VectorXd&); void setTheta(const double& ntheta) {d_fam.setTheta(ntheta);} // negative binomial distribution only }; class nlsResp : public lmResp { protected: MVec d_gamma; Environment d_nlenv; Language d_nlmod; CharacterVector d_pnames; public: nlsResp(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); double Laplace(double, double, double) const; double updateMu(const Eigen::VectorXd&); }; } #endif lme4/src/glmFamily.h0000644000176200001440000001650113751775607014021 0ustar liggesusers// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*- // // glmFamily.h: glm family class using Eigen // // Copyright (C) 2012 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #ifndef LME4_GLMFAMILY_H #define LME4_GLMFAMILY_H #include namespace glm { using Eigen::ArrayXd; class glmDist { protected: //@{ R functions from the family, as a fall-back Rcpp::Function d_devRes, d_variance, d_aic; //@} Rcpp::Environment d_rho; public: glmDist(Rcpp::List&); virtual ~glmDist() {} virtual const ArrayXd variance(const ArrayXd&) const; virtual const ArrayXd devResid(const ArrayXd&, const ArrayXd&, const ArrayXd&) const; virtual double aic(const ArrayXd&, const ArrayXd&, const ArrayXd&, const ArrayXd&, double) const; /**< in keeping with the botched up nomenclature in the R glm function, * the value of aic is the deviance */ virtual double theta() const; virtual void setTheta(const double&); }; class binomialDist : public glmDist { public: binomialDist(Rcpp::List& ll) : glmDist(ll) {} const ArrayXd variance(const ArrayXd&) const; const ArrayXd devResid(const ArrayXd&, const ArrayXd&, const ArrayXd&) const; double aic(const ArrayXd&, const ArrayXd&, const ArrayXd&, const ArrayXd&, double) const; }; class gammaDist : public glmDist { public: gammaDist(Rcpp::List& ll) : glmDist(ll) {} const ArrayXd variance(const ArrayXd&) const; const ArrayXd devResid(const ArrayXd&, const ArrayXd&, const ArrayXd&) const; double aic(const ArrayXd&, const ArrayXd&, const ArrayXd&, const ArrayXd&, double) const; }; class GaussianDist : public glmDist { public: GaussianDist(Rcpp::List& ll) : glmDist(ll) {} const ArrayXd variance(const ArrayXd&) const; const ArrayXd devResid(const ArrayXd&, const ArrayXd&, const ArrayXd&) const; double aic(const ArrayXd&, const ArrayXd&, const ArrayXd&, const ArrayXd&, double) const; }; class inverseGaussianDist : public glmDist { public: inverseGaussianDist(Rcpp::List& ll) : glmDist(ll) {} const ArrayXd variance(const ArrayXd&) const; const ArrayXd devResid(const ArrayXd&, const ArrayXd&, const ArrayXd&) const; double aic(const ArrayXd&, const ArrayXd&, const ArrayXd&, const ArrayXd&, double) const; }; class negativeBinomialDist : public glmDist { protected: double d_theta; public: negativeBinomialDist (Rcpp::List& ll); const ArrayXd variance(const ArrayXd&) const; const ArrayXd devResid(const ArrayXd&, const ArrayXd&, const ArrayXd&) const; double aic(const ArrayXd&, const ArrayXd&, const ArrayXd&, const ArrayXd&, double) const; double theta() const {return d_theta;} void setTheta(const double& ntheta) {d_theta = ntheta;} }; class PoissonDist : public glmDist { public: PoissonDist(Rcpp::List& ll) : glmDist(ll) {} const ArrayXd variance(const ArrayXd&) const; const ArrayXd devResid(const ArrayXd&, const ArrayXd&, const ArrayXd&) const; double aic(const ArrayXd&, const ArrayXd&, const ArrayXd&, const ArrayXd&, double) const; }; class glmLink { protected: //@{ R functions from the family, as a fall-back Rcpp::Function d_linkFun, d_linkInv, d_muEta; //@} Rcpp::Environment d_rho; public: glmLink(Rcpp::List&); virtual ~glmLink() {} virtual const ArrayXd linkFun(const ArrayXd&) const; virtual const ArrayXd linkInv(const ArrayXd&) const; virtual const ArrayXd muEta(const ArrayXd&) const; }; class cauchitLink : public glmLink { public: cauchitLink(Rcpp::List& ll) : glmLink(ll) {} const ArrayXd linkFun(const ArrayXd&) const; const ArrayXd linkInv(const ArrayXd&) const; const ArrayXd muEta(const ArrayXd&) const; }; class cloglogLink : public glmLink { public: cloglogLink(Rcpp::List& ll) : glmLink(ll) {} // const ArrayXd linkFun(const ArrayXd&) const; const ArrayXd linkInv(const ArrayXd&) const; const ArrayXd muEta(const ArrayXd&) const; }; class identityLink : public glmLink { public: identityLink(Rcpp::List& ll) : glmLink(ll) {} const ArrayXd linkFun(const ArrayXd&) const; const ArrayXd linkInv(const ArrayXd&) const; const ArrayXd muEta(const ArrayXd&) const; }; class inverseLink : public glmLink { public: inverseLink(Rcpp::List& ll) : glmLink(ll) {} const ArrayXd linkFun(const ArrayXd&) const; const ArrayXd linkInv(const ArrayXd&) const; const ArrayXd muEta(const ArrayXd&) const; }; class logLink : public glmLink { public: logLink(Rcpp::List& ll) : glmLink(ll) {} const ArrayXd linkFun(const ArrayXd&) const; const ArrayXd linkInv(const ArrayXd&) const; const ArrayXd muEta(const ArrayXd&) const; }; class logitLink : public glmLink { public: logitLink(Rcpp::List& ll) : glmLink(ll) {} const ArrayXd linkFun(const ArrayXd&) const; const ArrayXd linkInv(const ArrayXd&) const; const ArrayXd muEta(const ArrayXd&) const; }; class probitLink : public glmLink { public: probitLink(Rcpp::List& ll) : glmLink(ll) {} const ArrayXd linkFun(const ArrayXd&) const; const ArrayXd linkInv(const ArrayXd&) const; const ArrayXd muEta(const ArrayXd&) const; }; class glmFamily { protected: std::string d_family, d_linknam; /**< as in the R glmFamily object */ glmDist *d_dist; glmLink *d_link; public: glmFamily(Rcpp::List ll); ~glmFamily(); /**< explicit destructor to call delete on d_dist and d_link */ const std::string& fam() const {return d_family;} const std::string& lnk() const {return d_linknam;} //@{ Application of functions from the family using compiled code when available const ArrayXd devResid(const ArrayXd&, const ArrayXd&, const ArrayXd&) const; const ArrayXd linkFun(const ArrayXd& mu) const {return d_link->linkFun(mu);} const ArrayXd linkInv(const ArrayXd& eta) const {return d_link->linkInv(eta);} const ArrayXd muEta(const ArrayXd& eta) const {return d_link->muEta(eta);} const ArrayXd variance(const ArrayXd& mu) const {return d_dist->variance(mu);} double aic(const ArrayXd&, const ArrayXd&, const ArrayXd&, const ArrayXd&, double) const; double theta() const {return d_dist->theta();} void setTheta(const double& theta) {d_dist->setTheta(theta);} //@} }; } #endif /* LME4_GLMFAMILY_H */ lme4/src/Makevars0000644000176200001440000000073613751775607013426 0ustar liggesusers## -*- mode: makefile; -*- PKG_LIBS = `$(R_HOME)/bin/Rscript --vanilla -e "Rcpp:::LdFlags()"` PKG_CXXFLAGS = -DEIGEN_DONT_VECTORIZE ## For a release, uncomment the following line to suppress package ## check warnings about __assert_fail. During development we retain ## the debugging checks even though they cause R to terminate, which ## is bad form. Better to learn of bugs in an impolite way than not ## to learn of them. PKG_CXXFLAGS = -DNDEBUG -DEIGEN_DONT_VECTORIZE lme4/src/Makevars.win0000644000176200001440000000102413751775607014211 0ustar liggesusers## -*- mode: makefile; -*- ## This assumes that we can call Rscript to ask Rcpp about its locations ## Use the R_HOME indirection to support installations of multiple R version ## PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" --vanilla -e "Rcpp:::LdFlags()") PKG_CPPFLAGS = -I. -DNDEBUG -DEIGEN_DONT_VECTORIZE ## For development define the package CPPFLAGS as #PKG_CPPFLAGS= -I. -DEIGEN_DONT_VECTORIZE ## to activate assertions in Eigen. For the purposes of R CMD check the ## assertions should be suppressed. lme4/src/predModule.h0000644000176200001440000001006013751775607014172 0ustar liggesusers// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*- // // predModule.h: predictor module using Eigen // // Copyright (C) 2011 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #ifndef LME4_PREDMODULE_H #define LME4_PREDMODULE_H #include #include "lme4CholmodDecomposition.h" namespace lme4 { using Eigen::ArrayXd; using Eigen::LLT; using Eigen::MatrixXd; using Eigen::VectorXd; using Eigen::VectorXi; class merPredD { public: typedef Eigen::Map MMap; typedef Eigen::Map MVec; typedef Eigen::Map MiVec; typedef MatrixXd::Scalar Scalar; typedef MatrixXd::Index Index; typedef Eigen::SparseMatrix SpMatrixd; typedef lme4CholmodDecomposition ChmDecomp; typedef Eigen::MappedSparseMatrix MSpMatrixd; protected: MMap d_X, d_RZX, d_V, d_VtV; MSpMatrixd d_Zt, d_Ut, d_LamtUt, d_Lambdat; MVec d_theta, d_Vtr, d_Utr, d_Xwts, d_beta0, d_delb, d_delu, d_u0; MiVec d_Lind; Index d_N, d_p, d_q; Scalar d_CcNumer, d_ldL2, d_ldRX2; ChmDecomp d_L; LLT d_RX; public: merPredD(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); VectorXi Pvec() const; MatrixXd RX() const; MatrixXd RXi() const; MatrixXd unsc() const; VectorXd RXdiag() const; VectorXd b(const Scalar& f) const; VectorXd beta(const Scalar& f) const; VectorXd linPred(const Scalar& f) const; VectorXd u(const Scalar& f) const; Rcpp::List condVar(const Rcpp::Environment&) const; Scalar CcNumer() const {return d_CcNumer;} Scalar ldL2() const {return d_ldL2;} Scalar ldRX2() const {return d_ldRX2;} Scalar solve(); Scalar solveU(); Scalar sqrL(const Scalar& f) const; const ChmDecomp& L() const {return d_L;} const MMap& V() const {return d_V;} const MMap& VtV() const {return d_VtV;} const MMap& RZX() const {return d_RZX;} const MSpMatrixd& Lambdat() const {return d_Lambdat;} const MSpMatrixd& LamtUt() const {return d_LamtUt;} const MSpMatrixd& Ut() const {return d_Ut;} const MSpMatrixd& Zt() const {return d_Zt;} const MVec& Utr() const {return d_Utr;} const MVec& Vtr() const {return d_Vtr;} const MVec& delb() const {return d_delb;} const MVec& delu() const {return d_delu;} const MVec& beta0() const {return d_beta0;} const MVec& theta() const {return d_theta;} const MVec& u0() const {return d_u0;} const MVec& Xwts() const {return d_Xwts;} int info() const {return d_L.info();} void installPars(const Scalar& f); void MCMC_beta_u(const Scalar& sigma); void setBeta0(const VectorXd&); void setDelb(const VectorXd&); void setDelu(const VectorXd&); void setTheta(const VectorXd&); void setZt(const VectorXd&); void setU0(const VectorXd&); void updateDecomp(); void updateDecomp(const MatrixXd*); void updateL(); void updateLamtUt(); void updateRes(const VectorXd&); void updateXwts(const ArrayXd&); }; } #endif // LME4_PREDMODULE_H lme4/src/external.cpp0000644000176200001440000011222014063503234014226 0ustar liggesusers// external.cpp: externally .Call'able functions in lme4 // // Copyright (C) 2011-2018 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #include #include "predModule.h" #include "respModule.h" #include "optimizer.h" // #include "merPhylo.h" // not included yet in main branch! extern "C" { typedef Eigen::VectorXi iVec; typedef Eigen::Map MiVec; typedef Eigen::MatrixXd Mat; typedef Eigen::Map MMat; typedef Eigen::VectorXd Vec; typedef Eigen::Map MVec; typedef Eigen::ArrayXd Ar1; typedef Eigen::Map MAr1; typedef Eigen::ArrayXXd Ar2; typedef Eigen::Map MAr2; using Rcpp::CharacterVector; using Rcpp::Environment; using Rcpp::IntegerVector; using Rcpp::Language; using Rcpp::List; using Rcpp::Named; using Rcpp::NumericVector; using Rcpp::XPtr; using Rcpp::as; using Rcpp::wrap; using glm::glmFamily; using lme4::glmResp; using lme4::lmResp; using lme4::lmerResp; using lme4::merPredD; using lme4::nlsResp; using optimizer::Golden; using optimizer::Nelder_Mead; using optimizer::nm_status; using std::runtime_error; // utilities // FIXME: as pointed out here , this is potentially // dangerous when v_ is long ... SEXP allPerm_int(SEXP v_, SEXP sz_) { BEGIN_RCPP; iVec v(as(v_)); // forces a copy int sz(v.size()); std::vector vec; vec.reserve(static_cast(INTEGER(sz_)[0])); std::sort(v.data(), v.data() + sz); do { vec.push_back(iVec(v)); } while (std::next_permutation(v.data(), v.data() + sz)); int nperm(vec.size()); List allPerm(nperm); for (int j = 0; j < nperm; ++j) allPerm[j] = wrap(vec[j]); return allPerm; END_RCPP; } SEXP Eigen_SSE() { BEGIN_RCPP; return wrap(Eigen::SimdInstructionSetsInUse()); END_RCPP; } SEXP deepcopy(SEXP x) { return(Rf_duplicate(x)); } // generalized linear model (and generalized linear mixed model) response SEXP glm_Create(SEXP fam, SEXP y, SEXP weights, SEXP offset, SEXP mu, SEXP sqrtXwt, SEXP sqrtrwt, SEXP wtres, SEXP eta, SEXP n) { BEGIN_RCPP; glmResp *ans = new glmResp(List(fam), y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres, eta, n); return wrap(XPtr(ans, true)); END_RCPP; } SEXP glm_aic(SEXP ptr_) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)->aic()); END_RCPP; } SEXP glm_setN(SEXP ptr_, SEXP n) { BEGIN_RCPP; XPtr(ptr_)->setN(as(n)); END_RCPP; } SEXP glm_devResid(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->devResid()); END_RCPP; } SEXP glm_family(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->family()); END_RCPP; } SEXP glm_link(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->link()); END_RCPP; } SEXP glm_muEta(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->muEta()); END_RCPP; } SEXP glm_resDev(SEXP ptr_) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)->resDev()); END_RCPP; } SEXP glm_setTheta(SEXP ptr, SEXP newtheta) { BEGIN_RCPP; XPtr(ptr)->setTheta(::Rf_asReal(newtheta)); END_RCPP; } SEXP glm_sqrtWrkWt(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->sqrtWrkWt()); END_RCPP; } SEXP glm_theta(SEXP ptr) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->theta()); END_RCPP; } SEXP glm_updateWts(SEXP ptr_) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)->updateWts()); END_RCPP; } SEXP glm_variance(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->variance()); END_RCPP; } SEXP glm_wrkResids(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->wrkResids()); END_RCPP; } SEXP glm_wrkResp(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->wrkResp()); END_RCPP; } SEXP glm_wtWrkResp(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->wtWrkResp()); END_RCPP; } SEXP glm_Laplace(SEXP ptr_, SEXP ldL2, SEXP ldRX2, SEXP sqrL) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)->Laplace(::Rf_asReal(ldL2), ::Rf_asReal(ldRX2), ::Rf_asReal(sqrL))); END_RCPP; } SEXP glm_updateMu(SEXP ptr_, SEXP gamma) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)->updateMu(as(gamma))); END_RCPP; } // glm family objects SEXP glmFamily_Create(SEXP fam_) { BEGIN_RCPP; glmFamily *ans = new glmFamily(List(fam_)); return wrap(XPtr(ans, true)); END_RCPP; } SEXP glmFamily_link(SEXP ptr, SEXP mu) { BEGIN_RCPP; return wrap(XPtr(ptr)->linkFun(as(mu))); END_RCPP; } SEXP glmFamily_linkInv(SEXP ptr, SEXP eta) { BEGIN_RCPP; return wrap(XPtr(ptr)->linkInv(as(eta))); END_RCPP; } SEXP glmFamily_devResid(SEXP ptr, SEXP y, SEXP mu, SEXP wt) { BEGIN_RCPP; return wrap(XPtr(ptr)->devResid(as(y), as(mu), as(wt))); END_RCPP; } SEXP glmFamily_aic(SEXP ptr, SEXP y, SEXP n, SEXP mu, SEXP wt, SEXP dev) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->aic(as(y), as(n), as(mu), as(wt), ::Rf_asReal(dev))); END_RCPP; } SEXP glmFamily_muEta(SEXP ptr, SEXP eta) { BEGIN_RCPP; return wrap(XPtr(ptr)->muEta(as(eta))); END_RCPP; } SEXP glmFamily_setTheta(SEXP ptr, SEXP ntheta) { BEGIN_RCPP; XPtr(ptr)->setTheta(::Rf_asReal(ntheta)); END_RCPP; } SEXP glmFamily_theta(SEXP ptr) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->theta()); END_RCPP; } SEXP glmFamily_variance(SEXP ptr, SEXP mu) { BEGIN_RCPP; return wrap(XPtr(ptr)->variance(as(mu))); END_RCPP; } static inline double pwrss(lmResp *rp, merPredD *pp, double fac) { return rp->wrss() + (fac ? pp->sqrL(fac) : pp->u0().squaredNorm()); } static double internal_glmerWrkIter(merPredD *pp, glmResp *rp, bool uOnly) { int debug=0; // !=0 to enable if (debug) Rcpp::Rcout << "(igWI, pre-updateXwts) Xwts: min: " << pp->Xwts().minCoeff() << " sqrtWrkWt: min: " << rp->sqrtWrkWt().minCoeff() << std::endl; pp->updateXwts(rp->sqrtWrkWt()); if (debug) Rcpp::Rcout << "(igWI) Xwts: min: " << pp->Xwts().minCoeff() << " max: " << pp->Xwts().maxCoeff() << std::endl; pp->updateDecomp(); pp->updateRes(rp->wtWrkResp()); if (uOnly) pp->solveU(); else pp->solve(); if (debug) { Rcpp::Rcout << "(igWI)" << " delu_min: " << pp->delu().minCoeff() << "; delu_max: " << pp->delu().maxCoeff() << "; delb_min: " << pp->delb().minCoeff() << "; delb_max: " << pp->delb().maxCoeff() << std::endl; // if (verb) } rp->updateMu(pp->linPred(1.)); // FIXME: warn/error/clamp/penalize here if value is out of bounds if (debug) Rcpp::Rcout << "(igWI) mu: min: " << rp->mu().minCoeff() << " max: " << rp->mu().maxCoeff() << std::endl; return rp->resDev() + pp->sqrL(1.); } // FIXME: improve verbose output (remove code, even commented, // intended for finding pointer/referencing/updating bugs; // leave code that allows end-user to see what's going on // in PWRSS iterations) // // Separate verb settings for min/max delu, delb // (and which_min, which_max) vs entire // delu/delb vectors? note length(delu) will generally be // >> length(delb) ... // // FIXME: sufficient to print just before/after update? static void pwrssUpdate(glmResp *rp, merPredD *pp, bool uOnly, double tol, int maxit, int verbose) { double oldpdev=std::numeric_limits::max(); double pdev; int maxstephalfit = 20; bool cvgd = false, verb = verbose > 2, moreverb = verbose > 10; int debug=0; pdev = oldpdev; // define so debugging statements work on first step for (int i = 0; i < maxit; i++) { if (verb) { Rcpp::Rcout << "*** pwrssUpdate step " << i << std::endl; if (debug) { Rcpp::Rcout << "\nmin delu at iteration " << i << ": " << pp->delu().minCoeff() << std::endl; Rcpp::Rcout << "\nmax delu at iteration " << i << ": " << pp->delu().maxCoeff() << std::endl; Rcpp::Rcout << "\nresDev before dels, iter: " << i << ", " << rp->resDev() << std::endl; // FIXME: would like to print this in row, not column, format // Rcpp::Rcout << "before update:" << "pdev = " << pdev << std::endl; // if (verb) } } Vec olddelu(pp->delu()), olddelb(pp->delb()); pdev = internal_glmerWrkIter(pp, rp, uOnly); if (verb) { Rcpp::Rcout << "pdev=" << pdev << "; delu_min: " << pp->delu().minCoeff() << "; delu_max: " << pp->delu().maxCoeff() << "; delb_min: " << pp->delb().minCoeff() << "; delb_max: " << pp->delb().maxCoeff() << std::endl; // if (verb) } if (std::abs((oldpdev - pdev) / pdev) < tol) {cvgd = true; break;} if (ISNAN(pdev) || (pdev > oldpdev)) { // PWRSS step led to _larger_ deviation, or nan; try step halving if (verb) Rcpp::Rcout << "\npwrssUpdate: Entering step halving loop" << std::endl; for (int k = 0; k < maxstephalfit && (ISNAN(pdev) || (pdev > oldpdev)); k++) { pp->setDelu((olddelu + pp->delu())/2.); if (!uOnly) pp->setDelb((olddelb + pp->delb())/2.); rp->updateMu(pp->linPred(1.)); pdev = rp->resDev() + pp->sqrL(1.); if (moreverb) { Rcpp::Rcout << "step-halving iteration " << k << ": pdev=" << pdev << "; delu_min: " << pp->delu().minCoeff() << "; delu_max: " << pp->delu().maxCoeff() << "; delb_min: " << pp->delb().minCoeff() << "; delb_max: " << pp->delb().maxCoeff() << std::endl; } // if (moreverb) } if (ISNAN(pdev)) { throw runtime_error("PIRLS loop resulted in NaN value"); } if ((pdev - oldpdev) > tol) { // FIXME: fill in max halfstep iters in error statement throw runtime_error("(maxstephalfit) PIRLS step-halvings failed to reduce deviance in pwrssUpdate"); } } // step-halving oldpdev = pdev; } // pwrss loop if (!cvgd) // FIXME: fill in max iters in error statement throw runtime_error("pwrssUpdate did not converge in (maxit) iterations"); } SEXP glmerLaplace(SEXP pp_, SEXP rp_, SEXP nAGQ_, SEXP tol_, SEXP maxit_, SEXP verbose_) { BEGIN_RCPP; XPtr rp(rp_); XPtr pp(pp_); if ( ::Rf_asInteger(verbose_) >100) { Rcpp::Rcout << "\nglmerLaplace resDev: " << rp->resDev() << std::endl; Rcpp::Rcout << "\ndelb 1: " << pp->delb() << std::endl; } pwrssUpdate(rp, pp, ::Rf_asInteger(nAGQ_), ::Rf_asReal(tol_), ::Rf_asInteger(maxit_), ::Rf_asInteger(verbose_)); return ::Rf_ScalarReal(rp->Laplace(pp->ldL2(), pp->ldRX2(), pp->sqrL(1.))); END_RCPP; } // function used below in glmerAGQ // // fac: mapped integer vector indicating the factor levels // u: current conditional modes // devRes: current deviance residuals (i.e. similar to results of // family()$dev.resid, but computed in glmFamily.cpp) static Ar1 devcCol(const MiVec& fac, const Ar1& u, const Ar1& devRes) { Ar1 ans(u.square()); for (int i = 0; i < devRes.size(); ++i) ans[fac[i] - 1] += devRes[i]; // return: vector the size of u (i.e. length = number of // grouping factor levels), containing the squared conditional // modes plus the sum of the deviance residuals associated // with each level return ans; } static double sqrt2pi = std::sqrt(2. * M_PI); // tol: tolerance for pirls // maxit: maximum number of pirls iterations // GQmat: matrix of quadrature weights // fac: grouping factor (gets converted to mapped integer below) SEXP glmerAGQ(SEXP pp_, SEXP rp_, SEXP tol_, SEXP maxit_, SEXP GQmat_, SEXP fac_, SEXP verbose_) { BEGIN_RCPP; XPtr rp(rp_); XPtr pp(pp_); const MiVec fac(as(fac_)); // convert grouping // factor to mapped // integer double tol(::Rf_asReal(tol_)); int maxit(::Rf_asInteger(maxit_)); double verb(::Rf_asReal(verbose_)); if (fac.size() != rp->mu().size()) throw std::invalid_argument("size of fac must match dimension of response vector"); pwrssUpdate(rp, pp, true, tol, maxit, verb); // should be a // no-op // devc0: vector with one element per grouping // factor level containing the the squared // conditional modes plus the sum of the deviance // residuals associated with each level const Ar1 devc0(devcCol(fac, pp->u(1.), rp->devResid())); const unsigned int q(pp->u0().size()); if (pp->L().factor()->nzmax != q) throw std::invalid_argument("AGQ only defined for a single scalar random-effects term"); const Ar1 sd(MAr1((double*)pp->L().factor()->x, q).inverse()); const MMat GQmat(as(GQmat_)); Ar1 mult(q); mult.setZero(); for (int i = 0; i < GQmat.rows(); ++i) { double zknot(GQmat(i, 0)); if (zknot == 0) mult += Ar1::Constant(q, GQmat(i, 1)); else { pp->setU0(zknot * sd); // to be added to current delu rp->updateMu(pp->linPred(1.)); mult += (-0.5 * (devcCol(fac, pp->u(1.), rp->devResid()) - devc0) - GQmat(i, 2)).exp() * GQmat(i, 1)/sqrt2pi; } } pp->setU0(Vec::Zero(q)); // restore settings from pwrssUpdate; rp->updateMu(pp->linPred(1.)); return ::Rf_ScalarReal(devc0.sum() + pp->ldL2() - 2 * std::log(mult.prod())); END_RCPP; } // called only from prssUpdate() : static void nstepFac(nlsResp *rp, merPredD *pp, double prss0, int verb) { for (double fac = 1.; fac > 0.001; fac /= 2.) { double prss1 = rp->updateMu(pp->linPred(fac)) + pp->sqrL(fac); if (verb > 3) ::Rprintf(" nstepFac(), fac=%6.4f, prss0-prss1=%10g\n", fac, prss0 - prss1); if (prss1 < prss0) { pp->installPars(fac); return; } } throw runtime_error("step factor reduced below 0.001 without reducing pwrss"); } static void prssUpdate(nlsResp *rp, merPredD *pp, int verb, bool uOnly, double tol, int maxit) { bool cvgd(false); for (int it=0; it < maxit; ++it) { rp->updateMu(pp->linPred(0.)); pp->updateXwts(rp->sqrtXwt()); pp->updateDecomp(); pp->updateRes(rp->wtres()); double pwrs0(pwrss(rp, pp, 0.)), ccrit((uOnly ? pp->solveU() : pp->solve())/pwrs0); if (verb > 3) ::Rprintf(" it=%d, pwrs0=%10g, ccrit=%10g, tol=%10g\n", it, pwrs0, ccrit, tol); if (ccrit < tol) { cvgd = true; break; } nstepFac(rp, pp, pwrs0, verb); } if (!cvgd) throw runtime_error("prss{Update} failed to converge in 'maxit' iterations"); } SEXP nlmerLaplace(SEXP pp_, SEXP rp_, SEXP theta_, SEXP u0_, SEXP beta0_, SEXP verbose_, SEXP uOnly_, SEXP tol_, SEXP maxit_) { BEGIN_RCPP; XPtr rp(rp_); XPtr pp(pp_); pp->setTheta(as(theta_)); pp->setU0 (as(u0_)); pp->setBeta0(as(beta0_)); prssUpdate(rp, pp, ::Rf_asInteger(verbose_), ::Rf_asLogical(uOnly_), ::Rf_asReal(tol_), ::Rf_asInteger(maxit_)); return ::Rf_ScalarReal(rp->Laplace(pp->ldL2(), pp->ldRX2(), pp->sqrL(1.))); END_RCPP; } SEXP golden_Create(SEXP lower_, SEXP upper_) { BEGIN_RCPP; Golden *ans = new Golden(::Rf_asReal(lower_), ::Rf_asReal(upper_)); return wrap(XPtr(ans, true)); END_RCPP; } SEXP golden_newf(SEXP ptr_, SEXP f_) { BEGIN_RCPP; XPtr(ptr_)->newf(::Rf_asReal(f_)); END_RCPP; } SEXP golden_xeval(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->xeval()); END_RCPP; } SEXP golden_value(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->value()); END_RCPP; } SEXP golden_xpos(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->xpos()); END_RCPP; } SEXP isNullExtPtr(SEXP Ptr) { void *ptr = R_ExternalPtrAddr(Ptr); return ::Rf_ScalarLogical(ptr == (void*)NULL); } void setNullExtPtr(SEXP Ptr) { return R_ClearExternalPtr(Ptr); } // linear model response (also the base class for other response classes) SEXP lm_Create(SEXP y, SEXP weights, SEXP offset, SEXP mu, SEXP sqrtXwt, SEXP sqrtrwt, SEXP wtres) { BEGIN_RCPP; lmResp *ans = new lmResp(y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres); return wrap(XPtr(ans, true)); END_RCPP; } SEXP lm_setOffset(SEXP ptr_, SEXP offset) { BEGIN_RCPP; XPtr(ptr_)->setOffset(as(offset)); END_RCPP; } SEXP lm_setResp(SEXP ptr_, SEXP resp) { BEGIN_RCPP; XPtr(ptr_)->setResp(as(resp)); END_RCPP; } SEXP lm_setWeights(SEXP ptr_, SEXP weights) { BEGIN_RCPP; XPtr(ptr_)->setWeights(as(weights)); END_RCPP; } SEXP lm_wrss(SEXP ptr_) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)->wrss()); END_RCPP; } SEXP lm_updateMu(SEXP ptr_, SEXP gamma) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)->updateMu(as(gamma))); END_RCPP; } // linear mixed-effects model response SEXP lmer_Create(SEXP y, SEXP weights, SEXP offset, SEXP mu, SEXP sqrtXwt, SEXP sqrtrwt, SEXP wtres) { BEGIN_RCPP; lmerResp *ans = new lmerResp(y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres); return wrap(XPtr(ans, true)); END_RCPP; } SEXP lmer_setREML(SEXP ptr_, SEXP REML) { BEGIN_RCPP; int reml = ::Rf_asInteger(REML); XPtr(ptr_)->setReml(reml); return ::Rf_ScalarInteger(reml); END_RCPP; } SEXP lmer_Laplace(SEXP ptr_, SEXP ldL2, SEXP ldRX2, SEXP sqrL, SEXP sigma_sq) { BEGIN_RCPP; if (Rf_isNull(sigma_sq)) return ::Rf_ScalarReal(XPtr(ptr_)->Laplace(::Rf_asReal(ldL2), ::Rf_asReal(ldRX2), ::Rf_asReal(sqrL))); return ::Rf_ScalarReal(XPtr(ptr_)->Laplace(::Rf_asReal(ldL2), ::Rf_asReal(ldRX2), ::Rf_asReal(sqrL), ::Rf_asReal(sigma_sq))); END_RCPP; } static double lmer_dev(XPtr ppt, XPtr rpt, const Eigen::VectorXd& theta) { int debug=0; double val; ppt->setTheta(theta); ppt->updateXwts(rpt->sqrtXwt()); ppt->updateDecomp(); rpt->updateMu(ppt->linPred(0.)); ppt->updateRes(rpt->wtres()); ppt->solve(); rpt->updateMu(ppt->linPred(1.)); val=rpt->Laplace(ppt->ldL2(), ppt->ldRX2(), ppt->sqrL(1.)); if (debug) { Rcpp::Rcout.precision(10); Rcpp::Rcout << "lmer_dev: theta=" << ppt->theta() << ", val=" << val << std::endl; } return val; } SEXP lmer_Deviance(SEXP pptr_, SEXP rptr_, SEXP theta_) { BEGIN_RCPP; XPtr rpt(rptr_); XPtr ppt(pptr_); return ::Rf_ScalarReal(lmer_dev(ppt, rpt, as(theta_))); END_RCPP; } SEXP lmer_opt1(SEXP pptr_, SEXP rptr_, SEXP lower_, SEXP upper_) { BEGIN_RCPP; XPtr rpt(rptr_); XPtr ppt(pptr_); Eigen::VectorXd th(1); optimizer::Golden gold(::Rf_asReal(lower_), ::Rf_asReal(upper_)); for (int i = 0; i < 30; ++i) { th[0] = gold.xeval(); gold.newf(lmer_dev(ppt, rpt, th)); } return List::create(Named("theta") = ::Rf_ScalarReal(gold.xpos()), Named("objective") = ::Rf_ScalarReal(gold.value())); END_RCPP; } // dense predictor module for mixed-effects models SEXP merPredDCreate(SEXP Xs, SEXP Lambdat, SEXP LamtUt, SEXP Lind, SEXP RZX, SEXP Ut, SEXP Utr, SEXP V, SEXP VtV, SEXP Vtr, SEXP Xwts, SEXP Zt, SEXP beta0, SEXP delb, SEXP delu, SEXP theta, SEXP u0) { BEGIN_RCPP; merPredD *ans = new merPredD(Xs, Lambdat, LamtUt, Lind, RZX, Ut, Utr, V, VtV, Vtr, Xwts, Zt, beta0, delb, delu, theta, u0); return wrap(XPtr(ans, true)); END_RCPP; } // setters SEXP merPredDsetTheta(SEXP ptr, SEXP theta) { BEGIN_RCPP; XPtr(ptr)->setTheta(as(theta)); return theta; END_RCPP; } SEXP merPredDsetZt(SEXP ptr, SEXP ZtNonZero) { BEGIN_RCPP; XPtr(ptr)->setZt(as(ZtNonZero)); return ZtNonZero; END_RCPP; } SEXP merPredDsetBeta0(SEXP ptr, SEXP beta0) { BEGIN_RCPP; XPtr(ptr)->setBeta0(as(beta0)); END_RCPP; } SEXP merPredDsetDelu(SEXP ptr, SEXP delu) { BEGIN_RCPP; XPtr(ptr)->setDelu(as(delu)); END_RCPP; } SEXP merPredDsetDelb(SEXP ptr, SEXP delb) { BEGIN_RCPP; XPtr(ptr)->setDelb(as(delb)); END_RCPP; } // getters SEXP merPredDCcNumer(SEXP ptr) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->CcNumer()); END_RCPP; } SEXP merPredDL(SEXP ptr) { BEGIN_RCPP; return wrap(XPtr(ptr)->L()); END_RCPP; } SEXP merPredDPvec(SEXP ptr) { BEGIN_RCPP; return wrap(XPtr(ptr)->Pvec()); END_RCPP; } SEXP merPredDRX(SEXP ptr) { BEGIN_RCPP; return wrap(XPtr(ptr)->RX()); END_RCPP; } SEXP merPredDRXi(SEXP ptr) { BEGIN_RCPP; return wrap(XPtr(ptr)->RXi()); END_RCPP; } SEXP merPredDRXdiag(SEXP ptr) { BEGIN_RCPP; return wrap(XPtr(ptr)->RXdiag()); END_RCPP; } SEXP merPredDcondVar(SEXP ptr, SEXP rho) { BEGIN_RCPP; return wrap(XPtr(ptr)->condVar(Rcpp::Environment(rho))); END_RCPP; } SEXP merPredDldL2(SEXP ptr) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->ldL2()); END_RCPP; } SEXP merPredDldRX2(SEXP ptr) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->ldRX2()); END_RCPP; } SEXP merPredDunsc(SEXP ptr) { BEGIN_RCPP; return wrap(XPtr(ptr)->unsc()); END_RCPP; } // methods SEXP merPredDb(SEXP ptr, SEXP fac) { BEGIN_RCPP; return wrap(XPtr(ptr)->b(::Rf_asReal(fac))); END_RCPP; } SEXP merPredDbeta(SEXP ptr, SEXP fac) { BEGIN_RCPP; return wrap(XPtr(ptr)->beta(::Rf_asReal(fac))); END_RCPP; } SEXP merPredDinstallPars(SEXP ptr, SEXP fac) { BEGIN_RCPP; XPtr(ptr)->installPars(::Rf_asReal(fac)); END_RCPP; } SEXP merPredDlinPred(SEXP ptr, SEXP fac) { BEGIN_RCPP; return wrap(XPtr(ptr)->linPred(::Rf_asReal(fac))); END_RCPP; } SEXP merPredDsolve(SEXP ptr) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->solve()); END_RCPP; } SEXP merPredDsolveU(SEXP ptr) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->solveU()); END_RCPP; } SEXP merPredDsqrL(SEXP ptr, SEXP fac) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr)->sqrL(::Rf_asReal(fac))); END_RCPP; } SEXP merPredDu(SEXP ptr, SEXP fac) { BEGIN_RCPP; return wrap(XPtr(ptr)->u(::Rf_asReal(fac))); END_RCPP; } SEXP merPredDupdateDecomp(SEXP ptr, SEXP xPenalty_) { BEGIN_RCPP; if (Rf_isNull(xPenalty_)) XPtr(ptr)->updateDecomp(NULL); else { const Mat & xPenalty(as(xPenalty_)); XPtr(ptr)->updateDecomp(&xPenalty); } END_RCPP; } SEXP merPredDupdateL(SEXP ptr) { BEGIN_RCPP; XPtr(ptr)->updateL(); END_RCPP; } SEXP merPredDupdateLamtUt(SEXP ptr) { BEGIN_RCPP; XPtr(ptr)->updateLamtUt(); END_RCPP; } SEXP merPredDupdateRes(SEXP ptr, SEXP wtres) { BEGIN_RCPP; XPtr(ptr)->updateRes(as(wtres)); END_RCPP; } SEXP merPredDupdateXwts(SEXP ptr, SEXP wts) { BEGIN_RCPP; XPtr(ptr)->updateXwts(as(wts)); END_RCPP; } SEXP NelderMead_Create(SEXP lb_, SEXP ub_, SEXP xstep0_, SEXP x_, SEXP xtol_) { BEGIN_RCPP; MVec lb(as(lb_)), ub(as(ub_)), xstep0(as(xstep0_)), x(as(x_)); Nelder_Mead *ans = new Nelder_Mead(lb, ub, xstep0, x, optimizer::nl_stop(as(xtol_))); return wrap(XPtr(ans, true)); END_RCPP; } SEXP NelderMead_newf(SEXP ptr_, SEXP f_) { BEGIN_RCPP; switch (XPtr(ptr_)->newf(::Rf_asReal(f_))) { case optimizer::nm_evals: return ::Rf_ScalarInteger(-4); case optimizer::nm_forced: return ::Rf_ScalarInteger(-3); case optimizer::nm_nofeasible: return ::Rf_ScalarInteger(-2); case optimizer::nm_x0notfeasible: return ::Rf_ScalarInteger(-1); case optimizer::nm_active: return ::Rf_ScalarInteger(0); case optimizer::nm_minf_max: return ::Rf_ScalarInteger(1); case optimizer::nm_fcvg: return ::Rf_ScalarInteger(2); case optimizer::nm_xcvg: return ::Rf_ScalarInteger(3); } END_RCPP; } SEXP NelderMead_setForce_stop(SEXP ptr_, SEXP stp_) { BEGIN_RCPP; XPtr(ptr_)->setForce_stop(::Rf_asLogical(stp_)); END_RCPP; } SEXP NelderMead_setFtol_abs(SEXP ptr_, SEXP fta_) { BEGIN_RCPP; XPtr(ptr_)->setFtol_rel(::Rf_asReal(fta_)); END_RCPP; } SEXP NelderMead_setFtol_rel(SEXP ptr_, SEXP ftr_) { BEGIN_RCPP; XPtr(ptr_)->setFtol_rel(::Rf_asReal(ftr_)); END_RCPP; } SEXP NelderMead_setIprint(SEXP ptr_, SEXP ip_) { BEGIN_RCPP; XPtr(ptr_)->set_Iprint(::Rf_asInteger(ip_)); END_RCPP; } SEXP NelderMead_setMaxeval(SEXP ptr_, SEXP mm_) { BEGIN_RCPP; XPtr(ptr_)->set_Maxeval(::Rf_asInteger(mm_)); END_RCPP; } SEXP NelderMead_setMinf_max(SEXP ptr_, SEXP mm_) { BEGIN_RCPP; XPtr(ptr_)->setMinf_max(::Rf_asReal(mm_)); END_RCPP; } SEXP NelderMead_xeval(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->xeval()); END_RCPP; } SEXP NelderMead_value(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->value()); END_RCPP; } SEXP NelderMead_xpos(SEXP ptr_) { BEGIN_RCPP; return wrap(XPtr(ptr_)->xpos()); END_RCPP; } // return the number of function evaluations performed SEXP NelderMead_evals(SEXP ptr_) { BEGIN_RCPP; return wrap(int(XPtr(ptr_)->evals())); END_RCPP; } // nonlinear model response (also the base class for other response classes) SEXP nls_Create(SEXP y, SEXP weights, SEXP offset, SEXP mu, SEXP sqrtXwt, SEXP sqrtrwt, SEXP wtres, SEXP gamma, SEXP mod, SEXP env, SEXP pnms) { BEGIN_RCPP; nlsResp *ans = new nlsResp(y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres, gamma, mod, env, pnms); return wrap(XPtr(ans, true)); END_RCPP; } SEXP nls_Laplace(SEXP ptr_, SEXP ldL2, SEXP ldRX2, SEXP sqrL) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)-> Laplace(::Rf_asReal(ldL2), ::Rf_asReal(ldRX2), ::Rf_asReal(sqrL))); END_RCPP; } SEXP nls_updateMu(SEXP ptr_, SEXP gamma) { BEGIN_RCPP; return ::Rf_ScalarReal(XPtr(ptr_)->updateMu(as(gamma))); END_RCPP; } SEXP showlocation(SEXP obj) { int ll = Rf_length(obj); if (Rf_isReal(obj)) { double *vv = REAL(obj); Rcpp::Rcout << "Numeric vector of length " << ll << " at location: " << vv << std::endl; if (ll > 0) { Rcpp::Rcout << "Values: " << vv[0]; for(int i = 1; i < std::min(ll, 5); ++i) Rcpp::Rcout << "," << vv[i]; if (ll > 8) Rcpp::Rcout << ",...,"; for (int i = std::max(5, ll - 3); i < ll; ++i) Rcpp::Rcout << "," << vv[i]; Rcpp::Rcout << std::endl; } } if (Rf_isInteger(obj)) { int *vv = INTEGER(obj); Rcpp::Rcout << "Numeric vector of length " << ll << " at location: " << vv << std::endl; if (ll > 0) { Rcpp::Rcout << "Values: " << vv[0]; for(int i = 1; i < std::min(ll, 5); ++i) Rcpp::Rcout << "," << vv[i]; if (ll > 8) Rcpp::Rcout << ",...,"; for (int i = std::max(5,ll - 3); i < ll; ++i) Rcpp::Rcout << "," << vv[i]; Rcpp::Rcout << std::endl; } } return R_NilValue; } } #include #define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} static R_CallMethodDef CallEntries[] = { CALLDEF(Eigen_SSE, 0), CALLDEF(allPerm_int, 2), CALLDEF(deepcopy, 1), CALLDEF(glm_Create, 10), // generate external pointer CALLDEF(glm_setN, 2), // setters CALLDEF(glm_setTheta, 2), CALLDEF(glm_aic, 1), // getters CALLDEF(glm_devResid, 1), CALLDEF(glm_family, 1), CALLDEF(glm_link, 1), CALLDEF(glm_muEta, 1), CALLDEF(glm_resDev, 1), CALLDEF(glm_sqrtWrkWt, 1), CALLDEF(glm_theta, 1), CALLDEF(glm_variance, 1), CALLDEF(glm_wtWrkResp, 1), CALLDEF(glm_wrkResids, 1), CALLDEF(glm_wrkResp, 1), CALLDEF(glm_Laplace, 4), // methods CALLDEF(glm_updateMu, 2), CALLDEF(glm_updateWts, 1), CALLDEF(glmFamily_Create, 1), // generate external pointer CALLDEF(glmFamily_aic, 6), // methods CALLDEF(glmFamily_link, 2), CALLDEF(glmFamily_linkInv, 2), CALLDEF(glmFamily_devResid, 4), CALLDEF(glmFamily_muEta, 2), CALLDEF(glmFamily_setTheta, 2), CALLDEF(glmFamily_theta, 1), CALLDEF(glmFamily_variance, 2), CALLDEF(glmerAGQ, 7), CALLDEF(glmerLaplace, 6), CALLDEF(golden_Create, 2), CALLDEF(golden_newf, 2), CALLDEF(golden_value, 1), CALLDEF(golden_xeval, 1), CALLDEF(golden_xpos, 1), CALLDEF(isNullExtPtr, 1), CALLDEF(setNullExtPtr, 1), CALLDEF(lm_Create, 7), // generate external pointer CALLDEF(lm_setOffset, 2), // setters CALLDEF(lm_setResp, 2), CALLDEF(lm_setWeights, 2), CALLDEF(lm_wrss, 1), // getter CALLDEF(lm_updateMu, 2), // method CALLDEF(lmer_Create, 7), // generate external pointer CALLDEF(lmer_setREML, 2), // setter CALLDEF(lmer_Deviance, 3), // methods CALLDEF(lmer_Laplace, 5), CALLDEF(lmer_opt1, 4), CALLDEF(merPredDCreate, 17), // generate external pointer CALLDEF(merPredDsetTheta, 2), // setters CALLDEF(merPredDsetZt, 2), CALLDEF(merPredDsetBeta0, 2), CALLDEF(merPredDsetDelu, 2), // setters CALLDEF(merPredDsetDelb, 2), CALLDEF(merPredDCcNumer, 1), // getters CALLDEF(merPredDL, 1), CALLDEF(merPredDPvec, 1), CALLDEF(merPredDRX, 1), CALLDEF(merPredDRXdiag, 1), CALLDEF(merPredDRXi, 1), CALLDEF(merPredDldL2, 1), CALLDEF(merPredDldRX2, 1), CALLDEF(merPredDunsc, 1), CALLDEF(merPredDb, 2), // methods CALLDEF(merPredDbeta, 2), CALLDEF(merPredDcondVar, 2), CALLDEF(merPredDlinPred, 2), CALLDEF(merPredDinstallPars,2), CALLDEF(merPredDsolve, 1), CALLDEF(merPredDsolveU, 1), CALLDEF(merPredDsqrL, 2), CALLDEF(merPredDu, 2), CALLDEF(merPredDupdateDecomp,2), CALLDEF(merPredDupdateL, 1), CALLDEF(merPredDupdateLamtUt,1), CALLDEF(merPredDupdateRes, 2), CALLDEF(merPredDupdateXwts, 2), CALLDEF(NelderMead_Create, 5), CALLDEF(NelderMead_newf, 2), CALLDEF(NelderMead_setForce_stop, 2), CALLDEF(NelderMead_setFtol_abs, 2), CALLDEF(NelderMead_setFtol_rel, 2), CALLDEF(NelderMead_setIprint, 2), CALLDEF(NelderMead_setMaxeval, 2), CALLDEF(NelderMead_setMinf_max, 2), CALLDEF(NelderMead_value, 1), CALLDEF(NelderMead_xeval, 1), CALLDEF(NelderMead_xpos, 1), CALLDEF(nlmerLaplace, 9), CALLDEF(nls_Create, 11), // generate external pointer CALLDEF(nls_Laplace, 4), // methods CALLDEF(nls_updateMu, 2), CALLDEF(showlocation, 1), {NULL, NULL, 0} }; /** Initializer for lme4, called upon loading the package. * * Register routines that can be called directly from R. * Initialize CHOLMOD and require the LL' form of the factorization. * Install the symbols to be used by functions in the package. */ extern "C" void R_init_lme4(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, (Rboolean)FALSE); } lme4/src/optimizer.h0000644000176200001440000001523214063503234014100 0ustar liggesusers// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*- // // Nelder_Mead.h: NLopt's Nelder-Mead optimizer, modified to use Eigen // // Copyright (C) 2011 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #ifndef LME4_NELDER_MEAD_H #define LME4_NELDER_MEAD_H #include namespace optimizer { using Eigen::MatrixXd; using Eigen::VectorXd; using Eigen::VectorXi; typedef VectorXd::Scalar Scalar; typedef VectorXd::Index Index; class nl_stop { private: // utilities bool relstop(const Scalar& vold, const Scalar& vnew, const Scalar& reltol, const Scalar& abstol) const; Scalar sc(const Scalar& x, const Scalar& smin, const Scalar& smax) const { return smin + x * (smax - smin); } protected: const VectorXd xtol_abs; unsigned n, nevals, maxeval; Scalar minf_max, ftol_rel, ftol_abs, xtol_rel; bool force_stop=false; public: nl_stop(const VectorXd&); // constructor void incrEvals() {nevals++;} void resetEvals() {nevals = 0;} // setters void setFtol_rel(const Scalar& ftr) {ftol_rel = ftr;} void setFtol_abs(const Scalar& fta) {ftol_abs = fta;} void setForce_stop(const bool& stp) {force_stop = stp;} void setMinf_max(const Scalar& mm) {minf_max = mm;} void set_Maxeval(const unsigned int& mm) {maxeval = mm;} int get_Maxeval() const {return maxeval;} bool f(const Scalar& f, const Scalar& oldf) const { // convergence checking return (f <= minf_max || ftol(f, oldf)); } bool ftol(const Scalar& f, const Scalar& oldf) const { return relstop(oldf, f, ftol_rel, ftol_abs); } bool x(const VectorXd& x, const VectorXd& oldx) const; bool dx(const VectorXd& x, const VectorXd& dx) const; bool xs(const VectorXd& xs, const VectorXd& oldxs, const VectorXd& scale_min, const VectorXd& scale_max) const; bool evals() const {return maxeval > 0 && nevals > maxeval;} bool forced() const {return force_stop;} int ev() const {return nevals;} Scalar minfMax() const {return minf_max;} }; inline bool nl_stop::relstop(const Scalar& vold, const Scalar& vnew, const Scalar& reltol, const Scalar& abstol) const { int debug=0; bool result=false; if (std::abs(vold) == std::numeric_limits::infinity()) return false; result = std::abs(vnew - vold) < abstol || std::abs(vnew - vold) < reltol * (std::abs(vnew) + std::abs(vold)) * 0.5 || (reltol > 0 && vnew == vold); if (debug) Rcpp::Rcout << "(NM) nl_stop vnew=" << vnew << " vold=" << vold << " diff=" << std::abs(vnew-vold) << " abstol=" << abstol << " reltol=" << reltol << " scdiff=" << reltol * (std::abs(vnew) + std::abs(vold)) * 0.5 << " result=" << result << std::endl; return result; } enum nm_status {nm_active, nm_x0notfeasible, nm_nofeasible, nm_forced, nm_minf_max, nm_evals, nm_fcvg, nm_xcvg}; enum nm_stage {nm_restart, nm_postreflect, nm_postexpand, nm_postcontract}; /* heuristic "strategy" constants: */ static const double alpha = 1, beta = 0.5, gamm = 2, delta = 0.5; class Nelder_Mead { private: Scalar f_old; Index init_pos; nm_status init(const Scalar&); nm_status restart(const Scalar&); bool reflectpt(VectorXd&, const VectorXd&, const Scalar&, const VectorXd&); nm_status postreflect(const Scalar&); nm_status postexpand(const Scalar&); nm_status postcontract(const Scalar&); protected: const VectorXd d_lb; /*<< lower bounds */ const VectorXd d_ub; /*<< upper bounds */ const VectorXd d_xstep; /*<< initial step sizes */ VectorXd d_x; /*<< initial value and optimum */ Index d_ih; /**< index in d_vals of largest value */ Index d_il; /**< index in d_vals of smallest value */ Index d_n; /**< size of parameter vector */ MatrixXd d_pts; /*<< points */ VectorXd d_vals; /*<< function values */ VectorXd d_c; /*<< centroid */ VectorXd d_xcur; /*<< current x */ VectorXd d_xeval; /*<< x at which next evaluation is requested */ Scalar d_fl, d_fh, d_minf; nm_status d_stat; nm_stage d_stage; nl_stop d_stop; Index d_verb; /**< verbosity, if > 0 results are displayed every d_verb evaluations */ public: Nelder_Mead(const VectorXd&, const VectorXd&, const VectorXd&, const VectorXd&, const nl_stop&); const MatrixXd& pts() const {return d_pts;} const VectorXd& lb() const {return d_lb;} const VectorXd& ub() const {return d_ub;} const VectorXd& vals() const {return d_vals;} const VectorXd& xstep() const {return d_xstep;} const VectorXd& xeval() const {return d_xeval;} const VectorXd& xpos() const {return d_x;} Index ih() const {return d_ih;} Index il() const {return d_il;} Index evals() const {return d_stop.ev();} Scalar value() const {return d_minf;} nm_status newf(const Scalar&); void setForce_stop(const bool& stp) {d_stop.setForce_stop(stp);} void setFtol_abs(const Scalar& fta) {d_stop.setFtol_abs(fta);} void setFtol_rel(const Scalar& ftr) {d_stop.setFtol_rel(ftr);} void set_Maxeval(const unsigned int& mm) {d_stop.set_Maxeval(mm);} void set_Iprint(const int& ip) {d_verb = ip;} void setMinf_max(const Scalar& mm) {d_stop.setMinf_max(mm);} }; class Golden { protected: Scalar d_invratio, d_lower, d_upper; Eigen::Vector2d d_x, d_f; bool d_init=false, d_ll=false; public: Golden(const Scalar&, const Scalar&); void newf(const Scalar&); Scalar xeval() const {return d_x[d_ll ? 0 : 1];} Scalar value() const {return d_f[0];} Scalar xpos() const {return d_x[0];} }; } #endif // LME4_NELDER_MEAD_H lme4/src/respModule.cpp0000644000176200001440000001665714063503234014544 0ustar liggesusers// respModule.cpp: response modules using Eigen // // Copyright (C) 2011-2012 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #include "respModule.h" #include namespace lme4 { using Eigen::ArrayXd; using Eigen::VectorXd; using Rcpp::List; using Rcpp::NumericMatrix; using Rcpp::as; using std::copy; using std::invalid_argument; typedef Eigen::Map MVec; lmResp::lmResp(SEXP y, SEXP weights, SEXP offset, SEXP mu, SEXP sqrtXwt, SEXP sqrtrwt, SEXP wtres) : d_y( as(y)), d_weights(as(weights)), d_offset( as(offset)), d_mu( as(mu)), d_sqrtXwt(as(sqrtXwt)), d_sqrtrwt(as(sqrtrwt)), d_wtres( as(wtres)) { updateWrss(); d_ldW = d_weights.array().log().sum(); } /** * Update the (conditional) mean response and weighted residuals * * @param gamma New value of the linear predictor * @return updated sum of squared, weighted residuals */ double lmResp::updateMu(const VectorXd& gamma) { if (gamma.size() != d_offset.size()) throw invalid_argument("updateMu: Size mismatch"); d_mu = d_offset + gamma; return updateWrss(); } /** * Update the wtres vector and return its sum of squares * wtres <- sqrtrwt * (y - mu) * return(wrss <- sum(wtres^2)) * * @return Updated weighted residual sum of squares */ double lmResp::updateWrss() { d_wtres = d_sqrtrwt.cwiseProduct(d_y - d_mu); d_wrss = d_wtres.squaredNorm(); return d_wrss; } /** * Set a new value of the offset. * * The values are copied into the d_offset member because that member is mapped. * @param oo New value of the offset */ void lmResp::setOffset(const VectorXd& oo) { if (oo.size() != d_offset.size()) throw invalid_argument("setOffset: Size mismatch"); d_offset = oo; // this copies the values } void lmResp::setResp(const VectorXd& yy) { if (yy.size() != d_y.size()) throw invalid_argument("setResp: Size mismatch"); d_y = yy; } void lmResp::setWeights(const VectorXd& ww) { if (ww.size() != d_weights.size()) throw invalid_argument("setWeights: Size mismatch"); d_weights = ww; d_sqrtrwt = ww.array().sqrt(); d_ldW = ww.array().log().sum(); } lmerResp::lmerResp(SEXP y, SEXP weights, SEXP offset, SEXP mu, SEXP sqrtXwt, SEXP sqrtrwt, SEXP wtres) : lmResp(y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres), d_reml(0) { } double lmerResp::Laplace(double ldL2, double ldRX2, double sqrL) const { double lnum = std::log(2.* M_PI * (d_wrss + sqrL)); if (d_reml == 0) return ldL2 - d_ldW + d_y.size() * (1. + lnum - std::log(d_y.size())); double nmp = d_y.size() - d_reml; return ldL2 - d_ldW + ldRX2 + nmp * (1. + lnum - std::log(nmp)); } double lmerResp::Laplace(double ldL2, double ldRX2, double sqrL, double sigma_sq) const { double df = d_y.size() - d_reml; double result = df * (2.0 * M_LN_SQRT_2PI + std::log(sigma_sq)); // (2pi sigma_sq)^-df/2 result += (d_wrss + sqrL) / sigma_sq; // exp(-1/2sigma_sq x |pwrss|) result += ldL2 + (d_reml > 0 ? ldRX2 : 0.0); // det|LL'|^-1/2 and similar REML penalty result += -d_ldW; // subtract prior weights factor return result; } void lmerResp::setReml(int rr) { if (rr < 0) throw invalid_argument("setReml: negative value for REML not meaningful"); d_reml = rr; } glmResp::glmResp(List fam, SEXP y, SEXP weights, SEXP offset, SEXP mu, SEXP sqrtXwt, SEXP sqrtrwt, SEXP wtres, SEXP eta, SEXP n) : lmResp(y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres), d_fam(fam), d_eta(as(eta)), d_n(as(n)) { } double glmResp::aic() const { return d_fam.aic(d_y, d_n, d_mu, d_weights, resDev()); } ArrayXd glmResp::devResid() const { return d_fam.devResid(d_y, d_mu, d_weights); } ArrayXd glmResp::muEta() const { return d_fam.muEta(d_eta); } ArrayXd glmResp::variance() const { return d_fam.variance(d_mu); } ArrayXd glmResp::wrkResids() const { return (d_y - d_mu).array() / muEta(); } ArrayXd glmResp::wrkResp() const { return (d_eta - d_offset).array() + wrkResids(); } ArrayXd glmResp::wtWrkResp() const { return wrkResp() * sqrtWrkWt(); } ArrayXd glmResp::sqrtWrkWt() const { int debug=0; if (debug) Rcpp::Rcout << "(sqrtWrkWt) min muEta: " << muEta().minCoeff() << " min weights: " << d_weights.array().minCoeff() << std::endl; return muEta() * (d_weights.array() / variance()).sqrt(); } double glmResp::Laplace(double ldL2, double ldRX2, double sqrL) const { return ldL2 + sqrL + aic(); } double glmResp::resDev() const { return devResid().sum(); } double glmResp::updateMu(const VectorXd& gamma) { int debug=0; d_eta = d_offset + gamma; // lengths are checked here d_mu = d_fam.linkInv(d_eta); if (debug) Rcpp::Rcout << "updateMu: min mu:" << d_mu.minCoeff() << " max mu: " << d_mu.maxCoeff() << std::endl; return updateWrss(); } double glmResp::updateWts() { d_sqrtrwt = (d_weights.array() / variance()).sqrt(); d_sqrtXwt = muEta() * d_sqrtrwt.array(); return updateWrss(); } void glmResp::setN(const VectorXd& n) { if (n.size() != d_n.size()) throw invalid_argument("n size mismatch"); d_n = n; } nlsResp::nlsResp(SEXP y, SEXP weights, SEXP offset, SEXP mu, SEXP sqrtXwt, SEXP sqrtrwt, SEXP wtres, SEXP gamma, SEXP mm, SEXP ee, SEXP pp) : lmResp(y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres), d_gamma(as(gamma)), d_nlenv(as(ee)), d_nlmod(as(mm)), d_pnames(as(pp)) { } double nlsResp::Laplace(double ldL2, double ldRX2, double sqrL) const { double lnum = 2.* M_PI * (d_wrss + sqrL), n = d_y.size(); return ldL2 + n * (1 + std::log(lnum / n)); } double nlsResp::updateMu(const VectorXd& gamma) { int n = d_y.size(); if (gamma.size() != d_gamma.size()) throw invalid_argument("size mismatch in updateMu"); std::copy(gamma.data(), gamma.data() + gamma.size(), d_gamma.data()); const VectorXd lp(d_gamma + d_offset); // linear predictor const double *gg = lp.data(); for (int p = 0; p < d_pnames.size(); ++p) { std::string pn(d_pnames[p]); NumericVector pp = d_nlenv.get(pn); std::copy(gg + n * p, gg + n * (p + 1), pp.begin()); } NumericVector rr = d_nlmod.eval(SEXP(d_nlenv)); if (rr.size() != n) throw invalid_argument("dimension mismatch"); std::copy(rr.begin(), rr.end(), d_mu.data()); NumericMatrix gr = rr.attr("gradient"); std::copy(gr.begin(), gr.end(), d_sqrtXwt.data()); return updateWrss(); } } lme4/src/optimizer.cpp0000644000176200001440000003261013751775607014454 0ustar liggesusers// // Nelder_Mead.cpp: implementation of Nelder-Mead optimization algorithm // // Based on the files nldrmd.h, nldrmd.c, stop.c and nlopt-util.h from NLopt 2.2.4 // Steven G. Johnson, The NLopt nonlinear-optimization package, // http://ab-initio.mit.edu/nlopt // // Original implementation Copyright (C) 2007-2011 Massachusetts Institute of Technology // Modifications Copyright (C) 2011 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #include "optimizer.h" namespace optimizer { using std::invalid_argument; using std::runtime_error; typedef VectorXd::Scalar Scalar; typedef VectorXd::Index Index; /** * Determine if two values are approximately equal relative to floating-point precision * * @param a first value to compare * @param b second value to compare * * @return true if a and b are approximately equal else false */ static bool close(const Scalar& a, const Scalar& b) { return (std::abs(a - b) <= 1e-13 * (std::abs(a) + std::abs(b))); } /** * * * @param lb lower bounds * @param ub upper bounds * @param xstep initial step sizes * @param x initial parameter vector * @param f value of function at initial parameter vector */ Nelder_Mead::Nelder_Mead(const VectorXd& lb, const VectorXd& ub, const VectorXd& xstep, const VectorXd& x, const nl_stop& stp) : d_lb( lb), d_ub( ub), d_xstep( xstep), d_x( x), d_n( x.size()), d_pts( d_n, d_n + 1), d_vals( d_n + 1), d_c( d_n), d_xcur( d_n), d_xeval( x), d_minf( std::numeric_limits::infinity()), d_stage( nm_restart), d_stop( stp), d_verb( 10) { d_stop.setForce_stop( 0); // BMB: this was undefined, bad news on Win64 if (!d_n || d_lb.size() != d_n || d_ub.size() != d_n || d_xstep.size() != d_n) throw invalid_argument("dimension mismatch"); if (((d_x - d_lb).array() < 0).any() || ((d_ub - d_x).array() < 0).any()) throw std::invalid_argument("initial x is not a feasible point"); d_stop.resetEvals(); init_pos = 0; for (int i = 0; i <= d_n; ++i) d_vals[i] = std::numeric_limits::min(); d_pts = d_x.replicate(1, d_n + 1); for (Index i = 0; i < d_n; ++i) { // generate and check the initial positions Index j(i + 1); d_pts(i, j) += d_xstep[i]; if (d_pts(i, j) > d_ub[i]) { d_pts(i, j) = (d_ub[i] - d_x[i] > std::abs(d_xstep[i]) * 0.1) ? d_ub[i] // ub is too close to pt, go in other direction : d_x[i] - std::abs(d_xstep[i]); } if (d_pts(i,j) < d_lb[i]) { if (d_x[i] - d_lb[i] > std::abs(d_xstep[i]) * 0.1) d_pts(i,j) = d_lb[i]; else { // lb is too close to pt, go in other direction d_pts(i,j) = d_x[i] + std::abs(d_xstep[i]); if (d_pts(i, j) > d_ub[i]) // go towards farther of lb, ub */ d_pts(i, j) = 0.5 * ((d_ub[i] - d_x[i] > d_x[i] - d_lb[i] ? d_ub[i] : d_lb[i]) + d_x[i]); } } if (close(d_pts(i,j), d_x[i])) throw std::invalid_argument("cannot generate feasible simplex"); } } /** * Install the function value at d_xeval * * @param f value of function at d_xeval * * @return status */ nm_status Nelder_Mead::newf(const Scalar& f) { d_stop.incrEvals(); if (d_verb > 0 && (d_stop.ev() % d_verb) == 0) Rcpp::Rcout << "(NM) " << d_stop.ev() << ": " << "f = " << value() << " at " << d_x.adjoint() << std::endl; if (d_stop.forced()) { if (d_verb==1) { Rcpp::Rcout << "(NM) stop_forced" << std::endl; } return nm_forced; } if (f < d_minf) { d_minf = f; d_x = d_xeval; // save the value generating current minimum if (d_minf < d_stop.minfMax()) { if (d_verb==1) { Rcpp::Rcout << "(NM) nm_minf_max: " << d_minf << ", " << d_stop.minfMax() << ", " << d_x << std::endl; } return nm_minf_max; } } if (d_stop.evals()) { if (d_verb==1) { Rcpp::Rcout << "(NM) nm_evals" << std::endl; } return nm_evals; } if (init_pos <= d_n) { if (d_verb==1) { Rcpp::Rcout << "(NM) init_pos <= d_n" << std::endl; } return init(f); } switch (d_stage) { case nm_restart: return restart(f); case nm_postreflect: return postreflect(f); case nm_postexpand: return postexpand(f); case nm_postcontract: return postcontract(f); } return nm_active; // -Wall } /** * Initialization of d_vals from the positions in d_pts; * * @param f function value * * @return status */ nm_status Nelder_Mead::init(const Scalar& f) { if (init_pos > d_n) throw std::runtime_error("init called after n evaluations"); d_vals[init_pos++] = f; if (init_pos > d_n) return restart(f); d_xeval = d_pts.col(init_pos); return nm_active; } /** * Recompute the high/low function values (d_fh and d_fl) and indices * (d_ih and d_il) plus the centroid of the n-1 simplex opposite the high * vertex. Check if the simplex has collapsed. If not, attempt a reflection. * * @param f function value * * @return status */ nm_status Nelder_Mead::restart(const Scalar& f) { int debug=0; d_fl = d_vals.minCoeff(&d_il); d_fh = d_vals.maxCoeff(&d_ih); d_c = (d_pts.rowwise().sum() - d_pts.col(d_ih)) / d_n; // compute centroid if (debug) Rcpp::Rcout << "(NM) current points: " << d_pts << std::endl; if (debug) Rcpp::Rcout << "(NM) current centroid: " << d_c << std::endl; // check for x convergence by calculating the maximum absolute // deviation from the centroid for each coordinate in the simplex if (d_stop.x(VectorXd::Constant(d_n, 0.), (d_pts.colwise() - d_c).array().abs().rowwise().maxCoeff())) { if (debug) Rcpp::Rcout << "(NM) restart, report convergence" << std::endl; return nm_xcvg; } if (!reflectpt(d_xcur, d_c, alpha, d_pts.col(d_ih))) { if (debug) Rcpp::Rcout << "(NM) reflected; report convergence" << std::endl; return nm_xcvg; } d_xeval = d_xcur; if (debug) Rcpp::Rcout << "(NM) restart, now postreflect" << std::endl; d_stage = nm_postreflect; return nm_active; } nm_status Nelder_Mead::postreflect(const Scalar& f) { int debug=0; // Rcpp::Rcout << "postreflect: "; if (f < d_fl) { // new best point, try to expand if (!reflectpt(d_xeval, d_c, gamm, d_pts.col(d_ih))) return nm_xcvg; if (debug) Rcpp::Rcout << "(NM) postreflect: new best point" << std::endl; if (debug) Rcpp::Rcout << "(NM) postreflect, now postexpand" << std::endl; d_stage = nm_postexpand; f_old = f; return nm_active; } if (f < d_fh) { // accept new point if (debug) Rcpp::Rcout << "(NM) postreflect: accept new point" << std::endl; d_vals[d_ih] = f; d_pts.col(d_ih) = d_xeval; return restart(f); } // new worst point, contract if (debug) Rcpp::Rcout << "(NM) postreflect: new worst point" << std::endl; if (!reflectpt(d_xcur, d_c, d_fh <= f ? -beta : beta, d_pts.col(d_ih))) return nm_xcvg; f_old = f; d_xeval = d_xcur; if (debug) Rcpp::Rcout << "(NM) postreflect, now postcontract" << std::endl; d_stage = nm_postcontract; return nm_active; } nm_status Nelder_Mead::postexpand(const Scalar& f) { int debug=0; if (f < d_vals[d_ih]) { // expanding improved if (debug) Rcpp::Rcout << "(NM) postexpand: successful expand" << std::endl; d_pts.col(d_ih) = d_xeval; d_vals[d_ih] = f; } else { if (debug) Rcpp::Rcout << "(NM) postexpand: unsuccessful expand" << std::endl; d_pts.col(d_ih) = d_xcur; d_vals[d_ih] = f_old; } if (debug) Rcpp::Rcout << "(NM) postexpand: now restart" << std::endl; return restart(f); } nm_status Nelder_Mead::postcontract(const Scalar& f) { int debug=0; if (f < f_old && f < d_fh) { if (debug) Rcpp::Rcout << "(NM) postcontract: successful contraction:" << std::endl; d_pts.col(d_ih) = d_xeval; d_vals[d_ih] = f; return restart(f); } if (debug) Rcpp::Rcout << "(NM) postcontract: unsuccessful contraction, shrink simplex" << std::endl; for (Index i = 0; i <= d_n; ++i) { if (i != d_il) { if (!reflectpt(d_xeval, d_pts.col(d_il), -delta, d_pts.col(i))) return nm_xcvg; d_pts.col(i) = d_xeval; } } init_pos = 0; d_xeval = d_pts.col(0); return nm_active; } /* Perform the reflection xnew = c + scale * (c - xold), returning 0 if xnew == c or xnew == xold (coincident points), 1 otherwise. The reflected point xnew is "pinned" to the lower and upper bounds (lb and ub), as suggested by J. A. Richardson and J. L. Kuester, "The complex method for constrained optimization," Commun. ACM 16(8), 487-489 (1973). This is probably a suboptimal way to handle bound constraints, but I don't know a better way. The main danger with this is that the simplex might collapse into a lower-dimensional hyperplane; this danger can be ameliorated by restarting (as in subplex), however. */ bool Nelder_Mead::reflectpt(VectorXd& xnew, const VectorXd& c, const Scalar& scale, const VectorXd& xold) { int debug=0; xnew = c + scale * (c - xold); bool equalc = true, equalold = true; for (Index i = 0; i < d_n; ++i) { Scalar newx = std::min(std::max(xnew[i], d_lb[i]), d_ub[i]); // BMB: what is the difference between using d_c[i] and c[i]? equalc = equalc && close(newx, c[i]); if (debug && close(newx,c[i])) Rcpp::Rcout << "reflectpt: close(newx, c[i]) i=" << i << " newx=" << newx << " c[i]=" << c[i] << std::endl; equalold = equalold && close(newx, xold[i]); if (debug && close(newx,xold[i])) Rcpp::Rcout << "reflectpt: close(newx, xold[i]) i=" << i << " newx=" << newx << " xold[i]=" << xold[i] << std::endl; xnew[i] = newx; } return !(equalc || equalold); } nl_stop::nl_stop(const VectorXd& xtol) : xtol_abs( xtol), maxeval( 300), minf_max( std::numeric_limits::min()), ftol_rel( 1e-15), xtol_rel( 1e-7) { } bool nl_stop::x(const VectorXd& x, const VectorXd& oldx) const { for (Index i = 0; i < x.size(); ++i) if (!relstop(oldx[i], x[i], xtol_rel, xtol_abs[i])) return false; return true; } bool nl_stop::dx(const VectorXd& x, const VectorXd& dx) const { for (Index i = 0; i < x.size(); ++i) if (!relstop(x[i] - dx[i], x[i], xtol_rel, xtol_abs[i])) return false; return true; } bool nl_stop::xs(const VectorXd& xs, const VectorXd& oldxs, const VectorXd& scale_min, const VectorXd& scale_max) const { for (Index i = 0; i < xs.size(); ++i) if (relstop(sc(oldxs[i], scale_min[i], scale_max[i]), sc(xs[i], scale_min[i], scale_max[i]), xtol_rel, xtol_abs[i])) return true; return false; } Golden::Golden(const Scalar& lower, const Scalar& upper) : d_lower(lower), d_upper(upper) { if (lower >= upper) throw invalid_argument("lower >= upper"); d_invratio = 2./(1. + std::sqrt(5.)); double range = upper - lower; d_x[0] = lower + range * (1. - d_invratio); d_x[1] = lower + range * d_invratio; d_init = true; d_ll = true; } void Golden::newf(const Scalar& fv) { Rcpp::Rcout << "f = " << fv << " at x = " << xeval() << std::endl; d_f[d_ll ? 0 : 1] = fv; if (d_init) { d_init = false; d_ll = false; return; } if (d_f[0] > d_f[1]) { // discard left portion of interval d_lower = d_x[0]; d_x[0] = d_x[1]; d_f[0] = d_f[1]; d_x[1] = d_lower + (d_upper - d_lower) * d_invratio; d_ll = false; } else { d_upper = d_x[1]; d_x[1] = d_x[0]; d_f[1] = d_f[0]; d_x[0] = d_lower + (d_upper - d_lower) * (1 - d_invratio); d_ll = true; } } } lme4/src/lme4CholmodDecomposition.h0000644000176200001440000001236413751775607017007 0ustar liggesusers// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*- // // predModule.h: predictor module using Eigen // // Copyright (C) 2011 Douglas Bates, Martin Maechler and Ben Bolker // // This file is part of lme4. #ifndef LME4_CHOLMODDECOMPOSITION_H #define LME4_CHOLMODDECOMPOSITION_H #include namespace lme4 { /* A wrapper around Eigen's CholmodDecomposition class that provides some extra functionality and member access required by lme4. */ template class lme4CholmodDecomposition : public Eigen::CholmodDecomposition<_MatrixType, _UpLo> { protected: typedef Eigen::CholmodDecomposition<_MatrixType, _UpLo> Base; using Base::m_factorizationIsOk; using Base::m_analysisIsOk; public: cholmod_common& cholmod() const { return const_cast*>(this)->Base::cholmod(); } cholmod_factor* factor() const { return Base::m_cholmodFactor; } void factorize_p(const typename Base::MatrixType& matrix, Eigen::ArrayXi fset, double beta=0.) { // FIXME: add forceRectangular flag to allow backward compatibility; // restore an appropriate version of the square/rectangular test eigen_assert(m_analysisIsOk && "You must first call analyzePattern()"); cholmod_sparse A = // **SKIP square test because we only call this function // in lme4 when we want to treat the input as a rectangular // matrix // (!forceRectangularmatrix.rows() == matrix.cols()) ? // viewAsCholmod(matrix.template selfadjointView<_UpLo>()) : viewAsCholmod(matrix); cholmod_factorize_p(&A, &beta, fset.data(), fset.size(), factor(), &cholmod()); this->m_info = Eigen::Success; m_factorizationIsOk = true; } template void solveInPlace(const Eigen::MatrixBase& _other, int type) const { OtherDerived& other = _other.const_cast_derived(); eigen_assert(m_factorizationIsOk && "The decomposition is not in a valid state for solving, you must first call either compute() or symbolic()/numeric()"); eigen_assert((Base::Index)(factor()->n) == other.rows()); // note: cd stands for Cholmod Dense cholmod_dense b_cd = viewAsCholmod(other.const_cast_derived()); // m_cholmodFactor cholmod_dense* x_cd = cholmod_solve(type, factor(), &b_cd, &cholmod()); if(!x_cd) { this->m_info = Eigen::NumericalIssue; } typename Base::Scalar* xpt = reinterpret_cast(x_cd->x); std::copy(xpt, xpt + other.rows() * other.cols(), other.data()); cholmod_free_dense(&x_cd, &cholmod()); } }; template SEXP Eigen_cholmod_wrap(const lme4CholmodDecomposition >& obj) { typedef T* Tpt; const cholmod_factor* f = obj.factor(); if (f->minor < f->n) throw std::runtime_error("CHOLMOD factorization was unsuccessful"); //FIXME: Should extend this selection according to T ::Rcpp::S4 ans(std::string(f->is_super ? "dCHMsuper" : "dCHMsimpl")); ::Rcpp::IntegerVector dd(2); dd[0] = dd[1] = f->n; ans.slot("Dim") = dd; ans.slot("perm") = ::Rcpp::wrap((int*)f->Perm, (int*)f->Perm + f->n); ans.slot("colcount") = ::Rcpp::wrap((int*)f->ColCount, (int*)f->ColCount + f->n); ::Rcpp::IntegerVector tt(f->is_super ? 6 : 4); tt[0] = f->ordering; tt[1] = f->is_ll; tt[2] = f->is_super; tt[3] = f->is_monotonic; ans.slot("type") = tt; if (f->is_super) { tt[4] = f->maxcsize; tt[5] = f->maxesize; ans.slot("super") = ::Rcpp::wrap((int*)f->super, ((int*)f->super) + f->nsuper + 1); ans.slot("pi") = ::Rcpp::wrap((int*)f->pi, ((int*)f->pi) + f->nsuper + 1); ans.slot("px") = ::Rcpp::wrap((int*)f->px, ((int*)f->px) + f->nsuper + 1); ans.slot("s") = ::Rcpp::wrap((int*)f->s, ((int*)f->s) + f->ssize); ans.slot("x") = ::Rcpp::wrap((Tpt)f->x, ((T*)f->x) + f->xsize); } else { ans.slot("i") = ::Rcpp::wrap((int*)f->i, ((int*)f->i) + f->nzmax); ans.slot("p") = ::Rcpp::wrap((int*)f->p, ((int*)f->p) + f->n + 1); ans.slot("x") = ::Rcpp::wrap((Tpt)f->x, ((T*)f->x) + f->nzmax); ans.slot("nz") = ::Rcpp::wrap((int*)f->nz, ((int*)f->nz) + f->n); ans.slot("nxt") = ::Rcpp::wrap((int*)f->next, ((int*)f->next) + f->n + 2); ans.slot("prv") = ::Rcpp::wrap((int*)f->prev, ((int*)f->prev) + f->n + 2); } return ::Rcpp::wrap(ans); } } // namespace lme4 namespace Rcpp { template SEXP wrap(const lme4::lme4CholmodDecomposition >& obj) { return ::lme4::Eigen_cholmod_wrap(obj); } } // namespace Rcpp #endif // LME4_CHOLMODDECOMPOSITION_H lme4/vignettes/0000755000176200001440000000000014176612464013136 5ustar liggesuserslme4/vignettes/PLSvGLS.Rnw0000644000176200001440000004356213751775607015041 0ustar liggesusers\documentclass[12pt]{article} \usepackage{Sweave,amsmath,amsfonts,bm} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \DeclareMathOperator \tr {tr} \DefineVerbatimEnvironment{Sinput}{Verbatim} {formatcom={\vspace{-1ex}},fontshape=sl, fontfamily=courier,fontseries=b, fontsize=\footnotesize} \DefineVerbatimEnvironment{Soutput}{Verbatim} {formatcom={\vspace{-1ex}},fontfamily=courier,fontseries=b,% fontsize=\footnotesize} %%\VignetteIndexEntry{PLS vs GLS for LMMs} %%\VignetteDepends{lme4} \title{Penalized least squares versus generalized least squares representations of linear mixed models} \author{Douglas Bates\\Department of Statistics\\% University of Wisconsin -- Madison} \begin{document} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,strip.white=true,keep.source=TRUE} \SweaveOpts{include=FALSE} \setkeys{Gin}{width=\textwidth} \newcommand{\code}[1]{\texttt{\small{#1}}} \newcommand{\package}[1]{\textsf{\small{#1}}} \newcommand{\trans}{\ensuremath{^\prime}} <>= options(width=65,digits=5) #library(lme4) @ \maketitle \begin{abstract} The methods in the \code{lme4} package for \code{R} for fitting linear mixed models are based on sparse matrix methods, especially the Cholesky decomposition of sparse positive-semidefinite matrices, in a penalized least squares representation of the conditional model for the response given the random effects. The representation is similar to that in Henderson's mixed-model equations. An alternative representation of the calculations is as a generalized least squares problem. We describe the two representations, show the equivalence of the two representations and explain why we feel that the penalized least squares approach is more versatile and more computationally efficient. \end{abstract} \section{Definition of the model} \label{sec:Definition} We consider linear mixed models in which the random effects are represented by a $q$-dimensional random vector, $\bm{\mathcal{B}}$, and the response is represented by an $n$-dimensional random vector, $\bm{\mathcal{Y}}$. We observe a value, $\bm y$, of the response. The random effects are unobserved. For our purposes, we will assume a ``spherical'' multivariate normal conditional distribution of $\bm{\mathcal{Y}}$, given $\bm{\mathcal{B}}$. That is, we assume the variance-covariance matrix of $\bm{\mathcal{Y}}|\bm{\mathcal{B}}$ is simply $\sigma^2\bm I_n$, where $\bm I_n$ denotes the identity matrix of order $n$. (The term ``spherical'' refers to the fact that contours of the conditional density are concentric spheres.) The conditional mean, $\mathrm{E}[\bm{\mathcal{Y}}|\bm{\mathcal{B}}=\bm b]$, is a linear function of $\bm b$ and the $p$-dimensional fixed-effects parameter, $\bm\beta$, \begin{equation} \label{eq:condmean} \mathrm{E}[\bm{\mathcal{Y}}|\bm{\mathcal{B}}=\bm b]= \bm X\bm\beta+\bm Z\bm b , \end{equation} where $\bm X$ and $\bm Z$ are known model matrices of sizes $n\times p$ and $n\times q$, respectively. Thus \begin{equation} \label{eq:yconditional} \bm{\mathcal{Y}}|\bm{\mathcal{B}}\sim \mathcal{N}\left(\bm X\bm\beta+\bm Z\bm b,\sigma^2\bm I_n\right) . \end{equation} The marginal distribution of the random effects \begin{equation} \label{eq:remargin} \bm{\mathcal{B}}\sim\mathcal{N}\left(\bm 0,\sigma^2\bm\Sigma(\bm\theta)\right) \end{equation} is also multivariate normal, with mean $\bm 0$ and variance-covariance matrix $\sigma^2\bm\Sigma(\bm\theta)$. The scalar, $\sigma^2$, in (\ref{eq:remargin}) is the same as the $\sigma^2$ in (\ref{eq:yconditional}). As described in the next section, the relative variance-covariance matrix, $\bm\Sigma(\bm\theta)$, is a $q\times q$ positive semidefinite matrix depending on a parameter vector, $\bm\theta$. Typically the dimension of $\bm\theta$ is much, much smaller than $q$. \subsection{Variance-covariance of the random effects} \label{sec:revarcov} The relative variance-covariance matrix, $\bm\Sigma(\bm\theta)$, must be symmetric and positive semidefinite (i.e. $\bm x\trans\bm\Sigma\bm x\ge0,\forall\bm x\in\mathbb{R}^q$). Because the estimate of a variance component can be zero, it is important to allow for a semidefinite $\bm\Sigma$. We do not assume that $\bm\Sigma$ is positive definite (i.e. $\bm x\trans\bm\Sigma\bm x>0,\forall\bm x\in\mathbb{R}^q, \bm x\ne\bm 0$) and, hence, we cannot assume that $\bm\Sigma^{-1}$ exists. A positive semidefinite matrix such as $\bm\Sigma$ has a Cholesky decomposition of the so-called ``LDL$\trans$'' form. We use a slight modification of this form, \begin{equation} \label{eq:TSdef} \bm\Sigma(\bm\theta)=\bm T(\bm\theta)\bm S(\bm\theta)\bm S(\bm\theta)\bm T(\bm\theta)\trans , \end{equation} where $\bm T(\bm\theta)$ is a unit lower-triangular $q\times q$ matrix and $\bm S(\bm\theta)$ is a diagonal $q\times q$ matrix with nonnegative diagonal elements that act as scale factors. (They are the relative standard deviations of certain linear combinations of the random effects.) Thus, $\bm T$ is a triangular matrix and $\bm S$ is a scale matrix. Both $\bm T$ and $\bm S$ are highly patterned. \subsection{Orthogonal random effects} \label{sec:orthogonal} Let us define a $q$-dimensional random vector, $\bm{\mathcal{U}}$, of orthogonal random effects with marginal distribution \begin{equation} \label{eq:Udist} \bm{\mathcal{U}}\sim\mathcal{N}\left(\bm 0,\sigma^2\bm I_q\right) \end{equation} and, for a given value of $\bm\theta$, express $\bm{\mathcal{B}}$ as a linear transformation of $\bm{\mathcal{U}}$, \begin{equation} \label{eq:UtoB} \bm{\mathcal{B}}=\bm T(\bm\theta)\bm S(\bm\theta)\bm{\mathcal{U}} . \end{equation} Note that the transformation (\ref{eq:UtoB}) gives the desired distribution of $\bm{\mathcal{B}}$ in that $\mathrm{E}[\bm{\mathcal{B}}]=\bm T\bm S\mathrm{E}[\bm{\mathcal{U}}]=\bm 0$ and \begin{displaymath} \mathrm{Var}(\bm{\mathcal{B}})=\mathrm{E}[\bm{\mathcal{B}}\bm{\mathcal{B}}\trans] =\bm T\bm S\mathrm{E}[\bm{\mathcal{U}}\bm{\mathcal{U}}\trans]\bm S\bm T\trans=\sigma^2\bm T\bm S\bm S\bm T\trans=\bm\Sigma . \end{displaymath} The conditional distribution, $\bm{\mathcal{Y}}|\bm{\mathcal{U}}$, can be derived from $\bm{\mathcal{Y}}|\bm{\mathcal{B}}$ as \begin{equation} \label{eq:YgivenU} \bm{\mathcal{Y}}|\bm{\mathcal{U}}\sim\mathcal{N}\left(\bm X\bm\beta+\bm Z\bm T\bm S\bm u, \sigma^2\bm I\right) \end{equation} We will write the transpose of $\bm Z\bm T\bm S$ as $\bm A$. Because the matrices $\bm T$ and $\bm S$ depend on the parameter $\bm\theta$, $\bm A$ is also a function of $\bm\theta$, \begin{equation} \label{eq:Adef} \bm A\trans(\bm\theta)=\bm Z\bm T(\bm\theta)\bm S(\bm\theta) . \end{equation} In applications, the matrix $\bm Z$ is derived from indicator columns of the levels of one or more factors in the data and is a \emph{sparse} matrix, in the sense that most of its elements are zero. The matrix $\bm A$ is also sparse. In fact, the structure of $\bm T$ and $\bm S$ are such that pattern of nonzeros in $\bm A$ is that same as that in $\bm Z\trans$. \subsection{Sparse matrix methods} \label{sec:sparseMatrix} The reason for defining $\bm A$ as the transpose of a model matrix is because $\bm A$ is stored and manipulated as a sparse matrix. In the compressed column-oriented storage form that we use for sparse matrices, there are advantages to storing $\bm A$ as a matrix of $n$ columns and $q$ rows. In particular, the CHOLMOD sparse matrix library allows us to evaluate the sparse Cholesky factor, $\bm L(\bm\theta)$, a sparse lower triangular matrix that satisfies \begin{equation} \label{eq:SparseChol} \bm L(\bm\theta)\bm L(\bm\theta)\trans= \bm P\left(\bm A(\bm\theta)\bm A(\bm\theta)\trans+\bm I_q\right)\bm P\trans , \end{equation} directly from $\bm A(\bm\theta)$. In (\ref{eq:SparseChol}) the $q\times q$ matrix $\bm P$ is a ``fill-reducing'' permutation matrix determined from the pattern of nonzeros in $\bm Z$. $\bm P$ does not affect the statistical theory (if $\bm{\mathcal{U}}\sim\mathcal{N}(\bm 0,\sigma^2\bm I)$ then $\bm P\trans\bm{\mathcal{U}}$ also has a $\mathcal{N}(\bm 0,\sigma^2\bm I)$ distribution because $\bm P\bm P\trans=\bm P\trans\bm P=\bm I$) but, because it affects the number of nonzeros in $\bm L$, it can have a tremendous impact on the amount storage required for $\bm L$ and the time required to evaluate $\bm L$ from $\bm A$. Indeed, it is precisely because $\bm L(\bm\theta)$ can be evaluated quickly, even for complex models applied the large data sets, that the \code{lmer} function is effective in fitting such models. \section{The penalized least squares approach to linear mixed models} \label{sec:Penalized} Given a value of $\bm\theta$ we form $\bm A(\bm\theta)$ from which we evaluate $\bm L(\bm\theta)$. We can then solve for the $q\times p$ matrix, $\bm R_{\bm{ZX}}$, in the system of equations \begin{equation} \label{eq:RZX} \bm L(\theta)\bm R_{\bm{ZX}}=\bm P\bm A(\bm\theta)\bm X \end{equation} and for the $p\times p$ upper triangular matrix, $\bm R_{\bm X}$, satisfying \begin{equation} \label{eq:RX} \bm R_{\bm X}\trans\bm R_{\bm X}= \bm X\trans\bm X-\bm R_{\bm{ZX}}\trans\bm R_{\bm{ZX}} \end{equation} The conditional mode, $\tilde{\bm u}(\bm\theta)$, of the orthogonal random effects and the conditional mle, $\widehat{\bm\beta}(\bm\theta)$, of the fixed-effects parameters can be determined simultaneously as the solutions to a penalized least squares problem, \begin{equation} \label{eq:PLS} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\ \widehat{\bm\beta}(\bm\theta) \end{bmatrix}= \arg\min_{\bm u,\bm\beta}\left\| \begin{bmatrix}\bm y\\\bm 0\end{bmatrix} - \begin{bmatrix} \bm A\trans\bm P\trans & \bm X\\ \bm I_q & \bm 0 \end{bmatrix} \begin{bmatrix}\bm u\\\bm\beta\end{bmatrix} , \right\|^2 \end{equation} for which the solution satisfies \begin{equation} \label{eq:PLSsol} \begin{bmatrix} \bm P\left(\bm A\bm A\trans+\bm I\right)\bm P\trans & \bm P\bm A\bm X\\ \bm X\trans\bm A\trans\bm P\trans & \bm X\trans\bm X \end{bmatrix} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\ \widehat{\bm\beta}(\bm\theta) \end{bmatrix}= \begin{bmatrix}\bm P\bm A\bm y\\\bm X\trans\bm y\end{bmatrix} . \end{equation} The Cholesky factor of the system matrix for the PLS problem can be expressed using $\bm L$, $\bm R_{\bm Z\bm X}$ and $\bm R_{\bm X}$, because \begin{equation} \label{eq:PLSChol} \begin{bmatrix} \bm P\left(\bm A\bm A\trans+\bm I\right)\bm P\trans & \bm P\bm A\bm X\\ \bm X\trans\bm A\trans\bm P\trans & \bm X\trans\bm X \end{bmatrix} = \begin{bmatrix} \bm L & \bm 0\\ \bm R_{\bm Z\bm X}\trans & \bm R_{\bm X}\trans \end{bmatrix} \begin{bmatrix} \bm L\trans & \bm R_{\bm Z\bm X}\\ \bm 0 & \bm R_{\bm X} \end{bmatrix} . \end{equation} In the \code{lme4} package the \code{"mer"} class is the representation of a mixed-effects model. Several slots in this class are matrices corresponding directly to the matrices in the preceding equations. The \code{A} slot contains the sparse matrix $\bm A(\bm\theta)$ and the \code{L} slot contains the sparse Cholesky factor, $\bm L(\bm\theta)$. The \code{RZX} and \code{RX} slots contain $\bm R_{\bm Z\bm X}(\bm\theta)$ and $\bm R_{\bm X}(\bm\theta)$, respectively, stored as dense matrices. It is not necessary to solve for $\tilde{\bm u}(\bm\theta)$ and $\widehat{\bm\beta}(\bm\theta)$ to evaluate the \emph{profiled} log-likelihood, which is the log-likelihood evaluated $\bm\theta$ and the conditional estimates of the other parameters, $\widehat{\bm\beta}(\bm\theta)$ and $\widehat{\sigma^2}(\bm\theta)$. All that is needed for evaluation of the profiled log-likelihood is the (penalized) residual sum of squares, $r^2$, from the penalized least squares problem (\ref{eq:PLS}) and the determinant $|\bm A\bm A\trans+\bm I|=|\bm L|^2$. Because $\bm L$ is triangular, its determinant is easily evaluated as the product of its diagonal elements. Furthermore, $|\bm L|^2 > 0$ because it is equal to $|\bm A\bm A\trans + \bm I|$, which is the determinant of a positive definite matrix. Thus $\log(|\bm L|^2)$ is both well-defined and easily calculated from $\bm L$. The profiled deviance (negative twice the profiled log-likelihood), as a function of $\bm\theta$ only ($\bm\beta$ and $\sigma^2$ at their conditional estimates), is \begin{equation} \label{eq:profiledDev} d(\bm\theta|\bm y)=\log(|\bm L|^2)+n\left(1+\log(r^2)+\frac{2\pi}{n}\right) \end{equation} The maximum likelihood estimates, $\widehat{\bm\theta}$, satisfy \begin{equation} \label{eq:thetamle} \widehat{\bm\theta}=\arg\min_{\bm\theta}d(\bm\theta|\bm y) \end{equation} Once the value of $\widehat{\bm\theta}$ has been determined, the mle of $\bm\beta$ is evaluated from (\ref{eq:PLSsol}) and the mle of $\sigma^2$ as $\widehat{\sigma^2}(\bm\theta)=r^2/n$. Note that nothing has been said about the form of the sparse model matrix, $\bm Z$, other than the fact that it is sparse. In contrast to other methods for linear mixed models, these results apply to models where $\bm Z$ is derived from crossed or partially crossed grouping factors, in addition to models with multiple, nested grouping factors. The system (\ref{eq:PLSsol}) is similar to Henderson's ``mixed-model equations'' (reference?). One important difference between (\ref{eq:PLSsol}) and Henderson's formulation is that Henderson represented his system of equations in terms of $\bm\Sigma^{-1}$ and, in important practical examples, $\bm\Sigma^{-1}$ does not exist at the parameter estimates. Also, Henderson assumed that equations like (\ref{eq:PLSsol}) would need to be solved explicitly and, as we have seen, only the decomposition of the system matrix is needed for evaluation of the profiled log-likelihood. The same is true of the profiled the logarithm of the REML criterion, which we define later. \section{The generalized least squares approach to linear mixed models} \label{sec:GLS} Another common approach to linear mixed models is to derive the marginal variance-covariance matrix of $\bm{\mathcal{Y}}$ as a function of $\bm\theta$ and use that to determine the conditional estimates, $\widehat{\bm\beta}(\bm\theta)$, as the solution of a generalized least squares (GLS) problem. In the notation of \S\ref{sec:Definition} the marginal mean of $\bm{\mathcal{Y}}$ is $\mathrm{E}[\bm{\mathcal{Y}}]=\bm X\bm\beta$ and the marginal variance-covariance matrix is \begin{equation} \label{eq:marginalvarcovY} \mathrm{Var}(\bm{\mathcal{Y}})=\sigma^2\left(\bm I_n+\bm Z\bm T\bm S\bm S\bm T\trans\bm Z\trans\right)=\sigma^2\left(\bm I_n+\bm A\trans\bm A\right) =\sigma^2\bm V(\bm\theta) , \end{equation} where $\bm V(\bm\theta)=\bm I_n+\bm A\trans\bm A$. The conditional estimates of $\bm\beta$ are often written as \begin{equation} \label{eq:condbeta} \widehat{\bm\beta}(\bm\theta)=\left(\bm X\trans\bm V^{-1}\bm X\right)^{-1}\bm X\trans\bm V^{-1}\bm y \end{equation} but, of course, this formula is not suitable for computation. The matrix $\bm V(\bm\theta)$ is a symmetric $n\times n$ positive definite matrix and hence has a Cholesky factor. However, this factor is $n\times n$, not $q\times q$, and $n$ is always larger than $q$ --- sometimes orders of magnitude larger. Blithely writing a formula in terms of $\bm V^{-1}$ when $\bm V$ is $n\times n$, and $n$ can be in the millions does not a computational formula make. \subsection{Relating the GLS approach to the Cholesky factor} \label{sec:GLStoL} We can use the fact that \begin{equation} \label{eq:Vinv} \bm V^{-1}(\bm\theta)=\left(\bm I_n+\bm A\trans\bm A\right)^{-1}= \bm I_n-\bm A\trans\left(\bm I_q+\bm A\bm A\trans\right)^{-1}\bm A \end{equation} to relate the GLS problem to the PLS problem. One way to establish (\ref{eq:Vinv}) is simply to show that the product \begin{multline*} (\bm I+\bm A\trans\bm A)\left(\bm I-\bm A\trans\left(\bm I+\bm A\bm A\trans\right)^{-1}\bm A\right)\\ \begin{aligned} =&\bm I+\bm A\trans\bm A-\bm A\trans\left(\bm I+\bm A\bm A\trans\right) \left(\bm I+\bm A\bm A\trans\right)^{-1}\bm A\\ =&\bm I+\bm A\trans\bm A-\bm A\trans\bm A\\ =&\bm I . \end{aligned} \end{multline*} Incorporating the permutation matrix $\bm P$ we have \begin{equation} \label{eq:PLA} \begin{aligned} \bm V^{-1}(\bm\theta)=&\bm I_n-\bm A\trans\bm P\trans\bm P\left(\bm I_q+\bm A\bm A\trans\right)^{-1}\bm P\trans\bm P\bm A\\ =&\bm I_n-\bm A\trans\bm P\trans(\bm L\bm L\trans)^{-1}\bm P\bm A\\ =&\bm I_n-\left(\bm L^{-1}\bm P\bm A\right)\trans\bm L^{-1}\bm P\bm A . \end{aligned} \end{equation} Even in this form we would not want to routinely evaluate $\bm V^{-1}$. However, (\ref{eq:PLA}) does allow us to simplify many common expressions. For example, the variance-covariance of the estimator $\widehat{\bm \beta}$, conditional on $\bm\theta$ and $\sigma$, can be expressed as \begin{equation} \label{eq:varcovbeta} \begin{aligned} \sigma^2\left(\bm X\trans\bm V^{-1}(\bm\theta)\bm X\right)^{-1} =&\sigma^2\left(\bm X\trans\bm X-\left(\bm L^{-1}\bm P\bm A\bm X\right)\trans\left(\bm L^{-1}\bm P\bm A\bm X\right)\right)^{-1}\\ =&\sigma^2\left(\bm X\trans\bm X-\bm R_{\bm Z\bm X}\trans\bm R_{\bm Z\bm X}\right)^{-1}\\ =&\sigma^2\left(\bm R_{\bm X}\trans\bm R_{\bm X}\right)^{-1} . \end{aligned} \end{equation} \section{Trace of the ``hat'' matrix} \label{sec:hatTrace} Another calculation that is of interest to some is the the trace of the ``hat'' matrix, which can be written as \begin{multline} \label{eq:hatTrace} \tr\left(\begin{bmatrix}\bm A\trans&\bm X\end{bmatrix} \left(\begin{bmatrix}\bm A\trans&\bm X\\\bm I&\bm0\end{bmatrix}\trans \begin{bmatrix}\bm A\trans&\bm X\\\bm I&\bm0\end{bmatrix}\right)^{-1} \begin{bmatrix}\bm A\\\bm X\trans\end{bmatrix}\right)\\ = \tr\left(\begin{bmatrix}\bm A\trans&\bm X\end{bmatrix} \left(\begin{bmatrix}\bm L&\bm0\\ \bm R_{\bm{ZX}}\trans&\bm R_{\bm X}\trans\end{bmatrix} \begin{bmatrix}\bm L\trans&\bm R_{\bm{ZX}}\\ \bm0&\bm R_{\bm X}\end{bmatrix}\right)^{-1} \begin{bmatrix}\bm A\\\bm X\trans\end{bmatrix}\right) \end{multline} \end{document} lme4/vignettes/lmer.bib0000644000176200001440000004257113751775607014573 0ustar liggesusers%% This BibTeX bibliography file was created using BibDesk. %% http://bibdesk.sourceforge.net/ %% Created for Steven Walker at 2014-02-14 16:07:20 -0500 %% Saved with string encoding Unicode (UTF-8) @InCollection{Chambers:1993, author = {John M. Chambers}, title = {Linear Models}, booktitle = {Statistical Models in \proglang{S}}, publisher = {Chapman \& Hall}, year = 1993, editor = {John M. Chambers and Trevor J. Hastie}, chapter = 4, pages = {95--144}, } @book{Rauden:Bryk:2002, Author = {Stephen W. Raudenbush and Anthony S. Bryk}, Edition = {2nd}, Isbn = {0-7619-1904-X}, Publisher = {Sage}, Title = {Hierarchical Linear Models: Applications and Data Analysis Methods}, Year = 2002 } @book{MLwiNUser:2000, Address = {London}, Author = {J. Rasbash and W. Browne and H. Goldstein and M. Yang and I. Plewis}, Publisher = {Multilevel Models Project, Institute of Education, University of London}, Title = {A User's Guide to \pkg{MLwiN}}, Year = 2000} @Book{davis06:csparse_book, address = {Philadelphia, PA}, author = {Tim Davis}, publisher = {SIAM}, title = {Direct Methods for Sparse Linear Systems}, year = 2006, doi = {10.1137/1.9780898718881}, } @Article{laird_ware_1982, author = {Nan M. Laird and James H. Ware}, journal = {Biometrics}, pages = {963--974}, title = {Random-Effects Models for Longitudinal Data}, volume = 38, number = 4, year = 1982, doi = {10.2307/2529876}, } @Book{bateswatts88:_nonlin, address = {Hoboken, NJ}, author = {Douglas M. Bates and Donald G. Watts}, publisher = {John Wiley \& Sons}, title = {Nonlinear Regression Analysis and Its Applications}, year = 1988, doi = {10.1002/9780470316757}, } @book{R:Pinheiro+Bates:2000, Author = {Jose C. Pinheiro and Douglas M. Bates}, Title = {Mixed-Effects Models in \proglang{S} and \proglang{S-PLUS}}, Year = 2000, Orderinfo = {springer.txt}, ISBN = {0-387-98957-0}, Publisher = {Springer-Verlag}, Abstract = {A comprehensive guide to the use of the `nlme' package for linear and nonlinear mixed-effects models.}, } @article{bates04:_linear, Author = {Douglas M. Bates and Saikat DebRoy}, Journal = {Journal of Multivariate Analysis}, doi = {10.1016/j.jmva.2004.04.013}, Number = 1, Pages = {1--17}, Title = {Linear Mixed Models and Penalized Least Squares}, Volume = 91, Year = 2004} @article{gelman2005analysis, title = {Analysis of Variance --- Why it is More Important than Ever}, author = {Gelman, Andrew}, journal = {The Annals of Statistics}, volume = 33, number = 1, pages = {1--53}, year = 2005, doi = {10.1214/009053604000001048}, publisher = {Institute of Mathematical Statistics} } @ARTICLE{1977EfronAndMorris, author = {{Efron}, B. and {Morris}, C.}, title = "{Stein's Paradox in Statistics}", journal = {Scientific American}, year = 1977, month = may, volume = 236, pages = {119-127}, doi = {10.1038/scientificamerican0577-119}, adsurl = {http://adsabs.harvard.edu/abs/1977SciAm.236e.119E}, adsnote = {Provided by the SAO/NASA Astrophysics Data System} } @article{henderson_1982, author = {Charles R. {Henderson Jr.}}, Title = {Analysis of Covariance in the Mixed Model: Higher-Level, Nonhomogeneous, and Random Regressions}, Journal = {Biometrics}, Year = 1982, Volume = 38, Number = 3, Pages = {623--640}, Language = {English}, Publisher = {International Biometric Society}, Url = {http://www.jstor.org/stable/2530044}, } @article{golub_pereyra_1973, Author = {Golub, G. H. and Pereyra, V.}, Title = {The Differentiation of Pseudo-Inverses and Nonlinear Least Squares Problems Whose Variables Separate}, Year = 1973, Journal = {SIAM Journal on Numerical Analysis}, Volume = 10, Number = 2, Pages = {413--432}, doi = {10.1137/0710036}, } @article{sleepstudy, Author = {Gregory Belenky and Nancy J. Wesensten and David R. Thorne and Maria L. Thomas and Helen C. Sing and Daniel P. Redmond and Michael B. Russo and Thomas J. Balkin}, Date-Modified = {2014-02-14 21:07:17 +0000}, Journal = {Journal of Sleep Research}, Pages = {1--12}, Title = {Patterns of Performance Degradation and Restoration During Sleep Restriction and Subsequent Recovery: A Sleep Dose-Response Study}, Volume = 12, Year = 2003, doi = {10.1046/j.1365-2869.2003.00337.x}, } @article{Chen:2008:ACS:1391989.1391995, author = {Chen, Yanqing and Davis, Timothy A. and Hager, William W. and Rajamanickam, Sivasankaran}, title = {Algorithm 887: CHOLMOD, Supernodal Sparse Cholesky Factorization and Update/Downdate}, journal = {ACM Trans. Math. Softw.}, year = 2008, volume = 35, number = 3, month = oct, issn = {0098-3500}, pages = {22:1--22:14}, articleno = 22, doi = {10.1145/1391989.1391995}, publisher = {ACM}, address = {New York, NY, USA}, keywords = {Cholesky factorization, linear equations, sparse matrices}, } @article{kenward_small_1997, author = {M. G Kenward and J. H Roger}, title = {Small Sample Inference for Fixed Effects from Restricted Maximum Likelihood}, year = {1997}, journal = {Biometrics}, volume = {53}, number = {3}, pages = {983--997}, abstract = {Restricted maximum likelihood {(REML)} is now well established as a method for estimating the parameters of the general Gaussian linear model with a structured covariance matrix, in particular for mixed linear models. Conventionally, estimates of precision and inference for fixed effects are based on their asymptotic distribution, which is known to be inadequate for some small-sample problems. In this paper, we present a scaled Wald statistic, together with an F approximation to its sampling distribution, that is shown to perform well in a range of small sample settings. The statistic uses an adjusted estimator of the covariance matrix that has reduced small sample bias. This approach has the advantage that it reproduces both the statistics and F distributions in those settings where the latter is exact, namely for Hotelling T\${\textasciicircum}2\$ type statistics and for analysis of variance F-ratios. The performance of the modified statistics is assessed through simulation studies of four different {REML} analyses and the methods are illustrated using three examples.}, doi = {10.2307/2533558}, } @Article{Satterthwaite_1946, author = {F. E. Satterthwaite}, title = {An Approximate Distribution of Estimates of Variance Components}, journal = {Biometrics Bulletin}, year = 1946, volume = 2, number = 6, pages = {110-114}, doi = {10.2307/3002019}, } @Manual{gamm4, title = {\pkg{gamm4}: Generalized Additive Mixed Models Using \pkg{mgcv} and \pkg{lme4}}, author = {Simon Wood and Fabian Scheipl}, year = 2014, note = {\proglang{R} package version 0.2-3}, url = {http://CRAN.R-project.org/package=gamm4}, } @Manual{blme, title = {\pkg{blme}: {Bayesian} Linear Mixed-Effects Models}, author = {Vincent Dorie}, year = 2015, note = {R package version 1.0-4}, url = {http://CRAN.R-project.org/package=blme}, } @Article{blme2, title = {A Nondegenerate Penalized Likelihood Estimator for Variance Parameters in Multilevel Models}, author = {Yeojin Chung and Sophia Rabe-Hesketh and Vincent Dorie and Andrew Gelman and Jingchen Liu}, year = 2013, journal = {Psychometrika}, volume = 78, number = 4, pages = {685--709}, } @article{doran2007estimating, author={Doran, Harold and Bates, Douglas and Bliese, Paul and Dowling, Maritza}, title={Estimating the Multilevel {Rasch} Model: With the \pkg{lme4} Package}, year=2007, journal={Journal of Statistical Software}, volume=20, number=2, pages={1--18}, doi = {10.18637/jss.v020.i02}, publisher={American Statistical Association}, } @TechReport{Powell_bobyqa, author = {M. J. D. Powell}, title = {The {BOBYQA} Algorithm for Bound Constrained Optimization without Derivatives}, institution = {Centre for Mathematical Sciences, University of Cambridge}, year = {2009}, number = {DAMTP 2009/NA06}, address = {Cambridge, England}, url = {http://www.damtp.cam.ac.uk/user/na/NA_papers/NA2009_06.pdf} } @article{pinheiro_unconstrained_1996, title = {Unconstrained Parametrizations for Variance-Covariance Matrices}, volume = {6}, doi = {10.1007/BF00140873}, abstract = {The estimation of variance-covariance matrices through optimization of an objective function, such as a log-likelihood function, is usually a difficult numerical problem. Since the estimates should be positive semi-definite matrices, we must use constrained optimization, or employ a parametrization that enforces this condition. We describe here five different parametrizations for variance-covariance matrices that ensure positive definiteness, thus leaving the estimation problem unconstrained. We compare the parametrizations based on their computational efficiency and statistical interpretability. The results described here are particularly useful in maximum likelihood and restricted maximum likelihood estimation in linear and non-linear mixed-effects models, but are also applicable to other areas of statistics.}, number = {3}, urldate = {2010-01-05}, journal = {Statistics and Computing}, author = {Pinheiro, José C. and Bates, Douglas M.}, year = {1996}, pages = {289--296} } @article{bolker_strategies_2013, title = {Strategies for Fitting Nonlinear Ecological Models in \proglang{R}, \pkg{AD Model Builder}, and \proglang{BUGS}}, volume = 4, doi = {10.1111/2041-210X.12044}, number = 6, urldate = {2013-06-11}, journal = {Methods in Ecology and Evolution}, author = {Bolker, Benjamin M. and Gardner, Beth and Maunder, Mark and Berg, Casper W. and Brooks, Mollie and Comita, Liza and Crone, Elizabeth and Cubaynes, Sarah and Davies, Trevor and de Valpine, Perry and Ford, Jessica and Gimenez, Olivier and Kéry, Marc and Kim, Eun Jung and Lennert-Cody, Cleridy and Magnusson, Arni and Martell, Steve and Nash, John and Nielsen, Anders and Regetz, Jim and Skaug, Hans and Zipkin, Elise}, editor = {Ramula, Satu}, month = jun, year = 2013, pages = {501--512}, pdf={bbpapers/bolker_strategies_2013.pdf} } @Article{Klein_nelder_2013, author = {Kyle Klein and Julian Neira}, title = {{Nelder-Mead} Simplex Optimization Routine for Large-Scale Problems: A Distributed Memory Implementation}, journal = {Computational Economics}, year = 2013, doi = {10.1007/s10614-013-9377-8} } @Misc{merBoot, author = {José A. Sánchez-Espigares and Jordi Ocaña}, title = {An \proglang{R} Implementation of Bootstrap Procedures for Mixed Models}, howpublished = {Conference presentation, useR!}, month = {July}, year = {2009}, note = {accessed 25 May 2014}, url = {http://www.r-project.org/conferences/useR-2009/slides/SanchezEspigares+Ocana.pdf} } @book{gelman_data_2006, address = {Cambridge, England}, title = {Data Analysis Using Regression and {Multilevel/Hierarchical} Models}, url = {http://www.stat.columbia.edu/~gelman/arm/}, publisher = {Cambridge University Press}, author = {Gelman, Andrew and Hill, Jennifer}, year = {2006}, keywords = {uploaded} } @article{khatri1968solutions, title={Solutions to Some Functional Equations and their Applications to Characterization of Probability Distributions}, author={Khatri, CG and Rao, C Radhakrishna}, journal={Sankhy{\=a}: The Indian Journal of Statistics A}, pages={167--180}, volume = 30, number = 2, year = 1968, } @incollection{zhang2006schur, year={2005}, booktitle={The Schur Complement and its Applications}, volume={4}, series={Numerical Methods and Algorithms}, editor={Zhang, Fuzhen}, title={Basic Properties of the Schur Complement}, doi = {10.1007/0-387-24273-2_2}, publisher={Springer-Verlag}, author={Horn, RogerA. and Zhang, Fuzhen}, pages={17--46} } @book{gelman2013bayesian, title={Bayesian Data Analysis}, author={Gelman, Andrew and Carlin, John B and Stern, Hal S and Dunson, David B and Vehtari, Aki and Rubin, Donald B}, year={2013}, publisher={CRC press} } @Manual{Matrix_pkg, title = {\pkg{Matrix}: Sparse and Dense Matrix Classes and Methods}, author = {Douglas Bates and Martin Maechler}, year = 2015, note = {\proglang{R} package version 1.2-2}, url = {http://CRAN.R-project.org/package=Matrix}, } @Manual{minqa_pkg, title = {\pkg{minqa}: Derivative-Free Optimization Algorithms by Quadratic Approximation}, author = {Douglas Bates and Katharine M. Mullen and John C. Nash and Ravi Varadhan}, year = {2014}, note = {\proglang{R} package version 1.2.4}, url = {http://CRAN.R-project.org/package=minqa}, } @Article{optimx_pkg, author = {John C. Nash and Ravi Varadhan}, title = {Unifying Optimization Algorithms to Aid Software System Users: \pkg{optimx} for \proglang{R}}, journal = {Journal of Statistical Software}, year = 2011, volume = 43, number = 9, pages = {1--14}, doi = {10.18637/jss.v043.i09}, url = {http://www.jstatsoft.org/v43/i09/}, } @Misc{NLopt, author = {Steven G. Johnson}, title = {The \pkg{NLopt} Nonlinear-Optimization Package}, year = {2014}, url = {http://ab-initio.mit.edu/nlopt} } @Manual{nlme_pkg, title = {\pkg{nlme}: Linear and Nonlinear Mixed Effects Models}, author = {Jose Pinheiro and Douglas Bates and Saikat DebRoy and Deepayan Sarkar and {\proglang{R} Core Team}}, year = 2014, note = {\proglang{R} package version 3.1-117}, url = {http://CRAN.R-project.org/package=nlme}, } @Article{HLMdiag_pkg, title = {\pkg{HLMdiag}: A Suite of Diagnostics for Hierarchical Linear Models in \proglang{R}}, author = {Adam Loy and Heike Hofmann}, journal = {Journal of Statistical Software}, year = 2014, volume = 56, number = 5, pages = {1--28}, doi = {10.18637/jss.v056.i05}, url = {http://www.jstatsoft.org/v56/i05/}, } @Article{influenceME_pkg, title = {\proglang{Influence.ME}: Tools for Detecting Influential Data in Mixed Effects Models}, author = {Rense Nieuwenhuis and Manfred {Te Grotenhuis} and Ben Pelzer}, year = 2012, journal = {R Journal}, volume = 4, number = 2, pages = {38-47}, } @Manual{boot_pkg, author = {Angelo Canty and Brian Ripley}, year = 2015, title = { \pkg{boot}: Bootstrap \proglang{R} (\proglang{S-PLUS}) Functions}, note = {\proglang{R} package version 1.3-17}, url = {http://CRAN.R-project.org/package=boot} } @Book{DavisonHinkley1997, author = {A. C. Davison and D. V. Hinkley}, title = {Bootstrap Methods and Their Applications}, year = 1997, publisher = {Cambridge University Press}, ISBN = {0-521-57391-2}, address = {Cambridge, England} } @article{vaida2005conditional, title={Conditional Akaike Information for Mixed-Effects Models}, author={Vaida, Florin and Blanchard, Suzette}, journal={Biometrika}, volume={92}, number={2}, pages={351--370}, year={2005}, doi = {10.1093/biomet/92.2.351}, publisher={Biometrika Trust} } @book{cook1982residuals, title={Residuals and Influence in Regression}, author={Cook, R Dennis and Weisberg, Sanford}, year={1982}, publisher={New York: Chapman and Hall} } @comment -------- Software manuals, mostly R and R packages --------- @Manual{lme4, title = {\pkg{lme4}: Linear Mixed-Effects Models Using \pkg{Eigen} and \proglang{S}4}, author = {Douglas Bates and Martin Maechler and Ben Bolker and Steven Walker}, year = 2014, note = {\proglang{R} package version 1.1-7}, url = {http://CRAN.R-project.org/package=lme4}, } @Manual{R, title = {\proglang{R}: A Language and Environment for Statistical Computing}, author = {{\proglang{R} Core Team}}, organization = {\proglang{R} Foundation for Statistical Computing}, address = {Vienna, Austria}, year = 2015, url = {http://www.R-project.org/}, } @Unpublished{Julia, title = {\proglang{Julia}: A Fast Dynamic Language for Technical Computing}, author = {Jeff Bezanson and Stefan Karpinski and Viral B. Shah and Alan Edelman}, year = 2012, url = {http://arxiv.org/abs/1209.5145}, note = {{arXiv}:1209.5145 [cs.PL]}, } @Manual{MixedModels, title = {\pkg{MixedModels}: A \proglang{Julia} Package for Fitting (Statistical) Mixed-Effects Models}, author = {Douglas Bates}, year = 2015, note = {\proglang{Julia} package version 0.3-22}, url = {https://github.com/dmbates/MixedModels.jl}, } @Manual{lme4pureR, title = {\pkg{lme4pureR}: \pkg{lme4} in Pure \proglang{R}}, author = {Douglas Bates and Steven Walker}, year = 2013, note = {\proglang{R} package version 0.1-0}, url = {https://github.com/lme4/lme4pureR}, } @Manual{Eigen, title = {\pkg{Eigen}3}, author = {G Guennebaud and B Jacob and {and others}}, year = 2015, url = {http://eigen.tuxfamily.org/}, } @Manual{SuiteSparse, title = {\pkg{SuiteSparse}: A Suite of Sparse Matrix Software}, author = {Timothy A. Davis and others}, year = 2015, note = {Version 4.4-5}, url = {http://www.suitesparse.com/}, } @Book{lattice, title = {\pkg{lattice}: Multivariate Data Visualization with \proglang{R}}, author = {Deepayan Sarkar}, publisher = {Springer-Verlag}, address = {New York}, year = 2008, url = {http://lmdvr.R-Forge.R-project.org}, } lme4/vignettes/Theory.Rnw0000644000176200001440000015056114063503234015075 0ustar liggesusers%%\VignetteIndexEntry{Computational Methods} %%\VignetteDepends{lme4} %%\VignetteEngine{knitr::knitr} \documentclass[12pt]{article} \usepackage{amsmath,amsfonts,bm} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \title{Computational methods for mixed models} \author{Douglas Bates\\Department of Statistics\\% University of Wisconsin -- Madison} \newcommand{\code}[1]{\texttt{\small{#1}}} \newcommand{\package}[1]{\textsf{\small{#1}}} \newcommand{\trans}{\ensuremath{^\prime}} \renewcommand{\vec}{\operatorname{vec}} \newcommand{\diag}{\operatorname{diag}} \newcommand{\bc}[1]{\ensuremath{\bm{\mathcal{#1}}}} <>= knitr::opts_chunk$set(include=FALSE) options(width=65,digits=5) #library(lme4) @ \begin{document} \maketitle \begin{abstract} The \package{lme4} package provides R functions to fit and analyze several different types of mixed-effects models, including linear mixed models, generalized linear mixed models and nonlinear mixed models. In this vignette we describe the formulation of these models and the computational approach used to evaluate or approximate the log-likelihood of a model/data/parameter value combination. \end{abstract} \section{Introduction} \label{sec:intro} The \package{lme4} package provides \code{R} functions to fit and analyze linear mixed models, generalized linear mixed models and nonlinear mixed models. These models are called \emph{mixed-effects models} or, more simply, \emph{mixed models} because they incorporate both \emph{fixed-effects} parameters, which apply to an entire population or to certain well-defined and repeatable subsets of a population, and \emph{random effects}, which apply to the particular experimental units or observational units in the study. Such models are also called \emph{multilevel} models because the random effects represent levels of variation in addition to the per-observation noise term that is incorporated in common statistical models such as linear regression models, generalized linear models and nonlinear regression models. We begin by describing common properties of these mixed models and the general computational approach used in the \package{lme4} package. The estimates of the parameters in a mixed model are determined as the values that optimize an objective function --- either the likelihood of the parameters given the observed data, for maximum likelihood (ML) estimates, or a related objective function called the REML criterion. Because this objective function must be evaluated at many different values of the model parameters during the optimization process, we focus on the evaluation of the objective function and a critical computation in this evalution --- determining the solution to a penalized, weighted least squares (PWLS) problem. The dimension of the solution of the PWLS problem can be very large, perhaps in the millions. Furthermore, such problems must be solved repeatedly during the optimization process to determine parameter estimates. The whole approach would be infeasible were it not for the fact that the matrices determining the PWLS problem are sparse and we can use sparse matrix storage formats and sparse matrix computations \citep{davis06:csparse_book}. In particular, the whole computational approach hinges on the extraordinarily efficient methods for determining the Cholesky decomposition of sparse, symmetric, positive-definite matrices embodied in the CHOLMOD library of C functions \citep{Cholmod}. % The three types of mixed models -- linear, generalized linear and % nonlinear -- share common characteristics in that the model is % specified in whole or in part by a \emph{mixed model formula} that % describes a \emph{linear predictor} and a variance-covariance % structure for the random effects. In the next section we describe % the mixed model formula and the forms of these matrices. The % following section presents a general formulation of the Laplace % approximation to the log-likelihood of a mixed model. % In subsequent sections we describe computational methods for specific % kinds of mixed models. In particular, we should how a profiled % log-likelihood for linear mixed models, and for some nonlinear mixed % models, can be evaluated exactly. In the next section we describe the general form of the mixed models that can be represented in the \package{lme4} package and the computational approach embodied in the package. In the following section we describe a particular form of mixed model, called a linear mixed model, and the computational details for those models. In the fourth section we describe computational methods for generalized linear mixed models, nonlinear mixed models and generalized nonlinear mixed models. \section{Formulation of mixed models} \label{sec:form-mixed-models} A mixed-effects model incorporates two vector-valued random variables: the $n$-dimensional response vector, $\bc Y$, and the $q$-dimensional random effects vector, $\bc B$. We observe the value, $\bm y$, of $\bc Y$. We do not observe the value of $\bc B$. The random variable $\bc Y$ may be continuous or discrete. That is, the observed data, $\bm y$, may be on a continuous scale or they may be on a discrete scale, such as binary responses or responses representing a count. In our formulation, the random variable $\bc B$ is always continous. We specify a mixed model by describing the unconditional distribution of $\bc B$ and the conditional distribution $(\bc Y|\bc B=\bm b)$. \subsection{The unconditional distribution of $\bc B$} \label{sec:uncond-distr-B} In our formulation, the unconditional distribution of $\bc B$ is always a $q$-dimensional multivariate Gaussian (or ``normal'') distribution with mean $\bm 0$ and with a parameterized covariance matrix, \begin{equation} \label{eq:2} \bc B\sim\mathcal{N}\left(\bm 0,\sigma^2\bm\Lambda(\bm\theta) \bm\Lambda\trans(\bm\theta)\right) . \end{equation} The scalar, $\sigma$, in (\ref{eq:2}), is called the \emph{common scale parameter}. As we will see later, not all types of mixed models incorporate this parameter. We will include $\sigma^2$ in the general form of the unconditional distribution of $\bc B$ with the understanding that, in some models, $\sigma\equiv 1$. The $q\times q$ matrix $\bm\Lambda(\bm\theta)$, which is a left factor of the covariance matrix (when $\sigma=1$) or the relative covariance matrix (when $\sigma\ne 1$), depends on an $m$-dimensional parameter $\bm\theta$. Typically $m\ll q$; in the examples we show below it is always the case that $m<5$, even when $q$ is in the thousands. The fact that $m$ is very small is important because, as we shall see, determining the parameter estimates in a mixed model can be expressed as an optimization problem with respect to $\bm\theta$ only. The parameter $\bm\theta$ may be, and typically is, subject to constraints. For ease of computation, we require that the constraints be expressed as ``box'' constraints of the form $\theta_{iL}\le\theta_i\le\theta_{iU},i=1,\dots,m$ for constants $\theta_{iL}$ and $\theta_{iU}, i=1,\dots,m$. We shall write the set of such constraints as $\bm\theta_L\le\bm\theta\le\bm\theta_R$. The matrix $\bm\Lambda(\bm\theta)$ is required to be non-singular (i.e.{} invertible) when $\bm\theta$ is not on the boundary. \subsection{The conditional distribution, $(\bc Y|\bc B=\bm b)$} \label{sec:cond-distr-YB} The conditional distribution, $(\bc Y|\bc B=\bm b)$, must satisfy: \begin{enumerate} \item The conditional mean, $\bm\mu_{\bc Y|\bc B}(\bm b) = \mathrm{E}[\bc Y|\bc B=\bm b]$, depends on $\bm b$ only through the value of the \emph{linear predictor}, $\bm Z\bm b+\bm X\bm\beta$, where $\bm\beta$ is the $p$-dimensional \emph{fixed-effects} parameter vector and the \emph{model matrices}, $\bm Z$ and $\bm X$, are fixed matrices of the appropriate dimension. That is, the two model matrices must have the same number of rows and must have $q$ and $p$ columns, respectively. The number of rows in $\bm Z$ and $\bm X$ is a multiple of $n$, the dimension of $\bm y$. \item The scalar distributions, $(\mathcal{Y}_i|\bc B=\bm b),i=1,\dots,n$, all have the same form and are completely determined by the conditional mean, $\bm\mu_{\bc Y|\bc B}(\bm b)$ and, at most, one additional parameter, $\sigma$, which is the common scale parameter. \item The scalar distributions, $(\mathcal{Y}_i|\bc B=\bm b),i=1,\dots,n$, are independent. That is, the components of $\bc Y$ are \emph{conditionally independent} given $\bc B$. \end{enumerate} An important special case of the conditional distribution is the multivariate Gaussian distribution of the form \begin{equation} \label{eq:1} (\bc Y|\bc B=\bm b)\sim\mathcal{N}(\bm Z\bm b+\bm X\bm\beta,\sigma^2\bm I_n) \end{equation} where $\bm I_n$ denotes the identity matrix of size $n$. In this case the conditional mean, $\bm\mu_{\bc Y|\bc B}(\bm b)$, is exactly the linear predictor, $\bm Z\bm b+\bm X\bm\beta$, a situation we will later describe as being an ``identity link'' between the conditional mean and the linear predictor. Models with conditional distribution (\ref{eq:1}) are called \emph{linear mixed models}. \subsection{A change of variable to ``spherical'' random effects} \label{sec:change-vari-spher} Because the conditional distribution $(\bc Y|\bc B=\bm b)$ depends on $\bm b$ only through the linear predictor, it is easy to express the model in terms of a linear transformation of $\bc B$. We define the linear transformation from a $q$-dimensional ``spherical'' Gaussian random variable, $\bc U$, to $\bc B$ as \begin{equation} \label{eq:3} \bc B=\bm\Lambda(\bm\theta)\bc U,\quad \bc U\sim\mathcal{N}(\bm 0,\sigma^2\bm I_q). \end{equation} (The term ``spherical'' refers to the fact that contours of constant probability density for $\bc U$ are spheres centered at the mean --- in this case, $\bm0$.) When $\bm\theta$ is not on the boundary this is an invertible transformation. When $\bm\theta$ is on the boundary the transformation can fail to be invertible. However, we will only need to be able to express $\bc B$ in terms of $\bc U$ and that transformation is well-defined, even when $\bm\theta$ is on the boundary. The linear predictor, as a function of $\bm u$, is \begin{equation} \label{eq:4} \bm\gamma(\bm u)=\bm Z\bm\Lambda(\bm\theta)\bm u + \bm X\bm\beta. \end{equation} When we wish to emphasize the role of the model parameters, $\bm\theta$ and $\bm\beta$, in the formulation of $\bm\gamma$, we will write the linear predictor as $\bm\gamma(\bm u,\bm\theta,\bm\beta)$. \subsection{The conditional density $(\bc U|\bc Y=\bm y)$} \label{sec:cond-dens-bc} Because we observe $\bm y$ and do not observe $\bm b$ or $\bm u$, the conditional distribution of interest, for the purposes of statistical inference, is $(\bc U|\bc Y=\bm y)$ (or, equivalently, $(\bc B|\bc Y=\bm y)$). This conditional distribution is always a continuous distribution with conditional probability density $f_{\bc U|\bc Y}(\bm u|\bm y)$. We can evaluate $f_{\bc U|\bc Y}(\bm u|\bm y)$ , up to a constant, as the product of the unconditional density, $f_{\bc U}(\bm u)$, and the conditional density (or the probability mass function, whichever is appropriate), $f_{\bc Y|\bc U}(\bm y|\bm u)$. We write this unnormalized conditional density as \begin{equation} \label{eq:5} h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma) = f_{\bc Y|\bc U}(\bm y|\bm u,\bm\theta,\bm\beta,\sigma) f_{\bc U}(\bm u|\sigma) . \end{equation} We say that $h$ is the ``unnormalized'' conditional density because all we know is that the conditional density is proportional to $h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma)$. To obtain the conditional density we must normalize $h$ by dividing by the value of the integral \begin{equation} \label{eq:6} L(\bm\theta,\bm\beta,\sigma|\bm y) = \int_{\mathbb{R}^q}h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma)\,d\bm u . \end{equation} We write the value of the integral (\ref{eq:6}) as $L(\bm\theta,\bm\beta,\sigma|\bm y)$ because it is exactly the \emph{likelihood} of the parameters $\bm\theta$, $\bm\beta$ and $\sigma$, given the observed data $\bm y$. The \emph{maximum likelihood (ML) estimates} of these parameters are the values that maximize $L$. \subsection{Determining the ML estimates} \label{sec:DeterminingML} The general problem of maximizing $L(\bm\theta,\bm\beta,\sigma|\bm y)$ with respect to $\bm\theta$, $\bm\beta$ and $\sigma$ can be formidable because each evaluation of this function involves a potentially high-dimensional integral and because the dimension of $\bm\beta$ can be large. However, this general optimization problem can be split into manageable subproblems. Given a value of $\bm\theta$ we can determine the \emph{conditional mode}, $\tilde{\bm u}(\bm\theta)$, of $\bm u$ and the \emph{conditional estimate}, $\tilde{\bm\beta}(\bm\theta)$ simultaneously using \emph{penalized, iteratively re-weighted least squares} (PIRLS). The conditional mode and the conditional estimate are defined as \begin{equation} \label{eq:condmode} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\ \tilde{\bm\beta}(\bm\theta) \end{bmatrix}=\arg\max_{\bm u,\bm\beta}h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma) . \end{equation} (It may look as if we have missed the dependence on $\sigma$ on the left-hand side but it turns out that the scale parameter does not affect the location of the optimal values of quantities in the linear predictor.) As is common in such optimization problems, we re-express the conditional density on the \emph{deviance scale}, which is negative twice the logarithm of the density, where the optimization becomes \begin{equation} \label{eq:condmode2} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\ \tilde{\bm\beta}(\bm\theta) \end{bmatrix}=\arg\min_{\bm u,\bm\beta}-2\log\left(h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma)\right) . \end{equation} It is this optimization problem that can be solved quite efficiently using PIRLS. In fact, for linear mixed models, which are described in the next section, $\tilde{\bm u}(\bm\theta)$ and $\tilde{\bm\beta}(\bm\theta)$ can be directly evaluated. The second-order Taylor series expansion of $-2\log h$ at $\tilde{\bm u}(\bm\theta)$ and $\tilde{\bm\beta}(\bm\theta)$ provides the Laplace approximation to the profiled deviance. Optimizing this function with respect to $\bm\theta$ provides the ML estimates of $\bm\theta$, from which the ML estimates of $\bm\beta$ and $\sigma$ (if used) are derived. \section{Methods for linear mixed models} \label{sec:pwls-problem} As indicated in the introduction, a critical step in our methods for determining the maximum likelihood estimates of the parameters in a mixed model is solving a penalized, weighted least squares (PWLS) problem. We will motivate the general form of the PWLS problem by first considering computational methods for linear mixed models that result in a penalized least squares (PLS) problem. Recall from \S\ref{sec:cond-distr-YB} that, in a linear mixed model, both the conditional distribution, $(\bc Y|\bc U=\bm u)$, and the unconditional distribution, $\bc U$, are spherical Gaussian distributions and that the conditional mean, $\bm\mu_{\bc Y|\bc U}(\bm u)$, is the linear predictor, $\bm\gamma(\bm u)$. Because all the distributions determining the model are continuous distributions, we consider their densities. On the deviance scale these are \begin{equation} \label{eq:7} \begin{aligned} -2\log(f_{\bc U}(\bm u))&=q\log(2\pi\sigma^2)+\frac{\|\bm u\|^2}{\sigma^2}\\ -2\log(f_{\bc Y|\bc U}(\bm y|\bm u))&=n\log(2\pi\sigma^2)+ \frac{\|\bm y-\bm Z\bm\Lambda(\bm\theta)\bm u-\bm X\bm\beta\|^2}{\sigma^2}\\ -2\log(h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma)) &= (n+q)\log(2\pi\sigma^2)+ \frac{\|\bm y-\bm\gamma(\bm u,\bm\theta,\bm\beta)\|^2+\|\bm u\|^2}{\sigma^2}\\ &= (n+q)\log(2\pi\sigma^2)+ \frac{d(\bm u|\bm y,\bm\theta,\bm\beta)}{\sigma^2} \end{aligned} \end{equation} In (\ref{eq:7}) the \emph{discrepancy} function, \begin{equation} \label{eq:9} d(\bm u|\bm y,\bm\theta,\bm\beta) = \|\bm y-\bm\gamma(\bm u,\bm\theta,\bm\beta)\|^2+\|\bm u\|^2 \end{equation} has the form of a penalized residual sum of squares in that the first term, $\|\bm y-\bm\gamma(\bm u,\bm\theta,\bm\beta)\|^2$ is the residual sum of squares for $\bm y$, $\bm u$, $\bm\theta$ and $\bm\beta$ and the second term, $\|\bm u\|^2$, is a penalty on the size of $\bm u$. Notice that the discrepancy does not depend on the common scale parameter, $\sigma$. \subsection{The canonical form of the discrepancy} \label{sec:conditional-mode-bm} Using a so-called ``pseudo data'' representation, we can write the discrepancy as a residual sum of squares for a regression model that is linear in both $\bm u$ and $\bm\beta$ \begin{equation} \label{eq:10} d(\bm u|\bm y,\bm\theta,\bm\beta) =\left\| \begin{bmatrix} \bm y\\\bm 0 \end{bmatrix} - \begin{bmatrix} \bm Z\bm\Lambda(\bm\theta) & \bm X \\ \bm I_q & \bm0 \end{bmatrix} \begin{bmatrix}\bm u\\\bm\beta\end{bmatrix} \right\|^2 . \end{equation} The term ``pseudo data'' reflects the fact that we have added $q$ ``pseudo observations'' to the observed response, $\bm y$, and to the linear predictor, $\bm\gamma(\bm u,\bm\theta,\bm\beta)=\bm Z\bm\Lambda(\bm\theta)\bm u+\bm X\bm\beta$, in such a way that their contribution to the overall residual sum of squares is exactly the penalty term in the discrepancy. In the form (\ref{eq:10}) we can see that the discrepancy is a quadratic form in both $\bm u$ and $\bm\beta$. Furthermore, because we require that $\bm X$ has full column rank, the discrepancy is a positive-definite quadratic form in $\bm u$ and $\bm\beta$ that is minimized at $\tilde{\bm u}(\bm\theta)$ and $\tilde{\bm\beta}(\bm\theta)$ satisfying \begin{equation} \label{eq:13} \begin{bmatrix} \bm\Lambda\trans(\bm\theta)\bm Z\trans\bm Z\bm\Lambda(\theta) +\bm I_q&\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm X\\ \bm X\trans\bm Z\bm\Lambda(\theta) &\bm X\trans\bm X \end{bmatrix} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\\tilde{\bm\beta}(\bm\theta) \end{bmatrix} = \begin{bmatrix} \bm\Lambda\trans(\bm\theta)\bm Z\trans\bm y\\ \bm X\trans\bm y \end{bmatrix} \end{equation} An effective way of determining the solution to a sparse, symmetric, positive definite system of equations such as (\ref{eq:13}) is the sparse Cholesky decomposition \citep{davis06:csparse_book}. If $\bm A$ is a sparse, symmetric positive definite matrix then the sparse Cholesky factor with fill-reducing permutation $\bm P$ is the lower-triangular matrix $\bm L$ such that \begin{equation} \label{eq:14} \bm L\bm L\trans=\bm P\bm A\bm P\trans . \end{equation} (Technically, the factor $\bm L$ is only determined up to changes in the sign of the diagonal elements. By convention we require the diagonal elements to be positive.) The fill-reducing permutation represented by the permutation matrix $\bm P$, which is determined from the pattern of nonzeros in $\bm A$ but does not depend on particular values of those nonzeros, can have a profound impact on the number of nonzeros in $\bm L$ and hence on the speed with which $\bm L$ can be calculated from $\bm A$. In most applications of linear mixed models the matrix $\bm Z\bm\Lambda(\bm\theta)$ is sparse while $\bm X$ is dense or close to it so the permutation matrix $\bm P$ can be restricted to the form \begin{equation} \label{eq:15} \bm P=\begin{bmatrix}\bm P_{\bm Z}&\bm0\\ \bm0&\bm P_{\bm X}\end{bmatrix} \end{equation} without loss of efficiency. In fact, in most cases we can set $\bm P_{\bm X}=\bm I_p$ without loss of efficiency. Let us assume that the permutation matrix is required to be of the form (\ref{eq:15}) so that we can write the Cholesky factorization for the positive definite system (\ref{eq:13}) as \begin{multline} \label{eq:16} \begin{bmatrix} \bm L_{\bm Z}&\bm0\\\bm L_{\bm{XZ}}&\bm L_{\bm X} \end{bmatrix} \begin{bmatrix} \bm L_{\bm Z}&\bm0\\\bm L_{\bm{XZ}}&\bm L_{\bm X} \end{bmatrix}\trans =\\ \begin{bmatrix}\bm P_{\bm Z}&\bm0\\ \bm0&\bm P_{\bm X}\end{bmatrix} \begin{bmatrix} \bm\Lambda\trans(\bm\theta)\bm Z\trans\bm Z\bm\Lambda(\theta) +\bm I_q&\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm X\\ \bm X\trans\bm Z\bm\Lambda(\theta) &\bm X\trans\bm X \end{bmatrix} \begin{bmatrix}\bm P_{\bm Z}&\bm0\\ \bm0&\bm P_{\bm X}\end{bmatrix}\trans . \end{multline} The discrepancy can now be written in the canonical form \begin{equation} \label{eq:17} d(\bm u|\bm y,\bm\theta,\bm\beta) =\tilde{d}(\bm y,\bm\theta) + \left\| \begin{bmatrix} \bm L_{\bm Z}\trans&\bm L_{\bm{XZ}}\trans\\ \bm 0&\bm L_{\bm X}\trans \end{bmatrix} \begin{bmatrix} \bm P_{\bm Z}(\bm u-\tilde{\bm u})\\ \bm P_{\bm X}(\bm\beta-\tilde{\bm\beta}) \end{bmatrix} \right\|^2 \end{equation} where \begin{equation} \label{eq:18} \tilde{d}(\bm y,\bm\theta)= d(\tilde{\bm u}(\bm\theta)|\bm y,\bm\theta,\tilde{\bm\beta}(\bm\theta)) \end{equation} is the minimum discrepancy, given $\bm\theta$. \subsection{The profiled likelihood for linear mixed models} \label{sec:prof-log-likel} Substituting (\ref{eq:17}) into (\ref{eq:7}) provides the unnormalized conditional density $h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma)$ on the deviance scale as \begin{multline} \label{eq:32} -2\log(h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma))\\= (n+q)\log(2\pi\sigma^2)+\frac{\tilde{d}(\bm y,\bm\theta) + \left\| \begin{bmatrix} \bm L_{\bm Z}\trans&\bm L_{\bm{XZ}}\trans\\ \bm 0&\bm L_{\bm X}\trans \end{bmatrix} \begin{bmatrix} \bm P_{\bm Z}(\bm u-\tilde{\bm u})\\ \bm P_{\bm X}(\bm\beta-\tilde{\bm\beta}) \end{bmatrix} \right\|^2}{\sigma^2} . \end{multline} As shown in Appendix \ref{sec:integr-quadr-devi}, the integral of a quadratic form on the deviance scale, such as (\ref{eq:32}), is easily evaluated, providing the log-likelihood, $\ell(\bm\theta,\bm\beta,\sigma|\bm y)$, as \begin{multline} \label{eq:lmmdev} -2\ell(\bm\theta,\bm\beta,\sigma|\bm y)\\ =-2\log\left(L(\bm\theta,\bm\beta,\sigma|\bm y)\right)\\ =n\log(2\pi\sigma^2)+\log(|\bm L_{\bm Z}|^2)+\frac{\tilde{d}(\bm y,\bm\theta) + \left\|\bm L_{\bm X}\trans\bm P_{\bm X}(\bm\beta-\tilde{\bm\beta})\right\|^2}{\sigma^2}, \end{multline} from which we can see that the conditional estimate of $\bm\beta$, given $\bm\theta$, is $\tilde{\bm\beta}(\bm\theta)$ and the conditional estimate of $\sigma$, given $\bm\theta$, is \begin{equation} \label{eq:condsigma} \tilde{\sigma^2}(\bm\theta)= \frac{\tilde{d}(\bm\theta|\bm y)}{n} . \end{equation} Substituting these conditional estimates into (\ref{eq:lmmdev}) produces the \emph{profiled likelihood}, $\tilde{L}(\bm\theta|\bm y)$, as \begin{equation} \label{eq:19} -2\tilde{\ell}(\bm\theta|\bm y))= \log(|\bm L_{\bm Z}(\bm\theta)|^2)+ n\left(1+\log\left(\frac{2\pi\tilde{d}(\bm y,\bm\theta)}{n}\right)\right) . \end{equation} The maximum likelihood estimate of $\bm\theta$ can then be expressed as \begin{equation} \label{eq:29} \widehat{\bm\theta}_L=\arg\min_{\bm\theta} \left(-2\tilde{\ell}(\bm\theta|\bm y)\right) . \end{equation} from which the ML estimates of $\sigma^2$ and $\bm\beta$ are evaluated as \begin{align} \label{eq:30} \widehat{\sigma^2_L}&= \frac{\tilde{d}(\widehat{\bm\theta}_L,\bm y)}{n}\\ \widehat{\bm\beta}_L&=\tilde{\bm\beta}(\widehat{\bm\theta}_L) . \end{align} The important thing to note about optimizing the profiled likelihood, (\ref{eq:19}), is that it is a $m$-dimensional optimization problem and typically $m$ is very small. \subsection{The REML criterion} \label{sec:reml-criterion} In practice the so-called REML estimates of variance components are often preferred to the maximum likelihood estimates. (``REML'' can be considered to be an acronym for ``restricted'' or ``residual'' maximum likelihood, although neither term is completely accurate because these estimates do not maximize a likelihood.) We can motivate the use of the REML criterion by considering a linear regression model, \begin{equation} \label{eq:20} \bc Y\sim\mathcal{N}(\bm X\bm\beta,\sigma^2\bm I_n), \end{equation} in which we typically estimate $\sigma^2$ by \begin{equation} \label{eq:21} \widehat{\sigma^2_R}=\frac{\|\bm y-\bm X\widehat{\bm\beta}\|^2}{n-p} \end{equation} even though the maximum likelihood estimate of $\sigma^2$ is \begin{equation} \label{eq:22} \widehat{\sigma^2_{L}}=\frac{\|\bm y-\bm X\widehat{\bm\beta}\|^2}{n} . \end{equation} The argument for preferring $\widehat{\sigma^2_R}$ to $\widehat{\sigma^2_{L}}$ as an estimate of $\sigma^2$ is that the numerator in both estimates is the sum of squared residuals at $\widehat{\bm\beta}$ and, although the residual vector $\bm y-\bm X\bm\beta$ is an $n$-dimensional vector, the residual at $\widehat{\bm\theta}$ satisfies $p$ linearly independent constraints, $\bm X\trans(\bm y-\bm X\widehat{\bm\beta})=\bm 0$. That is, the residual at $\widehat{\bm\theta}$ is the projection of the observed response vector, $\bm y$, into an $(n-p)$-dimensional linear subspace of the $n$-dimensional response space. The estimate $\widehat{\sigma^2_R}$ takes into account the fact that $\sigma^2$ is estimated from residuals that have only $n-p$ \emph{degrees of freedom}. The REML criterion for determining parameter estimates $\widehat{\bm\theta}_R$ and $\widehat{\sigma_R^2}$ in a linear mixed model has the property that these estimates would specialize to $\widehat{\sigma^2_R}$ from (\ref{eq:21}) for a linear regression model. Although not usually derived in this way, the REML criterion can be expressed as \begin{equation} \label{eq:23} c_R(\bm\theta,\bm\sigma|\bm y)=-2\log \int_{\mathbb{R}^p}L(\bm u|\bm y,\bm\theta,\bm\beta,\sigma)\,d\bm\beta \end{equation} on the deviance scale. The REML estimates $\widehat{\bm\theta}_R$ and $\widehat{\sigma_R^2}$ minimize $c_R(\bm\theta,\bm\sigma|\bm y)$. The profiled REML criterion, a function of $\bm\theta$ only, is \begin{equation} \label{eq:24} \tilde{c}_R(\bm\theta|\bm y)= \log(|\bm L_{\bm Z}(\bm\theta)|^2|\bm L_{\bm X}(\bm\theta)|^2)+(n-p) \left(1+\log\left(\frac{2\pi\tilde{d}(\bm\theta|\bm y)}{n-p}\right)\right) \end{equation} and the REML estimate of $\bm\theta$ is \begin{equation} \label{eq:31} \widehat{\bm\theta}_R = \arg\min_{\bm\theta}\tilde{c}_R(\bm\theta,\bm y) . \end{equation} The REML estimate of $\sigma^2$ is $\widehat{\sigma^2_R}=\tilde{d}(\widehat{\bm\theta}_R|\bm y)/(n-p)$. It is not entirely clear how one would define a ``REML estimate'' of $\bm\beta$ because the REML criterion, $c_R(\bm\theta,\bm\sigma|\bm y)$, defined in (\ref{eq:23}), does not depend on $\bm\beta$. However, it is customary (and not unreasonable) to use $\widehat{\bm\beta}_R=\tilde{\bm\beta}(\widehat{\bm\theta}_R)$ as the REML estimate of $\bm\beta$. Note that the profiled REML criterion can be evaluated from a sparse Cholesky decomposition like that in (\ref{eq:16}) but without the requirement that the permutation can be applied to the columns of $\bm Z\bm\Lambda(\bm\theta)$ separately from the columnns of $\bm X$. That is, we can use a general fill-reducing permutation rather than the specific form (\ref{eq:15}) with separate permutations represented by $\bm P_{\bm Z}$ and $\bm P_{\bm X}$. This can be useful in cases where both $\bm Z$ and $\bm X$ are large and sparse. \subsection{Summary for linear mixed models} \label{sec:lmmsummary} A linear mixed model is characterized by the conditional distribution \begin{equation} \label{eq:lmmcond} (\bc Y|\bc U=\bm u)\sim\mathcal{N}(\bm\gamma(\bm u,\bm\theta,\bm\beta),\sigma^2\bm I_n)\text{ where } \bm\gamma(\bm u,\bm\theta,\bm\beta)=\bm Z\bm\Lambda(\bm\theta)\bm u+\bm X\bm\beta \end{equation} and the unconditional distribution $\bc U\sim\mathcal{N}(\bm 0,\sigma^2\bm I_q)$. The discrepancy function, \begin{displaymath} d(\bm u|\bm y,\bm\theta,\bm\beta)= \left\|\bm y-\bm\gamma(\bm u,\bm\theta,\bm\beta)\right\|^2+\|\bm u\|^2, \end{displaymath} is minimized at the conditional mode, $\tilde{\bm u}(\bm\theta)$, and the conditional estimate, $\tilde{\bm\beta}(\bm\theta)$, which are the solutions to the sparse, positive-definite linear system \begin{displaymath} \begin{bmatrix} \bm\Lambda\trans(\bm\theta)\bm Z\trans\bm Z\bm\Lambda(\theta) +\bm I_q&\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm X\\ \bm X\trans\bm Z\bm\Lambda(\theta) &\bm X\trans\bm X \end{bmatrix} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\\tilde{\bm\beta}(\bm\theta) \end{bmatrix} = \begin{bmatrix} \bm\Lambda\trans(\bm\theta)\bm Z\trans\bm y\\ \bm X\trans\bm y \end{bmatrix} . \end{displaymath} In the process of solving this system we create the sparse left Cholesky factor, $L_{\bm Z}(\bm\theta)$, which is a lower triangular sparse matrix satisfying \begin{displaymath} \bm L_{\bm Z}(\bm\theta)\bm L_{\bm Z}(\bm\theta)\trans=\bm P_{\bm Z}\left(\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm Z\bm\Lambda(\theta)+\bm I_q\right)\bm P_{\bm Z}\trans \end{displaymath} where $\bm P_{\bm Z}$ is a permutation matrix representing a fill-reducing permutation formed from the pattern of nonzeros in $\bm Z\bm\Lambda(\bm\theta)$ for any $\bm\theta$ not on the boundary of the parameter region. (The values of the nonzeros depend on $\bm\theta$ but the pattern doesn't.) The profiled log-likelihood, $\tilde{\ell}(\bm\theta|\bm y)$, is \begin{displaymath} -2\tilde{\ell}(\bm\theta|\bm y)= \log(|\bm L_{\bm Z}(\bm\theta)|^2)+ n\left(1+\log\left(\frac{2\pi\tilde{d}(\bm y,\bm\theta)}{n}\right)\right) \end{displaymath} where $\tilde{d}(\bm y,\bm\theta)=d(\tilde{\bm u}(\bm\theta)|\bm y,\tilde{\bm\beta}(\bm\theta),\bm\theta)$. \section{Generalizing the discrepancy function} \label{sec:generalizations} Because one of the factors influencing the choice of implementation for linear mixed models is the extent to which the methods can also be applied to other mixed models, we describe several other classes of mixed models before discussing the implementation details for linear mixed models. At the core of our methods for determining the maximum likelihood estimates (MLEs) of the parameters in the mixed model are methods for minimizing the discrepancy function with respect to the coefficients $\bm u$ and $\bm\beta$ in the linear predictor $\bm\gamma(\bm u,\bm\theta,\bm\beta)$. In this section we describe the general form of the discrepancy function that we will use and a penalized iteratively reweighted least squares (PIRLS) algorithm for determining the conditional modes $\tilde{\bm u}(\bm\theta)$ and $\tilde{\bm\beta}(\bm\theta)$. We then describe several types of mixed models and the form of the discrepancy function for each. \subsection{A weighted residual sum of squares} \label{sec:weighted} As shown in \S\ref{sec:conditional-mode-bm}, the discrepancy function for a linear mixed model has the form of a penalized residual sum of squares from a linear model (\ref{eq:10}). In this section we generalize that definition to \begin{equation} \label{eq:11} d(\bm u|\bm y,\bm\theta,\bm\beta) =\left\|\bm W^{1/2}(\bm\mu) \left[\bm y-\bm\mu_{\bc Y|\bc U}(\bm u,\bm\theta,\bm\beta)\right]\right\|^2+ \|\bm 0-\bm u\|^2 . \end{equation} where $\bm W$ is an $n\times n$ diagonal matrix, called the \emph{weights matrix}, with positive diagonal elements and $\bm W^{1/2}$ is the diagonal matrix with the square roots of the weights on the diagonal. The $i$th weight is inversely proportional to the conditional variances of $(\mathcal{Y}|\bc U=\bm u)$ and may depend on the conditional mean, $\bm\mu_{\bc Y|\bc U}$. We allow the conditional mean to be a nonlinear function of the linear predictor, but with certain restrictions. We require that the mapping from $\bm u$ to $\bm\mu_{\bc Y|\bc U=\bm u}$ be expressed as \begin{equation} \label{eq:uGammaEtaMu} \bm u\;\rightarrow\;\bm\gamma\;\rightarrow\;\bm\eta\;\rightarrow\;\bm\mu \end{equation} where $\bm\gamma=\bm Z\bm\Lambda(\bm\theta)\bm u+\bm X\bm\beta$ is an $ns$-dimensional vector ($s > 0$) while $\bm\eta$ and $\bm\mu$ are $n$-dimensional vectors. The map $\bm\eta\rightarrow\bm\mu$ has the property that $\mu_i$ depends only on $\eta_i$, $i=1,\dots,n$. The map $\bm\gamma\rightarrow\bm\eta$ has a similar property in that, if we write $\bm\gamma$ as an $n\times s$ matrix $\bm\Gamma$ such that \begin{equation} \label{eq:vecGamma} \bm\gamma=\vec{\bm\Gamma} \end{equation} (i.e.{} concatenating the columns of $\bm\Gamma$ produces $\bm\gamma$) then $\eta_i$ depends only on the $i$th row of $\bm\Gamma$, $i=1,\dots,n$. Thus the Jacobian matrix $\frac{d\bm\mu}{d\bm\eta\trans}$ is an $n\times n$ diagonal matrix and the Jacobian matrix $\frac{d\bm\eta}{d\bm\gamma\trans}$ is the horizontal concatenation of $s$ diagonal $n\times n$ matrices. For historical reasons, the function that maps $\eta_i$ to $\mu_i$ is called the \emph{inverse link} function and is written $\mu=g^{-1}(\eta)$. The \emph{link function}, naturally, is $\eta=g(\mu)$. When applied component-wise to vectors $\bm\mu$ or $\bm\eta$ we write these as $\bm\eta=\bm g(\bm\mu)$ and $\bm\mu=\bm g^{-1}(\bm\eta)$. Recall that the conditional distribution, $(\mathcal{Y}_i|\bc U=\bm u)$, is required to be independent of $(\mathcal{Y}_j|\bc U=\bm u)$ for $i,j=1,\dots,n,\,i\ne j$ and that all the component conditional distributions must be of the same form and differ only according to the value of the conditional mean. Depending on the family of the conditional distributions, the allowable values of the $\mu_i$ may be in a restricted range. For example, if the conditional distributions are Bernoulli then $0\le\mu_i\le1,i=1,\dots,n$. If the conditional distributions are Poisson then $0\le\mu_i,i=1,\dots,n$. A characteristic of the link function, $g$, is that it must map the restricted range to an unrestricted range. That is, a link function for the Bernoulli distribution must map $[0,1]$ to $[-\infty,\infty]$ and must be invertible within the range. The mapping from $\bm\gamma$ to $\bm\eta$ is defined by a function $m:\mathbb{R}^s\rightarrow\mathbb{R}$, called the \emph{nonlinear model} function, such that $\eta_i=m(\bm\gamma_i),i=1,\dots,n$ where $\bm\gamma_i$ is the $i$th row of $\bm\Gamma$. The vector-valued function is $\bm\eta=\bm m(\bm\gamma)$. Determining the conditional modes, $\tilde{\bm u}(\bm y|\bm\theta)$, and $\tilde{\bm\beta}(\bm y|\bm\theta)$, that jointly minimize the discrepancy, \begin{equation} \label{eq:12} \begin{bmatrix} \tilde{\bm u}(\bm y|\bm\theta)\\ \tilde{\bm\beta}(\bm y|\bm\theta) \end{bmatrix} =\arg\min_{\bm u,\bm\beta}\left[(\bm y-\bm\mu)\trans\bm W(\bm y-\bm\mu)+\|\bm u\|^2\right] \end{equation} becomes a weighted, nonlinear least squares problem except that the weights, $\bm W$, can depend on $\bm\mu$ and, hence, on $\bm u$ and $\bm\beta$. In describing an algorithm for linear mixed models we called $\tilde{\bm\beta}(\bm\theta)$ the \emph{conditional estimate}. That name reflects that fact that this is the maximum likelihood estimate of $\bm\beta$ for that particular value of $\bm\theta$. Once we have determined the MLE, $\widehat(\bm\theta)_L$ of $\bm\theta$, we have a ``plug-in'' estimator, $\widehat{\bm\beta}_L=\tilde{\bm\beta}(\bm\theta)$ for $\bm\beta$. This property does not carry over exactly to other forms of mixed models. The values $\tilde{\bm u}(\bm\theta)$ and $\tilde{\bm\beta}(\bm\theta)$ are conditional modes in the sense that they are the coefficients in $\bm\gamma$ that jointly maximize the unscaled conditional density $h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma)$. Here we are using the adjective ``conditional'' more in the sense of conditioning on $\bc Y=\bm y$ than in the sense of conditioning on $\bm\theta$, although these values are determined for a fixed value of $\bm\theta$. \subsection{The PIRLS algorithm for $\tilde{\bm u}$ and $\tilde{\bm\beta}$} \label{sec:pirls-algor-tild} The penalized, iteratively reweighted, least squares (PIRLS) algorithm to determine $\tilde{\bm u}(\bm\theta)$ and $\tilde{\bm\beta}(\bm\theta)$ is a form of the Fisher scoring algorithm. We fix the weights matrix, $\bm W$, and use penalized, weighted, nonlinear least squares to minimize the penalized, weighted residual sum of squares conditional on these weights. Then we update the weights to those determined by the current value of $\bm\mu$ and iterate. To describe this algorithm in more detail we will use parenthesized superscripts to denote the iteration number. Thus $\bm u^{(0)}$ and $\bm\beta^{(0)}$ are the initial values of these parameters, while $\bm u^{(i)}$ and $\bm\beta^{(i)}$ are the values at the $i$th iteration. Similarly $\bm\gamma^{(i)}=\bm Z\bm\Lambda(\bm\theta)\bm u^{(i)}+\bm X\bm\beta^{(i)}$, $\bm\eta^{(i)}=\bm m(\bm\gamma^{(i)})$ and $\bm\mu^{(i)}=\bm g^{-1}(\bm\eta^{(i)})$. We use a penalized version of the Gauss-Newton algorithm \citep[ch.~2]{bateswatts88:_nonlin} for which we define the weighted Jacobian matrices \begin{align} \label{eq:Jacobian} \bm U^{(i)}&=\bm W^{1/2}\left.\frac{d\bm\mu}{d\bm u\trans}\right|_{\bm u=\bm u^{(i)},\bm\beta=\bm\beta^{(i)}}=\bm W^{1/2} \left.\frac{d\bm\mu}{d\bm\eta\trans}\right|_{\bm\eta^{(i)}} \left.\frac{d\bm\eta}{d\bm\gamma\trans}\right|_{\bm\gamma^{(i)}} \bm Z\bm\Lambda(\bm\theta)\\ \bm V^{(i)}&=\bm W^{1/2}\left.\frac{d\bm\mu}{d\bm\beta\trans}\right|_{\bm u=\bm u^{(i)},\bm\beta=\bm\beta^{(i)}}=\bm W^{1/2} \left.\frac{d\bm\mu}{d\bm\eta\trans}\right|_{\bm\eta^{(i)}} \left.\frac{d\bm\eta}{d\bm\gamma\trans}\right|_{\bm\gamma^{(i)}} \bm X \end{align} of dimension $n\times q$ and $n\times p$, respectively. The increments at the $i$th iteration, $\bm\delta_{\bm u}^{(i)}$ and $\bm\delta_{\bm\beta}^{(i)}$, are the solutions to \begin{equation} \label{eq:PNLSinc} \begin{bmatrix} {\bm U^{(i)}}\trans\bm U^{(i)}+\bm I_q&{\bm U^{(i)}}\trans\bm V^{(i)}\\ {\bm V^{(i)}}\trans\bm U^{(i)}&{\bm V^{(i)}}\trans\bm V^{(i)} \end{bmatrix} \begin{bmatrix} \bm\delta_{\bm u}^{(i)}\\ \bm\delta_{\bm\beta}^{(i)} \end{bmatrix} = \begin{bmatrix} {\bm U^{(i)}}\trans\bm W^{1/2}(\bm y-\bm\mu^{(i)})-\bm u^{(i)}\\ {\bm V^{(i)}}\trans\bm W^{1/2}(\bm y-\bm\mu^{(i)}) \end{bmatrix} \end{equation} providing the updated parameter values \begin{equation} \label{eq:33} \begin{bmatrix}\bm u^{(i+1)}\\\bm\beta^{(i+1)}\end{bmatrix}= \begin{bmatrix}\bm u^{(i)}\\\bm\beta^{(i)}\end{bmatrix}+\lambda \begin{bmatrix}\bm\delta_{\bm u}^{(i)}\\\bm\delta_{\bm\beta}^{(i)} \end{bmatrix} \end{equation} where $\lambda>0$ is a step factor chosen to ensure that \begin{equation} \label{eq:34} (\bm y-\bm\mu^{(i+1)})\trans\bm W(\bm y-\bm\mu^{(i+1)})+\|\bm u^{(i+1)}\|^2 < (\bm y-\bm\mu^{(i)})\trans\bm W(\bm y-\bm\mu^{(i)})+\|\bm u^{(i)}\|^2 . \end{equation} In the process of solving for the increments we form the sparse, lower triangular, Cholesky factor, $\bm L^{(i)}$, satisfying \begin{equation} \label{eq:35} \bm L^{(i)} {\bm L^{(i)}}\trans = \bm P_{\bm Z}\left({\bm U^{(i)}}\trans\bm U^{(i)}+ \bm I_n\right)\bm P_{\bm Z}\trans . \end{equation} After each successful iteration, determining new values of the coefficients, $\bm u^{(i+1)}$ and $\bm\beta^{(i+1)}$, that reduce the penalized, weighted residual sum of squqres, we update the weights matrix to $\bm W(\bm\mu^{(i+1)})$ and the weighted Jacobians, $\bm U^{(i+1)}$ and $\bm V^{(i+1)}$, then iterate. Convergence is determined according to the orthogonality convergence criterion~\citep[ch.~2]{bateswatts88:_nonlin}, suitably adjusted for the weights matrix and the penalty. \subsection{Weighted linear mixed models} \label{sec:weightedLMM} One of the simplest generalizations of linear mixed models is a weighted linear mixed model where $s=1$, the link function, $g$, and the nonlinear model function, $m$, are both the identity, the weights matrix, $\bm W$, is constant and the conditional distribution family is Gaussian. That is, the conditional distribution can be written \begin{equation} \label{eq:weightedLMM} (\bc Y|\bc U=\bm u)\sim\mathcal{N}(\bm\gamma(\bm u,\bm\theta,\bm\beta),\sigma^2\bm W^{-1}) \end{equation} with discrepancy function \begin{equation} \label{eq:wtddisc} d(\bm u|\bm y,\bm\theta,\bm\beta)=\left\|\bm W^{1/2}(\bm y-\bm Z\bm\Lambda(\bm\theta)\bm u-\bm X\bm\beta)\right\|^2+\|\bm u\|^2 . \end{equation} The conditional mode, $\tilde{\bm u}(\bm\theta)$, and the conditional estimate, $\tilde{\bm\beta}(\bm\theta)$, are the solutions to \begin{equation} \begin{bmatrix} \bm\Lambda\trans(\bm\theta)\bm Z\trans\bm W\bm Z\bm\Lambda(\theta) +\bm I_q&\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm W\bm X\\ \bm X\trans\bm W\bm Z\bm\Lambda(\theta) &\bm X\trans\bm W\bm X \end{bmatrix} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\\tilde{\bm\beta}(\bm\theta) \end{bmatrix} = \begin{bmatrix} \bm\Lambda\trans(\bm\theta)\bm Z\trans\bm W\bm y\\ \bm X\trans\bm W\bm y \end{bmatrix} , \end{equation} which can be solved directly, and the Cholesky factor, $\bm L_{\bm Z}(\bm\theta)$, satisfies \begin{equation} \bm L_{\bm Z}(\bm\theta)\bm L_{\bm Z}(\bm\theta)\trans=\bm P_{\bm Z}\left(\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm W\bm Z\bm\Lambda(\theta)+\bm I_q\right)\bm P_{\bm Z}\trans . \end{equation} The profiled log-likelihood, $\tilde{\ell}(\bm\theta|\bm y)$, is \begin{equation} \label{eq:wtdprofilelik} -2\tilde{\ell}(\bm\theta|\bm y)= \log\left(\frac{|\bm L_{\bm Z}(\bm\theta)|^2}{|\bm W|}\right)+ n\left(1+\log\left(\frac{2\pi\tilde{d}(\bm y,\bm\theta)}{n}\right)\right) . \end{equation} If the matrix $\bm W$ is fixed then we can ignore the term $|\bm W|$ in (\ref{eq:wtdprofilelik}) when determining the MLE, $\widehat{\bm\theta}_L$. However, in some models, we use a parameterized weight matrix, $\bm W(\bm\phi)$, and wish to determine the MLEs, $\widehat{\bm\phi}_L$ and $\widehat{\bm\theta}_L$ simultaneously. In these cases we must include the term involving $|\bm W(\bm\phi)|$ when evaluating the profiled log-likelihood. Note that we must define the parameterization of $\bm W(\bm\phi)$ such that $\sigma^2$ and $\bm\phi$ are not a redundant parameterization of $\sigma^2\bm W(\bm\phi)$. For example, we could require that the first diagonal element of $\bm W$ be unity. \subsection{Nonlinear mixed models} \label{sec:NLMMs} In an unweighted, nonlinear mixed model the conditional distribution is Gaussian, the link, $g$, is the identity and the weights matrix, $\bm W=\bm I_n$. That is, \begin{equation} \label{eq:conddistNLMM} (\bc Y|\bc U=\bm u)\sim\mathcal{N}(\bm m(\bm\gamma),\sigma^2\bm I_n) \end{equation} with discrepancy function \begin{equation} \label{eq:discNLMM} d(\bm u|\bm y,\bm\theta,\bm\beta)= \|\bm y-\bm\mu\|^2 + \|\bm u\|^2 . \end{equation} For a given value of $\bm\theta$ we determine the conditional modes, $\tilde{\bm u}(\bm\theta)$ and $\tilde{\bm\beta}(\bm\theta)$, as the solution to the penalized nonlinear least squares problem \begin{equation} \label{eq:NLMMpnls} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\ \tilde{\bm\beta}(\bm\theta) \end{bmatrix} = \arg\min_{\bm u,\bm\theta}d(\bm u|\bm y,\bm\theta,\bm\beta) \end{equation} and we write the minimum discrepancy, given $\bm y$ and $\bm\theta$, as \begin{equation} \label{eq:25} \tilde{d}(\bm y,\bm\theta)=d(\tilde{\bm u}(\bm\theta)|\bm y,\bm\theta,\tilde{\bm\beta}(\bm\theta)). \end{equation} Let $\tilde{\bm L}_Z(\bm\theta)$ and $\tilde{\bm L}_X(\bm\theta)$ be the Cholesky factors at $\bm\theta$, $\tilde{\bm\beta}(\bm\theta)$ and $\tilde{\bm u}(\bm\theta)$. Then the \emph{Laplace approximation} to the log-likelihood is \begin{equation} \label{eq:36} -2\ell_P(\bm\theta,\bm\beta,\sigma|\bm y)\approx n\log(2\pi\sigma^2)+\log(|\tilde{\bm L}_{\bm Z}|^2)+ \frac{\tilde{d}(\bm y,\bm\theta) + \left\|\tilde{\bm L}_{\bm X}\trans(\bm\beta-\tilde{\bm\beta})\right\|^2}{\sigma^2}, \end{equation} producing the approximate profiled log-likelihood, $\tilde{\ell}_P(\bm\theta|\bm y)$, \begin{equation} \label{eq:37} -2\tilde{\ell}_P(\bm\theta|\bm y)\approx \log(|\tilde{\bm L}_{\bm Z}|^2)+n\left(1+\log(2\pi \tilde{d}(\bm y,\bm\theta)/n) \right). \end{equation} \subsubsection{Nonlinear mixed model summary} \label{sec:nonl-mixed-model} In a nonlinear mixed model we determine the parameter estimate, $\widehat{\bm\theta}_P$, from the Laplace approximation to the log-likelihood as \begin{equation} \label{eq:38} \widehat{\bm\theta}_P = \arg\max_{\bm\theta}\tilde{\ell}_P(\bm\theta|\bm y) =\arg\min_{\bm\theta} \log(|\tilde{\bm L}_{\bm Z}|^2)+ n\left(1+\log(2\pi \tilde{d}(\bm y,\bm\theta)/n) \right). \end{equation} Each evaluation of $\tilde{\ell}_P(\bm\theta|\bm y)$ requires a solving the penalized nonlinear least squares problem (\ref{eq:NLMMpnls}) simultaneously with respect to both sets of coefficients, $\bm u$ and $\bm\beta$, in the linear predictor, $\bm\gamma$. For a weighted nonlinear mixed model with fixed weights, $\bm W$, we replace the unweighted discrepancy function $d(\bm u|\bm y,\bm\theta,\bm\beta)$ with the weighted discrepancy function, %% Finish this off \section{Details of the implementation} \label{sec:details} \subsection{Implementation details for linear mixed models} \label{sec:impl-line-mixed} The crucial step in implementing algorithms for determining ML or REML estimates of the parameters in a linear mixed model is evaluating the factorization (\ref{eq:16}) for any $\bm\theta$ satisfying $\bm\theta_L\le\bm\theta\le\bm\theta_U$. We will assume that $\bm Z$ is sparse as is $\bm Z\bm\Lambda(\bm\theta)$. When $\bm X$ is not sparse we will use the factorization (\ref{eq:16}) setting $\bm P_{\bm X}=\bm I_p$ and storing $\bm L_{\bm X\bm Z}$ and $\bm L_{\bm X}$ as dense matrices. The permutation matrix $\bm P_{\bm Z}$ is determined from the pattern of non-zeros in $\bm Z\bm\Lambda(\bm\theta)$ which is does not depend on $\bm\theta$, as long as $\bm\theta$ is not on the boundary. In fact, in most cases the pattern of non-zeros in $\bm Z\bm\Lambda(\bm\theta)$ is the same as the pattern of non-zeros in $\bm Z$. For many models, in particular models with scalar random effects (described later), the matrix $\bm\Lambda(\bm\theta)$ is diagonal. Given a value of $\bm\theta$ we determine the Cholesky factor $\bm L_{\bm Z}$ satisfying \begin{equation} \label{eq:LZ} \bm L_{\bm Z}\bm L_{\bm Z}\trans=\bm P_{\bm Z}( \bm\Lambda\trans(\bm\theta)\bm Z\trans\bm Z\bm\Lambda(\theta) +\bm I_q)\bm P_{\bm Z}\trans . \end{equation} The CHOLMOD package allows for $\bm L_{\bm Z}$ to be calculated directly from $\bm\Lambda\trans(\bm\theta)\bm Z\trans$ or from $\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm Z\bm\Lambda(\theta)$. The choice in implementation is whether to store $\bm Z\trans$ and update it to $\bm\Lambda\trans(\bm\theta)\bm Z$ or to store $\bm Z\trans\bm Z$ and use it to form $\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm Z\bm\Lambda(\theta)$ at each evaluation. In the \package{lme4} package we store $\bm Z\trans$ and use it to form $\bm\Lambda\trans(\bm\theta)\bm Z\trans$ from which $\bm L_{\bm Z}$ is evaluated. There are two reasons for this choice. First, the calculations for the more general forms of mixed models cannot be reduced to calculations involving $\bm Z\trans\bm Z$ and by expressing these calculations in terms of $\bm\Lambda(\bm\theta)\bm Z\trans$ for linear mixed models we can reuse the code for the more general models. Second, the calculation of $\bm\Lambda(\bm\theta)\trans\left(\bm Z\trans\bm Z\right)\bm\Lambda(\bm\theta)$ from $\bm Z\trans\bm Z$ is complicated compared to the calculation of $\bm\Lambda(\bm\theta)\trans\bm Z\trans$ from $\bm Z\trans$. This choice is disadvantageous when $n\gg q$ because $\bm Z\trans$ is much larger than $\bm Z\trans\bm Z$, even when they are stored as sparse matrices. Evaluation of $\bm L_{\bm Z}$ directly from $\bm Z\trans$ requires more storage and more calculation that evaluating $\bm L_{\bm Z}$ from $\bm Z\trans\bm Z$. Next we evaluate $\bm L_{\bm X\bm Z}\trans$ as the solution to \begin{equation} \label{eq:LXZ} \bm L_{\bm Z}\bm L_{\bm X\bm Z}\trans=\bm P_{\bm Z}\bm\Lambda\trans(\bm\theta)\bm Z\trans\bm X . \end{equation} Again we have the choice of calculating and storing $\bm Z\trans\bm X$ or storing $\bm X$ and using it to reevaluate $\bm Z\trans\bm X$. In the \package{lme4} package we store $\bm X$, because the calculations for the more general models cannot be expressed in terms of $\bm Z\trans\bm X$. Finally $\bm L_{\bm X}$ is evaluated as the (dense) solution to \begin{equation} \label{eq:LX} \bm L_{\bm X}\bm L_{\bm X}\trans= \bm X\trans\bm X-\bm L_{\bm X\bm Z}\bm L_{\bm X\bm Z} . \end{equation} from which $\tilde{\bm\beta}$ can be determined as the solution to dense system \begin{equation} \label{eq:tildebeta} \bm L_{\bm X}\bm L_{\bm X}\tilde{\bm\beta}=\bm X\trans\bm y \end{equation} and $\tilde{\bm u}$ as the solution to the sparse system \begin{equation} \label{eq:tildeu} \bm L_{\bm Z}\bm L_{\bm Z}\tilde{u}=\bm\Lambda\trans\bm Z\trans\bm y \end{equation} For many models, in particular models with scalar random effects, which are described later, the matrix $\bm\Lambda(\bm\theta)$ is diagonal. For such a model, if both $\bm Z$ and $\bm X$ are sparse and we plan to use the REML criterion then we create and store \begin{equation} \label{eq:8} \bm A= \begin{bmatrix} \bm Z\trans\bm Z & \bm Z\trans\bm X\\ \bm X\trans\bm Z & \bm X\trans\bm X \end{bmatrix}\quad\text{and}\quad \bm c =\begin{bmatrix}\bm Z\trans\bm y\\\bm X\trans\bm y\end{bmatrix} \end{equation} and determine a fill-reducing permutation, $\bm P$, for $\bm A$. Given a value of $\bm\theta$ we create the factorization \begin{equation} \label{eq:26} \bm L(\bm\theta)\bm L(\bm\theta)\trans=\bm P\left( \begin{bmatrix} \bm\Lambda(\bm\theta) & \bm0\\\bm0&\bm I_p \end{bmatrix} \bm A \begin{bmatrix} \bm\Lambda(\bm\theta) & \bm0\\\bm0&\bm I_p \end{bmatrix}+ \begin{bmatrix}\bm I_q&\bm0\\\bm0&\bm0\end{bmatrix}\right) \bm P\trans \end{equation} solve for $\tilde{\bm u}(\bm\theta)$ and $\tilde{\bm\beta}(\bm\theta)$ in \begin{equation} \label{eq:28} \bm L\bm L\trans\bm P \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\\tilde{\bm\beta}(\bm\theta) \end{bmatrix}= \bm P \begin{bmatrix}\bm\Lambda(\bm\theta) & \bm0\\\bm0&\bm I_p \end{bmatrix} \bm c \end{equation} then evaluate $\tilde{d}(\bm y|\bm\theta)$ and the profiled REML criterion as \begin{equation} \label{eq:27} \tilde{d}_R(\bm\theta|\bm y)=\log(|\bm L(\bm\theta)|^2)+ (n-p)\left(1+\log\left(\frac{2\pi\tilde{d}(\bm y|\bm\theta)} {n-p}\right)\right) . \end{equation} \bibliography{lme4} \appendix{} \section{Notation} \label{sec:notation} \subsection{Random variables in the model} \label{sec:rand-vari-model} \begin{description} \item[$\bc B$] Random-effects vector of dimension $q$, $\bc{B}\sim\mathcal{N}(\bm 0,\sigma^2\bm \Lambda(\bm\theta)\bm \Lambda(\bm\theta)\trans)$. \item[$\bm U$] ``Spherical'' random-effects vector of dimension $q$, $\bc U\sim\mathcal{N}(\bm 0,\sigma^2\bm I_q)$, $\bc B=\bm \Lambda(\bm\theta)\bc U$. \item[$\bc Y$] Response vector of dimension $n$. \end{description} \subsection{Parameters of the model} \label{sec:parameters-model} \begin{description} \item[$\bm\beta$] Fixed-effects parameters (dimension $p$). \item[$\bm\theta$] Parameters determining the left factor, $\bm\Lambda(\bm\theta)$ of the relative covariance matrix of $\bc B$ (dimension $m$). \item[$\sigma$] the common scale parameter - not used in some generalized linear mixed models and generalized nonlinear mixed models. \end{description} \subsection{Dimensions} \label{sec:dimensions} \begin{description} \item[$m$] dimension of the parameter $\bm\theta$. \item[$n$] dimension of the response vector, $\bm y$, and the random variable, $\bm{\mathcal{Y}}$. \item[$p$] dimension of the fixed-effects parameter, $\bm\beta$. \item[$q$] dimension of the random effects, $\bc B$ or $\bc U$. \item[$s$] dimension of the parameter vector, $\bm\phi$, in the nonlinear model function. \end{description} \subsection{Matrices} \label{sec:matrices} \begin{description} \item[$\bm L$] Left Cholesky factor of a positive-definite symmetric matrix. $\bm L_{\bm Z}$ is $q\times q$; $\bm L_{\bm X}$ is $p\times p$. \item[$\bm P$] Fill-reducing permutation for the random effects model matrix. (Size $q\times q$.) \item[$\bm \Lambda$] Left factor of the relative covariance matrix of the random effects. (Size $q\times q$.) \item[$\bm X$] Model matrix for the fixed-effects parameters, $\bm\beta$. (Size $(ns)\times p$.) \item[$\bm Z$] Model matrix for the random effects. (Size $(ns)\times q$.) \end{description} \section{Integrating a quadratic deviance expression} \label{sec:integr-quadr-devi} In (\ref{eq:6}) we defined the likelihood of the parameters given the observed data as \begin{displaymath} L(\bm\theta,\bm\beta,\sigma|\bm y) = \int_{\mathbb{R}^q}h(\bm u|\bm y,\bm\theta,\bm\beta,\sigma)\,d\bm u . \end{displaymath} which is often alarmingly described as ``an intractable integral''. In point of fact, this integral can be evaluated exactly in the case of a linear mixed model and can be approximated quite accurately for other forms of mixed models. \end{document} lme4/vignettes/lmer.Rnw0000644000176200001440000041456214063503234014566 0ustar liggesusers%\VignetteEngine{knitr::knitr} %\VignetteDepends{ggplot2} %\VignetteDepends{gamm4} %\VignetteIndexEntry{Fitting Linear Mixed-Effects Models using lme4} \documentclass[nojss]{jss} \usepackage[T1]{fontenc}% for correct hyphenation and T1 encoding \usepackage[utf8]{inputenc}% \usepackage{lmodern}% latin modern font \usepackage[american]{babel} %% for texi2dvi ~ bug \usepackage{bm,amsmath,thumbpdf,amsfonts}%,minted} \usepackage{blkarray} \usepackage{array} \newcolumntype{P}[1]{>{\raggedright\arraybackslash}p{#1}} \newcommand{\matindex}[1]{\mbox{\scriptsize#1}}% Matrix index \newcommand{\github}{Github} \DeclareMathOperator{\tr}{tr} \DeclareMathOperator{\VEC}{vec} \newcommand{\bmb}[1]{{\color{red} \emph{#1}}} \newcommand{\scw}[1]{{\color{blue} \emph{#1}}} \newcommand{\dmb}[1]{{\color{magenta} \emph{#1}}} \shortcites{bolker_strategies_2013,sleepstudy,gelman2013bayesian} \author{Douglas Bates\\University of Wisconsin-Madison\And Martin M\"achler\\ETH Zurich\And Benjamin M. Bolker\\McMaster University\And Steven C. Walker\\McMaster University } \Plainauthor{Douglas Bates, Martin M\"achler, Ben Bolker, Steve Walker} \title{Fitting Linear Mixed-Effects Models Using \pkg{lme4}} \Plaintitle{Fitting Linear Mixed-Effects Models using lme4} \Shorttitle{Linear Mixed Models with lme4} \Abstract{% Maximum likelihood or restricted maximum likelihood (REML) estimates of the parameters in linear mixed-effects models can be determined using the \code{lmer} function in the \pkg{lme4} package for \proglang{R}. As for most model-fitting functions in \proglang{R}, the model is described in an \code{lmer} call by a formula, in this case including both fixed- and random-effects terms. The formula and data together determine a numerical representation of the model from which the profiled deviance or the profiled REML criterion can be evaluated as a function of some of the model parameters. The appropriate criterion is optimized, using one of the constrained optimization functions in \proglang{R}, to provide the parameter estimates. We describe the structure of the model, the steps in evaluating the profiled deviance or REML criterion, and the structure of classes or types that represents such a model. Sufficient detail is included to allow specialization of these structures by users who wish to write functions to fit specialized linear mixed models, such as models incorporating pedigrees or smoothing splines, that are not easily expressible in the formula language used by \code{lmer}.} \Keywords{% sparse matrix methods, linear mixed models, penalized least squares, Cholesky decomposition} \Address{ Douglas Bates\\ Department of Statistics, University of Wisconsin\\ 1300 University Ave.\\ Madison, WI 53706, U.S.A.\\ E-mail: \email{bates@stat.wisc.edu}\\ \par\bigskip Martin M\"achler\\ Seminar f\"ur Statistik, HG G~16\\ ETH Zurich\\ 8092 Zurich, Switzerland\\ E-mail: \email{maechler@stat.math.ethz.ch}\\ % URL: \url{http://stat.ethz.ch/people/maechler}\\ \par\bigskip Benjamin M. Bolker\\ Departments of Mathematics \& Statistics and Biology \\ McMaster University \\ 1280 Main Street W \\ Hamilton, ON L8S 4K1, Canada \\ E-mail: \email{bolker@mcmaster.ca}\\ \par\bigskip Steven C. Walker\\ Department of Mathematics \& Statistics \\ McMaster University \\ 1280 Main Street W \\ Hamilton, ON L8S 4K1, Canada \\ E-mail: \email{scwalker@math.mcmaster.ca } } \newcommand{\thetavec}{{\bm\theta}} \newcommand{\betavec}{{\bm\beta}} \newcommand{\Var}{\operatorname{Var}} \newcommand{\abs}{\operatorname{abs}} \newcommand{\bLt}{\ensuremath{\bm\Lambda_{\bm\theta}}} \newcommand{\mc}[1]{\ensuremath{\mathcal{#1}}} \newcommand{\trans}{\ensuremath{^\top}} % JSS wants \top \newcommand{\yobs}{\ensuremath{\bm y_{\mathrm{obs}}}} \newcommand*{\eq}[1]{eqn.~\ref{#1}}% or just {(\ref{#1})} <>= options(width=70, show.signif.stars=FALSE, str=strOptions(strict.width="cut"), ## prefer empty continuation for reader's cut'n'paste: continue = " ", #JSS: prompt = "R> ", continue = "+ ", useFancyQuotes = FALSE) library("knitr") library("lme4") library("ggplot2")# Keeping default theme, nicer "on line": #JSS theme_set(theme_bw()) library("grid") zmargin <- theme(panel.spacing=unit(0,"lines")) library("lattice") library("minqa") opts_chunk$set(engine='R',dev='pdf', fig.width=9, fig.height=5.5, prompt=TRUE, cache=TRUE, tidy=FALSE, comment=NA) render_sweave() @ \setkeys{Gin}{width=\textwidth} \setkeys{Gin}{height=3.5in} \begin{document} A version of this manuscript has been published online in the \emph{Journal of Statistical Software}, on Oct.\ 2015, with DOI \linebreak[3] \texttt{10.18637/jss.v067.i01}, see \url{https://www.jstatsoft.org/article/view/v067i01/}. \section{Introduction} \label{sec:intro} The \pkg{lme4} package \citep{lme4} for \proglang{R} \citep{R} provides functions to fit and analyze linear mixed models, generalized linear mixed models and nonlinear mixed models. In each of these names, the term ``mixed'' or, more fully, ``mixed effects'', denotes a model that incorporates both fixed- and random-effects terms in a linear predictor expression from which the conditional mean of the response can be evaluated. In this paper we describe the formulation and representation of linear mixed models. The techniques used for generalized linear and nonlinear mixed models will be described separately, in a future paper. At present, the main alternative to \pkg{lme4} for mixed modeling in \proglang{R} is the \pkg{nlme} package \citep{nlme_pkg}. The main features distinguishing \pkg{lme4} from \pkg{nlme} are (1) more efficient linear algebra tools, giving improved performance on large problems; (2) simpler syntax and more efficient implementation for fitting models with crossed random effects; (3) the implementation of profile likelihood confidence intervals on random-effects parameters; and (4) the ability to fit generalized linear mixed models (although in this paper we restrict ourselves to linear mixed models). The main advantage of \pkg{nlme} relative to \pkg{lme4} is a user interface for fitting models with structure in the residuals (various forms of heteroscedasticity and autocorrelation) and in the random-effects covariance matrices (e.g., compound symmetric models). With some extra effort, the computational machinery of \pkg{lme4} can be used to fit structured models that the basic \code{lmer} function cannot handle (see Appendix~\ref{sec:modularExamples}). The development of general software for fitting mixed models remains an active area of research with many open problems. Consequently, the \pkg{lme4} package has evolved since it was first released, and continues to improve as we learn more about mixed models. However, we recognize the need to maintain stability and backward compatibility of \pkg{lme4} so that it continues to be broadly useful. In order to maintain stability while continuing to advance mixed-model computation, we have developed several additional frameworks that draw on the basic ideas of \pkg{lme4} but modify its structure or implementation in various ways. These descendants include the \mbox{\pkg{MixedModels}} package \citep{MixedModels} in \proglang{Julia} \citep{Julia}, the \pkg{lme4pureR} package \citep{lme4pureR} in \proglang{R}, and the \pkg{flexLambda} development branch of \pkg{lme4}. The current article is largely restricted to describing the current stable version of the \pkg{lme4} package (1.1-7), with Appendix~\ref{sec:modularExamples} describing hooks into the computational machinery that are designed for extension development. The \pkg{gamm4} \citep{gamm4} and \pkg{blme} \citep{blme, blme2} packages currently make use of these hooks. Another goal of this article is to contrast the approach used by \pkg{lme4} with previous formulations of mixed models. The expressions for the profiled log-likelihood and profiled REML (restricted maximum likelihood) criteria derived in Section~\ref{sec:profdev} are similar to those presented in \citet{bates04:_linear} and, indeed, are closely related to ``Henderson's mixed-model equations''~\citep{henderson_1982}. Nonetheless there are subtle but important changes in the formulation of the model and in the structure of the resulting penalized least squares (PLS) problem to be solved (Section~\ref{sec:PLSpureR}). We derive the current version of the PLS problem (Section~\ref{sec:plsMath}) and contrast this result with earlier formulations (Section~\ref{sec:previous_lmm_form}). This article is organized into four main sections (Sections~\ref{sec:lFormula}, \ref{sec:mkLmerDevfun}, \ref{sec:optimizeLmer}, and \ref{sec:mkMerMod}), each of which corresponds to one of the four largely separate modules that comprise \pkg{lme4}. Before describing the details of each module, we describe the general form of the linear mixed model underlying \pkg{lme4} (Section~\ref{sec:LMMs}); introduce the \code{sleepstudy} data that will be used as an example throughout (Section~\ref{sec:sleepstudy}); and broadly outline \pkg{lme4}'s modular structure (Section~\ref{sec:modular}). \subsection{Linear mixed models} \label{sec:LMMs} Just as a linear model is described by the distribution of a vector-valued random response variable, $\mc{Y}$, whose observed value is $\yobs$, a linear mixed model is described by the distribution of two vector-valued random variables: $\mc{Y}$, the response, and $\mc{B}$, the vector of random effects. In a linear model the distribution of $\mc Y$ is multivariate normal,%\begin{linenomath} \begin{equation} \label{eq:linearmodel} \mc Y\sim\mc{N}(\bm X\bm\beta+\bm o,\sigma^2\bm W^{-1}), \end{equation} where $n$ is the dimension of the response vector, $\bm W$ is a diagonal matrix of known prior weights, $\bm\beta$ is a $p$-dimensional coefficient vector, $\bm X$ is an $n\times p$ model matrix, and $\bm o$ is a vector of known prior offset terms. The parameters of the model are the coefficients $\bm\beta$ and the scale parameter $\sigma$. In a linear mixed model it is the \emph{conditional} distribution of $\mc Y$ given $\mc B=\bm b$ that has such a form, \begin{equation} \label{eq:LMMcondY} ( \mc Y|\mc B=\bm b)\sim\mc{N}(\bm X\bm\beta+\bm Z\bm b+\bm o,\sigma^2\bm W^{-1}), % | <- for ESS \end{equation} where $\bm Z$ is the $n\times q$ model matrix for the $q$-dimensional vector-valued random-effects variable, $\mc B$, whose value we are fixing at $\bm b$. The unconditional distribution of $\mc B$ is also multivariate normal with mean zero and a parameterized $q\times q$ variance-covariance matrix, $\bm\Sigma$, \begin{equation} \label{eq:LMMuncondB} \mc B\sim\mc N(\bm0,\bm\Sigma) . \end{equation} As a variance-covariance matrix, $\bm\Sigma$ must be positive semidefinite. It is convenient to express the model in terms of a \emph{relative covariance factor}, $\bLt$, which is a $q\times q$ matrix, depending on the \emph{variance-component parameter}, $\bm\theta$, and generating the symmetric $q\times q$ variance-covariance matrix, $\bm\Sigma$, according to%\begin{linenomath} \begin{equation} \label{eq:relcovfac} \bm\Sigma_{\bm\theta}=\sigma^2\bLt\bLt\trans , \end{equation}%\end{linenomath} where $\sigma$ is the same scale factor as in the conditional distribution (\ref{eq:LMMcondY}). Although Equations~\ref{eq:LMMcondY}, \ref{eq:LMMuncondB}, and \ref{eq:relcovfac} fully describe the class of linear mixed models that \pkg{lme4} can fit, this terse description hides many important details. Before moving on to these details, we make a few observations: \begin{itemize} \item This formulation of linear mixed models allows for a relatively compact expression for the profiled log-likelihood of $\bm\theta$ (Section~\ref{sec:profdev}, Equation~\ref{eq:profiledDeviance}). \item The matrices associated with random effects, $\bm Z$ and $\bLt$, typically have a sparse structure with a sparsity pattern that encodes various model assumptions. Sections~\ref{sec:LMMmatrix} and \ref{sec:CSCmats} provide details on these structures, and how to represent them efficiently. \item The interface provided by \pkg{lme4}'s \code{lmer} function is slightly less general than the model described by Equations~\ref{eq:LMMcondY}, \ref{eq:LMMuncondB}, and \ref{eq:relcovfac}. To take advantage of the entire range of possibilities, one may use the modular functions (Sections~\ref{sec:modular} and Appendix~\ref{sec:modularExamples}) or explore the experimental \pkg{flexLambda} branch of \pkg{lme4} on \github. \end{itemize} \subsection{Example} \label{sec:sleepstudy} Throughout our discussion of \pkg{lme4}, we will work with a data set on the average reaction time per day for subjects in a sleep deprivation study \citep{sleepstudy}. On day 0 the subjects had their normal amount of sleep. Starting that night they were restricted to 3 hours of sleep per night. The response variable, \code{Reaction}, represents average reaction times in milliseconds (ms) on a series of tests given each \code{Day} to each \code{Subject} (Figure~\ref{fig:sleepPlot}), % <>= str(sleepstudy) @ <>= ## BMB: seemed more pleasing to arrange by increasing slope rather than ## intercept ... xyplot(Reaction ~ Days | Subject, sleepstudy, aspect = "xy", layout = c(9, 2), type = c("g", "p", "r"), index.cond = function(x, y) coef(lm(y ~ x))[2], xlab = "Days of sleep deprivation", ylab = "Average reaction time (ms)", as.table = TRUE) @ % | Each subject's reaction time increases approximately linearly with the number of sleep-deprived days. However, subjects also appear to vary in the slopes and intercepts of these relationships, which suggests a model with random slopes and intercepts. As we shall see, such a model may be fitted by minimizing the REML criterion (Equation~\ref{eq:REMLdeviance}) using <>= fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) @ % | The estimates of the standard deviations of the random effects for the intercept and the slope are \Sexpr{round(sqrt(VarCorr(fm1)$Subject[1,1]), 2)} ms % $ and \Sexpr{round(sqrt(VarCorr(fm1)$Subject[2,2]), 2)} ms/day. % $ The fixed-effects coefficients, $\betavec$, are \Sexpr{round(fixef(fm1)[1], 1)} ms and \Sexpr{round(fixef(fm1)[2], 2)} ms/day for the intercept and slope. In this model, one interpretation of these fixed effects is that they are the estimated population mean values of the random intercept and slope (Section~\ref{sec:intuitiveFormulas}). We have chosen the \code{sleepstudy} example because it is a relatively small and simple example to illustrate the theory and practice underlying \code{lmer}. However, \code{lmer} is capable of fitting more complex mixed models to larger data sets. For example, we direct the interested reader to \code{RShowDoc("lmerperf", package = "lme4")} for examples that more thoroughly exercise the performance capabilities of \code{lmer}. \subsection{High-level modular structure} \label{sec:modular} The \code{lmer} function is composed of four largely independent modules. In the first module, a mixed-model formula is parsed and converted into the inputs required to specify a linear mixed model (Section~\ref{sec:lFormula}). The second module uses these inputs to construct an \proglang{R} function which takes the covariance parameters, $\bm\theta$, as arguments and returns negative twice the log profiled likelihood or the REML criterion (Section~\ref{sec:mkLmerDevfun}). The third module optimizes this objective function to produce maximum likelihood (ML) or REML estimates of $\bm\theta$ (Section~\ref{sec:optimizeLmer}). Finally, the fourth module provides utilities for interpreting the optimized model (Section~\ref{sec:mkMerMod}). \begin{table}[tb] \centering \begin{tabular}{lllp{2.1in}} \hline Module & & \proglang{R} function & Description \\ \hline Formula module & (Section~\ref{sec:lFormula}) & \code{lFormula} & Accepts a mixed-model formula, data, and other user inputs, and returns a list of objects required to fit a linear mixed model. \\ Objective function module & (Section~\ref{sec:mkLmerDevfun}) & \code{mkLmerDevfun} & Accepts the results of \code{lFormula} and returns a function to calculate the deviance (or restricted deviance) as a function of the covariance parameters, $\bm\theta$.\\ Optimization module & (Section~\ref{sec:optimizeLmer}) & \code{optimizeLmer} & Accepts a deviance function returned by \code{mkLmerDevfun} and returns the results of the optimization of that deviance function. \\ Output module & (Section~\ref{sec:mkMerMod}) & \code{mkMerMod} & Accepts an optimized deviance function and packages the results into a useful object. \\ \hline \end{tabular} \caption{The high-level modular structure of \code{lmer}.} \label{tab:modular} \end{table} To illustrate this modularity, we recreate the \code{fm1} object by a series of four modular steps; the formula module, <>= parsedFormula <- lFormula(formula = Reaction ~ Days + (Days | Subject), data = sleepstudy) @ the objective function module, <>= devianceFunction <- do.call(mkLmerDevfun, parsedFormula) @ the optimization module, <>= optimizerOutput <- optimizeLmer(devianceFunction) @ and the output module, <>= mkMerMod( rho = environment(devianceFunction), opt = optimizerOutput, reTrms = parsedFormula$reTrms, fr = parsedFormula$fr) @ % | \section{Formula module} \label{sec:lFormula} \subsection{Mixed-model formulas} \label{sec:formulas} Like most model-fitting functions in \proglang{R}, \code{lmer} takes as its first two arguments a \emph{formula} specifying the model and the \emph{data} with which to evaluate the formula. This second argument, \code{data}, is optional but recommended and is usually the name of an \proglang{R} data frame. In the \proglang{R} \code{lm} function for fitting linear models, formulas take the form \verb+resp ~ expr+, where \code{resp} determines the response variable and \code{expr} is an expression that specifies the columns of the model matrix. Formulas for the \code{lmer} function contain special random-effects terms, <>= resp ~ FEexpr + (REexpr1 | factor1) + (REexpr2 | factor2) + ... @ where \code{FEexpr} is an expression determining the columns of the fixed-effects model matrix, $\bm X$, and the random-effects terms, \code{(REexpr1 | factor1)} and \code{(REexpr2 | factor2)}, determine both the random-effects model matrix, $\bm Z$ (Section~\ref{sec:mkZ}), and the structure of the relative covariance factor, $\bLt$ (Section~\ref{sec:mkLambdat}). In principle, a mixed-model formula may contain arbitrarily many random-effects terms, but in practice the number of such terms is typically low. \subsection{Understanding mixed-model formulas} \label{sec:intuitiveFormulas}\label{sec:uncor} Before describing the details of how \pkg{lme4} parses mixed-model formulas (Section~\ref{sec:LMMmatrix}), we provide an informal explanation and then some examples. Our discussion assumes familiarity with the standard \proglang{R} modeling paradigm \citep{Chambers:1993}. Each random-effects term is of the form \code{(expr | factor)}. The expression \code{expr} is evaluated as a linear model formula, producing a model matrix following the same rules used in standard \proglang{R} modeling functions (e.g., \code{lm} or \code{glm}). The expression \code{factor} is evaluated as an \proglang{R} factor. One way to think about the vertical bar operator is as a special kind of interaction between the model matrix and the grouping factor. This interaction ensures that the columns of the model matrix have different effects for each level of the grouping factor. What makes this a special kind of interaction is that these effects are modeled as unobserved random variables, rather than unknown fixed parameters. Much has been written about important practical and philosophical differences between these two types of interactions \citep[e.g., ][]{henderson_1982,gelman2005analysis}. For example, the random-effects implementation of such interactions can be used to obtain shrinkage estimates of regression coefficients \citep[e.g., ][]{1977EfronAndMorris}, or account for lack of independence in the residuals due to block structure or repeated measurements \citep[e.g., ][]{laird_ware_1982}. Table~\ref{tab:formulas} provides several examples of the right-hand-sides of mixed-model formulas. The first example, \code{(1 | g)}, % | is the simplest possible mixed-model formula, where each level of the grouping factor, \code{g}, has its own random intercept. The mean and standard deviation of these intercepts are parameters to be estimated. Our description of this model incorporates any nonzero mean of the random effects as fixed-effects parameters. If one wishes to specify that a random intercept has \emph{a priori} known means, one may use the \code{offset} function as in the second model in Table~\ref{tab:formulas}. This model contains no fixed effects, or more accurately the fixed-effects model matrix, $\bm X$, has zero columns and $\bm\beta$ has length zero. \begin{table}[tb] \centering \begin{tabular}{llP{1.5in}} %% see new column type for ragged right \hline Formula & Alternative & Meaning \\ \hline%------------------------------------------------ \code{(1 | g)} & \code{1 + (1 | g)} & Random intercept with fixed mean. \\ \code{0 + offset(o) + (1 | g)} & \code{-1 + offset(o) + (1 | g)} & Random intercept with \emph{a priori} means. \\ \code{(1 | g1/g2)} & \code{(1 | g1)+(1 | g1:g2)} % | & Intercept varying among \code{g1} and \code{g2} within \code{g1}. \\ \code{(1 | g1) + (1 | g2)} & \code{1 + (1 | g1) + (1 | g2)}. & Intercept varying among \code{g1} and \code{g2}. \\ \code{x + (x | g)} & \code{1 + x + (1 + x | g)} & Correlated random intercept and slope. \\ \code{x + (x || g)} & \code{1 + x + (1 | g) + (0 + x | g)} & Uncorrelated random intercept and slope. \\ \hline \end{tabular} \caption{Examples of the right-hand-sides of mixed-effects model formulas. The names of grouping factors are denoted \code{g}, \code{g1}, and \code{g2}, and covariates and \emph{a priori} known offsets as \code{x} and \code{o}.} \label{tab:formulas} \end{table} We may also construct models with multiple grouping factors. For example, if the observations are grouped by \code{g2}, which is nested within \code{g1}, then the third formula in Table \ref{tab:formulas} can be used to model variation in the intercept. A common objective in mixed modeling is to account for such nested (or hierarchical) structure. However, one of the most useful aspects of \pkg{lme4} is that it can be used to fit random effects associated with non-nested grouping factors. For example, suppose the data are grouped by fully crossing two factors, \code{g1} and \code{g2}, then the fourth formula in Table \ref{tab:formulas} may be used. Such models are common in item response theory, where \code{subject} and \code{item} factors are fully crossed \citep{doran2007estimating}. In addition to varying intercepts, we may also have varying slopes (e.g., the \code{sleepstudy} data, Section~\ref{sec:sleepstudy}). The fifth example in Table~\ref{tab:formulas} gives a model where both the intercept and slope vary among the levels of the grouping factor. \subsubsection{Specifying uncorrelated random effects} \label{sec:uncor} By default, \pkg{lme4} assumes that all coefficients associated with the same random-effects term are correlated. To specify an uncorrelated slope and intercept (for example), one may either use double-bar notation, \code{(x || g)}, or equivalently use multiple random-effects terms, \code{x + (1 | g) + (0 + x | g)}, as in the final example of Table~\ref{tab:formulas}. For example, if one examined the results of model \code{fm1} of the \code{sleepstudy} data (Section~\ref{sec:sleepstudy}) using \code{summary(fm1)}, one would see that the estimated correlation between the slope for \code{Days} and the intercept is fairly low (\Sexpr{round(attr(VarCorr(fm1)$Subject, "correlation")[2],3)}) % $ (See Section~\ref{sec:summary} below for more on how to extract the random-effects covariance matrix.) We may use double-bar notation to fit a model that excludes a correlation parameter: <>= fm2 <- lmer(Reaction ~ Days + (Days || Subject), sleepstudy) @ Although mixed models where the random slopes and intercepts are assumed independent are commonly used to reduce the complexity of random-slopes models, they do have one subtle drawback. Models in which the slopes and intercepts are allowed to have a nonzero correlation (e.g., \code{fm1}) are invariant to additive shifts of the continuous predictor (\code{Days} in this case). This invariance breaks down when the correlation is constrained to zero; any shift in the predictor will necessarily lead to a change in the estimated correlation, and in the likelihood and predictions of the model. For example, we can eliminate the correlation in \code{fm1} simply by adding an amount equal to the ratio of the estimated among-subject standard deviations multiplied by the estimated correlation (i.e., $\sigma_{\text{\small slope}}/\sigma_{\text{\small intercept}} \cdot \rho_{\text{\small slope:intercept}}$) to the \code{Days} variable. The use of models such as \code{fm2} should ideally be restricted to cases where the predictor is measured on a ratio scale (i.e., the zero point on the scale is meaningful, not just a location defined by convenience or convention), as is the case here. %% <>= %% sleepstudyShift <- within(sleepstudy, { %% Days <- Days + (24.74*0.07)/5.92 }) %% lmer(Reaction ~ Days + (Days | Subject), sleepstudyShift) %% @ \subsection{Algebraic and computational account of mixed-model formulas} \label{sec:LMMmatrix} The fixed-effects terms of a mixed-model formula are parsed to produce the fixed-effects model matrix, $\bm X$, in the same way that the \proglang{R} \code{lm} function generates model matrices. However, a mixed-model formula incorporates $k\ge1$ random-effects terms of the form \code{(r | f)} as well. % | These $k$ terms are used to produce the random-effects model matrix, $\bm Z$ (Equation~\ref{eq:LMMcondY}; Section~\ref{sec:mkZ}), and the structure of the relative covariance factor, $\bLt$ (Equation~\ref{eq:relcovfac}; Section~\ref{sec:mkLambdat}), which are matrices that typically have a sparse structure. We now describe how one might construct these matrices from the random-effects terms, considering first a single term, \code{(r | f)}, % | and then generalizing to multiple terms. Tables~\ref{tab:dim} and \ref{tab:algebraic} summarize the matrices and vectors that determine the structure of $\bm Z$ and $\bLt$. \begin{table}[tb] \centering \begin{tabular}{lll} \hline Symbol & Size \\ \hline $n$ & Length of the response vector, $\mc{Y}$ \\ $p$ & Number of columns of fixed-effects model matrix, $\bm X$ \\ $q = \sum_i^k q_i$ & Number of columns of random-effects model matrix, $\bm Z$ \\ $p_i$ & Number of columns of the raw model matrix, $\bm X_i$ \\ $\ell_i$ & Number of levels of the grouping factor indices, $\bm i_i$ \\ $q_i = p_i\ell_i$ & Number of columns of the term-wise model matrix, $\bm Z_i$ \\ $k$ & Number of random-effects terms \\ $m_i = \binom{p_i+1}{2}$ & Number of covariance parameters for term $i$ \\ $m = \sum_i^k m_i$ & Total number of covariance parameters \\ \hline \end{tabular} \caption{Dimensions of linear mixed models. The subscript $i = 1, \dots, k$ denotes a specific random-effects term.} \label{tab:dim} \end{table} \begin{table}[tb] \centering \begin{tabular}{lll} \hline Symbol & Size & Description \\ \hline $\bm X_i$ & $n\times p_i$ & Raw random-effects model matrix \\ $\bm J_i$ & $n\times \ell_i$ & Indicator matrix of grouping factor indices\\ $\bm X_{ij}$ & $p_i\times 1$ & Column vector containing $j$th row of $\bm X_i$ \\ $\bm J_{ij}$ & $\ell_i\times 1$ & Column vector containing $j$th row of $\bm J_i$ \\ $\bm i_i$ & $n$ & Vector of grouping factor indices \\ $\bm Z_i$ & $n\times q_i$ & Term-wise random-effects model matrix \\ $\bm\theta$ & $m$ & Covariance parameters \\ $\bm T_i$ & $p_i\times p_i$ & Lower triangular template matrix \\ $\bm\Lambda_i$ & $q_i\times q_i$ & Term-wise relative covariance factor \\ \hline \end{tabular} \caption{Symbols used to describe the structure of the random-effects model matrix and the relative covariance factor. The subscript $i = 1, \dots, k$ denotes a specific random-effects term.} \label{tab:algebraic} \end{table} The expression, \code{r}, is a linear model formula that evaluates to an \proglang{R} model matrix, $\bm X_i$, of size $n\times p_i$, called the \emph{raw random-effects model matrix} for term $i$. A term is said to be a \emph{scalar} random-effects term when $p_i=1$, otherwise it is \emph{vector-valued}. For a \emph{simple, scalar} random-effects term of the form \code{(1 | f)}, $\bm X_i$ is the % | $n\times 1$ matrix of ones, which implies a random intercept model. The expression \code{f} evaluates to an \proglang{R} factor, called the \emph{grouping factor}, for the term. For the $i$th term, we represent this factor mathematically with a vector $\bm i_i$ of \emph{factor indices}, which is an $n$-vector of values from $1,\dots,\ell_i$.\footnote{In practice, fixed-effects model matrices and random-effects terms are evaluated with respect to a \emph{model frame}, ensuring that any expressions for grouping factors have been coerced to factors and any unused levels of these factors have been dropped. That is, $\ell_i$, the number of levels in the grouping factor for the $i$th random-effects term, is well-defined.} Let $\bm J_i$ be the $n\times \ell_i$ matrix of indicator columns for $\bm i_i$. Using the \pkg{Matrix} package \citep{Matrix_pkg} in \proglang{R}, we may construct the transpose of $\bm J_i$ from a factor vector, \code{f}, by coercing \code{f} to a `\code{sparseMatrix}' object. For example, <>= set.seed(2) @ <>= (f <- gl(3, 2)) (Ji <- t(as(f, Class = "sparseMatrix"))) @ When $k>1$ we order the random-effects terms so that $\ell_1\ge\ell_2\ge\dots\ge\ell_k$; in general, this ordering reduces ``fill-in'' (i.e., the proportion of elements that are zero in the lower triangle of $\bLt\trans\bm Z\trans\bm W\bm Z\bLt+\bm I$ but not in the lower triangle of its left Cholesky factor, $\bm L_{\bm\theta}$, described below in Equation~\ref{eq:blockCholeskyDecomp}). This reduction in fill-in provides more efficient matrix operations within the penalized least squares algorithm (Section~\ref{sec:plsMath}). \subsubsection{Constructing the random-effects model matrix} \label{sec:mkZ} The $i$th random-effects term contributes $q_i=\ell_ip_i$ columns to the model matrix $\bm Z$. We group these columns into a matrix, $\bm Z_i$, which we refer to as the \emph{term-wise model matrix} for the $i$th term. Thus $q$, the number of columns in $\bm Z$ and the dimension of the random variable, $\mc{B}$, is \begin{equation} \label{eq:qcalc} q=\sum_{i=1}^k q_i = \sum_{i=1}^k \ell_i\,p_i . \end{equation} Creating the matrix $\bm Z_i$ from $\bm X_i$ and $\bm J_i$ is a straightforward concept that is, nonetheless, somewhat awkward to describe. Consider $\bm Z_i$ as being further decomposed into $\ell_i$ blocks of $p_i$ columns. The rows in the first block are the rows of $\bm X_i$ multiplied by the 0/1 values in the first column of $\bm J_i$ and similarly for the subsequent blocks. With these definitions we may define the term-wise random-effects model matrix, $\bm Z_i$, for the $i$th term as a transposed Khatri-Rao product, \begin{equation} \label{eq:Zi} \bm Z_i = (\bm J_i\trans * \bm X_i\trans)\trans = \begin{bmatrix} \bm J_{i1}\trans \otimes \bm X_{i1}\trans \\ \bm J_{i2}\trans \otimes \bm X_{i2}\trans \\ \vdots \\ \bm J_{in}\trans \otimes \bm X_{in}\trans \\ \end{bmatrix}, \end{equation} where $*$ and $\otimes$ are the Khatri-Rao\footnote{Note that the original definition of the Khatri-Rao product is more general than the definition used in the \pkg{Matrix} package, which is the definition we use here.} \citep{khatri1968solutions} and Kronecker products, and $\bm J_{ij}\trans$ and $\bm X_{ij}\trans$ are row vectors of the $j$th rows of $\bm J_i$ and $\bm X_i$. These rows correspond to the $j$th sample in the response vector, $\mc Y$, and thus $j$ runs from $1, \dots, n$. The \pkg{Matrix} package for \proglang{R} contains a \code{KhatriRao} function, which can be used to form $\bm Z_i$. For example, if we begin with a raw model matrix, <>= (Xi <- cbind(1, rep.int(c(-1, 1), 3L))) @ then the term-wise random-effects model matrix is, <>= (Zi <- t(KhatriRao(t(Ji), t(Xi)))) @ <>= ## alternative formulation of Zi (eq:Zi) rbind( Ji[1,] %x% Xi[1,], Ji[2,] %x% Xi[2,], Ji[3,] %x% Xi[3,], Ji[4,] %x% Xi[4,], Ji[5,] %x% Xi[5,], Ji[6,] %x% Xi[6,]) @ In particular, for a simple, scalar term, $\bm Z_i$ is exactly $\bm J_i$, the matrix of indicator columns. For other scalar terms, $\bm Z_i$ is formed by element-wise multiplication of the single column of $\bm X_i$ by each of the columns of $\bm J_i$. Because each $\bm Z_i$ is generated from indicator columns, its cross-product, $\bm Z_i\trans\bm Z_i$ is block-diagonal consisting of $\ell_i$ diagonal blocks each of size $p_i$.\footnote{To see this, note that by the properties of Kronecker products we may write the cross-product matrix $Z_i\trans Z_i$ as $\sum_{j=1}^n \bm J_{ij} \bm J_{ij}\trans \otimes \bm X_{ij} \bm X_{ij}\trans$. Because $\bm J_{ij}$ is a unit vector along a coordinate axis, the cross-product $\bm J_{ij} \bm J_{ij}\trans$ is a $p_i\times p_i$ matrix of all zeros except for a single $1$ along the diagonal. Therefore, the cross-products, $\bm X_{ij} \bm X_{ij}\trans$, will be added to one of the $\ell_i$ blocks of size $p_i\times p_i$ along the diagonal of $Z_i\trans Z_i$.} Note that this means that when $k=1$ (i.e., there is only one random-effects term, and $\bm Z_i = \bm Z$), $\bm Z\trans\bm Z$ will be block diagonal. These block-diagonal properties allow for more efficient sparse matrix computations (Section~\ref{sec:CSCmats}). The full random-effects model matrix, $\bm Z$, is constructed from $k\ge 1$ blocks, \begin{equation} \label{eq:Z} \bm Z = \begin{bmatrix} \bm Z_1 & \bm Z_2 & \hdots & \bm Z_k \\ \end{bmatrix}. \end{equation} By transposing Equation~\ref{eq:Z} and substituting in Equation~\ref{eq:Zi}, we may represent the structure of the transposed random-effects model matrix as follows, \begin{equation} \label{eq:Zt} \bm Z\trans = \begin{blockarray}{ccccc} \text{sample 1} & \text{sample 2} & \hdots & \text{sample } n & \\ \begin{block}{[cccc]c} \bm J_{11} \otimes \bm X_{11} & \bm J_{12} \otimes \bm X_{12} & \hdots & \bm J_{1n} \otimes \bm X_{1n} & \text{term 1} \\ \bm J_{21} \otimes \bm X_{21} & \bm J_{22} \otimes \bm X_{22} & \hdots & \bm J_{2n} \otimes \bm X_{2n} & \text{term 2} \\ \vdots & \vdots & \ddots & \vdots & \vdots \\ \end{block} \end{blockarray}. \end{equation} Note that the proportion of elements of $Z\trans$ that are structural zeros is \begin{equation} \label{eq:ZtSparsity} \frac{\sum_{i=1}^k p_i(\ell_i - 1)}{\sum_{i=1}^k p_i} \qquad . \end{equation} Therefore, the sparsity of $\bm Z\trans$ increases with the number of grouping factor levels. As the number of levels is often large in practice, it is essential for speed and efficiency to take account of this sparsity, for example by using sparse matrix methods, when fitting mixed models (Section~\ref{sec:CSCmats}). \subsubsection{Constructing the relative covariance factor} \label{sec:mkLambdat} \label{sec:mkZ} The $q\times q$ covariance factor, $\bLt$, is a block diagonal matrix whose $i$th diagonal block, $\bm\Lambda_i$, is of size $q_i,i=1,\dots,k$. We refer to $\bm\Lambda_i$ as the \emph{term-wise relative covariance factor}. Furthermore, $\bm\Lambda_i$ is a homogeneous block diagonal matrix with each of the $\ell_i$ lower-triangular blocks on the diagonal being a copy of a $p_i\times p_i$ lower-triangular \emph{template matrix}, $\bm T_i$. The covariance parameter vector, $\bm\theta$, of length $m_i =\binom{p_i+1}{2}$, consists of the elements in the lower triangle of $\bm T_i,i=1,\dots,k$. To provide a unique representation we require that the diagonal elements of the $\bm T_i,i=1,\dots,k$ be non-negative. The template, $\bm T_i$, can be constructed from the number $p_i$ alone. In \proglang{R} code we denote $p_i$ as \code{nc}. For example, if we set \code{nc <- 3}\Sexpr{nc <- 3}, we could create the template for term $i$ as, <>= nc <- 3 @ %% sequence() is equivalent to unlist(lapply(nvec, seq_len)) %% and (?sequence) ``mainly exists in reverence to the very early history of R'' %% scw: i like sequence, and in fact i never understood why that %% statement is there in the help file. <