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(haven)
library(stargazer)
library(xtable)
library(DT)
library(broom)
library(ggstance)
library(forcats)

source(file.path(PROJHOME, "Analysis", "graphics.R"))

options("xtable.html.table.attributes" = "border=0 class='table table-condensed'")

unlabelled <- function(x) {
  if (!haven:::is.labelled(x))
    return(x)
  attributes(x) <- NULL
  x
}

df.raw <- read_sav(file.path(PROJHOME, "Data", "Data_August 2016.sav")) %>%
  mutate_each(funs(unlabelled(.))) %>%
  mutate(KKKFrame_CivLibs.factor = factor(KKKFrame_CivLibs, levels=0:1,
                                          labels=c("Public safety frame",
                                                   "Civil liberties frame")),
         GunFrame_CivLibs.factor = factor(GunFrame_CivLibs, levels=0:1,
                                          labels=c("Public safety frame",
                                                   "Civil liberties frame")))

saveRDS(df.raw, file.path(PROJHOME, "Data", "survey_clean.rds"))


df.test <- df.raw %>%
  select(caseid, dplyr::contains("Frame"), dplyr::contains("Support"), dplyr::contains("Gun"), OPENNESS, CONSCIENTIOUSNESS, EXTRAVERSION, AGREEABLENESS, NEUROTICISM, POLITICAL_KNOWLEDGE, NC)


df.small <- df.raw %>%
  select(caseid, weight, KKK_Support, Gun_Support,
         OPENNESS, CONSCIENTIOUSNESS, EXTRAVERSION, AGREEABLENESS, NEUROTICISM,
         POLITICAL_KNOWLEDGE, NC, KKKFrame_CivLibs, GunFrame_CivLibs)

OLS models

KKK experiment

model.small.kkk <- lm(KKK_Support ~ KKKFrame_CivLibs +
                        OPENNESS * KKKFrame_CivLibs + 
                        CONSCIENTIOUSNESS * KKKFrame_CivLibs +
                        EXTRAVERSION * KKKFrame_CivLibs +
                        AGREEABLENESS * KKKFrame_CivLibs +
                        NEUROTICISM * KKKFrame_CivLibs,
                      data=df.small, weights=weight)

model.expanded.kkk <- lm(KKK_Support ~ KKKFrame_CivLibs +
                           OPENNESS * KKKFrame_CivLibs + 
                           CONSCIENTIOUSNESS * KKKFrame_CivLibs +
                           EXTRAVERSION * KKKFrame_CivLibs +
                           AGREEABLENESS * KKKFrame_CivLibs +
                           NEUROTICISM * KKKFrame_CivLibs +
                           POLITICAL_KNOWLEDGE * KKKFrame_CivLibs +
                           NC * KKKFrame_CivLibs,
                         data=df.small, weights=weight)

coef.names.kkk <- names(coef(model.small.kkk))
coef.plot.kkk <- bind_rows(mutate(tidy(model.small.kkk, conf.int=TRUE), 
                                  model="Reduced"),
                           mutate(tidy(model.expanded.kkk, conf.int=TRUE), 
                                  model="Full")) %>%
  mutate(low = estimate - std.error,
         high = estimate + std.error) %>%
  left_join(coef.names, by=c("term" = "coef.name")) %>%
  mutate(coef.clean = fct_rev(fct_inorder(coef.clean)),
         model = factor(model, levels=c("Reduced", "Full"),
                        labels=c("Reduced   ", "Full")))
ggplot(coef.plot.kkk, aes(x=estimate, y=coef.clean, colour=model)) + 
  geom_vline(xintercept=0, colour="#FF851B") +
  geom_pointrangeh(aes(xmin=low, xmax=high), size=0.5,
                   position=position_dodgev(0.5)) + 
  scale_colour_manual(values=framing.palette("palette1"), name=NULL) +
  labs(x="Coefficient", y=NULL,
       title="KKK framing experiment",
       subtitle="Reduced and full models") +
  theme_framing(12) + theme(legend.position="bottom")

