Init

library(kirkegaard)
## Loading required package: tidyverse
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✔ ggplot2 3.3.6     ✔ purrr   0.3.4
## ✔ tibble  3.1.7     ✔ dplyr   1.0.9
## ✔ tidyr   1.2.0     ✔ stringr 1.4.0
## ✔ readr   2.1.2     ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## Loading required package: magrittr
## 
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
## 
##     set_names
## The following object is masked from 'package:tidyr':
## 
##     extract
## Loading required package: weights
## Loading required package: Hmisc
## Loading required package: lattice
## Loading required package: survival
## Loading required package: Formula
## 
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## The following objects are masked from 'package:base':
## 
##     format.pval, units
## Loading required package: assertthat
## 
## Attaching package: 'assertthat'
## The following object is masked from 'package:tibble':
## 
##     has_name
## Loading required package: psych
## 
## Attaching package: 'psych'
## The following object is masked from 'package:Hmisc':
## 
##     describe
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
## 
## Attaching package: 'kirkegaard'
## The following object is masked from 'package:psych':
## 
##     rescale
## The following object is masked from 'package:assertthat':
## 
##     are_equal
## The following objects are masked from 'package:purrr':
## 
##     is_logical, is_numeric
## The following object is masked from 'package:base':
## 
##     +
load_packages(
  haven,
  rms,
  sjPlot
)
## Loading required package: SparseM
## 
## Attaching package: 'SparseM'
## The following object is masked from 'package:base':
## 
##     backsolve
## Registered S3 method overwritten by 'parameters':
##   method                         from      
##   format.parameters_distribution datawizard
theme_set(theme_bw())

Data

#ANES datasets
anes2018 = read_sav("data/anes_pilot_2018.sav")
anes2019 = read_sav("data/anes_pilot_2019.sav")
anes2020 = read_sav("data/anes_pilot_2020ets_sav/anes_pilot_2020ets_sav.SAV")
anes2020ts = read_sav("data/anes_timeseries_2020_spss_20220210/anes_timeseries_2020_spss_20220210.sav")

Recode

#rename numbers in levels
rm_numbers_in_levels = function(x) {
  levels(x) = levels(x) %>% str_replace("\\d+\\. ", "")
  x
}

#standardize race
standardize_race = function(x) {
  plyr::revalue(
    x,
    replace = c(
      "Black or African American" = "Black",
      "American Indian or Alaska Native" = "Native American",
      "White, non-Hispanic" = "White",
      "Black, non-Hispanic" = "Black",
      "Native American/Alaska Native or other race, non-Hispanic alone" = "Native American",
      "Native Hawaiian, or other Pacific islander" = "Native American",
      "Asian or Native Hawaiian/other Pacific Islander, non-Hispanic alone" = "Asian",
      "Multiple races, non-Hispanic" = "Mixed",
      "Middle Eastern" = "Other",
      "Missing" = NA
    ))
}

#standardize educ
standardize_educ = function(x) {
  plyr::revalue(
    x,
    replace = c(
      "12th grade or below, no high school diploma" = "No HS",
      "Less than high school credential" = "No HS",
      "High school graduate/diploma or equivalent" = "High school graduate",
      " High school graduate - High school diploma or equivalent (e.g. GED)" = "High school graduate",
      "Associate degree in college - occupational/vocational" = "2-year",
      "Associate degree in college - academic" = "2-year",
      "Some college but no degree" = "Some college",
      "Associate degree" = "2-year",
      "Bachelor’s degree" = "4-year",
      "Bachelor's degree (e.g. BA, AB, BS)" = "4-year",
      "Master’s degree" = "Post-grad",
      "Master's degree (e.g. MA, MS, MEng, MEd, MSW, MBA)" = "Post-grad",
      "Professional degree (e.g., MD, DDS, JD)" = "Post-grad",
      "Professional school degree (e.g. MD, DDS, DVM, LLB, JD)/Doctoral degree (e.g. PHD, EDD)" = "Post-grad",
      "Doctorate" = "Post-grad"
    ))
}

#2018
anes2018$honest %<>% as_factor() %>% fct_drop()
anes2018$honest %>% table2(sort_descending = NULL)
anes2018$honest_01 = anes2018$honest %>% as.numeric() %>% rescale(new_min = 0, new_max = 1)
anes2018$honest_01_z = anes2018$honest_01 %>% standardize()
anes2018$honest_binary = (anes2018$honest_01 == 1) %>% factor()
anes2018$race_orig = anes2018$race %>% as_factor()
anes2018$race %<>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels() %>% standardize_race()
## The following `from` values were not present in `x`: Black or African American, American Indian or Alaska Native, White, non-Hispanic, Black, non-Hispanic, Native American/Alaska Native or other race, non-Hispanic alone, Native Hawaiian, or other Pacific islander, Asian or Native Hawaiian/other Pacific Islander, non-Hispanic alone, Multiple races, non-Hispanic, Middle Eastern, Missing
anes2018$race %>% table2(sort_descending = NULL)
anes2018$gender %<>% as_factor() %>% fct_drop()
anes2018$gender %>% table2(sort_descending = NULL)
anes2018$birthyr %<>% as.numeric()
anes2018$age = (2018 - anes2018$birthyr) %>% standardize()
anes2018$educ %<>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels() %>% standardize_educ()
## The following `from` values were not present in `x`: 12th grade or below, no high school diploma, Less than high school credential, High school graduate/diploma or equivalent,  High school graduate - High school diploma or equivalent (e.g. GED), Associate degree in college - occupational/vocational, Associate degree in college - academic, Some college but no degree, Associate degree, Bachelor’s degree, Bachelor's degree (e.g. BA, AB, BS), Master’s degree, Master's degree (e.g. MA, MS, MEng, MEd, MSW, MBA), Professional degree (e.g., MD, DDS, JD), Professional school degree (e.g. MD, DDS, DVM, LLB, JD)/Doctoral degree (e.g. PHD, EDD), Doctorate
anes2018$educ %>% table2(sort_descending = NULL)
anes2018$party = anes2018$pid7x %>% as.numeric() %>% rescale(new_min = 0, new_max = 1) %>% standardize()
anes2018$ideo = anes2018$ideo5 %>% as.numeric() %>% mapvalues(c(-7, -1, 6), to = rep(NA, 3)) %>% rescale(new_min = 0, new_max = 1) %>% standardize()
## The following `from` values were not present in `x`: -7, -1
anes2018$ideo_fct = anes2018$ideo5 %>% as_factor() %>% fct_drop() %>% mapvalues("Not sure", NA)

