color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# 1 vs 4
toplot14a <- sd_values |>
inner_join(t1_full) |>
inner_join(t4_full) |>
mutate(sample="Full Sample")
toplot14m <- sd_values |>
inner_join(t1_manip) |>
inner_join(t4_manip) |>
mutate(sample="Passed Manipulation Check")
toplot14 <- bind_rows(toplot14a, toplot14m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m1 - m4) / sd)
plot14 <-
ggplot(toplot14, aes(y = name)) +
geom_point(aes(x = diff, color=sample, shape=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Placebo 1996 vs Treatment 2020",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# 2 vs 3
toplot23a <- sd_values |>
inner_join(t2_full) |>
inner_join(t3_full) |>
mutate(sample="Full Sample")
toplot23m <- sd_values |>
inner_join(t2_manip) |>
inner_join(t3_manip) |>
mutate(sample="Passed Manipulation Check")
toplot23 <- bind_rows(toplot23a, toplot23m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m2 - m3) / sd)
plot23 <-
ggplot(toplot23, aes(y = name)) +
geom_point(aes(x = diff, color=sample, shape=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Placebo 2006 vs Treatment 2012",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# 2 vs 4
toplot24a <- sd_values |>
inner_join(t2_full) |>
inner_join(t4_full) |>
mutate(sample="Full Sample")
toplot24m <- sd_values |>
inner_join(t2_manip) |>
inner_join(t4_manip) |>
mutate(sample="Passed Manipulation Check")
toplot24 <- bind_rows(toplot24a, toplot24m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m2 - m4) / sd)
plot24 <-
ggplot(toplot24, aes(y = name)) +
geom_point(aes(x = diff, color=sample, shape=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Placebo 2006 vs Treatment 2020",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# 3 vs 4
toplot34a <- sd_values |>
inner_join(t3_full) |>
inner_join(t4_full) |>
mutate(sample="Full Sample")
toplot34m <- sd_values |>
inner_join(t3_manip) |>
inner_join(t4_manip) |>
mutate(sample="Passed Manipulation Check")
toplot34 <- bind_rows(toplot34a, toplot34m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m3 - m4) / sd)
plot34 <-
ggplot(toplot34, aes(y = name)) +
geom_point(aes(x = diff, color=sample, shape=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Treatment 2012 vs Treatment 2020",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# patchwork
fig3 <- plot12 + plot13 + plot14 +
plot23 + plot24 + plot34 +
plot_layout(axes = "collect",
guides = "collect",
nrow = 3) & theme(legend.position = "bottom")
fig3
# Date: 2025.10.28
# Preliminaries
library(tidyverse)
library(broom)
library(haven)
library(estimatr)
library(ggforce)
library(patchwork)
library(gtsummary)
library(labelled)
library(knitr)
data <- read_dta("data_clean_SRM.dta")
# Figure 1:
# ---------
mcheck <- data |>
select(manip, navflag, attention_pct, fandom_scale, Saw_Match_Y) |>
mutate(manip = factor(manip, labels=c("No", "Yes")))
cm_navflag <- mcheck |>
group_by(manip) |>
do(tidy(lm(navflag ~ 1, data = .), conf.int=TRUE))
cm_atten <- mcheck |>
group_by(manip) |>
do(tidy(lm(attention_pct ~ 1, data = .), conf.int=TRUE))
# navigated away plot
navflag_plot <-
ggplot(mcheck, aes(x = manip, color=manip)) +
geom_point(data=mcheck,
aes(y=navflag),
position = position_jitternormal(sd_x = 0.05, sd_y = 0.02),
alpha=0.2,
size=0.2) +
geom_point(data=cm_navflag,
aes(y=estimate),
size=3) +
geom_errorbar(data=cm_navflag,
aes(ymin=conf.low,
ymax=conf.high),
width = 0) +
theme_minimal() +
labs(x = "Passed Manipulation Check",
y = "Navigated Away During Video?") +
scale_y_continuous(breaks=c(0,0.25,0.5,0.75,1), labels=c("No", "0.25", "0.5", "0.75", "Yes")) +
coord_cartesian(ylim = c(-0.1, 1.1)) +
theme(legend.position="none")
# attention plot
atten_plot <-
ggplot(mcheck, aes(x = manip, color=manip)) +
geom_point(data=mcheck,
aes(y=attention_pct),
position = position_jitternormal(sd_x = 0.05, sd_y = 0.02),
alpha=0.2,
size=0.2) +
geom_point(data=cm_atten,
aes(y=estimate),
size=3) +
geom_errorbar(data=cm_atten,
aes(ymin=conf.low,
ymax=conf.high),
width = 0) +
theme_minimal() +
labs(x = "Passed Manipulation Check",
y = "Share of Video Streamed") +
scale_y_continuous(breaks=c(0,0.25,0.5,0.75,1)) +
coord_cartesian(ylim = c(-0.1, 1.1)) +
theme(legend.position="none")
# patchwork
fig1 <- navflag_plot + atten_plot  +
plot_layout(axes = "collect", nrow = 1)
# exporting
ggsave(
filename = "8511_fig1.pdf",
plot = fig1,
)
# Figure 2:
# ---------
# some data prep
pr_comply <- data |>
group_by(tx) |>
# calculating the mean and standard deviation in each treatment arm
do(tidy(lm_robust(manip ~ 1, data=.))) |>
mutate(manip = estimate)
# plotting
fig2 <- ggplot(data=pr_comply, aes(x = tx, y = manip, color=as.factor(tx))) +
geom_point(
data=data,
position = position_jitternormal(sd_x = 0.1, sd_y = 0.05),
alpha = 0.1,
) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = 0) +
scale_y_continuous(breaks = seq(0, 1, by = 0.25)) +
scale_x_discrete(limits = c("Placebo 1996", "Placebo 2006", "Treatment 2012", "Treatment 2020")) +
coord_cartesian(ylim = c(-0.1, 1.1)) +
theme_minimal() +
theme(axis.title.x = element_blank(),
legend.position = "none",
text = element_text(size = 12)) +
ylab("Passed Manipulation Check \n [1 = Yes, 0 = No]")
# exporting
ggsave(
filename = "8511_fig2.pdf",
plot = fig2,
)
# Figure 3:
# ---------
dta <- data |>
mutate(conservative = ifelse(partyid == 1, 1, 0),
labour = ifelse(partyid == 2, 1, 0),
libdem = ifelse(partyid == 3, 1, 0),
FarRight = ifelse(partyid == 7, 1, 0),
novote = ifelse(partyid == 11, 1, 0))
covars <- c("Male", "Age", "Degree", "conservative", "labour", "libdem", "FarRight", "novote", "engl_id_scale", "fandom_scale")
# grabbing the standard deviations
sd_values <- dta |>
mutate(conservative = ifelse(partyid == 1, 1, 0),
labour = ifelse(partyid == 2, 1, 0),
libdem = ifelse(partyid == 3, 1, 0),
FarRight = ifelse(partyid == 7, 1, 0),
novote = ifelse(partyid == 11, 1, 0)) |>
select(all_of(covars)) |>
pivot_longer(everything()) |>
group_by(name) |>
summarise(
sd = sd(value)
)
# means for each of the treatment groups
for (i in 1:4) {
# full sample
df <- dta |>
filter(tx == i) |>
select(covars) |>
pivot_longer(everything()) |>
group_by(name) |>
summarise(!!paste0("m", i) := mean(value))
assign(paste0("t", i, "_full"), df)
# ppl who passed the manipulation check
df <- dta |>
filter(tx == i & manip == 1) |>
select(covars) |>
pivot_longer(everything()) |>
group_by(name) |>
summarise(!!paste0("m", i) := mean(value))
assign(paste0("t", i, "_manip"), df)
}
# 1 vs 2
toplot12a <- sd_values |>
inner_join(t1_full) |>
inner_join(t2_full) |>
mutate(sample="Full Sample")
toplot12m <- sd_values |>
inner_join(t1_manip) |>
inner_join(t2_manip) |>
mutate(sample="Passed Manipulation Check")
toplot12 <- bind_rows(toplot12a, toplot12m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m1 - m2) / sd)
plot12 <-
ggplot(toplot12, aes(y = name)) +
geom_point(aes(x = diff, color=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Placebo 1996 vs Placebo 2006",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "inside",
legend.position.inside = c(0.9,0.2)) +
coord_cartesian(xlim = c(0, 0.2))
# 1 vs 3
toplot13a <- sd_values |>
inner_join(t1_full) |>
inner_join(t3_full) |>
mutate(sample="Full Sample")
toplot13m <- sd_values |>
inner_join(t1_manip) |>
inner_join(t3_manip) |>
mutate(sample="Passed Manipulation Check")
toplot13 <- bind_rows(toplot13a, toplot13m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m1 - m3) / sd)
plot13 <-
ggplot(toplot13, aes(y = name)) +
geom_point(aes(x = diff, color=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Placebo 1996 vs Treatment 2012",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# 1 vs 4
toplot14a <- sd_values |>
inner_join(t1_full) |>
inner_join(t4_full) |>
mutate(sample="Full Sample")
toplot14m <- sd_values |>
inner_join(t1_manip) |>
inner_join(t4_manip) |>
mutate(sample="Passed Manipulation Check")
toplot14 <- bind_rows(toplot14a, toplot14m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m1 - m4) / sd)
plot14 <-
ggplot(toplot14, aes(y = name)) +
geom_point(aes(x = diff, color=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Placebo 1996 vs Treatment 2020",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# 2 vs 3
toplot23a <- sd_values |>
inner_join(t2_full) |>
inner_join(t3_full) |>
mutate(sample="Full Sample")
toplot23m <- sd_values |>
inner_join(t2_manip) |>
inner_join(t3_manip) |>
mutate(sample="Passed Manipulation Check")
toplot23 <- bind_rows(toplot23a, toplot23m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m2 - m3) / sd)
plot23 <-
ggplot(toplot23, aes(y = name)) +
geom_point(aes(x = diff, color=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Placebo 2006 vs Treatment 2012",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# 2 vs 4
toplot24a <- sd_values |>
inner_join(t2_full) |>
inner_join(t4_full) |>
mutate(sample="Full Sample")
toplot24m <- sd_values |>
inner_join(t2_manip) |>
inner_join(t4_manip) |>
mutate(sample="Passed Manipulation Check")
toplot24 <- bind_rows(toplot24a, toplot24m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m2 - m4) / sd)
plot24 <-
ggplot(toplot24, aes(y = name)) +
geom_point(aes(x = diff, color=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Placebo 2006 vs Treatment 2020",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# 3 vs 4
toplot34a <- sd_values |>
inner_join(t3_full) |>
inner_join(t4_full) |>
mutate(sample="Full Sample")
toplot34m <- sd_values |>
inner_join(t3_manip) |>
inner_join(t4_manip) |>
mutate(sample="Passed Manipulation Check")
toplot34 <- bind_rows(toplot34a, toplot34m) |>
mutate(name=factor(name, levels=covars),
diff = abs(m3 - m4) / sd)
plot34 <-
ggplot(toplot34, aes(y = name)) +
geom_point(aes(x = diff, color=sample)) +
geom_vline(xintercept = 0.1) +
labs(subtitle = "Treatment 2012 vs Treatment 2020",
y = "",
x = "Standardized Mean Difference",
color = "") +
theme_minimal() +
scale_y_discrete(limits=rev,
labels=c("Interest in football", "English ID scale", "Vote: DK, none", "UKIP, Reform, BNP", "LibDem",
"Labour",   "Conservative", "Degree", "Age", "Male"))  +
theme(legend.position = "none") +
coord_cartesian(xlim = c(0, 0.2))
# patchwork
fig3 <- plot12 + plot13 + plot14 +
plot23 + plot24 + plot34 +
plot_layout(axes = "collect",
guides = "collect",
nrow = 3) & theme(legend.position = "bottom")
# exporting
ggsave(
filename = "8511_fig3.pdf",
plot = fig3,
)
# Table 1:
# --------
sumtab <- data |>
select(Male, Female, Non_binary, Age_18_24, Age_25_34, Age_35_44, Age_45_54, Age_55_older, Degree,
partyid,
ID_Engl_very_strong, ID_Engl_fairly_strong, ID_Engl_not_very_strong, ID_Engl_not_at_all,
Fan_huge, Fan_regular, Not_fan_regular, Not_fan_tourney, No_interest, Hate_football) |>
mutate(NoDegree = ifelse(Degree==1, 0, 1),
Conservative = ifelse(partyid == 1, 1, 0),
Labour = ifelse(partyid == 2, 1, 0),
LibDem = ifelse(partyid == 3, 1, 0),
FarRight = ifelse(partyid == 7, 1, 0),
VoteOther = ifelse(partyid == 10, 1, 0),
DKnovote = ifelse(partyid == 11, 1, 0)) |>
select(-partyid) |>
relocate(NoDegree, .after=Degree)
# creating vector of labels
Characteristics <- c("Male", "Female", "Non-binary",
"18--24", "25--34", "35--44", "45--54", "55+",
"Yes", "No",
"Very strongly", "Fairly strongly", "Not very strongly", "Not at all",
"Huge fan", "Regular fan", "Irregular fan", "Tournaments only", "No interest", "Hate football",
"Conservative", "Labour", "LibDem", "Far Right", "Other", "DK, no vote")
# creating counts of 1s for each dummy variable
Counts <- colSums(sumtab == 1, na.rm = TRUE)
# creating dataframe to export
export <- cbind(Characteristics, Counts) |> as_tibble() |>
mutate(Counts = as.numeric(Counts),
Perc = Counts / nrow(data) * 100,
Perc = round(Perc, digits = 0))
writeLines(kable(export, format = "latex"), "8511_tab1.tex")
sumtab <- data |>
select(Male, Female, Non_binary, Age, Age_18_24, Age_25_34, Age_35_44, Age_45_54, Degree,
partyid,
ID_Engl_very_strong, ID_Engl_fairly_strong, ID_Engl_not_very_strong, ID_Engl_not_at_all,
Fan_huge, Fan_regular, Not_fan_regular, Not_fan_tourney, No_interest, Hate_football) |>
mutate(Age_55_64 = ifelse(Age >= 55 & Age <= 64, 1, 0),
Age_65_older = ifelse(Age >= 65 & Age < 120, 1, 0),
NoDegree = ifelse(Degree==1, 0, 1),
Conservative = ifelse(partyid == 1, 1, 0),
Labour = ifelse(partyid == 2, 1, 0),
LibDem = ifelse(partyid == 3, 1, 0),
FarRight = ifelse(partyid == 7, 1, 0),
VoteOther = ifelse(partyid == 10, 1, 0),
DKnovote = ifelse(partyid == 11, 1, 0)) |>
select(-partyid, -Age) |>
relocate(NoDegree, .after=Degree)
names(sumtab)
sumtab <- data |>
select(Male, Female, Non_binary, Age, Age_18_24, Age_25_34, Age_35_44, Age_45_54, Degree,
partyid,
ID_Engl_very_strong, ID_Engl_fairly_strong, ID_Engl_not_very_strong, ID_Engl_not_at_all,
Fan_huge, Fan_regular, Not_fan_regular, Not_fan_tourney, No_interest, Hate_football) |>
mutate(Age_55_64 = ifelse(Age >= 55 & Age <= 64, 1, 0),
Age_65_older = ifelse(Age >= 65 & Age < 120, 1, 0),
NoDegree = ifelse(Degree==1, 0, 1),
Conservative = ifelse(partyid == 1, 1, 0),
Labour = ifelse(partyid == 2, 1, 0),
LibDem = ifelse(partyid == 3, 1, 0),
FarRight = ifelse(partyid == 7, 1, 0),
VoteOther = ifelse(partyid == 10, 1, 0),
DKnovote = ifelse(partyid == 11, 1, 0)) |>
select(-partyid, -Age) |>
relocate(NoDegree, .after=Degree) |>
relocate(Age_55_64, .after=Age_45_54) |>
relocate(Age_65_older, .after=Age_55_64)
names(sumtab)
# creating vector of labels
Characteristics <- c("Male", "Female", "Non-binary",
"18--24", "25--34", "35--44", "45--54", "55-64", "65+",
"Yes", "No",
"Very strongly", "Fairly strongly", "Not very strongly", "Not at all",
"Huge fan", "Regular fan", "Irregular fan", "Tournaments only", "No interest", "Hate football",
"Conservative", "Labour", "LibDem", "Far Right", "Other", "DK, no vote")
# creating counts of 1s for each dummy variable
Counts <- colSums(sumtab == 1, na.rm = TRUE)
# creating dataframe to export
export <- cbind(Characteristics, Counts) |> as_tibble() |>
mutate(Counts = as.numeric(Counts),
Perc = Counts / nrow(data) * 100,
Perc = round(Perc, digits = 0))
writeLines(kable(export, format = "latex"), "8511_tab1.tex")