stargazer.labs <- coef.plot.kkk %>%
  distinct(term, coef.clean) %>%
  mutate(coef.clean = as.character(coef.clean)) %>%
  mutate(term = recode(term, `(Intercept)` = "Constant"),
         term = paste0("^", term, "$"))

stargazer(model.small.kkk, model.expanded.kkk,
          type="html", intercept.bottom=FALSE,
          dep.var.caption="", dep.var.labels.include=FALSE,
          report="vc*s", order=stargazer.labs$term,
          covariate.labels=stargazer.labs$coef.clean)
(1) (2)
Intercept 2.274 -0.087
(1.606) (1.693)
KKK frame 1.516 2.280
(2.197) (2.449)
Openness 0.302 -1.578
(1.154) (1.406)
Conscientiousness 1.781 1.891
(1.342) (1.357)
Extraversion -0.955 0.118
(0.905) (0.925)
Agreeableness -0.962 -0.948
(1.316) (1.330)
Neuroticism 0.333 1.697
(0.978) (1.032)
Openness × frame 3.902** 5.235***
(1.611) (1.972)
Conscientiousness × frame -5.095*** -4.924***
(1.784) (1.827)
Extraversion × frame -1.216 -2.290*
(1.267) (1.311)
Agreeableness × frame 1.576 0.786
(1.857) (1.942)
Neuroticism × frame -0.465 -1.780
(1.369) (1.455)
Political knowledge 2.658***
(0.552)
Need for cognition 0.327
(1.110)
Political knowledge × frame -0.951
(0.797)
Need for cognition × frame 1.153
(1.659)
Observations 447 398
R2 0.080 0.172
Adjusted R2 0.056 0.140
Residual Std. Error 2.021 (df = 435) 1.977 (df = 382)
F Statistic 3.415*** (df = 11; 435) 5.297*** (df = 15; 382)
Note: p<0.1; p<0.05; p<0.01

Guns experiment

model.small.guns <- lm(Gun_Support ~ GunFrame_CivLibs + 
                         GunFrame_CivLibs * OPENNESS + 
                         CONSCIENTIOUSNESS * GunFrame_CivLibs +
                         EXTRAVERSION * GunFrame_CivLibs +
                         AGREEABLENESS * GunFrame_CivLibs +
                         NEUROTICISM * GunFrame_CivLibs,
                       data=df.small, weights=weight)

model.expanded.guns <- lm(Gun_Support ~ GunFrame_CivLibs +
                            OPENNESS * GunFrame_CivLibs + 
                            CONSCIENTIOUSNESS * GunFrame_CivLibs +
                            EXTRAVERSION * GunFrame_CivLibs +
                            AGREEABLENESS * GunFrame_CivLibs +
                            NEUROTICISM * GunFrame_CivLibs +
                            POLITICAL_KNOWLEDGE * GunFrame_CivLibs +
                            NC * GunFrame_CivLibs,
                          data=df.small, weights=weight)

coef.names.guns <- names(coef(model.small.guns))
coef.plot.guns <- bind_rows(mutate(tidy(model.small.guns, conf.int=TRUE), 
                                   model="Reduced"),
                            mutate(tidy(model.expanded.guns, conf.int=TRUE), 
                                   model="Full")) %>%
  mutate(low = estimate - std.error,
         high = estimate + std.error) %>%
  left_join(coef.names, by=c("term" = "coef.name")) %>%
  mutate(coef.clean = fct_rev(fct_inorder(coef.clean)),
         model = factor(model, levels=c("Reduced", "Full"),
                        labels=c("Reduced   ", "Full")))