#2019 pilot
anes2019$serious %<>% as_factor() %>% fct_drop()
anes2019$serious %>% table2(sort_descending = NULL)
anes2019$honest = anes2019$serious
anes2019$honest_01 = anes2019$honest %>% as.numeric() %>% rescale(new_min = 0, new_max = 1)
anes2019$honest_01_z = anes2019$honest_01 %>% standardize()
anes2019$honest_binary = (anes2019$honest_01 == 1) %>% factor()
anes2019$race_orig = anes2019$race %>% as_factor()
anes2019$race %<>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels() %>% standardize_race()
## The following `from` values were not present in `x`: Black or African American, American Indian or Alaska Native, White, non-Hispanic, Black, non-Hispanic, Native American/Alaska Native or other race, non-Hispanic alone, Native Hawaiian, or other Pacific islander, Asian or Native Hawaiian/other Pacific Islander, non-Hispanic alone, Multiple races, non-Hispanic, Missing
anes2019$race %>% table2(sort_descending = NULL)
anes2019$gender %<>% as_factor() %>% fct_drop()
anes2019$gender %>% table2(sort_descending = NULL)
anes2019$birthyr %<>% as.numeric()
anes2019$age = (2019 - anes2019$birthyr) %>% standardize()
anes2019$educ %<>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels() %>% standardize_educ()
## The following `from` values were not present in `x`: 12th grade or below, no high school diploma, Less than high school credential, High school graduate/diploma or equivalent,  High school graduate - High school diploma or equivalent (e.g. GED), Associate degree in college - occupational/vocational, Associate degree in college - academic, Some college but no degree, Associate degree, Bachelor’s degree, Bachelor's degree (e.g. BA, AB, BS), Master’s degree, Master's degree (e.g. MA, MS, MEng, MEd, MSW, MBA), Professional degree (e.g., MD, DDS, JD), Professional school degree (e.g. MD, DDS, DVM, LLB, JD)/Doctoral degree (e.g. PHD, EDD), Doctorate
anes2019$educ %>% table2(sort_descending = NULL)
anes2019$party = anes2019$pid7x %>% as.numeric() %>% rescale(new_min = 0, new_max = 1) %>% standardize()
anes2019$ideo = anes2019$ideo5 %>% mapvalues(from = c(-7, -1, 6), to = rep(NA, 3)) %>% as.numeric() %>% rescale(new_min = 0, new_max = 1) %>% standardize()
## The following `from` values were not present in `x`: -7, -1
anes2019$ideo_fct = anes2019$ideo5 %>% as_factor() %>% fct_drop() %>% mapvalues("Not sure", NA)

#2020 pilot
anes2020$serious %<>% mapvalues(9, NA) %>% as_factor() %>% fct_drop()
anes2020$serious %>% table2(sort_descending = NULL)
anes2020$honest = anes2020$serious
anes2020$honest_01 = anes2020$honest %>% as.numeric() %>% rescale(new_min = 0, new_max = 1)
anes2020$honest_01_z = anes2020$honest_01 %>% standardize()
anes2020$honest_binary = (anes2020$honest_01 == 1) %>% factor()
anes2020$race_orig = anes2020$race7 %>% as_factor()
anes2020$race = anes2020$race7 %>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels() %>% standardize_race()
## The following `from` values were not present in `x`: White, non-Hispanic, Black, non-Hispanic, Native American/Alaska Native or other race, non-Hispanic alone, Asian or Native Hawaiian/other Pacific Islander, non-Hispanic alone, Multiple races, non-Hispanic, Middle Eastern
anes2020$race %>% table2(sort_descending = NULL)
anes2020$sex %<>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels()
anes2020$sex %>% table2(sort_descending = NULL)
anes2020$gender = anes2020$sex
anes2020$birthyr %<>% as.numeric()
anes2020$age = (2020 - anes2020$birthyr) %>% standardize()
anes2020$educ %<>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels() %>% standardize_educ()
## The following `from` values were not present in `x`: Less than high school credential,  High school graduate - High school diploma or equivalent (e.g. GED), Associate degree in college - occupational/vocational, Associate degree in college - academic, Bachelor's degree (e.g. BA, AB, BS), Master's degree (e.g. MA, MS, MEng, MEd, MSW, MBA), Professional school degree (e.g. MD, DDS, DVM, LLB, JD)/Doctoral degree (e.g. PHD, EDD)
anes2020$educ %>% table2(sort_descending = NULL)
anes2020$party = anes2020$pid7 %>% as.numeric() %>% mapvalues(from = 9, to = NA) %>% rescale(new_min = 0, new_max = 1) %>% standardize()
anes2020$ideo = anes2020$lcself %>% as.numeric() %>% mapvalues(from = 9, to = NA) %>% rescale(new_min = 0, new_max = 1) %>% standardize()
## The following `from` values were not present in `x`: 9
anes2020$ideo_fct = anes2020$lcself %>% as_factor() %>% fct_drop()

#2020 time series
anes2020ts$honest = anes2020ts$V201657 %>% mapvalues(c(-5, -1), c(NA, NA)) %>%  as_factor() %>% fct_drop() 
anes2020ts$honest %>% table2(sort_descending = NULL)
anes2020ts$honest_01 = anes2020ts$honest %>% fct_rev() %>% as.numeric() %>% rescale(new_min = 0, new_max = 1)
anes2020ts$honest_01_z = anes2020ts$honest_01 %>% standardize()
anes2020ts$honest_binary = (anes2020ts$honest_01 == 1) %>% factor()
anes2020ts$race_orig = anes2020ts$V201549x %>% as_factor()
anes2020ts$race = anes2020ts$V201549x %>% mapvalues(from = c(-8, -9), to = c(NA, NA)) %>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels() %>% standardize_race()
## The following `from` values were not present in `x`: Black or African American, American Indian or Alaska Native, Native Hawaiian, or other Pacific islander, Middle Eastern, Missing
anes2020ts$race %>% table2(sort_descending = NULL)
anes2020ts$gender = anes2020ts$V201600 %>% mapvalues(-9, NA) %>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels()
anes2020ts$gender %>% table2(sort_descending = NULL)
anes2020ts$age = anes2020ts$V201507x %>% as.numeric() %>% mapvalues(-9, NA) %>% standardize()
anes2020ts$educ = anes2020ts$V201510 %>% mapvalues(from = c(-8, -9, 95), to = rep(NA, 3)) %>% as_factor() %>% fct_drop()  %>% rm_numbers_in_levels() %>% standardize_educ()
## The following `from` values were not present in `x`: 12th grade or below, no high school diploma, High school graduate/diploma or equivalent, Associate degree, Bachelor’s degree, Master’s degree, Professional degree (e.g., MD, DDS, JD), Doctorate
anes2020ts$educ %>% table2(sort_descending = NULL)
anes2020ts$party = anes2020ts$V201231x %>% as.numeric() %>% mapvalues(from = c(-8, -9), to = rep(NA, 2)) %>% rescale(new_min = 0, new_max = 1) %>% standardize()
anes2020ts$ideo = anes2020ts$V201200 %>% as.numeric() %>% mapvalues(from = c(-8, -9, 99), to = rep(NA, 3)) %>% rescale(new_min = 0, new_max = 1) %>% standardize()
anes2020ts$ideo_fct = anes2020ts$V201200 %>% as_factor() %>% fct_drop() %>% rm_numbers_in_levels() %>% mapvalues(c("Haven't thought much about this", "-Refused", "-Don't know"), to = rep(NA, 3))

