[Lme4-commits] r1505 - in pkg/lme4a: man tests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jan 12 16:08:53 CET 2012


Author: mmaechler
Date: 2012-01-12 16:08:53 +0100 (Thu, 12 Jan 2012)
New Revision: 1505

Added:
   pkg/lme4a/man/getL.Rd
Modified:
   pkg/lme4a/tests/lmer-1.Rout.save
   pkg/lme4a/tests/simulate.R
Log:
update -- to pass R CMD check

Copied: pkg/lme4a/man/getL.Rd (from rev 1351, pkg/lme4a/man/getL.Rd)
===================================================================
--- pkg/lme4a/man/getL.Rd	                        (rev 0)
+++ pkg/lme4a/man/getL.Rd	2012-01-12 15:08:53 UTC (rev 1505)
@@ -0,0 +1,57 @@
+\name{getL}
+\title{Extract the  L  Matrix from a *Mer object}
+\alias{getL}
+\alias{getL-methods}
+\alias{getL,merMod-method}
+\alias{getL,reModule-method}
+\description{
+  \bold{Note that getL() is deprecated} and replaced by \code{getME(*, "L")}.
+
+  Extract the Cholesky factor \eqn{L} from a \code{*mer} fitted object.
+  A simple utility returning \eqn{L} independently from the inner
+  detailed structure of \code{x}.
+}
+\usage{
+getL(x)
+}
+\arguments{
+  \item{x}{a fitted model, result of \code{\link{lmer}()},
+    \code{\link{glmer}()}, or similar.}
+}
+\section{Methods}{
+  \describe{
+    \item{\code{signature(x = "lmerMod")}}{ }%% FIXME
+    \item{\code{signature(x = "mer")}}{ }
+    \item{\code{signature(x = "merenv")}}{ }
+    \item{\code{signature(x = "reModule")}}{ }
+  }
+}
+\details{
+  The Cholesky factor \eqn{L} is a lower triangular
+  \eqn{q \times q}{q x q} matrix, defined by
+  \deqn{L L' = \Lambda' Z'Z \Lambda + I_q}{L L' = Lambda' Z'Z Lambda + I_q},
+  where \eqn{I_q} is the identity and
+  \eqn{\Lambda = \Lambda_\theta = \Lambda(\theta)}{Lambda = Lambda(\theta)}
+  is the relative covariance factor (typically lower triangular as
+  well), generating the \eqn{q \times q}{q x q} variance-covariance
+  matrix \eqn{\Sigma_\theta}{Sigma(theta)} as
+  \deqn{\Sigma_\theta = \sigma^2 \Lambda_\theta{\Lambda_{\theta}}^T.%
+  }{Sigma = sigma^2 Lambda Lambda^T.}
+%%% FIXME: put this nice formula section into another help page _FIXME_
+}
+\value{
+  the Cholesky factor \eqn{L}, an object extending class
+  \code{\linkS4class{CHMfactor}},
+  (currently typically of class \code{\linkS4class{CHMsimpl}}.
+}
+%\references{Douglas Bates (2010).  lme4: Mixed Models with R
+%}
+% \seealso{
+% }
+% \examples{
+% ## (see  help(Penicillin)):
+% fm1 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin)
+% image(getL(fm1),
+%       sub = "Structure of random effects interaction in penicillin model")
+% }
+\keyword{methods}

Modified: pkg/lme4a/tests/lmer-1.Rout.save
===================================================================
--- pkg/lme4a/tests/lmer-1.Rout.save	2012-01-10 20:53:54 UTC (rev 1504)
+++ pkg/lme4a/tests/lmer-1.Rout.save	2012-01-12 15:08:53 UTC (rev 1505)
@@ -1,6 +1,6 @@
 
-R version 2.14.0 Under development (unstable) (2011-05-31 r56025)
-Copyright (C) 2011 The R Foundation for Statistical Computing
+R version 2.14.1 Patched (2012-01-11 r58090)
+Copyright (C) 2012 The R Foundation for Statistical Computing
 ISBN 3-900051-07-0
 Platform: x86_64-unknown-linux-gnu (64-bit)
 
@@ -22,18 +22,11 @@
 > 
 > source(system.file("test-tools.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
+> ## Is now (2011-02-18) in Matrix test-tools (i.e., sourced already):
+> S4_2list <- function(obj) {
 +    sn <- slotNames(obj)
 +    structure(lapply(sn, slot, object = obj), .Names = sn)
 + }
-> ## Is now (2010-09-03) in Matrix' test-tools.R above
-> showProc.time <- local({
-+     pct <- proc.time()
-+     function() { ## CPU elapsed __since last called__
-+ 	ot <- pct ; pct <<- proc.time()
-+ 	cat('Time elapsed: ', (pct - ot)[1:3],'\n')
-+     }
-+ })
 > 
 > (fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy))
 Linear mixed model fit by REML ['merMod']
@@ -170,7 +163,7 @@
 + 			  c(1,3), dimnames = list("(Intercept)",
 + 				  c("Estimate", "Std. Error", "t value")))))
 > showProc.time() #
-Time elapsed:  10.22 0.01 10.824 
+Time elapsed:  2.044 0.014 2.103 
 > 
 > ### {from ../man/lmer.Rd } --- compare lmer & lmer1 ---------------
 > (fmX1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy))
@@ -266,7 +259,7 @@
 > #fmX2s <- lmer2(Reaction ~ Days + (Days|Subject), sleepstudy, sparseX=TRUE)
 > 
 > showProc.time() #
