Media Diversity Project 2
Dani Grant
2025-07-29
2025 Study
# Load required libraries
library(Hmisc) # for rcorr##
## Attaching package: 'Hmisc'## The following objects are masked from 'package:base':
##
## format.pval, unitslibrary(corrplot) # for pretty correlation plot## corrplot 0.95 loadedlibrary(ggplot2)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:Hmisc':
##
## src, summarize## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(scales)
library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:scales':
##
## alpha, rescale## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha## The following object is masked from 'package:Hmisc':
##
## describelibrary(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ lubridate 1.9.2 ✔ tibble 3.2.1
## ✔ purrr 1.0.1 ✔ tidyr 1.3.0
## ✔ readr 2.1.4## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%() masks ggplot2::%+%()
## ✖ psych::alpha() masks scales::alpha(), ggplot2::alpha()
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::src() masks Hmisc::src()
## ✖ dplyr::summarize() masks Hmisc::summarize()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(optimx)
library(parallel)
library(dfoptim)
library(lsr)
library(MASS)##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## selectlibrary(sjPlot)
library(jtools)##
## Attaching package: 'jtools'
##
## The following object is masked from 'package:Hmisc':
##
## %nin%library(interactions)
library(ggpubr)
library(lme4)## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpacklibrary(lmerTest)##
## Attaching package: 'lmerTest'
##
## The following object is masked from 'package:lme4':
##
## lmer
##
## The following object is masked from 'package:stats':
##
## steplibrary(ordinal)##
## Attaching package: 'ordinal'
##
## The following object is masked from 'package:dplyr':
##
## slicelibrary(sjmisc)##
## Attaching package: 'sjmisc'
##
## The following objects are masked from 'package:jtools':
##
## %nin%, center
##
## The following object is masked from 'package:purrr':
##
## is_empty
##
## The following object is masked from 'package:tidyr':
##
## replace_na
##
## The following object is masked from 'package:tibble':
##
## add_case
##
## The following object is masked from 'package:Hmisc':
##
## %nin%library(ggplot2)
library(ggeffects)##
## Attaching package: 'ggeffects'
##
## The following object is masked from 'package:interactions':
##
## johnson_neymanlibrary(metan)## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
## |=========================================================|
## | Multi-Environment Trial Analysis (metan) v1.18.0 |
## | Author: Tiago Olivoto |
## | Type 'citation('metan')' to know how to cite metan |
## | Type 'vignette('metan_start')' for a short tutorial |
## | Visit 'https://bit.ly/pkgmetan' for a complete tutorial |
## |=========================================================|
##
## Attaching package: 'metan'
##
## The following objects are masked from 'package:sjmisc':
##
## add_rows, has_na, remove_cols, replace_na
##
## The following object is masked from 'package:sjPlot':
##
## get_model_data
##
## The following object is masked from 'package:MASS':
##
## select
##
## The following object is masked from 'package:forcats':
##
## as_factor
##
## The following object is masked from 'package:tidyr':
##
## replace_na
##
## The following objects are masked from 'package:tibble':
##
## column_to_rownames, remove_rownames, rownames_to_column
##
## The following object is masked from 'package:psych':
##
## skew
##
## The following object is masked from 'package:dplyr':
##
## recode_factorlibrary(apaTables)
library(tibble)
library(ggcorrplot)
# population sd function
pop_sd <- function(x, na.rm = FALSE) {
if (na.rm) x <- x[!is.na(x)]
sqrt(sum((x - mean(x))^2) / length(x))
}
d <- read.csv("study2_final_dataset.csv", header = T, na.strings = c("", " ", NA), stringsAsFactors = F)
d$ideology.z <- as.numeric(scale(d$ideology))
d$age.z <- as.numeric(scale(as.numeric(d$age)))
d$education.z <- as.numeric(scale(d$education))
d$nfc.z <- as.numeric(scale(d$nfc))
d$white_.5 <- as.numeric(d$white_.5)
d$sesLadder.z <- as.numeric(scale(d$sesLadder2))
d$man_.5 <- as.numeric(d$man_.5)
d$bias.mean.40.z <- as.numeric(scale(d$bias.mean.40))
d$bias.sd.40.z <- as.numeric(scale(d$bias.sd.40))
d$rel.mean.40.z <- as.numeric(scale(d$rel.mean.40))
d$mediaLiteracy.z <- scale(d$mediaLiteracy)
d$sumExp.40.z <- as.numeric(scale(d$sumExp.40))
d$tally.40.z <- as.numeric(scale(d$tally.40))
d$fluVaxx <- NA
d$fluVaxx[d$fluCurrent == 1] <- 1 #vaccinated
d$fluVaxx[d$fluCurrent == 2] <- 0 #unvaccinated
d$fluVaxx <- as.numeric(d$fluVaxx)
af <- read.csv("media-list-study-2.csv", header = T, na.strings = c("", " ", NA), stringsAsFactors = F)
af$bias.z <- scale(af$Bias)
af$rel.z <- af$Reliability
# if exposure is blank then assign zer0
d$abc[d$abc == 0] <- NA
d$atlantic[d$atlantic== 0] <- NA
d$bizPac[d$bizPac== 0] <- NA
d$blaze[d$blaze== 0] <- NA
d$breitbart[d$breitbart== 0] <- NA
d$cbs[d$cbs== 0] <- NA
d$cnn[d$cnn== 0] <- NA
d$crooks.liars[d$crooks.liars== 0] <- NA # no one watches this (so far)
d$dailyBeast[d$dailyBeast== 0] <- NA
d$dailyKos[d$dailyKos== 0] <- NA
d$dailyWire[d$dailyWire== 0] <- NA
d$demNow[d$demNow== 0] <- NA
d$dispatch[d$dispatch== 0] <- NA # no one watches this (so far)
d$epochTimes[d$epochTimes== 0] <- NA
d$foxBusiness[d$foxBusiness== 0] <- NA
d$foxNews[d$foxNews== 0] <- NA
d$guardian[d$guardian== 0] <- NA
d$huffPost[d$huffPost== 0] <- NA
d$meidasTouch[d$meidasTouch== 0] <- NA
d$motherJones[d$motherJones== 0] <- NA
d$msnbc[d$msnbc== 0] <- NA
d$nation[d$nation== 0] <- NA
d$nbc[d$nbc== 0] <- NA
d$nyPost[d$nyPost== 0] <- NA
d$nyTimes[d$nyTimes== 0] <- NA
d$newsNation[d$newsNation== 0] <- NA
d$newsmax[d$newsmax== 0] <- NA
d$newsweek[d$newsweek== 0] <- NA
d$npr[d$npr== 0] <- NA
d$oann[d$oann== 0] <- NA
d$reason[d$reason== 0] <- NA
d$reuters[d$reuters== 0] <- NA
d$root[d$root== 0] <- NA
d$salon[d$salon== 0] <- NA
d$twitchy[d$twitchy== 0] <- NA
d$vox[d$vox== 0] <- NA
d$wsj[d$wsj== 0] <- NA
d$washPost[d$washPost== 0] <- NA
d$washTimes[d$washTimes== 0] <- NA
d$yahoo[d$yahoo== 0] <- NA
# calculate tilt * exposure
d$abc.BiasExp <- af$bias.z[af$Media.Outlet == "ABC"] * as.numeric(d$abc)
d$atl.BiasExp <- af$bias.z[af$Media.Outlet == "Atlantic"] * d$atlantic
d$bpr.BiasExp <- af$bias.z[af$Media.Outlet == "BizPacReview"] * d$bizPac
d$blaze.BiasExp <- af$bias.z[af$Media.Outlet == "Blaze"] * d$blaze
d$breit.BiasExp <- af$bias.z[af$Media.Outlet == "Breitbart"] * d$breitbart
d$cbs.BiasExp <- af$bias.z[af$Media.Outlet == "CBS"] * d$cbs
d$cnn.BiasExp <- af$bias.z[af$Media.Outlet == "CNN"] * d$cnn
d$crooks.BiasExp <- af$bias.z[af$Media.Outlet == "Crooks&Liars"] * d$crooks.liars
d$dBeast.BiasExp <- af$bias.z[af$Media.Outlet == "DailyBeast"] * d$dailyBeast
d$dKos.BiasExp <- af$bias.z[af$Media.Outlet == "DailyKos"] * d$dailyKos
d$dWire.BiasExp <- af$bias.z[af$Media.Outlet == "DailyWire"] * d$dailyWire
d$demNow.BiasExp <- af$bias.z[af$Media.Outlet == "DemocracyNow"] * d$demNow
d$disp.BiasExp <- af$bias.z[af$Media.Outlet == "Dispatch"] * d$dispatch
d$epoch.BiasExp <- af$bias.z[af$Media.Outlet == "EpochTimes"] * d$epochTimes
d$foxBus.BiasExp <- af$bias.z[af$Media.Outlet == "FoxBusiness"] * d$foxBusiness
d$foxNews.BiasExp <- af$bias.z[af$Media.Outlet == "FoxNews"] * d$foxNews
d$guard.BiasExp <- af$bias.z[af$Media.Outlet == "Guardian"] * d$guardian
d$hPost.BiasExp <- af$bias.z[af$Media.Outlet == "HuffPost"] * d$huffPost
d$meidas.BiasExp <- af$bias.z[af$Media.Outlet == "MeidasTouch"] * d$meidasTouch
d$mJones.BiasExp <- af$bias.z[af$Media.Outlet == "MotherJones"] * d$motherJones
d$msnbc.BiasExp <- af$bias.z[af$Media.Outlet == "MSNBC"] * d$msnbc
d$nation.BiasExp <- af$bias.z[af$Media.Outlet == "Nation"] * d$nation
d$nbc.BiasExp <- af$bias.z[af$Media.Outlet == "NBC"] * d$nbc
d$nyPost.BiasExp <- af$bias.z[af$Media.Outlet == "NewYorkPost"] * d$nyPost
d$nyTimes.BiasExp <- af$bias.z[af$Media.Outlet == "NewYorkTimes"] * d$nyTimes
d$nNat.BiasExp <- af$bias.z[af$Media.Outlet == "NewsNation"] * d$newsNation
d$nMax.BiasExp <- af$bias.z[af$Media.Outlet == "Newsmax"] * d$newsmax
d$nweek.BiasExp <- af$bias.z[af$Media.Outlet == "Newsweek"] * d$newsweek
d$npr.BiasExp <- af$bias.z[af$Media.Outlet == "NPR"] * d$npr
d$oann.BiasExp <- af$bias.z[af$Media.Outlet == "OANN"] * d$oann
d$reason.BiasExp <- af$bias.z[af$Media.Outlet == "Reason"] * d$reason
d$reuters.BiasExp <- af$bias.z[af$Media.Outlet == "Reuters"] * d$reuters
d$root.BiasExp <- af$bias.z[af$Media.Outlet == "Root"] * d$root
d$salon.BiasExp <- af$bias.z[af$Media.Outlet == "Salon"] * d$salon
d$twitchy.BiasExp <- af$bias.z[af$Media.Outlet == "Twitchy"] * d$twitchy
d$vox.BiasExp <- af$bias.z[af$Media.Outlet == "Vox"] * d$vox
d$wsj.BiasExp <- af$bias.z[af$Media.Outlet == "WallStreetJournal"] * d$wsj
d$wPost.BiasExp <- af$bias.z[af$Media.Outlet == "WashingtonPost"] * d$washPost
d$wTimes.BiasExp <- af$bias.z[af$Media.Outlet == "WashingtonTimes"] * d$washTimes
d$yahoo.BiasExp <- af$bias.z[af$Media.Outlet == "Yahoo"] * d$yahoo
d$bias.mean.40 <- NA
d$bias.mean.40 <- rowMeans(d[c(
"abc.BiasExp",
"atl.BiasExp",
"bpr.BiasExp",
"blaze.BiasExp",
"breit.BiasExp",
"cbs.BiasExp",
"cnn.BiasExp",
"crooks.BiasExp",
"dBeast.BiasExp",
"dKos.BiasExp",
"dWire.BiasExp",
"demNow.BiasExp",
"disp.BiasExp",
"epoch.BiasExp",
"foxBus.BiasExp",
"foxNews.BiasExp",
"guard.BiasExp",
"hPost.BiasExp",
"meidas.BiasExp",
"mJones.BiasExp",
"msnbc.BiasExp",
"nation.BiasExp",
"nbc.BiasExp",
"nyPost.BiasExp",
"nyTimes.BiasExp",
"nNat.BiasExp",
"nMax.BiasExp",
"nweek.BiasExp",
"npr.BiasExp",
"oann.BiasExp",
"reason.BiasExp",
"reuters.BiasExp",
"root.BiasExp",
"salon.BiasExp",
"twitchy.BiasExp",
"vox.BiasExp",
"wsj.BiasExp",
"wPost.BiasExp",
"wTimes.BiasExp",
"yahoo.BiasExp")], na.rm = T)
d$bias.mean.40 <- ifelse(d$bias.mean.40 == "NaN", NA, d$bias.mean.40)
d$bias.sd.40 <- NA
d$bias.sd.40 <- apply(d[c( # TO DO: #adjust this so when tally = 0, sd also = 0
"abc.BiasExp",
"atl.BiasExp",
"bpr.BiasExp",
"blaze.BiasExp",
"breit.BiasExp",
"cbs.BiasExp",
"cnn.BiasExp",
"crooks.BiasExp",
"dBeast.BiasExp",
"dKos.BiasExp",
"dWire.BiasExp",
"demNow.BiasExp",
"disp.BiasExp",
"epoch.BiasExp",
"foxBus.BiasExp",
"foxNews.BiasExp",
"guard.BiasExp",
"hPost.BiasExp",
"meidas.BiasExp",
"mJones.BiasExp",
"msnbc.BiasExp",
"nation.BiasExp",
"nbc.BiasExp",
"nyPost.BiasExp",
"nyTimes.BiasExp",
"nNat.BiasExp",
"nMax.BiasExp",
"nweek.BiasExp",
"npr.BiasExp",
"oann.BiasExp",
"reason.BiasExp",
"reuters.BiasExp",
"root.BiasExp",
"salon.BiasExp",
"twitchy.BiasExp",
"vox.BiasExp",
"wsj.BiasExp",
"wPost.BiasExp",
"wTimes.BiasExp",
"yahoo.BiasExp")], 1, pop_sd, na.rm = T)
d$bias.sd.40 <- ifelse(d$bias.sd.40 == "NaN", NA, d$bias.sd.40)
#d$bias.sd.40[d$tally.40 == 1] <- 0
d$bias.sd.40.z <- scale(d$bias.sd.40)2022 + 2023 Studies
af2 <- read.csv("media-ratings-gui.csv", header = T, na.strings = c("", " ", NA), stringsAsFactors = F)
af2$bias.z <- scale(af2$Bias)
af2$rel.z <- scale(af2$Reliability)
d22 <- read.csv("Study2022.csv", header = T, na.strings = c("", " ", NA), stringsAsFactors = F)
d22 <- d22[c("ResponseId",
"vax_current_yr",
# Did you receive a flu shot in the current season (2022-2023)?
# 1 = Yes, 2 = No,3 = IDK
"beh_intentions",
# How likely is it that you will get the flu vaccine in the next 12 months?
# Extremely unlikely (1)
# Unlikely (2)
# Somewhat unlikely (3)
# Neutral (4)
# Somewhat likely (5)
# Likely (6)
# Extremely likely (7)
"attitudes_1", # flu vaxx is necessary
"attitudes_2", # flu vaxx is good idea
"attitudes_3", #flu vaxx is beneficial
"vax_prob", "vax_severe",
"flu_risk", "flu_severe",
"norms_attitudes_1",
"norms_attitudes_2",
"norms_attitudes_3",
"media_consumption_1",
"media_consumption_2",
"media_consumption_3",
"media_consumption_4",
"media_consumption_5",
"media_consumption_6",
"media_consumption_7",
"media_consumption_8",
"media_consumption_9",
"media_consumption_10",
"media_consumption_11",
"media_consumption_12",
"media_consumption_13",
"media_consumption_14",
"media_consumption_15",
"media_consumption_16",
"media_consumption_17",
"media_consumption_18",
"media_consumption_19",
"media_consumption_20",
"media_consumption_21",
"media_consumption_22",
"media_consumption_23",
"media_consumption_24",
"media_consumption_25",
"media_consumption_26",
"media_consumption_27",
"media_consumption_28",
"media_consumption_29",
"media_consumption_30",
"media_consumption_31",
"CRT1", # Cognitive reflection
"CRT2",
"CRT3",
"CRT4",
"CRT5",
"CRT6",
"Num1", # Objective numeracy
"Num2",
"Num3",
"Num4",
"Num5",
"ravens1", # Raven's inventory
"ravens2",
"ravens3",
"ravens4" ,
"ravens5",
"ravens6" ,
"ravens7",
"ravens8",
"ravens9",
"ravens10",
"style_1", # Rational experiential inventory
"style_2",
"style_3",
"style_4",
"style_5",
"style_6",
"style_7",
"style_8",
"style_9",
"style_10",
"subj_numeracy1", # Subjective numeracy
"subj_numeracy2",
"subj_numeracy3",
"subj_numeracy4",
"trust_science_1", # Scientists ignore evidence that contradicts their work
"trust_science_2", # Scientific theories are weak explanations
"trust_science_3", # Scientists don't value the ideas of others
"trust_science_4", # We should trust the work of scientists
"trust_science_5", # Scientific theories are trustworthy
"trust_science_6", # We cannot trust scientists because they are based in their perspectives
"trust_science_7", # We cannot trust scientists to consider ideas that contradict their own
"trust_science_8", # We cannot trust science because it moves too slowly
"pol_id_1", # general
"pol_id_2", # social issues
"pol_id_3", # economic issues
"gender", "gender_3_TEXT", # 1 = Female, 2 = Male, Other = 3
"age",
"education", "education_10_TEXT",
"income",
"race", "race_7_TEXT",
"vax",
"id"
)]
d23 <- read.csv("Study2023.csv", header = T, na.strings = c("", " ", NA), stringsAsFactors = F)
d23 <- d23[c("ResponseId",
"vax_current_yr",
"beh_intentions",
"attitudes_1", # flu vaxx is necessary
"attitudes_2", # flu vaxx is good idea
"attitudes_3", #flu vaxx is beneficial
"vax_prob", "vax_severe",
"flu_risk", "flu_severe",
"norms_attitudes_1",
"norms_attitudes_2",
"norms_attitudes_3",
"media_consumption_1",
"media_consumption_2",
"media_consumption_3",
"media_consumption_4",
"media_consumption_5",
"media_consumption_6",
"media_consumption_7",
"media_consumption_8",
"media_consumption_9",
"media_consumption_10",
"media_consumption_11",
"media_consumption_12",
"media_consumption_13",
"media_consumption_14",
"media_consumption_15",
"media_consumption_16",
"media_consumption_17",
"media_consumption_18",
"media_consumption_19",
"media_consumption_20",
"media_consumption_21",
"media_consumption_22",
"media_consumption_23",
"media_consumption_24",
"media_consumption_25",
"media_consumption_26",
"media_consumption_27",
"media_consumption_28",
"media_consumption_29",
"media_consumption_30",
"media_consumption_31",
"CRT1",
"CRT2",
"CRT3",
"CRT4",
"CRT5",
"CRT6",
"Num1",
"Num2",
"Num3",
"Num4",
"Num5",
"ravens1", # Raven's inventory
"ravens2",
"ravens3",
"ravens4" ,
"ravens5",
"ravens6" ,
"ravens7",
"ravens8",
"ravens9",
"ravens10",
"style_1", # Rational experiential inventory
"style_2",
"style_3",
"style_4",
"style_5",
"style_6",
"style_7",
"style_8",
"style_9",
"style_10",
"subj_numeracy1", # Subjective numeracy
"subj_numeracy2",
"subj_numeracy3",
"subj_numeracy4",
"trust_science_1", # Scientists ignore evidence that contradicts their work
"trust_science_2", # Scientific theories are weak explanations
"trust_science_3", # Scientists don't value the ideas of others
"trust_science_4", # We should trust the work of scientists
"trust_science_5", # Scientific theories are trustworthy
"trust_science_6", # We cannot trust scientists because they are based in their perspectives
"trust_science_7", # We cannot trust scientists to consider ideas that contradict their own
"trust_science_8", # We cannot trust science because it moves too slowly
"pol_id_1", # general
"pol_id_2", # social issues
"pol_id_3", # economic issues
"gender", "gender_3_TEXT", # 1 = Female, 2 = Male, Other = 3
"age",
"education", "education_10_TEXT",
"income",
"race", "race_7_TEXT",
"vax",
"id"
)]
dm <- rbind(d22, d23)
# clean 2022-2023 data set
###################
#
# Numeracy
#
####################
# Numeracy: 1 = correct, 0 = incorrect
# Num1 = 500
dm$Num1.c <- NA
dm$Num1.c[dm$Num1 == 500] <- 1
dm$Num1.c[is.numeric(dm$Num1) & dm$Num1 != 500] <- 0
# Num2 = 10
dm$Num2.c <- NA
dm$Num2.c[dm$Num2 == 10] <- 1
dm$Num2.c[is.numeric(dm$Num2) & dm$Num2 != 10] <- 0
# Num3 = 0.1%
dm$Num3.c <- NA
dm$Num3.c[dm$Num3 == 0.1] <- 1
dm$Num3.c[is.numeric(dm$Num3) & dm$Num3 != 0.1] <- 0
# Num4 = 20%
dm$Num4.c <- NA
dm$Num4.c[dm$Num4 == 20] <- 1
dm$Num4.c[is.numeric(dm$Num4) & dm$Num4 != 20] <- 0
# Num5 = 100
dm$Num5.c <- NA
dm$Num5.c[dm$Num5 == 100] <- 1
dm$Num5.c[is.numeric(dm$Num5) & dm$Num5 != 100] <- 0
dm$numeracy <- rowSums(dm[c("Num1.c", "Num2.c", "Num3.c", "Num4.c", "Num5.c")], na.rm = T)
dm$numeracy <- ifelse(dm$numeracy == "NaN", NA, dm$numeracy)
################
#
# CRT
#
#################
# CRT1 = 4
dm$CRT1.c <- NA
dm$CRT1.c[dm$CRT1 == 4] <- 1
dm$CRT1.c[is.numeric(dm$CRT1) & dm$CRT1 != 4] <- 0
# CRT2 = 10
dm$CRT2.c <- NA
dm$CRT2.c[dm$CRT2 == 10] <- 1
dm$CRT2.c[is.numeric(dm$CRT2) & dm$CRT2 != 10] <- 0
# CRT3 = 39
dm$CRT3.c <- NA
dm$CRT3.c[dm$CRT3 == 39] <- 1
dm$CRT3.c[is.numeric(dm$CRT3) & dm$CRT3 != 39] <- 0
# CRT4 = 2
dm$CRT4.c <- NA
dm$CRT4.c[dm$CRT4 == 2] <- 1
dm$CRT4.c[is.numeric(dm$CRT4) & dm$CRT4 != 2] <- 0
# CRT5 = 8
dm$CRT5.c <- NA
dm$CRT5.c[dm$CRT5 == 8] <- 1
dm$CRT5.c[is.numeric(dm$CRT5) & dm$CRT5 != 8] <- 0
# CRT6 = Emily
## Correct the ones with small typos
dm$CRT6[dm$CRT6 == "emily"] <- "Emily"
dm$CRT6[dm$CRT6 == "emily "] <- "Emily"
dm$CRT6[dm$CRT6 == "Emily "] <- "Emily"
dm$CRT6[dm$CRT6 == "Emily? lol"] <- "Emily"
dm$CRT6[dm$CRT6 == "Emily ..... what is the reason for these questions?? "] <- "Emily"
dm$CRT6.c <- NA
dm$CRT6.c[dm$CRT6 == "Emily"] <- 1
dm$CRT6.c[dm$CRT6 != "Emily"] <- 0
dm$cogReflect <- rowSums(dm[c("CRT1.c", "CRT2.c", "CRT3.c", "CRT4.c", "CRT5.c", "CRT6.c")], na.rm = T)
dm$cogReflect <- ifelse(dm$cogReflect == "NaN", NA, dm$cogReflect)
###################
#
# Raven's
#
##################
dm$raven <- rowSums(dm[c(
"ravens1",
"ravens2",
"ravens3",
"ravens4" ,
"ravens5",
"ravens6" ,
"ravens7",
"ravens8",
"ravens9",
"ravens10" )], na.rm = T)
dm$raven <- ifelse(dm$raven == "NaN", NA, dm$raven)
#################
#
# Rational Experiential Inventory (style)
#
###################
dm$REI <- rowSums(dm[c(
"style_1", # Rational experiential inventory
"style_2",
"style_3",
"style_4",
"style_5",
"style_6",
"style_7",
"style_8",
"style_9",
"style_10")], na.rm = T)
dm$REI <- ifelse(dm$REI == "NaN", NA, dm$REI)
#################
#
# Subjective Numeracy
#
###################
dm$subjNum <- rowSums(dm[c(
"subj_numeracy1", # Subjective numeracy
"subj_numeracy2",
"subj_numeracy3",
"subj_numeracy4")], na.rm = T)
dm$subjNum <- ifelse(dm$subjNum == "NaN", NA, dm$subjNum)
###################################
##
## Analytical Style Construct
##
###################################
dm$anStyle <- rowSums(dm[c("REI", "subjNum")], na.rm = T)
dm$anStyle <- ifelse(dm$anStyle == "NaN", NA, dm$anStyle)
dm$anStyle.z <- scale(dm$anStyle)
###################################
##
## Analytical Ability Construct
##
###################################
dm$anAbility <- rowSums(dm[c("raven", "cogReflect","numeracy")], na.rm = T)
dm$anAbility <- ifelse(dm$anAbility == "NaN", NA, dm$anAbility)
dm$anAbility.z <- scale(dm$anAbility)
##########################
## ideology
##########################
dm$ideology <- rowMeans(dm[c("pol_id_1", "pol_id_2", "pol_id_3")], na.rm = T)
dm$ideology <- ifelse(dm$ideology == "NaN", NA, dm$ideology)
dm$ideology.z <- scale(dm$ideology)
##########################
## gender
##########################
dm$gender[dm$gender == 1] <- "woman"
dm$gender[dm$gender == 2] <- "man"
dm$gender[dm$gender == 3] <- "custom"
dm$man_.5 <- NA
dm$man_.5[dm$gender == "woman"] <- -0.5
dm$man_.5[dm$gender == "man"] <- 0.5
##########################
## race
##########################
dm$race_factor <- NA
dm$race_factor[dm$race == 1] <- "asian"
dm$race_factor[dm$race == 2] <- "black"
dm$race_factor[dm$race == 3] <- "latin"
dm$race_factor[dm$race == 4] <- "natAmer"
dm$race_factor[dm$race == 5] <- "pacIsl"
dm$race_factor[dm$race == 6] <- "white"
dm$race_factor[dm$race == 7] <- "other"
dm$race_factor[dm$race_7_TEXT == "White, Caucasian-Australian"] <- "white"
dm$race_factor[dm$race_7_TEXT == "white, South African"] <- "white"
dm$white_.5 <- NA
dm$white_.5[dm$race_factor == "asian"] <- -.5
dm$white_.5[dm$race_factor == "black"] <- -.5
dm$white_.5[dm$race_factor == "latin"] <- -.5
dm$white_.5[dm$race_factor == "natAmer"] <- -.5
dm$white_.5[dm$race_factor == "pacIsl"] <- -.5
dm$white_.5[dm$race_factor == "white"] <- .5
dm$white_.5[dm$race_factor == "other"] <- -.5
#########################
#
# age and education
#
#########################
dm$education.z <- scale(dm$education)
dm$age[dm$age == "20, i think i accidentally clicked republican when i meant democrat"] <- 20
dm$age[dm$age == "21, 22 in three days"] <- 21
dm$age[dm$age == "w0"] <- NA
dm$age <- as.numeric(dm$age)
dm$age.z <- scale(dm$age)
############################################
#
# outcomes
#
#############################################
dm$vaxBeh <- NA
dm$vaxBeh[dm$vax_current_yr == 1] <- 1
dm$vaxBeh[dm$vax_current_yr == 2] <- 0
dm$vaxBeh[dm$vax_current_yr == 3] <- NA
dm$vaxIntent <- NA
dm$vaxIntent[dm$beh_intentions == 1] <- -3
dm$vaxIntent[dm$beh_intentions == 18] <- -2
dm$vaxIntent[dm$beh_intentions == 19] <- -1
dm$vaxIntent[dm$beh_intentions == 20] <- 0
dm$vaxIntent[dm$beh_intentions == 21] <- 1
dm$vaxIntent[dm$beh_intentions == 22] <- 2
dm$vaxIntent[dm$beh_intentions == 23] <- 3
dm$vaxIntent.z <- scale(dm$vaxIntent)
dm$vaxAtt <- NA
dm$vaxAtt <- rowMeans(dm[c("attitudes_1", "attitudes_2", "attitudes_3")], na.rm = T)
dm$vaxAtt <- ifelse(dm$vaxAtt == "NaN", NA, dm$vaxAtt)
dm$vaxAtt.z <- scale(dm$vaxAtt)
dm$normVaxAtt <- rowMeans(dm[c("norms_attitudes_1", "norms_attitudes_2", "norms_attitudes_3")], na.rm = T)
dm$normVaxAtt <- ifelse(dm$normVaxAtt == "NaN", NA, dm$normVaxAtt)
####################
#
# Vacccine Risk Perceptions
#
####################
# vax_prob = What is the probability of experiencing adverse events if you get vaccinated against influenza?
# vax_severe = How severe do you judge the possible adverse events of the vaccination against influenza to be?
dm$vax_prob[dm$vax_prob == 18] <- 1
dm$vax_prob[dm$vax_prob == 19] <- 2
dm$vax_prob[dm$vax_prob == 20] <- 3
dm$vax_prob[dm$vax_prob == 21] <- 4
dm$vax_prob[dm$vax_prob == 22] <- 5
dm$vax_prob[dm$vax_prob == 23] <- 6
dm$vax_prob[dm$vax_prob == 24] <- 7
dm$vax_prob.z <- scale(dm$vax_prob)
dm$vaxRisk <- NA
dm$vaxRisk <- rowMeans(dm[c("vax_prob", "vax_severe")], na.rm = T)
dm$vaxRisk <- ifelse(dm$vaxRisk == "NaN", NA, dm$vaxRisk)
dm$vaxRisk.z <- scale(dm$vaxRisk)
####################
#
# Flu Risk Perceptions
#
####################
# flu_risk = If you don't get the flu shot, what do you think is the likelihood you will get infected with flu?
# flu_severe = If you don't get the flu shot and get infected with flu, how long do you think you will need to stay in bed?
dm$flu_risk[dm$flu_risk == 18] <- 2
dm$flu_risk[dm$flu_risk == 19] <- 3
dm$flu_risk[dm$flu_risk == 20] <- 4
dm$flu_risk[dm$flu_risk == 21] <- 5
dm$flu_risk[dm$flu_risk == 22] <- 6
dm$flu_risk[dm$flu_risk == 23] <- 7
dm$flu_severe[dm$flu_severe == 18] <- 2
dm$flu_severe[dm$flu_severe == 19] <- 3
dm$flu_severe[dm$flu_severe == 20] <- 4
dm$flu_severe[dm$flu_severe == 21] <- 5
dm$flu_severe <- ((dm$flu_severe - 1) / 4) * 6 + 1
dm$fluRisk <- NA
dm$fluRisk <- rowMeans(dm[c("flu_risk","flu_severe")], na.rm = T)
dm$fluRisk <- ifelse(dm$fluRisk == "NaN", NA, dm$fluRisk)
dm$fluRisk.z <- scale(dm$fluRisk)
############################################
#
# Calculate mean, sd, tally
#
##########################################
media_outlet_names <- c(
"NYT", # media_consumption_1
"WSJ",
"WashPost",
"USAToday",
"FoxNews",
"CNN",
"MSNBC",
"Yahoo",
"HuffPost",
"AOL",
"NPR",
"ABC",
"NBC",
"CBS",
"PBS",
"WashExam",
"WashTimes",
"Breitbart",
"DailyWire",
"Reason",
"NatInterest",
"DailyBuzz",
"Now8News",
"RealNews",
"BipartisanReport",
"Pistillon",
"DailyKos",
"WesternJournal",
"DailyCaller",
"Reuters",
"Fortune" # media_consumption_31
)
original_cols <- paste0("media_consumption_", 1:31) # paste old col names
positions <- match(original_cols, colnames(dm)) # match by position
colnames(dm)[positions] <- media_outlet_names # raname columns
dm[media_outlet_names] <- dm[media_outlet_names] - 1 #change to 0-6 scale
dm[media_outlet_names][dm[media_outlet_names] == 0] <- NA # change zeros to NA
dm$nyt.BiasExp <- af2$bias.z[af2$Outlet == "NYT"] * as.numeric(dm$NYT)
dm$wsj.BiasExp <- af2$bias.z[af2$Outlet == "WSJ"] * as.numeric(dm$WSJ)
dm$washPost.BiasExp <- af2$bias.z[af2$Outlet == "WashPost"] * as.numeric(dm$WashPost)
dm$usaToday.BiasExp <- af2$bias.z[af2$Outlet == "USAToday"] * as.numeric(dm$USAToday)
dm$fox.BiasExp <- af2$bias.z[af2$Outlet == "FoxNews"] * as.numeric(dm$FoxNews)
dm$cnn.BiasExp <- af2$bias.z[af2$Outlet == "CNN"] * as.numeric(dm$CNN)
dm$msnbc.BiasExp <- af2$bias.z[af2$Outlet == "MSNBC"] * as.numeric(dm$MSNBC)
dm$yahoo.BiasExp <- af2$bias.z[af2$Outlet == "Yahoo"] * as.numeric(dm$Yahoo)
dm$huffPost.BiasExp <- af2$bias.z[af2$Outlet == "HuffPost"] * as.numeric(dm$HuffPost)
dm$aol.BiasExp <- af2$bias.z[af2$Outlet == "AOL"] * as.numeric(dm$AOL)
dm$npr.BiasExp <- af2$bias.z[af2$Outlet == "NPR"] * as.numeric(dm$NPR)
dm$abc.BiasExp <- af2$bias.z[af2$Outlet == "ABC"] * as.numeric(dm$ABC)
dm$nbc.BiasExp <- af2$bias.z[af2$Outlet == "NBC"] * as.numeric(dm$NBC)
dm$cbs.BiasExp <- af2$bias.z[af2$Outlet == "CBS"] * as.numeric(dm$CBS)
dm$pbs.BiasExp <- af2$bias.z[af2$Outlet == "PBS"] * as.numeric(dm$PBS)
dm$washExam.BiasExp <- af2$bias.z[af2$Outlet == "WashExam"] * as.numeric(dm$WashExam)
dm$washTimes.BiasExp <- af2$bias.z[af2$Outlet == "WashTimes"] * as.numeric(dm$WashTimes)
dm$breitbart.BiasExp <- af2$bias.z[af2$Outlet == "Breitbart"] * as.numeric(dm$Breitbart)
dm$dailyWire.BiasExp <- af2$bias.z[af2$Outlet == "DailyWire"] * as.numeric(dm$DailyWire)
dm$reason.BiasExp <- af2$bias.z[af2$Outlet == "Reason"] * as.numeric(dm$Reason)
dm$bipartReport.BiasExp <- af2$bias.z[af2$Outlet == "BipartisanReport"] * as.numeric(dm$BipartisanReport)
dm$dailyKos.BiasExp <- af2$bias.z[af2$Outlet == "DailyKos"] * as.numeric(dm$DailyKos)
dm$westJournal.BiasExp <- af2$bias.z[af2$Outlet == "WesternJournal"] * as.numeric(dm$WesternJournal)
dm$dailyCaller.BiasExp <- af2$bias.z[af2$Outlet == "DailyCaller"] * as.numeric(dm$DailyCaller)
dm$reuters.BiasExp <- af2$bias.z[af2$Outlet == "Reuters"] * as.numeric(dm$Reuters)
dm$fortune.BiasExp <- af2$bias.z[af2$Outlet == "Fortune"] * as.numeric(dm$Fortune)
expBiasProducts <- c(
"nyt.BiasExp",
"wsj.BiasExp",
"washPost.BiasExp",
"usaToday.BiasExp",
"fox.BiasExp",
"cnn.BiasExp",
"msnbc.BiasExp",
"yahoo.BiasExp",
"huffPost.BiasExp",
"aol.BiasExp",
"npr.BiasExp",
"abc.BiasExp",
"nbc.BiasExp",
"cbs.BiasExp",
"pbs.BiasExp",
"washExam.BiasExp",
"washTimes.BiasExp",
"breitbart.BiasExp",
"dailyWire.BiasExp",
"reason.BiasExp",
"bipartReport.BiasExp",
"dailyKos.BiasExp",
"westJournal.BiasExp",
"reuters.BiasExp",
"fortune.BiasExp")
dm$bias.mean.26 <- rowMeans(dm[expBiasProducts], na.rm = TRUE)
dm$bias.mean.26 <- ifelse(dm$bias.mean.26 == "NaN", NA, dm$bias.mean.26)
dm$bias.mean.26.z <- scale(dm$bias.mean.26)
dm$bias.sd.26 <- apply(dm[expBiasProducts], 1, pop_sd, na.rm = T)
dm$bias.sd.26 <- ifelse(dm$bias.sd.26 == "NaN", NA, dm$bias.sd.26)
dm$bias.sd.26.z <- scale(dm$bias.sd.26)
##############################################
#
### Tally
#
#############################################@
outlet_cols <- c(
"NYT", # media_consumption_1
"WSJ",
"WashPost",
"USAToday",
"FoxNews",
"CNN",
"MSNBC",
"Yahoo",
"HuffPost",
"AOL",
"NPR",
"ABC",
"NBC",
"CBS",
"PBS",
"WashExam",
"WashTimes",
"Breitbart",
"DailyWire",
"Reason",
"NatInterest",
"DailyBuzz",
"Now8News",
"RealNews",
"BipartisanReport",
"Pistillon",
"DailyKos",
"WesternJournal",
"DailyCaller",
"Reuters",
"Fortune" # media_consumption_31
)
# Create a new column that counts how many of the selected columns are between 1 and 7
dm$tally.26 <- rowSums(dm[outlet_cols] >= 1 & dm[outlet_cols] <= 7, na.rm = TRUE)
dm$sumExp.26 <- rowSums(dm[outlet_cols], na.rm = TRUE)
dm$sumExp.26.z <- as.numeric(scale(dm$sumExp.26))
dm$tally.26.z <- as.numeric(scale(dm$tally.26))
library(tidyverse)
dm <- dm %>%
rowwise() %>%
mutate(
media.list = paste(
outlet_cols[which(
!is.na(c_across(all_of(outlet_cols))) &
c_across(all_of(outlet_cols)) >= 1
)],
collapse = ", "
)
) %>%
ungroup()
dm$trustSci_1.r <- (4 - dm$trust_science_1)
dm$trustSci_2.r <- (4 - dm$trust_science_2)
dm$trustSci_3.r <- (4 - dm$trust_science_3)
dm$trustSci_6.r <- (4 - dm$trust_science_6)
dm$trustSci_7.r <- (4 - dm$trust_science_7)
dm$trustSci_8.r <- (4 - dm$trust_science_8)
dm$trustSci <- rowMeans(
cbind.data.frame(dm$trustSci_1.r,
dm$trustSci_2.r,
dm$trustSci_3.r,
dm$trust_science_4,
dm$trust_science_5,
dm$trustSci_6.r,
dm$trustSci_7.r,
dm$trustSci_8.r)
, na.rm = T) corr table (2025)
corr <- data.frame(d$ideology)
colnames(corr)[colnames(corr) == "d.ideology"] <- "ideology"
corr$ethnicity <- d$white_1
corr$NFC <- d$nfc
corr$SESladder <- d$sesLadder2
corr$age <- d$age
corr$gender <- d$man_1
corr$fluCurrent <- d$fluCurrent
corr$fluNext <- d$fluNext
corr$mediaLiteracy <- d$mediaLiteracy
corr$vaxxHesitancy <- d$vaxxHesitancy
corr$trustSci <- d$trustSci
corr$vaxxNorms <- d$vaxxNorms
corr$genRisk <- d$genRisk
corr$reliability <- d$rel.mean.40
corr$conservativeTilt <- d$bias.mean.40
corr$diversity <- d$bias.sd.40
corr$tally <- d$tally.40
# Compute the correlation matrix
cor_matrix <- cor(corr, use = "pairwise.complete.obs")
# Generate a color-shaded correlation plot
cp <- corrplot(cor_matrix, method = "color",
col = colorRampPalette(c("red", "white", "blue"))(200), # Red for negative, blue for positive
type = "upper", # Only display upper triangle
addCoef.col = "black", # Add correlation coefficients
tl.col = "black", # Labels color
tl.cex = 1.0, # Labels size
number.cex = 0.8, # Coefficient size
cl.cex = 0.7) # Color legend size
apa.cor.table(cor_matrix)##
##
## Means, standard deviations, and correlations with confidence intervals
##
##
## Variable M SD 1 2 3
## 1. ideology 0.08 0.37
##
## 2. ethnicity 0.08 0.25 .08
## [-.43, .56]
##
## 3. NFC 0.12 0.25 -.32 -.11
## [-.70, .21] [-.58, .41]
##
## 4. SESladder 0.13 0.26 .19 -.08 .05
## [-.34, .62] [-.56, .43] [-.46, .53]
##
## 5. age 0.09 0.26 .02 .23 .00
## [-.48, .51] [-.30, .65] [-.49, .50]
##
## 6. fluCurrent -0.06 0.41 .45 .04 -.18
## [-.05, .78] [-.47, .52] [-.62, .34]
##
## 7. fluNext 0.09 0.46 -.62** -.10 .20
## [-.86, -.19] [-.57, .42] [-.33, .63]
##
## 8. mediaLiteracy 0.11 0.25 -.14 -.01 .46
## [-.59, .38] [-.50, .49] [-.05, .78]
##
## 9. vaxxHesitancy -0.01 0.45 .82** .07 -.25
## [.54, .93] [-.44, .55] [-.66, .28]
##
## 10. trustSci 0.02 0.41 -.93** -.10 .31
## [-.98, -.80] [-.57, .42] [-.22, .70]
##
## 11. vaxxNorms 0.13 0.41 -.60* -.08 .21
## [-.84, -.14] [-.56, .43] [-.32, .64]
##
## 12. genRisk 0.10 0.39 -.61* -.14 .07
## [-.85, -.16] [-.59, .39] [-.44, .55]
##
## 13. reliability 0.13 0.34 -.59* -.34 .20
## [-.84, -.14] [-.71, .19] [-.33, .63]
##
## 14. conservativeTilt 0.05 0.36 .89** .11 -.32
## [.70, .96] [-.40, .58] [-.71, .21]
##
## 15. diversity 0.15 0.26 .33 -.20 -.05
## [-.19, .71] [-.63, .33] [-.53, .46]
##
## 16. tally 0.16 0.30 -.36 -.35 .18
## [-.73, .17] [-.72, .17] [-.35, .62]
##
## 4 5 6 7 8 9
##
##
##
##
##
##
##
##
##
##
##
## .00
## [-.49, .50]
##
## -.44 -.17
## [-.77, .08] [-.61, .36]
##
## .30 .13 -.96**
## [-.23, .70] [-.39, .59] [-.99, -.89]
##
## -.26 -.02 .09 -.07
## [-.67, .27] [-.51, .48] [-.42, .56] [-.55, .44]
##
## -.07 -.18 .80** -.91** -.00
## [-.54, .44] [-.62, .35] [.51, .93] [-.97, -.77] [-.50, .49]
##
## -.11 .05 -.57* .71** .09 -.91**
## [-.58, .40] [-.46, .53] [-.83, -.10] [.33, .89] [-.43, .56] [-.97, -.76]
##
## .34 .18 -.94** .96** -.07 -.88**
## [-.19, .71] [-.34, .62] [-.98, -.83] [.89, .99] [-.55, .44] [-.96, -.68]
##
## .28 -.01 -.88** .93** -.17 -.84**
## [-.25, .68] [-.50, .49] [-.96, -.68] [.80, .98] [-.62, .35] [-.94, -.60]
##
## .05 -.19 -.45 .52* .04 -.56*
## [-.46, .53] [-.62, .34] [-.77, .06] [.03, .81] [-.47, .52] [-.83, -.09]
##
## .02 .03 .52* -.65** -.11 .78**
## [-.48, .51] [-.47, .52] [.03, .81] [-.87, -.23] [-.57, .41] [.46, .92]
##
## .18 -.22 -.03 -.08 -.00 .26
## [-.34, .62] [-.65, .31] [-.52, .48] [-.55, .43] [-.50, .49] [-.28, .67]
##
## -.05 -.21 -.23 .26 .17 -.30
## [-.53, .46] [-.64, .32] [-.65, .30] [-.27, .67] [-.36, .61] [-.69, .23]
##
## 10 11 12 13 14 15
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
## .68**
## [.27, .88]
##
## .66** .90**
## [.24, .87] [.72, .96]
##
## .59* .48 .53*
## [.14, .84] [-.02, .79] [.04, .81]
##
## -.87** -.63** -.65** -.70**
## [-.95, -.66] [-.86, -.20] [-.87, -.23] [-.89, -.32]
##
## -.35 -.07 -.03 .11 .26
## [-.72, .18] [-.54, .44] [-.52, .47] [-.41, .58] [-.28, .67]
##
## .34 .24 .27 .86** -.43 .42
## [-.19, .71] [-.29, .66] [-.26, .68] [.64, .95] [-.76, .08] [-.09, .76]
##
##
## Note. M and SD are used to represent mean and standard deviation, respectively.
## Values in square brackets indicate the 95% confidence interval.
## The confidence interval is a plausible range of population correlations
## that could have caused the sample correlation (Cumming, 2014).
## * indicates p < .05. ** indicates p < .01.
## corr table (2023)
library(ggcorrplot)
library(psych)
cor_vars <- c("tally.26", "sumExp.26", "bias.mean.26","bias.sd.26",
"vaxBeh", "vaxIntent",
"vaxAtt","normVaxAtt",
"vaxRisk","fluRisk",
"numeracy","cogReflect","raven", "anAbility",
"REI", "subjNum", "anStyle",
"ideology",
"white_.5",
"man_.5",
"age",
"education")
# Correlation and p-value matrix
cor_results <- corr.test(dm[, cor_vars], use = "pairwise.complete.obs")
# Correlation matrix rounded to 2 decimals
cor_matrix <- round(cor_results$r, 2)
# p-value matrix
p_matrix <- cor_results$p
ggcorrplot(cor_matrix,
method = "circle",
type = "lower",
lab = TRUE,
lab_size = 4,
p.mat = p_matrix, # Add p-values
sig.level = 0.05, # Mark significance (e.g., with stars)
insig = "blank", # Blank out insignificant correlations
colors = c("red", "white", "blue"),
title = "Correlation Matrix with Significance",
ggtheme = ggplot2::theme_minimal())
Analyses
Vaccination Behavior (2023 & 2025)
m2023 <- glm(vaxBeh ~
(bias.mean.26.z * bias.sd.26.z) +
(bias.mean.26.z + bias.sd.26.z) * ideology.z + anAbility.z + age.z + education.z + man_.5, family = binomial, data = dm)
m2025 <- glm(fluVaxx ~
(bias.mean.40.z * bias.sd.40.z) +
(bias.mean.40.z + bias.sd.40.z) * ideology.z + nfc.z + age.z + sesLadder.z + man_.5, family = binomial, data = d)
tab_model(m2023, m2025,
string.est = "OR",
title = "Outcome: Flu vaccination",
dv.labels = c("2022-23", "2025"),
show.stat = F,
string.stat = "t",
show.se = F,
digits = 2)| 2022-23 | 2025 | |||||
|---|---|---|---|---|---|---|
| Predictors | OR | CI | p | OR | CI | p |
| (Intercept) | 0.71 | 0.57 – 0.88 | 0.002 | 0.66 | 0.59 – 0.73 | <0.001 |
| bias mean 26 z | 0.90 | 0.72 – 1.12 | 0.335 | |||
| bias sd 26 z | 1.20 | 0.98 – 1.46 | 0.080 | |||
| ideology z | 0.69 | 0.55 – 0.86 | 0.001 | 0.78 | 0.69 – 0.89 | <0.001 |
| anAbility z | 0.91 | 0.73 – 1.13 | 0.400 | |||
| age z | 1.02 | 0.84 – 1.25 | 0.830 | 1.20 | 1.09 – 1.33 | <0.001 |
| education z | 1.13 | 0.93 – 1.39 | 0.217 | |||
| man 5 | 0.85 | 0.55 – 1.32 | 0.467 | 1.01 | 0.83 – 1.22 | 0.958 |
|
bias mean 26 z × bias sd 26 z |
0.98 | 0.78 – 1.22 | 0.834 | |||
|
bias mean 26 z × ideology z |
0.82 | 0.66 – 1.00 | 0.060 | |||
| bias sd 26 z × ideology z | 1.07 | 0.88 – 1.31 | 0.507 | |||
| bias mean 40 z | 0.69 | 0.60 – 0.79 | <0.001 | |||
| bias sd 40 z | 1.15 | 1.04 – 1.28 | 0.008 | |||
| nfc z | 0.99 | 0.90 – 1.10 | 0.888 | |||
| sesLadder z | 1.84 | 1.66 – 2.06 | <0.001 | |||
|
bias mean 40 z × bias sd 40 z |
1.14 | 1.02 – 1.27 | 0.017 | |||
|
bias mean 40 z × ideology z |
1.02 | 0.93 – 1.12 | 0.723 | |||
| bias sd 40 z × ideology z | 1.12 | 1.01 – 1.25 | 0.025 | |||
| Observations | 449 | 1933 | ||||
| R2 Tjur | 0.057 | 0.116 | ||||
Vaccination Intention (2023 & 2025)
m2023 <- lm(vaxIntent ~
(bias.mean.26.z * bias.sd.26.z) +
(bias.mean.26.z + bias.sd.26.z) * ideology.z +
anAbility.z + white_.5 + education.z + man_.5 + age.z, data = dm)
m2025 <- lm(fluNext ~
(bias.mean.40.z * bias.sd.40.z) +
(bias.mean.40.z + bias.sd.40.z) * ideology.z +
nfc.z+ white_.5 + sesLadder.z + man_.5 + age.z, data = d)
tab_model(m2023, m2025,
string.est = "Est",
title = "Outcome: Flu Vaxx Intention",
dv.labels = c("2022-23", "2025"),
show.stat = F,
string.stat = "t",
show.se = F,
digits = 2)| 2022-23 | 2025 | |||||
|---|---|---|---|---|---|---|
| Predictors | Est | CI | p | Est | CI | p |
| (Intercept) | 1.28 | 1.08 – 1.49 | <0.001 | 0.20 | 0.07 – 0.32 | 0.002 |
| bias mean 26 z | -0.12 | -0.29 – 0.06 | 0.204 | |||
| bias sd 26 z | 0.15 | -0.02 – 0.32 | 0.080 | |||
| ideology z | -0.48 | -0.67 – -0.30 | <0.001 | -0.52 | -0.64 – -0.39 | <0.001 |
| anAbility z | 0.06 | -0.13 – 0.25 | 0.513 | |||
| white 5 | 0.08 | -0.31 – 0.47 | 0.675 | 0.02 | -0.21 – 0.26 | 0.843 |
| education z | -0.02 | -0.19 – 0.14 | 0.775 | |||
| man 5 | -0.18 | -0.55 – 0.19 | 0.343 | -0.05 | -0.25 – 0.15 | 0.631 |
| age z | -0.01 | -0.17 – 0.16 | 0.918 | 0.23 | 0.13 – 0.33 | <0.001 |
|
bias mean 26 z × bias sd 26 z |
-0.08 | -0.27 – 0.11 | 0.417 | |||
|
bias mean 26 z × ideology z |
-0.30 | -0.45 – -0.14 | <0.001 | |||
| bias sd 26 z × ideology z | 0.07 | -0.10 – 0.24 | 0.412 | |||
| bias mean 40 z | -0.50 | -0.63 – -0.36 | <0.001 | |||
| bias sd 40 z | 0.15 | 0.04 – 0.25 | 0.007 | |||
| nfc z | 0.10 | -0.01 – 0.20 | 0.066 | |||
| sesLadder z | 0.55 | 0.44 – 0.65 | <0.001 | |||
|
bias mean 40 z × bias sd 40 z |
0.18 | 0.07 – 0.29 | 0.001 | |||
|
bias mean 40 z × ideology z |
0.01 | -0.08 – 0.10 | 0.817 | |||
| bias sd 40 z × ideology z | 0.11 | 0.00 – 0.22 | 0.043 | |||
| Observations | 469 | 1933 | ||||
| R2 / R2 adjusted | 0.124 / 0.103 | 0.163 / 0.158 | ||||
Trust in Science (2023 & 2025)
m2023 <- lm(trustSci ~
(bias.mean.26.z * bias.sd.26.z) +
(bias.mean.26.z + bias.sd.26.z) * ideology.z +
anAbility.z + white_.5 + education.z + man_.5 + age.z, data = dm)
m2025 <- lm(trustSci ~
(bias.mean.40.z * bias.sd.40.z) +
(bias.mean.40.z + bias.sd.40.z) * ideology.z +
nfc.z+ white_.5 + sesLadder.z + man_.5 + age.z, data = d)
tab_model(m2023, m2025,
string.est = "Est",
title = "Outcome: Trust in Science",
dv.labels = c("2022-23", "2025"),
show.stat = F,
show.se = F,
digits = 2)| 2022-23 | 2025 | |||||
|---|---|---|---|---|---|---|
| Predictors | Est | CI | p | Est | CI | p |
| (Intercept) | 2.36 | 2.27 – 2.45 | <0.001 | 1.01 | 0.95 – 1.06 | <0.001 |
| bias mean 26 z | -0.07 | -0.15 – 0.01 | 0.068 | |||
| bias sd 26 z | -0.00 | -0.08 – 0.07 | 0.945 | |||
| ideology z | -0.29 | -0.37 – -0.21 | <0.001 | -0.55 | -0.60 – -0.49 | <0.001 |
| anAbility z | 0.09 | 0.01 – 0.17 | 0.032 | |||
| white 5 | 0.23 | 0.06 – 0.40 | 0.007 | 0.06 | -0.04 – 0.16 | 0.232 |
| education z | 0.04 | -0.04 – 0.11 | 0.322 | |||
| man 5 | -0.02 | -0.18 – 0.14 | 0.809 | 0.11 | 0.03 – 0.20 | 0.009 |
| age z | 0.08 | 0.01 – 0.15 | 0.031 | 0.08 | 0.03 – 0.12 | <0.001 |
|
bias mean 26 z × bias sd 26 z |
0.01 | -0.08 – 0.09 | 0.903 | |||
|
bias mean 26 z × ideology z |
0.00 | -0.06 – 0.07 | 0.894 | |||
| bias sd 26 z × ideology z | -0.03 | -0.11 – 0.04 | 0.341 | |||
| bias mean 40 z | -0.28 | -0.34 – -0.22 | <0.001 | |||
| bias sd 40 z | -0.08 | -0.12 – -0.03 | 0.001 | |||
| nfc z | 0.13 | 0.09 – 0.18 | <0.001 | |||
| sesLadder z | -0.00 | -0.04 – 0.04 | 0.955 | |||
|
bias mean 40 z × bias sd 40 z |
0.08 | 0.03 – 0.12 | 0.001 | |||
|
bias mean 40 z × ideology z |
0.01 | -0.03 – 0.04 | 0.784 | |||
| bias sd 40 z × ideology z | 0.07 | 0.02 – 0.11 | 0.004 | |||
| Observations | 469 | 1933 | ||||
| R2 / R2 adjusted | 0.195 / 0.176 | 0.399 / 0.396 | ||||
Vaccine hesitancy (2025)
m <- lm(vaxxHesitancy ~
(bias.mean.40.z * bias.sd.40.z) +
(bias.mean.40.z + bias.sd.40.z) * ideology.z +
white_.5 + age.z + sesLadder.z + nfc.z + man_.5, data = d)
tab_model( m,
string.est = "Est",
title = "Outcome: Flu Vaccine Hesitancy",
dv.labels = c("2025"),
show.stat = T,
show.se = F,
string.se = "SE",
string.stat = "t",
digits = 2)| 2025 | ||||
|---|---|---|---|---|
| Predictors | Est | CI | t | p |
| (Intercept) | -0.62 | -0.67 – -0.56 | -23.07 | <0.001 |
| bias mean 40 z | 0.24 | 0.19 – 0.30 | 8.44 | <0.001 |
| bias sd 40 z | 0.08 | 0.04 – 0.13 | 3.63 | <0.001 |
| ideology z | 0.44 | 0.39 – 0.49 | 16.55 | <0.001 |
| white 5 | 0.02 | -0.07 – 0.12 | 0.45 | 0.652 |
| age z | -0.19 | -0.23 – -0.15 | -8.67 | <0.001 |
| sesLadder z | -0.05 | -0.09 – -0.01 | -2.20 | 0.028 |
| nfc z | -0.03 | -0.07 – 0.02 | -1.25 | 0.212 |
| man 5 | -0.10 | -0.18 – -0.01 | -2.28 | 0.022 |
|
bias mean 40 z × bias sd 40 z |
-0.08 | -0.12 – -0.03 | -3.43 | 0.001 |
|
bias mean 40 z × ideology z |
-0.04 | -0.07 – 0.00 | -1.94 | 0.053 |
| bias sd 40 z × ideology z | -0.07 | -0.11 – -0.02 | -2.93 | 0.003 |
| Observations | 1932 | |||
| R2 / R2 adjusted | 0.312 / 0.308 | |||
Risk of flu (2023 & 2025)
#2023 flu risk questions
# flu_risk = If you don't get the flu shot, what do you think is the likelihood you will get infected with flu?
# flu_severe = If you don't get the flu shot and get infected with flu, how long do you think you will need to stay in bed?
# 2025 flu risk questions
# flu_risk = How likely are you to contract the flu this year?
# flu_severe = If you were to contract the flu this year, what do you believe is the likelihood that you would develop serious health consequences (e.g., difficulty breathing, pneumonia, and dangerously high fever)?
m2023 <- lm(fluRisk ~
(bias.mean.26.z * bias.sd.26.z) +
(bias.mean.26.z + bias.sd.26.z) * ideology.z +
anAbility.z + white_.5 + education.z + man_.5 + age.z, data = dm)
m2025 <- lm(fluRisk ~
(bias.mean.40.z * bias.sd.40.z) +
(bias.mean.40.z + bias.sd.40.z) * ideology.z +
nfc.z+ white_.5 + sesLadder.z + man_.5 + age.z, data = d)
tab_model(m2023, m2025,
string.est = "Est",
title = "Outcome: Flu Risk Perceptions",
dv.labels = c("2022-23", "2025"),
show.stat = F,
show.se = F,
digits = 2)| 2022-23 | 2025 | |||||
|---|---|---|---|---|---|---|
| Predictors | Est | CI | p | Est | CI | p |
| (Intercept) | 4.43 | 4.32 – 4.55 | <0.001 | -0.82 | -0.90 – -0.75 | <0.001 |
| bias mean 26 z | -0.11 | -0.21 – -0.00 | 0.041 | |||
| bias sd 26 z | 0.08 | -0.02 – 0.18 | 0.098 | |||
| ideology z | -0.14 | -0.24 – -0.03 | 0.012 | 0.05 | -0.02 – 0.13 | 0.178 |
| anAbility z | -0.02 | -0.13 – 0.08 | 0.674 | |||
| white 5 | -0.21 | -0.43 – 0.01 | 0.066 | 0.11 | -0.03 – 0.25 | 0.135 |
| education z | 0.05 | -0.05 – 0.14 | 0.345 | |||
| man 5 | -0.36 | -0.57 – -0.15 | 0.001 | -0.15 | -0.27 – -0.03 | 0.015 |
| age z | 0.04 | -0.05 – 0.13 | 0.411 | -0.02 | -0.08 – 0.05 | 0.601 |
|
bias mean 26 z × bias sd 26 z |
-0.06 | -0.17 – 0.05 | 0.260 | |||
|
bias mean 26 z × ideology z |
-0.04 | -0.13 – 0.04 | 0.327 | |||
| bias sd 26 z × ideology z | 0.06 | -0.04 – 0.15 | 0.224 | |||
| bias mean 40 z | -0.12 | -0.20 – -0.04 | 0.004 | |||
| bias sd 40 z | 0.21 | 0.14 – 0.27 | <0.001 | |||
| nfc z | -0.13 | -0.19 – -0.06 | <0.001 | |||
| sesLadder z | 0.18 | 0.11 – 0.24 | <0.001 | |||
|
bias mean 40 z × bias sd 40 z |
0.05 | -0.02 – 0.11 | 0.177 | |||
|
bias mean 40 z × ideology z |
-0.14 | -0.19 – -0.08 | <0.001 | |||
| bias sd 40 z × ideology z | 0.05 | -0.01 – 0.11 | 0.127 | |||
| Observations | 468 | 1933 | ||||
| R2 / R2 adjusted | 0.096 / 0.074 | 0.071 / 0.066 | ||||
Risk of Vaccine (2023)
m <- lm(vaxRisk ~
(bias.mean.26.z * bias.sd.26.z) +
(bias.mean.26.z + bias.sd.26.z) *+ ideology.z + anAbility.z + man_.5 + education.z + age.z, data = dm)
tab_model(m2023,
string.est = "Est",
title = "Outcome: Vaccine Risk Perceptions",
dv.labels = c("2022-23 ONLY"),
show.stat = F,
string.stat = "t",
show.se = F,
digits = 2)| 2022-23 ONLY | |||
|---|---|---|---|
| Predictors | Est | CI | p |
| (Intercept) | 4.43 | 4.32 – 4.55 | <0.001 |
| bias mean 26 z | -0.11 | -0.21 – -0.00 | 0.041 |
| bias sd 26 z | 0.08 | -0.02 – 0.18 | 0.098 |
| ideology z | -0.14 | -0.24 – -0.03 | 0.012 |
| anAbility z | -0.02 | -0.13 – 0.08 | 0.674 |
| white 5 | -0.21 | -0.43 – 0.01 | 0.066 |
| education z | 0.05 | -0.05 – 0.14 | 0.345 |
| man 5 | -0.36 | -0.57 – -0.15 | 0.001 |
| age z | 0.04 | -0.05 – 0.13 | 0.411 |
|
bias mean 26 z × bias sd 26 z |
-0.06 | -0.17 – 0.05 | 0.260 |
|
bias mean 26 z × ideology z |
-0.04 | -0.13 – 0.04 | 0.327 |
| bias sd 26 z × ideology z | 0.06 | -0.04 – 0.15 | 0.224 |
| Observations | 468 | ||
| R2 / R2 adjusted | 0.096 / 0.074 | ||
Attitudes toward vaccination (2023)
# Vaccine Attitudes = Vaccination against the flu is (1) necessary, (2) a good idea, (3) beneficial
m2023 <- lm(vaxAtt ~
(bias.mean.26.z * bias.sd.26.z) +
(bias.mean.26.z + bias.sd.26.z) * ideology.z + anAbility.z + man_.5 + education.z + age.z, data = dm)
tab_model(m2023,
string.est = "Est",
title = "Outcome: Attitude toward the flu vaccination",
dv.labels = c("2022-23"),
show.stat = F,
show.se = F,
digits = 2)| 2022-23 | |||
|---|---|---|---|
| Predictors | Est | CI | p |
| (Intercept) | 5.72 | 5.60 – 5.84 | <0.001 |
| bias mean 26 z | -0.09 | -0.21 – 0.03 | 0.142 |
| bias sd 26 z | 0.04 | -0.08 – 0.15 | 0.503 |
| ideology z | -0.34 | -0.46 – -0.21 | <0.001 |
| anAbility z | 0.11 | -0.02 – 0.23 | 0.095 |
| man 5 | -0.05 | -0.30 – 0.19 | 0.673 |
| education z | 0.06 | -0.06 – 0.17 | 0.331 |
| age z | -0.04 | -0.15 – 0.07 | 0.474 |
|
bias mean 26 z × bias sd 26 z |
-0.05 | -0.18 – 0.07 | 0.408 |
|
bias mean 26 z × ideology z |
-0.03 | -0.13 – 0.08 | 0.607 |
| bias sd 26 z × ideology z | 0.00 | -0.11 – 0.11 | 0.966 |
| Observations | 469 | ||
| R2 / R2 adjusted | 0.115 / 0.095 | ||
Norms Around Vaccine Attitudes (2023)
m <- lm(normVaxAtt ~
(bias.mean.26.z * bias.sd.26.z) +
(bias.mean.26.z + bias.sd.26.z) * ideology.z +
anAbility.z + white_.5 + education.z + man_.5 + age.z, data = dm)
tab_model(m2023,
string.est = "Est",
title = "Outcome: Norms around vaccine attitudes",
dv.labels = c("2022-23"),
show.stat = F,
show.se = F,
digits = 2)| 2022-23 | |||
|---|---|---|---|
| Predictors | Est | CI | p |
| (Intercept) | 5.72 | 5.60 – 5.84 | <0.001 |
| bias mean 26 z | -0.09 | -0.21 – 0.03 | 0.142 |
| bias sd 26 z | 0.04 | -0.08 – 0.15 | 0.503 |
| ideology z | -0.34 | -0.46 – -0.21 | <0.001 |
| anAbility z | 0.11 | -0.02 – 0.23 | 0.095 |
| man 5 | -0.05 | -0.30 – 0.19 | 0.673 |
| education z | 0.06 | -0.06 – 0.17 | 0.331 |
| age z | -0.04 | -0.15 – 0.07 | 0.474 |
|
bias mean 26 z × bias sd 26 z |
-0.05 | -0.18 – 0.07 | 0.408 |
|
bias mean 26 z × ideology z |
-0.03 | -0.13 – 0.08 | 0.607 |
| bias sd 26 z × ideology z | 0.00 | -0.11 – 0.11 | 0.966 |
| Observations | 469 | ||
| R2 / R2 adjusted | 0.115 / 0.095 | ||