Differences in means

knitr::opts_chunk$set(cache = FALSE, fig.retina = 2,
                      tidy.opts = list(width.cutoff = 120),  # For code
                      width = 120)  # For output

library(tidyverse)
library(pander)
library(broom)
library(here)

source(file.path(here(), "lib", "pander_options.R"))
source(file.path(here(), "lib", "graphics.R"))
source(file.path(here(), "lib", "labels.R"))

survey_clean <- readRDS(file.path(here(), "Data", "survey_clean.rds"))

framing_anova <- function(frame_factor, issue_support, issue_name) {
  # Create quosures
  enquo_frame <- enquo(frame_factor)
  enquo_support <- enquo(issue_support)
  
  # Create string versions of arguments
  char_frame <- deparse(substitute(frame_factor))
  char_support <- deparse(substitute(issue_support))
  
  # Summarize data based on issue and support
  frame_summary <- survey_clean %>%
    filter(!is.na(!!enquo_frame)) %>%
    group_by(!!enquo_frame) %>%
    summarize(N = n(),
              Mean = Hmisc::wtd.mean(!!enquo_support, weight, na.rm = TRUE),
              SD = sqrt(Hmisc::wtd.var(!!enquo_support, weight, na.rm = TRUE))) %>%
    rename(Frame = !!enquo_frame) %>%
    arrange(Frame)
  
  # ANOVA
  anova_formula <- as.formula(paste(char_support, "~", char_frame))
  frame_anova <- aov(anova_formula, weights = weight, data = survey_clean)
  
  # Round to nearest ten-thousandth
  frame_sig <- ceiling(tidy(frame_anova)[1,]$p.value * 10000) / 10000

  frame_summary_sig <- frame_summary %>%
    mutate(`Sig.` = c(NA, frame_sig),
           Issue = c(issue_name, NA)) %>%
    select(Issue, everything()) %>%
    mutate(Frame = as.character(Frame))
  
  frame_summary_sig
}

# KKK experiment
kkk_summary <- framing_anova(KKKFrame_CivLibs.factor, 
                             KKK_Support, model_kkk_name)

# Guns experiment
guns_summary <- framing_anova(GunFrame_CivLibs.factor, 
                              Gun_Support, model_guns_name)

# Stem cells experiment
stemcells_summary <- framing_anova(StemCellsFrame_Positive.factor, 
                                   StemCellsSupport, model_stemcells_name)

# Affirmative action experiment
aa_summary <- framing_anova(AAFrame_positive.factor, 
                            AASupport, model_af_ac_name)

# Everything in one table
framing_summary <- bind_rows(kkk_summary, guns_summary, 
                             stemcells_summary, aa_summary)

caption <- "Framing effects for various issues"
tbl_framing <- pandoc.table.return(framing_summary, caption = caption,
                                   justify = "llcccc", digits = 3)

cat(tbl_framing)

cat(tbl_framing, file = file.path(here(), "Output", "table_framing_anova.md"))

clean_issue_means <- function(frame_factor, issue_support) {
  enquo_frame <- enquo(frame_factor)
  enquo_support <- enquo(issue_support)
  
  survey_clean %>%
    select(frame = !!enquo_frame,
           support = !!enquo_support) %>%
    filter(!is.na(frame),
           !is.na(support))
}

issue_means <- tribble(
  ~issue_name, ~plot,
  model_kkk_name, clean_issue_means(KKKFrame_CivLibs.factor, KKK_Support),
  model_guns_name, clean_issue_means(GunFrame_CivLibs.factor, Gun_Support),
  model_stemcells_name, clean_issue_means(StemCellsFrame_Positive.factor, 
                                          StemCellsSupport),
  model_af_ac_name_plot, clean_issue_means(AAFrame_positive.factor, AASupport)
) %>%
  unnest(plot) %>%
  mutate(issue_name = fct_inorder(issue_name, ordered = TRUE)) %>%
  left_join(frame_labs_all, by = "frame")

set.seed(1234)

plot_issue_means <- ggplot(issue_means, aes(x = frame_plot, y = support)) +
  geom_point(position = position_jitter(height = 0.1, width = 0.1),
             alpha = 0.1, size = 0.3) +
  stat_summary(fun.data = "mean_cl_boot", colour = "black",
                 size = 1.5, fatten = 2) +
  scale_y_continuous(breaks = 1:7,
                     labels = c("Strongly oppose (1)", 
                                "Moderately oppose (2)",
                                "Slightly oppose (3)",
                                "Neither oppose nor support (4)",
                                "Slightly support (5)",
                                "Moderately support (6)",
                                "Strongly support (7)")) +
  coord_cartesian(ylim = c(1, 7)) +
  labs(x = "Frame", y = NULL) +
  theme_framing() +
  theme(panel.grid.major.x = element_blank(),
        panel.grid.minor.y = element_blank(),
        strip.text = element_text(size = rel(0.8))) +
  facet_wrap(~ issue_name, scales = "free_x", nrow = 1)

