Exp. 1 - Confirmatory Factor Analysis

A multilevel confirmatory factor analysis was performed in R (lavaan 0.6–19) to test a two or three-factor measurement model across two or three repeated vignette ratings nested within 100 participants. Each latent factor was indicated by three observed items. The model was estimated using robust maximum likelihood (MLR), with participant ID specified as a cluster variable to adjust for non-independence. Model fit was acceptable for the SEM models with best 3 items, but not for all items, see output tables for indicators.

These analysyses correspond to section CFA model fits and measurement invariance in the manuscript.

EDR

df <- readRDS(file="data/EDR_N100.rds")

tmp <- dplyr::filter(df,vignette=="E" | vignette=="D" | vignette=="R")
tmp_w <- pivot_wider(tmp, names_from = item_label, values_from = value,id_expand = FALSE,id_cols = c('ID','vignette'))
tmp_w<-data.frame(tmp_w)
rownames(tmp_w) <- 1:nrow(tmp_w)
tmp_w$ID<-as.numeric(as.factor(tmp_w$ID))
tmp_w$vignette<-as.factor(tmp_w$vignette)
#tmp_w <- select(tmp_w, -ID)
print(knitr::kable(table(tmp_w$vignette),col.names = c("Vignette", "N"),caption = "Table 1. Distribution of participants across EDR vignettes"))
Table 1. Distribution of participants across EDR vignettes
Vignette N
D 100
E 100
R 100 
model_full <- "
E =~ E1 + E2 + E3 + E4 + E5 + E6 + E7
D =~ D1 + D2 + D3 + D4 + D5 + D6 + D7 + D8
R =~ R1 + R2 + R3 + R4 + R5 + R6 + R7
"

model_best3item <- "
E =~ E1 + E6 + E7
D =~ D1 + D6 + D7
R =~ R1 + R3 + R7
"

