[Lme4-commits] r1562 - in pkg/lme4Eigen: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Feb 4 00:05:31 CET 2012
Author: dmbates
Date: 2012-02-04 00:05:31 +0100 (Sat, 04 Feb 2012)
New Revision: 1562
Added:
pkg/lme4Eigen/man/rePos-class.Rd
pkg/lme4Eigen/man/rePos.Rd
Modified:
pkg/lme4Eigen/NAMESPACE
pkg/lme4Eigen/R/lmer.R
pkg/lme4Eigen/R/optimizer.R
pkg/lme4Eigen/R/utilities.R
pkg/lme4Eigen/man/getME.Rd
pkg/lme4Eigen/man/lmer.Rd
pkg/lme4Eigen/man/profile-methods.Rd
Log:
Change names of components of returned value from NelderMead to match those from bobyqa. Document the rePos class. Create an as.function method for merMod.
Modified: pkg/lme4Eigen/NAMESPACE
===================================================================
--- pkg/lme4Eigen/NAMESPACE 2012-02-03 23:03:53 UTC (rev 1561)
+++ pkg/lme4Eigen/NAMESPACE 2012-02-03 23:05:31 UTC (rev 1562)
@@ -87,6 +87,7 @@
importMethodsFrom(Matrix,t)
importMethodsFrom(Matrix,tcrossprod)
S3method(anova,merMod)
+S3method(as.function,merMod)
S3method(coef,lmList)
S3method(coef,merMod)
S3method(confint,lmList)
Modified: pkg/lme4Eigen/R/lmer.R
===================================================================
--- pkg/lme4Eigen/R/lmer.R 2012-02-03 23:03:53 UTC (rev 1561)
+++ pkg/lme4Eigen/R/lmer.R 2012-02-03 23:05:31 UTC (rev 1562)
@@ -137,8 +137,8 @@
xst <- rep.int(0.1, length(lower))
opt <- Nelder_Mead(devfun, x0=rho$pp$theta, xst=0.2*xst, xt=xst*0.0001,
lower=lower, control=control)
- if (opt$code < 0L) {
- if (opt$code > -4L)
+ if (opt$ierr < 0L) {
+ if (opt$ierr > -4L)
stop("convergence failure, code ", nMres, " in NelderMead")
else
warning("failure to converge in", opt$control$maxfun, "evaluations")
@@ -349,23 +349,6 @@
})
}
mkMerMod(environment(devfun), opt, reTrms, fr, mc)
- ## sqrLenU <- rho$pp$sqrL(0.)
- ## wrss <- rho$resp$wrss()
- ## pwrss <- wrss + sqrLenU
- ## n <- nrow(fr)
-
- ## dims <- c(N=n, n=n, nmp=n-p, nth=length(rho$pp$theta), p=p, q=nrow(reTrms$Zt),
- ## nAGQ=nAGQ, useSc=0L, reTrms=length(reTrms$cnms),
- ## spFe=0L, REML=0L, GLMM=1L, NLMM=0L)
- ## cmp <- c(ldL2=rho$pp$ldL2(), ldRX2=rho$pp$ldRX2(), wrss=wrss,
- ## ussq=sqrLenU, pwrss=pwrss,
- ## drsum=rho$resp$resDev(), dev=opt$fval, REML=NA,
- ## sigmaML=NA, sigmaREML=NA, tolPwrss=tolPwrss)
-
- ## new("glmerMod", call=mc, frame=fr, flist=reTrms$flist, cnms=reTrms$cnms,
- ## Gp=reTrms$Gp, theta=rho$pp$theta, beta=rho$pp$beta0, u=rho$pp$u0,
- ## lower=reTrms$lower, devcomp=list(cmp=cmp, dims=dims), pp=rho$pp,
- ## resp=rho$resp)
}## {glmer}
##' Fit a nonlinear mixed-effects model
@@ -429,8 +412,8 @@
xst <- rep.int(0.1, length(lower))
opt <- Nelder_Mead(devfun, x0=rho$pp$theta, xst=0.2*xst, xt=xst*0.0001,
lower=lower, control=control)
- if (opt$code < 0L) {
- if (opt$code > -4L)
+ if (opt$ierr < 0L) {
+ if (opt$ierr > -4L)
stop("convergence failure, code ", nMres, " in NelderMead")
else
warning("failure to converge in ", cc$maxfun, " evaluations")
@@ -462,22 +445,6 @@
})
}
mkMerMod(environment(devfun), opt, vals$reTrms, vals$frame, mc)
- ## sqrLenU <- rho$pp$sqrL(0.)
- ## wrss <- rho$resp$wrss()
- ## pwrss <- wrss + sqrLenU
- ## n <- nrow(vals$fr)
-
- ## dims <- c(N=n, n=n, nmp=n-p, nth=length(rho$pp$theta), p=p, q=nrow(vals$reTrms$Zt),
- ## nAGQ=nAGQ, useSc=1L, reTrms=length(vals$reTrms$cnms),
- ## spFe=0L, REML=0L, GLMM=0L, NLMM=1L)
- ## cmp <- c(ldL2=rho$pp$ldL2(), ldRX2=rho$pp$ldRX2(), wrss=wrss,
- ## ussq=sqrLenU, pwrss=pwrss, drsum=NA,
- ## drsum=wrss, dev=opt$fval, REML=NA,
- ## sigmaML=sqrt(pwrss/n), sigmaREML=NA, tolPwrss=tolPwrss)
-
- ## new("nlmerMod", call=mc, frame=vals$fr, flist=vals$reTrms$flist, cnms=vals$reTrms$cnms,
- ## Gp=vals$reTrms$Gp, theta=rho$pp$theta, beta=rho$pp$beta0, u=rho$pp$u0,
- ## lower=vals$reTrms$lower, devcomp=list(cmp=cmp, dims=dims), pp=rho$pp, resp=rho$resp)
}## {nlmer}
##' Create a deviance evaluation function from a predictor and a response module
@@ -514,9 +481,10 @@
mkdevfun <- function(rho, nAGQ=1L) {
stopifnot(is.environment(rho), is(rho$resp, "lmResp"))
ff <- NULL
- if (is(rho$resp, "lmerResp"))
+ if (is(rho$resp, "lmerResp")) {
+ rho$lmer_Deviance <- lmer_Deviance
ff <- function(theta) .Call(lmer_Deviance, pp$ptr(), resp$ptr(), theta)
- else if (is(rho$resp, "glmResp")) {
+ } else if (is(rho$resp, "glmResp")) {
if (nAGQ < 2L) {
rho$glmerLaplace <- glmerLaplace
ff <- switch(nAGQ + 1L,
@@ -883,6 +851,15 @@
##' @S3method anova merMod
anova.merMod <- anovaLmer
+##' @S3method as.function merMod
+as.function.merMod <- function(x, ...) {
+ rho <- list2env(list(resp=x at resp$copy(),
+ pp=x at pp$copy(),
+ beta0=x at beta,
+ u0=x at u), parent=as.environment("package:lme4Eigen"))
+ mkdevfun(rho, getME(x, "devcomp")$dims["nAGQ"])
+}
+
## coef() method for all kinds of "mer", "*merMod", ... objects
## ------ should work with fixef() + ranef() alone
coefMer <- function(object, ...)
@@ -1469,6 +1446,8 @@
##' \item{L}{sparse Cholesky factor of the penalized random-effects model.}
##' \item{Lambda}{relative covariance factor of the random effects.}
##' \item{Lambdat}{transpose of the relative covariance factor of the random effects.}
+##' \item{Lind}{index vector for inserting elements of \eqn{\theta}{theta} into the
+##' nonzeros of \eqn{\Lambda}{Lambda}}
##' \item{RX}{Cholesky factor for the fixed-effects parameters}
##' \item{RZX}{cross-term in the full Cholesky factor}
##' \item{beta}{fixed-effects parameter estimates (same as the result of \code{\link{fixef}})}
@@ -1507,7 +1486,7 @@
getME <- function(object,
name = c("X", "Z","Zt", "u",
"Gp",
- "L", "Lambda", "Lambdat",
+ "L", "Lambda", "Lambdat", "Lind",
"RX", "RZX",
"beta", "theta",
"REML", "n_rtrms", "is_REML", "devcomp"))
@@ -1529,6 +1508,7 @@
"L"= PR$ L(),
"Lambda"= t(PR$ Lambdat),
"Lambdat"= PR$ Lambdat,
+ "Lind" = PR$ Lind,
"RX" = PR $ RX(), ## FIXME - add the column names and row names, either in the C++ or the R method
"RZX" = PR $ RZX(), ## FIXME - add column names
Modified: pkg/lme4Eigen/R/optimizer.R
===================================================================
--- pkg/lme4Eigen/R/optimizer.R 2012-02-03 23:03:53 UTC (rev 1561)
+++ pkg/lme4Eigen/R/optimizer.R 2012-02-03 23:05:31 UTC (rev 1562)
@@ -20,8 +20,8 @@
##' }
##' @return a list with 4 components
##' \item{fval}{numeric scalar - the minimum function value achieved}
-##' \item{pars}{numeric vector - the value of \code{x} providing the minimum}
-##' \item{code}{integer scalar - convergence code}
+##' \item{par}{numeric vector - the value of \code{x} providing the minimum}
+##' \item{ierr}{integer scalar - error code}
##' \item{control}{list - the list of control settings after substituting for defaults}
##' @export
Nelder_Mead <- function(ff, x0, xst, xt, lower=rep.int(-Inf, n),
@@ -47,5 +47,5 @@
nM$setMaxeval(cc$maxfun)
nM$setMinfMax(cc$MinfMax)
while ((nMres <- nM$newf(ff(nM$xeval()))) == 0L) {}
- list(fval=nM$value(), pars=nM$xpos(), code=nMres, control=cc)
+ list(fval=nM$value(), par=nM$xpos(), ierr=nMres, control=cc)
}
Modified: pkg/lme4Eigen/R/utilities.R
===================================================================
--- pkg/lme4Eigen/R/utilities.R 2012-02-03 23:03:53 UTC (rev 1561)
+++ pkg/lme4Eigen/R/utilities.R 2012-02-03 23:05:31 UTC (rev 1562)
@@ -485,7 +485,7 @@
is(pp <- rho$pp, "merPredD"),
is(resp <- rho$resp, "lmResp"),
is.list(opt),
- all(c("fval", "pars", "code") %in% names(opt)),
+ all(c("fval", "par", "ierr") %in% names(opt)),
is.list(reTrms),
all(c("flist", "cnms", "Gp", "lower") %in%
names(reTrms)))
Modified: pkg/lme4Eigen/man/getME.Rd
===================================================================
--- pkg/lme4Eigen/man/getME.Rd 2012-02-03 23:03:53 UTC (rev 1561)
+++ pkg/lme4Eigen/man/getME.Rd 2012-02-03 23:05:31 UTC (rev 1562)
@@ -5,7 +5,7 @@
\title{Extract or Get Generalize Components from a Fitted Mixed Effects Model}
\usage{
getME(object,
- name = c("X", "Z", "Zt", "u", "Gp", "L", "Lambda", "Lambdat", "RX", "RZX", "beta", "theta", "REML", "n_rtrms", "is_REML", "devcomp"))
+ name = c("X", "Z", "Zt", "u", "Gp", "L", "Lambda", "Lambdat", "Lind", "RX", "RZX", "beta", "theta", "REML", "n_rtrms", "is_REML", "devcomp"))
}
\arguments{
\item{object}{a fitted mixed-effects model of class
@@ -26,10 +26,12 @@
\item{Lambda}{relative covariance factor of the random
effects.} \item{Lambdat}{transpose of the relative
covariance factor of the random effects.}
- \item{RX}{Cholesky factor for the fixed-effects
- parameters} \item{RZX}{cross-term in the full Cholesky
- factor} \item{beta}{fixed-effects parameter estimates
- (same as the result of \code{\link{fixef}})}
+ \item{Lind}{index vector for inserting elements of
+ \eqn{\theta}{theta} into the nonzeros of
+ \eqn{\Lambda}{Lambda}} \item{RX}{Cholesky factor for the
+ fixed-effects parameters} \item{RZX}{cross-term in the
+ full Cholesky factor} \item{beta}{fixed-effects parameter
+ estimates (same as the result of \code{\link{fixef}})}
\item{n_rtrms}{number of random-effects terms}
\item{is_REML}{same as the result of
\code{\link{isREML}}} \item{devcomp}{a list consisting of
Modified: pkg/lme4Eigen/man/lmer.Rd
===================================================================
--- pkg/lme4Eigen/man/lmer.Rd 2012-02-03 23:03:53 UTC (rev 1561)
+++ pkg/lme4Eigen/man/lmer.Rd 2012-02-03 23:05:31 UTC (rev 1562)
@@ -105,15 +105,6 @@
(fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy))
(fm2 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy))
anova(fm1, fm2)
-
-## dense vs sparse X --------------------------
-## use more sensible example !!
-fm3.d <- lmer(Yield ~ 1|Batch, Dyestuff2)
-fm3.s <- lmer(Yield ~ 1|Batch, Dyestuff2, sparseX=TRUE)#-> warning
-## check "equality"
-stopifnot(all.equal( coef(fm3.d), coef(fm3.s), tol = 1e-14),
- all.equal(sigma(fm3.d),sigma(fm3.s), tol = 1e-14),
- TRUE)
}
\seealso{
The \code{\linkS4class{merMod}} class,
Modified: pkg/lme4Eigen/man/profile-methods.Rd
===================================================================
--- pkg/lme4Eigen/man/profile-methods.Rd 2012-02-03 23:03:53 UTC (rev 1561)
+++ pkg/lme4Eigen/man/profile-methods.Rd 2012-02-03 23:05:31 UTC (rev 1562)
@@ -34,19 +34,12 @@
\"merMod\")}{ ... } }
}
\examples{
-\dontrun{
-\%\% Do keep at least *one* such example! -- this is (also) a regression test
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) )
-
(confint(tpr) -> CIpr)
print(xyplot(tpr))
-stopifnot(dim(CIpr) == c(3,2),
- all.equal(unname(CIpr[2,]),c(3.64362, 4.21446), tol=1e-6))
}
-}
\seealso{
For (more expensive) alternative confidence intervals:
\code{\link{bootMer}}.
Added: pkg/lme4Eigen/man/rePos-class.Rd
===================================================================
--- pkg/lme4Eigen/man/rePos-class.Rd (rev 0)
+++ pkg/lme4Eigen/man/rePos-class.Rd 2012-02-03 23:05:31 UTC (rev 1562)
@@ -0,0 +1,18 @@
+\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}
+
Added: pkg/lme4Eigen/man/rePos.Rd
===================================================================
--- pkg/lme4Eigen/man/rePos.Rd (rev 0)
+++ pkg/lme4Eigen/man/rePos.Rd 2012-02-03 23:05:31 UTC (rev 1562)
@@ -0,0 +1,26 @@
+\name{rePos}
+\alias{rePos}
+\title{Generator object for the rePos (random-effects positions) class}
+\arguments{
+ \item{mer}{an object of class
+ \code{"\linkS4class{merMod}"}}
+}
+\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.
+}
+\section{Methods}{
+ \describe{ \item{\code{new(mer=mer)}}{Create a new
+ \code{\linkS4class{rePos}} object.} }
+}
+\seealso{
+ \code{\linkS4class{rePos}}
+}
+\keyword{classes}
+
More information about the Lme4-commits
mailing list