R Under development (unstable) (2023-11-03 r85470 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 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. 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 > source(system.file("test-tools-1.R", package = "Matrix"), keep.source = FALSE) Loading required package: tools > ## 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) > > proc.time() user system elapsed 1.06 0.25 1.29