-Time elapsed:  2.95 0.01 3.203 
+Time elapsed:  0.574 0.004 0.584 
 > 
 > for(nm in c("coef", "fixef", "ranef", "sigma",
 + 	     "model.matrix", "model.frame" , "terms")) {
@@ -325,7 +318,7 @@
 At return
  18:     100.15189: 0.641815
 At return
- 72:     100.09586: 0.642261 -1.39853 -0.992333 -1.12867 -1.58031
+ 85:     100.09586: 0.642261 -1.39853 -0.992333 -1.12867 -1.58031
 > stopifnot(is((cm1 <- coef(m1)), "coef.mer"),
 + 	  dim(cm1$herd) == c(15,4),
 + 	  all.equal(fixef(m1), ##  these values are those of "old-lme4":
@@ -408,7 +401,7 @@
 
 > 
 > showProc.time() #
-Time elapsed:  2.54 0.02 2.644 
+Time elapsed:  0.752 0.001 0.768 
 > 
 > if (require('MASS', quietly = TRUE)) {
 +     bacteria$wk2 <- bacteria$week > 2
@@ -459,7 +452,7 @@
 trtdiag     -0.044              
 trtencourag  0.064 -0.495       
 wk2TRUE     -0.794  0.063 -0.056
-Time elapsed:  2.32 0.03 2.461 
+Time elapsed:  0.263 0.007 0.338 
 > 
 > ## Invalid factor specification -- used to seg.fault:
 > set.seed(1)
@@ -595,7 +588,7 @@
 +             )
 > 
 > showProc.time() #
-Time elapsed:  1.86 0.02 1.943 
+Time elapsed:  0.364 0.003 0.371 
 > 
 > ## Wrong formula gave a seg.fault at times:
 > set.seed(2)# !
@@ -615,7 +608,7 @@
 In Ops.factor(ff, x1) : + not meaningful for factors
 > 
 > showProc.time() #
-Time elapsed:  7.93 0.01 8.181 
+Time elapsed:  2.082 0.009 2.123 
 > 
 > ## Reordering of grouping factors should not change the internal structure
 > #Pm1  <- lmer1(strength ~ (1|batch) + (1|sample), Pastes, doFit = FALSE)
@@ -646,7 +639,6 @@
 > ##'                                   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
-> set.seed(1)
 > rPoisGLMMi <- function(ng, nr, sd=c(f = 1, ind = 0.5), b=c(1,2))
 + {
 +   stopifnot(nr >= 1, ng >= 1,
@@ -665,6 +657,8 @@
 +          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))
@@ -699,5 +693,5 @@
 m1  4  624.76  638.68 -308.38   616.76 554.33      1  < 2.2e-16
 > 
 > showProc.time()
-Time elapsed:  2.15 0 2.209 
+Time elapsed:  0.302 0.004 0.312 
 > 

Modified: pkg/lme4a/tests/simulate.R
===================================================================
--- pkg/lme4a/tests/simulate.R	2012-01-10 20:53:54 UTC (rev 1504)
+++ pkg/lme4a/tests/simulate.R	2012-01-12 15:08:53 UTC (rev 1505)
@@ -6,13 +6,11 @@
 fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
 fm2 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)
 
-## MM: FIXME? -- why not be more compatible to simulate.lm()
-##              which returns a data frame both for nsim=1 and nsim > 1 ??
 s1 <- simulate(fm1)
-stopifnot(is.numeric(s1), is.null(dim(s1)))  ## returns vector
+stopifnot(is.numeric(s1), ncol(s1)==1)
 showProc.time()
 s2 <- simulate(fm1,10)
-stopifnot(is.numeric(s2), ncol(s2)==10)      ## returns matrix
+stopifnot(is.numeric(s2), ncol(s2)==10)
 showProc.time()
 
 ## binomial (non-Bernoulli)
@@ -20,13 +18,17 @@
 	     family = binomial, data = cbpp)
 gm0 <- update(gm1, . ~. -period)
 
+if(FALSE) {## FIXME -- not implemented for glmer
 s1 <- simulate(gm1)
 stopifnot(is.numeric(s1), ncol(s1)==2)
 s2 <- simulate(gm1,10)
 stopifnot(is.list(s2), sapply(s2,ncol)==2,
 	  sapply(s2,nrow) == nrow(cbpp))
+
 showProc.time()
 
+## FIXME --- refit() no longer implemented in lme4a
+
 pboot <- function(m0,m1) {
   s <- simulate(m0)
   L0 <- logLik(refit(m0,s))
@@ -41,6 +43,7 @@
 r1 <- replicate(10,pboot(gm0,gm1))
 summary(r1)
 showProc.time()
+}##-- end if(FALSE)
 
 ## FIXME: want real Poisson example, but will have to simulate one instead for now
 nobs <- 50
@@ -60,6 +63,7 @@
 ##  ggplot(d,aes(x=x,y=y,colour=f))+stat_sum(aes(size=..n..))
 
 gm3 <- glmer(y~x+(1|f),data=d,family=poisson)
+if(FALSE){## FIXME
 s3 <- simulate(gm3,seed=1001)
 showProc.time()
 stopifnot(is.numeric(s3), length(s3)==nrow(d))
@@ -68,6 +72,7 @@
 stopifnot(is.numeric(s4), nrow(s4)==nrow(d), ncol(s4)==10)
 
 invisible(refit(gm3,s4[,1]))
+} ## end if(FALSE)
 
 ## simulate with offset
 d$offset <- rep(1,nobs)
@@ -77,6 +82,8 @@
 d$y <- rpois(nobs,lambda=mu)
 
 gm4 <- glmer(y~x+(1|f),offset=offset,data=d,family=poisson)
+if(FALSE){## FIXME
 s5 <- simulate(gm4,seed=1001)
 stopifnot(is.numeric(s5), length(s5)==nrow(d))
 showProc.time()
+}



More information about the Lme4-commits mailing list