Main results
Figure 1: Coefficient plot
df_long_all <-
bind_rows(
dplyr::filter(df_long) |> mutate(group = "All"),
dplyr::filter(df_long, vaccinated == 0) |> mutate(group = "Unvaccinated"),
dplyr::filter(df_long, vaccinated == 1) |> mutate(group = "Vaccinated"))
custom.coef.map = list("severity" = "Pandemic severity",
"stringency" = "Policy stringency",
"universality" = "Policy universality",
"severity:stringency" = "Severity * Stringency",
"severity:universality" = "Severity * Universality",
"universality:stringency" = "Stringency * Universality",
"severity:stringency:universality" = "Triple interaction"
)
fig_1_models <-
list(All = "All", Unvaccinated= "Unvaccinated", Vaccinated = "Vaccinated") |>
lapply(function(g)
list(
rating = lm_robust(rating ~ severity*universality*stringency, fixed_effects = ~ ID,
data = df_long_all, subset = group == g, se_type = "stata"),
choice = lm_robust(choice ~ severity*universality*stringency, fixed_effects = ~ ID,
data = df_long_all, subset = group == g, se_type = "stata"),
trust = lm_robust(trust ~ severity*universality*stringency, fixed_effects = ~ ID,
data = df_long_all, subset = group == g, se_type = "stata"))
)
fig_1_models$Unvaccinated$vaccination <-
lm_robust(vaccine_probability ~ severity*universality*stringency, fixed_effects = ~ ID,
data = df_long_all, subset = group == "Unvaccinated", se_type = "stata")
fig_1_data <-
fig_1_models |>
lapply(function(m) m |> lapply(tidy) |> bind_rows()) |>
bind_rows(.id = "group") |>
dplyr::mutate(term = dplyr::recode(term,
"severity" = "Pandemic severity",
"stringency" = "Policy stringency",
"universality" = "Policy universality",
"severity:stringency" = "Severity * Stringency",
"severity:universality" = "Severity * Universality",
"universality:stringency" = "Stringency * Universality",
"severity:universality:stringency" = "Triple interaction"
), outcome = dplyr::recode(
outcome,
"choice" = "Choice",
"rating" = "Rating",
"trust" = "Trust",
"vaccine_probability" = "Vaccination Probability"
)
)
fig_main <-
fig_1_data %>%
#dplyr::filter(term != "Triple interaction") %>%
ggplot(aes(x = estimate, y = term, color = group, shape=group)) +
geom_point(size = 2.5,position=position_dodge(width=0.5)) +
geom_errorbarh(aes(y = term, xmin =conf.low, xmax = conf.high),
size=0.5, alpha = 0.5, height = 0.2, position=position_dodge(width=0.5)) +
facet_grid(~ outcome , scales = "free")+
theme_bw() +
scale_y_discrete(limits=rev)+
theme(axis.title.y=element_blank()) +
theme(axis.title.x=element_text(size = 14)) +
theme(axis.text.y =element_text(size = 14)) +
theme(axis.text.x = element_text(size = 11)) +
theme(strip.text.x = element_text(size = 14))+
theme(legend.text=element_text(size=14))+
geom_vline(xintercept = 0, linetype="dotted",
color = "black") +
#scale_x_continuous(breaks=pretty_breaks(n = 4),labels = scales::number_format(accuracy = 0.01))+
# scale_x_continuous(breaks=pretty_breaks(n = 3)) +
theme(legend.position="bottom")
pdf("results/fig_1.pdf", width = 12, height = 5)
fig_main
dev.off()
quartz_off_screen 2
Display the figure:
fig_main
For text: Head to head comparisons
Low-mid stringency comparisons
# LM comparison
df_long %>%
# dplyr::filter(severity == 1) %>%
dplyr::filter(stringency <= 0) %>%
group_by(severity, ID, universality) %>% mutate(x = mean(stringency) == -.5) %>% ungroup %>%
dplyr::filter(x) %>% arrange(ID) %>%
# dplyr::select(id, outcome, choice, stringency, severity, universality) %>% # View
group_by(severity, stringency) %>% summarize(n(), choice = mean(choice))
# A tibble: 6 × 4
# Groups: severity [3]
severity stringency `n()` choice
<dbl> <dbl> <int> <dbl>
1 -1 -1 745 0.523
2 -1 0 745 0.477
3 0 -1 588 0.466
4 0 0 588 0.534
5 1 -1 433 0.379
6 1 0 433 0.621
Mid-high stringency comparisons
# MH comparison
df_long %>%
# dplyr::filter(severity == 1) %>%
dplyr::filter(stringency >= 0) %>%
group_by(severity, ID, universality) %>% mutate(x = mean(stringency) == .5) %>% ungroup %>%
dplyr::filter(x) %>% arrange(ID) %>%
# dplyr::select(id, outcome, choice, stringency, severity, universality) %>% # View
group_by(severity, stringency) %>% summarize(n(), choice = mean(choice))
# A tibble: 6 × 4
# Groups: severity [3]
severity stringency `n()` choice
<dbl> <dbl> <int> <dbl>
1 -1 0 612 0.670
2 -1 1 612 0.330
3 0 0 608 0.694
4 0 1 608 0.306
5 1 0 621 0.605
6 1 1 621 0.395
Low-high stringency comparisons
# LH comparison
df_long %>%
# dplyr::filter(severity == 1) %>%
dplyr::filter(stringency != 0) %>%
group_by(severity, ID, universality) %>% mutate(x = mean(stringency) == 0) %>% ungroup %>%
dplyr::filter(x) %>% arrange(ID) %>%
# dplyr::select(id, outcome, choice, stringency, severity, universality) %>% # View
group_by(severity, stringency) %>% summarize(n(), choice = mean(choice))
# A tibble: 6 × 4
# Groups: severity [3]
severity stringency `n()` choice
<dbl> <dbl> <int> <dbl>
1 -1 -1 683 0.574
2 -1 1 683 0.426
3 0 -1 687 0.504
4 0 1 687 0.496
5 1 -1 589 0.441
6 1 1 589 0.559
Figure 2: Ideal points and tradeoffs
We use the model in the PAP implemented via cjEuclid to estimate ideal points and indifference curves assuming a general linear quadratic utility function.
ideals <- cj_euclid(
rating ~ universality + stringency + severity,
data = df_long,
fixed_effects = "ID",
mins = c(-1, -1, -1),
maxs = c(1, 1, 1),
lengths = c(30, 30, 3),
X = "universality",
x_vals = policy_universality_labels,
Y = "stringency",
y_vals = policy_stringency_labels,
Col = "severity")
ideals$graph + xlab("Universality") + ylab("Stringency")
Note the failure of positive semi definiteness here comes from the low weight on severity when assessing policies. This is not surprising from the design as subjects were evaluating policies given severity. A “given” analysis would condition on severity thus:
fig_2_models <-
list(all = df_long,
vaccinated = dplyr::filter(df_long, vaccinated==1),
unvaccinated = dplyr::filter(df_long, vaccinated==0)) %>%
lapply(function(data)
cj_euclid(rating ~ universality + stringency + severity,
fixed_effects = "ID",
data = data,
lengths = c(30, 30, 3)))
# Write matrices
mapply(function(model, name)
write_matrices(round(model$A, 3), name),
fig_2_models, c("results/fig_2_mat_all.tex", "results/fig_2_mat_vac.tex", "results/fig_2_mat_unvac.tex"))
all vaccinated unvaccinated
0 0 0
fig_2 <-
fig_2_models |>
lapply(function(m) m$predictions_df) |>
bind_rows(.id = "group") |>
mutate(group = factor(group, c("all", "vaccinated", "unvaccinated"))) |>
mutate(severity = factor(severity, -1:1, severity_labels)) |>
euclid_plot(
X = "universality",
x_vals =policy_universality_labels ,
Y = "stringency",
y_vals = policy_stringency_labels,
Col = "severity",
Row = "group") + xlab("Universality") + ylab("Stringency")
fig_2
pdf("results/fig_2.pdf", width = 10, height =10)
fig_2 + theme(legend.position="bottom")
dev.off()
quartz_off_screen
2
Independence tests
In most cases we cannot reject the null that preferences for stringency and universality are separable.
euclidean_models <-
list(all = df_long,
vaccinated = dplyr::filter(df_long, vaccinated==1),
unvaccinated = dplyr::filter(df_long, vaccinated==0)) %>%
lapply(function(data)
lapply(severity_labs, function(j)
cj_euclid(rating ~ universality + stringency,
fixed_effects = "ID",
data = data |> filter(severity == j))$model))
euclidean_models %>%
lapply(
function(L) {L|> lapply(
function(m) m |> tidy()) |> bind_rows(.id = "Context")
}) %>%
bind_rows(.id = "Group") %>%
dplyr::filter(term == "universality:stringency") |>
select(Group, Context, term, p.value) |>
kable(digits = 3, booktabs = TRUE) |>
kable_styling(bootstrap_options=c("striped", "hover", "condensed", "responsive"),
full_width=FALSE)
|
Group
|
Context
|
term
|
p.value
|
|
all
|
Moderate worsening
|
universality:stringency
|
0.224
|
|
all
|
Sharp worsening
|
universality:stringency
|
0.728
|
|
all
|
Dramatic worsening
|
universality:stringency
|
0.265
|
|
vaccinated
|
Moderate worsening
|
universality:stringency
|
0.079
|
|
vaccinated
|
Sharp worsening
|
universality:stringency
|
0.409
|
|
vaccinated
|
Dramatic worsening
|
universality:stringency
|
0.059
|
|
unvaccinated
|
Moderate worsening
|
universality:stringency
|
0.187
|
|
unvaccinated
|
Sharp worsening
|
universality:stringency
|
0.185
|
|
unvaccinated
|
Dramatic worsening
|
universality:stringency
|
0.499
|
Equal salience is generally rejected however except in the case of dramatic worsening for the vaccinated:
euclidean_models %>%
lapply(
function(L) {L|> lapply(
function(m) car::linearHypothesis(m, "I(universality^2) = I(stringency^2)")$`Pr(>Chisq)`[2]) |> bind_rows(.id = "Context")
}) %>%
bind_rows(.id = "Group") %>% kable(digits = 3, booktabs = TRUE)|>
kable_styling(bootstrap_options=c("striped", "hover", "condensed", "responsive"),
full_width=FALSE)
|
Group
|
Moderate worsening
|
Sharp worsening
|
Dramatic worsening
|
|
all
|
0
|
0.001
|
0.005
|
|
vaccinated
|
0
|
0.000
|
0.424
|
|
unvaccinated
|
0
|
0.001
|
0.000
|
Appendix
Table A1: Main summary Stats
Main sample
df_small <-
df_long %>% dplyr::select(all_of(c("status","group", covariate_names))) %>%
# select_if(is.numeric) %>%
drop_na() %>%
group_by(ID) %>% slice(1) %>% ungroup()
summ_stats_main <-
df_small %>%
# only main sample
dplyr::filter(group == 4) %>%
select(-status, -ID,-group) %>%
fBasics::basicStats()
summ_stats_main <- round(summ_stats_main, 2) %>%
t() %>%
as.data.frame() %>%
dplyr::select("Mean") %>%
dplyr::rename(`Wave 4 Main` = Mean)
# Add in labels
summ_stats_main <- summ_stats_main %>%
dplyr::mutate(Variable = factor(rownames(summ_stats_main), var_list$new_name, var_list$label)) %>%
relocate(Variable)
Refreshmment sample
summ_stats_refresh <-
df_small %>%
# only main sample
dplyr::filter(group == 5) %>%
select(-status, -ID,-group) %>%
fBasics::basicStats()
summ_stats_refresh <- round(summ_stats_refresh, 2) %>%
t() %>%
as.data.frame() %>%
dplyr::select("Mean") %>%
dplyr::rename(`Wave 4 Refreshment` = Mean)
# Add in labels
summ_stats_refresh <- summ_stats_refresh %>%
dplyr::mutate(Variable = factor(rownames(summ_stats_refresh), var_list$new_name, var_list$label)) %>%
relocate(Variable)
Statistical Office
Source: https://www.regionalstatistik.de/genesis/online/; values are always taken for 2021
# gender
df1 <- read_excel("data/sociodemographics_destatis_gender.xlsx",range = "A7:D83") %>%
# create sum
dplyr::mutate(
Total = sum(`...4`),
Male = sum(`...2`)/Total,
Female = sum(`...3`)/Total) %>%
dplyr::filter(row_number() %in% c(1:1)) %>%
dplyr::select(Male,Female) %>%
dplyr::mutate(value="value") %>%
tidyr::gather(Variable, value, -value) %>%
dplyr::mutate(total = sum(value))%>%
dplyr::mutate(`Statistical-office` = value/total) %>%
dplyr::select(Variable,`Statistical-office`) %>%
dplyr::filter(row_number() %in% c(1:1))
# age
df2 <- read_excel("data/sociodemographics_destatis_age.xlsx",range = "A7:F92",col_names = FALSE) %>%
dplyr::select(...1,...6) %>%
# create sum
dplyr::mutate(total = sum(...6[row_number() %in% 19:76])) %>%
dplyr::mutate(`18-29` = sum(...6[row_number() %in% 19:30])/total) %>%
dplyr::mutate(`30-39` = sum(...6[row_number() %in% 31:40])/total) %>%
dplyr::mutate(`40-49` = sum(...6[row_number() %in% 41:50])/total) %>%
dplyr::mutate(`50-59` = sum(...6[row_number() %in% 51:60])/total) %>%
dplyr::mutate(`60-75` = sum(...6[row_number() %in% 61:76])/total) %>%
dplyr::select(`18-29`,`30-39`,`40-49`,`50-59`,`60-75`) %>%
dplyr::filter(row_number() %in% c(1:1)) %>%
dplyr::mutate(value="value") %>%
tidyr::gather(Variable, value, -value) %>%
dplyr::mutate(total = sum(value))%>%
dplyr::mutate(`Statistical-office` = value/total) %>%
dplyr::select(Variable,`Statistical-office`)
# region
df3 <- read_excel("data/sociodemographics_destatis_region.xlsx", range = "A5:Q97") %>%
dplyr::filter(!row_number() %in% c(1:19)) %>%
dplyr::filter(!row_number() %in% c(59:73)) %>%
dplyr::select(-(...1)) %>%
dplyr::mutate(`Baden Wuerttemberg` = sum(`Baden-Württemberg`),
`Bavaria` = sum(`Bayern`),
`Berlin` = sum(`Berlin`),
`Brandenburg` = sum(`Brandenburg`),
`Bremen` = sum(`Bremen`),
`Hamburg` = sum(`Hamburg`),
`Hesse` = sum(`Hessen`),
`Mecklenburg-Vorpommern` = sum(`Mecklenburg-Vorpommern`),
`Lower-Saxony` = sum(`Niedersachsen`),
`North-Rhine-Westphalia` = sum(`Nordrhein-Westfalen`),
`Rhineland-Palatinate` = sum(`Rheinland-Pfalz`),
`Saarland` = sum(`Saarland`),
`Saxony` = sum(`Sachsen`),
`Saxony-Anhalt` = sum(`Sachsen-Anhalt`),
`Schleswig-Holstein` = sum(`Schleswig-Holstein`),
`Thuringia` = sum(`Thüringen`)
) %>%
dplyr::select(`Baden Wuerttemberg`,`Bavaria`,`Thuringia`,`Berlin`,
`Brandenburg`,`Bremen`,`Hamburg`,`Hesse`,
`Mecklenburg-Vorpommern`,`Lower-Saxony`,
`North-Rhine-Westphalia`,`Rhineland-Palatinate`,
`Saarland`,`Saxony`,`Saxony-Anhalt`,`Schleswig-Holstein`,
`Thuringia`
) %>%
distinct() %>%
dplyr::mutate(value="value") %>%
tidyr::gather(Variable, value, -value) %>%
dplyr::mutate(total = sum(value))%>%
dplyr::mutate(`Statistical-office` = value/total) %>%
dplyr::select(Variable,`Statistical-office`)
sum_stats_statoffice<-bind_rows(df1, df2,df3)
|
Variable
|
Statistical-office
|
Wave 4 Main
|
Wave 4 Refreshment
|
|
Male
|
0.50
|
0.56
|
0.50
|
|
18-29
|
0.18
|
0.10
|
0.18
|
|
30-39
|
0.18
|
0.15
|
0.17
|
|
40-49
|
0.16
|
0.19
|
0.18
|
|
50-59
|
0.22
|
0.26
|
0.23
|
|
60-75
|
0.26
|
0.30
|
0.25
|
|
Baden Wuerttemberg
|
0.13
|
0.12
|
0.13
|
|
Bavaria
|
0.16
|
0.16
|
0.16
|
|
Thuringia
|
0.03
|
0.03
|
0.03
|
|
Berlin
|
0.04
|
0.05
|
0.04
|
|
Brandenburg
|
0.03
|
0.03
|
0.03
|
|
Bremen
|
0.01
|
0.01
|
0.01
|
|
Hamburg
|
0.02
|
0.02
|
0.02
|
|
Hesse
|
0.08
|
0.07
|
0.07
|
|
Mecklenburg-Vorpommern
|
0.02
|
0.02
|
0.02
|
|
Lower-Saxony
|
0.10
|
0.10
|
0.10
|
|
North-Rhine-Westphalia
|
0.22
|
0.22
|
0.22
|
|
Rhineland-Palatinate
|
0.05
|
0.05
|
0.05
|
|
Saarland
|
0.01
|
0.01
|
0.01
|
|
Saxony
|
0.05
|
0.05
|
0.05
|
|
Saxony-Anhalt
|
0.03
|
0.03
|
0.03
|
|
Schleswig-Holstein
|
0.03
|
0.03
|
0.03
|
Table A2: Main Analysis
x <- c(fig_1_models[[1]], fig_1_models[[2]], fig_1_models[[3]])
pap_1_write <- function(
model_list,
filename = "results/tabA2.tex",
add_text = " Full sample of respondents.",
label = "tab:saturated_all") {
fileConn <- file(filename)
writeLines(texreg(model_list,
float.pos = "h!",
ci.test = NULL,
include.ci = FALSE,
caption = paste0("\\label{", label, "}Main results, with interactions and individual fixed effects. 95 confidence intervals in square brackets. All treatments are centered on zero.", add_text),
custom.coef.map = custom.coef.map,
custom.header = list("All" = 1:3, "Vaccinated" = 4:6, "Unvaccinated" = 7:10),
custom.model.names = rep(c("Rating", "Choice", "Trust","Rating", "Choice", "Trust", "Rating", "Choice", "Trust", "Vaccination")),
digits = 3),
fileConn)
close(fileConn)
}
x %>% pap_1_write()
x <- c(fig_1_models[[1]], fig_1_models[[2]], fig_1_models[[3]])
htmlreg(x, include.ci = FALSE,
#custom.coef.map = custom.coef.map,
digits = 3#,
# custom.header = list("Vaccinated" = 1:3, "Unvaccinated" = 4:7))
)
Statistical models
|
|
rating
|
choice
|
trust
|
rating
|
choice
|
trust
|
vaccination
|
rating
|
choice
|
trust
|
|
severity
|
0.002
|
-0.002
|
0.001
|
0.003
|
0.006
|
-0.003
|
-0.001
|
0.002
|
-0.004
|
0.002
|
|
|
(0.002)
|
(0.004)
|
(0.002)
|
(0.006)
|
(0.010)
|
(0.004)
|
(0.002)
|
(0.003)
|
(0.004)
|
(0.002)
|
|
universality
|
-0.007**
|
-0.014***
|
-0.008***
|
-0.022***
|
-0.058***
|
-0.004
|
-0.005*
|
-0.003
|
-0.005
|
-0.009***
|
|
|
(0.002)
|
(0.004)
|
(0.002)
|
(0.006)
|
(0.010)
|
(0.005)
|
(0.002)
|
(0.003)
|
(0.004)
|
(0.003)
|
|
stringency
|
0.002
|
-0.009*
|
0.010***
|
-0.091***
|
-0.161***
|
-0.042***
|
-0.002
|
0.019***
|
0.019***
|
0.019***
|
|
|
(0.002)
|
(0.004)
|
(0.003)
|
(0.006)
|
(0.009)
|
(0.006)
|
(0.002)
|
(0.003)
|
(0.004)
|
(0.003)
|
|
severity:universality
|
-0.006
|
-0.015**
|
-0.003
|
-0.005
|
-0.012
|
-0.010
|
-0.001
|
-0.006
|
-0.016**
|
-0.001
|
|
|
(0.003)
|
(0.005)
|
(0.003)
|
(0.008)
|
(0.012)
|
(0.007)
|
(0.003)
|
(0.003)
|
(0.005)
|
(0.004)
|
|
severity:stringency
|
0.039***
|
0.058***
|
0.018***
|
0.026***
|
0.040***
|
0.012
|
0.008**
|
0.041***
|
0.060***
|
0.019***
|
|
|
(0.003)
|
(0.005)
|
(0.003)
|
(0.007)
|
(0.012)
|
(0.007)
|
(0.003)
|
(0.003)
|
(0.005)
|
(0.003)
|
|
universality:stringency
|
-0.003
|
-0.002
|
-0.004
|
0.001
|
0.011
|
-0.007
|
0.005
|
-0.004
|
-0.005
|
-0.003
|
|
|
(0.003)
|
(0.005)
|
(0.003)
|
(0.007)
|
(0.012)
|
(0.007)
|
(0.003)
|
(0.003)
|
(0.005)
|
(0.004)
|
|
severity:universality:stringency
|
-0.004
|
-0.006
|
0.001
|
0.005
|
-0.002
|
0.007
|
0.005
|
-0.006
|
-0.007
|
0.000
|
|
|
(0.004)
|
(0.006)
|
(0.004)
|
(0.009)
|
(0.015)
|
(0.009)
|
(0.003)
|
(0.004)
|
(0.006)
|
(0.004)
|
|
R2
|
0.244
|
0.005
|
0.767
|
0.396
|
0.064
|
0.816
|
0.880
|
0.184
|
0.006
|
0.728
|
|
Adj. R2
|
-0.009
|
-0.326
|
0.534
|
0.194
|
-0.249
|
0.630
|
0.840
|
-0.088
|
-0.325
|
0.455
|
|
Num. obs.
|
41480
|
41480
|
20740
|
6572
|
6572
|
3286
|
6572
|
34908
|
34908
|
17454
|
|
RMSE
|
0.354
|
0.576
|
0.213
|
0.331
|
0.559
|
0.181
|
0.130
|
0.356
|
0.576
|
0.218
|
|
***p < 0.001; **p < 0.01; *p < 0.05
|
Figure A3: Conditional preferences
We implement the same analysis but now conditioning on severity and estimating preferences over the policy dimensions only:
conditional <-
list(all = df_long,
vaccinated = dplyr::filter(df_long, vaccinated==1),
unvaccinated = dplyr::filter(df_long, vaccinated==0)) %>%
lapply(function(data)
lapply(severity_labs, function(j)
cj_euclid(rating ~ universality + stringency,
fixed_effects = "ID",
data = data |> filter(severity == j),
mins = c(-1, -1),
maxs = c(1, 1),
lengths = c(30, 30))$predictions_df ) |>
bind_rows(.id = "severity")) |> bind_rows(.id = "group") |>
mutate(severity = factor(severity, severity_labels),
group = factor(group, c("all", "vaccinated", "unvaccinated")))
# Write matrices
severity_labs |>
lapply(function(j)
lm_euclid(rating ~ universality + stringency, fixed_effects = "ID", data = df_long)$A |>
round(3) |>
write_matrices(paste0("results/fig2c_matrix_all_", j, ".tex")))
$`Moderate worsening`
[1] 0
$`Sharp worsening`
[1] 0
$`Dramatic worsening`
[1] 0
severity_labs |>
lapply(function(j)
lm_euclid(rating ~ universality + stringency, fixed_effects = "ID",
data = dplyr::filter(df_long, vaccinated==1))$A |>
round(3) |>
write_matrices(paste0("results/fig2c_matrix_vac_", j, ".tex")))
$`Moderate worsening`
[1] 0
$`Sharp worsening`
[1] 0
$`Dramatic worsening`
[1] 0
severity_labs |>
lapply(function(j)
lm_euclid(rating ~ universality + stringency, fixed_effects = "ID",
data = dplyr::filter(df_long, vaccinated==0))$A |>
round(3) |>
write_matrices(paste0("results/fig2c_matrix_unvac_", j, ".tex")))
$`Moderate worsening`
[1] 0
$`Sharp worsening`
[1] 0
$`Dramatic worsening`
[1] 0
fig_2c <- conditional |>
euclid_plot(
X = "universality",
x_vals =policy_universality_labels ,
Y = "stringency",
y_vals = policy_stringency_labels,
Col = "severity",
Row = "group") + xlab("Universality") + ylab("Stringency")
fig_2c
pdf("results/fig_A3.pdf", width = 10, height = 10)
fig_2c + theme(legend.position="bottom")
dev.off()
quartz_off_screen
2
Table A3: AMCEs
# recode (not really needed, just to have a little more intuitive coding)
df_amce<-df_long %>%
dplyr::mutate(
severity_amce = severity +1,
stringency_amce = stringency + 1,
universal_amce = universality +1)
df_amce_unv <- dplyr::filter(df_amce, vaccinated == 0)
pap_1_amce <-
list(
rating = lm_robust(rating ~ factor(severity_amce)+factor(universal_amce)+factor(stringency_amce), fixed_effects = ~ ID, data = df_amce, se_type = "stata"),
choice = lm_robust(choice ~ factor(severity_amce)+factor(universal_amce)+factor(stringency_amce), fixed_effects = ~ ID, data = df_amce, se_type = "stata"),
trust =
lm_robust(trust ~ factor(severity_amce)+factor(universal_amce)+factor(stringency_amce), fixed_effects = ~ ID, data = df_amce, se_type = "stata"),
rating_sub = lm_robust(rating ~ factor(severity_amce)+factor(universal_amce)+factor(stringency_amce), fixed_effects = ~ ID, data = df_amce_unv, se_type = "stata"),
choice_sub = lm_robust(choice ~ factor(severity_amce)+factor(universal_amce)+factor(stringency_amce), fixed_effects = ~ ID, data = df_amce_unv, se_type = "stata"),
trust_sub =
lm_robust(trust ~ factor(severity_amce)+factor(universal_amce)+factor(stringency_amce), fixed_effects = ~ ID, data = df_amce_unv, se_type = "stata"),
vaccine_probability_sub =
lm_robust(vaccine_probability ~ factor(severity_amce)+factor(universal_amce)+factor(stringency_amce), fixed_effects = ~ ID, data = df_amce_unv, se_type = "stata")
)
custom.coef.map = list("factor(severity_amce)1" = "Sharp Worsening",
"factor(severity_amce)2" = "Dramatic Worsening",
"factor(universal_amce)1" = "Some exemptions",
"factor(universal_amce)2" = "Fewest exemptions",
"factor(stringency_amce)1" = "Moderate Restrictions",
"factor(stringency_amce)2" = "Severe Restrictions"
)
pap_amce_write <- function(model_list,
filename = "results/tabA3.tex",
add_text = "Full sample of respondents.",
label = "tab:AMCE") {
fileConn <- file(filename)
writeLines(texreg(model_list, float.pos = "h!",
ci.test = NULL,
include.ci = FALSE,
caption = paste0("\\label{", label, "}AMCE, with individual fixed effects. 95 confidence intervals in square brackets. First four columns employ data on all respondents; last four on unvaccinated respondents only.", add_text),
custom.coef.map = custom.coef.map,
custom.header = list("All" = 1:3, "Unvaccinated" = 4:7),
custom.model.names = c("Rating", "Choice", "Trust", "Rating", "Choice", "Trust","Vaccination"),
digits = 3), fileConn)
close(fileConn)
}
htmlreg(pap_1_amce,include.ci = FALSE)
Statistical models
|
|
rating
|
choice
|
trust
|
rating_sub
|
choice_sub
|
trust_sub
|
vaccine_probability_sub
|
|
factor(severity_amce)1
|
0.00
|
0.00
|
-0.00
|
0.00
|
-0.00
|
0.01
|
-0.01
|
|
|
(0.00)
|
(0.01)
|
(0.00)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.00)
|
|
factor(severity_amce)2
|
0.01
|
0.00
|
0.00
|
0.01
|
0.03
|
-0.01
|
0.00
|
|
|
(0.00)
|
(0.01)
|
(0.00)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.00)
|
|
factor(universal_amce)1
|
0.06***
|
0.08***
|
0.04***
|
-0.17***
|
-0.26***
|
-0.05***
|
-0.01*
|
|
|
(0.00)
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.00)
|
|
factor(universal_amce)2
|
-0.01**
|
-0.03***
|
-0.02***
|
-0.04**
|
-0.11***
|
-0.00
|
-0.01*
|
|
|
(0.00)
|
(0.01)
|
(0.00)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.00)
|
|
factor(stringency_amce)1
|
0.04***
|
0.08***
|
0.03***
|
-0.15***
|
-0.21***
|
-0.07***
|
-0.00
|
|
|
(0.00)
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.00)
|
|
factor(stringency_amce)2
|
0.00
|
-0.02*
|
0.02***
|
-0.19***
|
-0.33***
|
-0.08***
|
-0.00
|
|
|
(0.00)
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.00)
|
|
R2
|
0.25
|
0.01
|
0.77
|
0.43
|
0.10
|
0.82
|
0.88
|
|
Adj. R2
|
-0.00
|
-0.32
|
0.54
|
0.24
|
-0.21
|
0.64
|
0.84
|
|
Num. obs.
|
41480
|
41480
|
20740
|
6572
|
6572
|
3286
|
6572
|
|
RMSE
|
0.35
|
0.57
|
0.21
|
0.32
|
0.55
|
0.18
|
0.13
|
|
***p < 0.001; **p < 0.01; *p < 0.05
|
pap_1_amce %>% pap_amce_write()
Table A4: Refresher sample Conjoint estimates
# df_long_norm_refresh <-dplyr::filter(df_long_norm, group == 5)
df_long_refresh <-dplyr::filter(df_long, group == 5)
df_long_unv <- dplyr::filter(df_long, vaccinated == 0, group == 5)
pap_1_refresh <-
list(
rating = lm_robust(rating ~ severity*universality*stringency, fixed_effects = ~ ID, data = df_long_refresh, se_type = "stata"),
choice = lm_robust(choice ~ severity*universality*stringency, fixed_effects = ~ ID, data = df_long_refresh, se_type = "stata"),
trust =
lm_robust(trust ~ severity*universality*stringency, fixed_effects = ~ ID, data = df_long_refresh, se_type = "stata"),
rating_sub = lm_robust(rating ~ severity*universality*stringency, fixed_effects = ~ ID, data = df_long_unv, se_type = "stata"),
choice_sub = lm_robust(choice ~ severity*universality*stringency, fixed_effects = ~ ID, data = df_long_unv, se_type = "stata"),
trust_sub =
lm_robust(trust ~ severity*universality*stringency, fixed_effects = ~ ID, data = df_long_unv, se_type = "stata"),
vaccine_probability_sub =
lm_robust(vaccine_probability ~ severity*universality*stringency, fixed_effects = ~ ID, data = df_long_unv, se_type = "stata")
)
htmlreg(pap_1_refresh,include.ci = FALSE)
Statistical models
|
|
rating
|
choice
|
trust
|
rating_sub
|
choice_sub
|
trust_sub
|
vaccine_probability_sub
|
|
severity
|
0.00
|
0.00
|
0.01
|
-0.00
|
0.00
|
0.00
|
0.00
|
|
|
(0.01)
|
(0.01)
|
(0.00)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.00)
|
|
universality
|
-0.00
|
-0.01
|
-0.01
|
-0.02
|
-0.03
|
-0.01
|
-0.01**
|
|
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.01)
|
|
stringency
|
-0.01
|
-0.02*
|
0.01
|
-0.11***
|
-0.16***
|
-0.05**
|
-0.00
|
|
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.01)
|
(0.01)
|
|
severity:universality
|
0.01
|
0.00
|
0.00
|
-0.03
|
-0.08***
|
-0.04**
|
0.00
|
|
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.02)
|
(0.02)
|
(0.01)
|
|
severity:stringency
|
0.04***
|
0.06***
|
0.02***
|
0.05**
|
0.05*
|
0.03
|
0.01*
|
|
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.02)
|
(0.01)
|
|
universality:stringency
|
-0.00
|
-0.01
|
-0.01
|
0.01
|
0.02
|
0.00
|
0.00
|
|
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.02)
|
(0.02)
|
(0.01)
|
|
severity:universality:stringency
|
0.01
|
-0.02
|
-0.00
|
0.02
|
-0.02
|
-0.00
|
-0.01
|
|
|
(0.01)
|
(0.01)
|
(0.01)
|
(0.02)
|
(0.03)
|
(0.02)
|
(0.01)
|
|
R2
|
0.23
|
0.01
|
0.74
|
0.41
|
0.07
|
0.78
|
0.86
|
|
Adj. R2
|
-0.03
|
-0.33
|
0.49
|
0.20
|
-0.24
|
0.55
|
0.81
|
|
Num. obs.
|
8484
|
8484
|
4242
|
1444
|
1444
|
722
|
1444
|
|
RMSE
|
0.36
|
0.58
|
0.22
|
0.34
|
0.56
|
0.20
|
0.14
|
|
***p < 0.001; **p < 0.01; *p < 0.05
|
custom.coef.map = list("severity" = "Pandemic severity",
"universality" = "Policy universality",
"stringency" = "Policy stringency",
"severity:stringency" = "Severity * Stringency",
"severity:universality" = "Severity * Universality",
"universality:stringency" = "Stringency * Universality",
"severity:universality:stringency" = "Triple interaction"
)
pap_3_write <- function(model_list,
filename = "results/tabA4.tex",
add_text = " Refreshment Sample",
label = "tab:saturated_all") {
fileConn <- file(filename)
writeLines(texreg(model_list, float.pos = "h!",
ci.test = NULL,
include.ci = FALSE,
caption = paste0("\\label{", label, "}Main results, with interactions and individual fixed effects. 95 confidence intervals in square brackets. All treatments are centered on zero. First four columns employ data on all respondents; last four on unvaccinated respondents only.", add_text),
custom.coef.map = custom.coef.map,
custom.header = list("All" = 1:3, "Unvaccinated" = 4:7),
custom.model.names = rep(c("Rating", "Choice", "Trust","Rating", "Choice", "Trust", "Vaccination")),
#model.names = rep(c("Rating", "Choice", "Trust", "Vaccination"), 2),
digits = 3), fileConn)
close(fileConn)
}
pap_1_refresh %>% pap_3_write()
Figure A7: Fitted Values
# create binary indi
df_long<-df_long %>%
dplyr::mutate(
refusing = case_when(
status == "Refusing"~ 1,
TRUE ~ 0),
vaccinated = case_when(
status == "Vaccinated"~ 1,
TRUE ~ 0),
)
fitted_values <- function(Y = "trust", y_lab = "Trust", dff = df_long, adjust = TRUE) {
dff$Y <- unlist(dff[Y][1])
dff <-
dff %>% dplyr::filter(!is.na(Y)) %>%
mutate(universal_0 = 1*(universality==0),
universal_1 = 1*(universality==1),
type_numeric = 2 + vaccinated - refusing)
# Y
pap_analysis_1 <- lm_robust(
Y ~ severity*stringency*universality*vaccinated,
data = dff, fixed_effects = ~ID, se_type = "stata")
lows <- dff %>% group_by(ID) %>%
summarize(mean_Y = mean(Y, na.rm = TRUE)) %>%
arrange(mean_Y) %>% slice(1:2)
new_data <- expand.grid(
severity = c(-1:1),
stringency = c(-1:1),
universality = c(-1:1),
vaccinated = 0:1) %>% data.frame() %>%
mutate(
ID = case_when(
vaccinated == 1 ~ lows$ID[1],
vaccinated == 0 ~ lows$ID[2]),
universal_0 = 1*(universality==0),
universal_1 = 1*(universality==1),
type = vaccinated,
type = factor(vaccinated, 1:0, c("Vaccinated", "Unvaccinated")))
means <- dff %>% group_by(vaccinated) %>%
summarize(Y = mean(Y, na.rm = TRUE))
# Add on the fixed effect
new_data <- new_data %>%
mutate(Y = predict(pap_analysis_1, newdata = new_data))
if(adjust) new_data <- new_data %>%
mutate(Y = Y + means$Y[vaccinated +1] )
new_data %>%
mutate(
severity = factor(severity, c(-1,0,1), severity_labels),
universality = factor(universality, -1:1, policy_universality_labels)) %>%
ggplot(aes(stringency, Y, color = universality)) +
facet_grid(type ~ severity) + geom_point() + geom_line() + #ylim(0,6)+
theme_bw() + ylab(y_lab) + xlab("Severity of stringency") +
scale_x_continuous(breaks=c(-.8,.8), labels = c("Least", "Most")) +
ylim(0,1)
}
fig_A7 <- ggarrange(
fitted_values("rating", "Policy Rating"),
fitted_values("choice", "Probability policy is preferred", adjust = FALSE),
fitted_values(),
fitted_values("vaccine_probability", y_lab = "Will vaccinate"),
common.legend = TRUE, legend="bottom",
ncol = 2, nrow = 2)
pdf("results/fig_A7.pdf", height = 10, width = 10)
fig_A7
dev.off()
quartz_off_screen
2
fig_A7