ggplot(coef.plot.guns, aes(x=estimate, y=coef.clean, colour=model)) + 
  geom_vline(xintercept=0, colour="#FF851B") +
  geom_pointrangeh(aes(xmin=low, xmax=high), size=0.5,
                   position=position_dodgev(0.5)) + 
  scale_colour_manual(values=framing.palette("palette1"), name=NULL) +
  labs(x="Coefficient", y=NULL,
       title="Concealed carry framing experiment",
       subtitle="Reduced and full models") +
  theme_framing(12) + theme(legend.position="bottom")

stargazer.labs <- coef.plot.guns %>%
  distinct(term, coef.clean) %>%
  mutate(coef.clean = as.character(coef.clean)) %>%
  mutate(term = recode(term, `(Intercept)` = "Constant"),
         term = paste0("^", term, "$"))

stargazer(model.small.guns, model.expanded.guns,
          type="html", intercept.bottom=FALSE,
          dep.var.caption="", dep.var.labels.include=FALSE,
          report="vc*s", order=stargazer.labs$term,
          covariate.labels=stargazer.labs$coef.clean)
(1) (2)
Intercept 2.269 1.716
(1.848) (1.993)
Guns frame 5.860** 7.631**
(2.751) (2.967)
Openness 1.998 2.025
(1.362) (1.650)
Conscientiousness 0.534 0.443
(1.545) (1.599)
Extraversion -0.469 -0.030
(1.041) (1.088)
Agreeableness -0.070 -0.211
(1.512) (1.568)
Neuroticism -0.742 -0.122
(1.124) (1.216)
Openness × frame -1.562 -3.944
(1.954) (2.508)
Conscientiousness × frame -1.457 -1.043
(2.183) (2.283)
Extraversion × frame 0.969 0.811
(1.529) (1.614)
Agreeableness × frame -3.714* -4.325*
(2.113) (2.225)
Neuroticism × frame -0.856 -2.122
(1.666) (1.782)
Political knowledge 0.782
(0.655)
Need for cognition -0.638
(1.305)
Political knowledge × frame -1.461
(0.921)
Need for cognition × frame 2.847
(1.963)
Observations 453 408
R2 0.060 0.077
Adjusted R2 0.037 0.041
Residual Std. Error 2.313 (df = 441) 2.321 (df = 392)
F Statistic 2.570*** (df = 11; 441) 2.171*** (df = 15; 392)
Note: p<0.1; p<0.05; p<0.01

Exploration of results

KKK experiment

# Get just the means of personality types
personality.means <- model.expanded.kkk$model %>% 
  summarise_at(vars(OPENNESS, CONSCIENTIOUSNESS, EXTRAVERSION, AGREEABLENESS, 
                    NEUROTICISM, POLITICAL_KNOWLEDGE, NC),
               mean)

# Create rows of personality types with all 0s and all 1s
personality.1 <- data_frame(personality = colnames(personality.means),
                            value = 1) %>%
  spread(personality, value)
personality.0 <- data_frame(personality = colnames(personality.means),
                            value = 0) %>%
  spread(personality, value)

# Create base matrix of possible personality type values (mean, 0, and 1)
personality.possibilities <- bind_rows(personality.means,
                                       personality.0, personality.1)

# Expand the personality possibilities matrix to include all combinations of
# all variables, then filter out all rows where there are multiple 0 and 1
# values
new.data.personalities <- expand.grid(personality.possibilities) %>%
  mutate(id = row_number()) %>%
  gather(key, value, -id) %>%
  group_by(id) %>%
  # Select only rows where there's one 0 value and no 1 value, or one 1 value
  # and no 0 value
  filter(sum(value == 0) == 1 & !any(value == 1) | 
           sum(value == 1) == 1 & !any(value == 0)) %>%
  spread(key, value) %>%
  mutate(index = 1)
    
# Create matrix of possible framing conditions
new.data.kkk <- data_frame(KKKFrame_CivLibs = 0:1, index = 1,
                           `(weights)` = 1) %>%
  left_join(new.data.personalities, by="index") %>%
  select(-index, -id)

