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")