[Lme4-commits] r1766 - in pkg/lme4.0: . R man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jun 16 16:33:07 CEST 2012
Author: mmaechler
Date: 2012-06-16 16:33:07 +0200 (Sat, 16 Jun 2012)
New Revision: 1766
Modified:
pkg/lme4.0/DESCRIPTION
pkg/lme4.0/NAMESPACE
pkg/lme4.0/R/lmer.R
pkg/lme4.0/R/mlirt.R
pkg/lme4.0/man/getME.Rd
pkg/lme4.0/tests/lmer-1.Rout.save
Log:
add isLMM(), isGLMM() etc - to have them as in lme4
Modified: pkg/lme4.0/DESCRIPTION
===================================================================
--- pkg/lme4.0/DESCRIPTION 2012-06-05 20:39:48 UTC (rev 1765)
+++ pkg/lme4.0/DESCRIPTION 2012-06-16 14:33:07 UTC (rev 1766)
@@ -3,8 +3,11 @@
Date: 2012-05-08
Title: Linear mixed-effects models using S4 classes
Description: Fit linear and generalized linear mixed-effects models.
- This is the implementation of lme4 available on CRAN and developed up to 2011.
- It has been renamed to lme4.0, and is now deprecated in favor of the new lme4 package.
+ This is the implementation of lme4 available on CRAN and developed up to 2011.
+ It has been renamed to lme4.0, and is now deprecated in favor of the new lme4 package.
+ For the time being, code and other packages who have made extensive use
+ of the inner structure, e.g., of lmer() results, will have to depend on
+ lme4.0 until their code can be adapted.
Author: Douglas Bates <bates at stat.wisc.edu>,
Martin Maechler <maechler at R-project.org> and
Ben Bolker <bolker at mcmaster.ca>
Modified: pkg/lme4.0/NAMESPACE
===================================================================
--- pkg/lme4.0/NAMESPACE 2012-06-05 20:39:48 UTC (rev 1765)
+++ pkg/lme4.0/NAMESPACE 2012-06-16 14:33:07 UTC (rev 1766)
@@ -32,6 +32,7 @@
export(AIC, BIC, logLik)
## and the rest (S3 generics; regular functions):
export("HPDinterval", "getME",
+ "isLMM", "isGLMM", "isNLMM",
"isREML",
"glmer",
#"gsummary", "hatTrace",
@@ -91,6 +92,10 @@
S3method(terms, mer)# even though we have it S4 method as well
S3method(drop1, mer)
S3method(extractAIC, mer)
+S3method(isLMM, mer)
+S3method(isGLMM, mer)
+S3method(isNLMM, mer)
+S3method(isREML, mer)
S3method(plot, coef.mer)
S3method(plot, ranef.mer)
Modified: pkg/lme4.0/R/lmer.R
===================================================================
--- pkg/lme4.0/R/lmer.R 2012-06-05 20:39:48 UTC (rev 1765)
+++ pkg/lme4.0/R/lmer.R 2012-06-16 14:33:07 UTC (rev 1766)
@@ -226,6 +226,32 @@
all(diff(sm at p) < 2)
}
+
+isREML <- function(x, ...) UseMethod("isREML")
+isLMM <- function(x, ...) UseMethod("isLMM")
+isNLMM <- function(x, ...) UseMethod("isNLMM")
+isGLMM <- function(x, ...) UseMethod("isGLMM")
+
+##' @S3method isREML mer
+isREML.mer <- function(x, ...) as.logical(x at dims["REML"])
+
+##' @S3method isGLMM mer
+isGLMM.mer <- function(x,...) {
+ length(x at muEta) > 0
+ ## or: is(x at resp,"glmResp")
+}
+
+##' @S3method isNLMM mer
+isNLMM.mer <- function(x,...) {
+ ## or: is(x at resp,"nlsResp")
+ !isLMM.mer(x) & !isGLMM.mer(x)
+}
+
+##' @S3method isLMM mer
+isLMM.mer <- function(x,...) as.logical(x at dims["LMM"])
+## or: is(x at resp,"lmerResp") ?
+
+
##' dimsNames and devNames are in the package's namespace rather than
##' in the function lmerFactorList because the function sparseRasch
##' needs to access them.
@@ -340,7 +366,6 @@
## check for nesting of factors
dd["nest"] <- all(sapply(seq_along(fl)[-1],
function(i) isNested(fl[[i-1]], fl[[i]])))
-
list(trms = trms, fl = fl, dims = dd)
}
@@ -366,8 +391,10 @@
msVerbose = as.integer(msVerbose))# "integer" on purpose
}
+##' Generate a named vector of the given mode.
+##' NB: If \code{defaults} contains more than one entry of a given name,
+##' the *last* one wins
VecFromNames <- function(nms, mode = "numeric", defaults = list())
-### Generate a named vector of the given mode
{
ans <- vector(mode = mode, length = length(nms))
names(ans) <- nms
@@ -626,7 +653,7 @@
stopifnot(length(formula <- as.formula(formula)) == 3)
fr <- lmerFrames(mc, formula, contrasts) # model frame, X, etc.
- FL <- lmerFactorList(formula, fr, 0L, 0L) # flist, Zt, dims
+ FL <- lmerFactorList(formula, fr, rmInt=FALSE, drop=FALSE) # flist, Zt, dims
largs <- list(...)
if (!is.null(method <- largs$method)) {
warning(paste("Argument", sQuote("method"),
@@ -641,6 +668,7 @@
### FIXME: issue a warning if the control argument has an msVerbose component
cv <- do.call(lmerControl, control)
if (missing(verbose)) verbose <- cv$msVerbose
+ FL$dims["LMM"] <- 1L
FL$dims["mxit"] <- cv$maxIter
FL$dims["mxfn"] <- cv$maxFN
ans <- list(fr = fr, FL = FL, start = start, REML = REML, verbose = verbose)
@@ -705,7 +733,7 @@
glmFit <- glm.fit(fr$X, fr$Y, weights = wts, # glm on fixed effects
offset = offset, family = family,
intercept = attr(attr(fr$mf, "terms"), "intercept") > 0)
- FL <- lmerFactorList(formula, fr, 0L, 0L) # flist, Zt
+ FL <- lmerFactorList(formula, fr, rmInt=FALSE, drop=FALSE) # flist, Zt
### FIXME: issue a warning if the control argument has an msVerbose component
cv <- do.call(lmerControl, control)
if (missing(verbose)) verbose <- cv$msVerbose
@@ -773,7 +801,7 @@
# factor list and model matrices
FL <- lmerFactorList(substitute(foo ~ bar, list(foo = nlform[[2]],
bar = formula[[3]])),
- fr, TRUE, TRUE)
+ fr, rmInt=TRUE, drop=TRUE)
X <- as.matrix(mf[,pnames])
rownames(X) <- NULL
xnms <- colnames(fr$X)
@@ -2320,29 +2348,6 @@
function (ind) unlist(reinds(fm at Gp)[ind]))
-## From: Soren.Hojsgaard at agrsci.dk
-## To: "maechler at stat.math.ethz.ch" <maechler at stat.math.ethz.ch>
-## CC: "bates at stat.wisc.edu" <bates at stat.wisc.edu>, Ulrich Halekoh
-## <Ulrich.Halekoh at agrsci.dk> <Soren.Hojsgaard at agrsci.dk>
-## Date: Thu, 18 Aug 2011 15:22:05 +0200
-## Subject: Slots that we extract to do Kenward-Roger approximation
-
-## Dear Martin,
-
-## It seems that what we extract is:
-
-## @X
-## @Gp
-## @Zt
-## @dims['REML']
-## @dims['nt']
-
-##' @rdname getME
-##' @param x [ng]lmer() fit
-isREML <- function(object) {
- getME(object,"is_REML")
-}
-
##' "Generalized Extractor" -- the version for classical lme4
##' @param object [ng]lmer() fit
##' @param name character string
Modified: pkg/lme4.0/R/mlirt.R
===================================================================
--- pkg/lme4.0/R/mlirt.R 2012-06-05 20:39:48 UTC (rev 1765)
+++ pkg/lme4.0/R/mlirt.R 2012-06-16 14:33:07 UTC (rev 1766)
@@ -37,7 +37,7 @@
mf$.subj <- gl(nr, 1, nr*nc)
form <- substitute(Y ~ base + (1|.subj), list(base = formula[[3]]))
## establish factor list and Ztl
- FL <- lmerFactorList(form, mf, 0L, 0L)
+ FL <- lmerFactorList(form, mf, rmInt=FALSE, drop=FALSE)
fl <- FL$fl
## initial fit of a glm to the fixed-effects only.
glmFit <- glm.fit(X, Y, weights = fl$weights[ind],
Modified: pkg/lme4.0/man/getME.Rd
===================================================================
--- pkg/lme4.0/man/getME.Rd 2012-06-05 20:39:48 UTC (rev 1765)
+++ pkg/lme4.0/man/getME.Rd 2012-06-16 14:33:07 UTC (rev 1766)
@@ -1,6 +1,9 @@
\name{getME}
\alias{getME}
\alias{isREML}
+\alias{isLMM}
+\alias{isGLMM}
+\alias{isNLMM}
\title{Extract or Get Generalize Components from a Fitted Mixed Effects Model}
\description{
Extract (or \dQuote{get}) \dQuote{components} -- in a generalized
@@ -14,24 +17,29 @@
}
\usage{
getME(object, name)
-isREML(object)
+
+isREML(x, ...)
+
+isLMM(x, ...)
+isNLMM(x, ...)
+isGLMM(x, ...)
}
\arguments{
- \item{object}{a fitted mixed-effects model of class
+ \item{object,x}{a fitted mixed-effects model of class
\code{"\linkS4class{mer}"}, i.e. typically the result of
\code{\link{lmer}()}, \code{\link{glmer}()} or \code{\link{nlmer}()}.
}
\item{name}{a character string specifying the name of the
\dQuote{component}. Note this may not be the name of
\code{\link{slot}} of \code{object}. }
+ \item{...}{additional, optional arguments. (None are used in the
+ \code{mer} methods.)}
}
\value{
Unspecified, as very much depending on the \code{\link{name}}.
}
\seealso{
-% \code{\link{getCall}()} (in \R >= 2.14.0; otherwise in \pkg{MatrixModels}).
-% no \link{} -> no warning ...
- \code{getCall()} (in \R >= 2.14.0; otherwise in \pkg{MatrixModels}).
+ \code{\link{getCall}()} (in \R >= 2.14.0; otherwise in \pkg{MatrixModels}).
More standard methods for \code{*mer()} objects, such as
\code{\link{ranef}},
@@ -44,6 +52,11 @@
showMethods(class = "mer")
(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))
+
Z <- getME(fm1, "Z")
stopifnot(is(Z, "CsparseMatrix"),
c(180,36) == dim(Z),
@@ -56,8 +69,21 @@
\dontshow{
## internal consistency check ensuring that all work:
## "try(.)" because some are not yet implemented:
-str(parts <- sapply(nmME, function(nm) try(getME(fm1, nm)),
+str(fm.parts <- sapply(nmME, function(nm) try(getME(fm1, nm)),
simplify=FALSE))
+
+str(gm.parts <- sapply(nmME, function(nm) try(getME(gm1, nm)),
+ simplify=FALSE))
+
+str(nm.parts <- sapply(nmME, function(nm) try(getME(nm1, nm)),
+ simplify=FALSE))
}% dont..
+
+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)))
}
\keyword{utilities}
Modified: pkg/lme4.0/tests/lmer-1.Rout.save
===================================================================
--- pkg/lme4.0/tests/lmer-1.Rout.save 2012-06-05 20:39:48 UTC (rev 1765)
+++ pkg/lme4.0/tests/lmer-1.Rout.save 2012-06-16 14:33:07 UTC (rev 1766)
@@ -1,5 +1,5 @@
-R version 2.14.2 RC (2012-02-26 r58499)
+R version 2.15.1 beta (2012-06-14 r59562) -- "Roasted Marshmallows"
Copyright (C) 2012 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: x86_64-unknown-linux-gnu (64-bit)
@@ -264,7 +264,7 @@
+ m2 <- lmer(incidence / size ~ period, weights = size,
+ family = binomial, data = cbpp)
+ )
-Error in lmerFactorList(formula, fr, 0L, 0L) :
+Error in lmerFactorList(formula, fr, rmInt = FALSE, drop = FALSE) :
No random effects terms specified in formula
>
> ## useRs can set LME4_UNSAFE_BLAS for less strict checking:
@@ -325,7 +325,7 @@
Slot "dims":
nt n p q s np LMM REML fTyp lTyp vTyp nest useSc
- 1 10 1 2 1 1 0 1 2 5 1 1 1
+ 1 10 1 2 1 1 1 1 2 5 1 1 1
nAGQ verb mxit mxfn cvg
1 0 300 900 4
@@ -366,7 +366,7 @@
Slot "dims":
nt n p q s np LMM REML fTyp lTyp vTyp nest useSc
- 1 10 1 2 1 1 0 1 2 5 1 1 1
+ 1 10 1 2 1 1 1 1 2 5 1 1 1
nAGQ verb mxit mxfn cvg
1 0 300 900 4
@@ -416,7 +416,7 @@
Slot "dims":
nt n p q s np LMM REML fTyp lTyp vTyp nest useSc
- 1 20 1 2 1 1 0 1 2 5 1 1 1
+ 1 20 1 2 1 1 1 1 2 5 1 1 1
nAGQ verb mxit mxfn cvg
1 0 300 900 4
@@ -484,7 +484,7 @@
Slot "dims":
nt n p q s np LMM REML fTyp lTyp vTyp nest useSc
- 1 20 2 4 1 3 0 1 2 5 1 1 1
+ 1 20 2 4 1 3 1 1 2 5 1 1 1
nAGQ verb mxit mxfn cvg
1 0 300 900 5
@@ -635,5 +635,8 @@
> if(.unsafe.BLAS) rm(identical)
>
> cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons''
-Time elapsed: 6.081 0.176 7.526 0 0.008
+Time elapsed: 6.352 0.052 6.414 0 0
>
+> proc.time()
+ user system elapsed
+ 6.352 0.052 6.414
More information about the Lme4-commits
mailing list