#combine the datasets for select variables
select_vars = c("honest", "honest_01", "honest_01_z", "honest_binary", "race", "gender", "age", "educ", "party", "ideo")
d = bind_rows(
  anes2018 %>% select(!!select_vars) %>% mutate(wave = "2018"),
  anes2019 %>% select(!!select_vars) %>% mutate(wave = "2019"),
  anes2020 %>% select(!!select_vars) %>% mutate(wave = "2020"),
  anes2020ts %>% select(!!select_vars) %>% mutate(wave = "2020ts")
)

#recode race slightly so one can fit an interaction model with wave
#this requires the levels of race to be able for every year
table(d$race, d$wave)
##                  
##                   2018 2019 2020 2020ts
##   White           1854 2218 2161   5963
##   Black            255  338  327    726
##   Hispanic         247  359  369    762
##   Asian             46   87  112    284
##   Native American   13   52   22    172
##   Mixed             55   80   87    271
##   Other             29   31    0      0
d$race2 = d$race %>% mapvalues(from = c("Other"), to = rep(NA, 1))

Analysis

#basics
#look at the combined variables
d$gender %>% table2(sort_descending = NULL)
d$race %>% table2(sort_descending = NULL)
d$educ %>% table2(sort_descending = NULL) %>% print(n=Inf)
## # A tibble: 7 × 3
##   Group                Count Percent
##   <fct>                <dbl>   <dbl>
## 1 No HS                  756   4.44 
## 2 High school graduate  3570  21.0  
## 3 Some college          3558  20.9  
## 4 2-year                2087  12.3  
## 5 4-year                3985  23.4  
## 6 Post-grad             2938  17.3  
## 7 <NA>                   131   0.769
describeBy(d$honest_01, d$wave)
## 
##  Descriptive statistics by group 
## group: 2018
##    vars    n mean   sd median trimmed mad min max range  skew kurtosis se
## X1    1 2500 0.93 0.19      1    0.98   0   0   1     1 -3.22    10.55  0
## ------------------------------------------------------------ 
## group: 2019
##    vars    n mean   sd median trimmed mad min max range  skew kurtosis se
## X1    1 3165 0.89 0.25      1    0.96   0   0   1     1 -2.43     4.87  0
## ------------------------------------------------------------ 
## group: 2020
##    vars    n mean   sd median trimmed mad min max range  skew kurtosis se
## X1    1 3079 0.92 0.21      1    0.98   0   0   1     1 -2.82     7.53  0
## ------------------------------------------------------------ 
## group: 2020ts
##    vars   n mean   sd median trimmed mad min max range  skew kurtosis   se
## X1    1 491 0.92 0.22      1    0.97   0   0   1     1 -2.64     6.41 0.01
#OLS
ols_fit = ols(honest_01 ~ age + gender + race + educ + party + ideo + wave, data = d)
ols_fit
## Frequencies of Missing Values Due to Each Variable
## honest_01       age    gender      race      educ     party      ideo      wave 
##      7790       348        67       105       131       252      1792         0 
## 
## Linear Regression Model
##  
##  ols(formula = honest_01 ~ age + gender + race + educ + party + 
##      ideo + wave, data = d)
##  
##  
##                  Model Likelihood    Discrimination    
##                        Ratio Test           Indexes    
##  Obs    8500    LR chi2    591.95    R2       0.067    
##  sigma0.2003    d.f.           18    R2 adj   0.065    
##  d.f.   8481    Pr(> chi2) 0.0000    g        0.060    
##  
##  Residuals
##  
##       Min       1Q   Median       3Q      Max 
##  -1.04374  0.01266  0.05360  0.09470  0.26090 
##  
##  
##                            Coef    S.E.   t      Pr(>|t|)
##  Intercept                  0.9036 0.0126  71.61 <0.0001 
##  age                        0.0339 0.0023  14.65 <0.0001 
##  gender=Female              0.0069 0.0044   1.58 0.1151  
##  race=Black                -0.0403 0.0075  -5.35 <0.0001 
##  race=Hispanic             -0.0794 0.0075 -10.63 <0.0001 
##  race=Asian                -0.0285 0.0132  -2.16 0.0305  
##  race=Native American      -0.0521 0.0227  -2.29 0.0220  
##  race=Mixed                 0.0036 0.0138   0.26 0.7954  
##  race=Other                -0.0140 0.0280  -0.50 0.6171  
##  educ=High school graduate  0.0332 0.0125   2.65 0.0081  
##  educ=Some college          0.0716 0.0126   5.68 <0.0001 
##  educ=2-year                0.0599 0.0133   4.49 <0.0001 
##  educ=4-year                0.0598 0.0126   4.76 <0.0001 
##  educ=Post-grad             0.0462 0.0129   3.58 0.0003  
##  party                     -0.0014 0.0022  -0.64 0.5245  
##  ideo                      -0.0056 0.0023  -2.42 0.0157  
##  wave=2019                 -0.0412 0.0057  -7.18 <0.0001 
##  wave=2020                 -0.0269 0.0057  -4.75 <0.0001 
##  wave=2020ts               -0.0128 0.0109  -1.17 0.2411  
## 
#OLS z
ols_fit_z = ols(honest_01_z ~ age + gender + race + educ + party + ideo, data = d)
ols_fit_z
## Frequencies of Missing Values Due to Each Variable
## honest_01_z         age      gender        race        educ       party 
##        7790         348          67         105         131         252 
##        ideo 
##        1792 
## 
## Linear Regression Model
##  
##  ols(formula = honest_01_z ~ age + gender + race + educ + party + 
##      ideo, data = d)
##  
##  
##                  Model Likelihood    Discrimination    
##                        Ratio Test           Indexes    
##  Obs    8500    LR chi2    545.81    R2       0.062    
##  sigma0.9033    d.f.           15    R2 adj   0.061    
##  d.f.   8484    Pr(> chi2) 0.0000    g        0.260    
##  
##  Residuals
##  
##       Min       1Q   Median       3Q      Max 
##  -5.48307  0.07694  0.23945  0.42511  1.22709 
##  
##  
##                            Coef    S.E.   t      Pr(>|t|)
##  Intercept                 -0.1587 0.0544  -2.92 0.0036  
##  age                        0.1561 0.0104  14.96 <0.0001 
##  gender=Female              0.0333 0.0197   1.69 0.0911  
##  race=Black                -0.1857 0.0339  -5.48 <0.0001 
##  race=Hispanic             -0.3631 0.0336 -10.80 <0.0001 
##  race=Asian                -0.1223 0.0594  -2.06 0.0396  
##  race=Native American      -0.2161 0.1024  -2.11 0.0348  
##  race=Mixed                 0.0178 0.0622   0.29 0.7746  
##  race=Other                -0.0398 0.1259  -0.32 0.7517  
##  educ=High school graduate  0.1564 0.0565   2.77 0.0056  
##  educ=Some college          0.3413 0.0568   6.01 <0.0001 
##  educ=2-year                0.2843 0.0601   4.73 <0.0001 
##  educ=4-year                0.2816 0.0566   4.97 <0.0001 
##  educ=Post-grad             0.2173 0.0581   3.74 0.0002  
##  party                     -0.0075 0.0100  -0.74 0.4571  
##  ideo                      -0.0253 0.0104  -2.43 0.0152  
## 
#logistic
lrm_fit = lrm(honest_binary ~ age + gender + race + educ + party + ideo + wave, data = d)
lrm_fit
## Frequencies of Missing Values Due to Each Variable
## honest_binary           age        gender          race          educ 
##          7790           348            67           105           131 
##         party          ideo          wave 
##           252          1792             0 
## 
## Logistic Regression Model
##  
##  lrm(formula = honest_binary ~ age + gender + race + educ + party + 
##      ideo + wave, data = d)
##  
##  
##                         Model Likelihood        Discrimination    Rank Discrim.    
##                               Ratio Test               Indexes          Indexes    
##  Obs          8500    LR chi2     524.66        R2       0.103    C       0.691    
##   FALSE       1341    d.f.            18      R2(18,8500)0.058    Dxy     0.381    
##   TRUE        7159    Pr(> chi2) <0.0001    R2(18,3388.3)0.139    gamma   0.381    
##  max |deriv| 1e-13                              Brier    0.124    tau-a   0.101    
##  
##                            Coef    S.E.   Wald Z Pr(>|Z|)
##  Intercept                  1.6230 0.1532 10.60  <0.0001 
##  age                        0.4832 0.0336 14.39  <0.0001 
##  gender=Female              0.0641 0.0621  1.03  0.3021  
##  race=Black                -0.6229 0.0941 -6.62  <0.0001 
##  race=Hispanic             -0.7632 0.0884 -8.63  <0.0001 
##  race=Asian                -0.4969 0.1604 -3.10  0.0019  
##  race=Native American      -0.4735 0.2837 -1.67  0.0951  
##  race=Mixed                -0.0354 0.1968 -0.18  0.8572  
##  race=Other                -0.6901 0.3681 -1.87  0.0609  
##  educ=High school graduate  0.3837 0.1473  2.60  0.0092  
##  educ=Some college          0.8015 0.1520  5.27  <0.0001 
##  educ=2-year                0.6791 0.1648  4.12  <0.0001 
##  educ=4-year                0.6557 0.1506  4.36  <0.0001 
##  educ=Post-grad             0.5784 0.1560  3.71  0.0002  
##  party                     -0.0170 0.0316 -0.54  0.5904  
##  ideo                      -0.0883 0.0328 -2.69  0.0071  
##  wave=2019                 -0.4059 0.0857 -4.73  <0.0001 
##  wave=2020                 -0.4101 0.0847 -4.84  <0.0001 
##  wave=2020ts                0.1299 0.1808  0.72  0.4725  
## 
#plot models
plot_model(ols_fit, title = "")