fit.full <- lavaan::cfa(model_full, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")
fit.best3item <- lavaan::cfa(model_best3item, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")

fit.meas.full <- fitMeasures(fit.full,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
fit.meas.best3item <- fitMeasures(fit.best3item,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
res <- rbind(fit.meas.full,fit.meas.best3item)
print(knitr::kable(res,digits=3))
tli chisq df pvalue cfi rmsea srmr
fit.meas.full 0.926 581.917 206 0.000 0.934 0.078 0.071
fit.meas.best3item 0.975 51.853 24 0.001 0.984 0.062 0.038 
#print(knitr::kable(effectsize::interpret(fit.best3item)))
rm(tmp,tmp_w,df)
rm(fit.full,fit.best3item)

FM

df <- readRDS(file="data/FM_N100.rds")
df$item_label[df$item_label=="F1"]<-"M9" # relabel

tmp <- dplyr::filter(df,vignette=="F" | vignette=="M")
tmp_w <- pivot_wider(tmp, names_from = item_label, values_from = value,id_expand = FALSE,id_cols = c('ID','vignette'))
tmp_w<-data.frame(tmp_w)
rownames(tmp_w) <- 1:nrow(tmp_w)
tmp_w$ID<-as.numeric(as.factor(tmp_w$ID))
tmp_w$vignette<-as.factor(tmp_w$vignette)
#tmp_w <- select(tmp_w, -ID)
print(knitr::kable(table(tmp_w$vignette),col.names = c("Vignette", "N"), caption = "Table 1. Distribution of participants across FM vignettes"))
Table 1. Distribution of participants across FM vignettes
Vignette N
F 100
M 100 
model_full <- "
M =~ M1 + M3 + M9 + F5 + F7
F =~ M2 + F2 + F3 + F4 + F6 + F9 + F10 + F11
"

model_best3item <- "
M =~ M1 + M3 + M9
F =~ F3 + F6 + F10
"

fit.full <- lavaan::cfa(model_full, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")
fit.best3item <- lavaan::cfa(model_best3item, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")
fit.meas.full <- fitMeasures(fit.full,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
fit.meas.best3item <- fitMeasures(fit.best3item,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
res <- rbind(fit.meas.full,fit.meas.best3item)
print(knitr::kable(res,digits=3))
tli chisq df pvalue cfi rmsea srmr
fit.meas.full 0.893 291.485 64 0.000 0.912 0.133 0.076
fit.meas.best3item 0.985 16.583 8 0.035 0.992 0.073 0.018 
#print(knitr::kable(effectsize::interpret(fit.best3item)))
rm(tmp,tmp_w,df)
rm(fit.full,fit.best3item)

CB

df <- readRDS(file="data/CB_N100.rds")

tmp <- dplyr::filter(df,vignette=="C" | vignette=="S")
tmp_w <- pivot_wider(tmp, names_from = item_label, values_from = value,id_expand = FALSE,id_cols = c('ID','vignette'))
tmp_w<-data.frame(tmp_w)
rownames(tmp_w) <- 1:nrow(tmp_w)
tmp_w$ID<-as.numeric(as.factor(tmp_w$ID))
tmp_w$vignette<-as.factor(tmp_w$vignette)
#tmp_w <- select(tmp_w, -ID)
print(knitr::kable(table(tmp_w$vignette),col.names = c("Vignette", "N"),caption = "Table 1. Distribution of participants across CB vignettes"))
Table 1. Distribution of participants across CB vignettes
Vignette N
C 100
S 100 
model_full <- "
C =~ C1 + C2 + C3 + C4 + C5 + C6 + C7 + C8 + C9
S =~ S1 + S2 + S3 + S4 + S5 + S6 + S7 
"

model_best3item <- "
C =~ C5 + C2 + C9
S =~ S5 + S6 + S7 
"

fit.full <- lavaan::cfa(model_full, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")
fit.best3item <- lavaan::cfa(model_best3item, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")

fit.meas.full <- fitMeasures(fit.full,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
fit.meas.best3item <- fitMeasures(fit.best3item,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
res <- rbind(fit.meas.full,fit.meas.best3item)
print(knitr::kable(res,digits=3))
tli chisq df pvalue cfi rmsea srmr
fit.meas.full 0.741 676.974 103 0.000 0.778 0.167 0.117
fit.meas.best3item 0.986 13.853 8 0.086 0.992 0.060 0.041 
#print(knitr::kable(effectsize::interpret(fit.best3item)))
rm(tmp,tmp_w,df)
rm(fit.full,fit.best3item)

PEP

df <- readRDS(file="data/PEP_N100.rds")

tmp <- dplyr::filter(df,vignette=="U" | vignette=="P")
tmp_w <- pivot_wider(tmp, names_from = item_label, values_from = value,id_expand = FALSE,id_cols = c('ID','vignette'))
tmp_w<-data.frame(tmp_w)
rownames(tmp_w) <- 1:nrow(tmp_w)
tmp_w$ID<-as.numeric(as.factor(tmp_w$ID))
tmp_w$vignette<-as.factor(tmp_w$vignette)
#tmp_w <- select(tmp_w, -ID)

print(knitr::kable(table(tmp_w$vignette),col.names = c("Vignette", "N"),caption = "Table 1. Distribution of participants across PEP vignettes"))
Table 1. Distribution of participants across PEP vignettes
Vignette N
P 100
U 100 
model_full <- "
U =~ U1 + U2 + U3 + U4 + U5 + U6 + U7 
P =~ P1 + P2 + P3 + P4 + P5 + P6 + P7 + P8 + P9 + P10 + P11 + P12 + P13
"

model_best3item <- "
U =~ U2 + U3 + U6
P =~ P4 + P8 + P9
"

fit.full <- lavaan::cfa(model_full, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")
fit.best3item <- lavaan::cfa(model_best3item, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")

fit.meas.full <- fitMeasures(fit.full,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
fit.meas.best3item <- fitMeasures(fit.best3item,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
res <- rbind(fit.meas.full,fit.meas.best3item)
print(knitr::kable(res,digits=3))
tli chisq df pvalue cfi rmsea srmr
fit.meas.full 0.852 578.643 169 0.000 0.868 0.11 0.066
fit.meas.best3item 0.979 15.921 8 0.044 0.989 0.07 0.027 
#print(knitr::kable(effectsize::interpret(fit.best3item)))
rm(tmp,tmp_w,df)
rm(fit.full,fit.best3item)

AIA

df <- readRDS(file="data/AIA_N101.rds")

tmp <- dplyr::filter(df,vignette=="I" | vignette=="X" | vignette=="B")
tmp_w <- pivot_wider(tmp, names_from = item_label, values_from = value,id_expand = FALSE,id_cols = c('ID','vignette'))
tmp_w<-data.frame(tmp_w)
rownames(tmp_w) <- 1:nrow(tmp_w)
tmp_w$ID<-as.numeric(as.factor(tmp_w$ID))
tmp_w$vignette<-as.factor(tmp_w$vignette)
#tmp_w <- select(tmp_w, -ID)

print(knitr::kable(table(tmp_w$vignette),col.names = c("Vignette", "N"),caption = "Table 1. Distribution of participants across AIA vignettes"))
Table 1. Distribution of participants across AIA vignettes
Vignette N
B 101
I 101
X 101 
model_full <- "
I =~ I1 + I2 + I3 + I4 + I5 + I6 
X =~ X1 + X2 + X3 + X4 + X5
B =~ B1 + B2 + B3 + B4 + B5
"

model_best3item <- "
I =~ I3 + I4 + I5
X =~ X1 + X2
B =~ B1 + B3 + B5
"

fit.full <- lavaan::cfa(model_full, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")
fit.best3item <- lavaan::cfa(model_best3item, data = tmp_w,meanstructure = TRUE, estimator = "MLR",cluster = "ID")

fit.meas.full <- fitMeasures(fit.full,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
fit.meas.best3item <- fitMeasures(fit.best3item,c("tli","chisq","df","pvalue", "cfi", "rmsea", "srmr"))
res <- rbind(fit.meas.full,fit.meas.best3item)
print(knitr::kable(res,digits=3))
tli chisq df pvalue cfi rmsea srmr
fit.meas.full 0.810 701.974 101 0 0.840 0.140 0.087
fit.meas.best3item 0.966 54.764 17 0 0.979 0.086 0.051 
#print(knitr::kable(effectsize::interpret(fit.best3item)))
rm(tmp,tmp_w,df)
rm(fit.full,fit.best3item)
Back to top