plot.predict.kkk <- augment(model.expanded.kkk, newdata=new.data.kkk) %>%
  gather(key, value, one_of(colnames(personality.means))) %>%
  left_join(coef.names, by=c("key" = "coef.name")) %>%
  filter(value %in% c(0, 1)) %>%
  mutate(value = factor(value, levels=c(0, 1),
                        labels=c("Low (0)", "High (1)"),
                        ordered=TRUE),
         KKKFrame_CivLibs = factor(KKKFrame_CivLibs, levels=c(0, 1),
                                   labels=c("Public safety", "Civil liberties"),
                                   ordered=TRUE),
         coef.clean = fct_inorder(coef.clean))
plot.pred.kkk <- ggplot(plot.predict.kkk,
                        aes(x=KKKFrame_CivLibs, y=.fitted, 
                            colour=value, group=value)) + 
  geom_line(size=1) + 
  labs(x=NULL, y="Average KKK support",
       title="Predicted means of KKK support") + 
  scale_colour_manual(values=framing.palette("palette1")[c(3, 5)], name=NULL) +
  facet_wrap(~ coef.clean) + 
  theme_framing()
plot.pred.kkk

Guns experiment

# Get just the means of personality types
personality.means <- model.expanded.guns$model %>% 
  summarise_at(vars(OPENNESS, CONSCIENTIOUSNESS, EXTRAVERSION, AGREEABLENESS, 
                    NEUROTICISM, POLITICAL_KNOWLEDGE, NC),
               mean)

# Create rows of personality types with all 0s and all 1s
personality.1 <- data_frame(personality = colnames(personality.means),
                            value = 1) %>%
  spread(personality, value)
personality.0 <- data_frame(personality = colnames(personality.means),
                            value = 0) %>%
  spread(personality, value)

# Create base matrix of possible personality type values (mean, 0, and 1)
personality.possibilities <- bind_rows(personality.means,
                                       personality.0, personality.1)

# Expand the personality possibilities matrix to include all combinations of
# all variables, then filter out all rows where there are multiple 0 and 1
# values
new.data.personalities <- expand.grid(personality.possibilities) %>%
  mutate(id = row_number()) %>%
  gather(key, value, -id) %>%
  group_by(id) %>%
  # Select only rows where there's one 0 value and no 1 value, or one 1 value
  # and no 0 value
  filter(sum(value == 0) == 1 & !any(value == 1) | 
           sum(value == 1) == 1 & !any(value == 0)) %>%
  spread(key, value) %>%
  mutate(index = 1)

# Create matrix of possible framing conditions
new.data.guns <- data_frame(GunFrame_CivLibs = 0:1, index = 1,
                            `(weights)` = 1) %>%
  left_join(new.data.personalities, by="index") %>%
  select(-index, -id)

plot.predict.guns <- augment(model.expanded.guns, newdata=new.data.guns) %>%
  gather(key, value, one_of(colnames(personality.means))) %>%
  left_join(coef.names, by=c("key" = "coef.name")) %>%
  filter(value %in% c(0, 1)) %>%
  mutate(value = factor(value, levels=c(0, 1),
                        labels=c("Low (0)", "High (1)"),
                        ordered=TRUE),
         GunFrame_CivLibs = factor(GunFrame_CivLibs, levels=c(0, 1),
                                   labels=c("Public safety", "Civil liberties"),
                                   ordered=TRUE),
         coef.clean = fct_inorder(coef.clean))
plot.pred.guns <- ggplot(plot.predict.guns,
                        aes(x=GunFrame_CivLibs, y=.fitted, 
                            colour=value, group=value)) + 
  geom_line(size=1) + 
  labs(x=NULL, y="Average concealed carry support",
       title="Predicted means of concealed carry support") + 
  scale_colour_manual(values=framing.palette("palette1")[c(3, 5)], name=NULL) +
  facet_wrap(~ coef.clean) + 
  theme_framing()
plot.pred.guns