Week 8: Summary, Synthesis, & Interpretation
Dani Cosme
2021-05-17
# load packages
if (!require(pacman)) {
install.packages("pacman")
}
pacman::p_load("tidyverse", "here", "tidytext", "ggwordcloud", "knitr", "reactable", "lmerTest",
install = TRUE)
# set aesthetics
palette = c("#b8b3be", "#357c92")
palette_messages = c("#1985a1", "#e64626", "#ffb800", "#4c5c68", "#00a896")
plot_aes = theme_minimal() +
theme(legend.position = "top",
legend.text = element_text(size = 12),
text = element_text(size = 16, family = "Futura Medium"),
axis.text = element_text(color = "black"),
axis.line = element_line(colour = "black"),
axis.ticks.y = element_blank())
# load the survey data file
data_sona = read_csv(here("static", "labs", "data", "survey_data_sona.csv"))
data_nonsona = read_csv(here("static", "labs", "data", "survey_data_nonsona.csv"))
merged = bind_rows(data_sona, data_nonsona)
item_text = merged %>%
slice(1) %>%
pivot_longer(cols = everything()) %>%
mutate(text = ifelse(grepl("_[0-9]+|message_rating|school", name),
yes = gsub(".* - ", "", value),
no = value),
text = gsub(" - Selected Choice", "", text),
text = ifelse(grepl("student", name),
yes = gsub("In the next section.*Are", "Are", text),
no = text),
text = gsub("\n", "", text),
text = gsub(".*In your opinion, what", "In your opinion, what", text)) %>%
select(-value)
# tidy the survey data
data_tidy = merged %>%
# filter out test and incomplete responses
filter(!DistributionChannel == "preview" & Finished == 1 & consent == 1 & !source == "" & is.na(eligible)) %>%
# pivot to long format
pivot_longer(cols = -c(ResponseId, source, group)) %>%
# join with item text
left_join(., item_text) %>%
# reverse and re-coding
mutate(value = ifelse(name %in% c("identity_3"),
yes = 100 - as.numeric(value),
no = value),
value = ifelse(name %in% c("election_2021"),
yes = recode(value, "1" = "Philadelphia",
"2" = "Pennsylvania",
"3" = "out of state: holding elections",
"4" = "out of state: no elections",
"5" = "not eligible to vote"),
no = value),
value = ifelse(name %in% c("past_behav", "past_2020"),
yes = recode(value, "1" = "no",
"2" = "yes",
"3" = "not eligible"),
no = value),
value = ifelse(grepl("checklist", name),
yes = recode(value, "2" = "0"),
no = value),
value = ifelse(name %in% c("gender"),
yes = recode(value, "1" = "man",
"2" = "non-binary / third gender",
"3" = "woman",
"4" = "prefer to self-describe",
"5" = "prefer not to say"),
no = value),
value = ifelse(name %in% c("hispanic_latinx"),
yes = recode(value, "1" = "yes",
"0" = "no",
"2" = "prefer not to say"),
no = value),
value = ifelse(name %in% c("race"),
yes = recode(value, "1" = "American Indian or Alaska Native",
"2" = "Asian",
"3" = "Black or African American",
"4" = "Native Hawaiian or other Pacific Islander",
"5" = "White",
"6" = "More than one race",
"7" = "Prefer not to say"),
no = value),
value = ifelse(name %in% c("student_level"),
yes = recode(value, "1" = "undergraduate",
"2" = "graduate",
"3" = "not a student"),
no = value),
value = ifelse(name %in% c("school_undergrad"),
yes = recode(value, "1" = "The Wharton School",
"2" = "School of Arts & Sciences",
"3" = "Penn Engineering",
"4" = "Penn Nursing",
"5" = "Other"),
no = value),
#name = ifelse(name %in% c("motivation_2021_1", "motivation_2021_2"), "vote_motive_controlled", name),
#name = ifelse(name %in% c("motivation_2021_3", "motivation_2021_4", "motivation_2021_5"), "vote_motive_autonomous", name),
name = gsub("social_norms_voting_1", "norms students", name),
name = gsub("social_norms_voting_2", "norms friends", name),
name = gsub("social_norms_voting_3", "norms community", name),
name = gsub("engagement_1", "engagement students", name),
name = gsub("engagement_2", "engagement community", name),
name = gsub("intention_", "intention ", name),
name = gsub("mailin", "request ballot", name),
source = gsub("SONA", "psych pool", source),
source = gsub("classforum", "class forums", source),
source = gsub("listserv", "PLTV mailing list", source),
source = gsub("vol", "volunteer list", source)
)
messages = data_tidy %>%
filter(grepl("message_ratings", name)) %>%
extract(col = name, into = c("item", "name"), "([0-9]{1})_(.*)") %>%
mutate(name = gsub("message_ratings_e_|message_ratings_c_", "", name),
name = recode(name, "1" = "relevance self", "2" = "relevance others",
"3" = "motivation self", "4" = "motivation others",
"5" = "share broadcast", "6" = "share narrowcast",
"7" = "check norms", "8" = "check identity"),
value = as.numeric(value)) %>%
filter(!is.na(value)) sample information
249 people have completed the survey so far. Let’s take a look at the following demographic information to get a feel for who participated.
source
data_tidy %>%
select(ResponseId, source) %>%
unique() %>%
group_by(source) %>%
mutate(order = n()) %>%
ggplot(aes(x = reorder(source, order))) +
geom_bar() +
coord_flip() +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
gender
| name | text |
|---|---|
| gender | What is your gender? |
data_tidy %>%
filter(grepl("gender$", name)) %>%
filter(!is.na(value)) %>%
group_by(value) %>%
mutate(order = n()) %>%
ggplot(aes(x = reorder(value, order))) +
geom_bar() +
coord_flip() +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
ethnicity
| name | text |
|---|---|
| hispanic_latinx | Do you identify as Hispanic or Latina/Latino/Latinx? |
data_tidy %>%
filter(grepl("hispanic_latinx", name)) %>%
filter(!is.na(value)) %>%
group_by(value) %>%
mutate(order = n()) %>%
ggplot(aes(x = reorder(value, order))) +
geom_bar() +
coord_flip() +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
race
| name | text |
|---|---|
| race | What race or races do you consider yourself to be? |
data_tidy %>%
filter(grepl("race$", name)) %>%
filter(!is.na(value)) %>%
group_by(value) %>%
mutate(order = n()) %>%
ggplot(aes(x = reorder(value, order))) +
geom_bar() +
coord_flip() +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
student information
status
| name | text |
|---|---|
| student_level | Are you an undergraduate or graduate student at the University of Pennsylvania? |
| student_grade | What year are you at the University of Pennsylvania? |
data_tidy %>%
filter(grepl("student_level", name)) %>%
group_by(value) %>%
mutate(order = n()) %>%
ggplot(aes(x = reorder(value, order))) +
geom_bar() +
coord_flip() +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
voting behavior
past voting behavior
| name | text |
|---|---|
| past_behav | I have voted in a US election before. |
| past_2020 | I voted in the 2020 US general election. |
data_tidy %>%
filter(grepl("past_", name)) %>%
filter(!is.na(value)) %>%
mutate(name = ifelse(name == "past_2020",
yes = "voted in 2020",
no = "voted previously")) %>%
group_by(value) %>%
mutate(order = n()) %>%
ggplot(aes(x = reorder(value, order))) +
geom_bar() +
labs(x = "") +
facet_grid(~name) +
plot_aes +
theme(legend.position = "top")
message framing experiment
In the next section, we’ll explore whether there is evidence that the experimentally framed messages were more effective than control messages.
Keep in mind that these are preliminary analyses with the sample we currently have and that as we recruit more participants, the uncertainty around the estimates will decrease and we can be more confident about our results.
message-level DVs
First, let’s see if there were differences between the experimental and control conditions for items that were rated for each message.
manipulation checks
These two items were included to check to see if our experimental manipulation worked. If so, we should see that the experimental messages were clearly rated higher than the control messages.
| name | text |
|---|---|
| check norms | This message emphasizes that Penn students vote |
| check identity | This message emphasizes the Penn identity |
distributions
messages %>%
filter(grepl("check", name)) %>%
ggplot(aes(x = value, y = name, fill = group)) +
ggridges::geom_density_ridges2(alpha = .5, color = NA) +
labs(y = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
means
messages %>%
filter(grepl("check", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
statistics
stats_mlm = function(data) {
lmerTest::lmer(value ~ group + (1 | ResponseId),
data = data) %>%
broom.mixed::tidy(., conf.int = TRUE) %>%
filter(term == "groupexperimental") %>%
mutate(`difference [95% CI]` = sprintf("%.2f [%.2f, %.2f]", estimate, conf.low, conf.high)) %>%
select(`difference [95% CI]`, p.value) %>%
kable(format = "pandoc", digits = 3)
}
stats_mlm_mod = function(data, moderator) {
lmerTest::lmer(value ~ group * get(moderator) + (1 | ResponseId),
data = data) %>%
broom.mixed::tidy(., conf.int = TRUE) %>%
filter(grepl("group|get", term)) %>%
mutate(term = gsub("groupexperimental", "condition", term),
term = gsub("get\\(moderator\\)", "moderator", term),
term = gsub(":", " x ", term),
`estimate [95% CI]` = sprintf("%.2f [%.2f, %.2f]", estimate, conf.low, conf.high)) %>%
select(term, `estimate [95% CI]`, p.value) %>%
kable(format = "pandoc", digits = 3)
}
stats_lm = function(data) {
lm(value ~ group, data = data) %>%
broom::tidy(., conf.int = TRUE) %>%
filter(term == "groupexperimental") %>%
mutate(`difference [95% CI]` = sprintf("%.2f [%.2f, %.2f]", estimate, conf.low, conf.high)) %>%
select(`difference [95% CI]`, p.value) %>%
kable(format = "pandoc", digits = 3)
}norms
The difference between the experimental and control groups is statistically unlikely to be due to chance.
| difference [95% CI] | p.value |
|---|---|
| 23.64 [18.38, 28.90] | 0 |
relevance
The next items measure how self and socially relevant participants found the messages.
Does framing messages to emphasize Penn social norms and identity increase perceived relevance?
| name | text |
|---|---|
| relevance self | This message is relevant to me |
| relevance others | This message is relevant to people I know |
distributions
messages %>%
filter(grepl("relevance", name)) %>%
ggplot(aes(x = value, y = name, fill = group)) +
ggridges::geom_density_ridges2(alpha = .5, color = NA) +
labs(y = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
means
messages %>%
filter(grepl("relevance", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
statistics
self-relevance
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
| difference [95% CI] | p.value |
|---|---|
| 1.34 [-3.97, 6.64] | 0.622 |
relevance to others
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
| difference [95% CI] | p.value |
|---|---|
| -2.92 [-6.90, 1.06] | 0.152 |
motivation
These items measure perceived voting motivation for oneself and others.
Does framing messages to emphasize Penn social norms and identity increase perceived motivation to vote?
| name | text |
|---|---|
| motivation self | This message motivates me to vote |
| motivation others | This message would motivate people I know to vote |
distributions
messages %>%
filter(grepl("motiv", name)) %>%
ggplot(aes(x = value, y = name, fill = group)) +
ggridges::geom_density_ridges2(alpha = .5, color = NA) +
labs(y = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
means
messages %>%
filter(grepl("motivation", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
statistics
motivation to vote: self
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
| difference [95% CI] | p.value |
|---|---|
| 2.54 [-2.68, 7.75] | 0.341 |
motivation to vote: others
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
| difference [95% CI] | p.value |
|---|---|
| -1.12 [-5.66, 3.41] | 0.628 |
sharing
The items measure intentions to share the message on social media (broadcast sharing) or directly with a friend (narrowcast sharing)
Does framing messages to emphasize Penn social norms and identity increase intentions to share?
| name | text |
|---|---|
| share broadcast | I would share this message on social media |
| share narrowcast | I would share this message directly with a friend |
distributions
messages %>%
filter(grepl("share", name)) %>%
ggplot(aes(x = value, y = name, fill = group)) +
ggridges::geom_density_ridges2(alpha = .5, color = NA) +
labs(y = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
means
messages %>%
filter(grepl("share", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
statistics
broadcast
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
| difference [95% CI] | p.value |
|---|---|
| 0.48 [-6.53, 7.49] | 0.893 |
relevance to others
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
| difference [95% CI] | p.value |
|---|---|
| -0.69 [-7.80, 6.42] | 0.849 |
person-level DVs
Next, let’s see whether the messaging intervention was associated with the person-level dependent variables.
Penn identity
These items measure how strongly participants identify with Penn.
Does exposure to messages that emphasize Penn social norms and identity increase how strongly people identify with Penn?
| name | text |
|---|---|
| identity_1 | I am proud to be part of the Penn community |
| identity_2 | I identify as a member of the Penn community |
| identity_3 | Being part of the Penn community doesn’t matter to me |
distributions
data_tidy %>%
filter(grepl("identity", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = value, fill = group)) +
geom_density(alpha = .5, color = NA) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
means
data_tidy %>%
filter(grepl("identity", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = group, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
labs(x = "") +
plot_aes +
theme(legend.position = "none")
statistics
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
data_tidy %>%
filter(grepl("identity", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_mlm(data = .)| difference [95% CI] | p.value |
|---|---|
| 0.21 [-4.71, 5.13] | 0.933 |
engagement
These items measure perceived civic engagement for Penn students and the Penn community.
Does exposure to messages that emphasize Penn social norms and identity increase perceived civic engagement?
| name | text |
|---|---|
| engagement students | Penn students are civically engaged |
| engagement community | The Penn community is civically engaged |
distributions
data_tidy %>%
filter(grepl("engagement", name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(x = value, y = name, fill = group)) +
ggridges::geom_density_ridges2(alpha = .5, color = NA) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
labs(y = "") +
plot_aes
means
data_tidy %>%
filter(grepl("engagement", name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
statistics
community
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
data_tidy %>%
filter(grepl("engagement community", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_lm(data = .)| difference [95% CI] | p.value |
|---|---|
| -2.11 [-7.05, 2.83] | 0.401 |
students
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
data_tidy %>%
filter(grepl("engagement students", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_lm(data = .)| difference [95% CI] | p.value |
|---|---|
| -1.08 [-5.86, 3.70] | 0.656 |
social belonging
These items measure perceived social belonging associated with voting.
Does exposure to messages that emphasize Penn social norms and identity increase voting-related social belonging?
| name | text |
|---|---|
| belonging_1 | Not voting makes me feel left out |
| belonging_2 | Voting makes me feel like part of the group |
| belonging_3 | Voting makes me feel like I belong |
distributions
data_tidy %>%
filter(grepl("belonging_", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = value, fill = group)) +
geom_density(alpha = .5, color = NA) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
means
data_tidy %>%
filter(grepl("belonging_", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = group, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9))+
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
labs(x = "") +
plot_aes +
theme(legend.position = "none")
statistics
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
data_tidy %>%
filter(grepl("belonging_", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_mlm(data = .)| difference [95% CI] | p.value |
|---|---|
| -0.41 [-7.64, 6.82] | 0.912 |
civic engagement attitudes
These items measure general civic engagement attitudes.
Does exposure to messages that emphasize Penn social norms and identity increase civic engagement attitudes?
| name | text |
|---|---|
| CE_attitudes_1 | I feel responsible for my community. |
| CE_attitudes_2 | I believe I should make a difference in my community. |
| CE_attitudes_3 | I believe that I have a responsibility to help people who are less well off than myself. |
| CE_attitudes_4 | I am committed to serve in my community. |
| CE_attitudes_5 | I believe that all citizens have a responsibility to their community. |
| CE_attitudes_6 | I believe that it is important to be informed about community issues. |
| CE_attitudes_7 | I believe that it is important to volunteer. |
| CE_attitudes_8 | I believe that it is important to support charitable organizations. |
distributions
data_tidy %>%
filter(grepl("CE_attitude", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = value, fill = group)) +
geom_density(alpha = .5, color = NA) +
scale_fill_manual(values = palette) +
plot_aes
means
data_tidy %>%
filter(grepl("CE_attitude", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = group, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_fill_manual(values = palette) +
coord_cartesian(ylim = c(1, 7)) +
labs(x = "") +
plot_aes +
theme(legend.position = "none")
statistics
The difference between the experimental and control groups is statistically unlikely to be due to chance. Therefore, we can say that the experimental group reported lower civic engagement attitudes than the control group.
data_tidy %>%
filter(grepl("CE_attitude", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_mlm(data = .)| difference [95% CI] | p.value |
|---|---|
| -0.25 [-0.49, -0.01] | 0.04 |
voting attitudes
These items measure attitudes about voting in 2021 elections. Only participants who reported being eligible to vote in an election (N = 226) responded to these items.
Does exposure to messages that emphasize Penn social norms and identity strengthen civic engagement attitudes?
| name | text |
|---|---|
| attitude_1 | a bad thing:a good thing |
| attitude_2 | an unpleasant experience:a pleasant experience |
distributions
data_tidy %>%
filter(grepl("^attitude", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = value, fill = group)) +
geom_density(alpha = .5, color = NA) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
means
data_tidy %>%
filter(grepl("^attitude", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = group, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9))+
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
coord_cartesian(ylim = c(1, 7)) +
labs(x = "") +
plot_aes +
theme(legend.position = "none")
statistics
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
data_tidy %>%
filter(grepl("^attitude", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_mlm(data = .)| difference [95% CI] | p.value |
|---|---|
| 0.07 [-0.18, 0.32] | 0.576 |
voting intentions
These items measure voting-related intentions in 2021 elections. Only participants who reported being eligible to vote in an election (N = 226) responded to these items.
Does exposure to messages that emphasize Penn social norms and identity increase intentions to vote in the 2021 elections?
| name | text |
|---|---|
| plan | I will make a plan for how to vote in the 2021 elections. |
| intention register | I plan to register to vote in the 2021 elections. |
| intention vote | I plan to vote in the 2021 elections. |
| intention request ballot | I plan to request a mail-in ballot to vote in the 2021 elections. |
distributions
data_tidy %>%
filter(grepl("intention|plan", name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(x = value, y = name, fill = group)) +
ggridges::geom_density_ridges2(alpha = .5, color = NA) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
labs(y = "") +
plot_aes
means
data_tidy %>%
filter(grepl("intention|plan", name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
coord_cartesian(ylim = c(1, 7)) +
labs(x = "") +
plot_aes +
theme(legend.position = "none")
statistics
intention to register to vote
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
data_tidy %>%
filter(grepl("intention register", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_lm(data = .)| difference [95% CI] | p.value |
|---|---|
| 0.00 [-0.45, 0.45] | 0.987 |
intention to request ballow
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
data_tidy %>%
filter(grepl("intention request", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_lm(data = .)| difference [95% CI] | p.value |
|---|---|
| 0.01 [-0.48, 0.50] | 0.962 |
intention to vote
The difference between the experimental and control groups is statistically likely to be due to chance. So, even though exposure to the experimental messages was associated with higher intentions to vote, the difference might just be noise.
data_tidy %>%
filter(grepl("intention vote", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_lm(data = .)| difference [95% CI] | p.value |
|---|---|
| 0.24 [-0.17, 0.64] | 0.249 |
intention to make a plan
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
data_tidy %>%
filter(grepl("plan", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_lm(data = .)| difference [95% CI] | p.value |
|---|---|
| 0.03 [-0.39, 0.45] | 0.888 |
voting efficacy
These items measure perceived self-efficacy to vote in 2021 elections. Only participants who reported being eligible to vote in an election (N = 226) responded to these items.
Does exposure to messages that emphasize Penn social norms and identity increased perceived self-efficacy to vote?
| name | text |
|---|---|
| PBC1 | I am confident that I can vote in the 2021 elections. |
| PBC2 | Voting in the 2021 elections is up to me. |
distributions
data_tidy %>%
filter(grepl("PBC", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = value, fill = group)) +
geom_density(alpha = .5, color = NA) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
means
data_tidy %>%
filter(grepl("PBC", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
ggplot(aes(x = group, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
coord_cartesian(ylim = c(1, 7)) +
labs(x = "") +
plot_aes +
theme(legend.position = "none")
statistics
The difference between the experimental and control groups is statistically likely to be due to chance. So, even though exposure to the experimental messages was associated with higher perceived efficacy to vote, the difference might just be noise.
data_tidy %>%
filter(grepl("PBC", name)) %>%
mutate(value = as.numeric(value)) %>%
stats_mlm(data = .)| difference [95% CI] | p.value |
|---|---|
| 0.18 [-0.06, 0.42] | 0.152 |
moderation
Let’s look at whether individual differences are related to the effectiveness of the message framing experiment.
Penn identity
Here, we’ll see whether the effect of message framing condition differed for people who have weaker versus stronger Penn identities.
For the bar graphs, we’ll define strong identities as being above the median, and weak identities being at or below the median.
identity = data_tidy %>%
filter(grepl("identity", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(identity = mean(value, na.rm = TRUE)) %>%
ungroup() %>%
mutate(identity_split = ifelse(identity > median(identity, na.rm = TRUE), "strong", "weak")) relevance
Do people who have weaker/stronger Penn identities perceive the messages as more relevant when they’re in the experimental versus control group?
median split
messages %>%
filter(grepl("relevance", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., identity) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
facet_grid(~identity_split) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
continuous measure
messages %>%
filter(grepl("relevance", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
ggplot(aes(x = identity, y = value, color = group, fill = group)) +
geom_point() +
geom_smooth(method = "lm") +
facet_grid(~name) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
statistics
self-relevance
condition= The groups don’t differ statistically in their ratings of message self-relevancemoderator= Stronger Penn identity is associated higher message self-relevancecondition x moderator= People with stronger identities rated the experimental messages as less relevant than the control messages, but this difference is likely just due to chance
messages %>%
filter(grepl("relevance self", name)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
stats_mlm_mod(data = ., moderator = "identity")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 13.51 [-7.01, 34.03] | 0.198 |
| moderator | 0.26 [0.07, 0.45] | 0.008 |
| condition x moderator | -0.16 [-0.43, 0.10] | 0.229 |
relevance to others
condition= The groups don’t differ statistically in their ratings of message relevance to othersmoderator= Stronger Penn identity is associated higher message relevance to otherscondition x moderator= People with stronger identities rated the experimental messages as less relevant to others than the control messages, but this difference is likely just due to chance
messages %>%
filter(grepl("relevance others", name)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
stats_mlm_mod(data = ., moderator = "identity")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 4.63 [-10.72, 19.98] | 0.555 |
| moderator | 0.20 [0.06, 0.34] | 0.006 |
| condition x moderator | -0.10 [-0.30, 0.10] | 0.317 |
motivation
Do people who have weaker/stronger Penn identities perceive the messages as more motivating when they’re in the experimental versus control group?
median split
messages %>%
filter(grepl("motivation", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., identity) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
facet_grid(~identity_split) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
continuous measure
messages %>%
filter(grepl("motivation", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
ggplot(aes(x = identity, y = value, color = group, fill = group)) +
geom_point() +
geom_smooth(method = "lm") +
facet_grid(~name) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
statistics
motivation to self
condition= The groups don’t differ statistically in their ratings of how motivating the messages were to themselvesmoderator= Stronger Penn identity is associated higher message motivation to themselvescondition x moderator= The relationship between identity and motivation didn’t differ depending on which type of messages participants were exposed to
messages %>%
filter(grepl("motivation self", name)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
stats_mlm_mod(data = ., moderator = "identity")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 5.82 [-14.50, 26.14] | 0.575 |
| moderator | 0.16 [-0.03, 0.35] | 0.093 |
| condition x moderator | -0.04 [-0.31, 0.22] | 0.741 |
motivation to others
condition= Exposure to the experimental messages was associated with lower ratings of motivation to others, but the difference is likely due to chancemoderator= Stronger Penn identity wasn’t associated with perceived motivation to otherscondition x moderator= People with stronger Penn identities tended to rate the messages as more motivating to others when in the experimental condition, but this relationship is likely due to chance
messages %>%
filter(grepl("motivation others", name)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
stats_mlm_mod(data = ., moderator = "identity")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | -12.79 [-30.39, 4.81] | 0.156 |
| moderator | 0.04 [-0.12, 0.21] | 0.589 |
| condition x moderator | 0.16 [-0.07, 0.38] | 0.181 |
sharing
Do people who have weaker/stronger Penn identities have higher sharing intentions when they’re in the experimental versus control group?
median split
messages %>%
filter(grepl("share", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., identity) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
facet_grid(~identity_split) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
continuous measure
messages %>%
filter(grepl("share", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
ggplot(aes(x = identity, y = value, color = group, fill = group)) +
geom_point() +
geom_smooth(method = "lm") +
facet_grid(~name) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
statistics
broadcasting
condition= The groups don’t differ statistically in the intentions to share on social mediamoderator= Stronger Penn identity is associated higher intentions to share on social media, but this association is may be due to chancecondition x moderator= The relationship between identity and sharing intentions didn’t differ depending on which type of messages participants were exposed to
messages %>%
filter(grepl("broadcast", name)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
stats_mlm_mod(data = ., moderator = "identity")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 6.33 [-21.08, 33.74] | 0.651 |
| moderator | 0.18 [-0.08, 0.43] | 0.175 |
| condition x moderator | -0.08 [-0.43, 0.28] | 0.664 |
narrowcasting
condition= Participants in the experimental group reported higher intentions to share the messages directly with someone, but this difference is likely due to chancemoderator= Stronger Penn identity is associated higher intentions to share on directly with someonecondition x moderator= People with strong Penn identities in the experimental condition reported lower intentions to share the messages than people with strong identities in the control condition, but this difference is likely due to chance
messages %>%
filter(grepl("narrowcast", name)) %>%
left_join(., identity) %>%
filter(!is.na(identity)) %>%
stats_mlm_mod(data = ., moderator = "identity")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 15.32 [-12.42, 43.06] | 0.280 |
| moderator | 0.24 [-0.01, 0.50] | 0.064 |
| condition x moderator | -0.22 [-0.58, 0.14] | 0.242 |
class year
Here, we’ll see whether the effect of message framing condition differed as a function of class year. Because only two people were year 5 or higher, let’s exclude those participants to reduce their outsized effect.
year = data_tidy %>%
filter(grepl("grade", name)) %>%
mutate(value = as.numeric(value)) %>%
rename("year" = value) %>%
select(ResponseId, year) %>%
filter(!year == "5")relevance
Does the effect of message condition on perceived message relevance differ by class year?
by year
messages %>%
filter(grepl("relevance", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
facet_grid(~year) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
continuous measure
messages %>%
filter(grepl("relevance", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
ggplot(aes(x = year, y = value, color = group, fill = group)) +
geom_point() +
geom_smooth(method = "lm") +
facet_grid(~name) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
statistics
self-relevance
condition= The groups don’t differ statistically in their ratings of message self-relevancemoderator= Class year isn’t associated with higher message self-relevancecondition x moderator= More advanced students rated the experimental messages as less relevant than the control messages, but this difference is likely just due to chance
messages %>%
filter(grepl("relevance self", name)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
stats_mlm_mod(data = ., moderator = "year")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 6.94 [-5.30, 19.18] | 0.267 |
| moderator | 0.27 [-3.21, 3.74] | 0.880 |
| condition x moderator | -2.86 [-7.88, 2.16] | 0.265 |
relevance to others
condition= The groups don’t differ statistically in their ratings of perceived relevance to othersmoderator= Class year isn’t associated with higher perceived relevance to otherscondition x moderator= More advanced students rated the experimental messages as less relevant to others than the control messages, but this difference is likely just due to chance
messages %>%
filter(grepl("relevance others", name)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
stats_mlm_mod(data = ., moderator = "year")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 1.78 [-7.48, 11.03] | 0.707 |
| moderator | -0.16 [-2.78, 2.47] | 0.907 |
| condition x moderator | -2.13 [-5.93, 1.66] | 0.272 |
motivation
Does the effect of message condition on perceived message motivation differ by class year?
median split
messages %>%
filter(grepl("motivation", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
facet_grid(~year) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
continuous measure
messages %>%
filter(grepl("motivation", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
ggplot(aes(x = year, y = value, color = group, fill = group)) +
geom_point() +
geom_smooth(method = "lm") +
facet_grid(~name) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
statistics
motivation to self
condition= The groups don’t differ statistically in their ratings of message motivationmoderator= Class year isn’t associated with higher message motivationcondition x moderator= More advanced students rated the experimental messages as less motivating than the control messages, but this difference is likely just due to chance
messages %>%
filter(grepl("motivation self", name)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
stats_mlm_mod(data = ., moderator = "year")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 7.49 [-4.53, 19.50] | 0.223 |
| moderator | -0.20 [-3.61, 3.21] | 0.909 |
| condition x moderator | -2.62 [-7.55, 2.31] | 0.299 |
motivation to others
condition= The groups don’t differ statistically in their ratings of perceived motivation to othersmoderator= Class year isn’t associated with higher perceived motivation to otherscondition x moderator= More advanced students rated the experimental messages as less motivating to others than the control messages, but this difference is likely just due to chance
messages %>%
filter(grepl("motivation others", name)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
stats_mlm_mod(data = ., moderator = "year")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 4.54 [-6.01, 15.08] | 0.400 |
| moderator | 0.34 [-2.66, 3.33] | 0.825 |
| condition x moderator | -2.52 [-6.84, 1.80] | 0.255 |
sharing
Does the effect of message condition on message sharing intentions differ by class year?
median split
messages %>%
filter(grepl("share", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
ggplot(aes(x = name, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0,
position = position_dodge(.9)) +
facet_grid(~year) +
labs(x = "") +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes +
theme(legend.position = "top")
continuous measure
messages %>%
filter(grepl("share", name)) %>%
group_by(ResponseId, group, name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
ggplot(aes(x = year, y = value, color = group, fill = group)) +
geom_point() +
geom_smooth(method = "lm") +
facet_grid(~name) +
scale_color_manual(values = palette) +
scale_fill_manual(values = palette) +
plot_aes
statistics
broadcasting
condition= The groups don’t differ statistically in the intentions to share on social mediamoderator= Class year isn’t associated with intentions to share on social mediacondition x moderator= More advanced students exposed to experimental messages reported lower sharing intentions than advanced students in the control condition, but this difference is likely just due to chance
messages %>%
filter(grepl("broadcast", name)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
stats_mlm_mod(data = ., moderator = "year")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 8.68 [-7.59, 24.95] | 0.297 |
| moderator | -1.84 [-6.46, 2.77] | 0.434 |
| condition x moderator | -4.01 [-10.69, 2.66] | 0.240 |
narrowcasting
condition= The groups don’t differ statistically in the intentions to share directly with someonemoderator= Class year isn’t associated with intentions to share directly with someonecondition x moderator= The relationship between condition and sharing intentions didn’t fiffer by class year
messages %>%
filter(grepl("narrowcast", name)) %>%
left_join(., year) %>%
filter(!is.na(year)) %>%
stats_mlm_mod(data = ., moderator = "year")| term | estimate [95% CI] | p.value |
|---|---|---|
| condition | 5.36 [-11.28, 21.99] | 0.529 |
| moderator | 1.06 [-3.66, 5.78] | 0.661 |
| condition x moderator | -3.09 [-9.91, 3.73] | 0.375 |
message effectiveness
Overall, which messages were most effective?
relevance
distributions
messages %>%
filter(grepl("relevance", name)) %>%
ggplot(aes(x = value, y = name, fill = item)) +
ggridges::geom_density_ridges2(alpha = .2, color = NA, scale = .8) +
facet_grid(~group) +
labs(y = "") +
scale_color_manual(values = palette_messages) +
scale_fill_manual(values = palette_messages) +
plot_aes
means
messages %>%
filter(grepl("relevance", name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(x = item, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_fill_manual(values = palette) +
facet_grid(~name) +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
motivation
distributions
messages %>%
filter(grepl("motivation", name)) %>%
ggplot(aes(x = value, y = name, fill = item)) +
ggridges::geom_density_ridges2(alpha = .2, color = NA, scale = .8) +
facet_grid(~group) +
labs(y = "") +
scale_color_manual(values = palette_messages) +
scale_fill_manual(values = palette_messages) +
plot_aes
means
messages %>%
filter(grepl("motivation", name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(x = item, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_fill_manual(values = palette) +
facet_grid(~name) +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
sharing
distributions
messages %>%
filter(grepl("share", name)) %>%
ggplot(aes(x = value, y = name, fill = item)) +
ggridges::geom_density_ridges2(alpha = .2, color = NA, scale = .8) +
facet_grid(~group) +
labs(y = "") +
scale_color_manual(values = palette_messages) +
scale_fill_manual(values = palette_messages) +
plot_aes
means
messages %>%
filter(grepl("share", name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(x = item, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_fill_manual(values = palette) +
facet_grid(~name) +
labs(x = "") +
plot_aes +
theme(legend.position = "top")
other individual difference measures
civic engagement behavior
These items measure general civic engagement behavior.
How civically engaged are the participants and do the groups differ?
| name | text |
|---|---|
| CE_checklist_1 | worked together informally with someone or some group to solve a problem in the community where I live. |
| CE_checklist_2 | spent time participating in any community service or volunteer activity. |
| CE_checklist_3 | belonged to or donated money to any group or association, either locally or nationally. |
| CE_checklist_4 | walked, ran, or bicycled for a charitable cause–this is separate from sponsoring or giving money to this type of event. |
| CE_checklist_5 | did something else to help raise money for a charitable cause. |
| CE_checklist_6 | talked to people to try to show them why they should vote for or against one of the parties or candidates. |
| CE_checklist_7 | wore a campaign button, put a sticker on my car or other personal belonging, or placed a sign in front of my house. |
| CE_checklist_8 | contributed money to a candidate, political party, or any organization that supported candidates. |
| CE_checklist_9 | volunteered for a political organization or candidates running for office. |
| CE_checklist_10 | contacted or visited a public official–at any level of government–to ask for assistance or to express my opinion. |
| CE_checklist_11 | contacted a newspaper or magazine to express my opinion on an issue. |
| CE_checklist_12 | called in to a radio or television talk show to express my opinion on a political issue (even if you did not get on the air). |
| CE_checklist_13 | took part in a protest, march, or demonstration. |
| CE_checklist_14 | signed a written petition about a political or social issue. |
| CE_checklist_15 | did NOT buy something because of conditions under which the product is made, or because I dislike the conduct of the company that produces it. |
| CE_checklist_16 | bought a certain product or service because I like the social or political values of the company that produces it. |
| CE_checklist_17 | worked as a canvasser (e.g. via door-to-door, texting, or calling) for a political or social group or candidate. |
| CE_checklist_18 | volunteered with Penn Leads the Vote |
distributions
data_tidy %>%
filter(grepl("CE_checklist", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = sum(value, na.rm = TRUE)) %>%
ggplot(aes(x = value, fill = group)) +
geom_density(alpha = .5, color = NA) +
scale_fill_manual(values = palette) +
plot_aes
means
data_tidy %>%
filter(grepl("CE_checklist", name)) %>%
mutate(value = as.numeric(value)) %>%
group_by(ResponseId, group) %>%
summarize(value = sum(value, na.rm = TRUE)) %>%
ggplot(aes(x = group, y = value, fill = group)) +
stat_summary(fun = "mean", geom = "bar", position = position_dodge(.9)) +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, position = position_dodge(.9)) +
scale_fill_manual(values = palette) +
labs(x = "") +
plot_aes +
theme(legend.position = "none")
reasons for voting/not voting
Next, let’s look at the reasons participants endorsed for voting and not voting.
reasons = read_csv(here("static", "labs", "data", "week8_reasons.csv"))
data_reasons = data_tidy %>%
# select relevant variables
select(-text) %>%
filter(grepl("reasons_yes$|reasons_no$", name)) %>%
# split the selected responses and convert to a single row per response
unnest_tokens(value, value, token = stringr::str_split, pattern = ",") %>%
# convert to numeric to facilitate joining
mutate(value = as.numeric(value)) %>%
# join with text
left_join(., reasons) %>%
# remove missing responses and "other" responses
filter(!is.na(text)) %>%
# get unique responses
unique()not voting
This plot shows the number of participants that endorsed each reason for not voting. Written in responses to “other” are reported below.
| name | text |
|---|---|
| reasons_no | Some people choose to vote, while others do not. We’re interested in understanding why people do or don’t vote. Below are some reasons people may not vote. Please select all reasons from the list that apply to you or write your own reasons by selecting “Other” below. |
data_reasons %>%
filter(name == "reasons_no") %>%
group_by(text) %>%
mutate(n_responses = n()) %>%
ggplot(aes(x = reorder(text, n_responses))) +
geom_bar() +
coord_flip() +
labs(x = "", y = "\ncount") +
plot_aes
data_tidy %>%
select(-text) %>%
filter(grepl("reasons_no_", name)) %>%
filter(!is.na(value)) %>%
select(value) %>%
rename("other reasons" = value) %>%
kable()| other reasons |
|---|
| N/a - I think voting is important and there is no reason not to vote |
| I do vote. |
| missing registration/election deadlines |
| Believing that both major candidates are too extreme and do not represent your beliefs |
| Aside from national elections, I am not very informed about the people who I am voting for on the ballot. Thus, I feel that my vote could be harmful since I am voting without being fully educated on the policies behind each candidate. |
| I do not know enough about the candidates and what they believe in or stand for. |
| I vote and I think voting matters and makes a difference. |
| none of these are reasons I would not vote |
| none |
| I do vote |
| None of these are reasons that would stop me from voting. |
| i vote |
| I have always voted. |
| You are given two options (first past the post system), but these options are two heads of the same horse. They all want to see us suffer |
| I believe we should always vote |
| n/a |
| N/A |
| Politics is primarily a game, so even if I were to research about people and agree with them, that does not mean they will actually enact those changes. I just dont have faith in the political system when money is involved and as influential as it is. |
| None. I always try to vote and think it makes a difference. |
| None of these apply to me |
| N/A |
| I can improve my status as an individual by focusing on improving my immediate situation; participating in civic engagement as a community is less relevant to me. |
| I do vote, what do you mean? |
| does not apply to me |
| i choose to vote so these options do not apply to me |
| I do vote |
| Being eligible to vote in another state other than PA, make it difficult and are often barriers |
| They make it very confusing and the politics are so polarizing I can not decide what i believe at times. |
| None apply to me |
voting
This plot shows the number of participants that endorsed each reason for voting. Written in responses to “other” are reported below.
| name | text |
|---|---|
| reasons_yes | Below are some reasons people may vote. Please select all reasons from the list that apply to you or write your own reasons by selecting “Other” below. |
data_reasons %>%
filter(name == "reasons_yes") %>%
group_by(text) %>%
mutate(n_responses = n()) %>%
ggplot(aes(x = reorder(text, n_responses))) +
geom_bar() +
coord_flip() +
labs(x = "", y = "\ncount") +
plot_aes
data_tidy %>%
select(-text) %>%
filter(grepl("reasons_yes_", name)) %>%
filter(!is.na(value)) %>%
select(value) %>%
rename("other reasons" = value) %>%
kable()| other reasons |
|---|
| we do not live in a democracy, |
| I used to think the political party in power does not affect the amount of racism and hatred taking place in America, but the last 2-3 years have really opened my eyes to that foolish belief. I genuinely believe that voting a certain way, and seeing that certain political party win, can do so much to push racists back into the closet. |
open-ended questions
Below are the responses to the open-ended questions about civic engagement.
meaning
| name | text |
|---|---|
| OE_meaning | In your opinion, what does being civically engaged mean to you? |
importance
| name | text |
|---|---|
| OE_matter | In your opinion, why does being civically engaged matter or not matter? |
belonging
| name | text |
|---|---|
| OE_belonging | Does being more engaged make you feel more a part of the Penn community? Why or why not? |
support
| name | text |
|---|---|
| OE_support | How could Penn support and encourage students to be civically engaged? |
social norms
These items measure perceived social norms about voting for different groups at Penn.
Does exposure to messages that emphasize Penn social norms and identity increase perceived social norms about voting?
distributions
means
statistics
community
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
friends
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.
students
The difference between the experimental and control groups is statistically likely to be due to chance. As such, we can say that the groups probably don’t differ from each other.