Import Data Set

Method

Respondents: Summer 2020

nrow(d)  #N = 3328
## [1] 3328
# exclude participants out of proper age range
d <- d[d$age < 100,] # 0 participants excluded
d <- d[d$age > 17,]  # 0 participants excluded

nrow(d) 
## [1] 3328
mean(d$age, na.rm = T) 
## [1] 48.37987
sd(d$age, na.rm = T) 
## [1] 15.44165
range(d$age, na.rm = T) 
## [1] 19 89
prop.table(table(d$gender)) # F = 1, M = 2, Other = 3
## 
##           1           2           3 
## 0.507552870 0.490433031 0.002014099
table(d$gender) # F = 1, M = 2, Other = 3
## 
##    1    2    3 
## 1512 1461    6
round(prop.table(table(d$race_factor)), 4)*100
## 
##   asian   black   latin natAmer   other  pacIsl   white 
##    8.39   13.49    8.59    0.84    1.31    0.47   66.90
describe(d$education) 
## d$education 
##        n  missing distinct     Info     Mean      Gmd      .05      .10 
##     2972      356       17    0.953    14.32    2.755       11       12 
##      .25      .50      .75      .90      .95 
##       13       15       16       17       17 
##                                                                             
## Value          1     2     3     4     5     6     7     8     9    10    11
## Frequency      7    16    10    53    15     9     3     7     9    13    20
## Proportion 0.002 0.005 0.003 0.018 0.005 0.003 0.001 0.002 0.003 0.004 0.007
##                                               
## Value         12    13    14    15    16    17
## Frequency    559   209   415   154   932   541
## Proportion 0.188 0.070 0.140 0.052 0.314 0.182
## 
## For the frequency table, variable is rounded to the nearest 0
table(d$party_factor)
## 
##    Democrat Independent  Republican 
##        1337         577        1057
prop.table(table(d$party_factor))
## 
##    Democrat Independent  Republican 
##   0.4500168   0.1942107   0.3557725
mean(d$ideology.1, na.rm = T)
## [1] 0.08814318
sd(d$ideology.1, na.rm = T)
## [1] 1.599481

Respondents: Fall 2020

d2 <- d[!is.na(d$bias.mean.2.15),]
nrow(d2)
## [1] 2179
range(d2$age, na.rm = T) 
## [1] 19 89
mean(d2$age, na.rm = T) 
## [1] 50.14043
sd(d2$age, na.rm = T) 
## [1] 14.98017
prop.table(table(d2$gender)) 
## 
##          1          2          3 
## 0.47979798 0.51882461 0.00137741
round(prop.table(table(d2$race_factor)), 4)*100
## 
##   asian   black   latin natAmer   other  pacIsl   white 
##    8.72   12.25    7.66    0.87    1.15    0.32   69.02
describe(d2$education) 
## d2$education 
##        n  missing distinct     Info     Mean      Gmd      .05      .10 
##     2174        5       17    0.949    14.53    2.532       12       12 
##      .25      .50      .75      .90      .95 
##       13       16       16       17       17 
##                                                                             
## Value          1     2     3     4     5     6     7     8     9    10    11
## Frequency      1     8     7    28     8     4     3     3     6     7    11
## Proportion 0.000 0.004 0.003 0.013 0.004 0.002 0.001 0.001 0.003 0.003 0.005
##                                               
## Value         12    13    14    15    16    17
## Frequency    393   155   296   111   710   423
## Proportion 0.181 0.071 0.136 0.051 0.327 0.195
## 
## For the frequency table, variable is rounded to the nearest 0
round(prop.table(table(d2$party_factor)), 4)*100
## 
##    Democrat Independent  Republican 
##       44.87       17.40       37.74
mean(d2$ideology.1, na.rm = T)
## [1] 0.1399725
sd(d2$ideology.1, na.rm = T)
## [1] 1.62458
mean(d2$ideology.1, na.rm = T)
## [1] 0.1399725
sd(d2$ideology.1, na.rm = T)
## [1] 1.62458

Respondents: Spring 2022

d3 <- d[!is.na(d$bias.mean.3.20),]

mean(d3$age, na.rm = T) 
## [1] 52.48975
sd(d3$age, na.rm = T) 
## [1] 14.52032
range(d3$age, na.rm = T) 
## [1] 21 84
round(prop.table(table(d3$gender_factor)), 4)*100
## 
## custom female   male 
##   0.22  46.22  53.56
round(prop.table(table(d3$race_factor)), 4)*100
## 
##   asian   black   latin natAmer   other  pacIsl   white 
##    7.66   11.00    7.66    0.54    0.76    0.32   72.06
describe(d3$education) 
## d3$education 
##        n  missing distinct     Info     Mean      Gmd      .05      .10 
##      926        1       14    0.949    14.66    2.496       12       12 
##      .25      .50      .75      .90      .95 
##       13       16       16       17       17 
##                                                                             
## Value          1     2     3     4     8     9    10    11    12    13    14
## Frequency      1     4     3    14     2     4     2     4   155    59   119
## Proportion 0.001 0.004 0.003 0.015 0.002 0.004 0.002 0.004 0.167 0.064 0.129
##                             
## Value         15    16    17
## Frequency     57   298   204
## Proportion 0.062 0.322 0.220
## 
## For the frequency table, variable is rounded to the nearest 0
round(prop.table(table(d3$party_factor)), 4)*100
## 
##    Democrat Independent  Republican 
##       45.45       17.21       37.34
mean(d3$ideology.1, na.rm = T)
## [1] 0.1794319
sd(d3$ideology.1, na.rm = T)
## [1] 1.717245

Measures

cor.test(d$ideology.1, d$partyCont)
## 
##  Pearson's product-moment correlation
## 
## data:  d$ideology.1 and d$partyCont
## t = 45.866, df = 2969, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.6224355 0.6645528
## sample estimates:
##       cor 
## 0.6439818

Vaccination Intentions & Behavior

table(d$vaxxBehavior)
## 
##   1   2   3 
## 192 160 591
round(prop.table(table(d3$vaxxBehavior)), 4)*100
## 
##     1     2     3 
## 20.07 16.92 63.02
cor.test(d$vaxxIntent.1, d$vaxxIntent.2)
## 
##  Pearson's product-moment correlation
## 
## data:  d$vaxxIntent.1 and d$vaxxIntent.2
## t = 49.986, df = 2183, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.7103808 0.7495246
## sample estimates:
##       cor 
## 0.7305523
table(d$vaxxIntent.12)
## 
##   -3 -2.5   -2 -1.5   -1 -0.5    0 0.25  0.5    1  1.5    2  2.5    3 
##  408   59  102  108  139   88  438    1  168  249  207  263  188  562
t.test(d$vaxxIntent.12[d$party_factor == "Democrat"], d$vaxxIntent.12[d$party_factor == "Republican"])
## 
##  Welch Two Sample t-test
## 
## data:  d$vaxxIntent.12[d$party_factor == "Democrat"] and d$vaxxIntent.12[d$party_factor == "Republican"]
## t = 9.6593, df = 2026, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.6453615 0.9741781
## sample estimates:
## mean of x mean of y 
## 0.9502618 0.1404920
round(prop.table(table(d$vaxxBehavior[d$party_factor == "Republican"])), 2)
## 
##    1    2    3 
## 0.31 0.20 0.49
round(prop.table(table(d$vaxxBehavior[d$party_factor == "Democrat"])), 2)
## 
##    1    2    3 
## 0.10 0.14 0.76
# Create binary variable: 1 = vaccinated & boosted (vaxxBehavior == 4), 0 = not
d$boosted <- ifelse(d$vaxxBehavior == 4, 1, 0)
d$unvaxxed <- ifelse(d$vaxxBehavior == 1, 1, 0)
d$onlyVaxx <- ifelse(d$vaxxBehavior == 3, 1, 0)

# Create contingency table
table_boosted <- table(d$party_factor, d$boosted)
print(table_boosted)
##              
##                 0
##   Democrat    427
##   Independent 161
##   Republican  352
chisq.test(table_boosted)
## 
##  Chi-squared test for given probabilities
## 
## data:  table_boosted
## X-squared = 120.07, df = 2, p-value < 2.2e-16
# Create contingency table
table_unvaxxed <- table(d$party_factor, d$unvaxxed)
print(table_unvaxxed)
##              
##                 0   1
##   Democrat    386  41
##   Independent 119  42
##   Republican  243 109
chisq.test(table_unvaxxed)
## 
##  Pearson's Chi-squared test
## 
## data:  table_unvaxxed
## X-squared = 58.013, df = 2, p-value = 2.527e-13
# Create contingency table
table_onlyvaxx <- table(d$party_factor, d$onlyVaxx)
print(table_onlyvaxx)
##              
##                 0   1
##   Democrat    102 325
##   Independent  69  92
##   Republican  181 171
chisq.test(table_onlyvaxx)
## 
##  Pearson's Chi-squared test
## 
## data:  table_onlyvaxx
## X-squared = 64.869, df = 2, p-value = 8.201e-15