GG_save("figs/joint_ols.png")

plot_model(ols_fit_z, title = "")

GG_save("figs/joint_ols_z.png")

plot_model(lrm_fit, title = "")

GG_save("figs/joint_lrm.png")

#one variable at a time fits
pred_vars = c("age", "gender", "race", "educ", "party", "ideo")

ols_models = map(pred_vars, function(p) {
  lm(str_glue("honest_01 ~ {p}") %>% as.formula(), data = d)
})

ols_models %>% map(summary)
## [[1]]
## 
## Call:
## lm(formula = str_glue("honest_01 ~ {p}") %>% as.formula(), data = d)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.01738  0.02412  0.06186  0.11265  0.18027 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.912339   0.002239  407.50   <2e-16 ***
## age         0.047449   0.002236   21.22   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2151 on 9226 degrees of freedom
##   (7797 observations deleted due to missingness)
## Multiple R-squared:  0.04655,    Adjusted R-squared:  0.04644 
## F-statistic: 450.4 on 1 and 9226 DF,  p-value: < 2.2e-16
## 
## 
## [[2]]
## 
## Call:
## lm(formula = str_glue("honest_01 ~ {p}") %>% as.formula(), data = d)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.91296  0.08704  0.08704  0.08809  0.08809 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   0.912960   0.003355  272.13   <2e-16 ***
## genderFemale -0.001055   0.004597   -0.23    0.818    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2204 on 9233 degrees of freedom
##   (7790 observations deleted due to missingness)
## Multiple R-squared:  5.705e-06,  Adjusted R-squared:  -0.0001026 
## F-statistic: 0.05268 on 1 and 9233 DF,  p-value: 0.8185
## 
## 
## [[3]]
## 
## Call:
## lm(formula = str_glue("honest_01 ~ {p}") %>% as.formula(), data = d)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.93425  0.06575  0.06575  0.06575  0.17500 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          0.934253   0.002673 349.474  < 2e-16 ***
## raceBlack           -0.062839   0.007439  -8.447  < 2e-16 ***
## raceHispanic        -0.107919   0.007323 -14.737  < 2e-16 ***
## raceAsian           -0.057816   0.013688  -4.224 2.43e-05 ***
## raceNative American -0.109253   0.023017  -4.747 2.10e-06 ***
## raceMixed           -0.009883   0.014310  -0.691    0.490    
## raceOther           -0.038419   0.028127  -1.366    0.172    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2169 on 9212 degrees of freedom
##   (7806 observations deleted due to missingness)
## Multiple R-squared:  0.0299, Adjusted R-squared:  0.02927 
## F-statistic: 47.32 on 6 and 9212 DF,  p-value: < 2.2e-16
## 
## 
## [[4]]
## 
## Call:
## lm(formula = str_glue("honest_01 ~ {p}") %>% as.formula(), data = d)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.93133  0.06867  0.07028  0.07818  0.16875 
## 
## Coefficients:
##                          Estimate Std. Error t value Pr(>|t|)    
## (Intercept)               0.83125    0.01094  75.995  < 2e-16 ***
## educHigh school graduate  0.05293    0.01185   4.468 7.99e-06 ***
## educSome college          0.10008    0.01201   8.336  < 2e-16 ***
## educ2-year                0.09346    0.01286   7.267 3.96e-13 ***
## educ4-year                0.09847    0.01195   8.237  < 2e-16 ***
## educPost-grad             0.09057    0.01235   7.333 2.43e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2188 on 9222 degrees of freedom
##   (7797 observations deleted due to missingness)
## Multiple R-squared:  0.0136, Adjusted R-squared:  0.01306 
## F-statistic: 25.42 on 5 and 9222 DF,  p-value: < 2.2e-16
## 
## 
## [[5]]
## 
## Call:
## lm(formula = str_glue("honest_01 ~ {p}") %>% as.formula(), data = d)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.91892  0.08121  0.08269  0.08463  0.08583 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.916653   0.002271 403.623   <2e-16 ***
## party       -0.001622   0.002272  -0.714    0.475    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2156 on 9010 degrees of freedom
##   (8013 observations deleted due to missingness)
## Multiple R-squared:  5.657e-05,  Adjusted R-squared:  -5.441e-05 
## F-statistic: 0.5097 on 1 and 9010 DF,  p-value: 0.4753
## 
## 
## [[6]]
## 
## Call:
## lm(formula = str_glue("honest_01 ~ {p}") %>% as.formula(), data = d)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.92650  0.07429  0.07820  0.08052  0.08343 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.921683   0.002254 408.972   <2e-16 ***
## ideo        0.002762   0.002255   1.225    0.221    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.209 on 8602 degrees of freedom
##   (8421 observations deleted due to missingness)
## Multiple R-squared:  0.0001745,  Adjusted R-squared:  5.824e-05 
## F-statistic: 1.501 on 1 and 8602 DF,  p-value: 0.2205
ols_z_models = map(pred_vars, function(p) {
  lm(str_glue("honest_01_z ~ {p}") %>% as.formula(), data = d)
})

