
R version 2.15.0 (2012-03-30)
Copyright (C) 2012 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: x86_64-pc-mingw32/x64 (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.

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.

> ##  NOTE: This code pertains to panels R15.5 - R15.7
> ##  To execute code in this file package lme4.0 has to be used. 
> 
> 
> ###################################################
> ### code chunk Chap15init
> ###################################################
> options(width=65, digits=5, show.signif.stars = FALSE) 
> date()
[1] "Wed Mar 06 17:40:11 2013"
> packageVersion("lme4.0")
[1] '0.9999.2'
> packageVersion("Matrix")
[1] '1.0.6'
> sessionInfo()
R version 2.15.0 (2012-03-30)
Platform: x86_64-pc-mingw32/x64 (64-bit)

locale:
[1] LC_COLLATE=C                          
[2] LC_CTYPE=English_United States.1252   
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     
> SeedValue <- 17761
> set.seed(SeedValue)
> 
> ###################################################
> ### code chunk: R15.1
> ###################################################
> n1 <- 2                 # Number of levels for the factor g1
> n2 <- 3                 # Number of levels for the factor g2
> i <- gl(n1, n2)         # i 
> j <- gl(n2, 1, n1*n2)   # j
> b1x <- rnorm(n1, 0, 1)  # b_i
> b2x <- rnorm(n2, 0, 2)  # b_j
> dt0 <- data.frame(i, j)
> (dtc <- 
+    within(dt0,
+           {             # g1 and g2 are crossed
+            eps <- rnorm(nrow(dt0), 0, 0.2)
+            b1 <- b1x[i]
+            b2 <- b2x[j]
+            y <- 10 + b1 + b2 + eps
+            g2 <- factor(j, labels = letters[1:n2])
+            g1 <- factor(LETTERS[i])
+            }))
  i j g1 g2       y        b2      b1       eps
1 1 1  A  a 10.1444 -0.055214 0.13972  0.059933
2 1 2  A  b 12.2306  2.012640 0.13972  0.078235
3 1 3  A  c  9.3669 -0.601585 0.13972 -0.171216
4 2 1  B  a 11.2304 -0.055214 1.25311  0.032463
5 2 2  B  b 13.1089  2.012640 1.25311 -0.156847
6 2 3  B  c 10.8498 -0.601585 1.25311  0.198232
> 
> ###################################################
> ### code chunk: R15.5
> ###################################################
> require(lme4.0)
Loading required package: lme4.0
Loading required package: Matrix
Loading required package: lattice

Attaching package: 'lme4.0'

The following object(s) are masked from 'package:stats':

    AIC, BIC

> fmc <- lmer(y ~ 1 + (1|g1) + (1|g2), data = dtc)
> summary(fmc)
Linear mixed model fit by REML 
Formula: y ~ 1 + (1 | g1) + (1 | g2) 
   Data: dtc 
  AIC  BIC logLik deviance REMLdev
 21.1 20.3  -6.56     14.8    13.1
Random effects:
 Groups   Name        Variance Std.Dev.
 g2       (Intercept) 1.7807   1.334   
 g1       (Intercept) 0.6444   0.803   
 Residual             0.0472   0.217   
Number of obs: 6, groups: g2, 3; g1, 2

Fixed effects:
            Estimate Std. Error t value
(Intercept)   11.155      0.961    11.6
> gf <- getME(fmc, "flist")     # Grouping factors
> xtabs(~g1 + g2, gf)           # g1 and g2 fuly crossed 
   g2
g1  a b c
  A 1 1 1
  B 1 1 1
> (Zt <- getME(fmc, "Zt"))      # Z'
5 x 6 sparse Matrix of class "dgCMatrix"
                
[1,] 1 . . 1 . .
[2,] . 1 . . 1 .
[3,] . . 1 . . 1
[4,] 1 1 1 . . .
[5,] . . . 1 1 1
> 
> 
> 
> ###################################################
> ### code chunk: R15.6
> ###################################################
> STs <- expand(fmc)         # Expand the ST slot
> summary(STs)
      Length Class     Mode   
sigma  1     -none-    numeric
P     25     pMatrix   S4     
T     25     dtCMatrix S4     
S     25     ddiMatrix S4     
> (P <- STs$P)               # Permutation matrix P
5 x 5 sparse Matrix of class "pMatrix"
              
[1,] . . | . .
[2,] | . . . .
[3,] . | . . .
[4,] . . . | .
[5,] . . . . |
> S <- STs$S                 # Diagonal scale-matrix S
> summary(S)
5 x 5 sparse Matrix of class "ddiMatrix", with 5 entries 
  i j      x
1 1 1 6.1439
2 2 2 6.1439
3 3 3 6.1439
4 4 4 3.6959
5 5 5 3.6959
> T <- STs$T                 # Unit lower-triangular matrix T
> summary(T)                 # All off-diagonal elements equal to 0       
5 x 5 sparse Matrix of class "dtCMatrix", with 0 entries 
[1] i j x
<0 rows> (or 0-length row.names)
> 
> 
> ###################################################
> ### code chunk: R15.7
> ###################################################
> TS <- T %*% S            
> (sig <- STs$sigma)                 # sigma 
[1] 0.2172
> sig * sig * tcrossprod(TS)         # D = sigma^2 TSST'13.9), (13.33)
5 x 5 sparse Matrix of class "dsCMatrix"
                                       
[1,] 1.7807 .      .      .      .     
[2,] .      1.7807 .      .      .     
[3,] .      .      1.7807 .      .     
[4,] .      .      .      0.6444 .     
[5,] .      .      .      .      0.6444
> A  <- getME(fmc, "A")                
> ZTS <- t(Zt) %*% TS                # Z*T*S
> max(abs(t(A) - ZTS ))              # A' = Z*T*S : (13.34)
[1] 0
> Ac <- tcrossprod(A)                # A*A'
> AcI <- Ac + diag(1, nrow(A))       # A*A' + I
> Ls <- slot(fmc, "L")               # L_Z (13.38)
> PP <- P %*% AcI %*% t(P)           # P*(A*A' + I)*P'
> L <- as(Ls, "sparseMatrix")
> max(abs(tcrossprod(L) - PP))       # L_Z*L_Z' = P*(A*A' + I)*P': (13.38)  
[1] 0.0024641
> 
> ### sessionInfo
> sessionInfo()                      # Before detaching packages
R version 2.15.0 (2012-03-30)
Platform: x86_64-pc-mingw32/x64 (64-bit)

locale:
[1] LC_COLLATE=C                          
[2] LC_CTYPE=English_United States.1252   
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

other attached packages:
[1] lme4.0_0.9999-2 Matrix_1.0-6    lattice_0.20-6 

loaded via a namespace (and not attached):
[1] grid_2.15.0   nlme_3.1-103  stats4_2.15.0
> detach(package:lme4.0) 
> 
> 
> proc.time()
   user  system elapsed 
   4.36    0.06    4.43 
