├── README.md └── brown-cfa ├── README.md └── allExamples.R /README.md: -------------------------------------------------------------------------------- 1 | # lavaan material 2 | 3 | This repository contains all material concerning lavaan. Currently: 4 | 5 | - brown-cfa: examples of the excellent [book](http://people.bu.edu/tabrown/cfabook.html) by Timothy Brown on confirmatory factor analysis converted to lavaan 6 | -------------------------------------------------------------------------------- /brown-cfa/README.md: -------------------------------------------------------------------------------- 1 | # T. Brown: Confirmatory Factor Analysis for Applied Research 2 | ## Examples in lavaan 3 | 4 | Examples of the excellent [book](http://people.bu.edu/tabrown/cfabook.html) by Timothy Brown on confirmatory factor analysis translated to [lavaan](http://lavaan.org). 5 | 6 | We tried to mimic as close as possible the output presented in the book, hence the frequent use of the `mimic='mplus'` and `mimic='eqs'` parameter. 7 | 8 | Not all examples are converted (yet): 9 | 10 | - Table 9.2 (Multiple Imputation, code given but warning/error) 11 | - Table 9.12 (IRT) 12 | - Table 10.2-10.5 (monte carlo approach to determine power) 13 | 14 | Not all examples use lavaan. Other packages used are: 15 | 16 | - [semTools](http://cran.r-project.org/web/packages/semTools/index.html) 17 | - [factanal](http://rss.acs.unt.edu/Rdoc/library/stats/html/factanal.html) 18 | -------------------------------------------------------------------------------- /brown-cfa/allExamples.R: -------------------------------------------------------------------------------- 1 | require(lavaan) 2 | 3 | ############################################################################## 4 | ## 5 | ## Table 3.2 6 | ## (nothing lavaan here) 7 | ## 8 | ############################################################################## 9 | 10 | # sample covariance matrix 11 | S <- matrix(c(4.0, 2.4, 2.8, 12 | 2.4, 4.0, 2.0, 13 | 2.8, 2.0, 4.0), nrow=3) 14 | 15 | # predicted covariance matrix 16 | SIGM <- matrix(c(4.0, 2.4, 1.2, 17 | 2.4, 4.0, 2.0, 18 | 1.2, 2.0, 4.0), nrow=3) 19 | 20 | RES <- S - SIGM # RESIDUAL COVARIANCE MATRIX 21 | SDET <- det(S) # DETERMINANT OF THE SAMPLE COVARIANCE MATRIX 22 | SIGMDET <- det(SIGM) # DETERMINANT OF THE PREDICTED COVARIANCE MATRIX 23 | LOGS <- log(SDET) # NATURAL LOG OF SAMPLE MATRIX DETERMINANT 24 | LOGSIGM <- log(SIGMDET) # NATURAL LOG OF PREDICTED MATRIX DETERMINANT 25 | SIGMINV = solve(SIGM) # INVERSE OF PREDICTED MATRIX 26 | SDIV = S %*% SIGMINV # MULTIPLICATION OF SAMPLE MATRIX AND PREDICTED INVERSE 27 | STRACE = sum(diag(SDIV)) # TRACE OF THE RESULTING SDIV MATRIX 28 | SORDER = dim(S)[1] # ORDER OF SAMPLE MATRIX = NUMBER OF INDICATORS 29 | 30 | # calculation of Fml 31 | FML = abs((LOGS - LOGSIGM) + STRACE - SORDER); 32 | 33 | 34 | # print results 35 | S 36 | SIGM 37 | RES 38 | SDET 39 | SIGMDET 40 | LOGS 41 | LOGSIGM 42 | SDIV 43 | STRACE 44 | SORDER 45 | FML 46 | 47 | 48 | ############################################################################## 49 | ## 50 | ## Table 4.1 - 4.5 51 | ## Two-factor cfa model of neuroticism and extraversion 52 | ## 53 | ############################################################################## 54 | sds <- '5.7 5.6 6.4 5.7 6.0 6.2 5.7 5.6' 55 | 56 | cors <- ' 57 | 1.000 58 | 0.767 1.000 59 | 0.731 0.709 1.000 60 | 0.778 0.738 0.762 1.000 61 | -0.351 -0.302 -0.356 -0.318 1.000 62 | -0.316 -0.280 -0.300 -0.267 0.675 1.000 63 | -0.296 -0.289 -0.297 -0.296 0.634 0.651 1.000 64 | -0.282 -0.254 -0.292 -0.245 0.534 0.593 0.566 1.000' 65 | 66 | covs <- getCov(cors, sds = sds, names = c("n1", "n2", "n3", "n4", "e1", "e2", "e3", "e4")) 67 | 68 | model <- ' 69 | 70 | neuroticism =~ n1 + n2 + n3 + n4 71 | extraversion =~ e1 + e2 + e3 + e4 72 | 73 | ' 74 | 75 | fit <- cfa(model, sample.cov = covs, sample.nobs = 250, mimic = "mplus") 76 | 77 | 78 | ############################################################################## 79 | ## 80 | ## Table 4.2 81 | ## (continued from Table 4.1) 82 | ## 83 | ############################################################################## 84 | # Sample Variance-Covariance Matrix (S) 85 | covs 86 | 87 | # Model-Implied Variance-Covariance Matrix (Sigma) 88 | fitted(fit)$cov 89 | 90 | # Fitted Residual Matrix 91 | resid(fit)$cov 92 | 93 | # Standardized Residual Matrix 94 | # Brown reports LISREL 8.72 output which is different from the lavaan result 95 | resid(fit, type = "standardized")$cov 96 | 97 | 98 | ############################################################################## 99 | ## 100 | ## Table 4.3 101 | ## (continued from Table 4.1) 102 | ## Modification indices and EPC's for the two-factor cfa model of neuroticism and extraversion 103 | ## 104 | ############################################################################## 105 | modindices(fit) 106 | 107 | # mi: modification indices 108 | # sepc.all: completely standardized expected change 109 | 110 | ############################################################################## 111 | ## 112 | ## Table 4.4 113 | ## (continued from Table 4.1) 114 | ## standardized parameter estimates and r-square 115 | ## 116 | ############################################################################## 117 | summary(fit, standardized = TRUE, rsquare = TRUE) 118 | 119 | ############################################################################## 120 | ## 121 | ## Table 4.5 122 | ## Measurement model of health status involving latent variables and single indicators 123 | ## 124 | ############################################################################## 125 | Data <- read.table("http://people.bu.edu/tabrown/Ch4/fig4.3.dat") 126 | names(Data) <- c("subjid", "activ", "soma", "pain", "menth", "socf", "vital", "genhlth", "age") 127 | 128 | model <- ' 129 | 130 | # factors 131 | physicalf =~ activ + soma + pain 132 | mentalf =~ menth + socf + vital 133 | 134 | # pseudofactors for single indicators 135 | gwb =~ genhlth 136 | agef =~ age 137 | 138 | # fix residual variance of pseudofactor indicators 139 | age ~~ 0 * age 140 | genhlth ~~ 7.88 * genhlth 141 | 142 | # residual covariances 143 | activ ~~ soma 144 | 145 | ' 146 | 147 | fit <- cfa(model, data = Data) 148 | summary(fit, fit.measures = TRUE, standardized = TRUE, rsquare = TRUE) 149 | 150 | ############################################################################## 151 | ## 152 | ## Table 5.1 153 | ## Standardized residuals and modification indices for a one-factor cfa model 154 | ## of indicators of neuroticism and extraversion 155 | ## 156 | ############################################################################## 157 | 158 | sds <- '5.7 5.6 6.4 5.7 6.0 6.2 5.7 5.6' 159 | 160 | cors <- ' 161 | 1.000 162 | 0.767 1.000 163 | 0.731 0.709 1.000 164 | 0.778 0.738 0.762 1.000 165 | -0.351 -0.302 -0.356 -0.318 1.000 166 | -0.316 -0.280 -0.300 -0.267 0.675 1.000 167 | -0.296 -0.289 -0.297 -0.296 0.634 0.651 1.000 168 | -0.282 -0.254 -0.292 -0.245 0.534 0.593 0.566 1.000' 169 | 170 | covs <- getCov(cors, sds = sds, names = c("n1", "n2", "n3", "n4", "e1", "e2", "e3", "e4")) 171 | 172 | model <- 'onefactor =~ n1 + n2 + n3 + n4 + e1 + e2 + e3 + e4' 173 | 174 | fit <- cfa(model, sample.cov = covs, sample.nobs = 250, mimic = "eqs") 175 | summary(fit, fit.measures = TRUE) 176 | ## RMSEA, CFI, TLI differ 177 | 178 | # Standardized Residual Matrix 179 | # Brown reports LISREL 8.72 output which is different from the lavaan result 180 | resid(fit, type = "standardized")$cov 181 | 182 | 183 | # modification indices 184 | modindices(fit) 185 | 186 | 187 | ############################################################################## 188 | ## 189 | ## Table 5.2 190 | ## Base model 191 | ## 192 | ############################################################################## 193 | sds <- '2.06 1.52 1.92 1.41 1.73 1.77 2.49 2.27 2.68 1.75 2.57 2.66' 194 | 195 | cors <- ' 196 | 1.000 197 | 0.300 1.000 198 | 0.229 0.261 1.000 199 | 0.411 0.406 0.429 1.000 200 | 0.172 0.252 0.218 0.481 1.000 201 | 0.214 0.268 0.267 0.579 0.484 1.000 202 | 0.200 0.214 0.241 0.543 0.426 0.492 1.000 203 | 0.185 0.230 0.185 0.545 0.463 0.548 0.522 1.000 204 | 0.134 0.146 0.108 0.186 0.122 0.131 0.108 0.151 1.000 205 | 0.134 0.099 0.061 0.223 0.133 0.188 0.105 0.170 0.448 1.000 206 | 0.160 0.131 0.158 0.161 0.044 0.124 0.066 0.061 0.370 0.350 1.000 207 | 0.087 0.088 0.101 0.198 0.077 0.177 0.128 0.112 0.356 0.359 0.507 1.000' 208 | 209 | covs <- getCov(cors, sds = sds, names = paste("x", 1:12, sep = "")) 210 | 211 | model <- ' 212 | 213 | copingm =~ x1 + x2 + x3 + x4 214 | socialm =~ x4 + x5 + x6 + x7 + x8 215 | enhancem =~ x9 + x10 + x11 + x12 216 | 217 | x11 ~~ x12 218 | 219 | ' 220 | 221 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500, mimic = "mplus") 222 | summary(fit, fit.measures = TRUE) 223 | 224 | ############################################################################## 225 | ## 226 | ## Table 5.3 227 | ## no cross-loading x4 228 | ## 229 | ############################################################################## 230 | model <- ' 231 | 232 | copingm =~ x1 + x2 + x3 + x4 233 | socialm =~ x5 + x6 + x7 + x8 234 | enhancem =~ x9 + x10 + x11 + x12 235 | 236 | x11 ~~ x12 ' 237 | 238 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500, mimic = "mplus") 239 | 240 | # Standardized Residuals 241 | # Brown reports LISREL 8.72 output which is different from the lavaan result 242 | resid(fit, type = "standardized")$cov 243 | 244 | 245 | # Modification Indices 246 | modindices(fit) 247 | 248 | # Completely Standardized Solution 249 | standardizedSolution(fit) 250 | 251 | 252 | ############################################################################## 253 | ## 254 | ## Table 5.4 255 | ## x12 on wrong factor 256 | ## 257 | ############################################################################## 258 | model <- ' 259 | 260 | copingm =~ x1 + x2 + x3 + x4 261 | socialm =~ x4 +x5 + x6 + x7 + x8 + x12 262 | enhancem =~ x9 + x10 + x11 263 | 264 | x11 ~~ x12 ' 265 | 266 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500, mimic = "mplus") 267 | ## WARNING: some fit measures are a bit different 268 | 269 | # Standardized Residuals 270 | # Brown reports LISREL 8.72 output which is different from the lavaan result 271 | resid(fit, type = "standardized")$cov 272 | 273 | # Modification Indices 274 | modindices(fit) 275 | 276 | # Completely Standardized Solution 277 | standardizedSolution(fit) 278 | 279 | 280 | ############################################################################## 281 | ## 282 | ## Table 5.5 283 | ## without correlated error of item 11 and item 12 284 | ## 285 | ############################################################################## 286 | model <- ' 287 | 288 | coping =~ x1 + x2 + x3 + x4 289 | social =~ x4 +x5 + x6 + x7 + x8 290 | enhance =~ x9 + x10 + x11 + x12 291 | ' 292 | 293 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500, mimic = "mplus") 294 | 295 | # Standardized Residuals 296 | # Brown reports LISREL 8.72 output which is different from the lavaan result 297 | resid(fit, type = "standardized")$cov 298 | 299 | # Modification Indices 300 | modindices(fit) 301 | 302 | # Completely Standardized Solution 303 | standardizedSolution(fit) 304 | 305 | 306 | ############################################################################## 307 | ## 308 | ## Table 5.6 309 | ## efa 310 | ## not in lavaan but e.g. with the factanal package 311 | ## 312 | ############################################################################## 313 | Data <- read.table("http://people.bu.edu/tabrown/Ch5/efa.dat") 314 | Data <- Data[,-13] 315 | names(Data) <- paste("x", 1:12, sep = "") 316 | 317 | fit <- factanal(Data, 3, rotation = "promax") 318 | print(fit) 319 | 320 | # eigenvalues 321 | eigen(cor(Data))$values 322 | 323 | 324 | ############################################################################## 325 | ## 326 | ## Table 5.7 + 5.8 327 | ## Drinking motives e/cfa 328 | ## 329 | ############################################################################## 330 | Data <- read.table("http://people.bu.edu/tabrown/Ch5/efa.dat") 331 | names(Data) <- paste("x", 1:13, sep = "") # x13 is not used in the model 332 | 333 | 334 | model <- ' 335 | coping =~ NA*x1 + x2 + x3 + x4 + x5 + x6 + x7 + 0*x8 + x9 + x10 + x11 + 0*x12 336 | social =~ NA*x8 + 0*x1 + x2 + x3 + x4 + x5 + x6 + x7 + x9 + x10 + x11 + 0*x12 337 | enhance =~ NA*x12 + 0*x1 + x2 + x3 + x4 + x5 + x6 + x7 + 0*x8 + x9 + x10 + x11 338 | 339 | coping ~~ 1*coping 340 | social ~~ 1*social 341 | enhance ~~ 1*enhance 342 | ' 343 | 344 | fit <- cfa(model, data = Data) 345 | summary(fit, fit.measures = TRUE) 346 | 347 | mis <- modindices(fit) 348 | mis[mis$mi >= 10 & !is.na(mis$mi),] 349 | 350 | ############################################################################## 351 | ## 352 | ## Table 6.2 353 | ## Correlated methods CFA 354 | ## 355 | ############################################################################## 356 | 357 | # no results provided in book 358 | 359 | ############################################################################## 360 | ## 361 | ## Table 6.3 + 6.4 362 | ## Correlated uniqueness CFA of the MTMM matrix of cluster A personality disorders 363 | ## 364 | ############################################################################## 365 | sds <- '3.61 3.66 3.59 2.94 3.03 2.85 2.22 2.42 2.04' 366 | 367 | cors <- ' 368 | 1.000 369 | 0.290 1.000 370 | 0.372 0.478 1.000 371 | 0.587 0.238 0.209 1.000 372 | 0.201 0.586 0.126 0.213 1.000 373 | 0.218 0.281 0.681 0.195 0.096 1.000 374 | 0.557 0.228 0.195 0.664 0.242 0.232 1.000 375 | 0.196 0.644 0.146 0.261 0.641 0.248 0.383 1.000 376 | 0.219 0.241 0.676 0.290 0.168 0.749 0.361 0.342 1.000' 377 | 378 | covs <- getCov(cors, sds = sds, names = c("pari", "szti", "szdi", "parc", "sztc", "szdc", "paro", "szto", "szdo")) 379 | 380 | model <- ' 381 | paranoid =~ pari + parc + paro 382 | schizotypal =~ szti + sztc + szto 383 | schizoid =~ szdi + szdc + szdo 384 | 385 | pari ~~ szti + szdi 386 | szti ~~ szdi 387 | parc ~~ sztc + szdc 388 | sztc ~~ szdc 389 | paro ~~ szto + szdo 390 | szto ~~ szdo 391 | ' 392 | 393 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500, std.lv = TRUE) 394 | summary(fit, fit.measures = TRUE, standardized = TRUE) 395 | 396 | 397 | ############################################################################## 398 | ## 399 | ## Table 7.1 400 | ## Two-factor model of memory - congeneric 401 | ## 402 | ############################################################################## 403 | sds <- '2.610 2.660 2.590 1.940 2.030 2.050' 404 | 405 | cors <-' 406 | 1.000 407 | 0.661 1.000 408 | 0.630 0.643 1.000 409 | 0.270 0.300 0.268 1.000 410 | 0.297 0.265 0.225 0.805 1.000 411 | 0.290 0.287 0.248 0.796 0.779 1.000' 412 | 413 | covs <- getCov(cors, sds = sds, names = paste("x", 1:6, sep = "")) 414 | 415 | model.congeneric <- ' 416 | 417 | auditorymemory =~ x1 + x2 + x3 418 | visualmemory =~ x4 + x5 + x6 419 | 420 | ' 421 | 422 | fit.congeneric <- cfa(model.congeneric, sample.cov = covs, sample.nobs = 200, std.lv = TRUE) 423 | summary(fit.congeneric, fit.measures = TRUE, standardized = TRUE, rsquare = TRUE) 424 | 425 | 426 | ############################################################################## 427 | ## 428 | ## Table 7.3 429 | ## Congeneric, Tau-equivalent and parallel solutions of a 430 | ## two-factor model of memory (N=200) 431 | ## 432 | ############################################################################## 433 | 434 | # tau equivalent: auditory memory 435 | model.tau.a <- ' 436 | auditorymemory =~ x1 + v1*x1 + v1*x2 + v1*x3 437 | visualmemory =~ x4 + x5 + x6 438 | ' 439 | 440 | fit.tau.a <- cfa(model.tau.a, sample.cov = covs, sample.nobs = 200, std.lv = TRUE) 441 | 442 | # tau equivalent: auditory & visual memory 443 | model.tau.av <- ' 444 | auditorymemory =~ x1 + v1*x1 + v1*x2 + v1*x3 445 | visualmemory =~ x4 + v2*x4 + v2*x5 + v2*x6 446 | ' 447 | 448 | fit.tau.av <- cfa(model.tau.av, sample.cov = covs, sample.nobs = 200, std.lv = TRUE) 449 | 450 | # parallel: auditory memory 451 | model.parallel.a <- ' 452 | auditorymemory =~ x1 + v1*x1 + v1*x2 + v1*x3 453 | visualmemory =~ x4 + v2*x4 + v2*x5 + v2*x6 454 | 455 | x1 ~~ v3 * x1 456 | x2 ~~ v3 * x2 457 | x3 ~~ v3 * x3 458 | ' 459 | 460 | fit.parallel.a <- cfa(model.parallel.a, sample.cov = covs, sample.nobs = 200, std.lv = TRUE) 461 | 462 | # parallel: auditory & visual memory 463 | model.parallel.av <- ' 464 | auditorymemory =~ x1 + v1*x1 + v1*x2 + v1*x3 465 | visualmemory =~ x4 + v2*x4 + v2*x5 + v2*x6 466 | 467 | x1 ~~ v3 * x1 468 | x2 ~~ v3 * x2 469 | x3 ~~ v3 * x3 470 | 471 | x4 ~~ v4 * x4 472 | x5 ~~ v4 * x5 473 | x6 ~~ v4 * x6 474 | ' 475 | fit.parallel.av <- cfa(model.parallel.av, sample.cov = covs, sample.nobs = 200, std.lv = TRUE) 476 | 477 | # Chi square difference tests 478 | anova(fit.congeneric, fit.tau.a, fit.tau.av, fit.parallel.a, fit.parallel.av, test = "chisq") 479 | 480 | 481 | ############################################################################## 482 | ## 483 | ## Table 7.4 484 | ## Two-factor model of memory - parallel 485 | ## (continued from Table 7.3) 486 | ## 487 | ############################################################################## 488 | summary(fit.parallel.av, fit.measures = TRUE, standardized = TRUE, rsquare = TRUE) 489 | 490 | ############################################################################## 491 | ## 492 | ## Table 7.6 + 7.7 493 | ## Longitudinal model of job satisfaction 494 | ## 495 | ############################################################################## 496 | sds <- '1.940 2.030 2.050 1.990 2.610 2.660 2.590 2.550' 497 | 498 | cors <- ' 499 | 1.000 500 | 0.736 1.000 501 | 0.731 0.648 1.000 502 | 0.771 0.694 0.700 1.000 503 | 0.685 0.512 0.496 0.508 1.000 504 | 0.481 0.638 0.431 0.449 0.726 1.000 505 | 0.485 0.442 0.635 0.456 0.743 0.672 1.000 506 | 0.508 0.469 0.453 0.627 0.759 0.689 0.695 1.000' 507 | 508 | covs <- getCov(cors, sds = sds, names = c("A1", "B1", "C1", "D1", "A2", "B2", "C2", "D2")) 509 | 510 | ms <- c(1.500, 1.320, 1.450, 1.410, 6.600, 6.420, 6.560, 6.310) # this should be a numeric vector, not a character string 511 | 512 | model.equalform <- ' 513 | 514 | satis1 =~ A1 + B1 + C1 + D1 515 | satis2 =~ A2 + B2 + C2 + D2 516 | 517 | A1 ~~ A2 518 | B1 ~~ B2 519 | C1 ~~ C2 520 | D1 ~~ D2 521 | 522 | # fix indicator intercepts to 0 523 | A1 ~ 0*1 524 | A2 ~ 0*1 525 | 526 | # free factor intercepts 527 | satis1 ~ 1 528 | satis2 ~ 1 529 | ' 530 | 531 | fit.equalforms <- cfa(model.equalform, sample.cov = covs, sample.nobs = 250, sample.mean = ms, meanstructure = TRUE) 532 | summary(fit.equalforms, standardized = TRUE, fit.measures = TRUE) 533 | 534 | ############################################################################## 535 | ## 536 | ## Table 7.7 537 | ## Longitudinal model of job satisfaction 538 | ## Equality of factor loadings over the two assessment points 539 | ## ..continues from previous table 540 | ## 541 | ############################################################################## 542 | 543 | model.equalfl <- ' 544 | 545 | # equality of factor loadings 546 | satis1 =~ v1*A1 + v2*B1 + v3*C1 + v4*D1 547 | satis2 =~ v1*A2 + v2*B2 + v3*C2 + v4*D2 548 | 549 | A1 ~~ A2 550 | B1 ~~ B2 551 | C1 ~~ C2 552 | D1 ~~ D2 553 | 554 | # fix indicator intercepts to 0 555 | A1 ~ 0*1 556 | A2 ~ 0*1 557 | 558 | # free factor intercepts 559 | satis1 ~ 1 560 | satis2 ~ 1 561 | ' 562 | 563 | fit.equalfl <- cfa(model.equalfl, sample.cov = covs, sample.nobs = 250, sample.mean = ms, meanstructure = TRUE) 564 | summary(fit.equalfl, standardized = TRUE, fit.measures = TRUE) 565 | anova(fit.equalforms, fit.equalfl, test = "chisq") 566 | 567 | ############################################################################## 568 | ## 569 | ## Table 7.7 570 | ## Longitudinal model of job satisfaction 571 | ## Equality of indicator intercepts over the two assessment points 572 | ## ..continued from previous table 573 | ## 574 | ############################################################################## 575 | model.equali <- ' 576 | 577 | # equality of factor loadings 578 | satis1 =~ v1*A1 + v2*B1 + v3*C1 + v4*D1 579 | satis2 =~ v1*A2 + v2*B2 + v3*C2 + v4*D2 580 | 581 | A1 ~~ A2 582 | B1 ~~ B2 583 | C1 ~~ C2 584 | D1 ~~ D2 585 | 586 | # fix indicator intercepts to 0 587 | A1 ~ 0*1 588 | A2 ~ 0*1 589 | 590 | # free factor intercepts 591 | satis1 ~ 1 592 | satis2 ~ 1 593 | 594 | # equal indicator intercepts 595 | B1 ~ equal("B2~1")*1 596 | C1 ~ equal("C2~1")*1 597 | D1 ~ equal("D2~1")*1 598 | ' 599 | 600 | fit.equali <- cfa(model.equali, sample.cov = covs, sample.nobs = 250, sample.mean = ms, meanstructure = TRUE) 601 | summary(fit.equali, standardized = TRUE, fit.measures = TRUE) 602 | anova(fit.equalfl, fit.equali, test = "chisq") 603 | 604 | ############################################################################## 605 | ## 606 | ## Table 7.7 607 | ## Longitudinal model of job satisfaction 608 | ## Equality of indicator error variances over the two assessment points 609 | ## ..continued from previous table 610 | ## 611 | ############################################################################## 612 | model.equalrv <- ' 613 | 614 | # equality of factor loadings 615 | satis1 =~ v1*A1 + v2*B1 + v3*C1 + v4*D1 616 | satis2 =~ v1*A2 + v2*B2 + v3*C2 + v4*D2 617 | 618 | A1 ~~ A2 619 | B1 ~~ B2 620 | C1 ~~ C2 621 | D1 ~~ D2 622 | 623 | # fix indicator intercepts to 0 624 | A1 ~ 0*1 625 | A2 ~ 0*1 626 | 627 | # free factor intercepts 628 | satis1 ~ 1 629 | satis2 ~ 1 630 | 631 | # equal indicator intercepts 632 | B1 ~ equal("B2~1")*1 633 | C1 ~ equal("C2~1")*1 634 | D1 ~ equal("D2~1")*1 635 | 636 | # equal residual variances 637 | A1 ~~ v5*A1 638 | B1 ~~ v6*B1 639 | C1 ~~ v7*C1 640 | D1 ~~ v8*D1 641 | A2 ~~ v5*A2 642 | B2 ~~ v6*B2 643 | C2 ~~ v7*C2 644 | D2 ~~ v8*D2 645 | ' 646 | 647 | fit.equalrv <- cfa(model.equalrv, sample.cov = covs, sample.nobs = 250, sample.mean = ms, meanstructure = TRUE) 648 | summary(fit.equalrv, standardized = TRUE, fit.measures = TRUE) 649 | anova(fit.equali, fit.equalrv, test = "chisq") 650 | 651 | 652 | ############################################################################## 653 | ## 654 | ## Table 7.9 655 | ## 656 | ## Tests of measurement invariance and population heterogeneity of DSM-IV 657 | ## major depressive disorder in men and women 658 | ## 659 | ############################################################################## 660 | Data <- read.table("http://people.bu.edu/tabrown/Ch7/MDDALL.dat") 661 | names(Data) <- c("sex", paste("mdd", 1:9, sep = "")) 662 | Data$sex <- factor(Data$sex, levels = c(0, 1), labels = c("female", "male")) 663 | 664 | model.mdd <- ' 665 | MDD =~ mdd1 + mdd2 + mdd3 + mdd4 + mdd5 + mdd6 + mdd7 + mdd8 + mdd9 666 | mdd1 ~~ mdd2 667 | ' 668 | # Single group solution (men) 669 | fit.men <- cfa(model.mdd, data = Data[Data$sex == "male",]) 670 | summary(fit.men, fit.measures = TRUE) 671 | 672 | # Single group solution (women) 673 | fit.women <- cfa(model.mdd, data = Data[Data$sex == "female",]) 674 | summary(fit.women, fit.measures = TRUE) 675 | 676 | # Measurement Invariance using semTools 677 | require(semTools) 678 | measurementInvariance(model.mdd, data = Data, group = "sex", strict = TRUE) 679 | 680 | # using lavaan 681 | # measurementInvariance doesn't do equal factor variance. But, this can be accomplished as follows 682 | fit.ef <- cfa(model.mdd, data = Data, group = "sex", meanstructure = TRUE) # equal form 683 | fit.efl <- update(fit.ef, group.equal = c("loadings")) # equal factor laodings 684 | fit.eii <- update(fit.efl, group.equal = c("loadings", "intercepts")) # equal indicator intercepts 685 | fit.eir <- update(fit.eii, group.equal = c("loadings", "intercepts", "residuals")) # equal indicator error variances 686 | fit.fv <- update(fit.eir, group.equal = c("loadings", "intercepts", "residuals", "lv.variances")) # equal factor variances 687 | fit.fm <- update(fit.fv, group.equal = c("loadings", "intercepts", "residuals", "lv.variances", "means")) # equal latent means 688 | 689 | # chi-squared diff tests 690 | anova(fit.ef, fit.efl, fit.eii, fit.eir, fit.fv, fit.fm, test = "chisq") 691 | 692 | ############################################################################## 693 | ## 694 | ## Table 7.11 695 | ## 696 | ## Parameter estimates from the equal form measurement model of major 697 | ## depression in men and woman 698 | ## .. continued from previous chunk 699 | ############################################################################## 700 | summary(fit.ef, standardized = TRUE, rsquare = TRUE) 701 | 702 | 703 | ############################################################################## 704 | ## 705 | ## Table 7.14-7.15 706 | ## 707 | ## MIMIC model of Social Phobia and Agoraphobia 708 | ## 709 | ############################################################################## 710 | sds <- '2.26 2.73 2.11 2.32 2.61 2.44 0.50' 711 | 712 | cors <- ' 713 | 1.000 714 | 0.705 1.000 715 | 0.724 0.646 1.000 716 | 0.213 0.195 0.190 1.000 717 | 0.149 0.142 0.128 0.521 1.000 718 | 0.155 0.162 0.135 0.557 0.479 1.000 719 | -0.019 -0.024 -0.029 -0.110 -0.074 -0.291 1.000' 720 | 721 | covs <- getCov(cors, sds = sds, names = c("S1", "S2", "S3", "A1", "A2", "A3", "sex")) 722 | 723 | model <- ' 724 | socialphobia =~ S1 + S2 + S3 725 | agoraphobia =~ A1 + A2 + A3 726 | 727 | socialphobia + agoraphobia + A3 ~ sex 728 | 729 | socialphobia ~~ agoraphobia 730 | ' 731 | 732 | fit <- cfa(model, sample.cov = covs, sample.nobs = 730) 733 | summary(fit, standardized = TRUE, fit.measures = TRUE) 734 | 735 | ############################################################################## 736 | ## 737 | ## Table 8.1 738 | ## Four-factor (first-order) measurement model of coping 739 | ## 740 | ## Table 8.3 741 | ## Higher-order model of coping 742 | ## 743 | ############################################################################## 744 | sds <- '1.40 2.10 1.30 2.30 2.40 1.90 2.00 2.90 2.30 3.10 2.20 1.20' 745 | 746 | cors <- ' 747 | 1.00 748 | 0.78 1.00 749 | 0.80 0.77 1.00 750 | 0.56 0.51 0.48 1.00 751 | 0.52 0.51 0.46 0.78 1.00 752 | 0.59 0.51 0.51 0.80 0.79 1.00 753 | 0.16 0.15 0.17 0.14 0.18 0.16 1.00 754 | 0.19 0.13 0.18 0.14 0.16 0.16 0.81 1.00 755 | 0.12 0.17 0.17 0.17 0.20 0.16 0.75 0.80 1.00 756 | 0.16 0.13 0.17 0.15 0.16 0.18 0.56 0.52 0.50 1.00 757 | 0.16 0.14 0.18 0.15 0.16 0.18 0.51 0.58 0.51 0.81 1.00 758 | 0.16 0.15 0.14 0.16 0.16 0.14 0.52 0.57 0.52 0.80 0.79 1.00' 759 | 760 | covs <- getCov(cors, sds = sds, names = c("P1", "P2", "P3", "C1", "C2", "C3", "E1", "E2", "E3", "S1", "S2", "S3")) 761 | 762 | model8.1 <- ' 763 | probslv =~ P1 + P2 + P3 764 | cogres =~ C1 + C2 + C3 765 | expremot =~ E1 + E2 + E3 766 | socspt =~ S1 + S2 + S3 767 | ' 768 | 769 | fit8.1 <- cfa(model8.1, sample.cov = covs, sample.nobs = 275) 770 | inspect(fit8.1, "std.coef") 771 | 772 | model8.3 <- ' 773 | probslv =~ P1 + P2 + P3 774 | cogres =~ C1 + C2 + C3 775 | expremot =~ E1 + E2 + E3 776 | socspt =~ S1 + S2 + S3 777 | 778 | probfoc =~ probslv + cogres 779 | emotfoc =~ expremot + socspt 780 | ' 781 | 782 | fit8.3 <- cfa(model8.3, sample.cov = covs, sample.nobs = 275, std.lv = TRUE) 783 | inspect(fit8.3, "std.coef") 784 | 785 | ############################################################################## 786 | ## 787 | ## Table 8.5 788 | ## 789 | ## Selected unstandardized parameter estimates of measurement model of the 790 | ## reactions to traumatic stress questionnaire 791 | ## 792 | ############################################################################## 793 | sds <- '1.150 1.200 1.570 2.820 1.310 1.240 1.330 1.290' 794 | 795 | cors <- ' 796 | 1.000 797 | 0.594 1.000 798 | 0.607 0.613 1.000 799 | 0.736 0.765 0.717 1.000 800 | 0.378 0.321 0.360 0.414 1.000 801 | 0.314 0.301 0.345 0.363 0.732 1.000 802 | 0.310 0.262 0.323 0.337 0.665 0.583 1.000 803 | 0.317 0.235 0.276 0.302 0.632 0.557 0.796 1.000' 804 | 805 | covs <- getCov(cors, sds = sds, names = paste("Y", 1:8, sep = "")) 806 | 807 | model <- ' 808 | intrus =~ Y1 + Y2 + Y3 + Y4 809 | avoid =~ Y5 + Y6 + Y7 + Y8 810 | 811 | Y7 ~~ Y8 812 | ' 813 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500, std.lv = TRUE, mimic = "EQS") 814 | inspect(fit, "coef") 815 | 816 | ############################################################################## 817 | ## 818 | ## Table 8.6, 8.7 & 8.8 819 | ## 820 | ## Syntax for computing point estimates for scale reliability and 95% CI 821 | ## 822 | ############################################################################## 823 | sds <- '1.15 1.20 1.57 2.82 1.31 1.24 1.33 1.29' 824 | 825 | cors <- ' 826 | 1.000 827 | 0.594 1.000 828 | 0.607 0.613 1.000 829 | 0.736 0.765 0.717 1.000 830 | 0.378 0.321 0.360 0.414 1.000 831 | 0.314 0.301 0.345 0.363 0.732 1.000 832 | 0.310 0.262 0.323 0.337 0.665 0.583 1.000 833 | 0.317 0.235 0.276 0.302 0.632 0.557 0.796 1.000' 834 | 835 | covs <- getCov(cors, sds = sds, names = paste("Y", 1:8, sep = "")) 836 | 837 | 838 | model <- ' 839 | # main model. 840 | intrus =~ Y1 + l1*Y1 + l2*Y2 + l3*Y3 + l4*Y4 841 | avoid =~ Y5 + l5*Y5 + l6*Y6 + l7*Y7 + l8*Y8 842 | 843 | # label the residual variances 844 | Y1 ~~ e1*Y1 845 | Y2 ~~ e2*Y2 846 | Y3 ~~ e3*Y3 847 | Y4 ~~ e4*Y4 848 | Y5 ~~ e5*Y5 849 | Y6 ~~ e6*Y6 850 | Y7 ~~ e7*Y7 851 | Y8 ~~ e8*Y8 852 | 853 | # covariance between Y7 and Y8 854 | Y7 ~~ e78*Y8 855 | 856 | # defined parameters 857 | intr.tru := (l1 + l2 + l3 + l4)^2 858 | intr.tot := (l1 + l2 + l3 + l4)^2 + e1 + e2 + e3 + e4 859 | intr.rel := intr.tru/intr.tot 860 | 861 | avoid.tru := (l5 + l6 + l7 + l8)^2 862 | avoid.tot := (l5 + l6 + l7 + l8)^2 + e5 + e6 + e7 + e8 + 2*e78 863 | avoid.rel := avoid.tru/avoid.tot 864 | 865 | ' 866 | 867 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500, mimic = "EQS", std.lv = TRUE) 868 | summary(fit, standardized = TRUE, fit.measures = TRUE) 869 | 870 | # 95% CI 871 | parameterEstimates(fit) 872 | 873 | 874 | ############################################################################## 875 | ## 876 | ## Table 8.9 877 | ## Model with a formative construct 878 | ## 879 | ############################################################################## 880 | sds <- '2.5 2.1 3.0 4.1 3.9 4.4 1.2 1.0 1.2' 881 | 882 | cors <- ' 883 | 1.000 884 | 0.700 1.000 885 | 0.713 0.636 1.000 886 | 0.079 0.066 0.076 1.000 887 | 0.088 0.058 0.070 0.681 1.000 888 | 0.084 0.056 0.074 0.712 0.633 1.000 889 | 0.279 0.248 0.240 0.177 0.155 0.170 1.000 890 | 0.250 0.214 0.222 0.157 0.143 0.152 0.373 1.000 891 | 0.280 0.236 0.251 0.173 0.178 0.171 0.448 0.344 1.000 ' 892 | 893 | covs <- getCov(cors, sds = sds, names = c(paste("Y", 1:6, sep = ""), paste("X", 1:3, sep = ""))) 894 | 895 | model <- ' 896 | satis =~ Y1 + Y2 + Y3 897 | optim =~ Y4 + Y5 + Y6 898 | stress =~ NA*satis + optim 899 | 900 | stress ~ 1*X1 + X2 + X3 901 | 902 | X1 ~~ X2 + X3 903 | X2 ~~ X3 904 | ' 905 | 906 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500) 907 | summary(fit, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE) 908 | 909 | ############################################################################## 910 | ## 911 | ## Table 9.1 912 | ## Estimation of a CFA model with missing data using direct ML 913 | ## 914 | ############################################################################## 915 | Data <- read.table("http://people.bu.edu/tabrown/Ch9/cfamiss.dat", na.strings = "9") 916 | names(Data) <- c("subject", "s1", "s2", "s3", "s4") 917 | 918 | model <- ' 919 | esteem =~ s1 + s2 + s3 + s4 920 | s2 ~~ s4 921 | ' 922 | 923 | fit <- cfa(model, data = Data, missing = "ml") 924 | summary(fit, fit.measures = TRUE) 925 | 926 | ## Question: could the following be combined into an "inspect function"? 927 | # number of patterns 928 | fit@Data@Mp[[1]]$npatterns 929 | 930 | # patterns and their frequency 931 | pats <- fit@Data@Mp[[1]]$pat * 1L 932 | colnames(pats) <- fit@Data@ov.names[[1]] 933 | print(pats) 934 | 935 | # covariance coverage 936 | coverage <- fit@Data@Mp[[1]]$coverage 937 | colnames(coverage) <- rownames(coverage) <- fit@Data@ov.names[[1]] 938 | print(coverage) 939 | 940 | 941 | ############################################################################## 942 | ## 943 | ## Table 9.2 944 | ## 945 | ## Estimation of CFA model with missing data using multiple imputation 946 | ## 947 | ############################################################################## 948 | data9.2 <- read.table("http://people.bu.edu/tabrown/Ch9/cfamiss.dat", na.strings = "9") 949 | names(data9.2) <- c("subject", "s1", "s2", "s3", "s4") 950 | 951 | model9.2 <- ' 952 | esteem =~ s1 + s2 + s3 + s4 953 | s2 ~~ s4 954 | ' 955 | require(semTools) 956 | fit9.2 <- cfa.mi(model9.2, data = data9.2, m = 5, miPackage = "mice", seed = 44176) 957 | inspect(fit9.2, "fit") 958 | inspect(fit9.2, "impute") 959 | 960 | 961 | 962 | ############################################################################## 963 | ## 964 | ## Table 9.5 (syntax) + Table 9.7 (results) 965 | ## lavaan syntax for conducting CFA with non-normal, continuous data using 966 | ## robust maximum likelihood 967 | ## 968 | ############################################################################## 969 | Data <- read.table("http://people.bu.edu/tabrown/Ch9/NONML.DAT", nrows = 870) 970 | names(Data) <- c("x1", "x2", "x3", "x4", "x5") 971 | 972 | model <- ' 973 | f1 =~ x1 + x2 + x3 + x4 + x5 974 | x1 ~~ x3 # added in the second run 975 | ' 976 | 977 | fit <- cfa(model, data = Data, mimic = "EQS", estimator = "MLM") 978 | summary(fit, fit.measures = TRUE) 979 | 980 | ############################################################################## 981 | ## 982 | ## Table 9.9 (syntax) + Table 9.10 (results) 983 | ## lavaan syntax for conducting CFA with categorical indicators 984 | ## 985 | ############################################################################## 986 | Data <- read.fwf("http://people.bu.edu/tabrown/Ch9/BINARY.DAT", width = c(1,1,1,1,1,1), n = 750) 987 | names(Data) <- c(paste("y", 1:6, sep = "")) 988 | 989 | model1 <- ' 990 | etoh =~ y1 + y2 + y3 + y4 + y5 + y6 991 | ' 992 | 993 | fit1 <- cfa(model1, data = Data, ordered = names(Data), estimator = "WLSMVS", mimic = "mplus") 994 | summary(fit1, fit.measures = TRUE) 995 | 996 | 997 | ############################################################################## 998 | ## 999 | ## Table 9.11 1000 | ## lavaan syntax for conducting nested model comparison with WLSMV: One factor 1001 | ## CFA of alcohol dependence with binary indicators (factor loadings constrained 1002 | ## to equality) 1003 | ## 1004 | ############################################################################## 1005 | 1006 | # continued from previous example 1007 | 1008 | model2 <- ' 1009 | etoh =~ y1 + l1*y2 + l1*y3 + l1*y4 + l1*y5 + l1*y6 1010 | ' 1011 | 1012 | fit2 <- cfa(model2, data = Data, ordered = names(Data), estimator = "WLSMVS", mimic = "mplus") 1013 | summary(fit2, fit.measures = TRUE) 1014 | 1015 | # diff test 1016 | anova(fit1, fit2) 1017 | 1018 | # The output does not correspond exactly to what is reported by mplus. 1019 | # see: https://groups.google.com/forum/?fromgroups=#!topic/lavaan/LxqIagOPmRU 1020 | 1021 | ############################################################################## 1022 | ## 1023 | ## Table 9.14 1024 | ## lavaan syntax for bootstrapping a one-factor CFA with non-normal, continuous 1025 | ## indicators 1026 | ## 1027 | ############################################################################## 1028 | Data <- read.table("http://people.bu.edu/tabrown/Ch9/NONML.DAT", nrows = 870) 1029 | names(Data) <- c("x1", "x2", "x3", "x4", "x5") 1030 | 1031 | model <- ' 1032 | f1 =~ x1 + x2 + x3 + x4 + x5 1033 | x1 ~~ x3 1034 | ' 1035 | 1036 | fit <- cfa(model, data = Data, se = "bootstrap", bootstrap = 500) 1037 | summary(fit, fit.measures = TRUE) 1038 | parameterEstimates(fit, ci = TRUE, level = .90, boot.ci.type = "bca.simple") 1039 | 1040 | 1041 | ############################################################################## 1042 | ## 1043 | ## Table 10.1 1044 | ## Satorra-Saris method of determining power to detect that factor covariances 1045 | ## is significantly different from zero 1046 | ## 1047 | ############################################################################## 1048 | 1049 | ## Step 1: generate population covariance matrix from H1 model 1050 | 1051 | covs <- matrix(c( 1052 | 1, 0, 0, 0, 0, 0, 1053 | 0, 1, 0, 0, 0, 0, 1054 | 0, 0, 1, 0, 0, 0, 1055 | 0, 0, 0, 1, 0, 0, 1056 | 0, 0, 0, 0, 1, 0, 1057 | 0, 0, 0, 0, 0, 1), nrow = 6) 1058 | 1059 | colnames(covs) <- rownames(covs) <- paste("x", 1:6, sep = "") 1060 | 1061 | model <- ' 1062 | esteem =~ .65*x1 + .70*x2 + .72*x3 1063 | depress =~ .60*x4 + .70*x5 + .65*x6 1064 | 1065 | esteem ~~ 1*esteem 1066 | depress ~~ 1*depress 1067 | 1068 | x1 ~~ .5775*x1 1069 | x2 ~~ .51*x2 1070 | x3 ~~ .4816*x3 1071 | x4 ~~ .64*x4 1072 | x5 ~~ .51*x5 1073 | x6 ~~ .5775*x6 1074 | 1075 | esteem ~~ .35*depress 1076 | ' 1077 | fit <- cfa(model, sample.cov = covs, sample.nobs = 500) 1078 | 1079 | covs.pop <- fitted(fit)$cov 1080 | 1081 | ## Step 2: analyze residual covariance matrix to ensure that population values are recovered 1082 | 1083 | model <- ' 1084 | esteem =~ x1 + x2 + x3 1085 | depress =~ x4 + x5 + x6 1086 | ' 1087 | 1088 | fit <- cfa(model, sample.cov = covs.pop, sample.nobs = 500) 1089 | residuals(fit)$cov 1090 | 1091 | ## Step 3: fit H0 model that contains the misspecified parameter and target sample size 1092 | 1093 | model <- ' 1094 | esteem =~ x1 + x2 + x3 1095 | depress =~ x4 + x5 + x6 1096 | 1097 | esteem ~~ 0*depress 1098 | ' 1099 | 1100 | fit <- cfa(model, sample.cov = covs.pop, sample.nobs = 100) 1101 | 1102 | 1103 | ## Step 4: use X2 from step 3 as noncentrality parameter to estimate power at targeted sample sizes 1104 | dfs <- 1 1105 | alfa <- 0.05 1106 | crit <- qchisq(1-alfa,dfs) 1107 | lamba <- inspect(fit, "fit")[1] 1108 | power <- 1-pchisq(crit, 1, lamba) 1109 | power 1110 | 1111 | 1112 | 1113 | 1114 | 1115 | --------------------------------------------------------------------------------