MGCFA Analyses of Spearman's Hypothesis
May 3, 2020
Startup
Functions
#Congruence coefficient formula because Psych's fa.congruence function is broken
CONGO <- function(F1, F2) {
PHI = sum(F1*F2) / sqrt(sum(F1^2)*sum(F2^2))
return(PHI)}
#Cohen's d or Hedge's g to point-biserial
RPBS <- function(d) {
RPB = d / sqrt(d^2 + 4)
return(RPB)}Equations
\[\phi = \frac{\Sigma(\lambda_1 * \lambda_2)}{\sqrt{\Sigma\lambda_1^2 * \Sigma\lambda_2^2}}\]
\[R_{pb} = \frac{d}{\sqrt{d^2 + 4}}\]
For the bifactor model:
\[\delta_g = \frac{\Sigma \lambda_g}{\Sigma (\lambda_g + \lambda_{non_g})}\]
For the higher-order model (unused):
\[\delta_g = \frac{\Sigma (\Gamma_g\times\lambda_{non-g})}{\Sigma ((\Gamma_g\times\lambda_{non-g}) + ((1-\Gamma_g^2)\times\lambda_{non-g}))}\]
For independent loading summaries (there are many ways to derive this and without the square root, it's the communality if all loadings are used):
\[\lambda_{cumulative} = \sqrt{\lambda_{1}^2 + \lambda_{2}^2 + ... \lambda_{n}^2}\]
Packages
library(pacman)
p_load(lavaan, semPlot, psych, qpcR, ggplot2, dplyr, parameters, nFactors, see, kirkegaard, umx, haven)
#Fit measures
FITM <- c("chisq", "df", "nPar", "cfi", "rmsea", "rmsea.ci.lower", "rmsea.ci.upper", "aic", "bic")Rationale
For some reason, no one has properly analyzed Spearman's hypothesis for available datasets. The following analyses are all included in a forthcoming (as of 3/5/20) meta-analysis.
9/12/20: Reuploaded this page without alteration. Some additional models should be tested given some things I've learned about multidimensional MI problems. The same applies to my ISIR MI poster which virtually only used bifactor models when possible, rolling straight into issues with what MI actually means and requiring multiple additional analyses and outputs to validate the results (that poster is also nowhere near complete and due to a lack of space, it might not be clear what I was saying on it). Thought one of the editors of Journal of Intelligence already assessed MI by age in the WJIII, I need to more comprehensively address some of Jelte's suggestions he gave me in a review along the same lines and for the WJI and R (among the other studies). If I get some time to tidy up the code for those changes and suggestions, I'll add them here, but for now, Spearman's hypothesis is kind of boring for me since it's just an implication of scalar invariance with a dominant g. Maybe it's more interesting cross-culturally. Data is too scarce and takes too long to gather to know if that's the case.
Analysis
Dolan
Dolan (2000) fit a model with three group factors and a higher-order g factor to the Wechsler Adult Intelligence Scale for Children (Revised)/WISC-R data used by Jensen & Reynolds (1982; see also Reynolds & Jensen, 1983). These group factors were labeled verbal, performance, and memory (although the names for group factors are basically arbitrary). Strict factorial invariance was attained but the different forms of Spearman's hypothesis could not be meaningfully differentiated. Frisby & Beaujean (2015) later suggested that this might have been due to a lack of power not as a result of the sample size so much as the type of model. They proposed that the higher-order model confounded the group factors with g, which reduced the ability to differentiate forms of the hypothesis. Instead of using a higher-order model, they proposed searching for factorial purity with a bifactor model in order to gain extra power to differentiate the forms of the hypothesis, even though the model may be atheoretical (see Hood, 2010). I've thought that the model proposed by Dolan has too many cross-loadings, so I also fit the three-factor solution offered by O'Grady (1989). The effect of cross-loadings can be similar to the confounding seen in the higher-order model.
Data Input
#Correlation matrices
lowerW = '
1.00
0.58 1.00
0.51 0.43 1.00
0.66 0.63 0.48 1.00
0.51 0.55 0.40 0.61 1.00
0.34 0.33 0.42 0.36 0.23 1.00
0.25 0.19 0.32 0.24 0.19 0.37 1.00
0.35 0.40 0.30 0.38 0.35 0.16 0.16 1.00
0.37 0.37 0.26 0.39 0.34 0.18 0.19 0.34 1.00
0.44 0.45 0.41 0.43 0.38 0.29 0.27 0.47 0.41 1.00
0.34 0.35 0.23 0.33 0.29 0.17 0.15 0.41 0.37 0.56 1
0.26 0.25 0.29 0.29 0.23 0.28 0.25 0.15 0.22 0.30 0.20 1
0.22 0.24 0.24 0.21 0.23 0.18 0.19 0.29 0.27 0.39 0.31 0.18 1'
lowerB = '
1
0.55 1
0.53 0.46 1
0.63 0.65 0.52 1
0.49 0.48 0.39 0.63 1
0.43 0.34 0.5 0.41 0.35 1
0.32 0.21 0.3 0.25 0.24 0.43 1
0.42 0.43 0.32 0.43 0.44 0.28 0.29 1
0.29 0.36 0.23 0.36 0.38 0.3 0.26 0.37 1
0.37 0.41 0.4 0.41 0.38 0.35 0.26 0.48 0.37 1
0.31 0.36 0.28 0.34 0.35 0.25 0.17 0.49 0.41 0.57 1
0.21 0.26 0.28 0.28 0.26 0.25 0.25 0.16 0.21 0.43 0.39 1
0.26 0.24 0.22 0.25 0.3 0.28 0.26 0.36 0.32 0.29 0.19 0.18 1'
#Variable names
Names = list("IN", "SIM", "AR", "VC", "CP", "DS", "TS", "PC", "PA", "BD", "OA", "CD", "MZ")
#Convert to variance-covariance matrices
JRW.cor = getCov(lowerW, names = Names)
JRB.cor = getCov(lowerB, names = Names)
JRWSDs <- c(2.91, 3.01, 2.84, 2.94, 2.81, 3, 2.87, 2.87, 2.91, 2.92, 3.01, 3.3, 3.06)
JRBSDs <- c(2.65, 2.92, 2.75, 2.76, 2.53, 3.19, 2.95, 3.03, 2.7, 2.96, 2.93, 3.22, 3.06)
JRW.cov = lavaan::cor2cov(R = JRW.cor, sds = JRWSDs)
JRB.cov = lavaan::cor2cov(R = JRB.cor, sds = JRBSDs)
#Means
Wmeans = c(10.41, 10.29, 10.37, 10.42, 10.44, 10.08, 10.09, 10.41, 10.37, 10.39, 10.73, 10.22, 10.41)
Bmeans = c(8.09, 7.91, 8.63, 7.86, 7.83, 9.18, 9.12, 8.12, 8.1, 7.7, 7.89, 8.86, 8.39)
#Group inputs
JRCovs <- list(JRW.cov, JRB.cov)
JRMeans <- list(Wmeans, Bmeans)
JRNs <- list(1868, 305)Analysis
Initial Fits
I first refit Dolan's mesaurement and then higher-order models and then I fit a bifactor model with the same group factors. I also fit the models suggested by O'Grady, which are more factorially pure. The plotted models are from the white group.
#Measurement Model - Dolan
DMM.model <- '
VERBAL =~ IN + SIM + AR + VC + CP + PC + PA
PERFORMANCE =~ SIM + CP + PC + PA + BD + OA + CD + MZ
MEMORY =~ IN + AR + DS + TS + BD + CD + MZ'
#Higher-Order - Dolan
DHOF.model <- '
VERBAL =~ IN + SIM + AR + VC + CP + PC + PA
PERFORMANCE =~ SIM + CP + PC + PA + BD + OA + CD + MZ
MEMORY =~ IN + AR + DS + TS + BD + CD + MZ
g =~ VERBAL + PERFORMANCE + MEMORY'
#Bifactor - Dolan
DBF.model <- '
VERBAL =~ IN + SIM + AR + VC + CP + PC + PA
PERFORMANCE =~ SIM + CP + PC + PA + BD + OA + CD + MZ
MEMORY =~ IN + AR + DS + TS + BD + CD + MZ
g =~ IN + SIM + VC + CP + PC + PA + BD + OA + MZ + AR + DS + TS + CD'
#Measurement Model - O'Grady
OMM.model <- '
VERBAL =~ IN + SIM + VC + CP
PERFORMANCE =~ PC + PA + BD + OA + MZ
MEMORY =~ AR + DS + TS + CD'
#Higher-Order - O'Grady
OHOF.model <- '
VERBAL =~ IN + SIM + VC + CP
PERFORMANCE =~ PC + PA + BD + OA + MZ
MEMORY =~ AR + DS + TS + CD
g =~ VERBAL + PERFORMANCE + MEMORY'
#Bifactor - O'Grady
OBF.model <- '
VERBAL =~ IN + SIM + VC + CP
PERFORMANCE =~ PC + PA + BD + OA + MZ
MEMORY =~ AR + DS + TS + CD
g =~ IN + SIM + VC + CP + PC + PA + BD + OA + MZ + AR + DS + TS + CD'
DMM.fit <- cfa(DMM.model, sample.cov = JRW.cov, sample.nobs = 1868, std.lv = T, orthogonal = F)
DHOF.fit <- cfa(DHOF.model, sample.cov = JRW.cov, sample.nobs = 1868, std.lv = T, orthogonal = T)
DBF.fit <- cfa(DBF.model, sample.cov = JRW.cov, sample.nobs = 1868, std.lv = T, orthogonal = T)
OMM.fit <- cfa(OMM.model, sample.cov = JRW.cov, sample.nobs = 1868, std.lv = T, orthogonal = F)
OHOF.fit <- cfa(OHOF.model, sample.cov = JRW.cov, sample.nobs = 1868, std.lv = T, orthogonal = T)
OBF.fit <- cfa(OBF.model, sample.cov = JRW.cov, sample.nobs = 1868, std.lv = T, orthogonal = T)
round(cbind(DMM = fitMeasures(DMM.fit, FITM),
DHOF = fitMeasures(DHOF.fit, FITM),
DBF = fitMeasures(DBF.fit, FITM),
OMM = fitMeasures(OMM.fit, FITM),
OHOF = fitMeasures(OHOF.fit, FITM),
OBF = fitMeasures(OBF.fit, FITM)),3)## DMM DHOF DBF OMM OHOF
## chisq 151.169 151.169 96.149 383.635 383.635
## df 53.000 53.000 43.000 62.000 62.000
## npar 38.000 38.000 48.000 29.000 29.000
## cfi 0.988 0.988 0.993 0.960 0.960
## rmsea 0.031 0.031 0.026 0.053 0.053
## rmsea.ci.lower 0.026 0.026 0.019 0.048 0.048
## rmsea.ci.upper 0.037 0.037 0.033 0.058 0.058
## aic 113589.828 113589.828 113554.809 113804.295 113804.295
## bic 113800.068 113800.068 113820.375 113964.741 113964.741
## OBF
## chisq 229.019
## df 52.000
## npar 39.000
## cfi 0.978
## rmsea 0.043
## rmsea.ci.lower 0.037
## rmsea.ci.upper 0.048
## aic 113669.679
## bic 113885.451#Dolan groups and plots
DLATS <- list(
VERBAL = c("IN", "SIM", "AR", "VC", "CP", "PC", "PA"),
PERFORMANCE = c("SIM", "CP", "PC", "PA", "BD", "OA", "CD", "MZ"),
MEMORY = c("IN", "AR", "DS", "TS", "BD", "CD", "MZ"))
#semPaths(DMM.fit, "model", "std", title = F, residuals = F, groups = "DLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)
#semPaths(DHOF.fit, "model", "std", title = F, residuals = F, groups = "DLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = F)
#semPaths(DBF.fit, "model", "std", title = F, residuals = F, groups = "DLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)
semPaths(DMM.fit, "std", title = F, residuals = F, mar = c(2, 1, 3, 1), layout = "circle2", posCol = c("skyblue4", "red"), sizeMan = 7, edge.label.cex = 1.2)
semPaths(DHOF.fit, "std", title = F, residuals = F, mar = c(2, 1, 3, 1), layout = "circle2", bifactor = "g", posCol = c("skyblue4", "red"), sizeMan = 7, edge.label.cex = 1.2)
semPaths(DBF.fit, "std", title = F, residuals = F, mar = c(2, 1, 3, 1), layout = "circle2", bifactor = "g", posCol = c("skyblue4", "red"), sizeMan = 7, edge.label.cex = 1.2, exoCov = F)
#O'Grady groups and plots
OLATS <- list(
VERBAL = c("IN", "SIM", "VC", "CP"),
PERFORMANCE = c("PC", "PA", "BD", "OA", "MZ"),
MEMORY = c("AR", "DS", "TS", "CD"))
#semPaths(OMM.fit, "model", "std", title = F, residuals = F, groups = "OLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)
#semPaths(OHOF.fit, "model", "std", title = F, residuals = F, groups = "OLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = F)
#semPaths(OBF.fit, "model", "std", title = F, residuals = F, groups = "OLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)
semPaths(OMM.fit, "std", title = F, residuals = F, mar = c(2, 1, 3, 1), layout = "circle2", posCol = c("skyblue4", "red"), sizeMan = 7, edge.label.cex = 1.2)
semPaths(OHOF.fit, "std", title = F, residuals = F, mar = c(2, 1, 3, 1), layout = "circle2", bifactor = "g", posCol = c("skyblue4", "red"), sizeMan = 7, edge.label.cex = 1.2)
semPaths(OBF.fit, "std", title = F, residuals = F, mar = c(2, 1, 3, 1), layout = "circle2", bifactor = "g", posCol = c("skyblue4", "red"), sizeMan = 7, edge.label.cex = 1.2, exoCov = F)
I'll assess the fit of both models, but interpretation is clearer with the O'Grady-based factor structure even though the fit is somewhat worse. Fitting a huge number of cross-loadings seems more like a way to get to over- rather than accurate fittings.
Measurement Invariance
#Measurement model
DMMC.fit <- cfa(DMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F)
DMMM.fit <- cfa(DMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = "loadings")
DMMS.fit <- cfa(DMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts"))
DMMF.fit <- cfa(DMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
DMMV.fit <- cfa(DMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
DMMME.fit <- cfa(DMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(DMMC.fit, FITM),
METRIC = fitMeasures(DMMM.fit, FITM),
SCALAR = fitMeasures(DMMS.fit, FITM),
STRICT = fitMeasures(DMMF.fit, FITM),
LVARS = fitMeasures(DMMV.fit, FITM),
MEANS = fitMeasures(DMMME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 240.371 274.779 299.198 315.756 315.756
## df 106.000 125.000 135.000 148.000 148.000
## npar 102.000 83.000 73.000 60.000 60.000
## cfi 0.986 0.984 0.983 0.982 0.982
## rmsea 0.034 0.033 0.033 0.032 0.032
## rmsea.ci.lower 0.028 0.028 0.028 0.027 0.027
## rmsea.ci.upper 0.040 0.039 0.039 0.037 0.037
## aic 131983.153 131979.560 131983.980 131974.537 131974.537
## bic 132562.907 132451.321 132398.902 132315.569 132315.569
## MEANS
## chisq 602.019
## df 151.000
## npar 57.000
## cfi 0.952
## rmsea 0.052
## rmsea.ci.lower 0.048
## rmsea.ci.upper 0.057
## aic 132254.800
## bic 132578.780The measurement model given by Dolan is clearly measurement invariant and the means differ. Below, I used the same procedure for Dolan's higher-order model, even though this is not the correct procedure, which is really, reduced.
#Higher-order model
DHOFC.fit <- cfa(DHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F)
DHOFM.fit <- cfa(DHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = "loadings")
DHOFS.fit <- cfa(DHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts"))
DHOFF.fit <- cfa(DHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
DHOFV.fit <- cfa(DHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 1.604330e-14) is close to zero. This may be a symptom that the
## model is not identified.DHOFME.fit <- cfa(DHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))## Warning in lav_object_post_check(object): lavaan WARNING: some estimated lv
## variances are negativeround(cbind(CONFIGURAL = fitMeasures(DHOFC.fit, FITM),
METRIC = fitMeasures(DHOFM.fit, FITM),
SCALAR = fitMeasures(DHOFS.fit, FITM),
STRICT = fitMeasures(DHOFF.fit, FITM),
LVARS = fitMeasures(DHOFV.fit, FITM),
MEANS = fitMeasures(DHOFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 240.371 278.448 302.975 320.046 320.046
## df 106.000 127.000 136.000 149.000 149.000
## npar 102.000 81.000 72.000 59.000 59.000
## cfi 0.986 0.984 0.982 0.982 0.982
## rmsea 0.034 0.033 0.034 0.033 0.033
## rmsea.ci.lower 0.028 0.028 0.029 0.028 0.028
## rmsea.ci.upper 0.040 0.038 0.039 0.037 0.037
## aic 131983.153 131979.229 131985.756 131976.827 131976.827
## bic 132562.907 132439.622 132394.995 132312.175 132312.175
## MEANS
## chisq 619.732
## df 153.000
## npar 55.000
## cfi 0.951
## rmsea 0.053
## rmsea.ci.lower 0.049
## rmsea.ci.upper 0.057
## aic 132268.514
## bic 132581.126I now fit the bifactor model. Noting the numerous cross-loadings again, it's unlikely that convergence can occur without adjusting the rel.tol.
#Bifactor model
DBFC.fit <- cfa(DBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = T, control=list(rel.tol=1e-4))
DBFM.fit <- cfa(DBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = T, group.equal = "loadings", control=list(rel.tol=1e-4), check.gradient = F)
DBFS.fit <- cfa(DBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = T, group.equal = c("loadings", "intercepts"), control=list(rel.tol=1e-4), check.gradient = F)
DBFF.fit <- cfa(DBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"), control=list(rel.tol=1e-4), check.gradient = F)
DBFV.fit <- cfa(DBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"), control=list(rel.tol=1e-4), check.gradient = F)
DBFME.fit <- cfa(DBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "means"), control=list(rel.tol=1e-4), check.gradient = F)
round(cbind(CONFIGURAL = fitMeasures(DBFC.fit, FITM),
METRIC = fitMeasures(DBFM.fit, FITM),
SCALAR = fitMeasures(DBFS.fit, FITM),
STRICT = fitMeasures(DBFF.fit, FITM),
LVARS = fitMeasures(DBFV.fit, FITM),
MEANS = fitMeasures(DBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 164.333 238.710 257.043 269.989 264.177
## df 86.000 117.000 126.000 139.000 139.000
## npar 122.000 91.000 82.000 69.000 69.000
## cfi 0.992 0.987 0.986 0.986 0.987
## rmsea 0.029 0.031 0.031 0.029 0.029
## rmsea.ci.lower 0.022 0.025 0.026 0.024 0.023
## rmsea.ci.upper 0.036 0.037 0.036 0.035 0.034
## aic 131947.114 131959.492 131959.824 131946.771 131940.958
## bic 132640.545 132476.723 132425.901 132338.957 132333.145
## MEANS
## chisq 592.168
## df 143.000
## npar 65.000
## cfi 0.953
## rmsea 0.054
## rmsea.ci.lower 0.049
## rmsea.ci.upper 0.058
## aic 132260.949
## bic 132630.400The bifactor model is unbiased with Dolan's factor configuration. I next fit the O'Grady measurement, higher-order, and bifactor models.
#Measurement model
OMMC.fit <- cfa(OMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F)
OMMM.fit <- cfa(OMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = "loadings")
OMMS.fit <- cfa(OMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts"))
OMMF.fit <- cfa(OMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
OMMV.fit <- cfa(OMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
OMMME.fit <- cfa(OMM.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(OMMC.fit, FITM),
METRIC = fitMeasures(OMMM.fit, FITM),
SCALAR = fitMeasures(OMMS.fit, FITM),
STRICT = fitMeasures(OMMF.fit, FITM),
LVARS = fitMeasures(OMMV.fit, FITM),
MEANS = fitMeasures(OMMME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 543.752 557.396 598.739 612.922 612.922
## df 124.000 134.000 144.000 157.000 157.000
## npar 84.000 74.000 64.000 51.000 51.000
## cfi 0.956 0.955 0.952 0.952 0.952
## rmsea 0.056 0.054 0.054 0.052 0.052
## rmsea.ci.lower 0.051 0.049 0.049 0.047 0.047
## rmsea.ci.upper 0.061 0.059 0.058 0.056 0.056
## aic 132250.534 132244.177 132265.520 132253.703 132253.703
## bic 132727.978 132664.783 132629.287 132543.580 132543.580
## MEANS
## chisq 895.281
## df 160.000
## npar 48.000
## cfi 0.923
## rmsea 0.065
## rmsea.ci.lower 0.061
## rmsea.ci.upper 0.069
## aic 132530.062
## bic 132802.887#Higher-order model
OHOFC.fit <- cfa(OHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F)
OHOFM.fit <- cfa(OHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = "loadings")
OHOFS.fit <- cfa(OHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 1.087293e-16) is close to zero. This may be a symptom that the
## model is not identified.OHOFF.fit <- cfa(OHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 5.861285e-15) is close to zero. This may be a symptom that the
## model is not identified.OHOFV.fit <- cfa(OHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 3.456829e-15) is close to zero. This may be a symptom that the
## model is not identified.OHOFME.fit <- cfa(OHOF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(OHOFC.fit, FITM),
METRIC = fitMeasures(OHOFM.fit, FITM),
SCALAR = fitMeasures(OHOFS.fit, FITM),
STRICT = fitMeasures(OHOFF.fit, FITM),
LVARS = fitMeasures(OHOFV.fit, FITM),
MEANS = fitMeasures(OHOFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 543.752 561.749 602.898 618.018 618.018
## df 124.000 136.000 145.000 158.000 158.000
## npar 84.000 72.000 63.000 50.000 50.000
## cfi 0.956 0.955 0.952 0.952 0.952
## rmsea 0.056 0.054 0.054 0.052 0.052
## rmsea.ci.lower 0.051 0.049 0.049 0.048 0.048
## rmsea.ci.upper 0.061 0.058 0.058 0.056 0.056
## aic 132250.534 132244.531 132267.680 132256.799 132256.799
## bic 132727.978 132653.769 132625.763 132540.992 132540.992
## MEANS
## chisq 914.347
## df 162.000
## npar 46.000
## cfi 0.921
## rmsea 0.065
## rmsea.ci.lower 0.061
## rmsea.ci.upper 0.070
## aic 132545.128
## bic 132806.586#Bifactor model
OBFC.fit <- cfa(OBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = T, control=list(rel.tol=1e-4))## Warning in lav_object_post_check(object): lavaan WARNING: some estimated ov
## variances are negativeOBFM.fit <- cfa(OBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = T, group.equal = "loadings", control=list(rel.tol=1e-4), check.gradient = F)
OBFS.fit <- cfa(OBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = T, group.equal = c("loadings", "intercepts"), control=list(rel.tol=1e-4), check.gradient = F)
OBFF.fit <- cfa(OBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = F, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"), control=list(rel.tol=1e-4), check.gradient = F)
OBFV.fit <- cfa(OBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"), control=list(rel.tol=1e-4), check.gradient = F)
OBFME.fit <- cfa(OBF.model, sample.cov = JRCovs, sample.mean = JRMeans, sample.nobs = JRNs, std.lv = T, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "means"), control=list(rel.tol=1e-4), check.gradient = F)
round(cbind(CONFIGURAL = fitMeasures(OBFC.fit, FITM),
METRIC = fitMeasures(OBFM.fit, FITM),
SCALAR = fitMeasures(OBFS.fit, FITM),
STRICT = fitMeasures(OBFF.fit, FITM),
LVARS = fitMeasures(OBFV.fit, FITM),
MEANS = fitMeasures(OBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 351.214 387.291 421.068 434.481 435.061
## df 104.000 126.000 135.000 148.000 148.000
## npar 104.000 82.000 73.000 60.000 60.000
## cfi 0.974 0.972 0.970 0.970 0.970
## rmsea 0.047 0.044 0.044 0.042 0.042
## rmsea.ci.lower 0.041 0.039 0.039 0.038 0.038
## rmsea.ci.upper 0.052 0.049 0.049 0.047 0.047
## aic 132097.995 132090.072 132105.849 132093.262 132093.842
## bic 132689.117 132556.149 132520.771 132434.294 132434.874
## MEANS
## chisq 738.800
## df 152.000
## npar 56.000
## cfi 0.938
## rmsea 0.060
## rmsea.ci.lower 0.055
## rmsea.ci.upper 0.064
## aic 132389.581
## bic 132707.878The configural model had a slightly negative variance for the vocabulary subtest in the black group, but this quickly disappeared and it wasn't significant in the first place (p = 0.828). Adjustment was unnecessary with the metric model fixing the issue and fitting well. With both structures, the WISC-R was clearly unbiased.
Spearman's Hypothesis
Using the higher-order model, Dolan was unable to ascertain which form of Spearman's hypothesis fit best. I will reassess that with his and O'Grady's higher-order models and with both implied bifactor models. Briefly, to clarify for this dataset in particular, the strong model corresponds to all group factors being constrained, the weak 1 model corresponds to the verbal model being constrained, weak 2 to a constraint on performance, weak 3 to a constraint on memory, weak 4 to a constraint on verbal and performance, weak 5 to a constraint on verbal and memory, and weak 6 to a constraint on performance and memory, and the contra models have the same group factor constraints plus a constraint on g.
round(cbind(LVAR = fitMeasures(DHOFV.fit, FITM),
STRONG = fitMeasures(DHOFVS.fit, FITM),
WEAK1 = fitMeasures(DHOFVW1.fit, FITM),
WEAK2 = fitMeasures(DHOFVW2.fit, FITM),
WEAK3 = fitMeasures(DHOFVW3.fit, FITM),
WEAK4 = fitMeasures(DHOFVW4.fit, FITM),
WEAK5 = fitMeasures(DHOFVW5.fit, FITM),
WEAK6 = fitMeasures(DHOFVW6.fit, FITM),
CONTRA1 = fitMeasures(DHOFVC1.fit, FITM),
CONTRA2 = fitMeasures(DHOFVC2.fit, FITM),
CONTRA3 = fitMeasures(DHOFVC3.fit, FITM),
CONTRA4 = fitMeasures(DHOFVC4.fit, FITM),
CONTRA5 = fitMeasures(DHOFVC5.fit, FITM),
CONTRA6 = fitMeasures(DHOFVC6.fit, FITM)),3)## LVAR STRONG WEAK1 WEAK2 WEAK3
## chisq 320.046 378.742 320.046 320.046 320.046
## df 149.000 152.000 150.000 150.000 150.000
## npar 59.000 56.000 58.000 58.000 58.000
## cfi 0.982 0.976 0.982 0.982 0.982
## rmsea 0.033 0.037 0.032 0.032 0.032
## rmsea.ci.lower 0.028 0.032 0.027 0.027 0.027
## rmsea.ci.upper 0.037 0.042 0.037 0.037 0.037
## aic 131976.827 132029.523 131974.827 131974.827 131974.827
## bic 132312.175 132347.819 132304.491 132304.491 132304.491
## WEAK4 WEAK5 WEAK6 CONTRA1 CONTRA2
## chisq 354.452 325.613 368.700 528.766 554.276
## df 151.000 151.000 151.000 151.000 151.000
## npar 57.000 57.000 57.000 57.000 57.000
## cfi 0.979 0.982 0.977 0.960 0.957
## rmsea 0.035 0.033 0.036 0.048 0.050
## rmsea.ci.lower 0.030 0.028 0.032 0.044 0.045
## rmsea.ci.upper 0.040 0.037 0.041 0.052 0.054
## aic 132007.233 131978.394 132021.481 132181.547 132207.057
## bic 132331.213 132302.374 132345.462 132505.527 132531.037
## CONTRA3 CONTRA4 CONTRA5 CONTRA6
## chisq 362.388 615.935 528.766 567.174
## df 151.000 152.000 152.000 152.000
## npar 57.000 56.000 56.000 56.000
## cfi 0.978 0.951 0.960 0.956
## rmsea 0.036 0.053 0.048 0.050
## rmsea.ci.lower 0.031 0.049 0.043 0.046
## rmsea.ci.upper 0.041 0.057 0.052 0.055
## aic 132015.169 132266.716 132179.547 132217.955
## bic 132339.149 132585.013 132497.843 132536.251Selecting the best model from each set by way of BIC:
round(cbind(LVAR = fitMeasures(DHOFV.fit, FITM),
STRONG = fitMeasures(DHOFVS.fit, FITM),
WEAK = fitMeasures(DHOFVW5.fit, FITM),
CONTRA = fitMeasures(DHOFVC3.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 320.046 378.742 325.613 362.388
## df 149.000 152.000 151.000 151.000
## npar 59.000 56.000 57.000 57.000
## cfi 0.982 0.976 0.982 0.978
## rmsea 0.033 0.037 0.033 0.036
## rmsea.ci.lower 0.028 0.032 0.028 0.031
## rmsea.ci.upper 0.037 0.042 0.037 0.041
## aic 131976.827 132029.523 131978.394 132015.169
## bic 132312.175 132347.819 132302.374 132339.149Dolan found that his models B4 and C5 were the best-fitting weak and contra models; these were my models W2 and C4, but I found that W5 and C3 fit best. The differences were minor, but it does appear that the weak model fit considerably better. This may be because the information theoretic fit criteria were computed differently in lavaan versus LISREL, where they're computed correctly from the loglikelihood in lavaan and were approximated in LISREL. Overall the model fits are very similar, but slightly differ. The bifactor fits are assessed below.
round(cbind(LVAR = fitMeasures(DBFV.fit, FITM),
STRONG = fitMeasures(DBFVS.fit, FITM),
WEAK1 = fitMeasures(DBFVW1.fit, FITM),
WEAK2 = fitMeasures(DBFVW2.fit, FITM),
WEAK3 = fitMeasures(DBFVW3.fit, FITM),
WEAK4 = fitMeasures(DBFVW4.fit, FITM),
WEAK5 = fitMeasures(DBFVW5.fit, FITM),
WEAK6 = fitMeasures(DBFVW6.fit, FITM),
CONTRA1 = fitMeasures(DBFVC1.fit, FITM),
CONTRA2 = fitMeasures(DBFVC2.fit, FITM),
CONTRA3 = fitMeasures(DBFVC3.fit, FITM),
CONTRA4 = fitMeasures(DBFVC4.fit, FITM),
CONTRA5 = fitMeasures(DBFVC5.fit, FITM),
CONTRA6 = fitMeasures(DBFVC6.fit, FITM)),3)## LVAR STRONG WEAK1 WEAK2 WEAK3
## chisq 264.177 370.046 278.748 305.913 264.146
## df 139.000 142.000 140.000 140.000 140.000
## npar 69.000 66.000 68.000 68.000 68.000
## cfi 0.987 0.976 0.985 0.983 0.987
## rmsea 0.029 0.038 0.030 0.033 0.029
## rmsea.ci.lower 0.023 0.034 0.025 0.028 0.023
## rmsea.ci.upper 0.034 0.043 0.035 0.038 0.034
## aic 131940.958 132040.827 131953.529 131980.694 131938.928
## bic 132333.145 132415.962 132340.032 132367.197 132325.430
## WEAK4 WEAK5 WEAK6 CONTRA1 CONTRA2
## chisq 344.719 281.172 359.719 477.222 511.459
## df 141.000 141.000 141.000 141.000 141.000
## npar 67.000 67.000 67.000 67.000 67.000
## cfi 0.979 0.985 0.977 0.965 0.961
## rmsea 0.036 0.030 0.038 0.047 0.049
## rmsea.ci.lower 0.032 0.025 0.033 0.042 0.045
## rmsea.ci.upper 0.041 0.035 0.043 0.052 0.054
## aic 132017.500 131953.953 132032.501 132150.003 132184.241
## bic 132398.319 132334.772 132413.319 132530.822 132565.059
## CONTRA3 CONTRA4 CONTRA5 CONTRA6
## chisq 325.158 591.067 477.646 524.825
## df 141.000 142.000 142.000 142.000
## npar 67.000 66.000 66.000 66.000
## cfi 0.981 0.953 0.965 0.960
## rmsea 0.035 0.054 0.047 0.050
## rmsea.ci.lower 0.030 0.049 0.042 0.045
## rmsea.ci.upper 0.040 0.058 0.051 0.054
## aic 131997.939 132261.848 132148.427 132195.606
## bic 132378.758 132636.983 132523.562 132570.741Again, selecting the best models from each category by BIC:
round(cbind(LVAR = fitMeasures(DBFV.fit, FITM),
STRONG = fitMeasures(DBFVS.fit, FITM),
WEAK = fitMeasures(DBFVW3.fit, FITM),
CONTRA = fitMeasures(DBFVC3.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 264.177 370.046 264.146 325.158
## df 139.000 142.000 140.000 141.000
## npar 69.000 66.000 68.000 67.000
## cfi 0.987 0.976 0.987 0.981
## rmsea 0.029 0.038 0.029 0.035
## rmsea.ci.lower 0.023 0.034 0.023 0.030
## rmsea.ci.upper 0.034 0.043 0.034 0.040
## aic 131940.958 132040.827 131938.928 131997.939
## bic 132333.145 132415.962 132325.430 132378.758Frisby & Beaujean might have been correct: the \(\Delta\)BIC was ~37 for the higher-order and ~53 for the bifactor model. Overall, the weak form of Spearman's hypothesis seems confirmed with Dolan's model. Importantly, the bifactor model selected consistent group factor constraints, perhaps adding another reason why it should be preferred for this sort of test, since that is the expected situation if something real is being modeled. Next, I fit the O'Grady models.
round(cbind(LVAR = fitMeasures(OHOFV.fit, FITM),
STRONG = fitMeasures(OHOFVS.fit, FITM),
WEAK1 = fitMeasures(OHOFVW1.fit, FITM),
WEAK2 = fitMeasures(OHOFVW2.fit, FITM),
WEAK3 = fitMeasures(OHOFVW3.fit, FITM),
WEAK4 = fitMeasures(OHOFVW4.fit, FITM),
WEAK5 = fitMeasures(OHOFVW5.fit, FITM),
WEAK6 = fitMeasures(OHOFVW6.fit, FITM),
CONTRA1 = fitMeasures(OHOFVC1.fit, FITM),
CONTRA2 = fitMeasures(OHOFVC2.fit, FITM),
CONTRA3 = fitMeasures(OHOFVC3.fit, FITM),
CONTRA4 = fitMeasures(OHOFVC4.fit, FITM),
CONTRA5 = fitMeasures(OHOFVC5.fit, FITM),
CONTRA6 = fitMeasures(OHOFVC6.fit, FITM)),3)## LVAR STRONG WEAK1 WEAK2 WEAK3
## chisq 618.018 672.871 618.018 618.018 618.018
## df 158.000 161.000 159.000 159.000 159.000
## npar 50.000 47.000 49.000 49.000 49.000
## cfi 0.952 0.946 0.952 0.952 0.952
## rmsea 0.052 0.054 0.052 0.052 0.052
## rmsea.ci.lower 0.048 0.050 0.047 0.047 0.047
## rmsea.ci.upper 0.056 0.058 0.056 0.056 0.056
## aic 132256.799 132305.652 132254.799 132254.799 132254.799
## bic 132540.992 132572.794 132533.308 132533.308 132533.308
## WEAK4 WEAK5 WEAK6 CONTRA1 CONTRA2
## chisq 643.536 630.513 670.257 836.506 885.010
## df 160.000 160.000 160.000 160.000 160.000
## npar 48.000 48.000 48.000 48.000 48.000
## cfi 0.949 0.950 0.946 0.929 0.924
## rmsea 0.053 0.052 0.054 0.062 0.065
## rmsea.ci.lower 0.049 0.048 0.050 0.058 0.060
## rmsea.ci.upper 0.057 0.056 0.058 0.067 0.069
## aic 132278.317 132265.295 132305.038 132471.287 132519.791
## bic 132551.143 132538.120 132577.863 132744.112 132792.616
## CONTRA3 CONTRA4 CONTRA5 CONTRA6
## chisq 714.662 904.314 836.679 886.107
## df 160.000 161.000 161.000 161.000
## npar 48.000 47.000 47.000 47.000
## cfi 0.942 0.922 0.929 0.924
## rmsea 0.056 0.065 0.062 0.064
## rmsea.ci.lower 0.052 0.061 0.058 0.060
## rmsea.ci.upper 0.061 0.069 0.066 0.069
## aic 132349.443 132537.095 132469.460 132518.888
## bic 132622.269 132804.237 132736.601 132786.029round(cbind(LVAR = fitMeasures(OHOFV.fit, FITM),
STRONG = fitMeasures(OHOFVS.fit, FITM),
WEAK = fitMeasures(OHOFVW5.fit, FITM),
CONTRA = fitMeasures(OHOFVC3.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 618.018 672.871 630.513 714.662
## df 158.000 161.000 160.000 160.000
## npar 50.000 47.000 48.000 48.000
## cfi 0.952 0.946 0.950 0.942
## rmsea 0.052 0.054 0.052 0.056
## rmsea.ci.lower 0.048 0.050 0.048 0.052
## rmsea.ci.upper 0.056 0.058 0.056 0.061
## aic 132256.799 132305.652 132265.295 132349.443
## bic 132540.992 132572.794 132538.120 132622.269Supporting factorial determinacy, the same weak and contra models were selected with the Dolan and O'Grady higher-order structures. The support for the weak model over the contra was much stronger here, perhaps because there were no cross-loadings here.
round(cbind(LVAR = fitMeasures(OBFV.fit, FITM),
STRONG = fitMeasures(OBFVS.fit, FITM),
WEAK1 = fitMeasures(OBFVW1.fit, FITM),
WEAK2 = fitMeasures(OBFVW2.fit, FITM),
WEAK3 = fitMeasures(OBFVW3.fit, FITM),
WEAK4 = fitMeasures(OBFVW4.fit, FITM),
WEAK5 = fitMeasures(OBFVW5.fit, FITM),
WEAK6 = fitMeasures(OBFVW6.fit, FITM),
CONTRA1 = fitMeasures(OBFVC1.fit, FITM),
CONTRA2 = fitMeasures(OBFVC2.fit, FITM),
CONTRA3 = fitMeasures(OBFVC3.fit, FITM),
CONTRA4 = fitMeasures(OBFVC4.fit, FITM),
CONTRA5 = fitMeasures(OBFVC5.fit, FITM),
CONTRA6 = fitMeasures(OBFVC6.fit, FITM)),3)## LVAR STRONG WEAK1 WEAK2 WEAK3
## chisq 435.061 495.390 435.207 464.219 434.780
## df 148.000 151.000 149.000 149.000 149.000
## npar 60.000 57.000 59.000 59.000 59.000
## cfi 0.970 0.964 0.970 0.967 0.970
## rmsea 0.042 0.046 0.042 0.044 0.042
## rmsea.ci.lower 0.038 0.041 0.037 0.040 0.037
## rmsea.ci.upper 0.047 0.050 0.047 0.049 0.047
## aic 132093.842 132148.171 132091.988 132121.000 132091.561
## bic 132434.874 132472.151 132427.336 132456.348 132426.909
## WEAK4 WEAK5 WEAK6 CONTRA1 CONTRA2
## chisq 473.433 444.918 494.005 654.944 712.276
## df 150.000 150.000 150.000 150.000 150.000
## npar 58.000 58.000 58.000 58.000 58.000
## cfi 0.966 0.969 0.964 0.947 0.941
## rmsea 0.045 0.043 0.046 0.056 0.059
## rmsea.ci.lower 0.040 0.038 0.041 0.051 0.054
## rmsea.ci.upper 0.049 0.047 0.050 0.060 0.063
## aic 132128.214 132099.699 132148.786 132309.725 132367.058
## bic 132457.878 132429.364 132478.450 132639.389 132696.722
## CONTRA3 CONTRA4 CONTRA5 CONTRA6
## chisq 545.981 729.287 657.036 712.291
## df 150.000 151.000 151.000 151.000
## npar 58.000 57.000 57.000 57.000
## cfi 0.958 0.939 0.947 0.941
## rmsea 0.049 0.059 0.056 0.058
## rmsea.ci.lower 0.045 0.055 0.051 0.054
## rmsea.ci.upper 0.054 0.064 0.060 0.063
## aic 132200.763 132382.068 132309.817 132365.072
## bic 132530.427 132706.049 132633.798 132689.052round(cbind(LVAR = fitMeasures(OBFV.fit, FITM),
STRONG = fitMeasures(OBFVS.fit, FITM),
WEAK = fitMeasures(OBFVW3.fit, FITM),
CONTRA = fitMeasures(OBFVC3.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 435.061 495.390 434.780 545.981
## df 148.000 151.000 149.000 150.000
## npar 60.000 57.000 59.000 58.000
## cfi 0.970 0.964 0.970 0.958
## rmsea 0.042 0.046 0.042 0.049
## rmsea.ci.lower 0.038 0.041 0.037 0.045
## rmsea.ci.upper 0.047 0.050 0.047 0.054
## aic 132093.842 132148.171 132091.561 132200.763
## bic 132434.874 132472.151 132426.909 132530.427The bifactor model also supports the same factorial constraints as with the Dolan bifactor structure, again supporting factorial determinacy, but also more strongly supporting the weak model, which gave \(\Delta\)BIC of ~84 for the higher-order and ~104 for the bifactor structure. Frisby & Beaujean seem correct, although to a modest degree (which is still considerable given how valuable power is), concerns about confounding by overfitting or conflating factors are clear, and the Jensen & Reynolds data seem to support the weak version of Spearman's hypothesis.
Because of these results, it will be interesting to assess the proportion of the group differences attributable to g in the latent variances and weak models for both the higher-order and bifactor structures. For the sake of simplicity, I'll just do this for the O'Grady bifactor structure (latent variances model for loadings), though there won't be much difference with the Dolan structure and using the higher-order probably won't do much either (\(\pm\) proportionality constraint/tetrad violation effects). I use the fit of the bifactor O'Grady model for the cumulative fit plot at the end of the paper because it made more theoretical sense, but it doesn't substantively change the result.
Traditional Analyses
In the latent variances model, g explained 60.5% of the group differences and in the selected weak model, it explained 68.8%.
The MCV relationships for g are \(r = 0.158, \rho = 0.261,\) and \(\phi = 0.942\); for the non-g loadings they are \(r = 0.805, \rho = 0.816,\) and \(\phi = 0.924\). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.946; for the non-g loadings it becomes 0.920. Clearly the typical MCV interpretation does not work well here and \(\phi\) makes more sense. This may be because, as Gorsuch and Gordon have remarked, only the PCA loadings are supposed to work for the congruence coefficient, and the \(R_{pb}\) is an approximation here. The zeroes for the non-g loadings are actually making it stronger in terms of MCV interpretations.
MCVDFD %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#C70039", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in Jensen & Reynolds (1982)/Dolan (2000)") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.85, 0.15), legend.background = element_blank())
MCVDFD %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#C70039", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in Jensen & Reynolds (1982)/Dolan (2000)") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.85, 0.15), legend.background = element_blank())
ggplot(MCVDFD, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#C70039", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in Jensen & Reynolds (1982)/Dolan (2000)") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDFD, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#C70039", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in Jensen & Reynolds (1982)/Dolan (2000)") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
These results really help to push home the point that analyses should be model-based rather than done via MCV, which has no clear reference points.
Dolan & Hamaker
Dolan & Hamaker (2001) assessed Spearman's hypothesis in the sample provided by Naglieri & Jensen (1987). This sample included the subtests of the WISC-R and the Kaufman Assessment Battery for Children (KABC). Since there is no theoretical model for a combined battery analysis such as this, it was necessary for Dolan & Hamaker to perform an EFA, which resulted in a well-fitting three-factor model with a verbal, a memory, and a spatial group factor. They placed a higher-order g atop this measurement configuration and found support for strict factorial invariance but could not distinguish forms of Spearman's hypothesis. An advantage of this model is that the groups had the same sample size, but they were also small (n = 86 each). Just like with the Dolan (2000) result, I refit the data with a bifactor model. Notably, I think the model used in the Dolan & Hamaker analysis was more appropriate than the one used in the Dolan analysis because it included fewer cross-loadings. By Gorsuch's criteria that for each subtest you need 5 participants, for each group, this data would not be admissible.
Data Input
#Correlation matrices
lowerW = '
1
0.6 1
0.37 0.37 1
0.71 0.69 0.38 1
0.59 0.51 0.25 0.63 1
0.2 0.23 0.52 0.11 0.1 1
0.29 0.38 0.09 0.28 0.34 0.14 1
0.24 0.17 0.23 0.28 0.11 0.14 0.18 1
0.38 0.41 0.34 0.56 0.23 0.25 0.43 0.4 1
0.29 0.37 0.24 0.45 0.24 0.23 0.44 0.29 0.55 1
0.03 0.15 0.1 0.05 0.05 0.14 0.15 0.22 0.16 0.13 1
0.19 0.36 0.45 0.26 0.31 0.4 0.16 0.05 0.21 0.25 0.13 1
0.39 0.31 0 0.28 0.3 0.11 0.37 0.13 0.36 0.26 0.14 0 1
0.12 0.12 0.29 0.13 0.11 0.63 0.13 0.14 0.3 0.18 0 0.35 -0.08 1
0.31 0.29 0.44 0.37 0.21 0.26 0.4 0.37 0.675 0.53 0.27 0.31 0.07 0.25 1
0.11 0.18 0.39 0.12 0.17 0.64 0.19 0.04 0.29 0.21 0.22 0.36 -0.06 0.59 0.31 1
0.23 0.36 0.39 0.41 0.38 0.26 0.36 0.32 0.48 0.4 0.24 0.39 0.17 0.21 0.44 0.25 1
0.02 0.14 0.09 0.07 0.09 0.14 0.29 0.2 0.28 0.32 0.45 0.3 0.17 0.09 0.39 0.25 0.29 1
0.31 0.4 0.32 0.3 0.31 0.09 0.17 0.1 0.29 0.32 0.21 0.33 0.32 -0.02 0.31 0.1 0.14 0.29 1
0.72 0.68 0.2 0.75 0.54 0.09 0.34 0.2 0.4 0.35 -0.09 0.24 0.35 0.08 0.24 0.07 0.26 -0.03 0.32 1
0.49 0.44 0.57 0.54 0.49 0.43 0.15 0.24 0.44 0.24 0.11 0.46 0.13 0.34 0.35 0.35 0.42 0.29 0.33 0.41 1
0.66 0.64 0.33 0.73 0.49 0.15 0.38 0.24 0.46 0.45 0 0.34 0.39 0.1 0.35 0.14 0.33 0.12 0.42 0.7 0.48 1
0.53 0.5 0.41 0.63 0.48 0.41 0.35 0.14 0.42 0.3 -0.04 0.4 0.12 0.35 0.3 0.29 0.51 0.1 0.17 0.53 0.65 0.55 1
0.55 0.51 0.39 0.59 0.46 0.27 0.23 0.18 0.33 0.29 0.1 0.34 0.09 0.16 0.36 0.25 0.37 0.14 0.3 0.47 0.53 0.6 0.68 1'
lowerB = '
1
0.71 1
0.48 0.46 1
0.7 0.65 0.44 1
0.68 0.67 0.53 0.76 1
0.11 0.19 0.15 0.25 0.23 1
0.39 0.43 0.23 0.26 0.39 0.1 1
0.36 0.41 0.3 0.33 0.39 0.17 0.39 1
0.45 0.56 0.44 0.43 0.49 0.22 0.58 0.44 1
0.2 0.25 0.06 0.16 0.19 0.12 0.44 0.37 0.51 1
0.11 0.04 0.21 0.13 0.18 0.24 0.09 0.21 0.25 0.27 1
0.15 0.18 0.27 0.11 0.21 0.38 0.16 0.23 0.29 0.15 0.26 1
0.25 0.33 0.18 0.26 0.27 0.18 0.41 0.36 0.42 0.35 0.1 0.13 1
0.16 0.17 0.19 0.27 0.23 0.52 0.14 0.06 0.23 0.01 0.08 0.19 0.06 1
0.27 0.4 0.27 0.31 0.33 0.19 0.51 0.39 0.66 0.53 0.12 0.19 0.5 0.22 1
0.24 0.2 0.25 0.1 0.28 0.29 0.25 0.23 0.18 0.08 0.12 0.26 0.08 0.4 0.1 1
0.44 0.48 0.35 0.43 0.44 0.33 0.45 0.26 0.59 0.38 0.22 0.26 0.34 0.24 0.41 0.32 1
0.26 0.26 0.18 0.22 0.28 0.31 0.33 0.35 0.44 0.48 0.3 0.22 0.27 0.18 0.48 0.3 0.41 1
0.19 0.18 0.2 0.14 0.26 0.12 0.38 0.44 0.45 0.35 0.39 0.28 0.21 0.09 0.28 0.11 0.35 0.38 1
0.66 0.53 0.25 0.69 0.55 0.18 0.35 0.34 0.38 0.27 0.09 0.13 0.29 0.09 0.26 0.09 0.35 0.24 0.12 1
0.44 0.45 0.59 0.47 0.57 0.14 0.27 0.26 0.51 0.06 0.07 0.28 0.11 0.18 0.3 0.23 0.41 0.12 0.21 0.29 1
0.73 0.64 0.43 0.69 0.67 0.24 0.4 0.58 0.55 0.28 0.17 0.2 0.37 0.26 0.39 0.18 0.47 0.3 0.31 0.69 0.48 1
0.55 0.43 0.35 0.6 0.48 0.3 0.17 0.1 0.34 0.11 0.12 0.16 0.22 0.23 0.12 0.12 0.52 0.24 0.1 0.59 0.39 0.52 1
0.59 0.56 0.41 0.67 0.61 0.15 0.27 0.27 0.39 0.21 0.13 0.25 0.33 0.24 0.23 0.13 0.46 0.21 0.19 0.67 0.45 0.63 0.73 1'
#Variable names
Names = list("I", "S", "A", "V", "C", "DS", "PC", "PA", "B", "OA", "CD", "HM", "GC", "NR", "T", "WO", "MA", "SM", "PS", "FP", "AR", "R", "RD", "RU")
#Convert to variance-covariance matrices
NJW.cor = getCov(lowerW, names = Names)
NJB.cor = getCov(lowerB, names = Names)
NJWSDs <- c(2.11, 2.91, 2.36, 2.4, 2.82, 2.9, 2.53, 2.12, 2.71, 3.02, 2.77, 2.34, 2.72, 2.52, 2.69, 2.12, 2.76, 2.51, 2.04, 12.55, 12.17, 11.08, 12.69, 9.02)
NJBSDs <- c(2.47, 2.66, 2.4, 2.49, 2.41, 2.72, 2.38, 2.22, 3.16, 2.98, 2.39, 2.24, 2.95, 2.47, 2.32, 1.67, 2.32, 2.43, 2.21, 12.44, 9.4, 11.42, 11.05, 8.45)
NJW.cov = lavaan::cor2cov(R = NJW.cor, sds = NJWSDs)
NJB.cov = lavaan::cor2cov(R = NJB.cor, sds = NJBSDs)
#Means
Wmeans = c(9.83, 10.73, 9.53, 10.35, 10.29, 8.93, 10.09, 11.38, 10.13, 9.98, 10.37, 9.09, 10.07, 9.84, 10.56, 9.19, 9.53, 9.53, 10.07, 99.63, 99.27, 99.8, 100.8, 96.66)
Bmeans = c(8.58, 8.87, 8.51, 9.05, 9.05, 8.52, 9.08, 10.55, 7.78, 8, 10.2, 8.1, 9.4, 9.79, 9.03, 8.87, 9.03, 8.42, 9.55, 96.06, 90.53, 91.95, 95.5, 92.74)
#Group inputs
NJCovs <- list(NJW.cov, NJB.cov)
NJMeans <- list(Wmeans, Bmeans)
NJNs <- list(86, 86)Analysis
Initial Fits
#Measurement Model - Dolan & Hamaker
DHMM.model <- '
VERBAL =~ I + S + A + V + C + FP + AR + R + RU
MEMORY =~ A + DS + HM + NR + WO + MA + AR
SPATIAL =~ PC + PA + B + OA + CD + GC + T + MA + SM + PS'
#Higher-Order - Dolan & Hamaker
DHHOF.model <- '
VERBAL =~ I + S + A + V + C + FP + AR + R + RU
MEMORY =~ A + DS + HM + NR + WO + MA + AR
SPATIAL =~ PC + PA + B + OA + CD + GC + T + MA + SM + PS
g =~ VERBAL + MEMORY + SPATIAL'
#Bifactor - Dolan & Hamaker
DHBF.model <- '
VERBAL =~ I + S + A + V + C + FP + AR + R + RU
MEMORY =~ A + DS + HM + NR + WO + MA + AR
SPATIAL =~ PC + PA + B + OA + CD + GC + T + MA + SM + PS
g =~ I + S + A + V + C + DS + PC + PA + B + OA + CD + HM + GC + NR + T + WO + MA + SM + PS + FP + AR + R + RU'
DHMM.fit <- cfa(DHMM.model, sample.cov = NJW.cov, sample.nobs = 86, std.lv = T, orthogonal = F)
DHHOF.fit <- cfa(DHHOF.model, sample.cov = NJW.cov, sample.nobs = 86, std.lv = T, orthogonal = T)## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## Could not compute standard errors! The information matrix could
## not be inverted. This may be a symptom that the model is not
## identified.DHBF.fit <- cfa(DHBF.model, sample.cov = NJW.cov, sample.nobs = 86, std.lv = T, orthogonal = T)
round(cbind(DHMM = fitMeasures(DHMM.fit, FITM),
DHHOF = fitMeasures(DHHOF.fit, FITM),
DHBF = fitMeasures(DHBF.fit, FITM)),3)## DHMM DHHOF DHBF
## chisq 322.770 322.795 283.363
## df 224.000 224.000 204.000
## npar 52.000 52.000 72.000
## cfi 0.891 0.891 0.913
## rmsea 0.072 0.072 0.067
## rmsea.ci.lower 0.053 0.053 0.047
## rmsea.ci.upper 0.088 0.088 0.085
## aic 9542.917 9542.942 9543.510
## bic 9670.543 9670.568 9720.223These models clearly did not fit well, but then again, the TLI in the Dolan & Hamaker paper ended up being $$0.89-0.91. They may need to be redone.
#Dolan & Hamaker groups and plots
DHLATS <- list(
VERBAL = c("I", "S", "A", "V", "C", "FP", "AR", "R", "RU"),
MEMORY = c("A", "DS", "HM", "NR", "WO", "MA", "AR"),
SPATIAL = c("PC", "PA", "B", "OA", "CD", "GC", "T", "MA", "SM", "PS"))
semPaths(DHMM.fit, "model", "std", title = F, residuals = F, groups = "DHLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(DHHOF.fit, "model", "std", title = F, residuals = F, groups = "DHLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(DHBF.fit, "model", "std", title = F, residuals = F, groups = "DHLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
The higher-order model actually produced a Heywood case for the spatial group factor and remains unidentified. The bifactor model reduces the verbal factor to nothing. This model will not do.
resFA <- n_factors(NJW.cor, type = "FA", package = "all", n.obs = 86)
fa.parallel(NJW.cor, n.obs = 86)
## Parallel analysis suggests that the number of factors = 3 and the number of components = 3plot(resFA, type = "line") + theme_bw()
FAT <- fa(NJW.cor, n.obs = 86, nfactors = 6)## Loading required namespace: GPArotationprint(FAT, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = NJW.cor, nfactors = 6, n.obs = 86)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR2 MR3 MR4 MR5 MR6 h2 u2 com
## I 0.82 0.69 0.31 1.1
## S 0.71 0.61 0.39 1.1
## A 0.32 0.50 0.62 0.38 2.5
## V 0.74 0.82 0.18 1.5
## C 0.66 0.52 0.48 1.5
## DS 0.91 0.79 0.21 1.0
## PC -0.47 0.51 0.49 2.8
## PA 0.52 0.25 0.75 1.0
## B 0.78 0.75 0.25 1.1
## OA 0.51 0.47 0.53 1.6
## CD 0.50 0.31 0.69 1.4
## HM 0.31 0.35 0.44 0.56 3.7
## GC 0.50 -0.36 -0.32 0.48 0.52 2.9
## NR 0.75 0.60 0.40 1.2
## T 0.77 0.68 0.32 1.2
## WO 0.71 0.57 0.43 1.1
## MA 0.35 0.36 0.49 0.51 2.9
## SM 0.69 0.57 0.43 1.3
## PS 0.42 0.41 -0.31 0.49 0.51 3.3
## FP 0.87 0.75 0.25 1.1
## AR 0.38 0.63 0.37 3.8
## R 0.76 0.70 0.30 1.1
## RD 0.48 0.53 0.80 0.20 2.3
## RU 0.50 0.56 0.44 2.1
##
## MR1 MR2 MR3 MR4 MR5 MR6
## SS loadings 5.25 2.52 2.65 1.64 0.95 1.09
## Proportion Var 0.22 0.10 0.11 0.07 0.04 0.05
## Cumulative Var 0.22 0.32 0.43 0.50 0.54 0.59
## Proportion Explained 0.37 0.18 0.19 0.12 0.07 0.08
## Cumulative Proportion 0.37 0.55 0.74 0.86 0.92 1.00
##
## With factor correlations of
## MR1 MR2 MR3 MR4 MR5 MR6
## MR1 1.00 0.21 0.44 0.20 0.08 0.24
## MR2 0.21 1.00 0.34 0.23 0.21 0.28
## MR3 0.44 0.34 1.00 0.36 0.01 0.18
## MR4 0.20 0.23 0.36 1.00 0.06 0.02
## MR5 0.08 0.21 0.01 0.06 1.00 0.16
## MR6 0.24 0.28 0.18 0.02 0.16 1.00
##
## Mean item complexity = 1.9
## Test of the hypothesis that 6 factors are sufficient.
##
## The degrees of freedom for the null model are 276 and the objective function was 14.89 with Chi Square of 1133.94
## The degrees of freedom for the model are 147 and the objective function was 2.23
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.05
##
## The harmonic number of observations is 86 with the empirical chi square 54.05 with prob < 1
## The total number of observations was 86 with Likelihood Chi Square = 161.22 with prob < 0.2
##
## Tucker Lewis Index of factoring reliability = 0.967
## RMSEA index = 0.031 and the 90 % confidence intervals are 0 0.063
## BIC = -493.57
## Fit based upon off diagonal values = 0.99
## Measures of factor score adequacy
## MR1 MR2 MR3 MR4 MR5 MR6
## Correlation of (regression) scores with factors 0.97 0.94 0.93 0.87 0.82 0.86
## Multiple R square of scores with factors 0.94 0.89 0.87 0.76 0.68 0.74
## Minimum correlation of possible factor scores 0.88 0.78 0.74 0.51 0.36 0.49FATP <- fa(NJW.cor, n.obs = 86, nfactors = 3)
print(FATP, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = NJW.cor, nfactors = 3, n.obs = 86)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR3 MR2 h2 u2 com
## I 0.83 0.66 0.34 1.0
## S 0.69 0.59 0.41 1.1
## A 0.52 0.44 0.56 1.4
## V 0.86 0.79 0.21 1.0
## C 0.66 0.46 0.54 1.0
## DS 0.78 0.62 0.38 1.0
## PC 0.48 0.33 0.67 1.5
## PA 0.40 0.19 0.81 1.1
## B 0.60 0.57 0.43 1.3
## OA 0.58 0.45 0.55 1.2
## CD 0.52 0.23 0.77 1.3
## HM 0.46 0.36 0.64 1.4
## GC 0.32 0.32 0.27 0.73 3.0
## NR 0.70 0.47 0.53 1.0
## T 0.67 0.57 0.43 1.1
## WO 0.70 0.53 0.47 1.1
## MA 0.41 0.39 0.61 2.0
## SM 0.67 0.39 0.61 1.2
## PS 0.32 0.24 0.76 2.0
## FP 0.89 0.73 0.27 1.0
## AR 0.46 0.46 0.58 0.42 2.0
## R 0.78 0.70 0.30 1.1
## RD 0.63 0.41 0.65 0.35 1.8
## RU 0.60 0.50 0.50 1.3
##
## MR1 MR3 MR2
## SS loadings 5.66 3.10 2.95
## Proportion Var 0.24 0.13 0.12
## Cumulative Var 0.24 0.36 0.49
## Proportion Explained 0.48 0.26 0.25
## Cumulative Proportion 0.48 0.75 1.00
##
## With factor correlations of
## MR1 MR3 MR2
## MR1 1.00 0.42 0.27
## MR3 0.42 1.00 0.34
## MR2 0.27 0.34 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 3 factors are sufficient.
##
## The degrees of freedom for the null model are 276 and the objective function was 14.89 with Chi Square of 1133.94
## The degrees of freedom for the model are 207 and the objective function was 3.75
##
## The root mean square of the residuals (RMSR) is 0.06
## The df corrected root mean square of the residuals is 0.07
##
## The harmonic number of observations is 86 with the empirical chi square 156.73 with prob < 1
## The total number of observations was 86 with Likelihood Chi Square = 278.18 with prob < 7e-04
##
## Tucker Lewis Index of factoring reliability = 0.885
## RMSEA index = 0.062 and the 90 % confidence intervals are 0.042 0.082
## BIC = -643.87
## Fit based upon off diagonal values = 0.97
## Measures of factor score adequacy
## MR1 MR3 MR2
## Correlation of (regression) scores with factors 0.97 0.92 0.93
## Multiple R square of scores with factors 0.94 0.84 0.86
## Minimum correlation of possible factor scores 0.88 0.68 0.71#Measurement Model - EFA
EMM.model <- '
VERBAL =~ I + S + V + C + GC + FP + AR + R + RU
SPATIAL =~ PC + PA + B + OA + CD + GC + T + MA + SM + PS
MEMORY =~ A + DS + HM + NR + WO + AR'
#Higher-Order - EFA
EHOF.model <- '
VERBAL =~ I + S + V + C + GC + FP + AR + R + RU
SPATIAL =~ PC + PA + B + OA + CD + GC + T + MA + SM + PS
MEMORY =~ A + DS + HM + NR + WO + AR
g =~ VERBAL + MEMORY + SPATIAL'
#Bifactor - EFA
EBF.model <- '
VERBAL =~ I + S + V + C + GC + FP + AR + R + RU
SPATIAL =~ PC + PA + B + OA + CD + GC + T + MA + SM + PS
MEMORY =~ A + DS + HM + NR + WO + AR
g =~ I + S + A + V + C + DS + PC + PA + B + OA + CD + HM + GC + NR + T + WO + MA + SM + PS + FP + AR + R + RU'
EMM.fit <- cfa(EMM.model, sample.cov = NJW.cov, sample.nobs = 86, std.lv = T, orthogonal = F)
EHOF.fit <- cfa(EHOF.model, sample.cov = NJW.cov, sample.nobs = 86, std.lv = T, orthogonal = T)
EBF.fit <- cfa(EBF.model, sample.cov = NJW.cov, sample.nobs = 86, std.lv = T, orthogonal = T)
round(cbind(EMM = fitMeasures(EMM.fit, FITM),
EHOF = fitMeasures(EHOF.fit, FITM),
EBF = fitMeasures(EBF.fit, FITM)),3)## EMM EHOF EBF
## chisq 329.832 329.832 276.775
## df 225.000 225.000 205.000
## npar 51.000 51.000 71.000
## cfi 0.885 0.885 0.921
## rmsea 0.074 0.074 0.064
## rmsea.ci.lower 0.056 0.056 0.043
## rmsea.ci.upper 0.090 0.090 0.082
## aic 9547.979 9547.979 9534.922
## bic 9673.151 9673.151 9709.181I kept RD out for the same reason Dolan & Hamaker did. On its face, the model may seem to be worse for the measurement and higher-order configurations, but this is not really true. The reason for this is that the models no longer suffer from specification problems: the higher-order Heywood case is gone and, excepting small sample significance issues which can be ignored, the bifactor model now has a reasonably well-defined verbal factor and we got to drop a cross-loading - huzzah.
#EFA groups and plots
ELATS <- list(
VERBAL = c("I", "S", "V", "C", "GC", "FP", "AR", "R", "RU"),
MEMORY = c("A", "DS", "HM", "NR", "WO", "AR"),
SPATIAL = c("PC", "PA", "B", "OA", "CD", "GC", "T", "MA", "SM", "PS"))
semPaths(EMM.fit, "model", "std", title = F, residuals = F, groups = "ELATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(EHOF.fit, "model", "std", title = F, residuals = F, groups = "ELATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(EBF.fit, "model", "std", title = F, residuals = F, groups = "ELATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
Measurement Invariance
#Measurement model
EMMC.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F)
EMMM.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = "loadings")
EMMS.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts"))
EMMF.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
EMMV.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
EMMME.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(EMMC.fit, FITM),
METRIC = fitMeasures(EMMM.fit, FITM),
SCALAR = fitMeasures(EMMS.fit, FITM),
STRICT = fitMeasures(EMMF.fit, FITM),
LVARS = fitMeasures(EMMV.fit, FITM),
MEANS = fitMeasures(EMMME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS MEANS
## chisq 629.756 652.353 697.165 737.284 737.284 763.347
## df 450.000 472.000 492.000 515.000 515.000 518.000
## npar 148.000 126.000 106.000 83.000 83.000 80.000
## cfi 0.900 0.899 0.885 0.876 0.876 0.863
## rmsea 0.068 0.067 0.070 0.071 0.071 0.074
## rmsea.ci.lower 0.055 0.054 0.057 0.059 0.059 0.063
## rmsea.ci.upper 0.080 0.079 0.081 0.082 0.082 0.085
## aic 19024.253 19002.849 19007.662 19001.780 19001.780 19021.844
## bic 19490.082 19399.434 19341.296 19263.023 19263.023 19273.643In this model, apparently, the intercepts may be biased. The BIC still improved considerably though.
#Partial scalar and beyond
EMMSP.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts"), group.partial = "AR~1")
EMMFII.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"), group.partial = "AR~1")
EMMVII.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"), group.partial = "AR~1")
EMMMEII.fit <- cfa(EMM.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"), group.partial = "AR~1")
round(cbind(CONFIGURAL = fitMeasures(EMMC.fit, FITM),
METRIC = fitMeasures(EMMM.fit, FITM),
SCALAR = fitMeasures(EMMS.fit, FITM),
PSCALAR = fitMeasures(EMMSP.fit, FITM),
STRICT = fitMeasures(EMMFII.fit, FITM),
LVARS = fitMeasures(EMMVII.fit, FITM),
MEANS = fitMeasures(EMMMEII.fit, FITM)),3)## CONFIGURAL METRIC SCALAR PSCALAR STRICT LVARS
## chisq 629.756 652.353 697.165 686.993 727.527 727.527
## df 450.000 472.000 492.000 491.000 514.000 514.000
## npar 148.000 126.000 106.000 107.000 84.000 84.000
## cfi 0.900 0.899 0.885 0.891 0.881 0.881
## rmsea 0.068 0.067 0.070 0.068 0.070 0.070
## rmsea.ci.lower 0.055 0.054 0.057 0.056 0.058 0.058
## rmsea.ci.upper 0.080 0.079 0.081 0.080 0.081 0.081
## aic 19024.253 19002.849 19007.662 18999.489 18994.023 18994.023
## bic 19490.082 19399.434 19341.296 19336.271 19258.413 19258.413
## MEANS
## chisq 753.088
## df 517.000
## npar 81.000
## cfi 0.868
## rmsea 0.073
## rmsea.ci.lower 0.061
## rmsea.ci.upper 0.084
## aic 19013.585
## bic 19268.532Excepting the KABC's arithmetic subtest, the measurement model here could be considered unbiased. Though the below is, again, more than what's required for testing higher-order invariance, it's fit in full anyway.
#Higher-order model
EHOFC.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F)
EHOFM.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = "loadings")
EHOFS.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 6.613249e-14) is close to zero. This may be a symptom that the
## model is not identified.EHOFF.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
EHOFV.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
EHOFME.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(EHOFC.fit, FITM),
METRIC = fitMeasures(EHOFM.fit, FITM),
SCALAR = fitMeasures(EHOFS.fit, FITM),
STRICT = fitMeasures(EHOFF.fit, FITM),
LVARS = fitMeasures(EHOFV.fit, FITM),
MEANS = fitMeasures(EHOFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS MEANS
## chisq 629.756 652.919 697.739 737.979 737.979 764.057
## df 450.000 474.000 493.000 516.000 516.000 520.000
## npar 148.000 124.000 105.000 82.000 82.000 78.000
## cfi 0.900 0.900 0.886 0.876 0.876 0.864
## rmsea 0.068 0.066 0.069 0.071 0.071 0.074
## rmsea.ci.lower 0.055 0.053 0.057 0.059 0.059 0.062
## rmsea.ci.upper 0.080 0.078 0.081 0.082 0.082 0.085
## aic 19024.253 18999.416 19006.236 19000.475 19000.475 19018.554
## bic 19490.082 19389.705 19336.723 19258.570 19258.570 19264.058#Partial scalar and beyond
EHOFSP.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts"), group.partial = "AR~1")## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 8.977551e-14) is close to zero. This may be a symptom that the
## model is not identified.EHOFFII.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"), group.partial = "AR~1")
EHOFVII.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"), group.partial = "AR~1")
EHOFMEII.fit <- cfa(EHOF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"), group.partial = "AR~1")
round(cbind(CONFIGURAL = fitMeasures(EHOFC.fit, FITM),
METRIC = fitMeasures(EHOFM.fit, FITM),
SCALAR = fitMeasures(EHOFS.fit, FITM),
PSCALAR = fitMeasures(EHOFSP.fit, FITM),
STRICT = fitMeasures(EHOFFII.fit, FITM),
LVARS = fitMeasures(EHOFVII.fit, FITM),
MEANS = fitMeasures(EHOFMEII.fit, FITM)),3)## CONFIGURAL METRIC SCALAR PSCALAR STRICT LVARS
## chisq 629.756 652.919 697.739 687.559 728.226 728.226
## df 450.000 474.000 493.000 492.000 515.000 515.000
## npar 148.000 124.000 105.000 106.000 83.000 83.000
## cfi 0.900 0.900 0.886 0.891 0.881 0.881
## rmsea 0.068 0.066 0.069 0.068 0.069 0.069
## rmsea.ci.lower 0.055 0.053 0.057 0.056 0.057 0.057
## rmsea.ci.upper 0.080 0.078 0.081 0.080 0.081 0.081
## aic 19024.253 18999.416 19006.236 18998.055 18992.722 18992.722
## bic 19490.082 19389.705 19336.723 19331.689 19253.964 19253.964
## MEANS
## chisq 753.750
## df 519.000
## npar 79.000
## cfi 0.869
## rmsea 0.073
## rmsea.ci.lower 0.061
## rmsea.ci.upper 0.084
## aic 19010.246
## bic 19258.898#Bifactor model
EBFC.fit <- cfa(EBF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = T)
EBFM.fit <- cfa(EBF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = T, group.equal = "loadings")
EBFS.fit <- cfa(EBF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = T, group.equal = c("loadings", "intercepts"))
EBFF.fit <- cfa(EBF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = F, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
EBFV.fit <- cfa(EBF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
EBFME.fit <- cfa(EBF.model, sample.cov = NJCovs, sample.mean = NJMeans, sample.nobs = NJNs, std.lv = T, orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(EBFC.fit, FITM),
METRIC = fitMeasures(EBFM.fit, FITM),
SCALAR = fitMeasures(EBFS.fit, FITM),
STRICT = fitMeasures(EBFF.fit, FITM),
LVARS = fitMeasures(EBFV.fit, FITM),
MEANS = fitMeasures(EBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS MEANS
## chisq 496.705 557.485 584.189 625.228 625.228 658.369
## df 410.000 454.000 473.000 496.000 496.000 500.000
## npar 188.000 144.000 125.000 102.000 102.000 98.000
## cfi 0.952 0.942 0.938 0.928 0.928 0.912
## rmsea 0.050 0.051 0.052 0.055 0.055 0.061
## rmsea.ci.lower 0.031 0.035 0.036 0.040 0.040 0.047
## rmsea.ci.upper 0.065 0.065 0.066 0.068 0.068 0.073
## aic 18971.201 18943.981 18932.685 18927.725 18927.725 18952.865
## bic 19562.930 19397.220 19326.122 19248.769 19248.769 19261.320The bifactor model is clearly enormously better-fitting and does not require any parameters to be freed to achieve invariance.
Spearman's Hypothesis
The Spearman's hypothesis models are fit in the same way as in the Dolan reanalysis. Weak 1 corresponds to a constraint on verbal, weak 2 to a constraint on spatial, weak 3 to a constraint on memory, weak 4 to verbal and spatial, weak 5 to verbal and memory, and weak 6 to spatial and memory, with the contra models corresponding.
round(cbind(LVAR = fitMeasures(EHOFVII.fit, FITM),
STRONG = fitMeasures(EHOFVS.fit, FITM),
WEAK1 = fitMeasures(EHOFVW1.fit, FITM),
WEAK2 = fitMeasures(EHOFVW2.fit, FITM),
WEAK3 = fitMeasures(EHOFVW3.fit, FITM),
WEAK4 = fitMeasures(EHOFVW4.fit, FITM),
WEAK5 = fitMeasures(EHOFVW5.fit, FITM),
WEAK6 = fitMeasures(EHOFVW6.fit, FITM),
CONTRA1 = fitMeasures(EHOFVC1.fit, FITM),
CONTRA2 = fitMeasures(EHOFVC2.fit, FITM),
CONTRA3 = fitMeasures(EHOFVC3.fit, FITM),
CONTRA4 = fitMeasures(EHOFVC4.fit, FITM),
CONTRA5 = fitMeasures(EHOFVC5.fit, FITM),
CONTRA6 = fitMeasures(EHOFVC6.fit, FITM)),3)## LVAR STRONG WEAK1 WEAK2 WEAK3 WEAK4
## chisq 728.226 729.253 728.226 728.226 728.226 728.226
## df 515.000 518.000 516.000 516.000 516.000 517.000
## npar 83.000 80.000 82.000 82.000 82.000 81.000
## cfi 0.881 0.882 0.882 0.882 0.882 0.882
## rmsea 0.069 0.069 0.069 0.069 0.069 0.069
## rmsea.ci.lower 0.057 0.057 0.057 0.057 0.057 0.057
## rmsea.ci.upper 0.081 0.080 0.081 0.081 0.081 0.080
## aic 18992.722 18987.750 18990.722 18990.722 18990.722 18988.723
## bic 19253.964 19239.549 19248.817 19248.817 19248.817 19243.670
## WEAK5 WEAK6 CONTRA1 CONTRA2 CONTRA3 CONTRA4
## chisq 729.114 729.137 744.918 750.952 732.110 753.688
## df 517.000 517.000 517.000 517.000 517.000 518.000
## npar 81.000 81.000 81.000 81.000 81.000 80.000
## cfi 0.882 0.882 0.873 0.869 0.880 0.868
## rmsea 0.069 0.069 0.072 0.073 0.070 0.073
## rmsea.ci.lower 0.057 0.057 0.060 0.061 0.058 0.061
## rmsea.ci.upper 0.080 0.080 0.083 0.084 0.081 0.084
## aic 18989.610 18989.633 19005.414 19011.449 18992.606 19012.184
## bic 19244.557 19244.580 19260.361 19266.396 19247.553 19263.984
## CONTRA5 CONTRA6
## chisq 745.263 750.952
## df 518.000 518.000
## npar 80.000 80.000
## cfi 0.873 0.870
## rmsea 0.071 0.072
## rmsea.ci.lower 0.060 0.061
## rmsea.ci.upper 0.083 0.083
## aic 19003.760 19009.449
## bic 19255.559 19261.248round(cbind(LVAR = fitMeasures(EHOFVII.fit, FITM),
STRONG = fitMeasures(EHOFVS.fit, FITM),
WEAK = fitMeasures(EHOFVW4.fit, FITM),
CONTRA = fitMeasures(EHOFVC3.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 728.226 729.253 728.226 732.110
## df 515.000 518.000 517.000 517.000
## npar 83.000 80.000 81.000 81.000
## cfi 0.881 0.882 0.882 0.880
## rmsea 0.069 0.069 0.069 0.070
## rmsea.ci.lower 0.057 0.057 0.057 0.058
## rmsea.ci.upper 0.081 0.080 0.080 0.081
## aic 18992.722 18987.750 18988.723 18992.606
## bic 19253.964 19239.549 19243.670 19247.553It is interesting that the strong and weak models all fit better than the latent variances model, whereas all but one of the contra models fit much worse. The contra model selected was not meaningfully worse, but is not favored and, despite having as many degrees of freedom as the selected weak model, it fit somewhat worse. The p value with 1 df between these models would be 0.049, so the contra model was strictly worse, although it's hard to say much with this little power and the near-equivalence of the models.
round(cbind(LVAR = fitMeasures(EBFV.fit, FITM),
STRONG = fitMeasures(EBFVS.fit, FITM),
WEAK1 = fitMeasures(EBFVW1.fit, FITM),
WEAK2 = fitMeasures(EBFVW2.fit, FITM),
WEAK3 = fitMeasures(EBFVW3.fit, FITM),
WEAK4 = fitMeasures(EBFVW4.fit, FITM),
WEAK5 = fitMeasures(EBFVW5.fit, FITM),
WEAK6 = fitMeasures(EBFVW6.fit, FITM),
CONTRA1 = fitMeasures(EBFVC1.fit, FITM),
CONTRA2 = fitMeasures(EBFVC2.fit, FITM),
CONTRA3 = fitMeasures(EBFVC3.fit, FITM),
CONTRA4 = fitMeasures(EBFVC4.fit, FITM),
CONTRA5 = fitMeasures(EBFVC5.fit, FITM),
CONTRA6 = fitMeasures(EBFVC6.fit, FITM)),3)## LVAR STRONG WEAK1 WEAK2 WEAK3 WEAK4
## chisq 625.228 629.550 625.385 626.932 627.043 627.458
## df 496.000 499.000 497.000 497.000 497.000 498.000
## npar 102.000 99.000 101.000 101.000 101.000 100.000
## cfi 0.928 0.927 0.928 0.927 0.927 0.928
## rmsea 0.055 0.055 0.055 0.055 0.055 0.055
## rmsea.ci.lower 0.040 0.041 0.040 0.040 0.040 0.040
## rmsea.ci.upper 0.068 0.068 0.068 0.068 0.068 0.068
## aic 18927.725 18926.047 18925.881 18927.429 18927.539 18925.955
## bic 19248.769 19237.649 19243.778 19245.326 19245.436 19240.704
## WEAK5 WEAK6 CONTRA1 CONTRA2 CONTRA3 CONTRA4
## chisq 627.177 629.054 651.916 656.945 651.433 657.260
## df 498.000 498.000 498.000 498.000 498.000 499.000
## npar 100.000 100.000 100.000 100.000 100.000 99.000
## cfi 0.928 0.927 0.914 0.911 0.914 0.912
## rmsea 0.055 0.055 0.060 0.061 0.060 0.061
## rmsea.ci.lower 0.040 0.041 0.046 0.047 0.046 0.047
## rmsea.ci.upper 0.068 0.068 0.072 0.073 0.072 0.073
## aic 18925.673 18927.550 18950.412 18955.441 18949.930 18953.756
## bic 19240.423 19242.299 19265.162 19270.190 19264.679 19265.358
## CONTRA5 CONTRA6
## chisq 652.773 658.028
## df 499.000 499.000
## npar 99.000 99.000
## cfi 0.914 0.911
## rmsea 0.060 0.061
## rmsea.ci.lower 0.046 0.047
## rmsea.ci.upper 0.072 0.073
## aic 18949.270 18954.524
## bic 19260.872 19266.126round(cbind(LVAR = fitMeasures(EBFV.fit, FITM),
STRONG = fitMeasures(EBFVS.fit, FITM),
WEAK = fitMeasures(EBFVW5.fit, FITM),
CONTRA = fitMeasures(EBFVC5.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 625.228 629.550 627.177 652.773
## df 496.000 499.000 498.000 499.000
## npar 102.000 99.000 100.000 99.000
## cfi 0.928 0.927 0.928 0.914
## rmsea 0.055 0.055 0.055 0.060
## rmsea.ci.lower 0.040 0.041 0.040 0.046
## rmsea.ci.upper 0.068 0.068 0.068 0.072
## aic 18927.725 18926.047 18925.673 18949.270
## bic 19248.769 19237.649 19240.423 19260.872In terms of \(\chi^2\) tests, the latent variance model could not be distinguished from the strong or weak models, nor could they be distinguished from one another. However, all models fit better than the contra model. The strong model in this case may be slightly better than the weak model, which is especially interesting due to the large number of variables in this analysis, which have been expected to strengthen the contra case, but did not. The AIC picks the weak over the strong model, but not meaningfully or what would be considered significantly, and the weak model was less parsimonious.
Since models could be differentiated far better with the bifactor, it seems that Frisby & Beaujean are vindicated; moreover, the bifactor picks more consistent models in terms of constrained bifactors, perhaps due to their better identification (even if they may end up weaker for it). Since the model only had acceptable fit for initial fitting at all in the bifactor rather than the measurement model or higher-order cases, the bifactor model interpretation should be preferred.
Traditional Analyses
In the bifactor latent variances model, g explained 51.9% of the group differences and in the selected weak model, it explained 73%, while in the best-fitting strong model, of course, 100% of the group differences are attributable to g.
The MCV relationships for g are \(r = 0.673, \rho = 0.705,\) and \(\phi = 0.933\); for the non-g loadings they are \(r = 0.198, \rho = 0.135,\) and \(\phi = 0.626\). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.936; for the non-g loadings it becomes 0.630. Unlike the earlier model, the zeroes for the non-g loadings make it weaker here for \(\phi\); with zeroes set to their unrestricted model values, the \(r = -0.138, \rho = -0.042,\) and \(\phi = 0.789\), with 0.797 for the point-biserial.
MCVDFE %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#098A32", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in Naglieri & Jensen (1987)/Dolan & Hamaker (2001)") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.85, 0.15), legend.background = element_blank())
MCVDFE %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#098A32", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in Naglieri & Jensen (1987)/Dolan & Hamaker (2001)") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
ggplot(MCVDFE, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#098A32", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in Naglieri & Jensen (1987)/Dolan & Hamaker (2001)") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDFE, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#098A32", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in Naglieri & Jensen (1987)/Dolan & Hamaker (2001)") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Frisby & Beaujean
Traditional Analyses
#Plot of the model
semPaths(FBBF.fit, "model", title = F, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", posCol = c("skyblue4", "red"), groups = "FBLATS", sizeMan = 7, edge.label.cex = 1.2, residuals = F, exoCov = F, pastel = T)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
With the bifactor g and non-g loadings from the latent variances model, the proportion of the group differences explicable by g in the Frisby & Beaujean WAIS-IV/WMS-IV dataset is 60.8%. The MCV relationships (using the weak loadings) for g are \(r = 0.602, \rho = 0.599,\) and \(\phi = 0.980\); for the non-g loadings they are \(r = 0.190, \rho = 0.265,\) and \(\phi = 0.745\) (these were negative, negative, and slightly higher with the latent variances loading). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.985; for the non-g loadings it becomes 0.744. Taking the best-fitting model - of the weak form of Spearman's hypothesis - the proportion of the group differences attributable to g jumps to 70.3%.
MCVDF %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
#geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR), size = 3) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR), size = 3) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#D16103", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in Frisby & Beaujean (2015)") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.y = element_blank(), legend.position = c(0.85, 0.15), legend.background = element_blank()) + coord_flip()
MCVDF %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
#geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR), size = 3) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR), size = 3) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#D16103", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in Frisby & Beaujean (2015)") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.y = element_blank(), legend.position = c(0.85, 0.15), legend.background = element_blank()) + coord_flip()
comp <- (mean(MCVDF$RPBS)/mean(MCVDF$GL))
compc <- (mean(MCVDF$RPBS)/mean(MCVDF$NGL))
MCVDF %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) + #ggplot(MCVDF, aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) + # ~.*comp,
scale_color_manual(values = c("#D16103", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in Frisby & Beaujean (2015)") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.65, 0.15), legend.background = element_blank())
MCVDF %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) + #~.*compc
scale_color_manual(values = c("#D16103", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in Frisby & Beaujean (2015)") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.45, 0.85), legend.background = element_blank())
ggplot(MCVDF, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#D16103", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in Frisby & Beaujean (2015)") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDF, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#D16103", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in Frisby & Beaujean (2015)") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Hu et al. (NLSY 97)
- Uploaded elsewhere, might upload here later
Lasker et al. - a (PNC/TCP)
- Same
Lasker et al. - b (PING)
- Same
Lasker, Kirkegaard & Nyborg - a (VES)
Initial Fits
VESW <- subset(VES, race == "White")
VESBW <- subset(VES, race == "Black" | race == "White")
VESFAVars <- c("WRAT", "CVLT", "WCST", "WBD", "WGI", "GPTR", "GPTL", "PASAT", "CD", "CI", "CY", "WLGT", "PA", "GIT", "AFQT", "ACVE", "ACVL", "ACAE", "ACAL")
VESFAData <- VESW[VESFAVars]fa.parallel(VESFAData)
## Parallel analysis suggests that the number of factors = 6 and the number of components = 3resFA <- n_factors(VESFAData, type = "FA", package = "all")
plot(resFA, type = "line") + theme_bw()
FA3 <- fa(VESFAData, nfactors = 3)
FA6 <- fa(VESFAData, nfactors = 6)
print(FA3, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = VESFAData, nfactors = 3)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR2 MR3 h2 u2 com
## WRAT 0.83 0.63 0.37 1.0
## CVLT 0.30 0.18 0.82 1.7
## WCST 0.18 0.82 1.7
## WBD 0.33 0.37 0.46 0.54 2.5
## WGI 0.79 0.62 0.38 1.0
## GPTR 0.85 0.68 0.32 1.0
## GPTL 0.73 0.54 0.46 1.0
## PASAT 0.46 0.29 0.71 1.2
## CD 0.41 0.29 0.71 1.4
## CI 0.93 0.85 0.15 1.0
## CY 0.94 0.87 0.13 1.0
## WLGT 0.51 0.28 0.72 1.0
## PA 0.46 0.30 0.50 0.50 1.9
## GIT 0.67 0.46 0.54 1.0
## AFQT 0.70 0.70 0.30 1.2
## ACVE 0.92 0.77 0.23 1.0
## ACVL 0.89 0.75 0.25 1.0
## ACAE 0.80 0.66 0.34 1.0
## ACAL 0.74 0.64 0.36 1.0
##
## MR1 MR2 MR3
## SS loadings 6.34 2.52 1.47
## Proportion Var 0.33 0.13 0.08
## Cumulative Var 0.33 0.47 0.54
## Proportion Explained 0.61 0.24 0.14
## Cumulative Proportion 0.61 0.86 1.00
##
## With factor correlations of
## MR1 MR2 MR3
## MR1 1.00 0.41 0.32
## MR2 0.41 1.00 0.30
## MR3 0.32 0.30 1.00
##
## Mean item complexity = 1.3
## Test of the hypothesis that 3 factors are sufficient.
##
## The degrees of freedom for the null model are 171 and the objective function was 11.86 with Chi Square of 43248.31
## The degrees of freedom for the model are 117 and the objective function was 1.29
##
## The root mean square of the residuals (RMSR) is 0.04
## The df corrected root mean square of the residuals is 0.05
##
## The harmonic number of observations is 3627 with the empirical chi square 1810.59 with prob < 2.5e-301
## The total number of observations was 3654 with Likelihood Chi Square = 4706.15 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.844
## RMSEA index = 0.104 and the 90 % confidence intervals are 0.101 0.106
## BIC = 3746.33
## Fit based upon off diagonal values = 0.99
## Measures of factor score adequacy
## MR1 MR2 MR3
## Correlation of (regression) scores with factors 0.97 0.96 0.89
## Multiple R square of scores with factors 0.95 0.93 0.79
## Minimum correlation of possible factor scores 0.89 0.86 0.58print(FA6, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = VESFAData, nfactors = 6)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR2 MR5 MR4 MR3 MR6 h2 u2 com
## WRAT 0.83 0.73 0.274 1.1
## CVLT 0.23 0.771 3.4
## WCST 0.18 0.817 2.2
## WBD 0.61 0.55 0.453 1.3
## WGI 0.68 0.64 0.360 1.1
## GPTR 0.89 0.77 0.232 1.0
## GPTL 0.69 0.51 0.490 1.0
## PASAT 0.61 0.43 0.574 1.3
## CD 0.34 0.29 0.712 1.9
## CI 0.94 0.89 0.111 1.0
## CY 0.97 0.94 0.065 1.0
## WLGT 0.43 0.41 0.45 0.546 2.1
## PA 0.86 0.72 0.276 1.0
## GIT 0.53 0.49 0.510 1.3
## AFQT 0.59 0.81 0.189 1.6
## ACVE 0.89 0.84 0.162 1.0
## ACVL 0.82 0.79 0.206 1.0
## ACAE 0.67 0.76 0.241 1.2
## ACAL 0.89 0.82 0.176 1.0
##
## MR1 MR2 MR5 MR4 MR3 MR6
## SS loadings 3.64 2.21 2.26 2.00 1.37 0.36
## Proportion Var 0.19 0.12 0.12 0.11 0.07 0.02
## Cumulative Var 0.19 0.31 0.43 0.53 0.60 0.62
## Proportion Explained 0.31 0.19 0.19 0.17 0.12 0.03
## Cumulative Proportion 0.31 0.49 0.68 0.85 0.97 1.00
##
## With factor correlations of
## MR1 MR2 MR5 MR4 MR3 MR6
## MR1 1.00 0.30 0.74 0.60 0.23 0.06
## MR2 0.30 1.00 0.38 0.52 0.25 0.07
## MR5 0.74 0.38 1.00 0.68 0.27 0.06
## MR4 0.60 0.52 0.68 1.00 0.35 -0.06
## MR3 0.23 0.25 0.27 0.35 1.00 0.12
## MR6 0.06 0.07 0.06 -0.06 0.12 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 6 factors are sufficient.
##
## The degrees of freedom for the null model are 171 and the objective function was 11.86 with Chi Square of 43248.31
## The degrees of freedom for the model are 72 and the objective function was 0.12
##
## The root mean square of the residuals (RMSR) is 0.01
## The df corrected root mean square of the residuals is 0.02
##
## The harmonic number of observations is 3627 with the empirical chi square 140.62 with prob < 2.4e-06
## The total number of observations was 3654 with Likelihood Chi Square = 452.91 with prob < 1.4e-56
##
## Tucker Lewis Index of factoring reliability = 0.979
## RMSEA index = 0.038 and the 90 % confidence intervals are 0.035 0.041
## BIC = -137.75
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## MR1 MR2 MR5 MR4 MR3
## Correlation of (regression) scores with factors 0.97 0.98 0.95 0.94 0.91
## Multiple R square of scores with factors 0.94 0.96 0.90 0.87 0.82
## Minimum correlation of possible factor scores 0.87 0.92 0.80 0.75 0.64
## MR6
## Correlation of (regression) scores with factors 0.67
## Multiple R square of scores with factors 0.45
## Minimum correlation of possible factor scores -0.11#Measurement model
VESMM.model <- '
VER =~ WRAT + WGI + WLGT + GIT + ACVE + ACVL
FD =~ CD + CI + CY
MAT =~ PASAT + ACAE + ACAL
SP =~ PA + AFQT + WBD
TA =~ GPTR + GPTL
CI ~~ CY'
#Higher-order model
VESHOF.model <- '
VER =~ WRAT + WGI + WLGT + GIT + ACVE + ACVL
FD =~ CD + CI + CY
MAT =~ PASAT + ACAE + ACAL
SP =~ PA + AFQT + WBD
TA =~ GPTR + GPTL
CI ~~ CY
g =~ VER + FD + MAT + SP + TA'
#Bifactor model
VESBF.model <- '
VER =~ WRAT + WGI + WLGT + GIT + ACVE + ACVL
FD =~ CD + CI + CY
MAT =~ PASAT + ACAE + ACAL
SP =~ PA + AFQT + WBD
GPTR ~~ GPTL
g =~ WRAT + WGI + WLGT + GIT + ACVE + ACVL + CD + CI + CY + PASAT + ACAE + ACAL + PA + AFQT + WBD + GPTR + GPTL'
VESMM.fit <- cfa(VESMM.model, data = VESFAData, std.lv = T, orthogonal = F)
VESHOF.fit <- cfa(VESHOF.model, data = VESFAData, std.lv = T, orthogonal = T)
VESBF.fit <- cfa(VESBF.model, data = VESFAData, std.lv = T, orthogonal = T)
round(cbind(MM = fitMeasures(VESMM.fit, FITM),
HOF = fitMeasures(VESHOF.fit, FITM),
BF = fitMeasures(VESBF.fit, FITM)),3)## MM HOF BF
## chisq 1822.635 2154.326 1638.033
## df 108.000 113.000 103.000
## npar 45.000 40.000 50.000
## cfi 0.958 0.950 0.962
## rmsea 0.067 0.071 0.065
## rmsea.ci.lower 0.064 0.069 0.062
## rmsea.ci.upper 0.070 0.074 0.068
## aic 454356.185 454677.877 454181.583
## bic 454634.110 454924.921 454490.389Given how much more parsimonious it is, the higher-order factor seems to, really, fit far better than the measurement or bifactor models. Giving it a few residual covariances leads to that conclusion being confirmed, but this might be overfitting so I didn't do it.
#VES group and plots
VESLATS <- list(
VER = c("WRAT", "WGI", "WLGT", "GIT", "ACVE", "ACVL"),
FD = c("CD", "CI", "CY"),
MAT = c("PASAT", "ACAE", "ACAL"),
SP = c("PA", "AFQT", "WBD"),
TA = c("GPTR", "GPTL"))
semPaths(VESMM.fit, "model", "std", title = F, residuals = F, groups = "VESLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)
semPaths(VESHOF.fit, "model", "std", title = F, residuals = F, groups = "VESLATS", pastel = T, mar = c(2.8, 1, 3, 1), layout = "tree2", exoCov = F)
semPaths(VESBF.fit, "model", "std", title = F, residuals = F, groups = "VESLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
Measurement Invariance
#Measurement model
VESMMC.fit <- cfa(VESMM.model, data = VESBW, std.lv = T, group = "race", orthogonal = F)
VESMMM.fit <- cfa(VESMM.model, data = VESBW, std.lv = F, group = "race", orthogonal = F, group.equal = "loadings")
VESMMS.fit <- cfa(VESMM.model, data = VESBW, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts"))
VESMMF.fit <- cfa(VESMM.model, data = VESBW, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
VESMMV.fit <- cfa(VESMM.model, data = VESBW, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
VESMMME.fit <- cfa(VESMM.model, data = VESBW, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(VESMMC.fit, FITM),
METRIC = fitMeasures(VESMMM.fit, FITM),
SCALAR = fitMeasures(VESMMS.fit, FITM),
STRICT = fitMeasures(VESMMF.fit, FITM),
LVARS = fitMeasures(VESMMV.fit, FITM),
MEANS = fitMeasures(VESMMME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 2266.682 2376.201 2688.242 3015.298 3028.714
## df 216.000 228.000 240.000 257.000 258.000
## npar 124.000 112.000 100.000 83.000 82.000
## cfi 0.954 0.952 0.946 0.939 0.938
## rmsea 0.068 0.068 0.071 0.073 0.073
## rmsea.ci.lower 0.066 0.066 0.069 0.070 0.070
## rmsea.ci.upper 0.071 0.071 0.073 0.075 0.075
## aic 519986.436 520071.954 520359.995 520653.051 520664.467
## bic 520768.652 520778.473 520990.815 521176.631 521181.739
## MEANS
## chisq 3728.417
## df 263.000
## npar 77.000
## cfi 0.923
## rmsea 0.081
## rmsea.ci.lower 0.078
## rmsea.ci.upper 0.083
## aic 521354.170
## bic 521839.901#Higher-order model
VESHOFC.fit <- cfa(VESHOF.model, data = VESBW, std.lv = T, group = "race", orthogonal = F)
VESHOFM.fit <- cfa(VESHOF.model, data = VESBW, std.lv = F, group = "race", orthogonal = F, group.equal = "loadings")
VESHOFS.fit <- cfa(VESHOF.model, data = VESBW, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts"))
VESHOFF.fit <- cfa(VESHOF.model, data = VESBW, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
VESHOFV.fit <- cfa(VESHOF.model, data = VESBW, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
VESHOFME.fit <- cfa(VESHOF.model, data = VESBW, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(VESHOFC.fit, FITM),
METRIC = fitMeasures(VESHOFM.fit, FITM),
SCALAR = fitMeasures(VESHOFS.fit, FITM),
STRICT = fitMeasures(VESHOFF.fit, FITM),
LVARS = fitMeasures(VESHOFV.fit, FITM),
MEANS = fitMeasures(VESHOFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 2636.068 2785.541 3101.030 3429.784 3447.986
## df 226.000 242.000 253.000 270.000 271.000
## npar 114.000 98.000 87.000 70.000 69.000
## cfi 0.946 0.943 0.937 0.930 0.929
## rmsea 0.073 0.072 0.074 0.076 0.076
## rmsea.ci.lower 0.070 0.070 0.072 0.074 0.074
## rmsea.ci.upper 0.075 0.074 0.077 0.078 0.078
## aic 520335.821 520453.294 520746.783 521041.537 521057.739
## bic 521054.956 521071.498 521295.596 521483.111 521493.005
## MEANS
## chisq 4104.587
## df 277.000
## npar 63.000
## cfi 0.915
## rmsea 0.083
## rmsea.ci.lower 0.080
## rmsea.ci.upper 0.085
## aic 521702.340
## bic 522099.757#Bifactor model
VESBFC.fit <- cfa(VESBF.model, data = VESBW, std.lv = T, group = "race", orthogonal = T)## Warning in lav_object_post_check(object): lavaan WARNING: some estimated ov
## variances are negativeVESBFM.fit <- cfa(VESBF.model, data = VESBW, std.lv = F, group = "race", orthogonal = T, group.equal = "loadings")
VESBFS.fit <- cfa(VESBF.model, data = VESBW, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts"))
VESBFF.fit <- cfa(VESBF.model, data = VESBW, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
VESBFV.fit <- cfa(VESBF.model, data = VESBW, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
VESBFME.fit <- cfa(VESBF.model, data = VESBW, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(VESBFC.fit, FITM),
METRIC = fitMeasures(VESBFM.fit, FITM),
SCALAR = fitMeasures(VESBFS.fit, FITM),
STRICT = fitMeasures(VESBFF.fit, FITM),
LVARS = fitMeasures(VESBFV.fit, FITM),
MEANS = fitMeasures(VESBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 2018.946 2168.978 2394.978 2793.819 2820.865
## df 206.000 233.000 245.000 262.000 263.000
## npar 134.000 107.000 95.000 78.000 77.000
## cfi 0.960 0.957 0.952 0.944 0.943
## rmsea 0.066 0.064 0.066 0.069 0.069
## rmsea.ci.lower 0.063 0.062 0.063 0.067 0.067
## rmsea.ci.upper 0.068 0.066 0.068 0.071 0.072
## aic 519758.699 519854.731 520056.731 520421.572 520446.618
## bic 520603.998 520529.708 520656.010 520913.612 520932.349
## MEANS
## chisq 3520.319
## df 268.000
## npar 72.000
## cfi 0.928
## rmsea 0.077
## rmsea.ci.lower 0.075
## rmsea.ci.upper 0.080
## aic 521136.072
## bic 521590.262PA initially throws a negative variance in the black group, but this is quickly corrected when the loadings are set to equality. Altering the initial model to account for this by constraining that variance, changes are negligible, so I excluded it.
#Partial bifactor model
VESBFSP.fit <- cfa(VESBF.model, data = VESBW, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts"), group.partial = c("GIT~1"))
VESBFFP.fit <- cfa(VESBF.model, data = VESBW, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"), group.partial = c("GIT~1", "GPTL~~GPTL", "CD~~CD", "ACVL~~ACVL"))
VESBFVP.fit <- cfa(VESBF.model, data = VESBW, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"), group.partial = c("GIT~1", "GPTL~~GPTL", "CD~~CD", "ACVL~~ACVL"))
VESBFMEP.fit <- cfa(VESBF.model, data = VESBW, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"), group.partial = c("GIT~1", "GPTL~~GPTL", "CD~~CD", "ACVL~~ACVL"))
round(cbind(CONFIGURAL = fitMeasures(VESBFC.fit, FITM),
METRIC = fitMeasures(VESBFM.fit, FITM),
SCALAR = fitMeasures(VESBFSP.fit, FITM),
STRICT = fitMeasures(VESBFFP.fit, FITM),
LVARS = fitMeasures(VESBFVP.fit, FITM),
MEANS = fitMeasures(VESBFMEP.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 2018.946 2168.978 2334.545 2454.438 2465.994
## df 206.000 233.000 244.000 258.000 259.000
## npar 134.000 107.000 96.000 82.000 81.000
## cfi 0.960 0.957 0.953 0.951 0.951
## rmsea 0.066 0.064 0.065 0.065 0.065
## rmsea.ci.lower 0.063 0.062 0.063 0.062 0.062
## rmsea.ci.upper 0.068 0.066 0.067 0.067 0.067
## aic 519758.699 519854.731 519998.298 520090.191 520099.747
## bic 520603.998 520529.708 520603.885 520607.463 520610.711
## MEANS
## chisq 3129.038
## df 264.000
## npar 76.000
## cfi 0.936
## rmsea 0.073
## rmsea.ci.lower 0.071
## rmsea.ci.upper 0.075
## aic 520752.791
## bic 521232.214The degree to which the GIT intercept is biased can be assessed with \(SDI_2\). The way this works is that the second group (in this case, whites) has the \(d\) change in a given one of their observed scores if they had the non-invariant parameter from the other group. As seen below, the GIT intercept is negligibly (\(d = 0.0263\)) biased in favor of the black group (strict model used; latent variance model intercepts are the same except the black one is reduced by 0.001, using standardized intercepts); despite the small size of this effect, this lead to invariance looking violated. Alternatively, using the unstandardized intercepts, the difference was modest in size (\(d = -0.3555\)) against the black group; this is the likelier correct interpretation in my view, but I will defer to Gunn, Grimm & Edwards on this. In the constrained strict model, the factor means were VER = -0.348, FD = -0.010, MAT = -0.008, SP = -0.042, and g = 1.413; releasing the residuals, they became -0.363, -0.008, 0.004, -0.041, and 1.408 (higher favors whites). Nonetheless, these partial models are the ones I fit in the aggregate plot. This example should illustrate why it's important to always empirically assess bias rather than to conclude, just because it seems to be found in NHST terms, that it matters, or for that matter, which direction it faces.
#Effect of intercept bias
Vp = 6; Vl1 = c(0, 0, 0, 0, 0, 0); Vl2 = c(0, 0, 0, 0, 0, 0); Vi1 = c(0, 0, 0, 6.960, 0, 0); Vi2 = c(0, 0, 0, 6.600, 0, 0); Vsd = c(14.6, 14.8, 15.0, 13.7, 14.2, 13.7); Vfm = -0.363; Vfsd = 1
BFES <- SDI2.UDI2(Vp, Vl1, Vl2, Vi1, Vi2, Vsd, Vfm, Vfsd)
BFES$SDI2## SDI2
## [1,] 0.0000
## [2,] 0.0000
## [3,] 0.0000
## [4,] 0.0263
## [5,] 0.0000
## [6,] 0.0000#Unstandardized intercepts
Vp = 6; Vl1 = c(0, 0, 0, 0, 0, 0); Vl2 = c(0, 0, 0, 0, 0, 0); Vi1 = c(0, 0, 0, 85.754, 0, 0); Vi2 = c(0, 0, 0, 90.625, 0, 0); Vsd = c(14.6, 14.8, 15.0, 13.7, 14.2, 13.7); Vfm = -0.363; Vfsd = 1
BFES <- SDI2.UDI2(Vp, Vl1, Vl2, Vi1, Vi2, Vsd, Vfm, Vfsd)
BFES$SDI2## SDI2
## [1,] 0.0000
## [2,] 0.0000
## [3,] 0.0000
## [4,] -0.3555
## [5,] 0.0000
## [6,] 0.0000Spearman's Hypothesis
FD, MAT, and SP were not significantly differentiated (\(p's = 0.882, 0.991, 0.554\)) in the bifactor model with the partial intercept and variances (although I did not need to use the partial model as the above fits indicate), so I constrained them. In the higher-order model, only TA was insignificantly differentiated (\(p = 0.739\)).
round(cbind(LVAR = fitMeasures(VESHOFV.fit, FITM),
STRONG = fitMeasures(VESHOFVS.fit, FITM),
WEAK = fitMeasures(VESHOFVW.fit, FITM),
CONTRA = fitMeasures(VESHOFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 3447.986 3464.277 3447.399 3529.317
## df 271.000 276.000 272.000 273.000
## npar 69.000 64.000 68.000 67.000
## cfi 0.929 0.929 0.929 0.928
## rmsea 0.076 0.075 0.076 0.077
## rmsea.ci.lower 0.074 0.073 0.074 0.074
## rmsea.ci.upper 0.078 0.078 0.078 0.079
## aic 521057.739 521064.030 521055.152 521135.070
## bic 521493.005 521467.755 521484.109 521557.719round(cbind(LVAR = fitMeasures(VESBFVP.fit, FITM),
STRONG = fitMeasures(VESBFVS.fit, FITM),
WEAK = fitMeasures(VESBFVW.fit, FITM),
CONTRA = fitMeasures(VESBFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 2465.994 2486.150 2466.321 3124.056
## df 259.000 263.000 262.000 263.000
## npar 81.000 77.000 78.000 77.000
## cfi 0.951 0.951 0.951 0.936
## rmsea 0.065 0.065 0.064 0.073
## rmsea.ci.lower 0.062 0.062 0.062 0.071
## rmsea.ci.upper 0.067 0.067 0.067 0.076
## aic 520099.747 520111.903 520094.074 520749.809
## bic 520610.711 520597.634 520586.114 521235.540Invariance seems to work for both the higher-order and bifactor models, but the higher-order model looks to confirm the strong over the weak form, and both over the contra model, whereas the bifactor model clearly supports the weak form. Assessing what possibly apparent (by at least one metric) invariance violations actually did to the observed scores by group found that they looked negligible; perhaps this is because there wasn't really a violation of invariance and some fit guidelines work better than others. This deserves careful simulation study.
Traditional Analyses
The proportion of the group differences attributable to g was 61% in the latent variances model and 81.9% in the selected weak model. The MCV relationships for g are \(r = 0.828, \rho = 0.819,\) and \(\phi = 0.983\); for the non-g loadings they are \(r = -0.056, \rho = 0.029,\) and \(\phi = 0.518\). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.985; for the non-g loadings it becomes 0.526. Using the latent variances non-g loadings, these became \(r = -0.064, -0.092, 0.793,\) and \(0.808\).
MCVDFVES %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#10169C", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in the Vietnam Experience Study") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
MCVDFVES %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#10169C", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in the Vietnam Experience Study") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
ggplot(MCVDFVES, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#10169C", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in the Vietnam Experience Study") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDFVES, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#10169C", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in the Vietnam Experience Study") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Lasker, Kirkegaard & Nyborg - b (NLSY 79)
Initial Fits
NLS79 %<>% rename(
SCI = asvabsci,
ARI = asvabarithmetic,
WKN = asvabwordknow,
PAR = asvabpara,
NUM = asvabnumeric,
COS = asvabcodingspeed,
ASH = asvabautoshop,
MKN = asvabmathknow,
MEC = asvabmechcomp,
ELE = asvabelectricinf)
NLS79 <- umx_residualize(c("SCI", "ARI", "WKN", "PAR", "NUM", "COS", "ASH", "MKN", "MEC", "ELE"), c("age", "sex"), data = NLS79)## [1] "(Intercept) B = 7.952 [7.139, 8.766], t = 19.164, p < 0.001"
## [1] "age B = 0.491 [0.448, 0.533], t = 22.764, p < 0.001"
## [1] "sex B = -1.343 [-1.538, -1.147], t = -13.476, p < 0.001"
## [1] "(Intercept) B = 8.445 [7.285, 9.605], t = 14.27, p < 0.001"
## [1] "age B = 0.555 [0.495, 0.616], t = 18.068, p < 0.001"
## [1] "sex B = -1.39 [-1.668, -1.111], t = -9.781, p < 0.001"
## [1] "(Intercept) B = 7.377 [6.052, 8.702], t = 10.912, p < 0.001"
## [1] "age B = 0.9 [0.831, 0.968], t = 25.628, p < 0.001"
## [1] "sex B = 0.438 [0.12, 0.756], t = 2.699, p = 0.007"
## [1] "(Intercept) B = 3.615 [3.039, 4.191], t = 12.303, p < 0.001"
## [1] "age B = 0.304 [0.274, 0.334], t = 19.916, p < 0.001"
## [1] "sex B = 0.759 [0.62, 0.897], t = 10.751, p < 0.001"
## [1] "(Intercept) B = 15.591 [13.763, 17.418], t = 16.727, p < 0.001"
## [1] "age B = 0.709 [0.614, 0.804], t = 14.645, p < 0.001"
## [1] "sex B = 2.685 [2.246, 3.123], t = 11.998, p < 0.001"
## [1] "(Intercept) B = 6.982 [4.378, 9.585], t = 5.257, p < 0.001"
## [1] "age B = 1.403 [1.268, 1.538], t = 20.339, p < 0.001"
## [1] "sex B = 7.186 [6.561, 7.811], t = 22.537, p < 0.001"
## [1] "(Intercept) B = 9.436 [8.66, 10.211], t = 23.851, p < 0.001"
## [1] "age B = 0.603 [0.562, 0.643], t = 29.34, p < 0.001"
## [1] "sex B = -4.853 [-5.039, -4.667], t = -51.097, p < 0.001"
## [1] "(Intercept) B = 8.264 [7.261, 9.267], t = 16.155, p < 0.001"
## [1] "age B = 0.246 [0.194, 0.298], t = 9.261, p < 0.001"
## [1] "sex B = -0.192 [-0.433, 0.049], t = -1.562, p = 0.118"
## [1] "(Intercept) B = 10.399 [9.594, 11.205], t = 25.299, p < 0.001"
## [1] "age B = 0.417 [0.375, 0.459], t = 19.531, p < 0.001"
## [1] "sex B = -3.27 [-3.464, -3.077], t = -33.139, p < 0.001"
## [1] "(Intercept) B = 5.582 [4.934, 6.23], t = 16.886, p < 0.001"
## [1] "age B = 0.488 [0.454, 0.522], t = 28.42, p < 0.001"
## [1] "sex B = -2.536 [-2.692, -2.381], t = -31.956, p < 0.001"NLSB <- subset(NLS79, racecohort == "2")
NLSW <- subset(NLS79, racecohort == "3")
NLSBW <- subset(NLS79, racecohort == "2" | racecohort == "3")
NLSFAVars <- c("SCI", "ARI", "WKN", "PAR", "NUM", "COS", "ASH", "MKN", "MEC", "ELE")
NLSFAData <- NLSW[NLSFAVars]Many different measurement/higher-order models have been proposed for the ASVAB. Below, I've compared the fits given by Deary et al. [cite], Ree et al./(slightly modified) Kass et al. [cite], and Ree & Caretta [cite]. I also add a mixed higher-order model.
#Measurement model
NLSMMD.model <- '
PS =~ NUM + COS
AR =~ ARI + MKN
VC =~ WKN + PAR + SCI
TK =~ SCI + ASH + MEC + ELE
MEC ~~ MKN + ASH'
NLSMMDP.model <- '
PS =~ NUM + COS
AR =~ ARI + MKN
VC =~ WKN + PAR + SCI
TK =~ SCI + ASH + MEC + ELE'
NLSMMRK.model <- '
PS =~ NUM + COS
AR =~ ARI + MKN + MEC
VC =~ WKN + PAR + SCI
TK =~ ASH + MEC + ELE'
NLSMMRC.model <- '
PS =~ NUM + COS
VM =~ ARI + MKN + WKN + PAR
TK =~ SCI + ASH + MEC + ELE'
NLSMMD.fit <- cfa(NLSMMD.model, data = NLSFAData, std.lv = T, orthogonal = F)
NLSMMDP.fit <- cfa(NLSMMDP.model, data = NLSFAData, std.lv = T, orthogonal = F)
NLSMMRK.fit <- cfa(NLSMMRK.model, data = NLSFAData, std.lv = T, orthogonal = F)
NLSMMRC.fit <- cfa(NLSMMRC.model, data = NLSFAData, std.lv = T, orthogonal = F)
round(cbind(Deary = fitMeasures(NLSMMD.fit, FITM),
PDeary = fitMeasures(NLSMMDP.fit, FITM),
RCK = fitMeasures(NLSMMRK.fit, FITM),
RC = fitMeasures(NLSMMRC.fit, FITM)),3)## Deary PDeary RCK RC
## chisq 1088.990 1274.923 1440.655 4054.110
## df 26.000 28.000 28.000 32.000
## npar 29.000 27.000 27.000 23.000
## cfi 0.980 0.976 0.973 0.923
## rmsea 0.076 0.080 0.085 0.134
## rmsea.ci.lower 0.072 0.076 0.081 0.130
## rmsea.ci.upper 0.080 0.083 0.088 0.137
## aic 396270.271 396452.203 396617.936 399223.391
## bic 396469.205 396637.418 396803.150 399381.166I'll go with the model used by Deary.
#Higher-order model
NLSHOF.model <- '
PS =~ NUM + COS
AR =~ ARI + MKN
VC =~ WKN + PAR + SCI
TK =~ SCI + ASH + MEC + ELE
MEC ~~ MKN + ASH
g =~ PS + AR + VC + TK'
#Bifactor model
NLSBF.model <- '
TK =~ ELE + ASH + MEC + SCI
VR =~ SCI + WKN + PAR
MA =~ ARI + MKN + NUM
NUM ~~ COS
g =~ NUM + COS + ARI + MKN + WKN + PAR + SCI + ASH + MEC + ELE
WKN ~~ 1*WKN
MKN ~~ 1*MKN'
NLSHOF.fit <- cfa(NLSHOF.model, data = NLSFAData, std.lv = T, orthogonal = T)
NLSBF.fit <- cfa(NLSBF.model, data = NLSFAData, std.lv = T, orthogonal = T, control=list(rel.tol=1e-4), check.gradient = F)
round(cbind(MM = fitMeasures(NLSMMD.fit, FITM),
HOF = fitMeasures(NLSHOF.fit, FITM),
BF = fitMeasures(NLSBF.fit, FITM)),3)## MM HOF BF
## chisq 1088.990 1661.735 1247.520
## df 26.000 28.000 26.000
## npar 29.000 27.000 29.000
## cfi 0.980 0.969 0.977
## rmsea 0.076 0.091 0.082
## rmsea.ci.lower 0.072 0.087 0.078
## rmsea.ci.upper 0.080 0.095 0.086
## aic 396270.271 396839.016 396428.801
## bic 396469.205 397024.231 396627.734The higher-order model can be made just as parsimonious as the measurement model and just as well-fitting, but that's pointless. The bifactor model fits worse, but is still a simpler model; the cross-loading may explain this.
#NLS group and plots
NLSMHLATS <- list(
PS = c("NUM", "COS"),
AR = c("ARI", "MKN"),
VC = c("WKN", "PAR", "SCI"),
TK = c("SCI", "ASH", "MEC", "ELE"))
NLSBFLATS <- list(
TK = c("ELE", "ASH", "MEC", "SCI"),
VR = c("SCI", "WKN", "PAR"),
MA = c("ARI", "MKN", "NUM"))
semPaths(NLSMMD.fit, "model", "std", title = F, residuals = F, groups = "NLSMHLATS", pastel = T, mar = c(2.8, 1, 3, 1), layout = "tree2", exoCov = T)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(NLSHOF.fit, "model", "std", title = F, residuals = F, groups = "NLSMHLATS", pastel = T, mar = c(2.8, 1, 3, 1), layout = "tree2", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(NLSBF.fit, "model", "std", title = F, residuals = F, groups = "NLSBFLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
Measurement Invariance
#Measurement model
NLSMMC.fit <- cfa(NLSMMD.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = F)
NLSMMM.fit <- cfa(NLSMMD.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = F, group.equal = "loadings")
NLSMMS.fit <- cfa(NLSMMD.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = F, group.equal = c("loadings", "intercepts"))
NLSMMF.fit <- cfa(NLSMMD.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
NLSMMV.fit <- cfa(NLSMMD.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
NLSMMME.fit <- cfa(NLSMMD.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(NLSMMC.fit, FITM),
METRIC = fitMeasures(NLSMMM.fit, FITM),
SCALAR = fitMeasures(NLSMMS.fit, FITM),
STRICT = fitMeasures(NLSMMF.fit, FITM),
LVARS = fitMeasures(NLSMMV.fit, FITM),
MEANS = fitMeasures(NLSMMME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 1324.048 1434.768 2049.766 2234.081 2237.164
## df 52.000 59.000 65.000 75.000 77.000
## npar 78.000 71.000 65.000 55.000 53.000
## cfi 0.982 0.981 0.972 0.970 0.970
## rmsea 0.070 0.068 0.078 0.076 0.075
## rmsea.ci.lower 0.066 0.065 0.075 0.073 0.072
## rmsea.ci.upper 0.073 0.071 0.081 0.078 0.077
## aic 566192.813 566289.534 566892.532 567056.847 567055.930
## bic 566755.772 566801.971 567361.664 567453.805 567438.453
## MEANS
## chisq 5526.218
## df 81.000
## npar 49.000
## cfi 0.924
## rmsea 0.116
## rmsea.ci.lower 0.113
## rmsea.ci.upper 0.118
## aic 570336.984
## bic 570690.637#Higher-order model
NLSHOFC.fit <- cfa(NLSHOF.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = T)
NLSHOFM.fit <- cfa(NLSHOF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = "loadings")
NLSHOFS.fit <- cfa(NLSHOF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 7.457430e-15) is close to zero. This may be a symptom that the
## model is not identified.NLSHOFF.fit <- cfa(NLSHOF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
NLSHOFV.fit <- cfa(NLSHOF.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
NLSHOFME.fit <- cfa(NLSHOF.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(NLSHOFC.fit, FITM),
METRIC = fitMeasures(NLSHOFM.fit, FITM),
SCALAR = fitMeasures(NLSHOFS.fit, FITM),
STRICT = fitMeasures(NLSHOFF.fit, FITM),
LVARS = fitMeasures(NLSHOFV.fit, FITM),
MEANS = fitMeasures(NLSHOFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 2004.667 2701.085 3280.609 3484.867 3488.178
## df 56.000 66.000 71.000 81.000 83.000
## npar 74.000 64.000 59.000 49.000 47.000
## cfi 0.973 0.963 0.955 0.953 0.953
## rmsea 0.083 0.089 0.095 0.091 0.090
## rmsea.ci.lower 0.080 0.086 0.092 0.089 0.088
## rmsea.ci.upper 0.086 0.092 0.098 0.094 0.093
## aic 566865.433 567541.851 568111.375 568295.633 568294.944
## bic 567399.522 568003.765 568537.202 568649.286 568634.163
## MEANS
## chisq 6748.713
## df 88.000
## npar 42.000
## cfi 0.907
## rmsea 0.123
## rmsea.ci.lower 0.120
## rmsea.ci.upper 0.125
## aic 571545.479
## bic 571848.610#Bifactor model
NLSBFC.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = T)
NLSBFM.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = "loadings")
NLSBFS.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts"))
NLSBFF.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
NLSBFV.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
NLSBFME.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(NLSBFC.fit, FITM),
METRIC = fitMeasures(NLSBFM.fit, FITM),
SCALAR = fitMeasures(NLSBFS.fit, FITM),
STRICT = fitMeasures(NLSBFF.fit, FITM),
LVARS = fitMeasures(NLSBFV.fit, FITM),
MEANS = fitMeasures(NLSBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 1490.260 2332.343 2564.996 2741.664 2748.579
## df 52.000 68.000 74.000 82.000 83.000
## npar 78.000 62.000 56.000 48.000 47.000
## cfi 0.980 0.968 0.965 0.963 0.963
## rmsea 0.074 0.081 0.082 0.080 0.080
## rmsea.ci.lower 0.071 0.079 0.079 0.078 0.077
## rmsea.ci.upper 0.077 0.084 0.084 0.083 0.082
## aic 566359.026 567169.109 567389.762 567550.430 567555.344
## bic 566921.984 567616.589 567793.937 567896.866 567894.563
## MEANS
## chisq 6334.454
## df 87.000
## npar 43.000
## cfi 0.913
## rmsea 0.119
## rmsea.ci.lower 0.117
## rmsea.ci.upper 0.122
## aic 571133.220
## bic 571443.569#Partial bifactor model
NLSBFMP.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = "loadings", group.partial = "g=~ARI")
NLSBFS.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts"), group.partial = "g=~ARI")
NLSBFF.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = F, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"), group.partial = "g=~ARI")
NLSBFV.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"), group.partial = "g=~ARI")
NLSBFME.fit <- cfa(NLSBF.model, data = NLSBW, std.lv = T, group = "racecohort", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"), group.partial = "g=~ARI")
round(cbind(CONFIGURAL = fitMeasures(NLSBFC.fit, FITM),
METRIC = fitMeasures(NLSBFMP.fit, FITM),
SCALAR = fitMeasures(NLSBFS.fit, FITM),
STRICT = fitMeasures(NLSBFF.fit, FITM),
LVARS = fitMeasures(NLSBFV.fit, FITM),
MEANS = fitMeasures(NLSBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 1490.260 2154.540 2317.419 2474.853 2482.666
## df 52.000 67.000 73.000 81.000 82.000
## npar 78.000 63.000 57.000 49.000 48.000
## cfi 0.980 0.971 0.969 0.967 0.967
## rmsea 0.074 0.079 0.078 0.077 0.076
## rmsea.ci.lower 0.071 0.076 0.075 0.074 0.074
## rmsea.ci.upper 0.077 0.082 0.081 0.079 0.079
## aic 566359.026 566993.306 567144.185 567285.619 567291.432
## bic 566921.984 567448.003 567555.578 567639.272 567637.868
## MEANS
## chisq 6256.729
## df 86.000
## npar 44.000
## cfi 0.914
## rmsea 0.119
## rmsea.ci.lower 0.117
## rmsea.ci.upper 0.122
## aic 571057.495
## bic 571375.061#Effect of loading bias
Vp = 10; Vl1 = c(0, 0, 0.748, 0, 0, 0, 0, 0, 0, 0); Vl2 = c(0, 0, 0.834, 0, 0, 0, 0, 0, 0, 0); Vi1 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0); Vi2 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0); Vsd = c(10.25, 14.65, 6.92, 4.62, 6.92, 3.13, 4.49, 4.19, 6.22, 3.6); Vfm = 1.220; Vfsd = 1
BFES <- SDI2.UDI2(Vp, Vl1, Vl2, Vi1, Vi2, Vsd, Vfm, Vfsd)
BFES$SDI2## SDI2
## [1,] 0.0000
## [2,] 0.0000
## [3,] -0.0152
## [4,] 0.0000
## [5,] 0.0000
## [6,] 0.0000
## [7,] 0.0000
## [8,] 0.0000
## [9,] 0.0000
## [10,] 0.0000The arithmetic g loading was negligibly biased in favor of the white group. This should have more effect at greater values since the effect is nonuniform, unlike intercept bias.
At this sample size, it's basically impossible not to have AIC/BIC increasing between models without some extreme overspecification, so I avoided plotting this and the NLSY 97 and Project TALENT in the aggregate result even though, in typical centrality terms, it fits, and whenever measured, bias is minor; but that's always the expectation with large samples, whatever the case. With the variance constraints on MKN and WKN (to fix their initial negative values; this is generally not something which should be done as they likely resulted from multigroup sampling variance), their loading values are basically switched compared to a version of the final model where they're unrestricted.
Spearman's Hypothesis
PS and AR were the least differentiated in the higher-order model (\(p = 0.019, 0.030\)) and VR was the least differentiated in the bifactor model, but the mean difference was still highly significant.
round(cbind(LVAR = fitMeasures(NLSHOFV.fit, FITM),
STRONG = fitMeasures(NLSHOFVS.fit, FITM),
WEAK = fitMeasures(NLSHOFVW.fit, FITM),
CONTRA = fitMeasures(NLSHOFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 3488.178 3899.988 3495.425 5714.560
## df 83.000 87.000 85.000 86.000
## npar 47.000 43.000 45.000 44.000
## cfi 0.953 0.947 0.953 0.922
## rmsea 0.090 0.093 0.089 0.114
## rmsea.ci.lower 0.088 0.091 0.087 0.112
## rmsea.ci.upper 0.093 0.096 0.092 0.117
## aic 568294.944 568698.753 568298.191 570515.326
## bic 568634.163 569009.102 568622.975 570832.892round(cbind(LVAR = fitMeasures(NLSBFV.fit, FITM),
STRONG = fitMeasures(NLSBFVS.fit, FITM),
WEAK = fitMeasures(NLSBFVW.fit, FITM),
CONTRA = fitMeasures(NLSBFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 2482.666 3321.817 2511.488 5232.797
## df 82.000 85.000 83.000 84.000
## npar 48.000 45.000 47.000 46.000
## cfi 0.967 0.955 0.966 0.928
## rmsea 0.076 0.087 0.076 0.110
## rmsea.ci.lower 0.074 0.084 0.074 0.108
## rmsea.ci.upper 0.079 0.090 0.079 0.113
## aic 567291.432 568124.582 567318.254 570037.562
## bic 567637.868 568449.366 567657.472 570369.563Of the forms of Spearman's hypothesis, it seems the weak form fits best.
Traditional Analyses
The weighted average g loading for the arithmetic subtest was used. The proportion of the group differences attributable to g was 69.7% in the latent variances model and 74.9% in the selected weak model. The MCV relationships for g are \(r = 0.128, \rho = 0.248,\) and \(\phi = 0.985\); for the non-g loadings they are \(r = 0.426, \rho = 0.337,\) and \(\phi = 0.775\). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.989; for the non-g loadings it becomes 0.769. Using the latent variances non-g loadings, these became \(r = 0.628, 0.612, 0.892,\) and \(0.886\).
MCVDFNLS %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#9D9D95", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in the National Longitudinal Study of Youth \'79") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
MCVDFNLS %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#9D9D95", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in the National Longitudinal Study of Youth \'79") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
ggplot(MCVDFNLS, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#9D9D95", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in the National Longitudinal Study of Youth \'79") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDFNLS, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#9D9D95", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in the National Longitudinal Study of Youth \'79") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Lasker et al. - c (WJ-I)
General intelligence in the Woodcock-Johnson I was largely neglected, so thie reanalysis will be interesting. I use all of the normative data for this, the WJ-R/II, and the WJ-III analyses.
Initial Fit
WJI %<>% rename(
LW = a01letword,
WA = a02wordattack,
PC = a03passcomp,
CA = a04calc,
AP = a05approb,
DI = a06dict,
PR = a07proof,
SC = a08sci,
SO = a09soc,
HU = a10hum,
SP = a12spell,
PU = a13punct,
KN = achknowledge,
MA = achmath,
RE = achreading,
WR = achwriting,
PV = c01picvocab,
SR = c02spatrels,
MS = c03memsen,
VA = c04visaudit,
BL = c05blend,
VM = c07vismatch,
AS = c08antsyn,
AN = c09analsyn,
NR = c10numrev,
CF = c11concform,
AL = c12analogies)
#umx_residualize(c("LW", "WA", "PC" ,"CA", "AP", "DI", "PR", "SC", "SO", "HU", "SP", "PU", "KN", "MA", "RE", "WR", "PV" ,"SR", "MS", "VA", "BL", "VM", "AS", "AN", "NR", "CF", "AL"), c("testage", "sex"), data = WJI)
WJIW <- subset(WJI, race=="1")
WJIB <- subset(WJI, race=="2")
WJIFAVars <- c("LW", "WA", "PC" ,"CA", "AP", "DI", "PR", "SC", "SO", "HU", "SP", "PU", "KN", "MA", "RE", "WR", "PV" ,"SR", "MS", "VA", "BL", "VM", "AS", "AN", "NR", "CF", "AL")
WJIFAData <- WJIW[WJIFAVars]fa.parallel(WJIFAData)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
## Parallel analysis suggests that the number of factors = 8 and the number of components = 4resFA <- n_factors(WJIFAData, type = "FA", package = "all")
plot(resFA, type = "line") + theme_bw()
FA4 <- fa(WJIFAData, nfactors = 4)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefullyFA8 <- fa(WJIFAData, nfactors = 8)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## An ultra-Heywood case was detected. Examine the results carefullyprint(FA4, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = WJIFAData, nfactors = 4)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR2 MR3 MR4 h2 u2 com
## LW 0.76 0.77 0.2269 1.2
## WA 0.72 0.62 0.3802 1.2
## PC 0.50 0.60 0.4031 1.6
## CA 0.78 0.72 0.2792 1.1
## AP 0.74 0.68 0.3194 1.1
## DI 0.90 0.84 0.1601 1.0
## PR 0.83 0.73 0.2651 1.0
## SC 0.83 0.65 0.3464 1.0
## SO 0.80 0.73 0.2716 1.0
## HU 0.74 0.68 0.3233 1.1
## SP 0.95 0.87 0.1253 1.0
## PU 0.73 0.64 0.3622 1.1
## KN 1.04 1.03 -0.0250 1.0
## MA 0.99 1.01 -0.0051 1.0
## RE 0.79 0.90 0.1039 1.2
## WR 0.99 0.98 0.0153 1.0
## PV 0.75 0.59 0.4143 1.0
## SR 0.33 0.23 0.7717 1.9
## MS 0.34 0.38 0.6216 2.3
## VA 0.31 0.6912 2.7
## BL 0.32 0.30 0.6992 2.2
## VM 0.40 0.34 0.6637 2.5
## AS 0.50 0.65 0.3524 1.7
## AN 0.46 0.34 0.6564 1.4
## NR 0.37 0.34 0.32 0.6755 2.3
## CF 0.44 0.35 0.6543 2.0
## AL 0.34 0.31 0.56 0.4399 2.8
##
## MR1 MR2 MR3 MR4
## SS loadings 6.92 4.78 3.81 1.29
## Proportion Var 0.26 0.18 0.14 0.05
## Cumulative Var 0.26 0.43 0.57 0.62
## Proportion Explained 0.41 0.28 0.23 0.08
## Cumulative Proportion 0.41 0.70 0.92 1.00
##
## With factor correlations of
## MR1 MR2 MR3 MR4
## MR1 1.00 0.59 0.64 0.34
## MR2 0.59 1.00 0.56 0.36
## MR3 0.64 0.56 1.00 0.17
## MR4 0.34 0.36 0.17 1.00
##
## Mean item complexity = 1.5
## Test of the hypothesis that 4 factors are sufficient.
##
## The degrees of freedom for the null model are 351 and the objective function was 38.66 with Chi Square of 145152.4
## The degrees of freedom for the model are 249 and the objective function was 14.42
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.03
##
## The harmonic number of observations is 3686 with the empirical chi square 2244.43 with prob < 1.7e-317
## The total number of observations was 3765 with Likelihood Chi Square = 54110.65 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.475
## RMSEA index = 0.24 and the 90 % confidence intervals are 0.238 0.241
## BIC = 52060.5
## Fit based upon off diagonal values = 1print(FA8, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = WJIFAData, nfactors = 8)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR2 MR7 MR3 MR1 MR6 MR8 MR5 MR4 h2 u2 com
## LW 0.76 0.84 0.159 1.1
## WA 0.72 0.67 0.330 1.1
## PC 0.59 0.65 0.349 1.3
## CA 0.78 0.75 0.252 1.1
## AP 0.68 0.70 0.305 1.1
## DI 0.90 0.98 0.023 1.0
## PR 0.90 0.95 0.051 1.0
## SC 0.79 0.66 0.337 1.0
## SO 0.74 0.73 0.273 1.1
## HU 0.69 0.68 0.318 1.1
## SP 0.82 0.96 0.040 1.0
## PU 0.77 0.78 0.218 1.0
## KN 1.00 1.03 -0.032 1.0
## MA 1.02 1.05 -0.050 1.0
## RE 1.01 1.05 -0.046 1.0
## WR 0.59 0.39 1.00 0.001 1.8
## PV 0.69 0.59 0.413 1.1
## SR 0.53 0.36 0.638 1.3
## MS 0.57 0.51 0.495 1.1
## VA 0.32 0.679 3.5
## BL 0.34 0.32 0.682 2.2
## VM 0.63 0.54 0.459 1.1
## AS 0.37 0.67 0.335 2.6
## AN 0.43 0.39 0.607 1.5
## NR 0.38 0.38 0.625 2.6
## CF 0.63 0.47 0.525 1.0
## AL 0.37 0.59 0.407 2.3
##
## MR2 MR7 MR3 MR1 MR6 MR8 MR5 MR4
## SS loadings 4.05 3.30 2.69 2.65 2.22 1.46 1.12 1.11
## Proportion Var 0.15 0.12 0.10 0.10 0.08 0.05 0.04 0.04
## Cumulative Var 0.15 0.27 0.37 0.47 0.55 0.61 0.65 0.69
## Proportion Explained 0.22 0.18 0.14 0.14 0.12 0.08 0.06 0.06
## Cumulative Proportion 0.22 0.40 0.54 0.68 0.80 0.88 0.94 1.00
##
## With factor correlations of
## MR2 MR7 MR3 MR1 MR6 MR8 MR5 MR4
## MR2 1.00 0.56 0.52 0.45 0.44 0.57 0.32 0.50
## MR7 0.56 1.00 0.55 0.73 0.68 0.46 0.43 0.49
## MR3 0.52 0.55 1.00 0.53 0.54 0.59 0.53 0.35
## MR1 0.45 0.73 0.53 1.00 0.71 0.35 0.47 0.37
## MR6 0.44 0.68 0.54 0.71 1.00 0.41 0.44 0.35
## MR8 0.57 0.46 0.59 0.35 0.41 1.00 0.42 0.47
## MR5 0.32 0.43 0.53 0.47 0.44 0.42 1.00 0.36
## MR4 0.50 0.49 0.35 0.37 0.35 0.47 0.36 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 8 factors are sufficient.
##
## The degrees of freedom for the null model are 351 and the objective function was 38.66 with Chi Square of 145152.4
## The degrees of freedom for the model are 163 and the objective function was 8.97
##
## The root mean square of the residuals (RMSR) is 0.01
## The df corrected root mean square of the residuals is 0.02
##
## The harmonic number of observations is 3686 with the empirical chi square 357.72 with prob < 1.3e-16
## The total number of observations was 3765 with Likelihood Chi Square = 33615.7 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.502
## RMSEA index = 0.233 and the 90 % confidence intervals are 0.231 0.236
## BIC = 32273.64
## Fit based upon off diagonal values = 1#Measurement model
WJIMM.model <- '
Grw =~ LW + WA + PC + SP
Gs =~ VM + SR
Gf =~ AN + CF + AL
Gc =~ AL + PV + AS + KN
Gsm =~ MS + VA + NR'
#Higher-order model
WJIHOF.model <- '
Grw =~ LW + WA + PC + SP
Gs =~ VM + SR
Gf =~ AN + CF + AL
Gc =~ AL + PV + AS + KN
Gsm =~ MS + VA + NR
g =~ Grw + Gs + Gf + Gc + Gsm'
#Bifactor model
WJIBF.model <- '
Grw =~ LW + WA + PC + SP
VM ~~ SR
Gf =~ AN + CF + AL
Gc =~ AL + PV + AS + KN
Gsm =~ MS + VA + NR
g =~ LW + WA + PC + SP + VM + SR + AN + CF + AL + PV + AS + KN + MS + VA + NR'
WJIMM.fit <- cfa(WJIMM.model, data = WJIFAData, std.lv = T, orthogonal = F)
WJIHOF.fit <- cfa(WJIHOF.model, data = WJIFAData, std.lv = T, orthogonal = T)
WJIBF.fit <- cfa(WJIBF.model, data = WJIFAData, std.lv = T, orthogonal = T)
round(cbind(MM = fitMeasures(WJIMM.fit, FITM),
HOF = fitMeasures(WJIHOF.fit, FITM),
BF = fitMeasures(WJIBF.fit, FITM)),3)## MM HOF BF
## chisq 1446.386 1576.818 968.286
## df 79.000 84.000 75.000
## npar 41.000 36.000 45.000
## cfi 0.949 0.945 0.967
## rmsea 0.069 0.070 0.058
## rmsea.ci.lower 0.066 0.067 0.054
## rmsea.ci.upper 0.073 0.073 0.061
## aic 412284.255 412404.687 411814.155
## bic 412537.912 412627.410 412092.559#WJI group and plots
WJILATS <- list(
Grw = c("LW", "WA", "PC", "SP"),
Gs = c("VM", "SR"),
Gf = c("AN", "CF", "AL"),
Gc = c("AL", "PV", "AS", "KN"),
Gsm = c("MS", "VA", "NR"))
semPaths(WJIMM.fit, "model", "std", title = F, residuals = F, groups = "WJILATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(WJIHOF.fit, "model", "std", title = F, residuals = F, groups = "WJILATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(WJIBF.fit, "model", "std", title = F, residuals = F, groups = "WJILATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
Measurement Invariance
#Measurement model
WJIMMC.fit <- cfa(WJIMM.model, data = WJI, std.lv = T, group = "race", orthogonal = F)
WJIMMM.fit <- cfa(WJIMM.model, data = WJI, std.lv = F, group = "race", orthogonal = F, group.equal = "loadings")
WJIMMS.fit <- cfa(WJIMM.model, data = WJI, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts"))
WJIMMF.fit <- cfa(WJIMM.model, data = WJI, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
WJIMMV.fit <- cfa(WJIMM.model, data = WJI, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
WJIMMME.fit <- cfa(WJIMM.model, data = WJI, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIMMC.fit, FITM),
METRIC = fitMeasures(WJIMMM.fit, FITM),
SCALAR = fitMeasures(WJIMMS.fit, FITM),
STRICT = fitMeasures(WJIMMF.fit, FITM),
LVARS = fitMeasures(WJIMMV.fit, FITM),
MEANS = fitMeasures(WJIMMME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 1742.496 1755.485 1831.368 1937.612 1937.603
## df 158.000 169.000 179.000 194.000 194.000
## npar 112.000 101.000 91.000 76.000 76.000
## cfi 0.949 0.949 0.947 0.944 0.944
## rmsea 0.070 0.068 0.068 0.067 0.067
## rmsea.ci.lower 0.067 0.065 0.065 0.064 0.064
## rmsea.ci.upper 0.073 0.071 0.070 0.069 0.069
## aic 466139.274 466130.263 466186.146 466262.390 466262.381
## bic 466845.599 466767.217 466760.035 466741.682 466741.673
## MEANS
## chisq 2262.128
## df 199.000
## npar 71.000
## cfi 0.934
## rmsea 0.072
## rmsea.ci.lower 0.069
## rmsea.ci.upper 0.074
## aic 466576.907
## bic 467024.666#Higher-order model
WJIHOFC.fit <- cfa(WJIHOF.model, data = WJI, std.lv = T, group = "race", orthogonal = F)
WJIHOFM.fit <- cfa(WJIHOF.model, data = WJI, std.lv = F, group = "race", orthogonal = F, group.equal = "loadings")
WJIHOFS.fit <- cfa(WJIHOF.model, data = WJI, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 4.735755e-13) is close to zero. This may be a symptom that the
## model is not identified.WJIHOFF.fit <- cfa(WJIHOF.model, data = WJI, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
WJIHOFV.fit <- cfa(WJIHOF.model, data = WJI, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
WJIHOFME.fit <- cfa(WJIHOF.model, data = WJI, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIHOFC.fit, FITM),
METRIC = fitMeasures(WJIHOFM.fit, FITM),
SCALAR = fitMeasures(WJIHOFS.fit, FITM),
STRICT = fitMeasures(WJIHOFF.fit, FITM),
LVARS = fitMeasures(WJIHOFV.fit, FITM),
MEANS = fitMeasures(WJIHOFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 1895.525 1921.863 1992.794 2100.341 2100.340
## df 168.000 183.000 192.000 207.000 207.000
## npar 102.000 87.000 78.000 63.000 63.000
## cfi 0.944 0.944 0.942 0.939 0.939
## rmsea 0.071 0.069 0.068 0.067 0.067
## rmsea.ci.lower 0.068 0.066 0.065 0.065 0.065
## rmsea.ci.upper 0.074 0.071 0.071 0.070 0.070
## aic 466272.303 466268.642 466321.572 466399.119 466399.118
## bic 466915.563 466817.305 466813.477 466796.427 466796.426
## MEANS
## chisq 2446.725
## df 213.000
## npar 57.000
## cfi 0.928
## rmsea 0.072
## rmsea.ci.lower 0.069
## rmsea.ci.upper 0.075
## aic 466733.503
## bic 467092.972#Bifactor model
WJIBFC.fit <- cfa(WJIBF.model, data = WJI, std.lv = T, group = "race", orthogonal = T)
WJIBFM.fit <- cfa(WJIBF.model, data = WJI, std.lv = F, group = "race", orthogonal = T, group.equal = "loadings")
WJIBFS.fit <- cfa(WJIBF.model, data = WJI, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts"))
WJIBFF.fit <- cfa(WJIBF.model, data = WJI, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
WJIBFV.fit <- cfa(WJIBF.model, data = WJI, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
WJIBFME.fit <- cfa(WJIBF.model, data = WJI, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIBFC.fit, FITM),
METRIC = fitMeasures(WJIBFM.fit, FITM),
SCALAR = fitMeasures(WJIBFS.fit, FITM),
STRICT = fitMeasures(WJIBFF.fit, FITM),
LVARS = fitMeasures(WJIBFV.fit, FITM),
MEANS = fitMeasures(WJIBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 1204.474 1236.217 1295.942 1400.409 1400.405
## df 150.000 174.000 184.000 199.000 199.000
## npar 120.000 96.000 86.000 71.000 71.000
## cfi 0.966 0.966 0.964 0.961 0.961
## rmsea 0.059 0.055 0.055 0.055 0.055
## rmsea.ci.lower 0.056 0.052 0.052 0.052 0.052
## rmsea.ci.upper 0.062 0.058 0.057 0.057 0.057
## aic 465617.252 465600.995 465640.720 465715.187 465715.183
## bic 466374.029 466206.416 466183.077 466162.947 466162.943
## MEANS
## chisq 1769.382
## df 204.000
## npar 66.000
## cfi 0.950
## rmsea 0.062
## rmsea.ci.lower 0.059
## rmsea.ci.upper 0.064
## aic 466074.160
## bic 466490.387Invariance is clearly achieved for the WJ-I.
Spearman's Hypothesis
I assess Spearman's hypothesis for the higher-order and bifactor models in the typical way, with factors ordered as they appear in the model specification. Because there were so many models, I assessed which one to fit based on the factor means. As such, if a factor mean was very nearly equal, I constrained it. Gf and Gsm were not significantly different in the bifactor model and Gf, Gs, and Gsm were not significantly different in the higher-order model. If anybody really wants a specific alternative model tested, just tell me and I'll have the whole thing uploaded here.
round(cbind(LVAR = fitMeasures(WJIHOFV.fit, FITM),
STRONG = fitMeasures(WJIHOFVS.fit, FITM),
WEAK = fitMeasures(WJIHOFVW.fit, FITM),
CONTRA = fitMeasures(WJIHOFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 2100.340 2135.248 2101.892 2339.049
## df 207.000 212.000 210.000 211.000
## npar 63.000 58.000 60.000 59.000
## cfi 0.939 0.938 0.939 0.931
## rmsea 0.067 0.067 0.067 0.071
## rmsea.ci.lower 0.065 0.064 0.064 0.068
## rmsea.ci.upper 0.070 0.070 0.069 0.073
## aic 466399.118 466424.026 466394.670 466629.827
## bic 466796.426 466789.802 466773.059 467001.909round(cbind(LVAR = fitMeasures(WJIBFV.fit, FITM),
STRONG = fitMeasures(WJIBFVS.fit, FITM),
WEAK = fitMeasures(WJIBFVW.fit, FITM),
CONTRA = fitMeasures(WJIBFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 1400.405 1473.038 1406.124 1648.147
## df 199.000 203.000 201.000 202.000
## npar 71.000 67.000 69.000 68.000
## cfi 0.961 0.959 0.961 0.953
## rmsea 0.055 0.056 0.054 0.059
## rmsea.ci.lower 0.052 0.053 0.052 0.057
## rmsea.ci.upper 0.057 0.058 0.057 0.062
## aic 465715.183 465779.816 465716.902 465956.925
## bic 466162.943 466202.350 466152.049 466385.765Two conclusions can be reached about the WJ-I: 1) Measurement invariance is supported 2) The weak form of Spearman's hypothesis is supported
Traditional Analyses
The proportion of the group differences attributable to g was 65.9% in the latent variances model and 75.2% in the selected weak model. The MCV relationships for g are \(r = 0.763, \rho = 0.693,\) and \(\phi = 0.989\); for the non-g loadings they are \(r = 0.822, \rho = 0.869,\) and \(\phi = 0.870\). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.992; for the non-g loadings it becomes 0.777.
MCVDFWJI %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#CEDD57", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in the Woodcock-Johnson-I") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
MCVDFWJI %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#CEDD57", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in the Woodcock-Johnson-I") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
ggplot(MCVDFWJI, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#CEDD57", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in the Woodcock-Johnson-I") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDFWJI, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#CEDD57", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in the Woodcock-Johnson-I") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Lasker et al. - d (WJ-R)
Initial
WJII %<>% rename(
LW = a01letword,
WA = a02wordattack,
PC = a03passcomp,
CA = a04calc,
AP = a05approb,
DI = a06dict,
PR = a07proof,
SC = a08sci,
SO = a09soc,
HU = a10hum,
RV = a11readvocab,
SP = a12spell,
AW = a13write,
WF = a14writeflu,
PU = a20punct,
US = a21usage,
KN = achknowledge,
MA = achmath,
RE = achreading,
WR = achwriting,
PV = c01picvocab,
SR = c02spatrels,
MS = c03memsen,
VA = c04visaudit,
BL = c05blend,
VM = c07vismatch,
AS = c08antsyn,
AN = c09analsyn,
NR = c10numrev,
CF = c11concform,
AL = c12analogies,
PI = c13picrecog,
MW = c14memwords,
MN = c20memnames,
IW = c21incompwds,
VC = c22visclosure,
CR = c23crossout,
D1 = c25delayrec1,
D2 = c26delayrec2,
SU = c27sndpatts,
LC = c28listencomp)
#umx_residualize(c("LW", "WA", "PC" ,"CA", "AP", "DI", "PR", "SC", "SO", "HU", "RV", "SP", "AW", "WF", "PU", "US", "KN", "MA", "RE", "WR", "PV" ,"SR", "MS", "VA", "BL", "VM", "AS", "AN", "NR", "CF", "AL", "PI", "MW", "MN", "IW", "VC", "CR", "D1", "D2", "SU", "LC"), c("testage", "sex"), data = WJII)
WJIIW <- subset(WJII, race=="1")
WJIIB <- subset(WJII, race=="2")
WJIIFAVars <- c("LW", "WA", "PC" ,"CA", "AP", "DI", "PR", "SC", "SO", "HU", "RV", "SP", "AW", "WF", "PU", "US", "KN", "MA", "RE", "WR", "PV" ,"SR", "MS", "VA", "BL", "VM", "AS", "AN", "NR", "CF", "AL", "PI", "MW", "MN", "IW", "VC", "CR", "D1", "D2", "SU", "LC")
WJIIFAData <- WJIIW[WJIIFAVars]fa.parallel(WJIIFAData)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
## Parallel analysis suggests that the number of factors = 11 and the number of components = 6resFA <- n_factors(WJIIFAData, type = "FA", package = "all")
plot(resFA, type = "line") + theme_bw()
FA6 <- fa(WJIIFAData, nfactors = 6)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefullyFA11 <- fa(WJIIFAData, nfactors = 11)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## An ultra-Heywood case was detected. Examine the results carefullyprint(FA6, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = WJIIFAData, nfactors = 6)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR2 MR4 MR3 MR5 MR6 h2 u2 com
## LW 0.61 0.70 0.300 1.5
## WA 0.56 0.34 0.62 0.376 1.8
## PC 0.37 0.62 0.384 2.6
## CA 0.80 0.75 0.252 1.1
## AP 0.70 0.76 0.243 1.2
## DI 0.87 0.81 0.185 1.0
## PR 0.76 0.75 0.253 1.0
## SC 0.74 0.67 0.332 1.1
## SO 0.75 0.69 0.310 1.1
## HU 0.70 0.69 0.312 1.2
## RV 0.36 0.45 0.73 0.274 2.3
## SP 0.89 0.82 0.183 1.0
## AW 0.54 0.59 0.409 1.3
## WF 0.45 0.33 0.52 0.477 2.0
## PU 0.67 0.63 0.373 1.1
## US 0.64 0.61 0.392 1.1
## KN 0.95 0.97 0.028 1.0
## MA 0.97 1.02 -0.017 1.0
## RE 0.57 0.83 0.174 1.8
## WR 0.85 0.91 0.091 1.0
## PV 0.78 0.66 0.337 1.1
## SR 0.33 0.672 4.1
## MS 0.51 0.51 0.489 1.5
## VA 0.59 0.56 0.438 1.3
## BL 0.37 0.35 0.646 2.1
## VM 0.59 0.55 0.452 1.5
## AS 0.63 0.72 0.280 1.3
## AN 0.31 0.42 0.582 3.8
## NR 0.47 0.49 0.508 1.9
## CF 0.43 0.568 4.3
## AL 0.42 0.62 0.382 2.2
## PI 0.27 0.732 2.5
## MW 0.59 0.42 0.579 1.0
## MN 0.79 0.65 0.351 1.0
## IW 0.30 0.26 0.743 2.9
## VC 0.32 0.21 0.787 3.0
## CR 0.69 0.57 0.432 1.0
## D1 0.82 0.63 0.373 1.1
## D2 0.51 0.30 0.705 1.2
## SU 0.22 0.779 3.5
## LC 0.63 0.55 0.447 1.1
##
## MR1 MR2 MR4 MR3 MR5 MR6
## SS loadings 7.15 6.13 3.56 2.99 2.54 2.02
## Proportion Var 0.17 0.15 0.09 0.07 0.06 0.05
## Cumulative Var 0.17 0.32 0.41 0.48 0.55 0.59
## Proportion Explained 0.29 0.25 0.15 0.12 0.10 0.08
## Cumulative Proportion 0.29 0.54 0.69 0.81 0.92 1.00
##
## With factor correlations of
## MR1 MR2 MR4 MR3 MR5 MR6
## MR1 1.00 0.59 0.58 0.42 0.48 0.41
## MR2 0.59 1.00 0.58 0.51 0.46 0.27
## MR4 0.58 0.58 1.00 0.39 0.36 0.41
## MR3 0.42 0.51 0.39 1.00 0.36 0.27
## MR5 0.48 0.46 0.36 0.36 1.00 0.24
## MR6 0.41 0.27 0.41 0.27 0.24 1.00
##
## Mean item complexity = 1.7
## Test of the hypothesis that 6 factors are sufficient.
##
## The degrees of freedom for the null model are 820 and the objective function was 44.82 with Chi Square of 207952.8
## The degrees of freedom for the model are 589 and the objective function was 13.52
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.03
##
## The harmonic number of observations is 3538 with the empirical chi square 4355.81 with prob < 0
## The total number of observations was 4655 with Likelihood Chi Square = 62680.03 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.582
## RMSEA index = 0.15 and the 90 % confidence intervals are 0.15 0.151
## BIC = 57705.52
## Fit based upon off diagonal values = 1print(FA11, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = WJIIFAData, nfactors = 11)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR4 MR9 MR8 MR2 MR7 MR6 MR5 MR3 MR10 MR11 h2
## LW 0.63 0.80
## WA 0.36 0.66
## PC 0.54 0.71
## CA 0.78 0.76
## AP 0.69 0.76
## DI 0.91 1.00
## PR 1.02 1.02
## SC 0.66 0.68
## SO 0.68 0.70
## HU 0.60 0.69
## RV 0.32 0.41 0.75
## SP 0.67 0.87
## AW 0.55 0.77
## WF 0.41 0.54
## PU 0.49 0.67
## US 0.62 0.68
## KN 0.87 1.00
## MA 0.96 1.03
## RE 0.84 1.02
## WR 0.56 0.39 1.02
## PV 0.68 0.66
## SR 0.48 0.42
## MS 0.62 0.59
## VA 0.35 0.37 0.58
## BL 0.64 0.51
## VM 0.80 0.69
## AS 0.50 0.72
## AN 0.38 0.46
## NR 0.55 0.54
## CF 0.38 0.48
## AL 0.64
## PI 0.33 0.29
## MW 0.76 0.56
## MN 0.71 0.67
## IW 0.49 0.34
## VC 0.34 0.27
## CR 0.75 0.61
## D1 0.93 0.84
## D2 0.36 0.30
## SU 0.24
## LC 0.52 0.55
## u2 com
## LW 0.1988 1.4
## WA 0.3436 3.7
## PC 0.2943 1.6
## CA 0.2431 1.0
## AP 0.2365 1.1
## DI 0.0046 1.0
## PR -0.0211 1.0
## SC 0.3228 1.2
## SO 0.2958 1.2
## HU 0.3116 1.3
## RV 0.2497 2.5
## SP 0.1320 1.2
## AW 0.2259 1.4
## WF 0.4566 2.1
## PU 0.3342 1.7
## US 0.3221 1.1
## KN 0.0037 1.1
## MA -0.0300 1.0
## RE -0.0159 1.0
## WR -0.0178 1.9
## PV 0.3358 1.2
## SR 0.5812 1.5
## MS 0.4127 1.2
## VA 0.4235 2.8
## BL 0.4888 1.0
## VM 0.3078 1.1
## AS 0.2777 1.8
## AN 0.5352 2.1
## NR 0.4616 1.4
## CF 0.5172 2.1
## AL 0.3630 3.7
## PI 0.7132 2.1
## MW 0.4399 1.0
## MN 0.3301 1.1
## IW 0.6630 1.3
## VC 0.7291 3.8
## CR 0.3949 1.1
## D1 0.1558 1.0
## D2 0.6958 2.5
## SU 0.7556 2.6
## LC 0.4481 1.3
##
## MR1 MR4 MR9 MR8 MR2 MR7 MR6 MR5 MR3 MR10 MR11
## SS loadings 4.57 3.19 2.93 3.05 2.75 2.07 1.99 2.14 1.72 1.57 1.09
## Proportion Var 0.11 0.08 0.07 0.07 0.07 0.05 0.05 0.05 0.04 0.04 0.03
## Cumulative Var 0.11 0.19 0.26 0.34 0.40 0.45 0.50 0.55 0.60 0.63 0.66
## Proportion Explained 0.17 0.12 0.11 0.11 0.10 0.08 0.07 0.08 0.06 0.06 0.04
## Cumulative Proportion 0.17 0.29 0.39 0.51 0.61 0.69 0.76 0.84 0.90 0.96 1.00
##
## With factor correlations of
## MR1 MR4 MR9 MR8 MR2 MR7 MR6 MR5 MR3 MR10 MR11
## MR1 1.00 0.51 0.46 0.51 0.39 0.38 0.26 0.46 0.35 0.38 0.32
## MR4 0.51 1.00 0.52 0.47 0.48 0.31 0.46 0.46 0.34 0.32 0.35
## MR9 0.46 0.52 1.00 0.60 0.69 0.29 0.47 0.47 0.24 0.47 0.42
## MR8 0.51 0.47 0.60 1.00 0.58 0.32 0.34 0.50 0.21 0.49 0.34
## MR2 0.39 0.48 0.69 0.58 1.00 0.28 0.44 0.42 0.12 0.42 0.41
## MR7 0.38 0.31 0.29 0.32 0.28 1.00 0.23 0.31 0.34 0.36 0.19
## MR6 0.26 0.46 0.47 0.34 0.44 0.23 1.00 0.36 0.30 0.38 0.29
## MR5 0.46 0.46 0.47 0.50 0.42 0.31 0.36 1.00 0.27 0.54 0.27
## MR3 0.35 0.34 0.24 0.21 0.12 0.34 0.30 0.27 1.00 0.33 0.18
## MR10 0.38 0.32 0.47 0.49 0.42 0.36 0.38 0.54 0.33 1.00 0.21
## MR11 0.32 0.35 0.42 0.34 0.41 0.19 0.29 0.27 0.18 0.21 1.00
##
## Mean item complexity = 1.7
## Test of the hypothesis that 11 factors are sufficient.
##
## The degrees of freedom for the null model are 820 and the objective function was 44.82 with Chi Square of 207952.8
## The degrees of freedom for the model are 424 and the objective function was 8.64
##
## The root mean square of the residuals (RMSR) is 0.01
## The df corrected root mean square of the residuals is 0.02
##
## The harmonic number of observations is 3538 with the empirical chi square 1027.64 with prob < 5.1e-52
## The total number of observations was 4655 with Likelihood Chi Square = 40004.61 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.63
## RMSEA index = 0.142 and the 90 % confidence intervals are 0.14 0.143
## BIC = 36423.63
## Fit based upon off diagonal values = 1#Measurement model
WJIIMM.model <- '
Gc =~ AL + AS + PV + KN + LC
Grw =~ SP + PC + RV + LW + WA + AW + WF
Gs =~ VM + NR + CR
Gv =~ PI + SR
Gf =~ CF + AN + AP
Ga =~ SU + BL'
#Higher-order model
WJIIHOF.model <- '
Gc =~ AL + AS + PV + KN + LC
Grw =~ SP + PC + RV + LW + WA + AW + WF
Gs =~ VM + NR + CR
Gv =~ PI + SR
Gf =~ CF + AN + AP
Ga =~ SU + BL
g =~ Gc + Grw + Gs + Gv + Gf + Ga
AS ~~ RV
SP ~~ VM
WA ~~ BL'
#Bifactor model
WJIIBF.model <- '
Gc =~ AL + AS + PV + KN + LC
Grw =~ SP + PC + RV + LW + WA + AW + WF
Gs =~ VM + NR + CR
PI ~~ SR
Gf =~ CF + AN + AP
SU ~~ BL
AS ~~ RV
WA ~~ BL
g =~ AL + AS + PV + KN + LC + SP + PC + RV + LW + WA + AW + WF + VM + NR + CR + PI + SR + CF + AN + AP + SU + BL'
WJIIMM.fit <- cfa(WJIIMM.model, data = WJIIFAData, std.lv = T, orthogonal = F)
WJIIHOF.fit <- cfa(WJIIHOF.model, data = WJIIFAData, std.lv = T, orthogonal = T)
WJIIBF.fit <- cfa(WJIIBF.model, data = WJIIFAData, std.lv = T, orthogonal = T)
round(cbind(MM = fitMeasures(WJIIMM.fit, FITM),
HOF = fitMeasures(WJIIHOF.fit, FITM),
BF = fitMeasures(WJIIBF.fit, FITM)),3)## MM HOF BF
## chisq 3086.554 3072.625 2043.310
## df 194.000 200.000 187.000
## npar 59.000 53.000 66.000
## cfi 0.910 0.911 0.942
## rmsea 0.074 0.073 0.060
## rmsea.ci.lower 0.072 0.070 0.058
## rmsea.ci.upper 0.076 0.075 0.063
## aic 467812.847 467786.918 466783.603
## bic 468161.636 468100.237 467173.775#WJII group and plots
WJIILATS <- list(
Gc = c("AL", "AS", "PV", "KN", "LC"),
Grw = c("SP", "PC", "RV", "LW", "WA", "AW", "WF"),
Gs = c("VM", "NR", "CR"),
Gv = c("PI", "SR"),
Gf = c("CF", "AN", "AP"),
Ga = c("SU", "BL"))
semPaths(WJIIMM.fit, "model", "std", title = F, residuals = F, groups = "WJIILATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)
semPaths(WJIIHOF.fit, "model", "std", title = F, residuals = F, groups = "WJIILATS", pastel = T, mar = c(3, 1, 3, 1), layout = "tree2", exoCov = F)
semPaths(WJIIBF.fit, "model", "std", title = F, residuals = F, groups = "WJIILATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
As often happens, the higher-order model needed to model a small number of residual covariances in order to match the measurement model fit, but it still remained more parsimonious despite this. For the bifactor model, the PI to SR and SU to BL residual covariances were not necessary, but I modeled them for between-model consistency.
Measurement Invariance
#Measurement model
WJIIMMC.fit <- cfa(WJIIMM.model, data = WJII, std.lv = T, group = "race", orthogonal = F)
WJIIMMM.fit <- cfa(WJIIMM.model, data = WJII, std.lv = F, group = "race", orthogonal = F, group.equal = "loadings")
WJIIMMS.fit <- cfa(WJIIMM.model, data = WJII, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts"))
WJIIMMF.fit <- cfa(WJIIMM.model, data = WJII, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))## Warning in lav_object_post_check(object): lavaan WARNING: covariance matrix of latent variables
## is not positive definite in group 2;
## use lavInspect(fit, "cov.lv") to investigate.WJIIMMV.fit <- cfa(WJIIMM.model, data = WJII, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))## Warning in lav_object_post_check(object): lavaan WARNING: covariance matrix of latent variables
## is not positive definite in group 2;
## use lavInspect(fit, "cov.lv") to investigate.WJIIMMME.fit <- cfa(WJIIMM.model, data = WJII, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIIMMC.fit, FITM),
METRIC = fitMeasures(WJIIMMM.fit, FITM),
SCALAR = fitMeasures(WJIIMMS.fit, FITM),
STRICT = fitMeasures(WJIIMMF.fit, FITM),
LVARS = fitMeasures(WJIIMMV.fit, FITM),
MEANS = fitMeasures(WJIIMMME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 3597.239 3625.572 3804.495 3858.318 3858.302
## df 388.000 404.000 420.000 442.000 442.000
## npar 162.000 146.000 130.000 108.000 108.000
## cfi 0.910 0.910 0.905 0.904 0.904
## rmsea 0.074 0.073 0.073 0.072 0.072
## rmsea.ci.lower 0.072 0.071 0.071 0.070 0.070
## rmsea.ci.upper 0.076 0.075 0.075 0.074 0.074
## aic 515376.971 515373.303 515520.226 515530.049 515530.034
## bic 516350.272 516250.475 516301.270 516178.916 516178.901
## MEANS
## chisq 4031.984
## df 448.000
## npar 102.000
## cfi 0.900
## rmsea 0.073
## rmsea.ci.lower 0.071
## rmsea.ci.upper 0.075
## aic 515691.715
## bic 516304.535The errors given did not manifest when I inspected the results. Invariance was achieved.
#Higher-order model
WJIIHOFC.fit <- cfa(WJIIHOF.model, data = WJII, std.lv = T, group = "race", orthogonal = T)
WJIIHOFM.fit <- cfa(WJIIHOF.model, data = WJII, std.lv = F, group = "race", orthogonal = T, group.equal = "loadings")
WJIIHOFS.fit <- cfa(WJIIHOF.model, data = WJII, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 1.421566e-12) is close to zero. This may be a symptom that the
## model is not identified.WJIIHOFF.fit <- cfa(WJIIHOF.model, data = WJII, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
WJIIHOFV.fit <- cfa(WJIIHOF.model, data = WJII, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
WJIIHOFME.fit <- cfa(WJIIHOF.model, data = WJII, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIIHOFC.fit, FITM),
METRIC = fitMeasures(WJIIHOFM.fit, FITM),
SCALAR = fitMeasures(WJIIHOFS.fit, FITM),
STRICT = fitMeasures(WJIIHOFF.fit, FITM),
LVARS = fitMeasures(WJIIHOFV.fit, FITM),
MEANS = fitMeasures(WJIIHOFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 3586.724 3621.371 3797.045 3849.020 3853.107
## df 400.000 421.000 436.000 458.000 461.000
## npar 150.000 129.000 114.000 92.000 89.000
## cfi 0.911 0.910 0.906 0.905 0.905
## rmsea 0.073 0.071 0.072 0.070 0.070
## rmsea.ci.lower 0.071 0.069 0.070 0.068 0.068
## rmsea.ci.upper 0.075 0.073 0.074 0.072 0.072
## aic 515342.455 515335.102 515480.777 515488.751 515486.838
## bic 516243.660 516110.138 516165.692 516041.490 516021.553
## MEANS
## chisq 4027.481
## df 468.000
## npar 82.000
## cfi 0.900
## rmsea 0.071
## rmsea.ci.lower 0.069
## rmsea.ci.upper 0.073
## aic 515647.212
## bic 516139.871#Bifactor model
WJIIBFC.fit <- cfa(WJIIBF.model, data = WJII, std.lv = T, group = "race", orthogonal = T)## Warning in lav_object_post_check(object): lavaan WARNING: some estimated ov
## variances are negativeWJIIBFM.fit <- cfa(WJIIBF.model, data = WJII, std.lv = F, group = "race", orthogonal = T, group.equal = "loadings")
WJIIBFS.fit <- cfa(WJIIBF.model, data = WJII, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts"))## Warning in lav_object_post_check(object): lavaan WARNING: some estimated ov
## variances are negativeWJIIBFF.fit <- cfa(WJIIBF.model, data = WJII, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))## Warning in lav_object_post_check(object): lavaan WARNING: some estimated ov
## variances are negativeWJIIBFV.fit <- cfa(WJIIBFVM.model, data = WJII, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
WJIIBFME.fit <- cfa(WJIIBF.model, data = WJII, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIIBFC.fit, FITM),
METRIC = fitMeasures(WJIIBFM.fit, FITM),
SCALAR = fitMeasures(WJIIBFS.fit, FITM),
STRICT = fitMeasures(WJIIBFF.fit, FITM),
LVARS = fitMeasures(WJIIBFV.fit, FITM),
MEANS = fitMeasures(WJIIBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 2385.438 2461.767 2640.496 2679.785 2686.647
## df 374.000 409.000 426.000 448.000 453.000
## npar 176.000 141.000 124.000 102.000 97.000
## cfi 0.944 0.943 0.938 0.938 0.937
## rmsea 0.060 0.058 0.059 0.058 0.057
## rmsea.ci.lower 0.058 0.056 0.057 0.055 0.055
## rmsea.ci.upper 0.062 0.060 0.061 0.060 0.059
## aic 514193.169 514199.498 514344.227 514339.516 514336.378
## bic 515250.583 515046.631 515089.223 514952.336 514919.158
## MEANS
## chisq 2841.595
## df 457.000
## npar 93.000
## cfi 0.933
## rmsea 0.059
## rmsea.ci.lower 0.057
## rmsea.ci.upper 0.061
## aic 514483.327
## bic 515042.074Various subtests at different stages threw (insignificantly) negative residual variances which were removed (metric) or changed (scalar) by stage, so I took the last stage (latent variances) and constrained the VM subtest residual (1), with no decrement in fit. This is why I did not include the residual covariance between SP and VM in the bifactor model: the same error correction leads to \(\sigma(SP, VM) > 1\). In the final model, there were no negative variances; their correction at each stage did not affect fit, but it would have had the corrections stayed between stages, which is not expected to be needed because the constraints (like, e.g., those on \(\lambda\)) are expected to affect the parameters (again, insignificantly) in error.
Spearman's Hypothesis
Because there are so many models, I again fitted the Spearman's hypothesis models based on theory, which is to say, constraining the least-differentiated factor means. In the higher-order model, these were Gc and Gv (\(p\) = 0.015 and \(p\) = 0.059); in the bifactor model, they were Gc and Gf (\(p\) = 0.410 and \(p\) = 0.850).
round(cbind(LVAR = fitMeasures(WJIIHOFV.fit, FITM),
STRONG = fitMeasures(WJIIHOFVS.fit, FITM),
WEAK = fitMeasures(WJIIHOFVW.fit, FITM),
CONTRA = fitMeasures(WJIIHOFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 3853.107 3908.132 3853.567 3969.618
## df 461.000 467.000 463.000 464.000
## npar 89.000 83.000 87.000 86.000
## cfi 0.905 0.904 0.905 0.902
## rmsea 0.070 0.070 0.070 0.071
## rmsea.ci.lower 0.068 0.068 0.068 0.069
## rmsea.ci.upper 0.072 0.072 0.072 0.073
## aic 515486.838 515529.864 515483.298 515597.349
## bic 516021.553 516028.530 516005.997 516114.040round(cbind(LVAR = fitMeasures(WJIIBFV.fit, FITM),
STRONG = fitMeasures(WJIIBFVS.fit, FITM),
WEAK = fitMeasures(WJIIBFVW.fit, FITM),
CONTRA = fitMeasures(WJIIBFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 2686.647 2722.399 2687.386 2817.551
## df 453.000 457.000 455.000 456.000
## npar 97.000 93.000 95.000 94.000
## cfi 0.937 0.937 0.938 0.934
## rmsea 0.057 0.057 0.057 0.059
## rmsea.ci.lower 0.055 0.055 0.055 0.057
## rmsea.ci.upper 0.059 0.060 0.059 0.061
## aic 514336.378 514364.130 514333.117 514461.282
## bic 514919.158 514922.877 514903.880 515026.037It seems that the weak model is - again - "victorious".
Traditional Analyses
The proportion of the group differences attributable to g was 68.5% in the latent variances model and 78.7% in the selected weak model. The MCV relationships for g are \(r = 0.571, \rho = 0.612,\) and \(\phi = 0.979\); for the non-g loadings they are \(r = -0.452, \rho = -0.379,\) and \(\phi = 0.473\). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.981; for the non-g loadings it becomes 0.482.
MCVDFWJII %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#2AE2BC", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in the Woodcock-Johnson-R") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.85, 0.15), legend.background = element_blank())
MCVDFWJII %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#2AE2BC", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in the Woodcock-Johnson-R") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
ggplot(MCVDFWJII, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#2AE2BC", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in the Woodcock-Johnson-R") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDFWJII, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#2AE2BC", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in the Woodcock-Johnson-R") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Lasker et al. - e (WJ-III)
Initial Fits
WJIII %<>% rename(
LW = a01letword,
WA = a02wordattack,
PC = a03passcomp,
CA = a04calc,
AP = a05approb,
ED = a06edit,
IW = a07incword,
AM = a08audwrkmem,
DV = a09drvisaud,
PL = a10planning,
RV = a11readvocab,
SP = a12spell,
AW = a13write,
WF = a14writeflu,
ST = a15stryrecall,
MN = a17memnames,
VC = a18visclosure,
SV = a19sndpatvoice,
MF = a20mathflu,
RF = a21readflu,
NS = a22numseries,
NM = a23nummatrix,
MS = a24memsent,
BR = a25blokrot,
DM = a27delrecnames,
KN = achknowledge,
MA = achmath,
RE = achreading,
WR = achwriting,
SR = c02spatrels,
VA = c04visaudit,
BL = c05blend,
VP = c06verbcomp,
VM = c07vismatch,
AN = c09analsyn,
NR = c10numrev,
CF = c11concform,
PI = c13picrecog,
MW = c14memwords,
GI = c15geninfo,
RT = c16retrieve,
AA = c17audatten,
DE = c18decisions)
#Many of these variables had very few takers and were age-stratified so the young didn't take them; I didn't use those variables
#umx_residualize(c("LW", "WA", "PC" ,"CA", "AP", "ED", "IW", "AM", "DV", "PL", "RV", "SP", "AW", "WF", "ST", "MN", "VC", "SV", "MF", "RF", "NS", "NM", "MS", "BR", "DM", "KN", "MA", "RE", "WR", "SR", "VA", "BL", "VP", "VM", "AN", "NR", "CF", "PI", "MW", "GI", "RT", "AA", "DE"), c("testage", "sex"), data = WJIII)
WJIIIW <- subset(WJIII, race=="1")
WJIIIB <- subset(WJIII, race=="2")
WJIIIFAVars <- c("LW", "WA", "PC" ,"CA", "AP", "ED", "IW", "AM", "DV", "PL", "RV", "SP", "AW", "WF", "ST", "MN", "VC", "SV", "MF", "RF", "NS", "NM", "MS", "BR", "DM", "KN", "MA", "RE", "WR", "SR", "VA", "BL", "VP", "VM", "AN", "NR", "CF", "PI", "MW", "GI", "RT", "AA", "DE")
WJIIIFAData <- WJIIIW[WJIIIFAVars]fa.parallel(WJIIIFAData)## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
## Parallel analysis suggests that the number of factors = 12 and the number of components = 6resFA <- n_factors(WJIIIFAData, type = "FA", package = "all")##
## These indices are only valid with a principal component solution.
## ...................... So, only positive eugenvalues are permitted.plot(resFA, type = "line") + theme_bw()
FA6 <- fa(WJIIIFAData, nfactors = 6)## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefullyFA12 <- fa(WJIIIFAData, nfactors = 12)## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done## Warning in GPFoblq(L, Tmat = Tmat, normalize = normalize, eps = eps, maxit =
## maxit, : convergence not obtained in GPFoblq. 1000 iterations used.## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefullyprint(FA6, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = WJIIIFAData, nfactors = 6)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR3 MR1 MR5 MR2 MR6 MR4 h2 u2 com
## LW 0.62 0.68 0.3241 1.4
## WA 0.53 0.51 0.4911 1.6
## PC 0.33 0.46 0.5383 2.7
## CA 0.71 0.57 0.4274 1.0
## AP 0.72 0.67 0.3311 1.2
## ED 0.44 0.46 0.5412 1.9
## IW 0.41 0.28 0.7244 1.9
## AM 0.41 0.36 0.6390 1.6
## DV 0.88 0.75 0.2503 1.0
## PL 0.14 0.8624 3.0
## RV 0.31 0.40 0.54 0.4626 2.5
## SP 0.66 0.63 0.3681 1.1
## AW 0.38 0.43 0.5685 1.8
## WF 0.30 0.36 0.43 0.5669 2.2
## ST 0.56 0.59 0.4126 1.4
## MN 0.70 0.49 0.5100 1.1
## VC 0.10 0.8956 4.0
## SV 0.38 0.25 0.7467 1.3
## MF 0.45 0.41 0.64 0.3560 2.9
## RF 0.44 0.40 0.68 0.3164 2.4
## NS 0.53 0.50 0.4986 1.3
## NM 0.46 0.40 0.6024 1.4
## MS 0.46 0.44 0.5616 1.6
## BR 0.20 0.8036 4.2
## DM 0.66 0.43 0.5675 1.1
## KN 0.90 0.90 0.1049 1.0
## MA 0.98 1.01 -0.0055 1.0
## RE 0.62 0.85 0.1522 1.5
## WR 0.71 0.84 0.1624 1.2
## SR 0.23 0.7662 4.3
## VA 0.86 0.77 0.2316 1.0
## BL 0.52 0.39 0.6115 1.2
## VP 0.64 0.75 0.2502 1.2
## VM 0.59 0.59 0.4076 1.4
## AN 0.36 0.41 0.5911 2.7
## NR 0.38 0.37 0.6259 2.3
## CF 0.50 0.5006 4.0
## PI 0.14 0.8586 2.2
## MW 0.61 0.43 0.5651 1.2
## GI 0.85 0.80 0.1956 1.0
## RT 0.36 0.31 0.32 0.6830 2.0
## AA 0.31 0.31 0.25 0.7488 2.5
## DE 0.63 0.45 0.5513 1.2
##
## MR3 MR1 MR5 MR2 MR6 MR4
## SS loadings 4.32 4.25 4.29 3.50 3.15 2.12
## Proportion Var 0.10 0.10 0.10 0.08 0.07 0.05
## Cumulative Var 0.10 0.20 0.30 0.38 0.45 0.50
## Proportion Explained 0.20 0.20 0.20 0.16 0.15 0.10
## Cumulative Proportion 0.20 0.40 0.59 0.76 0.90 1.00
##
## With factor correlations of
## MR3 MR1 MR5 MR2 MR6 MR4
## MR3 1.00 0.53 0.51 0.44 0.42 0.34
## MR1 0.53 1.00 0.51 0.35 0.44 0.40
## MR5 0.51 0.51 1.00 0.50 0.55 0.18
## MR2 0.44 0.35 0.50 1.00 0.52 0.20
## MR6 0.42 0.44 0.55 0.52 1.00 0.26
## MR4 0.34 0.40 0.18 0.20 0.26 1.00
##
## Mean item complexity = 1.9
## Test of the hypothesis that 6 factors are sufficient.
##
## The degrees of freedom for the null model are 903 and the objective function was 55.04 with Chi Square of 345104.2
## The degrees of freedom for the model are 660 and the objective function was 30.84
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.03
##
## The harmonic number of observations is 4069 with the empirical chi square 6540.64 with prob < 0
## The total number of observations was 6286 with Likelihood Chi Square = 193267.2 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.234
## RMSEA index = 0.215 and the 90 % confidence intervals are 0.215 0.216
## BIC = 187494.8
## Fit based upon off diagonal values = 0.99print(FA12, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = WJIIIFAData, nfactors = 12)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR4 MR6 MR2 MR11 MR8 MR7 MR9 MR3 MR10 MR5 MR12 MR1 h2
## LW 0.34 0.43 0.75
## WA 0.35 0.54
## PC 0.33 0.49
## CA 0.70 0.59
## AP 0.72 0.69
## ED 0.48
## IW 0.45 0.34
## AM 0.47 0.41
## DV 0.95 0.91
## PL 0.18
## RV 0.57
## SP 0.54 0.38 0.73
## AW 0.33 0.45
## WF 0.72 -0.32 0.71
## ST 0.35 0.61
## MN 0.63 0.59
## VC 0.18
## SV 0.28
## MF 0.45 0.68
## RF 0.80 0.84
## NS 0.36 0.52
## NM 0.32 0.41
## MS 0.55 0.53
## BR 0.42 0.27
## DM 1.03 1.00
## KN 1.00 1.00
## MA 1.01 1.05
## RE 0.88 1.02
## WR 0.92 1.06
## SR 0.45 0.33
## VA 1.01 1.00
## BL 0.60 0.53
## VP 0.40 0.76
## VM 0.56 0.62
## AN 0.45
## NR 0.45 0.42
## CF 0.36 0.60
## PI 0.16
## MW 0.60 0.50
## GI 0.86 0.85
## RT 0.34 0.36
## AA 0.30 0.28
## DE 0.66 0.52
## u2 com
## LW 0.2464 2.6
## WA 0.4578 3.0
## PC 0.5138 3.0
## CA 0.4112 1.1
## AP 0.3129 1.1
## ED 0.5230 6.0
## IW 0.6648 1.2
## AM 0.5892 1.4
## DV 0.0942 1.0
## PL 0.8246 2.0
## RV 0.4314 5.3
## SP 0.2724 2.0
## AW 0.5515 2.4
## WF 0.2903 1.4
## ST 0.3858 3.0
## MN 0.4123 1.2
## VC 0.8174 4.3
## SV 0.7184 3.1
## MF 0.3227 3.3
## RF 0.1553 1.1
## NS 0.4835 2.8
## NM 0.5926 2.9
## MS 0.4692 1.4
## BR 0.7282 1.3
## DM 0.0048 1.0
## KN -0.0037 1.0
## MA -0.0486 1.0
## RE -0.0228 1.0
## WR -0.0560 1.0
## SR 0.6654 1.4
## VA 0.0016 1.0
## BL 0.4711 1.2
## VP 0.2425 2.6
## VM 0.3833 1.5
## AN 0.5478 4.2
## NR 0.5821 1.7
## CF 0.4009 3.6
## PI 0.8449 3.9
## MW 0.4955 1.2
## GI 0.1528 1.0
## RT 0.6391 3.5
## AA 0.7227 2.9
## DE 0.4830 1.2
##
## MR4 MR6 MR2 MR11 MR8 MR7 MR9 MR3 MR10 MR5 MR12
## SS loadings 3.67 3.19 2.51 2.87 2.71 1.84 2.16 1.64 1.30 1.24 0.95
## Proportion Var 0.09 0.07 0.06 0.07 0.06 0.04 0.05 0.04 0.03 0.03 0.02
## Cumulative Var 0.09 0.16 0.22 0.28 0.35 0.39 0.44 0.48 0.51 0.54 0.56
## Proportion Explained 0.15 0.13 0.10 0.11 0.11 0.07 0.09 0.06 0.05 0.05 0.04
## Cumulative Proportion 0.15 0.27 0.37 0.49 0.59 0.67 0.75 0.82 0.87 0.92 0.95
## MR1
## SS loadings 1.16
## Proportion Var 0.03
## Cumulative Var 0.59
## Proportion Explained 0.05
## Cumulative Proportion 1.00
##
## With factor correlations of
## MR4 MR6 MR2 MR11 MR8 MR7 MR9 MR3 MR10 MR5 MR12 MR1
## MR4 1.00 0.49 0.39 0.51 0.47 0.29 0.47 0.33 0.15 0.32 0.19 0.27
## MR6 0.49 1.00 0.44 0.52 0.43 0.38 0.47 0.17 0.43 0.24 0.18 0.50
## MR2 0.39 0.44 1.00 0.33 0.32 0.51 0.40 0.22 0.31 0.37 0.12 0.29
## MR11 0.51 0.52 0.33 1.00 0.60 0.25 0.50 0.45 0.29 0.11 0.24 0.23
## MR8 0.47 0.43 0.32 0.60 1.00 0.25 0.44 0.39 0.27 0.12 0.17 0.17
## MR7 0.29 0.38 0.51 0.25 0.25 1.00 0.30 0.15 0.24 0.24 0.13 0.22
## MR9 0.47 0.47 0.40 0.50 0.44 0.30 1.00 0.25 0.42 0.29 0.12 0.26
## MR3 0.33 0.17 0.22 0.45 0.39 0.15 0.25 1.00 0.15 0.16 -0.08 0.00
## MR10 0.15 0.43 0.31 0.29 0.27 0.24 0.42 0.15 1.00 0.20 0.10 0.23
## MR5 0.32 0.24 0.37 0.11 0.12 0.24 0.29 0.16 0.20 1.00 0.07 0.24
## MR12 0.19 0.18 0.12 0.24 0.17 0.13 0.12 -0.08 0.10 0.07 1.00 0.11
## MR1 0.27 0.50 0.29 0.23 0.17 0.22 0.26 0.00 0.23 0.24 0.11 1.00
##
## Mean item complexity = 2.2
## Test of the hypothesis that 12 factors are sufficient.
##
## The degrees of freedom for the null model are 903 and the objective function was 55.04 with Chi Square of 345104.2
## The degrees of freedom for the model are 453 and the objective function was 25.32
##
## The root mean square of the residuals (RMSR) is 0.01
## The df corrected root mean square of the residuals is 0.02
##
## The harmonic number of observations is 4069 with the empirical chi square 1370.95 with prob < 5.2e-93
## The total number of observations was 6286 with Likelihood Chi Square = 158526.6 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.083
## RMSEA index = 0.236 and the 90 % confidence intervals are 0.235 0.237
## BIC = 154564.6
## Fit based upon off diagonal values = 1#Measurement model
WJIIIMM.model <- '
Gc =~ GI + KN + ST + VP + RT
Grw =~ SP + PC + RV + LW + ED + AW + WA
Gs =~ RT + DE + VM + MF
Gq =~ MF + AP + NM + NS + CA
Gsm =~ NR + AM + MS + MW
Gv =~ PI + SR + BR + PL
Gf =~ AP + NM + NS + CF + AN'
#Higher-order model
WJIIIHOF.model <- '
Gc =~ GI + KN + ST + VP + RT
Grw =~ SP + PC + RV + LW + ED + AW + WA
Gs =~ RT + DE + VM + MF
Gq =~ MF + AP + NM + NS + CA
Gsm =~ NR + AM + MS + MW
Gv =~ PI + SR + BR + PL
Gf =~ AP + NM + NS + CF + AN
g =~ Gc + Grw + Gs + Gq + Gsm + Gv + Gf
GI ~~ KN
ST ~~ VP + CF
LW ~~ WA'
#Bifactor model
WJIIIBF.model <- '
Gc =~ GI + KN + ST + VP + RT
Grw =~ SP + PC + RV + LW + ED + AW + WA
Gs =~ RT + DE + VM + MF
Gq =~ MF + AP + NM + NS + CA
Gsm =~ NR + AM + MS + MW
Gv =~ PI + SR + BR + PL
Gf =~ AP + NM + NS + CF + AN
g =~ GI + KN + ST + VP + RT + SP + PC + RV + LW + ED + AW + WA + DE + VM + MF + AP + NM + NS + CA + NR + AM + MS + MW + PI + SR + BR + PL + CF + AN
ST ~~ CF'
WJIIIMM.fit <- cfa(WJIIIMM.model, data = WJIIIFAData, std.lv = T, orthogonal = F)
WJIIIHOF.fit <- cfa(WJIIIHOF.model, data = WJIIIFAData, std.lv = T, orthogonal = T)
WJIIIBF.fit <- cfa(WJIIIBF.model, data = WJIIIFAData, std.lv = T, orthogonal = T)
round(cbind(MM = fitMeasures(WJIIIMM.fit, FITM),
HOF = fitMeasures(WJIIIHOF.fit, FITM),
BF = fitMeasures(WJIIIBF.fit, FITM)),3)## MM HOF BF
## chisq 3195.102 2540.217 2295.248
## df 351.000 361.000 342.000
## npar 84.000 74.000 93.000
## cfi 0.904 0.926 0.934
## rmsea 0.063 0.054 0.053
## rmsea.ci.lower 0.061 0.052 0.051
## rmsea.ci.upper 0.065 0.056 0.055
## aic 458306.293 457631.407 457424.438
## bic 458779.496 458048.277 457948.341#WJIII group and plots
WJIIILATS <- list(
Gc = c("GI", "KN", "ST", "VP", "RT"),
Grw = c("SP", "PC", "RV", "KW", "ED", "AW", "WA"),
Gs = c("RT", "DE", "VM", "MF"),
Gq = c("MF", "AP", "NM", "NS", "CA"),
Gsm = c("NR", "AM", "MS", "MW"),
Gv = c("PI", "SR", "BR", "PL"),
Gf = c("AP", "NM", "NS", "CF", "AN"))
semPaths(WJIIIMM.fit, "model", "std", title = F, residuals = F, groups = "WJIIILATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(WJIIIHOF.fit, "model", "std", title = F, residuals = F, groups = "WJIIILATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(WJIIIBF.fit, "model", "std", title = F, residuals = F, groups = "WJIIILATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
Measurement Invariance
#Measurement model
WJIIIMMC.fit <- cfa(WJIIIMM.model, data = WJIII, std.lv = T, group = "race", orthogonal = F)
WJIIIMMM.fit <- cfa(WJIIIMM.model, data = WJIII, std.lv = F, group = "race", orthogonal = F, group.equal = "loadings")
WJIIIMMS.fit <- cfa(WJIIIMM.model, data = WJIII, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts"))
WJIIIMMF.fit <- cfa(WJIIIMM.model, data = WJIII, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
WJIIIMMV.fit <- cfa(WJIIIMM.model, data = WJIII, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
WJIIIMMME.fit <- cfa(WJIIIMM.model, data = WJIII, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIIIMMC.fit, FITM),
METRIC = fitMeasures(WJIIIMMM.fit, FITM),
SCALAR = fitMeasures(WJIIIMMS.fit, FITM),
STRICT = fitMeasures(WJIIIMMF.fit, FITM),
LVARS = fitMeasures(WJIIIMMV.fit, FITM),
MEANS = fitMeasures(WJIIIMMME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 4006.133 4094.192 4232.742 4353.716 4353.698
## df 702.000 729.000 751.000 780.000 780.000
## npar 226.000 199.000 177.000 148.000 148.000
## cfi 0.903 0.901 0.898 0.895 0.895
## rmsea 0.063 0.063 0.063 0.063 0.063
## rmsea.ci.lower 0.061 0.061 0.061 0.061 0.061
## rmsea.ci.upper 0.065 0.065 0.065 0.064 0.064
## aic 520244.707 520278.765 520373.316 520436.290 520436.272
## bic 521546.476 521425.013 521392.843 521288.776 521288.758
## MEANS
## chisq 4581.554
## df 787.000
## npar 141.000
## cfi 0.888
## rmsea 0.064
## rmsea.ci.lower 0.062
## rmsea.ci.upper 0.066
## aic 520650.128
## bic 521462.294Adding the residual covariances used in the higher-order model to the measurement model, initial fit is considerably improved and invariance is maintained, but it becomes even less parsimonious than the higher-order model. Based on the relative parsimony and the fit measures used, the bifactor actually seems to be worse in terms of fit than the higher-order model in this case. Briefly, worth stating is that the WJ models could have been better-fitting if I had allowed many cross-loadings, but the substantive results would not have changed.
#Higher-order model
WJIIIHOFC.fit <- cfa(WJIIIHOF.model, data = WJIII, std.lv = T, group = "race", orthogonal = F)
WJIIIHOFM.fit <- cfa(WJIIIHOF.model, data = WJIII, std.lv = F, group = "race", orthogonal = F, group.equal = "loadings")
WJIIIHOFS.fit <- cfa(WJIIIHOF.model, data = WJIII, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 3.771761e-13) is close to zero. This may be a symptom that the
## model is not identified.WJIIIHOFF.fit <- cfa(WJIIIHOF.model, data = WJIII, std.lv = F, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
WJIIIHOFV.fit <- cfa(WJIIIHOF.model, data = WJIII, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
WJIIIHOFME.fit <- cfa(WJIIIHOF.model, data = WJIII, std.lv = T, group = "race", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIIIHOFC.fit, FITM),
METRIC = fitMeasures(WJIIIHOFM.fit, FITM),
SCALAR = fitMeasures(WJIIIHOFS.fit, FITM),
STRICT = fitMeasures(WJIIIHOFF.fit, FITM),
LVARS = fitMeasures(WJIIIHOFV.fit, FITM),
MEANS = fitMeasures(WJIIIHOFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 3182.122 3285.401 3411.674 3531.224 3596.080
## df 722.000 755.000 776.000 805.000 809.000
## npar 206.000 173.000 152.000 123.000 119.000
## cfi 0.928 0.926 0.923 0.920 0.918
## rmsea 0.054 0.053 0.054 0.054 0.054
## rmsea.ci.lower 0.052 0.052 0.052 0.052 0.052
## rmsea.ci.upper 0.056 0.055 0.056 0.056 0.056
## aic 519380.696 519417.975 519502.248 519563.797 519620.654
## bic 520567.264 520414.462 520377.774 520272.282 520306.099
## MEANS
## chisq 3846.648
## df 817.000
## npar 111.000
## cfi 0.911
## rmsea 0.056
## rmsea.ci.lower 0.054
## rmsea.ci.upper 0.058
## aic 519855.221
## bic 520494.586#Bifactor model
WJIIIBFC.fit <- cfa(WJIIIBF.model, data = WJIII, std.lv = T, group = "race", orthogonal = T)## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## Could not compute standard errors! The information matrix could
## not be inverted. This may be a symptom that the model is not
## identified.## Warning in lav_object_post_check(object): lavaan WARNING: some estimated ov
## variances are negativeWJIIIBFM.fit <- cfa(WJIIIBF.model, data = WJIII, std.lv = F, group = "race", orthogonal = T, group.equal = "loadings")
WJIIIBFS.fit <- cfa(WJIIIBF.model, data = WJIII, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts"))
WJIIIBFF.fit <- cfa(WJIIIBF.model, data = WJIII, std.lv = F, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
WJIIIBFV.fit <- cfa(WJIIIBF.model, data = WJIII, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances"))
WJIIIBFME.fit <- cfa(WJIIIBF.model, data = WJIII, std.lv = T, group = "race", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "residual.covariances", "means"))
round(cbind(CONFIGURAL = fitMeasures(WJIIIBFC.fit, FITM),
METRIC = fitMeasures(WJIIIBFM.fit, FITM),
SCALAR = fitMeasures(WJIIIBFS.fit, FITM),
STRICT = fitMeasures(WJIIIBFF.fit, FITM),
LVARS = fitMeasures(WJIIIBFV.fit, FITM),
MEANS = fitMeasures(WJIIIBFME.fit, FITM)),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 2888.821 3014.977 3130.904 3256.517 3294.198
## df 684.000 739.000 760.000 789.000 790.000
## npar 244.000 189.000 168.000 139.000 138.000
## cfi 0.935 0.933 0.930 0.927 0.926
## rmsea 0.052 0.051 0.052 0.052 0.052
## rmsea.ci.lower 0.050 0.049 0.050 0.050 0.050
## rmsea.ci.upper 0.054 0.053 0.053 0.053 0.054
## aic 519163.395 519179.551 519253.477 519321.091 519356.772
## bic 520568.845 520268.199 520221.164 520121.736 520151.657
## MEANS
## chisq 3526.828
## df 798.000
## npar 130.000
## cfi 0.920
## rmsea 0.054
## rmsea.ci.lower 0.052
## rmsea.ci.upper 0.056
## aic 519573.402
## bic 520322.207The configural model had a slight (GI) and a large (PL) negative variance for the black group, but this was ameliorated in the following model. It's unlikely that this really mattered, but constraining those to zero for the black group in the configural model negligibly affected fit. Overall, there was invariance, with the two non-invariant parameters being the factor means and the residual covariance(s); the latent variances were unbiased. The residual covariances, I didn't bother including the different tests of invariance for individually since they didn't affect anything meaningfully except the goodness of fit, but in the higher-order model this is the ST and VP covariance and in the bifactor model it should be obvious; the means are, of course, investigated in the Spearman's hypothesis section.
Spearman's Hypothesis
Theory-based fitting led to constraining Gq, Gsm, Gv, and Gf (\(p's = 0.870, 0.404, 0.990, and 0.311\) respectively) in the higher-order model and the same factors (\(p's = 0.880, 0.142, 0.244, and 0.217\)) in the bifactor model. In both cases, I released the constraint on the residual covariance(s) but not the latent variances for determining that.
round(cbind(LVAR = fitMeasures(WJIIIHOFV.fit, FITM),
STRONG = fitMeasures(WJIIIHOFVS.fit, FITM),
WEAK = fitMeasures(WJIIIHOFVW.fit, FITM),
CONTRA = fitMeasures(WJIIIHOFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 3531.223 3611.117 3532.641 3675.703
## df 805.000 812.000 809.000 810.000
## npar 123.000 116.000 119.000 118.000
## cfi 0.920 0.918 0.920 0.916
## rmsea 0.054 0.054 0.054 0.055
## rmsea.ci.lower 0.052 0.052 0.052 0.053
## rmsea.ci.upper 0.056 0.056 0.055 0.057
## aic 519563.797 519629.690 519557.215 519698.276
## bic 520272.282 520297.855 520242.660 520377.961round(cbind(LVAR = fitMeasures(WJIIIBFV.fit, FITM),
STRONG = fitMeasures(WJIIIBFVS.fit, FITM),
WEAK = fitMeasures(WJIIIBFVW.fit, FITM),
CONTRA = fitMeasures(WJIIIBFVC.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 3256.512 3316.399 3259.955 3418.525
## df 789.000 796.000 793.000 794.000
## npar 139.000 132.000 135.000 134.000
## cfi 0.927 0.926 0.928 0.923
## rmsea 0.052 0.052 0.052 0.053
## rmsea.ci.lower 0.050 0.050 0.050 0.051
## rmsea.ci.upper 0.053 0.054 0.053 0.055
## aic 519321.086 519366.973 519316.528 519473.098
## bic 520121.732 520127.298 520094.134 520244.944Just like in the WJ-I and WJ-R, the WJ-III provides evidence for the weak version of Spearman's hypothesis.
Traditional Analyses
The proportion of the group differences attributable to g was 59.3% in the latent variances model and 73.4% in the selected weak model. The MCV relationships for g are \(r = 0.829, \rho = 0.839,\) and \(\phi = 0.974\); for the non-g loadings they are \(r = 0.211, \rho = 0.062,\) and \(\phi = 0.666\). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.979; for the non-g loadings it becomes 0.663.
MCVDFWJIII %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#59109C", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in the Woodcock-Johnson-III") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.85, 0.15), legend.background = element_blank())
MCVDFWJIII %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#59109C", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in the Woodcock-Johnson-III") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.80, 0.85), legend.background = element_blank())
ggplot(MCVDFWJIII, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#59109C", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in the Woodcock-Johnson-III") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDFWJIII, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#59109C", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in the Woodcock-Johnson-III") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Lasker & Kirkegaard (GATB)
Initial Fits
McDaniel supplied this large dataset of GATB results taken to qualify for civil service. The GATB was known to fit badly and large sample sizes can induce some problems for this sort of model, so not much is expected from this analysis. Because of my avoidance of cross-loadings, an increment in goodness of fit was foregone.
GATBFAVars <- c("G", "V", "N" ,"S", "P", "Q", "K", "F", "M")
GATBFAData <- WGATB[GATBFAVars]resFA <- n_factors(GATBFAData, type = "FA", package = "all")
fa.parallel(GATBFAData)
## Parallel analysis suggests that the number of factors = 4 and the number of components = 2plot(resFA, type = "line") + theme_bw()
GAT2 <- fa(GATBFAData, nfactors = 2)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefullyprint(GAT2, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = GATBFAData, nfactors = 2)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR2 h2 u2 com
## G 1.04 1.02 -0.016 1.0
## V 0.84 0.67 0.327 1.0
## N 0.82 0.72 0.281 1.0
## S 0.63 0.45 0.551 1.0
## P 0.48 0.44 0.62 0.380 2.0
## Q 0.54 0.33 0.57 0.435 1.6
## K 0.57 0.41 0.589 1.1
## F 0.69 0.50 0.502 1.0
## M 0.79 0.56 0.443 1.0
##
## MR1 MR2
## SS loadings 3.58 1.93
## Proportion Var 0.40 0.21
## Cumulative Var 0.40 0.61
## Proportion Explained 0.65 0.35
## Cumulative Proportion 0.65 1.00
##
## With factor correlations of
## MR1 MR2
## MR1 1.00 0.46
## MR2 0.46 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 2 factors are sufficient.
##
## The degrees of freedom for the null model are 36 and the objective function was 6.79 with Chi Square of 260604.5
## The degrees of freedom for the model are 19 and the objective function was 1.22
##
## The root mean square of the residuals (RMSR) is 0.05
## The df corrected root mean square of the residuals is 0.07
##
## The harmonic number of observations is 38394 with the empirical chi square 8052.02 with prob < 0
## The total number of observations was 38394 with Likelihood Chi Square = 46707.36 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.66
## RMSEA index = 0.253 and the 90 % confidence intervals are 0.251 0.255
## BIC = 46506.81
## Fit based upon off diagonal values = 0.99GAT3 <- fa(GATBFAData, nfactors = 3)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## An ultra-Heywood case was detected. Examine the results carefullyprint(GAT3, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = GATBFAData, nfactors = 3)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR2 MR3 h2 u2 com
## G 0.99 1.01 -0.012 1.1
## V 0.87 0.69 0.309 1.0
## N 0.85 0.73 0.273 1.0
## S 0.55 -0.49 0.72 0.276 2.3
## P 0.49 0.42 0.61 0.390 2.0
## Q 0.64 0.66 0.339 1.7
## K 0.49 0.38 0.54 0.459 2.3
## F 0.73 0.53 0.469 1.0
## M 0.81 0.58 0.423 1.0
##
## MR1 MR2 MR3
## SS loadings 3.66 1.89 0.52
## Proportion Var 0.41 0.21 0.06
## Cumulative Var 0.41 0.62 0.67
## Proportion Explained 0.60 0.31 0.09
## Cumulative Proportion 0.60 0.91 1.00
##
## With factor correlations of
## MR1 MR2 MR3
## MR1 1.00 0.46 -0.09
## MR2 0.46 1.00 0.07
## MR3 -0.09 0.07 1.00
##
## Mean item complexity = 1.5
## Test of the hypothesis that 3 factors are sufficient.
##
## The degrees of freedom for the null model are 36 and the objective function was 6.79 with Chi Square of 260604.5
## The degrees of freedom for the model are 12 and the objective function was 0.77
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.05
##
## The harmonic number of observations is 38394 with the empirical chi square 2476.13 with prob < 0
## The total number of observations was 38394 with Likelihood Chi Square = 29661.86 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.659
## RMSEA index = 0.254 and the 90 % confidence intervals are 0.251 0.256
## BIC = 29535.19
## Fit based upon off diagonal values = 1GAT4 <- fa(GATBFAData, nfactors = 4)## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## An ultra-Heywood case was detected. Examine the results carefullyprint(GAT4, cut = 0.3)## Factor Analysis using method = minres
## Call: fa(r = GATBFAData, nfactors = 4)
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR2 MR4 MR3 h2 u2 com
## G 0.98 1.03 -0.034 1.1
## V 0.81 0.70 0.299 1.1
## N 0.79 0.74 0.255 1.1
## S 0.73 0.84 0.156 1.2
## P 0.68 0.31 0.73 0.274 1.5
## Q 0.77 0.77 0.225 1.1
## K 0.40 0.37 0.49 0.510 2.9
## F 0.56 0.47 0.528 1.4
## M 0.91 0.77 0.227 1.0
##
## MR1 MR2 MR4 MR3
## SS loadings 2.61 1.46 1.64 0.85
## Proportion Var 0.29 0.16 0.18 0.09
## Cumulative Var 0.29 0.45 0.63 0.73
## Proportion Explained 0.40 0.22 0.25 0.13
## Cumulative Proportion 0.40 0.62 0.87 1.00
##
## With factor correlations of
## MR1 MR2 MR4 MR3
## MR1 1.00 0.30 0.66 0.48
## MR2 0.30 1.00 0.48 0.22
## MR4 0.66 0.48 1.00 0.23
## MR3 0.48 0.22 0.23 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 4 factors are sufficient.
##
## The degrees of freedom for the null model are 36 and the objective function was 6.79 with Chi Square of 260604.5
## The degrees of freedom for the model are 6 and the objective function was 0.31
##
## The root mean square of the residuals (RMSR) is 0.01
## The df corrected root mean square of the residuals is 0.02
##
## The harmonic number of observations is 38394 with the empirical chi square 229.38 with prob < 1e-46
## The total number of observations was 38394 with Likelihood Chi Square = 12002.19 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.724
## RMSEA index = 0.228 and the 90 % confidence intervals are 0.225 0.232
## BIC = 11938.86
## Fit based upon off diagonal values = 1#Measurement Model - EFA
GATMM.model <- '
F1 =~ G + V + N
F2 =~ K + F + M
F3 =~ P + Q + K
F4 =~ S + P
G ~~ 0*G
S ~~ 0*S'
#Higher-Order - EFA
GATHOF.model <- '
F1 =~ G + V + N
F2 =~ K + F + M
F3 =~ P + Q + K
F4 =~ S + P
g =~ F1 + F2 + F3 + F4
G ~~ 0*G
S ~~ 0*S'
#Bifactor - EFA
GATBF.model <- '
F1 =~ G + V + N
F2 =~ K + F + M
F3 =~ P + Q + K
g =~ G + V + N + S + P + Q + K + F + M
G ~~ 0*G
S ~~ 0*S'
GATMM.fit <- cfa(GATMM.model, data = GATBFAData, std.lv = T, orthogonal = F)
GATHOF.fit <- cfa(GATHOF.model, data = GATBFAData, std.lv = T, orthogonal = T)
GATBF.fit <- cfa(GATBF.model, data = GATBFAData, std.lv = T, orthogonal = T)
round(cbind(GATMM = fitMeasures(GATMM.fit, c(FITM, "bic2")),
GATHOF = fitMeasures(GATHOF.fit, c(FITM, "bic2")),
GATBF = fitMeasures(GATBF.fit, c(FITM, "bic2"))),3)## GATMM GATHOF GATBF
## chisq 33169.369 38338.053 33264.104
## df 21.000 23.000 20.000
## npar 24.000 22.000 25.000
## cfi 0.873 0.853 0.872
## rmsea 0.203 0.208 0.208
## rmsea.ci.lower 0.201 0.207 0.206
## rmsea.ci.upper 0.205 0.210 0.210
## aic 2812904.924 2818069.608 2813001.659
## bic 2813110.260 2818257.832 2813215.551
## bic2 2813033.988 2818187.916 2813136.100The two, three, and four factor models all fit badly and negative observed variances were part of that, but the sample is also very large. Including a performance rating measure (ERMY) leads to acceptable (>0.90) fit. I will be focusing on the sample size-adjusted measure SABIC (bic2 in lavaan). I may come back to this to do the whole thing with adjusted measures, but the result won't differ for the cutoffs, just the initial acceptability.
#EFA groups and plots
GMMLATS <- list(
F1 = c("G", "V", "N"),
F2 = c("K", "F", "M"),
F3 = c("P", "Q", "K"),
F4 = c("S", "P"))
GBFLATS <- list(
F1 = c("G", "V", "N"),
F2 = c("K", "F", "M"),
F3 = c("P", "Q", "K"))
semPaths(GATMM.fit, "model", "std", title = F, residuals = F, groups = "GMMLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = T)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(GATHOF.fit, "model", "std", title = F, residuals = F, groups = "GMMLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
semPaths(GATBF.fit, "model", "std", title = F, residuals = F, groups = "GBFLATS", pastel = T, mar = c(2, 1, 3, 1), layout = "tree2", bifactor = "g", exoCov = F)## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
## Warning in if (w <= 0) w <- 1e-07: the condition has length > 1 and only the
## first element will be used
Measurement Invariance
#Measurement model
GATMMC.fit <- cfa(GATMM.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = F)
GATMMM.fit <- cfa(GATMM.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = F, group.equal = "loadings")
GATMMS.fit <- cfa(GATMM.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = F, group.equal = c("loadings", "intercepts"))
GATMMF.fit <- cfa(GATMM.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
GATMMV.fit <- cfa(GATMM.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))
GATMMME.fit <- cfa(GATMM.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(GATMMC.fit, c(FITM, "bic2")),
METRIC = fitMeasures(GATMMM.fit, c(FITM, "bic2")),
SCALAR = fitMeasures(GATMMS.fit, c(FITM, "bic2")),
STRICT = fitMeasures(GATMMF.fit, c(FITM, "bic2")),
LVARS = fitMeasures(GATMMV.fit, c(FITM, "bic2")),
MEANS = fitMeasures(GATMMME.fit, c(FITM, "bic2"))),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 32873.082 33495.968 34287.901 34799.624 34799.624
## df 42.000 49.000 54.000 61.000 61.000
## npar 66.000 59.000 54.000 47.000 47.000
## cfi 0.862 0.860 0.856 0.854 0.854
## rmsea 0.202 0.189 0.182 0.172 0.172
## rmsea.ci.lower 0.200 0.187 0.180 0.171 0.171
## rmsea.ci.upper 0.204 0.190 0.183 0.174 0.174
## aic 2802280.549 2802889.436 2803671.368 2804169.092 2804169.092
## bic 2802845.222 2803394.220 2804133.374 2804571.207 2804571.207
## bic2 2802635.474 2803206.717 2803961.762 2804421.841 2804421.841
## MEANS
## chisq 42779.163
## df 65.000
## npar 43.000
## cfi 0.821
## rmsea 0.185
## rmsea.ci.lower 0.184
## rmsea.ci.upper 0.186
## aic 2812140.630
## bic 2812508.524
## bic2 2812371.870#Higher-order model
GATHOFC.fit <- cfa(GATHOF.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = F)
GATHOFM.fit <- cfa(GATHOF.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = F, group.equal = "loadings")## Warning in lav_object_post_check(object): lavaan WARNING: some estimated lv
## variances are negativeGATHOFS.fit <- cfa(GATHOF.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = F, group.equal = c("loadings", "intercepts"))## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING:
## The variance-covariance matrix of the estimated parameters (vcov)
## does not appear to be positive definite! The smallest eigenvalue
## (= 1.205063e-14) is close to zero. This may be a symptom that the
## model is not identified.
## Warning in lav_model_vcov(lavmodel = lavmodel, lavsamplestats = lavsamplestats, : lavaan WARNING: some estimated lv variances are negativeGATHOFF.fit <- cfa(GATHOF.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))## Warning in lav_object_post_check(object): lavaan WARNING: some estimated lv
## variances are negativeGATHOFV.fit <- cfa(GATHOF.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals"))## Warning in lav_object_post_check(object): lavaan WARNING: some estimated lv
## variances are negativeGATHOFME.fit <- cfa(GATHOF.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = F, group.equal = c("loadings", "intercepts", "residuals", "means"))## Warning in lav_object_post_check(object): lavaan WARNING: some estimated lv
## variances are negativeround(cbind(CONFIGURAL = fitMeasures(GATHOFC.fit, c(FITM, "bic2")),
METRIC = fitMeasures(GATHOFM.fit, c(FITM, "bic2")),
SCALAR = fitMeasures(GATHOFS.fit, c(FITM, "bic2")),
STRICT = fitMeasures(GATHOFF.fit, c(FITM, "bic2")),
LVARS = fitMeasures(GATHOFV.fit, c(FITM, "bic2")),
MEANS = fitMeasures(GATHOFME.fit, c(FITM, "bic2"))),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 38084.724 38758.083 39620.075 40131.374 40131.374
## df 46.000 56.000 60.000 67.000 67.000
## npar 62.000 52.000 48.000 41.000 41.000
## cfi 0.841 0.838 0.834 0.832 0.832
## rmsea 0.208 0.190 0.185 0.176 0.176
## rmsea.ci.lower 0.206 0.188 0.184 0.175 0.175
## rmsea.ci.upper 0.209 0.191 0.187 0.178 0.178
## aic 2807484.192 2808137.550 2808991.543 2809488.842 2809488.842
## bic 2808014.642 2808582.444 2809402.214 2809839.624 2809839.624
## bic2 2807817.606 2808417.188 2809249.670 2809709.326 2809709.326
## MEANS
## chisq 48060.223
## df 72.000
## npar 36.000
## cfi 0.799
## rmsea 0.186
## rmsea.ci.lower 0.185
## rmsea.ci.upper 0.188
## aic 2817407.691
## bic 2817715.694
## bic2 2817601.286#Bifactor model
GATBFC.fit <- cfa(GATBF.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = T)
GATBFM.fit <- cfa(GATBF.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = T, group.equal = "loadings")
GATBFS.fit <- cfa(GATBF.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = T, group.equal = c("loadings", "intercepts"))
GATBFF.fit <- cfa(GATBF.model, data = GATB, std.lv = F, group = "ETHGP", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
GATBFV.fit <- cfa(GATBF.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals"))
GATBFME.fit <- cfa(GATBF.model, data = GATB, std.lv = T, group = "ETHGP", orthogonal = T, group.equal = c("loadings", "intercepts", "residuals", "means"))
round(cbind(CONFIGURAL = fitMeasures(GATBFC.fit, c(FITM, "bic2")),
METRIC = fitMeasures(GATBFM.fit, c(FITM, "bic2")),
SCALAR = fitMeasures(GATBFS.fit, c(FITM, "bic2")),
STRICT = fitMeasures(GATBFF.fit, c(FITM, "bic2")),
LVARS = fitMeasures(GATBFV.fit, c(FITM, "bic2")),
MEANS = fitMeasures(GATBFME.fit, c(FITM, "bic2"))),3)## CONFIGURAL METRIC SCALAR STRICT LVARS
## chisq 32937.869 33743.523 34156.329 34547.857 34547.857
## df 40.000 54.000 59.000 66.000 66.000
## npar 68.000 54.000 49.000 42.000 42.000
## cfi 0.862 0.859 0.857 0.855 0.855
## rmsea 0.207 0.180 0.174 0.165 0.165
## rmsea.ci.lower 0.205 0.179 0.172 0.164 0.164
## rmsea.ci.upper 0.209 0.182 0.175 0.166 0.166
## aic 2802349.337 2803126.990 2803529.796 2803907.325 2803907.325
## bic 2802931.121 2803588.995 2803949.023 2804266.662 2804266.662
## bic2 2802715.017 2803417.383 2803793.301 2804133.186 2804133.186
## MEANS
## chisq 43470.247
## df 70.000
## npar 38.000
## cfi 0.818
## rmsea 0.180
## rmsea.ci.lower 0.178
## rmsea.ci.upper 0.181
## aic 2812821.715
## bic 2813146.830
## bic2 2813026.066In terms of cutoffs, the GATB could be considered measurement invariant, but the initial fit is wanting due to the massive sample size. Because of this the AIC/BIC will not be included in the aggregate plot, as they skew the entire thing.
Spearman's Hypothesis
The weak models are in the same sort of order as I've previously done them, so weak 1 is constrained F1, weak 2 is constrained F2, and so on. Because there were so many higher-order models and they fit worse anyway, I didn't assess Spearman's hypothesis for them.
round(cbind(LVAR = fitMeasures(GATBFV.fit, FITM),
STRONG = fitMeasures(GATBFVS.fit, FITM),
WEAK1 = fitMeasures(GATBFVW1.fit, FITM),
WEAK2 = fitMeasures(GATBFVW2.fit, FITM),
WEAK3 = fitMeasures(GATBFVW3.fit, FITM),
WEAK4 = fitMeasures(GATBFVW4.fit, FITM),
WEAK5 = fitMeasures(GATBFVW5.fit, FITM),
WEAK6 = fitMeasures(GATBFVW6.fit, FITM),
CONTRA1 = fitMeasures(GATBFVC1.fit, FITM),
CONTRA2 = fitMeasures(GATBFVC2.fit, FITM),
CONTRA3 = fitMeasures(GATBFVC3.fit, FITM),
CONTRA4 = fitMeasures(GATBFVC4.fit, FITM),
CONTRA5 = fitMeasures(GATBFVC5.fit, FITM),
CONTRA6 = fitMeasures(GATBFVC6.fit, FITM)),3)## LVAR STRONG WEAK1 WEAK2 WEAK3
## chisq 34547.857 38346.594 37809.186 34578.385 35050.586
## df 66.000 69.000 67.000 67.000 67.000
## npar 42.000 39.000 41.000 41.000 41.000
## cfi 0.855 0.840 0.842 0.855 0.853
## rmsea 0.165 0.170 0.171 0.164 0.165
## rmsea.ci.lower 0.164 0.169 0.170 0.162 0.163
## rmsea.ci.upper 0.166 0.171 0.173 0.165 0.166
## aic 2803907.325 2807700.061 2807166.653 2803935.853 2804408.053
## bic 2804266.662 2808033.732 2807517.435 2804286.634 2804758.835
## WEAK4 WEAK5 WEAK6 CONTRA1 CONTRA2
## chisq 37839.714 38311.915 35085.265 42932.839 39702.039
## df 68.000 68.000 68.000 68.000 68.000
## npar 40.000 40.000 40.000 40.000 40.000
## cfi 0.842 0.840 0.853 0.820 0.834
## rmsea 0.170 0.171 0.164 0.181 0.174
## rmsea.ci.lower 0.169 0.170 0.162 0.180 0.173
## rmsea.ci.upper 0.172 0.173 0.165 0.183 0.176
## aic 2807195.181 2807667.382 2804440.733 2812288.307 2809057.506
## bic 2807537.407 2808009.608 2804782.959 2812630.533 2809399.732
## CONTRA3 CONTRA4 CONTRA5 CONTRA6
## chisq 40174.240 42963.367 43435.568 40208.919
## df 68.000 69.000 69.000 69.000
## npar 40.000 39.000 39.000 39.000
## cfi 0.832 0.820 0.818 0.832
## rmsea 0.175 0.180 0.181 0.174
## rmsea.ci.lower 0.174 0.179 0.180 0.173
## rmsea.ci.upper 0.177 0.181 0.182 0.176
## aic 2809529.707 2812316.835 2812789.036 2809562.386
## bic 2809871.933 2812650.505 2813122.706 2809896.057round(cbind(LVAR = fitMeasures(GATBFV.fit, FITM),
STRONG = fitMeasures(GATBFVS.fit, FITM),
WEAK = fitMeasures(GATBFVW2.fit, FITM),
CONTRA = fitMeasures(GATBFVC2.fit, FITM)),3)## LVAR STRONG WEAK CONTRA
## chisq 34547.857 38346.594 34578.385 39702.039
## df 66.000 69.000 67.000 68.000
## npar 42.000 39.000 41.000 40.000
## cfi 0.855 0.840 0.855 0.834
## rmsea 0.165 0.170 0.164 0.174
## rmsea.ci.lower 0.164 0.169 0.162 0.173
## rmsea.ci.upper 0.166 0.171 0.165 0.176
## aic 2803907.325 2807700.061 2803935.853 2809057.506
## bic 2804266.662 2808033.732 2804286.634 2809399.732It seems that, of all the models, the latent variances model fits best, but of the Spearman's hypothesis models, the weak one fits best. Overall, the model fit is confusing.
Traditional Analyses
The proportion of the group differences attributable to g was 42.5% in the latent variances model and 50.7% in the selected weak model. The MCV relationships for g are \(r = 0.570, \rho = 0.883,\) and \(\phi = 0.831\); for the non-g loadings they are \(r = 0.346, \rho = 0.407,\) and \(\phi = 0.731\). Converting Hedge's g to the point-biserial correlation, \(\phi\) can be properly assessed and it turns out to be 0.857; for the non-g loadings it becomes 0.751.
MCVDFGAT <- data.frame("GL" = c(0.710, 0.434, 0.444, 1, 0.547, 0.353, 0.136, 0.312, 0.245),
"NGL" = c(0.704, 0.732, 0.766, 0, 0.568, 0.823, 0.469, 0, 0),
"diff" = c(1.111, 0.292, 0.383, 0.343, 0.270, 0.190, 0.047, 0.151, 0.121),
"VARS" = c("G", "V", "N", "S ", "P", "Q", "K", "F", "M"),
"GR" = c("DHE", "DHE", "DHE", "DHE", "DHE", "DHE", "DHE", "DHE", "DHE"))
cor(MCVDFGAT$GL, MCVDFGAT$diff, method = "pearson")## [1] 0.5702745cor(MCVDFGAT$GL, MCVDFGAT$diff, method = "spearman")## [1] 0.8833333CONGO(MCVDFGAT$GL, MCVDFGAT$diff)## [1] 0.8313502cor(MCVDFGAT$NGL, MCVDFGAT$diff, method = "pearson")## [1] 0.3456813cor(MCVDFGAT$NGL, MCVDFGAT$diff, method = "spearman")## [1] 0.4068381CONGO(MCVDFGAT$NGL, MCVDFGAT$diff)## [1] 0.7310262MCVDFGAT$RPBS <- RPBS(MCVDFGAT$diff)
CONGO(MCVDFGAT$RPBS, MCVDFGAT$GL)## [1] 0.8567792MCVDFGAT %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = GL, color = "g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = GL, color = "g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#E865C9", "#4E84C4")) +
labs(y = "g Loading", x = "Variables", color = "Parameter", title = "Spearman's Hypothesis in McDaniel's GATB Dataset") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
MCVDFGAT %>% arrange(RPBS) %>% mutate(VARS=factor(VARS, levels = VARS)) %>% ggplot(aes(x = VARS)) +
geom_line(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_line(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
geom_point(aes(y = NGL, color = "Non-g Loading", group = GR)) + geom_point(aes(y = RPBS, color = "Point-Biserial", group = GR)) +
scale_y_continuous(sec.axis = sec_axis(~.*1, name = "Point-Biserial")) +
scale_color_manual(values = c("#E865C9", "#4E84C4")) +
labs(y = "Non-g Loading", x = "Variables", color = "Parameter", title = "Contra-Spearman's Hypothesis in McDaniel's GATB Dataset") + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5), axis.title.x = element_blank(), legend.position = c(0.15, 0.85), legend.background = element_blank())
ggplot(MCVDFGAT, aes(GL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#E865C9", size = 2) + labs(y = "Hedge's g", x = "g Loading", title = "Spearman's Hypothesis in McDaniel's GATB Dataset") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(MCVDFGAT, aes(NGL, diff)) + geom_smooth(method = "lm", color = "#4E84C4", size = 1.5) + geom_point(color = "#E865C9", size = 2) + labs(y = "Hedge's g", x = "Non-g Loading", title = "Contra-Spearman's Hypothesis in McDaniel's GATB Dataset") + theme_bw() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
The results are to some degree artefactual for this battery because of the negative residuals, which led to, for example, worse fit and an inflated g loading for the S subtest when corrected.
Lasker (Project Talent)
- Upload later, maybe as a separate project?
Honorable Mentions
- Meta-SEM (Lasker, ISIR 2019)
- Cockroft et al. reanalysis
- Gygi, Fux & Grob reanalysis
- Schmid-Leiman breakdown of the numerous higher-order invariance studies (WJ, K-ABC, etc.), plot results just MI
Aggregate Results
Measurement Invariance
AIC/BIC Plots
Weights
ggplot(dm, aes(x = Model, y = AWE, fill = LM)) + geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7, show.legend = T) + coord_cartesian(ylim = c(0, 1)) + xlab('Level of Invariance') + ylab('Akaike Probability') + scale_fill_hue(name = "Study", breaks = c("FB", "D00", "DHE", "WJI", "WJII", "WJIII", "VES"), labels = c("Frisby & Beaujean", "Dolan", "Dolan & Hamaker", "Woodcock-Johnson-I", "Woodcock-Johnson-R", "Woodcock-Johnson-III", "Vietnam Experience Study"), c = 40) + theme_bw() + theme(text = element_text(size = 12, family = "serif"), legend.position = c(0.60, 0.75), legend.background = element_blank())
ggplot(dm, aes(x = Model, y = BWE, fill = LM)) + geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7, show.legend = T) + coord_cartesian(ylim = c(0, 1)) + xlab('Level of Invariance') + ylab('Schwarz Probability') + scale_fill_hue(name = "Study", breaks = c("FB", "D00", "DHE", "WJI", "WJII", "WJIII", "VES"), labels = c("Frisby & Beaujean", "Dolan", "Dolan & Hamaker", "Woodcock-Johnson-I", "Woodcock-Johnson-R", "Woodcock-Johnson-III", "Vietnam Experience Study"), c = 40) + theme_bw() + theme(text = element_text(size = 12, family = "serif"), legend.position = c(0.15, 0.75), legend.background = element_blank())
Absolute
ggplot(dm, aes(x = Model, y = AIC, group = LM, shape = LM, color = LM)) + geom_line(size = 1) + geom_point() + xlab('Level of Invariance') + ylab('Akaike Information Criterion') + scale_colour_discrete(name = "Study", breaks = c("FB", "D00", "DHE", "WJI", "WJII", "WJIII", "VES"), labels = c("Frisby & Beaujean", "Dolan", "Dolan & Hamaker", "Woodcock-Johnson-I", "Woodcock-Johnson-R", "Woodcock-Johnson-III", "Vietnam Experience Study"), c = 50) + scale_shape_discrete(name = "Study", breaks = c("FB", "D00", "DHE", "WJI", "WJII", "WJIII", "VES"), labels = c("Frisby & Beaujean", "Dolan", "Dolan & Hamaker", "Woodcock-Johnson-I", "Woodcock-Johnson-R", "Woodcock-Johnson-III", "Vietnam Experience Study")) + theme_bw() + theme(text = element_text(size = 12, family = "serif"), legend.position = c(0.15, 0.75), legend.background = element_blank())## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 7. Consider
## specifying shapes manually if you must have them.## Warning: Removed 4 rows containing missing values (geom_point).
ggplot(dm, aes(x = Model, y = BIC, group = LM, shape = LM, color = LM)) + geom_line(size = 1) + geom_point() + xlab('Level of Invariance') + ylab('Bayesian Information Criterion') + scale_colour_discrete(name = "Study", breaks = c("FB", "D00", "DHE", "WJI", "WJII", "WJIII", "VES"), labels = c("Frisby & Beaujean", "Dolan", "Dolan & Hamaker", "Woodcock-Johnson-I", "Woodcock-Johnson-R", "Woodcock-Johnson-III", "Vietnam Experience Study"), c = 50) + scale_shape_discrete(name = "Study", breaks = c("FB", "D00", "DHE", "WJI", "WJII", "WJIII", "VES"), labels = c("Frisby & Beaujean", "Dolan", "Dolan & Hamaker", "Woodcock-Johnson-I", "Woodcock-Johnson-R", "Woodcock-Johnson-III", "Vietnam Experience Study")) + theme_bw() + theme(text = element_text(size = 12, family = "serif"), legend.position = c(0.15, 0.25), legend.background = element_blank())## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 7. Consider
## specifying shapes manually if you must have them.
## Warning: Removed 4 rows containing missing values (geom_point).
BIC is obviously better for selecting among these models because it's intended for picking among them rather than from a universe of models. The general format of the plot is interesting, with later stages of invariance yielding better information theoretic fits (BIC; mixed, AIC). The WJ AIC results are consistent with simply badly defined group factors and can be remedied with additional specification, but that's unnecessary based on the other indices and the lack of any meaningful effect size from potential metric or scalar differences (I've discussed this elsewhere).
Spearman's Hypothesis
AIC/BIC Plots
Weights
- Do later, confirms weak
Absolute
- Same
MCV
SHD$RPBS <- RPBS(SHD$diff)
cor(SHD$g, SHD$diff, method = "pearson")## [1] 0.6768505cor(SHD$g, SHD$diff, method = "spearman")## [1] 0.6800827CONGO(SHD$g, SHD$diff)## [1] 0.9544902CONGO(SHD$g, SHD$RPBS)## [1] 0.9616502lm(g ~ diff, data = SHD)##
## Call:
## lm(formula = g ~ diff, data = SHD)
##
## Coefficients:
## (Intercept) diff
## 0.3285 0.3870cor(SHD$nong, SHD$diff, method = "pearson")## [1] -0.1355781cor(SHD$nong, SHD$diff, method = "spearman")## [1] -0.107062CONGO(SHD$nong, SHD$diff)## [1] 0.772849CONGO(SHD$nong, SHD$RPBS)## [1] 0.7823746lm(nong ~ diff, data = SHD)##
## Call:
## lm(formula = nong ~ diff, data = SHD)
##
## Coefficients:
## (Intercept) diff
## 0.4430 -0.1024cor(SHD$nongweak, SHD$diff, method = "pearson")## [1] 0.109261cor(SHD$nongweak, SHD$diff, method = "spearman")## [1] 0.1528134CONGO(SHD$nongweak, SHD$diff)## [1] 0.6411243CONGO(SHD$nongweak, SHD$RPBS)## [1] 0.6439037lm(nongweak ~ diff, data = SHD)##
## Call:
## lm(formula = nongweak ~ diff, data = SHD)
##
## Coefficients:
## (Intercept) diff
## 0.15363 0.09378averages(SHD$gprop, type = "arithmetic")## arithmetic
## 0.6229434averages(SHD$gpropweak, type = "arithmetic")## arithmetic
## 0.7861447ggplot(SHD, aes(x = g, y = diff)) + geom_point() + geom_smooth(method = lm, color = "gold")+ labs(title = "Spearman's Hypothesis for Invariant Tests", x = "g Loading", y = "Hedge's g") + theme_minimal() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(SHD, aes(x = nong, y = diff)) + geom_point() + geom_smooth(method = lm, color = "orange")+ labs(title = "Contra Spearman's Hypothesis for Invariant Tests (Full)", x = "Non-g Loading", y = "Hedge's g") + theme_minimal() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(SHD, aes(x = nongweak, y = diff)) + geom_point() + geom_smooth(method = lm, color = "lightgreen")+ labs(title = "Contra Spearman's Hypothesis for Invariant Tests (Weak)", x = "Non-g Loading", y = "Hedge's g") + theme_minimal() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Proportions
dp <- data.frame("gpf" = c(.605, .519, .608, NA, NA, NA, .659, .685, .593, .425, .610, .697), "gpw" = c(.688, .703, .730, .679, 1, .756, .752, .787, .734, .507, .819, .749), "Study" = c("Dolan (2000)", "Dolan & Hamaker (2001)", "Frisby & Beaujean (2015)", "Hu et al. (2019)", "Lasker et al. (PING)", "Lasker et al. (PNC)", "Lasker et al. (WJ-I)", "Lasker et al. (WJ-R)", "Lasker et al. (WJ-III)", "Lasker & Kirkegaard (GATB)", "Lasker, Nyborg & Kirkegaard (VES)", "Lasker, Nyborg & Kirkegaard (NLSY79)"))
dp$Study <- factor(dp$Study, levels = c("Lasker, Nyborg & Kirkegaard (NLSY79)", "Lasker, Nyborg & Kirkegaard (VES)", "Lasker & Kirkegaard (GATB)", "Lasker et al. (WJ-III)", "Lasker et al. (WJ-R)", "Lasker et al. (WJ-I)", "Lasker et al. (PNC)", "Lasker et al. (PING)", "Hu et al. (2019)", "Frisby & Beaujean (2015)", "Dolan & Hamaker (2001)", "Dolan (2000)"))
ggplot(dp, aes(x = Study, y = gpf, fill = Study)) + geom_bar(stat = "identity", show.legend = F) + labs(title = "Spearman's Hypothesis (Full)", x = "", y = "Proportion of Differences Due to g") + theme_minimal() + scale_fill_hue(c = 30) + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5)) + ylim(0, 1) + coord_flip()## Warning: Removed 3 rows containing missing values (position_stack).
ggplot(dp, aes(x = Study, y = gpw, fill = Study)) + geom_bar(stat = "identity", show.legend = F) + labs(title = "Spearman's Hypothesis (Weak)", x = "", y = "Proportion of Differences Due to g") + theme_minimal() + scale_fill_hue(c = 30) + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5)) + ylim(0, 1) + coord_flip()
g Means
The formula for composite scores is
\[FSIQ = \frac{\sum_{i=1}^{k}(X_i)-100k}{\sqrt{\sum_{i=1}^{k}\sum_{j=1}^{k}(r_{ij})}}\]
with \(k\) scores \(X_1, X_2, ... X_n\) and where \(r_{ij}\) is the correlation between tests \(i\) and \(j\); the composite reliability is
\[R_i = \frac{\sum_{i=1}^{k}\sum_{j=1}^{k}(r_{ij})-k+\sum_{i=1}^{k}(r_i)}{\sum_{i=1}^{k}\sum_{j=1}^{k}(r_{ij})}\]
But this formula is rarely used than the arithmetic mean, unfortunately. Using the proper formula leads to an aggregate difference averaging between 0.9 and 1.1 (some more, some less) and no trend. Similarly, using the optimal weights formula of
\[FSIQ = (\lambda_{t_1} * X_1) + (\lambda_{t_2} * X_2) + ... (\lambda_{t_n} * X_n)\]
where \(\lambda_{t_n}\) is the aggregate loading (there's usually just one, but for multiple, use the summary formula above) on common factors for indicator \(X\) there's a basically equivalent 0.9 to 1.1, with examples outside the range generally being selected on the basis of scores or correlates of scores which attenuate or augment the difference. To example the difference between the improper sumscore method (averaging) and optimal weights, factor scores, or computing composites, in Frisby & Beaujean (2015), the difference is 16.8 fullscale IQ points, but simply averaging the values for Hedge's g, it comes out to 0.714, when it's really ~1.12! These results will all, obviously, be highly-correlated, but high correlations do not imply the same conclusions so much as they suggest them.
What's more, if we want to assess changes in scores or score gaps over time and the weights for indicators in common between time points change, we can end up with an incorrect conclusion by failing to account for changes in psychometric properties. The Wechsler tests, for instance, have become slightly less g loaded over time and they've begun to include new tests with lower g loadings. The WISC-V Assessment and Interpretation book (Weiss et al., 2015, p. 160) contained this remark:
In the early part of the last century, Spearman hypothesized that group differences in IQ test scores could be explained by innate differences in g between the races, and this position continues to rear its ugly head 70 years later. Some will likely follow this antiquated line of reasoning and argue that the AA FSIQ was increased in WISC-IV and WISC-V by increasing the contribution of cognitively less complex subtests with lower g loadings (e.g., Coding and Symbol Search) in the FSIQ, and they could be correct insofar as psychometric studies of g are concerned.
They go on to suggest this is due to cultural confounding despite measurement invariance being routinely attained and a role for culture being unclear, if not, truly, unstudied in a meaningful sense. Before going on, I will note that they badly presented Spearman's remarks, presumably because they had not actually read him. In order to quickly remedy this, I'll quote Spearman (1927, pp. 379-380) so he gets a fair hearing rather than heedless indictment:
A much easier task [than comparing European ethnic groups] would seem to be the comparing of the white races with the coloured. For no great difficulty is said to attend the selecting of samples of persons wherein the two are in respect of education approximately equal.
As typical of the research done along this path may be taken that of S. L. Pressey and Teter, who applied ten tests to 120 coloured American children of ages 10-14 and compared the results with those obtained from 2,000 white American children. On the average of all the tests, the coloured were about two years behind the white; their inferiority extended through all ten tests, but it was most marked in just those which are known to be most saturated with g. Similar results ensued on comparing white with coloured college students, as was done by Derrick. And soon afterwards, an investigation of Arlitt not only confirmed the older results, but contributed the interesting addition that the superiority of the whites only begins after the fifth or six year of life.
On the other hand, however, the objection has been raised that, although the coloured and the white children may have been equal in respect of the education received at school, they may still have been very unequal in respect of that received at home and in social intercourse.
There has also been comparison attempted between many other coloured races, including especially Chinese, Japanese, Red Indians, and Hindoos. To quote the resultso btained would exceed our present limits. But certainly the conclusion to be drawn as regards the influency of heredity are even less decisive here than in the cases considered above.
On the whole, there has been foudn a large body of evidence that races do differ from one another, at any rate in respect of g. And there have been some indications - as yet hardly decisive - that such differences persist even when the members of the respective races are living in the same environment, educational and otherwise; to this extent, then, the cause would appear fairly traceable to inheritance. Nevertheless, such racial differences, even if truly existing, are indubitably very small as compared with those that exist between individuals belonging to one and the same race. Proof of the influence of heredity in the former case can then, after all, carry us but a small way towards estimating its scope in the latter.
Departing from this discussion and back to my main point, the degree to which a test is saturated with g should - by Wilks' theorem - also associate with the size of the observed difference if Spearman's hypothesis is true; the corollary that less g saturated tests should have smaller gaps is also true. If recent composites are, in fact, composed from less g loaded subtests, then it should be expected that they would show smaller gaps, even if no change in underlying abilities occurred. The truth of this statement is another reason to emphasize work with proper psychometric modeling and attention to invariance and psychometric properties of assessments. Although I've already plotted the subtest-level MCV result, I'll plot the aggregate one for averages here as well (it's trivial to see that the sumscore/optimal weight one is practically equivalently strong).
dag <- data.frame("gl" = c(.580, .546, .480, .465, .617, .618, .555, .597, .735), "gp" = c(.635, .605, .518, .420, .695, .729, .600, .652, .724), "ngl" = c(.375, .356, .446, .628, .319, .285, .381, .382, .319), "diff" = c(.714, .703, .408, .323, .782, .620, .488, .822, 1.019))
dag$RPBS <- RPBS(dag$diff)
cor(dag$gl, dag$diff, method = "pearson")## [1] 0.9070244cor(dag$gl, dag$diff, method = "spearman")## [1] 0.7833333CONGO(dag$gl, dag$diff)## [1] 0.9811214CONGO(dag$gl, dag$RPBS)## [1] 0.9853107lm(gl ~ diff, data = dag)##
## Call:
## lm(formula = gl ~ diff, data = dag)
##
## Coefficients:
## (Intercept) diff
## 0.3585 0.3345cor(dag$ngl, dag$diff, method = "pearson")## [1] -0.7120878cor(dag$ngl, dag$diff, method = "spearman")## [1] -0.5355695CONGO(dag$ngl, dag$diff)## [1] 0.874549CONGO(dag$ngl, dag$RPBS)## [1] 0.8845035lm(ngl ~ diff, data = dag)##
## Call:
## lm(formula = ngl ~ diff, data = dag)
##
## Coefficients:
## (Intercept) diff
## 0.6037 -0.3304cor(dag$gp, dag$diff, method = "pearson")## [1] 0.8200308cor(dag$gp, dag$diff, method = "spearman")## [1] 0.7333333CONGO(dag$gp, dag$diff)## [1] 0.9799535CONGO(dag$gp, dag$RPBS)## [1] 0.9848346lm(gp ~ diff, data = dag)##
## Call:
## lm(formula = gp ~ diff, data = dag)
##
## Coefficients:
## (Intercept) diff
## 0.3739 0.3764averages(dag$gl, type = "arithmetic")## arithmetic
## 0.577averages(dag$gp, type = "arithmetic")## arithmetic
## 0.6197778averages(dag$ngl, type = "arithmetic")## arithmetic
## 0.3878889averages(dag$diff, type = "arithmetic")## arithmetic
## 0.6532222ggplot(dag, aes(x = gl, y = diff)) + geom_point() + geom_smooth(method = lm, color = "gold")+ labs(title = "Spearman's Hypothesis for Test Averages", x = "Mean g Loading", y = "Mean Hedge's g") + theme_minimal() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(dag, aes(x = gp, y = diff)) + geom_point() + geom_smooth(method = lm, color = "orange")+ labs(title = "Spearman's Hypothesis for Test Averages", x = "Mean Proportion of Differences Attributable to g", y = "Mean Hedge's g") + theme_minimal() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
ggplot(dag, aes(x = ngl, y = diff)) + geom_point() + geom_smooth(method = lm, color = "blue")+ labs(title = "Contra Spearman's Hypothesis for Test Averages", x = "Mean Non-g Loading", y = "Mean Hedge's g") + theme_minimal() + theme(text = element_text(size = 12, family = "serif"), plot.title = element_text(hjust = 0.5))## `geom_smooth()` using formula 'y ~ x'
Rounding introduced some error. I may come back and correct it and use proper scores later, but the total result is unaltered.
- Do later, all around ~1d and no trend (with other tests)
- Check correlation with g proportion
- Check correlation of sumscore with g proportion (VES, NLSY, WJI, WJIR, WJIII, GATB; should be negative? use Frisby & Beaujean sum from earlier; use full g props, composites for Dolan/Dolan & Hamaker)
Conclusion
Measurement invariance is tenable for the black-white differences in the US, so the differences between these groups are explained by the same factors explaining them within these groups. The general factor seems to dominate as an explanation for the group differences, but that's not clearly the case with the standard types of analyses which relied on vector comparisons. This is but one reason not to use MCV as a means of testing Spearman's hypothesis since it simply cannot test it with determinacy barring as yet unseen modifications. A noteworthy recent paper found that there was bias for the SAT, so there's still a need to assess and work on test bias research.
To-Do
- Redo WJ with age/sex residualization (code in place; need to assess and adjust for nonlinearities).
- Note and adjust/weight for sample demographics versus national with normative data (background variables for age, SES, etc.)
- Redo with imputation, age stratification (will increase sample size)
- MFA/MNLFA/LSEM age
- Refit models for AIC/BIC
- Network model comparisons
- Assess invariance for network when method emerges
- Change Rpbs "properly" remark to be accurate since it's a conversion
- Make loading tables by study (like Eysenck, Carroll)
- Compute \(\omega_h\) and other metrics by study (already done, just table it)
- Replace plot legends with labels
References
Dolan, C. V. (2000). Investigating Spearman's Hypothesis by Means of Multi-Group Confirmatory Factor Analysis. Multivariate Behavioral Research, 35(1), 21-50. https://doi.org/10.1207/S15327906MBR3501_2
Jensen, A. R., & Reynolds, C. R. (1982). Race, social class and ability patterns on the WISC-R. Personality and Individual Differences, 3(4), 423-438. https://doi.org/10.1016/0191-8869(82)90007-1
Reynolds, C. R., & Jensen, A. R. (1983). WISC-R subscale patterns of abilities of Blacks and Whites matched on Full Scale IQ. Journal of Educational Psychology, 75(2), 207-214. https://doi.org/10.1037/0022-0663.75.2.207
Frisby, C. L., & Beaujean, A. A. (2015). Testing Spearman's hypotheses using a bi-factor model with WAIS-IV/WMS-IV standardization data. Intelligence, 51, 79-97. https://doi.org/10.1016/j.intell.2015.04.007
Hood, S. B. (2010). Latent Variable Realism in Psychometrics. https://scholarworks.iu.edu/dspace/handle/2022/8120
O'Grady, K. E. (1989). Factor Structure of the WISC-R. Multivariate Behavioral Research, 24(2), 177-193. https://doi.org/10.1207/s15327906mbr2402_3
Dolan, C. V., & Hamaker, E. L. (2001). Investigating Black-White differences in psychometric IQ: Multi-group confirmatory factor analyses of the WISC-R and K-ABC and a critique of the method of correlated vectors. In Advances in psychology research, Vol. 6. (pp. 31-59). Nova Science Publishers.
Naglieri, J. A., & Jensen, A. R. (1987). Comparison of black-white differences on the WISC-R and the K-ABC: Spearman's hypothesis. Intelligence, 11(1), 21-43. https://doi.org/10.1016/0160-2896(87)90024-9
Weiss, L. G., Saklofske, D. H., Holdnack, J. A., & Prifitera, A. (2015). WISC-V Assessment and Interpretation: Scientist-Practitioner Perspectives (1st edition). Academic Press.
Spearman, C. (1927). The abilities of man. Macmillan.
Malloy, J. (2013, May 26). The Onset and Development of B-W Ability Differences: Early Infancy to Age 3 (Part 1). Human Varieties. https://humanvarieties.org/2013/05/26/the-onset-and-development-of-b-w-ability-differences-early-infancy-to-age-3-part-1/