ols_z_models %>% map(summary)
## [[1]]
## 
## Call:
## lm(formula = str_glue("honest_01_z ~ {p}") %>% as.formula(), 
##     data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.3913  0.1000  0.2813  0.5136  0.8357 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0002673  0.0101487  -0.026    0.979    
## age          0.2182020  0.0101347  21.530   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9749 on 9226 degrees of freedom
##   (7797 observations deleted due to missingness)
## Multiple R-squared:  0.04784,    Adjusted R-squared:  0.04774 
## F-statistic: 463.6 on 1 and 9226 DF,  p-value: < 2.2e-16
## 
## 
## [[2]]
## 
## Call:
## lm(formula = str_glue("honest_01_z ~ {p}") %>% as.formula(), 
##     data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.9921  0.3606  0.3941  0.4240  0.4313 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)
## (Intercept)   0.003900   0.015218   0.256    0.798
## genderFemale -0.007324   0.020854  -0.351    0.725
## 
## Residual standard error: 0.9999 on 9233 degrees of freedom
##   (7790 observations deleted due to missingness)
## Multiple R-squared:  1.336e-05,  Adjusted R-squared:  -9.495e-05 
## F-statistic: 0.1233 on 1 and 9233 DF,  p-value: 0.7255
## 
## 
## [[3]]
## 
## Call:
## lm(formula = str_glue("honest_01_z ~ {p}") %>% as.formula(), 
##     data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.0856  0.2672  0.3007  0.3305  0.8179 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          0.09732    0.01213   8.023 1.16e-15 ***
## raceBlack           -0.28726    0.03376  -8.509  < 2e-16 ***
## raceHispanic        -0.48740    0.03323 -14.667  < 2e-16 ***
## raceAsian           -0.23923    0.06212  -3.851 0.000118 ***
## raceNative American -0.42321    0.10445  -4.052 5.12e-05 ***
## raceMixed           -0.03587    0.06494  -0.552 0.580762    
## raceOther           -0.13576    0.12764  -1.064 0.287529    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9842 on 9212 degrees of freedom
##   (7806 observations deleted due to missingness)
## Multiple R-squared:  0.02909,    Adjusted R-squared:  0.02846 
## F-statistic:    46 on 6 and 9212 DF,  p-value: < 2.2e-16
## 
## 
## [[4]]
## 
## Call:
## lm(formula = str_glue("honest_01_z ~ {p}") %>% as.formula(), 
##     data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.0805  0.2848  0.3354  0.3895  0.8266 
## 
## Coefficients:
##                          Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              -0.39876    0.04958  -8.043 9.87e-16 ***
## educHigh school graduate  0.26936    0.05369   5.017 5.35e-07 ***
## educSome college          0.49104    0.05442   9.024  < 2e-16 ***
## educ2-year                0.46133    0.05829   7.914 2.78e-15 ***
## educ4-year                0.47844    0.05419   8.829  < 2e-16 ***
## educPost-grad             0.43718    0.05598   7.809 6.38e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9916 on 9222 degrees of freedom
##   (7797 observations deleted due to missingness)
## Multiple R-squared:  0.01503,    Adjusted R-squared:  0.01449 
## F-statistic: 28.14 on 5 and 9222 DF,  p-value: < 2.2e-16
## 
## 
## [[5]]
## 
## Call:
## lm(formula = str_glue("honest_01_z ~ {p}") %>% as.formula(), 
##     data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.0189  0.3377  0.3699  0.3967  0.4195 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  0.020229   0.010255   1.973   0.0486 *
## party       -0.008285   0.010261  -0.807   0.4194  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9735 on 9010 degrees of freedom
##   (8013 observations deleted due to missingness)
## Multiple R-squared:  7.235e-05,  Adjusted R-squared:  -3.863e-05 
## F-statistic: 0.652 on 1 and 9010 DF,  p-value: 0.4194
## 
## 
## [[6]]
## 
## Call:
## lm(formula = str_glue("honest_01_z ~ {p}") %>% as.formula(), 
##     data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.0539  0.3200  0.3464  0.3733  0.4058 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.04434    0.01013   4.376 1.22e-05 ***
## ideo         0.01303    0.01014   1.285    0.199    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9399 on 8602 degrees of freedom
##   (8421 observations deleted due to missingness)
## Multiple R-squared:  0.000192,   Adjusted R-squared:  7.573e-05 
## F-statistic: 1.652 on 1 and 8602 DF,  p-value: 0.1988
lrm_models = map(pred_vars, function(p) {
  glm(str_glue("honest_binary ~ {p}") %>% as.formula(), data = d, family = "binomial")
})

