
R version 4.5.1 (2025-06-13 ucrt) -- "Great Square Root"
Copyright (C) 2025 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.

  Natural language support but running in an English locale

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.

[Previously saved workspace restored]

> ###################################################
> ### code chunk Chap14init
> ###################################################
> options(width=65, digits=5, show.signif.stars = FALSE)   
> date()
[1] "Mon Aug  4 20:09:32 2025"
> packageVersion("nlmeU")
[1] '0.75.0'
> packageVersion("nlme")
[1] '3.1.166'
> sessionInfo()
R version 4.5.1 (2025-06-13 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 22631)

Matrix products: default
  LAPACK version 3.12.1

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

time zone: America/New_York
tzcode source: internal

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

loaded via a namespace (and not attached):
[1] compiler_4.5.1 nlme_3.1-166   grid_4.5.1     lattice_0.22-6
> data(armd, package = "nlmeU")
> 
> ###################################################
> ### code chunk: R14.1a
> ###################################################
> library(nlme)
> (pdCS0    <- pdCompSymm(~agex))               
Uninitialized positive definite matrix structure of class pdCompSymm.
> isInitialized(pdCS0)                               # Not initialized        
[1] FALSE
> 
> 
> ###################################################
> ### code chunk: R14.1b
> ###################################################
> mtxUN    <- matrix(c(4, 1, 1, 9), nrow = 2)        # pdSymm matrix
> dt1      <- data.frame(agex = c(15, 45, 71, 82))   # Numeric age
> (pdSm    <- pdSymm(mtxUN, ~agex, data = dt1))               
Positive definite matrix structure of class pdSymm representing
            (Intercept) agex
(Intercept)           4    1
agex                  1    9
> isInitialized(pdSm)                             # Initialized
[1] TRUE
> 
> 
> ###################################################
> ### code chunk: R14.1c
> ###################################################
> mtxCS    <- matrix(4 * diag(3) + 1, nrow = 3)      # CompSymm matrix
> dt2      <- data.frame(agef = c("Y", "M", "O", "O")) # Factor age 
> (pdCSf   <- pdCompSymm(mtxCS, ~-1 + agef, data = dt2))               
Positive definite matrix structure of class pdCompSymm representing
      agefM agefO agefY
agefM     5     1     1
agefO     1     5     1
agefY     1     1     5
> 
> 
> ###################################################
> ### code chunk: R14.2a
> ###################################################
> summary(pdSm)               # Summary
 Formula: ~agex
 Structure: General positive-definite
            StdDev Corr  
(Intercept) 2      (Intr)
agex        3      0.167 
> formula(pdSm)               # Formula
~agex
> Names(pdSm)                 # Row/col names
[1] "(Intercept)" "agex"       
> (Dmtx <- as.matrix(pdSm))   # D matrix
            (Intercept) agex
(Intercept)           4    1
agex                  1    9
> Dim(pdSm)                   # Dimensions of D  
[1] 2 2
> logDet(pdSm)                # log|D^(1/2)|
[1] 1.7777
> 
> # VarCorr(pdSm)             # Variances, correlation coefficients
> # corMatrix(pdSm)           # Corr(D)
> 
> 
> ###################################################
> ### code chunk: 14.2b
> ###################################################
> Names(pdCSf)                 # Row/col names
[1] "agefM" "agefO" "agefY"
> as.matrix(pdCSf)             # D matrix
      agefM agefO agefY
agefM     5     1     1
agefO     1     5     1
agefY     1     1     5
> 
> 
> ###################################################
> ### code chunk: 14.3a
> ###################################################
> coef(pdSm, unconstrained = FALSE)   # Constrained coefficients   
     var((Intercept)) cov(agex,(Intercept)) 
                    4                     1 
            var(agex) 
                    9 
> coef(pdSm)                          # Unconstrained coefficients  
[1] 0.68424 0.08184 1.09344
> 
> 
> ###################################################
> ### code chunk: 14.3b
> ###################################################
> coef(pdCSf, unconstrained = FALSE)  # Constrained coefficients  
std. dev    corr. 
  2.2361   0.2000 
> coef(pdCSf)                         # Unconstrained coefficients  
[1]  0.80472 -0.13353
> log(5)/2                            # First coefficient verified 
[1] 0.80472
> rho <- 0.2                          # rho
> nc  <- 3                            # No. of columns
> aux <- (rho + 1/(nc - 1))/(1 - rho) # Modified Fisher's z: (10.35)
> log(aux)                            # Second coefficient verified
[1] -0.13353
> 
> 
> ###################################################
> ### code chunk: R14.4a
> ###################################################
> pdSm0 <- pdSymm(mtxUN)
> coef(pdSm0)                     # Unconstrained theta_D  
[1] 0.68424 0.08184 1.09344
> Dmtx <- pdMatrix(pdSm0)         # Matrix D
> CholD <- chol(Dmtx)             # Cholesky factor U of D: D=U'U
> vd <- svd(CholD, nu=0)          # SVD of U: (13.46)
> vd$v %*% (log(vd$d) * t(vd$v))  # (13.47)
        [,1]    [,2]
[1,] 0.68424 0.08184
[2,] 0.08184 1.09344
> 
> 
> ###################################################
> ### code chunk: R14.4b
> ###################################################
> pdLCh <- pdLogChol(mtxUN)
> coef(pdLCh)                     # Unconstrained coefficients theta_D  
[1] 0.69315 1.08453 0.50000
> LChD  <- CholD                  # U
> diag(LChD) <- log(diag(LChD))   # \diag(U) log-transformed
> LChD
        [,1]   [,2]
