Social regulation of emotions - confirmatory analyses
Ivan Ropovik
2017-09-27
Path models
Confirmatory model 2 COTouch
path.model <- 'PriBC ~ a*ZCommunalStrength
reflection ~ b*PriBC + c*TargetSharingSplit + d*CloseOthersTouchTest + e*ZCommunalStrength
rumination ~ f*ZCommunalStrength + g*CloseOthersTouchTest + h*int_COT_CS
stress ~ i*reflection + j*rumination
health ~ k*stress
reflection ~~ l*rumination
TargetSharingSplit ~~ m*CloseOthersTouchTest
TargetSharingSplit ~~ 0*ZCommunalStrength
CloseOthersTouchTest ~~ ZCommunalStrength
CloseOthersTouchTest ~~ int_COT_CS
int_COT_CS ~~ ZCommunalStrength
'fit.path.model <- sem(path.model, data = cfdat, se = "bootstrap", bootstrap = nboot, mimic = "Mplus", missing = "ML")Model test and approximate fit indices
fitmeasures(fit.path.model, c("chisq", "df", "pvalue", "cfi", "tli", "rmsea", "rmsea.ci.lower", "rmsea.ci.upper", "srmr_mplus", "pnfi", "bic"))## chisq df pvalue cfi tli
## 56.139 20.000 0.000 0.937 0.887
## rmsea rmsea.ci.lower rmsea.ci.upper pnfi bic
## 0.065 0.045 0.085 0.504 9526.845The model does not fit the data exactly. The approximate fit to the data is not terrible, but is not good either. Any interpretations of individual parameter estimates has to be made with great caution, since the true values may differ by hundredths and occasionaly even +/- one tenth.
Modification indices
modificationindices(fit.path.model, alpha = .05, sort. = TRUE, maximum.number = 8)## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 68 PriBC ~ stress 15.520 0.156 0.156 0.196 0.196
## 79 rumination ~ stress 13.143 -2.880 -2.880 -1.625 -1.625
## 74 reflection ~ stress 11.260 -0.939 -0.939 -0.708 -0.708
## 50 rumination ~~ stress 10.871 -0.927 -0.927 -0.951 -0.951
## 97 ZCommunalStrength ~ rumination 10.868 -1.778 -1.778 -2.348 -2.348
## 82 stress ~ PriBC 10.352 0.154 0.154 0.122 0.122
## 38 PriBC ~~ stress 9.951 0.052 0.052 0.119 0.119
## 44 reflection ~~ stress 9.691 -0.295 -0.295 -0.403 -0.403The modification indices suggest some weird changes like that stress should predict PriBC, rumination, or reflection. Seems to be caused by chance variation.
Parameter estimates, standard errors, p-values, CI’s, \(R^2\)
parameterEstimates(fit.path.model, rsquare = TRUE)[1:13,]## lhs op rhs label est se z
## 1 PriBC ~ ZCommunalStrength a 0.054 0.036 1.511
## 2 reflection ~ PriBC b 0.204 0.070 2.903
## 3 reflection ~ TargetSharingSplit c 0.053 0.050 1.064
## 4 reflection ~ CloseOthersTouchTest d 0.097 0.046 2.082
## 5 reflection ~ ZCommunalStrength e 0.185 0.059 3.138
## 6 rumination ~ ZCommunalStrength f -0.181 0.084 -2.167
## 7 rumination ~ CloseOthersTouchTest g -0.085 0.063 -1.358
## 8 rumination ~ int_COT_CS h -0.070 0.061 -1.143
## 9 stress ~ reflection i -0.190 0.039 -4.859
## 10 stress ~ rumination j 0.252 0.027 9.496
## 11 health ~ stress k 0.649 0.064 10.176
## 12 reflection ~~ rumination l -0.670 0.060 -11.090
## 13 TargetSharingSplit ~~ CloseOthersTouchTest m 0.134 0.039 3.456
## pvalue ci.lower ci.upper
## 1 0.131 -0.014 0.130
## 2 0.004 0.071 0.348
## 3 0.287 -0.050 0.152
## 4 0.037 0.006 0.193
## 5 0.002 0.079 0.306
## 6 0.030 -0.345 -0.016
## 7 0.174 -0.209 0.033
## 8 0.253 -0.185 0.054
## 9 0.000 -0.262 -0.108
## 10 0.000 0.199 0.304
## 11 0.000 0.519 0.769
## 12 0.000 -0.785 -0.547
## 13 0.001 0.059 0.213Overall, the model estimates are quite similar to the exploratory-data-based model. However, the effect of the interaction vanished (dropped by .009). Does not seem to be very robust. When the effects are feeble/too variable (like this one was, based on exploratory data), they easily fell prey to chance variation.
Bivariate correlations
lavCor(fit.path.model)## PriBC rflctn rumntn stress health ZCmmnS TrgtSS
## PriBC 1.000
## reflection 0.080 1.000
## rumination 0.096 -0.554 1.000
## stress 0.142 -0.499 0.587 1.000
## health -0.036 -0.325 0.352 0.470 1.000
## ZCommunalStrength 0.097 0.225 -0.155 -0.092 -0.119 1.000
## TargetSharingSplit -0.007 0.107 -0.094 0.030 -0.075 0.000 1.000
## CloseOthersTouchTest -0.008 0.141 -0.097 -0.095 -0.083 0.215 0.159
## int_COT_CS 0.050 0.155 -0.131 -0.124 -0.047 -0.091 0.000
## ClsOTT i_COT_
## PriBC
## reflection
## rumination
## stress
## health
## ZCommunalStrength
## TargetSharingSplit
## CloseOthersTouchTest 1.000
## int_COT_CS 0.128 1.000Power analysis
For approximate fit (based on the RMSEA distribution). Statistical power for the detection of a likely misspecified model (RMSEA > .08).
df <- fit.path.model@test[[1]]$df
alpha <- .05
n <- nrow(cfdat)
rmsea0 <- .05 # RMSEA given H0
rmseaa <- .08 # RMSEA given Ha
ncp0 <- (n-1)*df*rmsea0**2 ;
ncpa <-(n-1)*df*rmseaa**2 ;
if(rmsea0 < rmseaa) {
cval <- qchisq(1-alpha,df=df,ncp=ncp0)
pwr.rmsea <- 1 - pchisq(cval,df=df,ncp=ncpa)
} else {
cval <- qchisq(alpha,df=df,ncp=ncp0)
pwr.rmsea <- pchisq(cval,df=df,ncp=ncpa)
}
rm(ncp0, ncpa, cval)
print(round(pwr.rmsea,10))## [1] 0.8003669Path model
semPaths(fit.path.model, layout = "tree2", rotation = 2, nDigits = 2, "Standardized", intercepts = FALSE, residuals = FALSE,
fade = FALSE, nCharNodes = 0, sizeMan = 9, edge.label.cex = .9, edge.label.position = .45, curvature = 3)
Bayes factor in favor of the alternative hypothesis (BF10) and posterior probability for model parameters (given 1:1 prior odds for H0:Ha)
These are Bayes Factors based on model selection / information criteria approach as proposed by Wagenmakers, 2007. Each BF represents the relative evidence in the data favoring alternative hypothesis (parameter freely estimated) over the null (the given parameter fixed to 0). Bayes Factors using BIC approximation implicitly assume unit information prior which makes them rather conservative with regard to the alternative hypothesis.
f <- NULL
bf <- NULL
posterior <- NULL
for(i in letters[1:13]){
f <- sem(path.model, data = cfdat, mimic = "Mplus", missing = "ML")
bf[i] <- 1/(exp((BIC(f) - BIC(sem(path.model, data = cfdat, mimic = "Mplus", missing = "ML",
constraints = paste(i, '==', '0', sep = ""))))/2))
posterior[i] <- bf[i]/(1+bf[i])
}
data.frame(BF10 = bf, Posterior = round(posterior, 3))## BF10 Posterior
## a 1.963403e-01 0.164
## b 5.809815e+00 0.853
## c 9.458092e-02 0.086
## d 3.890751e-01 0.280
## e 1.195542e+01 0.923
## f 8.025302e-01 0.445
## g 1.146113e-01 0.103
## h 8.688074e-02 0.080
## i 1.377039e+05 1.000
## j 1.044854e+18 1.000
## k 1.513493e+22 1.000
## l 3.318291e+30 1.000
## m 1.019364e+01 0.911Confirmatory model 1
path.model1 <- 'PriBC ~ a*ZCommunalStrength
reflection ~ b*PriBC + c*TargetSharingSplit + d*CloseOthersTouchTest + e*ZCommunalStrength
stress ~ f*reflection
health ~ g*stress
CloseOthersTouchTest ~~ h*TargetSharingSplit
TargetSharingSplit ~~ 0*ZCommunalStrength
'
fit.path.model1 <- sem(path.model1, data = cfdat, se = "bootstrap", bootstrap = nboot, mimic = "Mplus", missing = "ML")Model test and approximate fit indices
fitmeasures(fit.path.model1, c("chisq", "df", "pvalue", "cfi", "tli", "rmsea", "rmsea.ci.lower", "rmsea.ci.upper", "srmr_mplus", "pnfi", "bic"))## chisq df pvalue cfi tli
## 53.692 13.000 0.000 0.868 0.787
## rmsea rmsea.ci.lower rmsea.ci.upper pnfi bic
## 0.085 0.062 0.109 0.518 7331.498This one’s not fitting well either. Parameter estimates should be interpreted with great caution, if at all.
Modification indices
modificationindices(fit.path.model1, alpha = .05, sort. = TRUE, maximum.number = 8)## lhs op rhs mi epc sepc.lv
## 50 stress ~ PriBC 19.345 0.231 0.231
## 44 PriBC ~ stress 19.250 0.192 0.192
## 25 PriBC ~~ stress 19.083 0.079 0.079
## 42 ZCommunalStrength ~~ CloseOthersTouchTest 13.710 0.200 0.200
## 76 CloseOthersTouchTest ~ ZCommunalStrength 13.710 0.200 0.200
## 65 ZCommunalStrength ~ CloseOthersTouchTest 13.346 0.200 0.200
## 73 CloseOthersTouchTest ~ reflection 11.264 0.817 0.817
## 51 stress ~ health 6.157 -0.170 -0.170
## sepc.all sepc.nox
## 50 0.184 0.184
## 44 0.241 0.241
## 25 0.182 0.182
## 42 0.200 0.200
## 76 0.200 0.200
## 65 0.200 0.200
## 73 0.799 0.799
## 51 -0.235 -0.235Again, the data suggest a link between PriBC and stress.
Parameter estimates, standard errors, p-values, CI’s, \(R^2\)
parameterEstimates(fit.path.model1, rsquare = TRUE, standardized = TRUE)[1:8,]## lhs op rhs label est se z
## 1 PriBC ~ ZCommunalStrength a 0.059 0.036 1.659
## 2 reflection ~ PriBC b 0.101 0.086 1.176
## 3 reflection ~ TargetSharingSplit c 0.106 0.056 1.884
## 4 reflection ~ CloseOthersTouchTest d 0.093 0.047 1.996
## 5 reflection ~ ZCommunalStrength e 0.204 0.061 3.359
## 6 stress ~ reflection f -0.378 0.032 -11.853
## 7 health ~ stress g 0.649 0.063 10.241
## 8 TargetSharingSplit ~~ CloseOthersTouchTest h 0.136 0.039 3.523
## pvalue ci.lower ci.upper std.lv std.all std.nox
## 1 0.097 -0.007 0.137 0.059 0.100 0.100
## 2 0.240 -0.065 0.267 0.101 0.061 0.061
## 3 0.060 0.001 0.220 0.106 0.093 0.093
## 4 0.046 0.006 0.185 0.093 0.095 0.095
## 5 0.001 0.091 0.326 0.204 0.209 0.209
## 6 0.000 -0.435 -0.312 -0.378 -0.498 -0.498
## 7 0.000 0.524 0.771 0.649 0.470 0.470
## 8 0.000 0.059 0.214 0.136 0.159 0.159Bivariate correlations
lavCor(fit.path.model1)## PriBC rflctn stress health ZCmmnS TrgtSS ClsOTT
## PriBC 1.000
## reflection 0.080 1.000
## stress 0.142 -0.499 1.000
## health -0.036 -0.325 0.470 1.000
## ZCommunalStrength 0.097 0.225 -0.092 -0.119 1.000
## TargetSharingSplit -0.007 0.107 0.030 -0.075 0.000 1.000
## CloseOthersTouchTest -0.008 0.141 -0.095 -0.083 0.215 0.159 1.000Power analysis
For approximate fit (based on the RMSEA distribution). Statistical power for the detection of a likely misspecified model (RMSEA > .08).
df <- fit.path.model1@test[[1]]$df
alpha <- .05
n <- nrow(cfdat)
rmsea0 <- .05 # RMSEA given H0
rmseaa <- .08 # RMSEA given Ha
ncp0 <- (n-1)*df*rmsea0**2 ;
ncpa <-(n-1)*df*rmseaa**2 ;
if(rmsea0 < rmseaa) {
cval <- qchisq(1-alpha,df=df,ncp=ncp0)
pwr.rmsea <- 1 - pchisq(cval,df=df,ncp=ncpa)
} else {
cval <- qchisq(alpha,df=df,ncp=ncp0)
pwr.rmsea <- pchisq(cval,df=df,ncp=ncpa)
}
rm(ncp0, ncpa, cval)
print(round(pwr.rmsea,10))## [1] 0.6453405Path model
semPaths(fit.path.model1, layout = "tree2", rotation = 2, nDigits = 2, "Standardized", intercepts = FALSE, residuals = FALSE,
fade = FALSE, nCharNodes = 0, sizeMan = 9, edge.label.cex = .9, edge.label.position = .4)
Bayes factor in favor of the alternative hypothesis (BF10) and posterior probability for model parameters (given 1:1 prior odds for H0:Ha)
These are Bayes Factors based on model selection / information criteria approach as proposed by Wagenmakers, 2007. Each BF represents the relative evidence in the data favoring alternative hypothesis (parameter freely estimated) over the null (the given parameter fixed to 0). Bayes Factors using BIC approximation implicitly assume unit information prior which makes them rather conservative with regard to the alternative hypothesis.
f1 <- NULL
bf1 <- NULL
posterior1 <- NULL
for(i in letters[1:8]){
f1 <- sem(path.model1, data = cfdat, mimic = "Mplus", missing = "ML")
bf1[i] <- 1/(exp((BIC(f1) - BIC(sem(path.model1, data = cfdat, mimic = "Mplus", missing = "ML",
constraints = paste(i, '==', '0', sep = ""))))/2))
posterior1[i] <- bf1[i]/(1+bf1[i])
}
data.frame(BF10 = bf1, Posterior = round(posterior1, 3))## BF10 Posterior
## a 2.553936e-01 0.203
## b 1.109203e-01 0.100
## c 3.164425e-01 0.240
## d 3.427116e-01 0.255
## e 4.787830e+01 0.980
## f 4.295316e+25 1.000
## g 1.513493e+22 1.000
## h 1.218557e+01 0.924Confirmatory model 2
path.model2 <- 'rumination ~ a*ZCommunalStrength + b*CloseOthersTouchTest + c*int_COT_CS
stress ~ d*rumination
health ~ e*stress'
fit.path.model2 <- sem(path.model2, data = cfdat, se = "bootstrap", bootstrap = nboot, mimic = "Mplus", missing = "ML")Model test and approximate fit indices
fitmeasures(fit.path.model2, c("chisq", "df", "pvalue", "cfi", "tli", "rmsea", "rmsea.ci.lower", "rmsea.ci.upper", "srmr_mplus", "pnfi", "bic"))## chisq df pvalue cfi tli
## 8.940 7.000 0.257 0.994 0.989
## rmsea rmsea.ci.lower rmsea.ci.upper pnfi bic
## 0.025 0.000 0.068 0.567 6520.509This model fits the data well.
#####Modification indices
#modificationindices(fit.path.model2, alpha = .05, sort. = TRUE, maximum.number = 5)Parameter estimates, standard errors, p-values, CI’s, \(R^2\)
parameterEstimates(fit.path.model2, rsquare = TRUE)[1:5,]## lhs op rhs label est se z pvalue
## 1 rumination ~ ZCommunalStrength a -0.210 0.085 -2.467 0.014
## 2 rumination ~ CloseOthersTouchTest b -0.064 0.065 -0.972 0.331
## 3 rumination ~ int_COT_CS c -0.188 0.074 -2.559 0.010
## 4 stress ~ rumination d 0.330 0.023 14.184 0.000
## 5 health ~ stress e 0.649 0.061 10.645 0.000
## ci.lower ci.upper
## 1 -0.377 -0.044
## 2 -0.190 0.065
## 3 -0.337 -0.046
## 4 0.281 0.374
## 5 0.527 0.769#####Bivariate correlations
#lavCor(fit.path.model2)Power analysis
For approximate fit (based on the RMSEA distribution). Statistical power for the detection of a likely misspecified model (RMSEA > .08).
df <- fit.path.model2@test[[1]]$df
alpha <- .05
n <- nrow(cfdat)
rmsea0 <- .05 # RMSEA given H0
rmseaa <- .08 # RMSEA given Ha
ncp0 <- (n-1)*df*rmsea0**2 ;
ncpa <-(n-1)*df*rmseaa**2 ;
if(rmsea0 < rmseaa) {
cval <- qchisq(1-alpha,df=df,ncp=ncp0)
pwr.rmsea <- 1 - pchisq(cval,df=df,ncp=ncpa)
} else {
cval <- qchisq(alpha,df=df,ncp=ncp0)
pwr.rmsea <- pchisq(cval,df=df,ncp=ncpa)
}
rm(ncp0, ncpa, cval)
print(round(pwr.rmsea,10))## [1] 0.4415844Path model
semPaths(fit.path.model2, layout = "tree2", rotation = 2, nDigits = 2, "Standardized", intercepts = FALSE, residuals = FALSE,
fade = FALSE, nCharNodes = 0, sizeMan = 9, edge.label.cex = .9, edge.label.position = .4)
Bayes factor in favor of the alternative hypothesis (BF10) and posterior probability for model parameters (given 1:1 prior odds for H0:Ha)
These are Bayes Factors based on model selection / information criteria approach as proposed by Wagenmakers, 2007. Each BF represents the relative evidence in the data favoring alternative hypothesis (parameter freely estimated) over the null (the given parameter fixed to 0). Bayes Factors using BIC approximation implicitly assume unit information prior which makes them rather conservative with regard to the alternative hypothesis.
f2 <- NULL
bf2 <- NULL
posterior2 <- NULL
for(i in letters[1:5]){
f2 <- sem(path.model2, data = cfdat, mimic = "Mplus", missing = "ML")
bf2[i] <- 1/(exp((BIC(f2) - BIC(sem(path.model2, data = cfdat, mimic = "Mplus", missing = "ML",
constraints = paste(i, '==', '0', sep = ""))))/2))
posterior2[i] <- bf2[i]/(1+bf2[i])
}
data.frame(BF10 = bf2, Posterior = round(posterior2, 3))## BF10 Posterior
## a 2.236066e+00 0.691
## b 7.786086e-02 0.072
## c 1.165013e+00 0.538
## d 3.259151e+38 1.000
## e 1.513493e+22 1.000