lrm_models %>% map(summary)
## [[1]]
## 
## Call:
## glm(formula = str_glue("honest_binary ~ {p}") %>% as.formula(), 
##     family = "binomial", data = d)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.7778   0.4058   0.5091   0.6835   0.9816  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  1.65141    0.03000   55.05   <2e-16 ***
## age          0.60024    0.02927   20.51   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8605.2  on 9227  degrees of freedom
## Residual deviance: 8151.6  on 9226  degrees of freedom
##   (7797 observations deleted due to missingness)
## AIC: 8155.6
## 
## Number of Fisher Scoring iterations: 4
## 
## 
## [[2]]
## 
## Call:
## glm(formula = str_glue("honest_binary ~ {p}") %>% as.formula(), 
##     family = "binomial", data = d)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8738   0.6160   0.6160   0.6303   0.6303  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   1.56588    0.04026  38.898   <2e-16 ***
## genderFemale -0.05057    0.05475  -0.924    0.356    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8614.1  on 9234  degrees of freedom
## Residual deviance: 8613.2  on 9233  degrees of freedom
##   (7790 observations deleted due to missingness)
## AIC: 8617.2
## 
## Number of Fisher Scoring iterations: 4
## 
## 
## [[3]]
## 
## Call:
## glm(formula = str_glue("honest_binary ~ {p}") %>% as.formula(), 
##     family = "binomial", data = d)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9932   0.5433   0.5433   0.5433   0.8702  
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          1.83881    0.03583  51.326  < 2e-16 ***
## raceBlack           -0.83105    0.08071 -10.297  < 2e-16 ***
## raceHispanic        -1.06297    0.07656 -13.884  < 2e-16 ***
## raceAsian           -0.75546    0.14684  -5.145 2.68e-07 ***
## raceNative American -0.82721    0.24104  -3.432   0.0006 ***
## raceMixed           -0.23942    0.17701  -1.353   0.1762    
## raceOther           -0.74020    0.30029  -2.465   0.0137 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8595.5  on 9218  degrees of freedom
## Residual deviance: 8340.8  on 9212  degrees of freedom
##   (7806 observations deleted due to missingness)
## AIC: 8354.8
## 
## Number of Fisher Scoring iterations: 4
## 
## 
## [[4]]
## 
## Call:
## glm(formula = str_glue("honest_binary ~ {p}") %>% as.formula(), 
##     family = "binomial", data = d)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9519   0.5677   0.5684   0.5840   0.8824  
## 
## Coefficients:
##                          Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                0.7423     0.1070   6.940 3.93e-12 ***
## educHigh school graduate   0.5247     0.1182   4.441 8.97e-06 ***
## educSome college           0.9498     0.1238   7.669 1.73e-14 ***
## educ2-year                 0.9400     0.1367   6.879 6.03e-12 ***
## educ4-year                 1.0015     0.1236   8.101 5.43e-16 ***
## educPost-grad              0.9990     0.1298   7.695 1.42e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8602.1  on 9227  degrees of freedom
## Residual deviance: 8496.1  on 9222  degrees of freedom
##   (7797 observations deleted due to missingness)
## AIC: 8508.1
## 
## Number of Fisher Scoring iterations: 4
## 
## 
## [[5]]
## 
## Call:
## glm(formula = str_glue("honest_binary ~ {p}") %>% as.formula(), 
##     family = "binomial", data = d)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8986   0.6008   0.6060   0.6128   0.6171  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  1.59351    0.02812  56.675   <2e-16 ***
## party       -0.02059    0.02813  -0.732    0.464    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8185.0  on 9011  degrees of freedom
## Residual deviance: 8184.4  on 9010  degrees of freedom
##   (8013 observations deleted due to missingness)
## AIC: 8188.4
## 
## Number of Fisher Scoring iterations: 3
## 
## 
## [[6]]
## 
## Call:
## glm(formula = str_glue("honest_binary ~ {p}") %>% as.formula(), 
##     family = "binomial", data = d)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9374   0.5788   0.5908   0.5980   0.6071  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  1.65588    0.02939  56.339   <2e-16 ***
## ideo         0.03141    0.02939   1.069    0.285    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 7577.0  on 8603  degrees of freedom
## Residual deviance: 7575.8  on 8602  degrees of freedom
##   (8421 observations deleted due to missingness)
## AIC: 7579.8
## 
## Number of Fisher Scoring iterations: 3
#plot together
plot_models(ols_models, show.legend = F, show.intercept = F)

GG_save("figs/separate_ols.png")

plot_models(ols_z_models, show.legend = F, show.intercept = F)

GG_save("figs/separate_ols_z.png")

plot_models(lrm_models, show.legend = F, show.intercept = F)

GG_save("figs/separate_lrm.png")