[1,] 0.69315 0.5000
[2,] 0.00000 1.0845
> 
> 
> ###################################################
> ### code chunk: R14.4c
> ###################################################
> pdNat <- pdNatural(mtxUN)
> coef(pdNat)                     # Unconstrained theta_D 
[1] 0.69315 1.09861 0.33647
> log(sqrt(diag(Dmtx)))           # log(SDs)
[1] 0.69315 1.09861
> corD  <- cov2cor(Dmtx)          # Corr(D)
> rho   <- corD[upper.tri(corD)]  # rho_ij (for i<j) 
> log((1+rho)/(1-rho))            # Fisher's z: (10.33)
[1] 0.33647
> 
> 
> ###################################################
> ### code chunk: R14.5
> ###################################################
> reSt <- reStruct(list(g1=pdSm,   # D_1
+                       g2=pdCSf)) # D_2 
> isInitialized(reSt)
[1] TRUE
> names(reSt)                      # Note: order g1, g2 reversed 
[1] "g2" "g1"
> formula(reSt)                    # Formulae for pdMat components
$g2
~-1 + agef

$g1
~agex

> getGroupsFormula(reSt)           # Model hierarchy
~g1/g2
<environment: 0x0000024435b2e308>
> Names(reSt)                      # Row/col names for pdMat components
$g2
[1] "agefM" "agefO" "agefY"

$g1
[1] "(Intercept)" "agex"       

> 
> 
> ###################################################
> ### code chunk: R14.6a
> ###################################################
> as.matrix(reSt)            # D_1,D_2   
$g1
            (Intercept) agex
(Intercept)           4    1
agex                  1    9

$g2
      agefM agefO agefY
agefM     5     1     1
agefO     1     5     1
agefY     1     1     5

> coef(reSt)                 # Unconstrained coefs for D_2,D_1   
     g21      g22      g11      g12      g13 
 0.80472 -0.13353  0.68424  0.08184  1.09344 
> 
> 
> ###################################################
> ### code chunk: R14.6b
> ###################################################
> reSt[["g1"]]                     # See pdSm in Panel R14.1b
Positive definite matrix structure of class pdSymm representing
            (Intercept) agex
(Intercept)           4    1
agex                  1    9
> g2.pdMat  <- reSt[["g2"]]        # See pdCSf in Panel R14.1c
> all.equal(pdCSf, g2.pdMat)       # g2.pdMat and pdCSf are equal
[1] TRUE
> 
> ###################################################
> ### code chunk: R14.7
> ###################################################
> Zmtx1 <- model.matrix(formula(pdSm), dt1)                    
> prmatrix(Zmtx1)                 # Design matrix Z_1 for pdSm
  (Intercept) agex
1           1   15
2           1   45
3           1   71
4           1   82
> Zmtx2 <- model.matrix(formula(pdCSf),dt2)                    
> prmatrix(Zmtx2)                 # Design matrix Z_2 for pdCSf 
  agefM agefO agefY
1     0     0     1
2     1     0     0
3     0     1     0
4     0     1     0
> dtz  <- data.frame(dt1,dt2)     # Data frame to evaluate reSt 
> Zmtx <- model.matrix(reSt, dtz) # Design matrix Z for reSt 
> prmatrix(Zmtx)                  # Matrix Z w/out attributes
  g2.agefM g2.agefO g2.agefY g1.(Intercept) g1.agex
1        0        0        1              1      15
2        1        0        0              1      45
3        0        1        0              1      71
4        0        1        0              1      82
> 
> 
> ###################################################
> ### code chunk: R14.8
> ###################################################
> reSt  <- reStruct(list(g1 = pdSm, g2 = pdCSf))         # reStruct class
> corSt <- corExp(c(0.3, 0.1), form=~tx, nugget = TRUE)  # corStruct class
> vF    <- varExp(0.8, form = ~agex)                     # varFunc class
> (lmeSt<- lmeStruct(reStruct = reSt, corStruct=corSt,   # lmeStruct class
+           varStruct = vF))                             # ... created.
reStruct  parameters:
     g21      g22      g11      g12      g13 
 0.80472 -0.13353  0.68424  0.08184  1.09344 
corStruct  parameters:
 range nugget 
   0.3    0.1 
varStruct  parameters:
expon 
  0.8 
> coefs <- coef(lmeSt,unconstrained=FALSE) # Constrained coefficients...
> (as.matrix(coefs))                       # ...printed more compactly
                                     [,1]
reStruct.g2.std. dev              2.23607
reStruct.g2.corr.                 0.20000
reStruct.g1.var((Intercept))      4.00000
reStruct.g1.cov(agex,(Intercept)) 1.00000
reStruct.g1.var(agex)             9.00000
corStruct.range                   1.34986
corStruct.nugget                  0.52498
varStruct.expon                   0.80000
> 
> #### sessionInfo ###
> library(nlmeU)

Attaching package: 'nlmeU'

The following objects are masked _by_ '.GlobalEnv':

    armd, armd.wide, fcat, prt, prt.subjects, SIIdata

> sessionInfo()           # with packages attached
R version 4.5.1 (2025-06-13 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 22631)

Matrix products: default
  LAPACK version 3.12.1

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

time zone: America/New_York
tzcode source: internal

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

other attached packages:
[1] nlmeU_0.75-0 nlme_3.1-166

loaded via a namespace (and not attached):
[1] compiler_4.5.1 tools_4.5.1    grid_4.5.1     lattice_0.22-6
> detach(package:nlmeU)
> detach(package:nlme)
> 
> proc.time()
   user  system elapsed 
   0.14    0.06    0.40 
