knitr::opts_chunk$set(cache=FALSE, fig.retina=2,
tidy.opts=list(width.cutoff=120), # For code
options(width=120)) # For output
# Load libraries and data
library(printr)
library(tidyverse)
library(forcats)
library(lavaan)
library(semPlot)
library(pander)
library(ggstance)
source(file.path(PROJHOME, "Analysis", "graphics.R"))
# Load clean data
new.cols <- filter(coef.names, new.column == TRUE)
df.survey <- readRDS(file.path(PROJHOME, "Data", "survey_clean.rds")) %>%
# Duplicate columns using short names for each of the SEM variables (i.e.
# create an x2 column from the PPGENDER column)
mutate_(.dots = setNames(new.cols$coef.name, new.cols$coef.abbr))
# Helpful functions for modeling
sem.model <- function(model.def) {
sem(model.def, data=df.survey, missing="FIML", fixed.x=FALSE)
}
sem.extract.latent <- function(model.fit) {
standardizedSolution(model.fit) %>%
filter(op == "=~")
}
sem.extract.path.coefs <- function(model.fit) {
standardizedSolution(model.fit) %>%
filter(op == "~") %>%
left_join(coef.names, by=c("rhs" = "coef.abbr")) %>%
mutate(term = sprintf("%s (%s)", coef.clean, rhs)) %>%
select(term, est.std, se, z, pvalue)
}
SEM results
KKK models
model.reduced.kkk <- '
# Measurement model / latent variables
# none
# Regressions
y1k ~ x1 + x2 + x3 + x4k + x5k + x6k + x7k + x8k + x9k
# Residual correlations
x1 ~~ x2 + x3 + x4k + x5k + x6k + x7k + x8k
x2 ~~ x3 + x4k + x5k + x6k + x7k + x8k
x3 ~~ x4k + x5k + x6k + x7k + x8k
x4k ~~ x5k + x6k + x7k + x8k
x5k ~~ x6k + x7k + x8k
x6k ~~ x7k + x8k
x7k ~~ x8k
'
model.full.kkk <- '
# Measurement model / latent variables
# none
# Regressions
y1k ~ x1 + x2 + x3 + x4k + x5k + x6k + x7k + x8k + x9k + x10k + x11k
# Residual correlations
x1 ~~ x2 + x3 + x4k + x5k + x6k + x7k + x8k + x10k + x11k
x2 ~~ x3 + x4k + x5k + x6k + x7k + x8k + x10k + x11k
x3 ~~ x4k + x5k + x6k + x7k + x8k + x10k + x11k
x4k ~~ x5k + x6k + x7k + x8k + x10k + x11k
x5k ~~ x6k + x7k + x8k + x10k + x11k
x6k ~~ x7k + x8k + x10k + x11k
x7k ~~ x8k + x10k + x11k
x8k ~~ x10k + x11k
x10k ~~ x11k
'
kkk.models <- data_frame(model.def = c(model.reduced.kkk, model.full.kkk)) %>%
mutate(model.fit = model.def %>% map(sem.model),
model.latent.vars = model.fit %>% map(sem.extract.latent),
model.path.coefs = model.fit %>% map(sem.extract.path.coefs))
## Found more than one class "Model" in cache; using the first, from namespace 'lavaan'
Coefficient plot
coef.plot.kkk <- bind_rows(kkk.models$model.path.coefs, .id="model.name") %>%
mutate(low = est.std - se,
high = est.std + se) %>%
mutate(model.name = factor(model.name, levels=c(1, 2),
labels=c("Reduced ", "Full"), ordered=TRUE),
term = fct_rev(fct_inorder(term)))
ggplot(coef.plot.kkk, aes(x=est.std, y=term, colour=model.name)) +
geom_vline(xintercept=0, colour="#FF851B") +
geom_pointrangeh(aes(xmin=low, xmax=high), size=0.5,
position=position_dodge(width=0.5)) +
scale_colour_manual(values=framing.palette("palette1"), name=NULL) +
labs(x="Standardized coefficient", y=NULL,
title="KKK framing experiment",
subtitle="Standardized coefficients from reduced and full SEM models") +
theme_framing(12) + theme(legend.position="bottom")
Reduced model
kkk.reduced <- pandoc.table.return(kkk.models$model.path.coefs[[1]],
keep.line.breaks=TRUE,
justify="lcccc")
cat(kkk.reduced)
| Race (x1) |
0.169 |
0.042 |
4.01 |
0 |
| Sex (x2) |
0.172 |
0.041 |
4.24 |
0 |
| Party (x3) |
-0.088 |
0.042 |
-2.08 |
0.038 |
| Frame × openness (x4k) |
0.47 |
0.18 |
2.62 |
0.009 |
| Frame × conscientiousness (x5k) |
-0.65 |
0.205 |
-3.16 |
0.002 |
| Frame × extraversion (x6k) |
-0.037 |
0.131 |
-0.284 |
0.776 |
| Frame × agreeableness (x7k) |
0.387 |
0.207 |
1.87 |
0.061 |
| Frame × neuroticism (x8k) |
-0.043 |
0.11 |
-0.385 |
0.7 |
| KKK frame (x9k) |
-0.024 |
0.265 |
-0.092 |
0.927 |
Full model
kkk.full <- pandoc.table.return(kkk.models$model.path.coefs[[2]],
keep.line.breaks=TRUE,
justify="lcccc")
cat(kkk.full)
| Race (x1) |
0.141 |
0.045 |
3.14 |
0.002 |
| Sex (x2) |
0.137 |
0.041 |
3.33 |
0.001 |
| Party (x3) |
-0.066 |
0.041 |
-1.6 |
0.109 |
| Frame × openness (x4k) |
0.282 |
0.203 |
1.38 |
0.166 |
| Frame × conscientiousness (x5k) |
-0.61 |
0.222 |
-2.74 |
0.006 |
| Frame × extraversion (x6k) |
0.04 |
0.119 |
0.339 |
0.735 |
| Frame × agreeableness (x7k) |
0.379 |
0.179 |
2.11 |
0.035 |
| Frame × neuroticism (x8k) |
-0.039 |
0.107 |
-0.368 |
0.713 |
| KKK frame (x9k) |
-0.231 |
0.234 |
-0.988 |
0.323 |
| Frame × political knowledge (x10k) |
0.317 |
0.102 |
3.11 |
0.002 |
| Frame × need for cognition (x11k) |
-0.014 |
0.171 |
-0.083 |
0.934 |
Path diagram (reduced)
semPaths(kkk.models$model.fit[[1]], layout="tree", rotation=2)
## Warning in lavaan(slotOptions = object@Options, slotParTable = object@ParTable, : lavaan WARNING: model has NOT
## converged!
Path diagram (full)
semPaths(kkk.models$model.fit[[2]], layout="tree", rotation=2)
## Warning in lavaan(slotOptions = object@Options, slotParTable = object@ParTable, : lavaan WARNING: model has NOT
## converged!
Gun models
model.reduced.gun <- '
# Measurement model / latent variables
# none
# Regressions
y1g ~ x1 + x2 + x3 + x4g + x5g + x6g + x7g + x8g + x9g
# Residual correlations
x1 ~~ x2 + x3 + x4g + x5g + x6g + x7g + x8g
x2 ~~ x3 + x4g + x5g + x6g + x7g + x8g
x3 ~~ x4g + x5g + x6g + x7g + x8g
x4g ~~ x5g + x6g + x7g + x8g
x5g ~~ x6g + x7g + x8g
x6g ~~ x7g + x8g
x7g ~~ x8g
'
model.full.gun <- '
# Measurement model / latent variables
# none
# Regressions
y1g ~ x1 + x2 + x3 + x4g + x5g + x6g + x7g + x8g + x9g + x10g + x11g
# Residual correlations
x1 ~~ x2 + x3 + x4g + x5g + x6g + x7g + x8g + x10g + x11g
x2 ~~ x3 + x4g + x5g + x6g + x7g + x8g + x10g + x11g
x3 ~~ x4g + x5g + x6g + x7g + x8g + x10g + x11g
x4g ~~ x5g + x6g + x7g + x8g + x10g + x11g
x5g ~~ x6g + x7g + x8g + x10g + x11g
x6g ~~ x7g + x8g + x10g + x11g
x7g ~~ x8g + x10g + x11g
x8g ~~ x10g + x11g
x10g ~~ x11g
'
gun.models <- data_frame(model.def = c(model.reduced.gun, model.full.gun)) %>%
mutate(model.fit = model.def %>% map(sem.model),
model.latent.vars = model.fit %>% map(sem.extract.latent),
model.path.coefs = model.fit %>% map(sem.extract.path.coefs))
Coefficient plot
coef.plot.guns <- bind_rows(gun.models$model.path.coefs, .id="model.name") %>%
mutate(low = est.std - se,
high = est.std + se) %>%
mutate(model.name = factor(model.name, levels=c(1, 2),
labels=c("Reduced ", "Full"), ordered=TRUE),
term = fct_rev(fct_inorder(term)))
ggplot(coef.plot.guns, aes(x=est.std, y=term, colour=model.name)) +
geom_vline(xintercept=0, colour="#FF851B") +
geom_pointrangeh(aes(xmin=low, xmax=high), size=0.5,
position=position_dodge(width=0.5)) +
scale_colour_manual(values=framing.palette("palette1"), name=NULL) +
labs(x="Standardized coefficient", y=NULL,
title="Gun framing experiment",
subtitle="Standardized coefficients from reduced and full SEM models") +
theme_framing(12) + theme(legend.position="bottom")
Reduced model
gun.reduced <- pandoc.table.return(gun.models$model.path.coefs[[1]],
keep.line.breaks=TRUE,
justify="lcccc")
cat(gun.reduced)
| Race (x1) |
0.003 |
0.036 |
0.086 |
0.932 |
| Sex (x2) |
0.03 |
0.036 |
0.83 |
0.406 |
| Party (x3) |
-0.331 |
0.059 |
-5.63 |
0 |
| Frame × openness (x4g) |
-0.101 |
0.163 |
-0.622 |
0.534 |
| Frame × conscientiousness (x5g) |
0.033 |
0.192 |
0.174 |
0.862 |
| Frame × extraversion (x6g) |
0.192 |
0.122 |
1.57 |
0.117 |
| Frame × agreeableness (x7g) |
-0.281 |
0.181 |
-1.55 |
0.12 |
| Frame × neuroticism (x8g) |
-0.117 |
0.085 |
-1.38 |
0.168 |
| Guns frame (x9g) |
0.409 |
0.151 |
2.71 |
0.007 |
Full model
gun.full <- pandoc.table.return(gun.models$model.path.coefs[[2]],
keep.line.breaks=TRUE,
justify="lcccc")
cat(gun.full)
| Race (x1) |
0.014 |
0.029 |
0.476 |
0.634 |
| Sex (x2) |
0.024 |
0.029 |
0.821 |
0.411 |
| Party (x3) |
-0.267 |
0.07 |
-3.8 |
0 |
| Frame × openness (x4g) |
-0.12 |
0.16 |
-0.755 |
0.45 |
| Frame × conscientiousness (x5g) |
0 |
0.159 |
-0.003 |
0.998 |
| Frame × extraversion (x6g) |
0.11 |
0.105 |
1.04 |
0.296 |
| Frame × agreeableness (x7g) |
-0.274 |
0.144 |
-1.91 |
0.056 |
| Frame × neuroticism (x8g) |
-0.152 |
0.066 |
-2.29 |
0.022 |
| Guns frame (x9g) |
0.556 |
0.106 |
5.23 |
0 |
| Frame × political knowledge (x10g) |
-0.145 |
0.073 |
-1.98 |
0.048 |
| Frame × need for cognition (x11g) |
0.117 |
0.132 |
0.885 |
0.376 |
Path diagram (reduced)
semPaths(gun.models$model.fit[[1]], layout="tree", rotation=2)
## Warning in lavaan(slotOptions = object@Options, slotParTable = object@ParTable, : lavaan WARNING: model has NOT
## converged!
Path diagram (full)
semPaths(gun.models$model.fit[[2]], layout="tree", rotation=2)
## Warning in lavaan(slotOptions = object@Options, slotParTable = object@ParTable, : lavaan WARNING: model has NOT
## converged!