#interactions with wave, this probably is due to differences in the outcome measurement
#OLS
ols_fit_wave = ols(honest_01 ~ gender*wave + race2*wave + educ*wave + party*wave + ideo*wave, data = d)
ols_fit_wave
## Frequencies of Missing Values Due to Each Variable
## honest_01    gender      wave     race2      educ     party      ideo 
##      7790        67         0       165       131       252      1792 
## 
## Linear Regression Model
##  
##  ols(formula = honest_01 ~ gender * wave + race2 * wave + educ * 
##      wave + party * wave + ideo * wave, data = d)
##  
##  
##                  Model Likelihood    Discrimination    
##                        Ratio Test           Indexes    
##  Obs    8453    LR chi2    507.31    R2       0.058    
##  sigma0.2021    d.f.           55    R2 adj   0.052    
##  d.f.   8397    Pr(> chi2) 0.0000    g        0.054    
##  
##  Residuals
##  
##       Min       1Q   Median       3Q      Max 
##  -0.98482  0.02035  0.05817  0.08489  0.33106 
##  
##  
##                                          Coef    S.E.   t     Pr(>|t|)
##  Intercept                                0.9218 0.0239 38.51 <0.0001 
##  gender=Female                            0.0027 0.0089  0.30 0.7629  
##  wave=2019                               -0.0083 0.0314 -0.26 0.7911  
##  wave=2020                               -0.0883 0.0318 -2.77 0.0056  
##  wave=2020ts                             -0.2369 0.0703 -3.37 0.0008  
##  race2=Black                             -0.0444 0.0161 -2.76 0.0058  
##  race2=Hispanic                          -0.0868 0.0159 -5.45 <0.0001 
##  race2=Asian                             -0.0569 0.0325 -1.75 0.0794  
##  race2=Native American                    0.0404 0.0642  0.63 0.5295  
##  race2=Mixed                             -0.0034 0.0293 -0.12 0.9069  
##  educ=High school graduate               -0.0023 0.0250 -0.09 0.9276  
##  educ=Some college                        0.0554 0.0248  2.23 0.0256  
##  educ=2-year                              0.0449 0.0265  1.70 0.0898  
##  educ=4-year                              0.0524 0.0250  2.10 0.0357  
##  educ=Post-grad                           0.0692 0.0258  2.68 0.0073  
##  party                                    0.0016 0.0062  0.26 0.7945  
##  ideo                                    -0.0062 0.0062 -0.99 0.3209  
##  gender=Female * wave=2019               -0.0041 0.0117 -0.35 0.7247  
##  gender=Female * wave=2020                0.0095 0.0116  0.82 0.4099  
##  gender=Female * wave=2020ts              0.0134 0.0224  0.60 0.5504  
##  wave=2019 * race2=Black                 -0.0308 0.0208 -1.48 0.1390  
##  wave=2020 * race2=Black                 -0.0149 0.0204 -0.73 0.4640  
##  wave=2020ts * race2=Black                0.0421 0.0397  1.06 0.2882  
##  wave=2019 * race2=Hispanic              -0.0527 0.0204 -2.59 0.0097  
##  wave=2020 * race2=Hispanic              -0.0043 0.0197 -0.22 0.8254  
##  wave=2020ts * race2=Hispanic             0.0940 0.0431  2.18 0.0291  
##  wave=2019 * race2=Asian                 -0.0647 0.0400 -1.62 0.1060  
##  wave=2020 * race2=Asian                  0.0433 0.0380  1.14 0.2547  
##  wave=2020ts * race2=Asian                0.0823 0.0618  1.33 0.1834  
##  wave=2019 * race2=Native American       -0.1236 0.0712 -1.74 0.0827  
##  wave=2020 * race2=Native American       -0.1144 0.0775 -1.48 0.1396  
##  wave=2020ts * race2=Native American     -0.1008 0.1354 -0.74 0.4567  
##  wave=2019 * race2=Mixed                 -0.0177 0.0382 -0.46 0.6434  
##  wave=2020 * race2=Mixed                  0.0052 0.0368  0.14 0.8882  
##  wave=2020ts * race2=Mixed               -0.0764 0.0658 -1.16 0.2452  
##  wave=2019 * educ=High school graduate    0.0053 0.0326  0.16 0.8705  
##  wave=2020 * educ=High school graduate    0.0974 0.0331  2.94 0.0033  
##  wave=2020ts * educ=High school graduate  0.2146 0.0743  2.89 0.0039  
##  wave=2019 * educ=Some college           -0.0244 0.0328 -0.75 0.4560  
##  wave=2020 * educ=Some college            0.0766 0.0331  2.32 0.0206  
##  wave=2020ts * educ=Some college          0.1880 0.0737  2.55 0.0107  
##  wave=2019 * educ=2-year                 -0.0177 0.0348 -0.51 0.6117  
##  wave=2020 * educ=2-year                  0.0731 0.0351  2.08 0.0377  
##  wave=2020ts * educ=2-year                0.1853 0.0749  2.47 0.0134  
##  wave=2019 * educ=4-year                 -0.0270 0.0329 -0.82 0.4131  
##  wave=2020 * educ=4-year                  0.0444 0.0330  1.34 0.1789  
##  wave=2020ts * educ=4-year                0.2265 0.0718  3.15 0.0016  
##  wave=2019 * educ=Post-grad              -0.0435 0.0342 -1.27 0.2038  
##  wave=2020 * educ=Post-grad              -0.0083 0.0339 -0.24 0.8068  
##  wave=2020ts * educ=Post-grad             0.1864 0.0725  2.57 0.0101  
##  wave=2019 * party                       -0.0083 0.0082 -1.02 0.3093  
##  wave=2020 * party                        0.0112 0.0077  1.46 0.1445  
##  wave=2020ts * party                     -0.0249 0.0163 -1.52 0.1278  
##  wave=2019 * ideo                         0.0068 0.0082  0.83 0.4052  
##  wave=2020 * ideo                         0.0200 0.0076  2.62 0.0087  
##  wave=2020ts * ideo                       0.0054 0.0162  0.33 0.7409  
## 
#logistic
lrm_fit_wave = lrm(honest_binary ~ gender*wave + race2*wave + educ*wave + party*wave + ideo*wave, data = d)
lrm_fit_wave
## Frequencies of Missing Values Due to Each Variable
## honest_binary        gender          wave         race2          educ 
##          7790            67             0           165           131 
##         party          ideo 
##           252          1792 
## 
## Logistic Regression Model
##  
##  lrm(formula = honest_binary ~ gender * wave + race2 * wave + 
##      educ * wave + party * wave + ideo * wave, data = d)
##  
##  
##                         Model Likelihood        Discrimination    Rank Discrim.    
##                               Ratio Test               Indexes          Indexes    
##  Obs          8453    LR chi2     450.84        R2       0.089    C       0.672    
##   FALSE       1332    d.f.            55      R2(55,8453)0.046    Dxy     0.344    
##   TRUE        7121    Pr(> chi2) <0.0001    R2(55,3366.3)0.111    gamma   0.345    
##  max |deriv| 0.001                              Brier    0.125    tau-a   0.091    
##  
##                                          Coef    S.E.    Wald Z Pr(>|Z|)
##  Intercept                                1.6117  0.2905  5.55  <0.0001 
##  gender=Female                           -0.0833  0.1418 -0.59  0.5569  
##  wave=2019                                0.2429  0.3833  0.63  0.5263  
##  wave=2020                               -0.8698  0.3693 -2.36  0.0185  
##  wave=2020ts                             -1.7262  0.7657 -2.25  0.0242  
##  race2=Black                             -0.9716  0.2116 -4.59  <0.0001 
##  race2=Hispanic                          -1.2514  0.1945 -6.43  <0.0001 
##  race2=Asian                             -1.5124  0.3866 -3.91  <0.0001 
##  race2=Native American                    7.6072 44.0777  0.17  0.8630  
##  race2=Mixed                              0.0483  0.5344  0.09  0.9279  
##  educ=High school graduate                0.1916  0.2962  0.65  0.5178  
##  educ=Some college                        0.8776  0.3071  2.86  0.0043  
##  educ=2-year                              0.8660  0.3407  2.54  0.0110  
##  educ=4-year                              1.0622  0.3168  3.35  0.0008  
##  educ=Post-grad                           1.5847  0.3715  4.27  <0.0001 
##  party                                   -0.0291  0.0958 -0.30  0.7615  
##  ideo                                    -0.0952  0.0961 -0.99  0.3216  
##  gender=Female * wave=2019                0.0024  0.1752  0.01  0.9890  
##  gender=Female * wave=2020                0.2975  0.1724  1.73  0.0845  
##  gender=Female * wave=2020ts              0.2033  0.3776  0.54  0.5902  
##  wave=2019 * race2=Black                 -0.1356  0.2636 -0.51  0.6069  
##  wave=2020 * race2=Black                  0.3148  0.2611  1.21  0.2280  
##  wave=2020ts * race2=Black                0.6227  0.6286  0.99  0.3219  
##  wave=2019 * race2=Hispanic              -0.1102  0.2413 -0.46  0.6479  
##  wave=2020 * race2=Hispanic               0.4343  0.2365  1.84  0.0662  
##  wave=2020ts * race2=Hispanic             1.8996  0.8663  2.19  0.0283  
##  wave=2019 * race2=Asian                  0.0114  0.4587  0.02  0.9802  
##  wave=2020 * race2=Asian                  1.4259  0.4673  3.05  0.0023  
##  wave=2020ts * race2=Asian                8.5200 35.0379  0.24  0.8079  
##  wave=2019 * race2=Native American       -8.3564 44.0793 -0.19  0.8496  
##  wave=2020 * race2=Native American       -8.3794 44.0804 -0.19  0.8492  
##  wave=2020ts * race2=Native American     -8.2905 44.0963 -0.19  0.8509  
##  wave=2019 * race2=Mixed                 -0.7167  0.6127 -1.17  0.2421  
##  wave=2020 * race2=Mixed                  0.0947  0.6282  0.15  0.8802  
##  wave=2020ts * race2=Mixed               -0.7946  0.9052 -0.88  0.3800  
##  wave=2019 * educ=High school graduate   -0.1579  0.3904 -0.40  0.6860  
##  wave=2020 * educ=High school graduate    0.6993  0.3813  1.83  0.0667  
##  wave=2020ts * educ=High school graduate  1.8082  0.8315  2.17  0.0296  
##  wave=2019 * educ=Some college           -0.6142  0.4042 -1.52  0.1287  
##  wave=2020 * educ=Some college            0.4140  0.3950  1.05  0.2946  
##  wave=2020ts * educ=Some college          1.1973  0.8260  1.45  0.1472  
##  wave=2019 * educ=2-year                 -0.6104  0.4422 -1.38  0.1675  
##  wave=2020 * educ=2-year                  0.2795  0.4343  0.64  0.5199  
##  wave=2020ts * educ=2-year                1.0808  0.8527  1.27  0.2050  
##  wave=2019 * educ=4-year                 -0.9150  0.4134 -2.21  0.0269  
##  wave=2020 * educ=4-year                 -0.1744  0.3963 -0.44  0.6599  
##  wave=2020ts * educ=4-year                2.0462  0.8724  2.35  0.0190  
##  wave=2019 * educ=Post-grad              -1.1452  0.4705 -2.43  0.0149  
##  wave=2020 * educ=Post-grad              -1.0035  0.4422 -2.27  0.0233  
##  wave=2020ts * educ=Post-grad             0.9287  0.8630  1.08  0.2819  
##  wave=2019 * party                       -0.0505  0.1184 -0.43  0.6696  
##  wave=2020 * party                        0.1405  0.1117  1.26  0.2086  
##  wave=2020ts * party                     -0.5561  0.2759 -2.02  0.0439  
##  wave=2019 * ideo                         0.0641  0.1183  0.54  0.5882  
##  wave=2020 * ideo                         0.2380  0.1112  2.14  0.0324  
##  wave=2020ts * ideo                       0.2060  0.2726  0.76  0.4498  
## 
lrtest(lrm_fit, lrm_fit_wave)
## 
## Model 1: honest_binary ~ age + gender + race + educ + party + ideo + wave
## Model 2: honest_binary ~ gender * wave + race2 * wave + educ * wave + 
##     party * wave + ideo * wave
## 
##   L.R. Chisq         d.f.            P 
## 7.382357e+01 3.700000e+01 3.029137e-04
#one wave at a time fits
ols_fit_waves = map(list(anes2018, anes2019, anes2020, anes2020ts), function(dd) {
  ols(honest_01 ~ age + gender + race + educ + party + ideo, data = dd)
})