Trust in Science

d$trustSci.0 <- d$trustSci - 4

mean(d$trustSci.0, na.rm = T)
## [1] -0.5294844
sd(d$trustSci.0, na.rm = T)
## [1] 0.8276678
mean(d$trustSci.0[d$party_factor == "Democrat"], na.rm = T)
## [1] -0.1243
sd(d$trustSci.0[d$party_factor == "Democrat"], na.rm = T)
## [1] 0.7056814
mean(d$trustSci.0[d$party_factor == "Republican"], na.rm = T)
## [1] -0.9371928
sd(d$trustSci.0[d$party_factor == "Republican"], na.rm = T)
## [1] 0.7628906
t.test(d$trustSci.0[d$party_factor == "Democrat"], d$trustSci.0[d$party_factor == "Republican"])
## 
##  Welch Two Sample t-test
## 
## data:  d$trustSci.0[d$party_factor == "Democrat"] and d$trustSci.0[d$party_factor == "Republican"]
## t = 15.133, df = 705.64, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.7074323 0.9183534
## sample estimates:
##  mean of x  mean of y 
## -0.1243000 -0.9371928

Risk Perceptions

mean(d$personalRisk.12, na.rm = T)
## [1] 0.226925
sd(d$personalRisk.12, na.rm = T)
## [1] 1.48559
mean(d$personalRisk.12[d$party_factor == "Republican"], na.rm = T)
## [1] -0.1559343
sd(d$personalRisk.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.551571
mean(d$personalRisk.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 0.6181592
sd(d$personalRisk.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.327057
t.test(d$personalRisk.12[d$party_factor == "Republican"], d$personalRisk.12[d$party_factor == "Democrat"])
## 
##  Welch Two Sample t-test
## 
## data:  d$personalRisk.12[d$party_factor == "Republican"] and d$personalRisk.12[d$party_factor == "Democrat"]
## t = -11.466, df = 1696.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.9065126 -0.6416745
## sample estimates:
##  mean of x  mean of y 
## -0.1559343  0.6181592

Cognitive Reflection

mean(d$CRT, na.rm = T)
## [1] 0.4052641
sd(d$CRT, na.rm = T)
## [1] 0.3127263
mean(d$CRT[d$party_factor == "Republican"], na.rm = T)
## [1] 0.4405181
sd(d$CRT[d$party_factor == "Republican"], na.rm = T)
## [1] 0.3213808
mean(d$CRT[d$party_factor == "Democrat"], na.rm = T)
## [1] 0.3877193
sd(d$CRT[d$party_factor == "Democrat"], na.rm = T)
## [1] 0.3092812
t.test(d$CRT[d$party_factor == "Republican"], d$CRT[d$party_factor == "Democrat"])
## 
##  Welch Two Sample t-test
## 
## data:  d$CRT[d$party_factor == "Republican"] and d$CRT[d$party_factor == "Democrat"]
## t = 2.2897, df = 715.04, p-value = 0.02233
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.007526822 0.098070749
## sample estimates:
## mean of x mean of y 
## 0.4405181 0.3877193

Media Consumption

Outlet Consumption

# Tally number of news outlets consumed in Wave 1 (Exposure > 0)
d$tally.1 <- rowSums(d[, grep("\\.exp\\.1$", names(d))] > 0, na.rm = TRUE)

# Tally for Wave 2
d$tally.2 <- rowSums(d[, grep("\\.exp\\.2$", names(d))] > 0, na.rm = TRUE)

# Tally for Wave 3
d$tally.3 <- rowSums(d[, grep("\\.exp\\.3$", names(d))] > 0, na.rm = TRUE)

# tally of media outlets consumed
d$tally.12 <- rowMeans(d[c("tally.1", "tally.2")], na.rm = T)

mean(d$tally.12, na.rm = T)
## [1] 5.520132
sd(d$tally.12, na.rm = T)
## [1] 4.46065
mean(d$tally.3, na.rm = T)
## [1] 2.224459
sd(d$tally.3, na.rm = T)
## [1] 4.950289
## t-test for average media consumption by party
d$avgExp.12.15 <- NA
d$avgExp.12.15 <- rowMeans(d[c(
  
    "ABC.exp.1",   
    "AOL.exp.1",   
    "CBS.exp.1",   
    "CNN.exp.1",   
    "Fox.exp.1",   
    "HPost.exp.1",
    "MSNBC.exp.1",
    "NBC.exp.1",
    "NPR.exp.1",
    "NYT.exp.1",
    "PBS.exp.1",
    "USAT.exp.1",
    "WPost.exp.1",
    "WSJ.exp.1",
    "Yah.exp.1",
    
    "ABC.exp.2",   
    "AOL.exp.2",   
    "CBS.exp.2",   
    "CNN.exp.2",   
    "Fox.exp.2",   
    "HPost.exp.2",
    "MSNBC.exp.2",
    "NBC.exp.2",
    "NPR.exp.2",
    "NYT.exp.2",
    "PBS.exp.2",
    "USAT.exp.2",
    "WPost.exp.2",
    "WSJ.exp.2",
    "Yah.exp.2"
)], na.rm = T)
d$avgExp.12.15 <- ifelse(d$avgExp.12.15 == "NaN", NA, d$avgExp.12.15)



t.test(d$avgExp.12.15[d$party_factor == "Republican"], d$avgExp.12.15[d$party_factor == "Democrat"])
## 
##  Welch Two Sample t-test
## 
## data:  d$avgExp.12.15[d$party_factor == "Republican"] and d$avgExp.12.15[d$party_factor == "Democrat"]
## t = -17.053, df = 2348.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.6077865 -0.4824173
## sample estimates:
## mean of x mean of y 
## 0.7593983 1.3045002
mean(d$avgExp.12.15[d$party_factor == "Republican"], na.rm = T) # M =
## [1] 0.7593983
sd(d$avgExp.12.15[d$party_factor == "Republican"], na.rm = T) # SD = 
## [1] 0.7416333
mean(d$avgExp.12.15[d$party_factor == "Democrat"], na.rm = T) # M = 
## [1] 1.3045
sd(d$avgExp.12.15[d$party_factor == "Democrat"], na.rm = T) # SD = 
## [1] 0.8188193
d$avgExp.3.20 <- NA
d$avgExp.3.20 <- rowMeans(d[c(
    "MSNBC.exp.3",
    "HPost.exp.3",
    "AOL.exp.3",
    "CNN.exp.3",
    "WPost.exp.3",
    "NYT.exp.3",
    "ABC.exp.3",
    "PBS.exp.3",
    "Yah.exp.3",
    "USAT.exp.3",
    "NBC.exp.3",
    "NPR.exp.3",
    "CBS.exp.3",
    "WSJ.exp.3",
    "Reason.exp.3",
    "WTimes.exp.3",
    "WExam.exp.3",
    "DailyWire.exp.3",
    "Fox.exp.3",
    "Breitbart.exp.3"
)], na.rm = T)
d$avgExp.3.20 <- ifelse(d$avgExp.3.20 == "NaN", NA, d$avgExp.3.20)


t.test(d$avgExp.3.20[d$party_factor == "Republican"], d$avgExp.3.20[d$party_factor == "Democrat"])
## 
##  Welch Two Sample t-test
## 
## data:  d$avgExp.3.20[d$party_factor == "Republican"] and d$avgExp.3.20[d$party_factor == "Democrat"]
## t = -8.821, df = 759.09, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.8853525 -0.5630196
## sample estimates:
## mean of x mean of y 
## 0.7673303 1.4915163
mean(d$avgExp.3.20[d$party_factor == "Republican"], na.rm = T) # M =
## [1] 0.7673303
sd(d$avgExp.3.20[d$party_factor == "Republican"], na.rm = T) # SD = 
## [1] 0.9825097
mean(d$avgExp.3.20[d$party_factor == "Democrat"], na.rm = T) # M = 
## [1] 1.491516
sd(d$avgExp.3.20[d$party_factor == "Democrat"], na.rm = T) # SD = 
## [1] 1.286728
## Most consumed outlets

d$fox.exp.12 <- rowMeans(d[c("Fox.exp.1", "Fox.exp.2")], na.rm = T)
d$cnn.exp.12 <- rowMeans(d[c("CNN.exp.1", "CNN.exp.2")], na.rm = T)
d$cbs.exp.12 <- rowMeans(d[c("CBS.exp.1", "CBS.exp.2")], na.rm = T)
d$abc.exp.12 <- rowMeans(d[c("ABC.exp.1", "ABC.exp.2")], na.rm = T)
d$nbc.exp.12 <- rowMeans(d[c("NBC.exp.1", "NBC.exp.2")], na.rm = T)

# CNN
mean(d$cnn.exp.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 2.036649
sd(d$cnn.exp.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.401374
mean(d$CNN.exp.3[d$party_factor == "Democrat"], na.rm = T)
## [1] 2.545238
sd(d$CNN.exp.3[d$party_factor == "Democrat"], na.rm = T)
## [1] 2.02852
# CBS
mean(d$cbs.exp.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.809506
sd(d$cbs.exp.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.258609
mean(d$CBS.exp.3[d$party_factor == "Democrat"], na.rm = T)
## [1] 2.392857
sd(d$CBS.exp.3[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.870624
# NBC
mean(d$nbc.exp.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.884817
sd(d$nbc.exp.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.274244
mean(d$NBC.exp.3[d$party_factor == "Democrat"], na.rm = T)
## [1] 2.428571
sd(d$NBC.exp.3[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.829784
# ABC
mean(d$abc.exp.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.8908
sd(d$abc.exp.12[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.295593
mean(d$ABC.exp.3[d$party_factor == "Democrat"], na.rm = T)
## [1] 2.595238
sd(d$ABC.exp.3[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.917879
# FOX
mean(d$fox.exp.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.804163
sd(d$fox.exp.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.42985
mean(d$Fox.exp.3[d$party_factor == "Republican"], na.rm = T)
## [1] 2.212828
sd(d$Fox.exp.3[d$party_factor == "Republican"], na.rm = T)
## [1] 2.048722
t.test(d$fox.exp.12, d$Fox.exp.3, paired = T)
## 
##  Paired t-test
## 
## data:  d$fox.exp.12 and d$Fox.exp.3
## t = -4.877, df = 922, p-value = 1.268e-06
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
##  -0.3053993 -0.1301370
## sample estimates:
## mean difference 
##      -0.2177681
# CBS
mean(d$cbs.exp.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.034564
sd(d$cbs.exp.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.143906
mean(d$CBS.exp.3[d$party_factor == "Republican"], na.rm = T)
## [1] 1.142029
sd(d$CBS.exp.3[d$party_factor == "Republican"], na.rm = T)
## [1] 1.622911
# NBC
mean(d$nbc.exp.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.009461
sd(d$nbc.exp.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.167102
mean(d$NBC.exp.3[d$party_factor == "Republican"], na.rm = T)
## [1] 1.089855
sd(d$NBC.exp.3[d$party_factor == "Republican"], na.rm = T)
## [1] 1.538474
# ABC
mean(d$abc.exp.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.041193
sd(d$abc.exp.12[d$party_factor == "Republican"], na.rm = T)
## [1] 1.17798
mean(d$ABC.exp.3[d$party_factor == "Republican"], na.rm = T)
## [1] 1.150725
sd(d$ABC.exp.3[d$party_factor == "Republican"], na.rm = T)
## [1] 1.601382

Figure 2: 2020 Media Consumption by Party Identity

d$ABC.exp.12 <- rowMeans(d[c("ABC.exp.1", "ABC.exp.2")], na.rm = T)
d$AOL.exp.12 <- rowMeans(d[c("AOL.exp.1", "AOL.exp.2")], na.rm = T)
d$CBS.exp.12 <- rowMeans(d[c("CBS.exp.1", "CBS.exp.2")], na.rm = T)
d$CNN.exp.12 <- rowMeans(d[c("CNN.exp.1", "CNN.exp.2")], na.rm = T)
d$Fox.exp.12 <- rowMeans(d[c("Fox.exp.1", "Fox.exp.2")], na.rm = T)
d$HPost.exp.12 <- rowMeans(d[c("HPost.exp.1", "HPost.exp.2")], na.rm = T)
d$MSNBC.exp.12 <- rowMeans(d[c("MSNBC.exp.1", "MSNBC.exp.2")], na.rm = T)
d$NBC.exp.12 <- rowMeans(d[c("NBC.exp.1", "NBC.exp.2")], na.rm = T)
d$NPR.exp.12 <- rowMeans(d[c("NPR.exp.1", "NPR.exp.2")], na.rm = T)
d$NYT.exp.12 <- rowMeans(d[c("NYT.exp.1", "NYT.exp.2")], na.rm = T)
d$PBS.exp.12 <- rowMeans(d[c("PBS.exp.1", "PBS.exp.2")], na.rm = T)
d$USAT.exp.12 <- rowMeans(d[c("USAT.exp.1", "USAT.exp.2")], na.rm = T)
d$WPost.exp.12 <- rowMeans(d[c("WPost.exp.1", "WPost.exp.2")], na.rm = T)
d$WSJ.exp.12 <- rowMeans(d[c("WSJ.exp.1", "WSJ.exp.2")], na.rm = T)
d$Yah.exp.12 <- rowMeans(d[c("Yah.exp.1", "Yah.exp.2")], na.rm = T)

library(tidyverse)






d.3 <- d[
  c("pt", 
    "party_factor",
    
     "MSNBC.exp.12",
    "HPost.exp.12",
    "AOL.exp.12",
    "CNN.exp.12",
    "WPost.exp.12",
    "NYT.exp.12",
    "ABC.exp.12",
    "PBS.exp.12",
    "Yah.exp.12",
    "USAT.exp.1",
    "NBC.exp.12",
    "NPR.exp.12",
    "CBS.exp.12",
    "WSJ.exp.12",
    "Fox.exp.12"
    )]

media <- d.3[!is.na(d.3$party_factor),]


media.df <- tidyr::gather(media, Source, Exposure, 3:17, factor_key = TRUE) 

media.df$Source <- factor(media.df$Source, levels = c(
    "MSNBC.exp.12",
    "HPost.exp.12",
    "AOL.exp.12",
    "CNN.exp.12",
    "WPost.exp.12",
    "NYT.exp.12",
    "ABC.exp.12",
    "PBS.exp.12",
    "Yah.exp.12",
    "USAT.exp.1",
    "NBC.exp.12",
    "NPR.exp.12",
    "CBS.exp.12",
    "WSJ.exp.12",
    "Fox.exp.12"))






# Step 0: Create a new lookup table for the subset of outlets
media_names_subset <- tibble::tibble(
  Source = c(
    "MSNBC.exp.12",
    "HPost.exp.12",
    "AOL.exp.12",
    "CNN.exp.12",
    "WPost.exp.12",
    "NYT.exp.12",
    "ABC.exp.12",
    "PBS.exp.12",
    "Yah.exp.12",
    "USAT.exp.1",
    "NBC.exp.12",
    "NPR.exp.12",
    "CBS.exp.12",
    "WSJ.exp.12",
    "Fox.exp.12"),
  
  Source_Formal = c("MSNBC", 
                    "HuffPost", 
                    "AOL News", 
                    "CNN", 
                    "The Washington Post", 
                    "The New York Times",
                    "ABC News",
                    "PBS News",
                    "Yahoo! News",
                    "USA Today",
                    "NBC News",
                    "NPR",
                    "CBS News",
                    "The Wall Street Journal",
                    "Fox News")
)

# Step 1: Reshape and filter media data
media_filtered <- media %>%
  filter(party_factor %in% c("Democrat", "Republican")) %>%
  pivot_longer(cols = 3:17, names_to = "Source", values_to = "Exposure") %>%
  filter(Source %in% media_names_subset$Source) %>%
  mutate(Source = factor(Source, levels = media_names_subset$Source))

# Step 2: Calculate wide format means
means_wide <- media_filtered %>%
  group_by(Source, party_factor) %>%
  summarise(MeanExposure = mean(Exposure, na.rm = TRUE), .groups = "drop") %>%
  pivot_wider(names_from = party_factor, values_from = MeanExposure)

# Step 3: Reshape to long and calculate hjust
means_long <- means_wide %>%
  pivot_longer(cols = c("Democrat", "Republican"),
               names_to = "party_factor",
               values_to = "MeanExposure") %>%
  left_join(means_wide, by = "Source") %>%
  mutate(hjust = case_when(
    party_factor == "Democrat" & Democrat < Republican ~ 1.1,
    party_factor == "Democrat" & Democrat > Republican ~ -0.1,
    party_factor == "Republican" & Republican < Democrat ~ 1.1,
    party_factor == "Republican" & Republican > Democrat ~ -0.1,
    TRUE ~ 0.5
  )) %>%
  left_join(media_names_subset, by = "Source") %>%
  mutate(Source_Formal = factor(Source_Formal, levels = media_names_subset$Source_Formal))

# Step 4: Plot
p <- ggplot(means_long, aes(x = MeanExposure, y = Source_Formal, color = party_factor)) +
  geom_line(aes(group = Source), color = "gray70", linewidth = 1) +
  geom_point(size = 1) +
  geom_text(aes(
    x = ifelse(hjust == 1.1, MeanExposure - 0.03,
               ifelse(hjust == -0.1, MeanExposure + 0.03, MeanExposure)),
    label = round(MeanExposure, 2),
    hjust = hjust
  ), size = 2, show.legend = FALSE) +
  scale_color_manual(name = "Party Identity",
                     values = c("Democrat" = "dodgerblue",
                                "Republican" = "red3")) +
  labs(x = "Average Exposure to Media Outlet", y = "",
       title = "") +
  scale_x_continuous(breaks = c(0, 1, 2, 3, 4), limits = c(0, 3)) +
  theme_minimal() +
  theme(legend.position = "right",
        axis.text.y = element_text(size = 8))

# Print plot
p

Figure 3: 2022 Media Consumption by Party Identity

d.3 <- d[
  c("pt", 
    "party_factor",
    
    "MSNBC.exp.3",
    "HPost.exp.3",
    "AOL.exp.3",
    "CNN.exp.3",
    "WPost.exp.3",
    "NYT.exp.3",
    "ABC.exp.3",
    "PBS.exp.3",
    "Yah.exp.3",
    "USAT.exp.3",
    "NBC.exp.3",
    "NPR.exp.3",
    "CBS.exp.3",
    "WSJ.exp.3",
    "Reason.exp.3",
    "WTimes.exp.3",
    "WExam.exp.3",
    "DailyWire.exp.3",
    "Fox.exp.3",
    "Breitbart.exp.3"
    )]

media <- d.3[!is.na(d.3$party_factor),]


media.df <- tidyr::gather(media, Source, Exposure, 3:22, factor_key = TRUE) 

media.df$Source <- factor(media.df$Source, levels = c(
    "MSNBC.exp.3",
    "HPost.exp.3",
    "AOL.exp.3",
    "CNN.exp.3",
    "WPost.exp.3",
    "NYT.exp.3",
    "ABC.exp.3",
    "PBS.exp.3",
    "Yah.exp.3",
    "USAT.exp.3",
    "NBC.exp.3",
    "NPR.exp.3",
    "CBS.exp.3",
    "WSJ.exp.3",
    "Reason.exp.3",
    "WTimes.exp.3",
    "WExam.exp.3",
    "DailyWire.exp.3",
    "Fox.exp.3",
    "Breitbart.exp.3",
    "Fox.exp.12"))

# Step 0: Create a new lookup table for the subset of outlets
media_names_subset <- tibble::tibble(
  Source = c(
    "MSNBC.exp.3",
    "HPost.exp.3",
    "AOL.exp.3",
    "CNN.exp.3",
    "WPost.exp.3",
    "NYT.exp.3",
    "ABC.exp.3",
    "PBS.exp.3",
    "Yah.exp.3",
    "USAT.exp.3",
    "NBC.exp.3",
    "NPR.exp.3",
    "CBS.exp.3",
    "WSJ.exp.3",
    "Reason.exp.3",
    "WTimes.exp.3",
    "WExam.exp.3",
    "DailyWire.exp.3",
    "Fox.exp.3",
    "Breitbart.exp.3"),
  
  Source_Formal = c("MSNBC", 
                    "HuffPost", 
                    "AOL News", 
                    "CNN", 
                    "The Washington Post", 
                    "The New York Times",
                    "ABC News",
                    "PBS News",
                    "Yahoo! News",
                    "USA Today",
                    "NBC News",
                    "NPR",
                    "CBS News",
                    "The Wall Street Journal",
                    "Reason",
                    "The Washington Times",
                    "The Washington Examiner",
                    "The Daily Wire",
                    "Fox News",
                    "Breitbart")
)

# Step 1: Reshape and filter media data
media_filtered <- media %>%
  filter(party_factor %in% c("Democrat", "Republican")) %>%
  pivot_longer(cols = 3:22, names_to = "Source", values_to = "Exposure") %>%
  filter(Source %in% media_names_subset$Source) %>%
  mutate(Source = factor(Source, levels = media_names_subset$Source))

# Step 2: Calculate wide format means
means_wide <- media_filtered %>%
  group_by(Source, party_factor) %>%
  summarise(MeanExposure = mean(Exposure, na.rm = TRUE), .groups = "drop") %>%
  pivot_wider(names_from = party_factor, values_from = MeanExposure)

# Step 3: Reshape to long and calculate hjust
means_long <- means_wide %>%
  pivot_longer(cols = c("Democrat", "Republican"),
               names_to = "party_factor",
               values_to = "MeanExposure") %>%
  left_join(means_wide, by = "Source") %>%
  mutate(hjust = case_when(
    party_factor == "Democrat" & Democrat < Republican ~ 1.1,
    party_factor == "Democrat" & Democrat > Republican ~ -0.1,
    party_factor == "Republican" & Republican < Democrat ~ 1.1,
    party_factor == "Republican" & Republican > Democrat ~ -0.1,
    TRUE ~ 0.5
  )) %>%
  left_join(media_names_subset, by = "Source") %>%
  mutate(Source_Formal = factor(Source_Formal, levels = media_names_subset$Source_Formal))

# Step 4: Plot
p <- ggplot(means_long, aes(x = MeanExposure, y = Source_Formal, color = party_factor)) +
  geom_line(aes(group = Source), color = "gray70", linewidth = 1) +
  geom_point(size = 1) +
  geom_text(aes(
    x = ifelse(hjust == 1.1, MeanExposure - 0.03,
               ifelse(hjust == -0.1, MeanExposure + 0.03, MeanExposure)),
    label = round(MeanExposure, 2),
    hjust = hjust
  ), size = 2, show.legend = FALSE) +
  scale_color_manual(name = "Party Identity",
                     values = c("Democrat" = "dodgerblue",
                                "Republican" = "red3")) +
  labs(x = "Average Exposure to Media Outlet", y = "",
       title = "") +
  scale_x_continuous(breaks = c(0, 1, 2, 3, 4), limits = c(0, 3)) +
  theme_minimal() +
  theme(legend.position = "right",
        axis.text.y = element_text(size = 8))

# Print plot
p

Conservative Tilt and Ideological Diversity of Media Consumption

### 2020
mean(d$bias.mean.avg[d$party_factor == "Democrat"], na.rm = T)
## [1] -0.4753483
sd(d$bias.mean.avg[d$party_factor == "Democrat"], na.rm = T)
## [1] 0.9183883
mean(d$bias.mean.avg[d$party_factor == "Republican"], na.rm = T)
## [1] 0.5526541
sd(d$bias.mean.avg[d$party_factor == "Republican"], na.rm = T)
## [1] 0.8521056
mean(d$bias.mean.3.20[d$party_factor == "Democrat"], na.rm = T)
## [1] -0.4821284
sd(d$bias.mean.3.20[d$party_factor == "Republican"], na.rm = T)
## [1] 0.3621564
mean(d$bias.mean.3.20[d$party_factor == "Republican"], na.rm = T)
## [1] 0.04725738
sd(d$bias.mean.3.20[d$party_factor == "Republican"], na.rm = T)
## [1] 0.3621564
### 2022
mean(d$bias.sd.avg[d$party_factor == "Democrat"], na.rm = T)
## [1] 0.1808597
sd(d$bias.sd.avg[d$party_factor == "Democrat"], na.rm = T)
## [1] 0.9200036
mean(d$bias.sd.avg[d$party_factor == "Republican"], na.rm = T)
## [1] -0.06343722
sd(d$bias.sd.avg[d$party_factor == "Republican"], na.rm = T)
## [1] 1.026111
mean(d$bias.sd.3.20[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.627152
sd(d$bias.sd.3.20[d$party_factor == "Democrat"], na.rm = T)
## [1] 1.180114
mean(d$bias.sd.3.20[d$party_factor == "Republican"], na.rm = T)
## [1] 1.27999
sd(d$bias.sd.3.20[d$party_factor == "Republican"], na.rm = T)
## [1] 1.028692
mean(d$bias.mean.avg, na.rm = T)
## [1] -0.00735392
mean(d$bias.sd.avg, na.rm = T)
## [1] 0.008891665
mean(d$bias.mean.3.20, na.rm = T)
## [1] -0.2355463
mean(d$bias.sd.3.20, na.rm = T)
## [1] 1.425992

Table 1

Analyses

Vaccine Intentions

cor.test(d$vaxxIntent.1, d$vaxxIntent.2)
## 
##  Pearson's product-moment correlation
## 
## data:  d$vaxxIntent.1 and d$vaxxIntent.2
## t = 49.986, df = 2183, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.7103808 0.7495246
## sample estimates:
##       cor 
## 0.7305523
m.intent <- lm(vaxxIntent.12 ~ 
           (bias.mean.avg * bias.sd.avg) +
           (bias.mean.avg + bias.sd.avg) * ideology.z +
             (crt.z + white_.5 + age.z + education.z), data = d)

d$cons.ideology <- d$ideology.z - 1
d$lib.ideology <- d$ideology.z + 1

m.cons <- lm(vaxxIntent.12 ~ 
           (bias.mean.avg * bias.sd.avg) +
           (bias.mean.avg + bias.sd.avg) * cons.ideology +
             (crt.z + white_.5 + age.z + education.z), data = d)

m.lib <- lm(vaxxIntent.12 ~ 
           (bias.mean.avg * bias.sd.avg) +
           (bias.mean.avg + bias.sd.avg) * lib.ideology +
             (crt.z + white_.5 + age.z + education.z), data = d)


tab_model(m.cons, m.intent, m.lib,
          string.est = "Est",
          title = "Outcome: Vaccination Intentions (2020)",
          dv.labels = c("Conservative","Mean", "Liberal"),
          show.stat = F,
          show.se = F,
          string.stat = "t",
          digits = 2)
Outcome: Vaccination Intentions (2020)
  Conservative Mean Liberal
Predictors Est CI p Est CI p Est CI p
(Intercept) 0.33 0.09 – 0.56 0.007 0.54 0.37 – 0.71 <0.001 0.75 0.55 – 0.96 <0.001
bias mean avg -0.35 -0.58 – -0.13 0.002 -0.39 -0.60 – -0.18 <0.001 -0.43 -0.69 – -0.17 0.001
bias sd avg 0.52 0.33 – 0.71 <0.001 0.31 0.13 – 0.49 0.001 0.10 -0.16 – 0.37 0.453
cons ideology -0.21 -0.35 – -0.08 0.003
crt z 0.27 0.14 – 0.39 <0.001 0.27 0.14 – 0.39 <0.001 0.27 0.14 – 0.39 <0.001
white 5 0.21 -0.07 – 0.49 0.148 0.21 -0.07 – 0.49 0.148 0.21 -0.07 – 0.49 0.148
age z 0.39 0.26 – 0.52 <0.001 0.39 0.26 – 0.52 <0.001 0.39 0.26 – 0.52 <0.001
education z 0.05 -0.08 – 0.19 0.462 0.05 -0.08 – 0.19 0.462 0.05 -0.08 – 0.19 0.462
bias mean avg × bias sd
avg 		0.12 -0.03 – 0.27 0.112 0.12 -0.03 – 0.27 0.112 0.12 -0.03 – 0.27 0.112
bias mean avg × cons
ideology 		0.04 -0.09 – 0.17 0.574
bias sd avg × cons
ideology 		0.21 0.06 – 0.36 0.006
ideology z -0.21 -0.35 – -0.08 0.003
bias mean avg × ideology
z 		0.04 -0.09 – 0.17 0.574
bias sd avg × ideology z 0.21 0.06 – 0.36 0.006
lib ideology -0.21 -0.35 – -0.08 0.003
bias mean avg × lib
ideology 		0.04 -0.09 – 0.17 0.574
bias sd avg × lib
ideology 		0.21 0.06 – 0.36 0.006
Observations 914 914 914
R2 / R2 adjusted 0.152 / 0.143 0.152 / 0.143 0.152 / 0.143 
summary(m.intent)
## 
## Call:
## lm(formula = vaxxIntent.12 ~ (bias.mean.avg * bias.sd.avg) + 
##     (bias.mean.avg + bias.sd.avg) * ideology.z + (crt.z + white_.5 + 
##     age.z + education.z), data = d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.8046 -1.2103  0.2699  1.4040  3.5880 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                0.53990    0.08835   6.111 1.47e-09 ***
## bias.mean.avg             -0.39267    0.10606  -3.702 0.000227 ***
## bias.sd.avg                0.30919    0.09012   3.431 0.000629 ***
## ideology.z                -0.21465    0.07108  -3.020 0.002601 ** 
## crt.z                      0.26504    0.06469   4.097 4.56e-05 ***
## white_.5                   0.20950    0.14482   1.447 0.148349    
## age.z                      0.38998    0.06628   5.884 5.65e-09 ***
## education.z                0.05097    0.06921   0.736 0.461658    
## bias.mean.avg:bias.sd.avg  0.11879    0.07462   1.592 0.111751    
## bias.mean.avg:ideology.z   0.03781    0.06729   0.562 0.574317    
## bias.sd.avg:ideology.z     0.20789    0.07560   2.750 0.006084 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.843 on 903 degrees of freedom
##   (2414 observations deleted due to missingness)
## Multiple R-squared:  0.1522, Adjusted R-squared:  0.1428 
## F-statistic: 16.21 on 10 and 903 DF,  p-value: < 2.2e-16

Graph: Figure 5

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Model: Vaccination Behavior

unique_values <- sort(unique(d$vaxxBehavior)) #get unique values
d$vaxxBehavior <- factor(d$vaxxBehavior, levels = unique_values, ordered = TRUE) # Convert to an ordered factor

d$cons.media <- d$bias.mean.3.20.z - 1
d$lib.media <- d$bias.mean.3.20.z + 1

m.vaxx.cons <- polr(vaxxBehavior ~ 
                 cons.media * bias.sd.3.20.z + 
                 (cons.media + bias.sd.3.20.z) * ideology.z +
                 (crt.z + white_.5 + age.z + education.z), data = d, Hess = TRUE)

m.vaxx.mean <- polr(vaxxBehavior ~ 
                 bias.mean.3.20.z * bias.sd.3.20.z + 
                 (bias.mean.3.20.z + bias.sd.3.20.z) * ideology.z +
                 (crt.z + white_.5 + age.z + education.z), data = d, Hess = TRUE)


m.vaxx.lib <- polr(vaxxBehavior ~ 
                 lib.media * bias.sd.3.20.z + 
                 (lib.media + bias.sd.3.20.z) * ideology.z +
                 (crt.z + white_.5 + age.z + education.z), data = d, Hess = TRUE)

tab_model(m.vaxx.lib, m.vaxx.mean, m.vaxx.cons, 
          title = "Outcome: Vaccination Behavior (2022)",
          dv.labels = c("Left-leaning","Mean", "Right-leaning"),
          show.stat = T,
          string.stat = "t",
          string.est = "OR",
          show.est = T, 
          show.se = F,
          show.df = F)
Outcome: Vaccination Behavior (2022)
  Left-leaning Mean Right-leaning
Predictors OR CI t p OR CI t p OR CI t p
1|2 0.09 0.06 – 0.13 -13.54 <0.001 0.19 0.15 – 0.23 -14.95 <0.001 0.40 0.30 – 0.52 -6.60 <0.001
2|3 0.25 0.18 – 0.35 -8.39 <0.001 0.53 0.44 – 0.64 -6.55 <0.001 1.12 0.86 – 1.46 0.84 0.402
lib media 0.47 0.38 – 0.59 -6.49 <0.001
bias sd 3 20 z 0.96 0.69 – 1.35 -0.26 0.796 1.46 1.24 – 1.74 4.37 <0.001 2.23 1.70 – 2.95 5.76 <0.001
ideology z 0.84 0.66 – 1.07 -1.37 0.170 0.76 0.65 – 0.90 -3.16 0.002 0.69 0.56 – 0.85 -3.44 0.001
crt z 1.22 1.05 – 1.42 2.53 0.011 1.22 1.05 – 1.42 2.53 0.011 1.22 1.05 – 1.42 2.53 0.011
white 5 0.89 0.63 – 1.26 -0.64 0.522 0.89 0.63 – 1.26 -0.64 0.522 0.89 0.63 – 1.26 -0.64 0.522
age z 1.66 1.42 – 1.96 6.18 <0.001 1.66 1.42 – 1.96 6.18 <0.001 1.66 1.42 – 1.96 6.18 <0.001
education z 1.31 1.11 – 1.53 3.28 0.001 1.31 1.11 – 1.53 3.28 0.001 1.31 1.11 – 1.53 3.28 0.001
lib media × bias sd 3 20
z 		1.53 1.18 – 1.97 3.25 0.001
lib media × ideology z 0.90 0.78 – 1.06 -1.28 0.201
bias sd 3 20 z × ideology
z 		1.07 0.92 – 1.24 0.85 0.394 1.07 0.92 – 1.24 0.85 0.394 1.07 0.92 – 1.24 0.85 0.394
bias mean 3 20 z 0.47 0.38 – 0.59 -6.49 <0.001
bias mean 3 20 z × bias
sd 3 20 z 		1.53 1.18 – 1.97 3.25 0.001
bias mean 3 20 z ×
ideology z 		0.90 0.78 – 1.06 -1.28 0.201
cons media 0.47 0.38 – 0.59 -6.49 <0.001
cons media × bias sd 3 20
z 		1.53 1.18 – 1.97 3.25 0.001
cons media × ideology z 0.90 0.78 – 1.06 -1.28 0.201
Observations 907 907 907
R2 Nagelkerke 0.307 0.307 0.307 
summary(m.vaxx.mean)
## Call:
## polr(formula = vaxxBehavior ~ bias.mean.3.20.z * bias.sd.3.20.z + 
##     (bias.mean.3.20.z + bias.sd.3.20.z) * ideology.z + (crt.z + 
##     white_.5 + age.z + education.z), data = d, Hess = TRUE)
## 
## Coefficients:
##                                    Value Std. Error t value
## bias.mean.3.20.z                -0.74650    0.11507 -6.4873
## bias.sd.3.20.z                   0.37943    0.08688  4.3675
## ideology.z                      -0.26942    0.08537 -3.1560
## crt.z                            0.19831    0.07823  2.5350
## white_.5                        -0.11319    0.17665 -0.6408
## age.z                            0.50903    0.08230  6.1849
## education.z                      0.26765    0.08156  3.2815
## bias.mean.3.20.z:bias.sd.3.20.z  0.42395    0.13051  3.2484
## bias.mean.3.20.z:ideology.z     -0.09988    0.07804 -1.2799
## bias.sd.3.20.z:ideology.z        0.06516    0.07635  0.8534
## 
## Intercepts:
##     Value    Std. Error t value 
## 1|2  -1.6716   0.1118   -14.9457
## 2|3  -0.6335   0.0968    -6.5468
## 
## Residual Deviance: 1455.942 
## AIC: 1479.942 
## (2421 observations deleted due to missingness)
# calculating chi-sq
(consTilt <- (-6.4873)^2)
## [1] 42.08506
(div <- (4.3675)^2)
## [1] 19.07506
(ideo <- (-3.1560)^2)
## [1] 9.960336
(crt <- 2.5350^2)
## [1] 6.426225
(age <- 6.1849^2)
## [1] 38.25299
(edu <- 3.2815^2)
## [1] 10.76824
(ethnicity <- (-0.6408)^2)
## [1] 0.4106246
(CTxDiv <- (3.2484)^2)
## [1] 10.5521
(DivxIdeo <- (0.8534)^2)
## [1] 0.7282916
summary(m.vaxx.cons)
## Call:
## polr(formula = vaxxBehavior ~ cons.media * bias.sd.3.20.z + (cons.media + 
##     bias.sd.3.20.z) * ideology.z + (crt.z + white_.5 + age.z + 
##     education.z), data = d, Hess = TRUE)
## 
## Coefficients:
##                              Value Std. Error t value
## cons.media                -0.74650    0.11507 -6.4873
## bias.sd.3.20.z             0.80338    0.13954  5.7574
## ideology.z                -0.36930    0.10740 -3.4385
## crt.z                      0.19831    0.07823  2.5350
## white_.5                  -0.11319    0.17665 -0.6408
## age.z                      0.50903    0.08230  6.1849
## education.z                0.26764    0.08156  3.2815
## cons.media:bias.sd.3.20.z  0.42395    0.13051  3.2484
## cons.media:ideology.z     -0.09989    0.07804 -1.2800
## bias.sd.3.20.z:ideology.z  0.06516    0.07635  0.8534
## 
## Intercepts:
##     Value   Std. Error t value
## 1|2 -0.9251  0.1401    -6.6041
## 2|3  0.1130  0.1348     0.8387
## 
## Residual Deviance: 1455.942 
## AIC: 1479.942 
## (2421 observations deleted due to missingness)
(div.cons <- 5.7574^2)
## [1] 33.14765
summary(m.vaxx.lib)
## Call:
## polr(formula = vaxxBehavior ~ lib.media * bias.sd.3.20.z + (lib.media + 
##     bias.sd.3.20.z) * ideology.z + (crt.z + white_.5 + age.z + 
##     education.z), data = d, Hess = TRUE)
## 
## Coefficients:
##                              Value Std. Error t value
## lib.media                 -0.74650    0.11507 -6.4873
## bias.sd.3.20.z            -0.04453    0.17231 -0.2584
## ideology.z                -0.16952    0.12336 -1.3742
## crt.z                      0.19831    0.07823  2.5350
## white_.5                  -0.11319    0.17665 -0.6408
## age.z                      0.50903    0.08230  6.1849
## education.z                0.26764    0.08156  3.2815
## lib.media:bias.sd.3.20.z   0.42395    0.13051  3.2484
## lib.media:ideology.z      -0.09989    0.07804 -1.2800
## bias.sd.3.20.z:ideology.z  0.06516    0.07635  0.8534
## 
## Intercepts:
##     Value    Std. Error t value 
## 1|2  -2.4181   0.1785   -13.5431
## 2|3  -1.3800   0.1645    -8.3907
## 
## Residual Deviance: 1455.942 
## AIC: 1479.942 
## (2421 observations deleted due to missingness)
(div.lib <- (-0.2584)^2)
## [1] 0.06677056

Graph: Figure 6A

(p <-Fig1A <- ggpredict(m.vaxx.mean, terms = "bias.mean.3.20.z[-3, -2.5, -2, -1.5, -1, -.5, 0, .5, 1, 1.5, 2, 2.5, 3]") %>%
  ggplot(mapping = aes(x = x, y = predicted, colour = response.level, fill = response.level)) +
  geom_line(size = 1) + 
  scale_x_continuous(limits = c(-2, 2), breaks = c(-3:3)) +
  scale_y_continuous(limits = c(0, 1), breaks = c(0, .1,.2,.3,.4,.5, .6, .7, .8, .9, 1)) +
  labs(title = "Predicted Probabilities for Vaccination Behaviors",
       x = "Conservative Tilt",
       y = "Predicted Probability for Vaccination Behavior Choice") +
  theme_minimal() +
  theme(plot.title = element_text(size = 12)) + labs(colour = "Vaccination Behavior") +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = 0.2, colour = NA))
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_line()`).

Graph: Figure 6B

(p <- Fig1B <- ggpredict(m.vaxx.mean, terms = "bias.sd.3.20.z[-3, -2.5, -2, -1.5, -1, -.5, 0, .5, 1, 1.5, 2, 2.5, 3]") %>%
  ggplot(mapping = aes(x = x, y = predicted, colour = response.level, fill = response.level)) +
  geom_line(size = 1) + 
  scale_x_continuous(limits = c(-2, 2), breaks = c(-3:3)) +
  scale_y_continuous(limits = c(0, 1), breaks = c(0, .1,.2,.3,.4,.5, .6, .7, .8, .9, 1)) +
  labs(title = "Predicted Probabilities for Vaccination Behaviors",
       x = "Diversity",
       y = "Predicted Probability for Vaccination Behavior Choice") +
  theme_minimal() +
  theme(plot.title = element_text(size = 12)) + labs(colour = "Vaccination Behavior") +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = 0.2, colour = NA))
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_line()`).

Model: COVID-19 Risk Perceptions

What do you believe is the likelihood you or close friends or family will personally contract COVID-19? (-3 = Extremely unlikely, -2 = Moderately unlikely, -1 = Slightly unlikely, 0 = Neither likely nor unlikely, 1 = Slightly likely, 2 = Moderately likely, 3 = Extremely likely)

note: spring 2022 question broken up into 2 items; (1) you (2) friends + family

If you or close friends or family were to contract Covid-19, what do you believe is the likelihood that either you or someone close to you would develop serious health consequences such as great difficulty breathing, pneumonia, and dangerously high fever? (-3 = Extremely unlikely, -2 = Moderately unlikely, -1 = Slightly unlikely, 0 = Neither likely nor unlikely, 1 = Slightly likely, 2 = Moderately likely, 3 = Extremely likely)

note: spring 2022 question broken up into 2 items; (1) you (2) friends + family

2020

d$cons.media <- d$bias.mean.avg - 1
d$lib.media <- d$bias.mean.avg + 1

m.risk.2020.cons <- lm(personalRisk.12 ~ 
                 cons.media * bias.sd.avg + 
                 (cons.media + bias.sd.avg) * ideology.z +
                 (crt.z + white_.5 + age.z + education.z), data = d)

m.risk.2020 <- lm(personalRisk.12 ~ 
                 bias.mean.avg * bias.sd.avg + 
                 (bias.mean.avg + bias.sd.avg) * ideology.z +
                 (crt.z + white_.5 + age.z + education.z), data = d)

m.risk.2020.lib <- lm(personalRisk.12 ~ 
                 lib.media * bias.sd.avg + 
                 (lib.media + bias.sd.avg) * ideology.z +
                 (crt.z + white_.5 + age.z + education.z), data = d)


tab_model(m.risk.2020.lib, m.risk.2020, m.risk.2020.cons, 
          string.est = "Est",
          title = "Outcome: 2020 Personal Risks for COVID-19",
          dv.labels = c("Left-leaning Media", 
                        "Mean", 
                        "Right-leaning Media"),
          show.stat = F,
          show.se = F,
          string.se = "SE",
          string.stat = "t",
          digits = 2)
Outcome: 2020 Personal Risks for COVID-19
  Left-leaning Media Mean Right-leaning Media
Predictors Est CI p Est CI p Est CI p
(Intercept) 0.99 0.75 – 1.24 <0.001 0.37 0.23 – 0.52 <0.001 -0.24 -0.46 – -0.03 0.025
lib media -0.62 -0.80 – -0.44 <0.001
bias sd avg -0.35 -0.56 – -0.13 0.002 -0.03 -0.18 – 0.12 0.722 0.29 0.12 – 0.46 0.001
ideology z 0.07 -0.09 – 0.23 0.411 -0.13 -0.25 – -0.02 0.024 -0.33 -0.49 – -0.17 <0.001
crt z 0.06 -0.04 – 0.17 0.224 0.06 -0.04 – 0.17 0.224 0.06 -0.04 – 0.17 0.224
white 5 0.33 0.09 – 0.57 0.007 0.33 0.09 – 0.57 0.007 0.33 0.09 – 0.57 0.007
age z 0.26 0.16 – 0.37 <0.001 0.26 0.16 – 0.37 <0.001 0.26 0.16 – 0.37 <0.001
education z -0.03 -0.14 – 0.09 0.651 -0.03 -0.14 – 0.09 0.651 -0.03 -0.14 – 0.09 0.651
lib media × bias sd avg 0.32 0.20 – 0.44 <0.001
lib media × ideology z -0.20 -0.31 – -0.09 0.001
bias sd avg × ideology z -0.06 -0.19 – 0.06 0.307 -0.06 -0.19 – 0.06 0.307 -0.06 -0.19 – 0.06 0.307
bias mean avg -0.62 -0.80 – -0.44 <0.001
bias mean avg × bias sd
avg 		0.32 0.20 – 0.44 <0.001
bias mean avg × ideology
z 		-0.20 -0.31 – -0.09 0.001
cons media -0.62 -0.80 – -0.44 <0.001
cons media × bias sd avg 0.32 0.20 – 0.44 <0.001
cons media × ideology z -0.20 -0.31 – -0.09 0.001
Observations 761 761 761
R2 / R2 adjusted 0.184 / 0.173 0.184 / 0.173 0.184 / 0.173

Graph: Figure 7

2022

m.risk.2022 <- lm(personalRisk.3.0 ~ 
                 bias.mean.3.20.z * bias.sd.3.20.z + 
                 (bias.mean.3.20.z + bias.sd.3.20.z) * ideology.z +
                 (crt.z + white_.5 + age.z + education.z), data = d)

tab_model(m.risk.2022,
          string.est = "Est",
          title = "Outcome: 2022 Personal Risks for COVID-19",
          show.stat = F,
          show.se = F,
          string.se = "SE",
          string.stat = "t",
          digits = 2)
Outcome: 2022 Personal Risks for COVID-19
  personalRisk.3.0
Predictors Est CI p
(Intercept) -0.50 -0.64 – -0.37 <0.001
bias mean 3 20 z -0.20 -0.36 – -0.05 0.008
bias sd 3 20 z 0.06 -0.07 – 0.19 0.345
ideology z -0.11 -0.24 – 0.01 0.070
crt z -0.05 -0.17 – 0.07 0.411
white 5 0.03 -0.22 – 0.29 0.801
age z 0.06 -0.06 – 0.18 0.307
education z -0.04 -0.17 – 0.08 0.477
bias mean 3 20 z × bias
sd 3 20 z 		0.06 -0.12 – 0.23 0.521
bias mean 3 20 z ×
ideology z 		-0.03 -0.13 – 0.08 0.622
bias sd 3 20 z × ideology
z 		-0.02 -0.14 – 0.09 0.667
Observations 660
R2 / R2 adjusted 0.043 / 0.028

Model: Trust in science

d$cons.media <- d$bias.mean.3.20.z - 1
d$lib.media <- d$bias.mean.3.20.z + 1


m.consMedia <- lm(trustSci ~ 
                   (cons.media * bias.sd.3.20.z)  +
                   (cons.media + bias.sd.3.20.z) * ideology.z +
                   (crt.z + white_.5 + age.z + education.z), data = d)

m.sciTrust <- lm(trustSci ~ 
                   (bias.mean.3.20.z * bias.sd.3.20.z)  +
                   (bias.mean.3.20.z + bias.sd.3.20.z) * ideology.z +
                   (crt.z + white_.5 + age.z + education.z), data = d)

m.libMedia <- lm(trustSci ~ 
                   (lib.media * bias.sd.3.20.z)  +
                   (lib.media + bias.sd.3.20.z) * ideology.z +
                   (crt.z + white_.5 + age.z + education.z), data = d)

tab_model(m.libMedia, m.sciTrust, m.consMedia,
          string.est = "Est",
          title = "Outcome: Trust in Science (2022)",
          dv.labels = c("Left-leaning media (-1 SD)",
                        "Mean", 
                        "Right-leaning media (+1 SD)"),
          show.stat = F,
          show.se = F,
          string.se = "SE",
          string.stat = "t",
          digits = 2)
Outcome: Trust in Science (2022)
  Left-leaning media (-1 SD) Mean Right-leaning media (+1 SD)
Predictors Est CI p Est CI p Est CI p
(Intercept) 3.89 3.80 – 3.97 <0.001 3.47 3.41 – 3.52 <0.001 3.04 2.97 – 3.12 <0.001
lib media -0.42 -0.48 – -0.36 <0.001
bias sd 3 20 z -0.25 -0.34 – -0.16 <0.001 -0.07 -0.12 – -0.03 0.003 0.11 0.03 – 0.18 0.007
ideology z -0.19 -0.25 – -0.13 <0.001 -0.19 -0.24 – -0.14 <0.001 -0.19 -0.26 – -0.13 <0.001
crt z 0.08 0.03 – 0.12 0.001 0.08 0.03 – 0.12 0.001 0.08 0.03 – 0.12 0.001
white 5 0.16 0.06 – 0.27 0.001 0.16 0.06 – 0.27 0.001 0.16 0.06 – 0.27 0.001
age z 0.05 0.00 – 0.10 0.046 0.05 0.00 – 0.10 0.046 0.05 0.00 – 0.10 0.046
education z 0.04 -0.01 – 0.09 0.084 0.04 -0.01 – 0.09 0.084 0.04 -0.01 – 0.09 0.084
lib media × bias sd 3 20
z 		0.18 0.11 – 0.25 <0.001
lib media × ideology z -0.00 -0.04 – 0.04 0.877
bias sd 3 20 z × ideology
z 		0.04 -0.00 – 0.09 0.051 0.04 -0.00 – 0.09 0.051 0.04 -0.00 – 0.09 0.051
bias mean 3 20 z -0.42 -0.48 – -0.36 <0.001
bias mean 3 20 z × bias
sd 3 20 z 		0.18 0.11 – 0.25 <0.001
bias mean 3 20 z ×
ideology z 		-0.00 -0.04 – 0.04 0.877
cons media -0.42 -0.48 – -0.36 <0.001
cons media × bias sd 3 20
z 		0.18 0.11 – 0.25 <0.001
cons media × ideology z -0.00 -0.04 – 0.04 0.877
Observations 910 910 910
R2 / R2 adjusted 0.385 / 0.378 0.385 / 0.378 0.385 / 0.378 
d$cons.ideology <- d$ideology.z - 1
d$lib.ideology <- d$ideology.z + 1

m.sciTrust.con <- lm(trustSci ~ 
                   (bias.mean.3.20.z * bias.sd.3.20.z)  +
                   (bias.mean.3.20.z + bias.sd.3.20.z) * cons.ideology +
                   (crt.z + white_.5 + age.z + education.z), data = d)

m.sciTrust.lib <- lm(trustSci ~ 
                   (bias.mean.3.20.z * bias.sd.3.20.z)  +
                   (bias.mean.3.20.z + bias.sd.3.20.z) * lib.ideology +
                   (crt.z + white_.5 + age.z + education.z), data = d)

tab_model(m.sciTrust.lib, m.sciTrust, m.sciTrust.con,
          string.est = "Est",
          title = "Outcome: Trust in Science (Spring 2022)",
          dv.labels = c("Liberal","Mean", "Conservative"),
          show.stat = F,
          show.se = F,
          string.se = "SE",
          string.stat = "t",
          digits = 2)
Outcome: Trust in Science (Spring 2022)
  Liberal Mean Conservative
Predictors Est CI p Est CI p Est CI p
(Intercept) 3.66 3.59 – 3.73 <0.001 3.47 3.41 – 3.52 <0.001 3.27 3.20 – 3.35 <0.001
bias mean 3 20 z -0.42 -0.49 – -0.35 <0.001 -0.42 -0.48 – -0.36 <0.001 -0.42 -0.50 – -0.35 <0.001
bias sd 3 20 z -0.12 -0.18 – -0.05 <0.001 -0.07 -0.12 – -0.03 0.003 -0.03 -0.10 – 0.04 0.376
lib ideology -0.19 -0.24 – -0.14 <0.001
crt z 0.08 0.03 – 0.12 0.001 0.08 0.03 – 0.12 0.001 0.08 0.03 – 0.12 0.001
white 5 0.16 0.06 – 0.27 0.001 0.16 0.06 – 0.27 0.001 0.16 0.06 – 0.27 0.001
age z 0.05 0.00 – 0.10 0.046 0.05 0.00 – 0.10 0.046 0.05 0.00 – 0.10 0.046
education z 0.04 -0.01 – 0.09 0.084 0.04 -0.01 – 0.09 0.084 0.04 -0.01 – 0.09 0.084
bias mean 3 20 z × bias
sd 3 20 z 		0.18 0.11 – 0.25 <0.001 0.18 0.11 – 0.25 <0.001 0.18 0.11 – 0.25 <0.001
bias mean 3 20 z × lib
ideology 		-0.00 -0.04 – 0.04 0.877
bias sd 3 20 z × lib
ideology 		0.04 -0.00 – 0.09 0.051
ideology z -0.19 -0.24 – -0.14 <0.001
bias mean 3 20 z ×
ideology z 		-0.00 -0.04 – 0.04 0.877
bias sd 3 20 z × ideology
z 		0.04 -0.00 – 0.09 0.051
cons ideology -0.19 -0.24 – -0.14 <0.001
bias mean 3 20 z × cons
ideology 		-0.00 -0.04 – 0.04 0.877
bias sd 3 20 z × cons
ideology 		0.04 -0.00 – 0.09 0.051
Observations 910 910 910
R2 / R2 adjusted 0.385 / 0.378 0.385 / 0.378 0.385 / 0.378

Graph: CMC + DMC + ideology

Graph: Figure 8A

Graph: Figure 8B

Appendix A: Party Identity Models

Table 15

m.summer <- lm(vaxxIntent.12 ~ 
           (bias.mean.avg * bias.sd.avg) +
           (bias.mean.avg + bias.sd.avg) * (pDem_Rep + pInd_Not) +
           (crt.z + white_.5 + age.z + education.z), data = d)

tab_model(m.summer, 
          string.est = "Est",
          show.stat = F,
          show.se = F,
          string.se = "SE",
          string.stat = "t",
          digits = 2)
  vaxxIntent.12
Predictors Est CI p
(Intercept) 0.47 0.28 – 0.66 <0.001
bias mean avg -0.39 -0.64 – -0.15 0.002
bias sd avg 0.28 0.07 – 0.49 0.010
pDem Rep -0.63 -0.98 – -0.27 0.001
pInd Not 0.26 -0.11 – 0.63 0.173
crt z 0.27 0.14 – 0.40 <0.001
white 5 0.24 -0.05 – 0.53 0.111
age z 0.35 0.22 – 0.48 <0.001
education z 0.06 -0.07 – 0.20 0.368
bias mean avg × bias sd
avg 		0.12 -0.03 – 0.27 0.125
bias mean avg × pDem Rep 0.00 -0.38 – 0.39 0.980
bias mean avg × pInd Not 0.22 -0.37 – 0.81 0.463
bias sd avg × pDem Rep 0.24 -0.14 – 0.63 0.219
bias sd avg × pInd Not 0.28 -0.26 – 0.81 0.311
Observations 912
R2 / R2 adjusted 0.154 / 0.142 
m.fall <- lm(vaxxBehavior ~ 
           (bias.mean.avg * bias.sd.avg) +
           (bias.mean.avg + bias.sd.avg) * (pDem_Rep + pInd_Not) +
           (crt.z + white_.5 + age.z + education.z), family = binomial, data = d)
## Warning in model.response(mf, "numeric"): using type = "numeric" with a factor
## response will be ignored
## Warning: In lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) :
##  extra argument 'family' will be disregarded
## Warning in Ops.ordered(y, z$residuals): '-' is not meaningful for ordered
## factors
tab_model(m.fall,
          string.est = "Est",
          show.stat = F,
          show.se = F,
          string.se = "SE",
          string.stat = "t",
          digits = 2)
  vaxxBehavior
Predictors Est CI p
(Intercept) 2.44
bias mean avg -0.30
bias sd avg -0.04
pDem Rep -0.25
pInd Not 0.08
crt z 0.05
white 5 -0.07
age z 0.16
education z 0.08
bias mean avg × bias sd
avg 		0.14
bias mean avg × pDem Rep 0.00
bias mean avg × pInd Not 0.13
bias sd avg × pDem Rep 0.11
bias sd avg × pInd Not 0.14
Observations 908 
m.sciTrust <- lm(trustSci ~ 
                   (bias.mean.3.20.z * bias.sd.3.20.z)  +
                   (bias.mean.3.20.z + bias.sd.3.20.z) * (pDem_Rep + pInd_Not) +
                   (crt.z + white_.5 + age.z + education.z), data = d)

tab_model(m.sciTrust,
          string.est = "Est",
          show.stat = F,
          show.se = F,
          string.se = "SE",
          string.stat = "t",
          digits = 2)
  trustSci
Predictors Est CI p
(Intercept) 3.43 3.37 – 3.49 <0.001
bias mean 3 20 z -0.45 -0.52 – -0.38 <0.001
bias sd 3 20 z -0.07 -0.13 – -0.02 0.006
pDem Rep -0.47 -0.59 – -0.35 <0.001
pInd Not 0.14 0.02 – 0.26 0.028
crt z 0.09 0.04 – 0.13 <0.001
white 5 0.19 0.08 – 0.29 <0.001
age z 0.02 -0.03 – 0.07 0.443
education z 0.06 0.01 – 0.11 0.013
bias mean 3 20 z × bias
sd 3 20 z 		0.15 0.08 – 0.22 <0.001
bias mean 3 20 z × pDem
Rep 		-0.08 -0.19 – 0.03 0.174
bias mean 3 20 z × pInd
Not 		0.19 0.03 – 0.35 0.019
bias sd 3 20 z × pDem Rep 0.10 -0.01 – 0.21 0.067
bias sd 3 20 z × pInd Not 0.01 -0.12 – 0.13 0.933
Observations 908
R2 / R2 adjusted 0.391 / 0.382

Appendix F: Climate Change Belief Models

How much do you believe that climate change is happening and that it is human caused?

Table 21

m.climate <- lm(climateBelief.1 ~ 
                       (bias.mean.1.15.z * bias.sd.1.15.z)  +
                       (bias.mean.1.15.z + bias.sd.1.15.z) * ideology.z +
                       (white_.5 + age.z + education.z + crt.z), data = d)

tab_model(m.climate,
          dv.labels = c("Belief in Climate Change"),
          string.est = "Est",
          show.stat = F,
          show.se = F,
          string.se = "SE",
          string.stat = "t",
          digits = 2)
  Belief in Climate Change
Predictors Est CI p
(Intercept) 1.57 1.44 – 1.69 <0.001
bias mean 1 15 z -0.68 -0.83 – -0.54 <0.001
bias sd 1 15 z -0.11 -0.23 – 0.01 0.066
ideology z -0.59 -0.69 – -0.49 <0.001
white 5 0.22 0.01 – 0.42 0.040
age z 0.10 0.00 – 0.19 0.048
education z -0.01 -0.10 – 0.09 0.903
crt z -0.01 -0.10 – 0.08 0.808
bias mean 1 15 z × bias
sd 1 15 z 		0.15 0.05 – 0.25 0.004
bias mean 1 15 z ×
ideology z 		-0.26 -0.35 – -0.16 <0.001
bias sd 1 15 z × ideology
z 		0.09 -0.01 – 0.20 0.076
Observations 914
R2 / R2 adjusted 0.407 / 0.400