plot_issue_means

caption <- c("Differences in means across frames and issues")
save.fig.caption(plot_issue_means, filename = "issue_means", 
                 width = 8.5, height = 4.5, caption = caption)

LS0tCnRpdGxlOiAiRGlmZmVyZW5jZXMgaW4gbWVhbnMiCmF1dGhvcjogIk1lcmVkaXRoIENvbnJveSBhbmQgQW5kcmV3IEhlaXNzIgpkYXRlOiAiYHIgZm9ybWF0KFN5cy50aW1lKCksICclQiAlZSwgJVknKWAiCmVkaXRvcl9vcHRpb25zOiAKICBjaHVua19vdXRwdXRfdHlwZTogY29uc29sZQotLS0KCmBgYHtyIHNldHVwLCBtZXNzYWdlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoY2FjaGUgPSBGQUxTRSwgZmlnLnJldGluYSA9IDIsCiAgICAgICAgICAgICAgICAgICAgICB0aWR5Lm9wdHMgPSBsaXN0KHdpZHRoLmN1dG9mZiA9IDEyMCksICAjIEZvciBjb2RlCiAgICAgICAgICAgICAgICAgICAgICB3aWR0aCA9IDEyMCkgICMgRm9yIG91dHB1dApgYGAKCmBgYHtyIGxvYWQtbGlicmFyaWVzLWRhdGEsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KHBhbmRlcikKbGlicmFyeShicm9vbSkKbGlicmFyeShoZXJlKQoKc291cmNlKGZpbGUucGF0aChoZXJlKCksICJsaWIiLCAicGFuZGVyX29wdGlvbnMuUiIpKQpzb3VyY2UoZmlsZS5wYXRoKGhlcmUoKSwgImxpYiIsICJncmFwaGljcy5SIikpCnNvdXJjZShmaWxlLnBhdGgoaGVyZSgpLCAibGliIiwgImxhYmVscy5SIikpCgpzdXJ2ZXlfY2xlYW4gPC0gcmVhZFJEUyhmaWxlLnBhdGgoaGVyZSgpLCAiRGF0YSIsICJzdXJ2ZXlfY2xlYW4ucmRzIikpCmBgYAoKCiMjIEZyYW1pbmcgZWZmZWN0cyBmb3IgdmFyaW91cyBpc3N1ZXMKCmBgYHtyIHByb2Nlc3MtZnJhbWluZy1lZmZlY3RzfQpmcmFtaW5nX2Fub3ZhIDwtIGZ1bmN0aW9uKGZyYW1lX2ZhY3RvciwgaXNzdWVfc3VwcG9ydCwgaXNzdWVfbmFtZSkgewogICMgQ3JlYXRlIHF1b3N1cmVzCiAgZW5xdW9fZnJhbWUgPC0gZW5xdW8oZnJhbWVfZmFjdG9yKQogIGVucXVvX3N1cHBvcnQgPC0gZW5xdW8oaXNzdWVfc3VwcG9ydCkKICAKICAjIENyZWF0ZSBzdHJpbmcgdmVyc2lvbnMgb2YgYXJndW1lbnRzCiAgY2hhcl9mcmFtZSA8LSBkZXBhcnNlKHN1YnN0aXR1dGUoZnJhbWVfZmFjdG9yKSkKICBjaGFyX3N1cHBvcnQgPC0gZGVwYXJzZShzdWJzdGl0dXRlKGlzc3VlX3N1cHBvcnQpKQogIAogICMgU3VtbWFyaXplIGRhdGEgYmFzZWQgb24gaXNzdWUgYW5kIHN1cHBvcnQKICBmcmFtZV9zdW1tYXJ5IDwtIHN1cnZleV9jbGVhbiAlPiUKICAgIGZpbHRlcighaXMubmEoISFlbnF1b19mcmFtZSkpICU+JQogICAgZ3JvdXBfYnkoISFlbnF1b19mcmFtZSkgJT4lCiAgICBzdW1tYXJpemUoTiA9IG4oKSwKICAgICAgICAgICAgICBNZWFuID0gSG1pc2M6Ond0ZC5tZWFuKCEhZW5xdW9fc3VwcG9ydCwgd2VpZ2h0LCBuYS5ybSA9IFRSVUUpLAogICAgICAgICAgICAgIFNEID0gc3FydChIbWlzYzo6d3RkLnZhcighIWVucXVvX3N1cHBvcnQsIHdlaWdodCwgbmEucm0gPSBUUlVFKSkpICU+JQogICAgcmVuYW1lKEZyYW1lID0gISFlbnF1b19mcmFtZSkgJT4lCiAgICBhcnJhbmdlKEZyYW1lKQogIAogICMgQU5PVkEKICBhbm92YV9mb3JtdWxhIDwtIGFzLmZvcm11bGEocGFzdGUoY2hhcl9zdXBwb3J0LCAifiIsIGNoYXJfZnJhbWUpKQogIGZyYW1lX2Fub3ZhIDwtIGFvdihhbm92YV9mb3JtdWxhLCB3ZWlnaHRzID0gd2VpZ2h0LCBkYXRhID0gc3VydmV5X2NsZWFuKQogIAogICMgUm91bmQgdG8gbmVhcmVzdCB0ZW4tdGhvdXNhbmR0aAogIGZyYW1lX3NpZyA8LSBjZWlsaW5nKHRpZHkoZnJhbWVfYW5vdmEpWzEsXSRwLnZhbHVlICogMTAwMDApIC8gMTAwMDAKCiAgZnJhbWVfc3VtbWFyeV9zaWcgPC0gZnJhbWVfc3VtbWFyeSAlPiUKICAgIG11dGF0ZShgU2lnLmAgPSBjKE5BLCBmcmFtZV9zaWcpLAogICAgICAgICAgIElzc3VlID0gYyhpc3N1ZV9uYW1lLCBOQSkpICU+JQogICAgc2VsZWN0KElzc3VlLCBldmVyeXRoaW5nKCkpICU+JQogICAgbXV0YXRlKEZyYW1lID0gYXMuY2hhcmFjdGVyKEZyYW1lKSkKICAKICBmcmFtZV9zdW1tYXJ5X3NpZwp9CmBgYAoKYGBge3Igc2hvdy1mcmFtaW5nLWVmZmVjdHMsIHJlc3VsdHM9ImFzaXMifQojIEtLSyBleHBlcmltZW50Cmtra19zdW1tYXJ5IDwtIGZyYW1pbmdfYW5vdmEoS0tLRnJhbWVfQ2l2TGlicy5mYWN0b3IsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgIEtLS19TdXBwb3J0LCBtb2RlbF9ra2tfbmFtZSkKCiMgR3VucyBleHBlcmltZW50Cmd1bnNfc3VtbWFyeSA8LSBmcmFtaW5nX2Fub3ZhKEd1bkZyYW1lX0NpdkxpYnMuZmFjdG9yLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgR3VuX1N1cHBvcnQsIG1vZGVsX2d1bnNfbmFtZSkKCiMgU3RlbSBjZWxscyBleHBlcmltZW50CnN0ZW1jZWxsc19zdW1tYXJ5IDwtIGZyYW1pbmdfYW5vdmEoU3RlbUNlbGxzRnJhbWVfUG9zaXRpdmUuZmFjdG9yLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBTdGVtQ2VsbHNTdXBwb3J0LCBtb2RlbF9zdGVtY2VsbHNfbmFtZSkKCiMgQWZmaXJtYXRpdmUgYWN0aW9uIGV4cGVyaW1lbnQKYWFfc3VtbWFyeSA8LSBmcmFtaW5nX2Fub3ZhKEFBRnJhbWVfcG9zaXRpdmUuZmFjdG9yLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgIEFBU3VwcG9ydCwgbW9kZWxfYWZfYWNfbmFtZSkKCiMgRXZlcnl0aGluZyBpbiBvbmUgdGFibGUKZnJhbWluZ19zdW1tYXJ5IDwtIGJpbmRfcm93cyhra2tfc3VtbWFyeSwgZ3Vuc19zdW1tYXJ5LCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICBzdGVtY2VsbHNfc3VtbWFyeSwgYWFfc3VtbWFyeSkKCmNhcHRpb24gPC0gIkZyYW1pbmcgZWZmZWN0cyBmb3IgdmFyaW91cyBpc3N1ZXMiCnRibF9mcmFtaW5nIDwtIHBhbmRvYy50YWJsZS5yZXR1cm4oZnJhbWluZ19zdW1tYXJ5LCBjYXB0aW9uID0gY2FwdGlvbiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBqdXN0aWZ5ID0gImxsY2NjYyIsIGRpZ2l0cyA9IDMpCgpjYXQodGJsX2ZyYW1pbmcpCmNhdCh0YmxfZnJhbWluZywgZmlsZSA9IGZpbGUucGF0aChoZXJlKCksICJPdXRwdXQiLCAidGFibGVfZnJhbWluZ19hbm92YS5tZCIpKQpgYGAKCipOb3Rlcyo6ICJNZWFuIiB0YWJsZSBlbnRyaWVzIGFyZSBhdmVyYWdlIHJlc3BvbnNlcywgd2hlcmUgbWluaW11bSByZXNwb25zZSBpcyAxLCBhbmQgbWF4aW11bSByZXNwb25zZSBpcyA3LCB3aGVyZSA3IGlzIG1heGltdW0gc3VwcG9ydC4KClF1ZXN0aW9ucyBtZWFzdXJpbmcgc3VwcG9ydDoKCi0gKipLS0sgcmFsbHkqKjogSW4gZ2VuZXJhbCwgZG8geW91IG9wcG9zZSBvciBzdXBwb3J0IGFsbG93aW5nIG1lbWJlcnMgb2YgdGhlIEt1IEtsdXggS2xhbiB0byBob2xkIHB1YmxpYyByYWxsaWVzPyAKLSAqKkNvbmNlYWxlZCBoYW5kZ3VuIGxhdyoqOiBIb3cgc3Ryb25nbHkgZG8geW91IHN1cHBvcnQgb3Igb3Bwb3NlIGEgcHJvcG9zZWQgc3RhdGUgbGF3IGFsbG93aW5nIGNpdGl6ZW5zIHRvIGNhcnJ5IGNvbmNlYWxlZCBoYW5kZ3Vucz8KLSAqKlN0ZW0gY2VsbCByZXNlYXJjaCoqOiBIb3cgc3Ryb25nbHkgZG8geW91IG9wcG9zZSBvciBzdXBwb3J0IGVtYnJ5b25pYyBzdGVtIGNlbGwgcmVzZWFyY2g/Ci0gKipBZmZpcm1hdGl2ZSBhY3Rpb24gZm9yIHdvbWVuKio6IERvIHlvdSBvcHBvc2Ugb3Igc3VwcG9ydCBwcmVmZXJlbnRpYWwgaGlyaW5nIGFuZCBwcm9tb3Rpb24gb2Ygd29tZW4/CgoKIyMgVmlzdWFsaXplIGF2ZXJhZ2Ugc3VwcG9ydCBhY3Jvc3MgZnJhbWVzCgpgYGB7ciBwbG90LWRpZmZlcmVuY2VzLCB3YXJuaW5nPUZBTFNFfQpjbGVhbl9pc3N1ZV9tZWFucyA8LSBmdW5jdGlvbihmcmFtZV9mYWN0b3IsIGlzc3VlX3N1cHBvcnQpIHsKICBlbnF1b19mcmFtZSA8LSBlbnF1byhmcmFtZV9mYWN0b3IpCiAgZW5xdW9fc3VwcG9ydCA8LSBlbnF1byhpc3N1ZV9zdXBwb3J0KQogIAogIHN1cnZleV9jbGVhbiAlPiUKICAgIHNlbGVjdChmcmFtZSA9ICEhZW5xdW9fZnJhbWUsCiAgICAgICAgICAgc3VwcG9ydCA9ICEhZW5xdW9fc3VwcG9ydCkgJT4lCiAgICBmaWx0ZXIoIWlzLm5hKGZyYW1lKSwKICAgICAgICAgICAhaXMubmEoc3VwcG9ydCkpCn0KCmlzc3VlX21lYW5zIDwtIHRyaWJibGUoCiAgfmlzc3VlX25hbWUsIH5wbG90LAogIG1vZGVsX2tra19uYW1lLCBjbGVhbl9pc3N1ZV9tZWFucyhLS0tGcmFtZV9DaXZMaWJzLmZhY3RvciwgS0tLX1N1cHBvcnQpLAogIG1vZGVsX2d1bnNfbmFtZSwgY2xlYW5faXNzdWVfbWVhbnMoR3VuRnJhbWVfQ2l2TGlicy5mYWN0b3IsIEd1bl9TdXBwb3J0KSwKICBtb2RlbF9zdGVtY2VsbHNfbmFtZSwgY2xlYW5faXNzdWVfbWVhbnMoU3RlbUNlbGxzRnJhbWVfUG9zaXRpdmUuZmFjdG9yLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgU3RlbUNlbGxzU3VwcG9ydCksCiAgbW9kZWxfYWZfYWNfbmFtZV9wbG90LCBjbGVhbl9pc3N1ZV9tZWFucyhBQUZyYW1lX3Bvc2l0aXZlLmZhY3RvciwgQUFTdXBwb3J0KQopICU+JQogIHVubmVzdChwbG90KSAlPiUKICBtdXRhdGUoaXNzdWVfbmFtZSA9IGZjdF9pbm9yZGVyKGlzc3VlX25hbWUsIG9yZGVyZWQgPSBUUlVFKSkgJT4lCiAgbGVmdF9qb2luKGZyYW1lX2xhYnNfYWxsLCBieSA9ICJmcmFtZSIpCgpzZXQuc2VlZCgxMjM0KQoKcGxvdF9pc3N1ZV9tZWFucyA8LSBnZ3Bsb3QoaXNzdWVfbWVhbnMsIGFlcyh4ID0gZnJhbWVfcGxvdCwgeSA9IHN1cHBvcnQpKSArCiAgZ2VvbV9wb2ludChwb3NpdGlvbiA9IHBvc2l0aW9uX2ppdHRlcihoZWlnaHQgPSAwLjEsIHdpZHRoID0gMC4xKSwKICAgICAgICAgICAgIGFscGhhID0gMC4xLCBzaXplID0gMC4zKSArCiAgc3RhdF9zdW1tYXJ5KGZ1bi5kYXRhID0gIm1lYW5fY2xfYm9vdCIsIGNvbG91ciA9ICJibGFjayIsCiAgICAgICAgICAgICAgICAgc2l6ZSA9IDEuNSwgZmF0dGVuID0gMikgKwogIHNjYWxlX3lfY29udGludW91cyhicmVha3MgPSAxOjcsCiAgICAgICAgICAgICAgICAgICAgIGxhYmVscyA9IGMoIlN0cm9uZ2x5IG9wcG9zZSAoMSkiLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiTW9kZXJhdGVseSBvcHBvc2UgKDIpIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiU2xpZ2h0bHkgb3Bwb3NlICgzKSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIk5laXRoZXIgb3Bwb3NlIG5vciBzdXBwb3J0ICg0KSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlNsaWdodGx5IHN1cHBvcnQgKDUpIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiTW9kZXJhdGVseSBzdXBwb3J0ICg2KSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlN0cm9uZ2x5IHN1cHBvcnQgKDcpIikpICsKICBjb29yZF9jYXJ0ZXNpYW4oeWxpbSA9IGMoMSwgNykpICsKICBsYWJzKHggPSAiRnJhbWUiLCB5ID0gTlVMTCkgKwogIHRoZW1lX2ZyYW1pbmcoKSArCiAgdGhlbWUocGFuZWwuZ3JpZC5tYWpvci54ID0gZWxlbWVudF9ibGFuaygpLAogICAgICAgIHBhbmVsLmdyaWQubWlub3IueSA9IGVsZW1lbnRfYmxhbmsoKSwKICAgICAgICBzdHJpcC50ZXh0ID0gZWxlbWVudF90ZXh0KHNpemUgPSByZWwoMC44KSkpICsKICBmYWNldF93cmFwKH4gaXNzdWVfbmFtZSwgc2NhbGVzID0gImZyZWVfeCIsIG5yb3cgPSAxKQpgYGAKCmBgYHtyIHNob3ctZGlmZmVyZW5jZXMsIGZpZy53aWR0aD04LjUsIGZpZy5oZWlnaHQ9NC41fQpwbG90X2lzc3VlX21lYW5zCgpjYXB0aW9uIDwtIGMoIkRpZmZlcmVuY2VzIGluIG1lYW5zIGFjcm9zcyBmcmFtZXMgYW5kIGlzc3VlcyIpCnNhdmUuZmlnLmNhcHRpb24ocGxvdF9pc3N1ZV9tZWFucywgZmlsZW5hbWUgPSAiaXNzdWVfbWVhbnMiLCAKICAgICAgICAgICAgICAgICB3aWR0aCA9IDguNSwgaGVpZ2h0ID0gNC41LCBjYXB0aW9uID0gY2FwdGlvbikKYGBgCg==