ols_z_fit_waves = map(list(anes2018, anes2019, anes2020, anes2020ts), function(dd) {
  ols(honest_01_z ~ age + gender + race + educ + party + ideo, data = dd)
})

lrm_fit_waves = map(list(anes2018, anes2019, anes2020, anes2020ts), function(dd) {
  lrm(honest_binary ~ age + gender + race + educ + party + ideo, data = dd, penalty = 0.1)
})

plot_models(ols_fit_waves, rm.terms = "Intercept", m.labels = c("Wave 2018", "Wave 2019", "Wave 2020", "Wave 2020ts"))

GG_save("figs/meta_ols.png")

plot_models(ols_z_fit_waves, rm.terms = "Intercept", m.labels = c("Wave 2018", "Wave 2019", "Wave 2020", "Wave 2020ts"))

GG_save("figs/meta_ols_z.png")

plot_models(lrm_fit_waves, rm.terms = "Intercept", m.labels = c("Wave 2018", "Wave 2019", "Wave 2020", "Wave 2020ts"))

GG_save("figs/meta_lrm.png")

Meta

write_sessioninfo()
## R version 4.2.0 (2022-04-22)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Linux Mint 19.3
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=en_DK.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_DK.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_DK.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] sjPlot_2.8.10         rms_6.3-0             SparseM_1.81         
##  [4] haven_2.5.0           kirkegaard_2022-05-06 psych_2.2.3          
##  [7] assertthat_0.2.1      weights_1.0.4         Hmisc_4.7-0          
## [10] Formula_1.2-4         survival_3.2-13       lattice_0.20-45      
## [13] magrittr_2.0.3        forcats_0.5.1         stringr_1.4.0        
## [16] dplyr_1.0.9           purrr_0.3.4           readr_2.1.2          
## [19] tidyr_1.2.0           tibble_3.1.7          ggplot2_3.3.6        
## [22] tidyverse_1.3.1      
## 
## loaded via a namespace (and not attached):
##   [1] TH.data_1.1-1       minqa_1.2.4         colorspace_2.0-3   
##   [4] ellipsis_0.3.2      sjlabelled_1.2.0    estimability_1.3   
##   [7] htmlTable_2.4.0     parameters_0.17.0   base64enc_0.1-3    
##  [10] fs_1.5.2            rstudioapi_0.13     mice_3.14.0        
##  [13] farver_2.1.0        MatrixModels_0.5-0  fansi_1.0.3        
##  [16] mvtnorm_1.1-3       lubridate_1.8.0     xml2_1.3.3         
##  [19] codetools_0.2-18    splines_4.2.0       mnormt_2.0.2       
##  [22] knitr_1.39          sjmisc_2.8.9        jsonlite_1.8.0     
##  [25] nloptr_2.0.1        ggeffects_1.1.2     broom_0.8.0        
##  [28] cluster_2.1.3       dbplyr_2.1.1        png_0.1-7          
##  [31] effectsize_0.6.0.1  compiler_4.2.0      httr_1.4.3         
##  [34] sjstats_0.18.1      emmeans_1.7.3       backports_1.4.1    
##  [37] Matrix_1.4-1        fastmap_1.1.0       cli_3.3.0          
##  [40] htmltools_0.5.2     quantreg_5.93       tools_4.2.0        
##  [43] gtable_0.3.0        glue_1.6.2          Rcpp_1.0.8.3       
##  [46] cellranger_1.1.0    jquerylib_0.1.4     vctrs_0.4.1        
##  [49] gdata_2.18.0        nlme_3.1-157        insight_0.17.0     
##  [52] xfun_0.30           lme4_1.1-29         rvest_1.0.2        
##  [55] lifecycle_1.0.1     gtools_3.9.2        polspline_1.1.20   
##  [58] MASS_7.3-57         zoo_1.8-10          scales_1.2.0       
##  [61] hms_1.1.1           parallel_4.2.0      sandwich_3.0-1     
##  [64] RColorBrewer_1.1-3  yaml_2.3.5          gridExtra_2.3      
##  [67] sass_0.4.1          rpart_4.1.16        latticeExtra_0.6-29
##  [70] stringi_1.7.6       highr_0.9           bayestestR_0.12.1  
##  [73] checkmate_2.1.0     boot_1.3-28         rlang_1.0.2        
##  [76] pkgconfig_2.0.3     evaluate_0.15       htmlwidgets_1.5.4  
##  [79] tidyselect_1.1.2    plyr_1.8.7          R6_2.5.1           
##  [82] generics_0.1.2      multcomp_1.4-19     DBI_1.1.2          
##  [85] pillar_1.7.0        foreign_0.8-82      withr_2.5.0        
##  [88] datawizard_0.4.0    nnet_7.3-17         performance_0.9.0  
##  [91] modelr_0.1.8        crayon_1.5.1        utf8_1.2.2         
##  [94] tmvnsim_1.0-2       tzdb_0.3.0          rmarkdown_2.14     
##  [97] jpeg_0.1-9          grid_4.2.0          readxl_1.4.0       
## [100] data.table_1.14.2   reprex_2.0.1        digest_0.6.29      
## [103] xtable_1.8-4        munsell_0.5.0       bslib_0.3.1
write_rds(d, "data/data_out.rds", compress = "xz")

#OSF
if (F) {
  library(osfr)
  #settings
  #you need to set up a personal token
  #good idea is to then place it somewhere safe for reuse
  osf_auth(read_lines("~/.config/osf_token"))
  
  #the project we will use
  osf_proj = osf_retrieve_node("https://osf.io/8d7ng/")
  
  #upload all files in project
  #overwrite existing (versioning)
  osf_upload(osf_proj,
             path = c("notebook.html", "notebook.Rmd", "figs", "data", "sessions_info.txt"),
             conflicts = "overwrite")
}