Overview &
Methodology
- Study of third party forced-choice judgments of donors motivated by
a justice or generosity virtue
- Data collected March 14th, 2023
- N = 100
Key Findings
- Participants think justice-motivated donors are less moral, but more
motivated by norm signaling desires
Setup
Libraries and functions
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
Mypackages <-
c("lme4","tidyverse","effects","ggplot2","psych",
"MASS","Rmisc","lmerTest","ggthemes", "knitr",
"lsmeans","pastecs","sjstats","car","ordinal",
"Rcpp","corrplot", "ggpubr", "EnvStats",
"easyStats", "cowplot","see","datawizard",
"ggcorrplot", "lavaan", "tidytext", "wordcloud",
"textdata", "reshape2")
# install.packages(Mypackages) #you must remove the # in this comment if you need to install the packages!
lapply(Mypackages,
require,
character.only = TRUE)
options(knitr.kable.NA = '—')
set.seed(1)
Load Data
# read in data files
setwd("~/Desktop")
gjg <-read.csv("/Users/mtrenfield17/Desktop/Research/Boston College Research/Morality Lab Research/Generosity Vs Justice Project/just_vs_gen_pilot2_files/gen_vs_just_pilot2.csv")
Reshaping data
# changing appropriate DVs to factor
# gjg <- gjg %>% mutate_at(vars(genuine:norm_signal, gender, race, education, political_overall), as.factor)
# changing appropriate DVs to numeric
gjg <- gjg %>% mutate_at(vars(age, income, ses, political_social, political_economic), as.numeric)
## renaming donors to their virtues
gjg <- gjg %>%
mutate_at(vars(genuine:norm_signal), ~ ifelse(. == "Jon", "Justice",
ifelse(. == "Will", "Generosity", "XX")))
Demographics
# Subset your data frame to include only the demographic columns
numeric_demos <- gjg[,c("age", "income", "ses", "political_social", "political_economic")]
categorical_demos <- gjg[, c("gender", "race", "education", "political_overall")]
# descsriptive stats for numeric demos
describeBy(numeric_demos)
## vars n mean sd median trimmed mad min max range
## age 1 100 35.34 11.90 32 33.94 10.38 18 66 48
## income 2 100 5.45 2.34 6 5.56 2.97 1 9 8
## ses 3 100 4.82 1.63 5 4.79 1.48 2 9 7
## political_social 4 100 2.80 1.63 2 2.60 1.48 1 7 6
## political_economic 5 100 3.23 1.66 3 3.14 1.48 1 7 6
## skew kurtosis se
## age 0.91 -0.09 1.19
## income -0.41 -0.91 0.23
## ses 0.15 -0.72 0.16
## political_social 0.72 -0.35 0.16
## political_economic 0.41 -0.85 0.17
## frequency for categorical demos
freq_tables <- list()
for (col in names(categorical_demos)) {
if (is.character(categorical_demos[[col]])) {
freq_table <- as.data.frame(table(categorical_demos[[col]], useNA = "ifany"))
freq_table$Percent <- round(freq_table$Freq / sum(freq_table$Freq) * 100, 2)
freq_table <- freq_table[complete.cases(freq_table), ]
freq_tables[[col]] <- freq_table
}
}
# Print the frequency tables
for (i in seq_along(freq_tables)) {
if (!is.null(freq_tables[[i]])) {
cat("\nTable of frequencies for", names(freq_tables)[i], ":\n")
print(freq_tables[[i]])
}
}
##
## Table of frequencies for gender :
## Var1 Freq Percent
## 1 Man 48 48
## 2 Nonbinary person or Other 1 1
## 3 Woman 51 51
##
## Table of frequencies for race :
## Var1 Freq Percent
## 1 Asian 8 8
## 2 Asian,White 2 2
## 3 Black or African American 6 6
## 4 Black or African American,Hispanic/Latino/a/x 1 1
## 5 Black or African American,White 1 1
## 6 Indigenous American or Alaskan Native,White 1 1
## 7 White 75 75
## 8 White,Hispanic/Latino/a/x 6 6
##
## Table of frequencies for education :
## Var1
## 1
## 2 Associate Degree (e.g. AA, AS)
## 3 Bachelor's Degree (e.g. BA, BS)
## 4 High school degree or equivalent (e.g. GED)
## 5 Less than a high school diploma
## 6 Postgraduate Degree (e.g. Master's Degree, Professional Degree, Doctorate Degree)
## 7 Some college, no degree
## Freq Percent
## 1 1 1
## 2 10 10
## 3 35 35
## 4 8 8
## 5 1 1
## 6 13 13
## 7 32 32
##
## Table of frequencies for political_overall :
## Var1 Freq Percent
## 1 Democrat 52 52
## 2 Independent 35 35
## 3 Republican 11 11
## 4 Something else 2 2
# Create composite political measures
gjg$polit_comp <- if_else(gjg$political_overall == "Democrat", "Democrat",
if_else(gjg$political_overall == "Republican"
| gjg$political_overall == "Independent"
| gjg$political_overall == "Something else", "Not Democrat", "NA"))
Relationship between
DVs
cont_table <- table(genuine = gjg$genuine, approval = gjg$approval, norm_signal = gjg$norm_signal,
dnn = c("Genuine", "Approval", "Norm Signal"),
useNA = "ifany")
prop_table <- prop.table(cont_table)
prop_table
## , , Norm Signal = Generosity
##
## Approval
## Genuine Generosity Justice
## Generosity 0.06 0.02
## Justice 0.02 0.13
##
## , , Norm Signal = Justice
##
## Approval
## Genuine Generosity Justice
## Generosity 0.50 0.06
## Justice 0.02 0.19
Frequency Plots +
Chi-squared Tests
ggplot(data = gjg, aes(x = genuine)) +
geom_bar(fill = c("#7CCCB0", "#D193DC"), color = "black") +
labs(x = "Motive", y = "Count", title = ' "Who do you think is more genuine?" (N = 100)') +
theme(plot.title = element_text(hjust = 0.5)) +
theme(
plot.title = element_text(hjust = 0.5, size = 25),
axis.text.x = element_text(face = "plain", size = 23, color = "black"),
axis.text.y = element_text(face = "plain", size = 20, color = "black"),
axis.title.y = element_text(face = "plain", size = 23, color = "black"),
axis.title.x = element_blank()
) +
scale_x_discrete(labels = c("Generosity-motivated \n\ Donor", "Justice-motivated \n\ Donor"))
genuine_chi <- table(gjg$genuine)
chisq.test(genuine_chi)
##
## Chi-squared test for given probabilities
##
## data: genuine_chi
## X-squared = 7.84, df = 1, p-value = 0.00511
ggplot(data = gjg, aes(x = approval)) +
geom_bar(fill = c("#7CCCB0", "#D193DC"), color = "black") +
labs(x = "Motive", y = "Count", title = ' "Whose motivation for donating do you approve of more?" (N = 100)') +
theme(plot.title = element_text(hjust = 0.5)) +
theme(
plot.title = element_text(hjust = 0.5, size = 25),
axis.text.x = element_text(face = "plain", size = 23, color = "black"),
axis.text.y = element_text(face = "plain", size = 20, color = "black"),
axis.title.y = element_text(face = "plain", size = 23, color = "black"),
axis.title.x = element_blank()
) +
scale_x_discrete(labels = c("Generosity-motivated \n\ Donor", "Justice-motivated \n\ Donor"))
ggplot(data = gjg, aes(x = approval)) +
geom_bar(fill = c("#7CCCB0", "#D193DC"), color = "black") +
labs(x = "Variable", y = "Frequency", title = "Approval Frequency Plot (N = 100)")+
theme(plot.title = element_text(hjust = 0.5)) +
theme(
plot.title = element_text(hjust = 0.5, size = 18),
axis.text.x = element_text(face = "plain", size = 17, color = "black"),
axis.text.y = element_text(face = "plain", size = 15, color = "black"),
axis.title.y = element_text(face = "plain", size = 17, color = "black"),
axis.title.x = element_text(face = "plain", size = 15, color = "black"), )
approval_chi <- table(gjg$approval)
chisq.test(approval_chi)
##
## Chi-squared test for given probabilities
##
## data: approval_chi
## X-squared = 4, df = 1, p-value = 0.0455
ggplot(data = gjg, aes(x = norm_signal)) +
geom_bar(fill = c("#7CCCB0", "#D193DC"), color = "black") +
labs(x = "Motive", y = "Count", title = ' "Who was more motivated to donate to this cause because \n\ he wanted to signal to others that it is important and right?" (N = 100)') +
theme(plot.title = element_text(hjust = 0.5)) +
theme(
plot.title = element_text(hjust = 0.5, size = 25),
axis.text.x = element_text(face = "plain", size = 23, color = "black"),
axis.text.y = element_text(face = "plain", size = 20, color = "black"),
axis.title.y = element_text(face = "plain", size = 23, color = "black"),
axis.title.x = element_blank()
) +
scale_x_discrete(labels = c("Generosity-motivated \n\ Donor", "Justice-motivated \n\ Donor"))
norm_chi <- table(gjg$norm_signal)
chisq.test(norm_chi)
##
## Chi-squared test for given probabilities
##
## data: norm_chi
## X-squared = 29.16, df = 1, p-value = 6.664e-08
Frequency Plots by
political affiliation
# genuine
genuine_plot_overall <- ggplot(data = gjg, aes(x = genuine)) +
geom_bar(fill = c("#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC", "#7CCCB0"), color = "black") +
labs(x = "Variable", y = "Frequency", title = "Genuine Frequency by Political Orientation") +
facet_wrap(~ political_overall) +
theme(plot.title = element_text(hjust = 0.5))
genuine_plot_overall
genuine_plot_consolidated <- ggplot(data = gjg, aes(x = genuine)) +
geom_bar(fill = c("#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC"), color = "black") +
labs(x = "Variable", y = "Frequency", title = "Genuine Frequency by Political Orientation") +
facet_wrap(~ polit_comp) +
theme(plot.title = element_text(hjust = 0.5))
genuine_plot_consolidated
genuine_polit_chi <- table(gjg$genuine, gjg$political_overall)
chisq.test(genuine_polit_chi)
##
## Pearson's Chi-squared test
##
## data: genuine_polit_chi
## X-squared = 3.5834, df = 3, p-value = 0.3101
genuine_polit_comp_chi <- table(gjg$genuine, gjg$polit_comp)
chisq.test(genuine_polit_comp_chi)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: genuine_polit_comp_chi
## X-squared = 1.3439, df = 1, p-value = 0.2463
# approval
approval_plot_overall <- ggplot(data = gjg, aes(x = approval)) +
geom_bar(fill = c("#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC", "#7CCCB0"), color = "black") +
labs(x = "Variable", y = "Frequency", title = "Approval Frequency by Political Orientation") +
facet_wrap(~ political_overall) +
theme(plot.title = element_text(hjust = 0.5))
approval_plot_overall
approval_plot_consolidated <- ggplot(data = gjg, aes(x = approval)) +
geom_bar(fill = c("#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC"), color = "black") +
labs(x = "Variable", y = "Frequency", title = "Approval Frequency by Political Orientation") +
facet_wrap(~ polit_comp) +
theme(plot.title = element_text(hjust = 0.5))
approval_plot_consolidated
approval_polit_chi <- table(gjg$approval, gjg$political_overall)
chisq.test(approval_polit_chi)
##
## Pearson's Chi-squared test
##
## data: approval_polit_chi
## X-squared = 5.0477, df = 3, p-value = 0.1683
approval_polit_comp_chi <- table(gjg$approval, gjg$polit_comp)
chisq.test(approval_polit_comp_chi)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: approval_polit_comp_chi
## X-squared = 2.2853, df = 1, p-value = 0.1306
# norm signaling
norm_plot_overall <- ggplot(data = gjg, aes(x = norm_signal)) +
geom_bar(fill = c("#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC", "#D193DC"), color = "black") +
labs(x = "Variable", y = "Frequency", title = "Norm Signaling Frequency by Political Orientation") +
facet_wrap(~ political_overall) +
theme(plot.title = element_text(hjust = 0.5))
norm_plot_overall
norm_plot_consolidated <- ggplot(data = gjg, aes(x = norm_signal)) +
geom_bar(fill = c("#7CCCB0", "#D193DC", "#7CCCB0", "#D193DC"), color = "black") +
labs(x = "Variable", y = "Frequency", title = "Norm Signaling Frequency by Political Orientation") +
facet_wrap(~ polit_comp) +
theme(plot.title = element_text(hjust = 0.5))
norm_plot_consolidated
norm_polit_chi <- table(gjg$norm_signal, gjg$political_overall)
chisq.test(norm_polit_chi)
##
## Pearson's Chi-squared test
##
## data: norm_polit_chi
## X-squared = 0.85945, df = 3, p-value = 0.8352
norm_polit_comp_chi <- table(gjg$norm_signal, gjg$polit_comp)
chisq.test(norm_polit_comp_chi)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: norm_polit_comp_chi
## X-squared = 0.065967, df = 1, p-value = 0.7973
gjg$approval
## [1] "Generosity" "Justice" "Generosity" "Generosity" "Justice"
## [6] "Generosity" "Generosity" "Generosity" "Justice" "Generosity"
## [11] "Generosity" "Generosity" "Generosity" "Justice" "Generosity"
## [16] "Generosity" "Generosity" "Justice" "Generosity" "Justice"
## [21] "Generosity" "Justice" "Justice" "Justice" "Generosity"
## [26] "Generosity" "Justice" "Generosity" "Generosity" "Generosity"
## [31] "Generosity" "Generosity" "Generosity" "Generosity" "Generosity"
## [36] "Justice" "Justice" "Generosity" "Generosity" "Generosity"
## [41] "Generosity" "Justice" "Justice" "Generosity" "Generosity"
## [46] "Justice" "Justice" "Generosity" "Generosity" "Justice"
## [51] "Generosity" "Justice" "Justice" "Justice" "Generosity"
## [56] "Generosity" "Generosity" "Generosity" "Justice" "Generosity"
## [61] "Generosity" "Justice" "Justice" "Generosity" "Justice"
## [66] "Generosity" "Generosity" "Justice" "Generosity" "Generosity"
## [71] "Generosity" "Generosity" "Justice" "Justice" "Justice"
## [76] "Generosity" "Generosity" "Justice" "Generosity" "Justice"
## [81] "Justice" "Generosity" "Justice" "Generosity" "Generosity"
## [86] "Justice" "Justice" "Generosity" "Justice" "Justice"
## [91] "Generosity" "Generosity" "Generosity" "Justice" "Justice"
## [96] "Justice" "Generosity" "Generosity" "Generosity" "Justice"
gjg <- gjg %>% mutate(approval_dif = ifelse(approval == "Justice", -1, 1))
gjg$political_social
## [1] 4 2 6 2 5 3 2 1 4 2 7 4 4 1 6 1 4 1 5 1 6 4 1 2 1 6 6 4 4 3 2 4 3 3 1 3 1
## [38] 3 1 1 3 3 1 2 5 2 1 3 1 2 2 4 2 1 2 1 3 1 4 6 4 2 2 2 1 2 2 3 1 2 4 2 6 1
## [75] 2 1 3 4 4 2 3 3 2 7 4 2 2 4 1 6 4 1 1 2 1 4 2 1 3 4
gjg$political_economic
## [1] 4 2 6 6 3 3 4 1 4 5 7 4 4 1 6 1 4 1 5 1 6 4 2 4 1 6 6 4 4 3 2 4 6 4 1 3 2
## [38] 4 2 1 5 5 1 2 3 3 1 3 2 4 3 6 2 1 3 4 3 2 5 6 4 2 2 6 1 2 1 2 2 6 4 3 6 2
## [75] 2 3 3 4 4 2 3 2 2 7 2 2 2 4 2 5 4 1 3 2 1 2 5 1 3 4
gjg$approval_dif
## [1] 1 -1 1 1 -1 1 1 1 -1 1 1 1 1 -1 1 1 1 -1 1 -1 1 -1 -1 -1 1
## [26] 1 -1 1 1 1 1 1 1 1 1 -1 -1 1 1 1 1 -1 -1 1 1 -1 -1 1 1 -1
## [51] 1 -1 -1 -1 1 1 1 1 -1 1 1 -1 -1 1 -1 1 1 -1 1 1 1 1 -1 -1 -1
## [76] 1 1 -1 1 -1 -1 1 -1 1 1 -1 -1 1 -1 -1 1 1 1 -1 -1 -1 1 1 1 -1
grouped_data <- gjg %>%
dplyr::group_by(political_social) %>%
dplyr::summarize(sum_approval_dif = sum(approval_dif))
grouped_data$sum_approval_dif
## [1] 2 0 7 6 1 2 2
# Create a bar plot of the summed approval_dif for each group
ggplot(grouped_data, aes(x = political_social, y = sum_approval_dif)) +
geom_line() +
labs(x = "Political and social scores", y = "Sum of approval difference")
grouped_data <- gjg %>%
dplyr::group_by(political_economic) %>%
dplyr::summarize(sum_approval_dif = sum(approval_dif))
grouped_data$sum_approval_dif
## [1] 0 -7 8 10 1 6 2
# Create a bar plot of the summed approval_dif for each group
ggplot(grouped_data, aes(x = political_economic, y = sum_approval_dif)) +
geom_line() +
labs(x = "Political and social scores", y = "Sum of approval difference")
# stacked plots
## genuine
genuine_plot_overall <- ggplot(data = gjg, aes(x = genuine, group = political_overall, fill = political_overall)) +
geom_bar(position = "fill") +
labs(x = "Variable", y = "Proportion", title = "Genuine Proportion by Political Orientation") +
scale_fill_brewer(palette = "Set2") +
theme(plot.title = element_text(hjust = 0.5), legend.title = element_blank())
genuine_plot_overall
genuine_plot_consolidated <- ggplot(data = gjg, aes(x = polit_comp, group = genuine, fill = genuine)) +
geom_bar(position = "fill") +
labs(x = "Variable", y = "Proportion", title = "Genuine Proportion by Political Orientation") +
scale_fill_brewer(palette = "Set2") +
theme(plot.title = element_text(hjust = 0.5), legend.title = element_blank())
genuine_plot_consolidated
# approval
approval_plot_overall <- ggplot(data = gjg, aes(x = approval, group = political_overall, fill = political_overall)) +
geom_bar(position = "fill") +
labs(x = "Variable", y = "Proportion", title = "Approval Proportion by Political Orientation") +
scale_fill_brewer(palette = "Set2") +
theme(plot.title = element_text(hjust = 0.5), legend.title = element_blank())
approval_plot_overall
approval_plot_consolidated <- ggplot(data = gjg, aes(x = approval, group = polit_comp, fill = polit_comp)) +
geom_bar(position = "fill") +
labs(x = "Variable", y = "Proportion", title = "Approval Proportion by Political Orientation") +
scale_fill_brewer(palette = "Set2") +
theme(plot.title = element_text(hjust = 0.5), legend.title = element_blank())
approval_plot_consolidated
# norm signaling
norm_plot_overall <- ggplot(data = gjg, aes(x = norm_signal, group = political_overall, fill = political_overall)) +
geom_bar(position = "fill") +
labs(x = "Variable", y = "Propotion", title = "Norm Signaling Proportion by Political Orientation") +
scale_fill_brewer(palette = "Set2") +
theme(plot.title = element_text(hjust = 0.5), legend.title = element_blank())
norm_plot_overall
norm_plot_consolidated <- ggplot(data = gjg, aes(x = norm_signal, group = polit_comp, fill = polit_comp)) +
geom_bar(position = "fill") +
labs(x = "Variable", y = "Proportion", title = "Norm Signaling Proportion by Political Orientation") +
scale_fill_brewer(palette = "Set2") +
theme(plot.title = element_text(hjust = 0.5), legend.title = element_blank())
norm_plot_consolidated
NLP
# making it longer format
gjg_long <- gjg %>% gather(DV, resp, "gen_OR","justice_OR")
# splitting data into gen and just motives
gjg_long<-gjg_long %>%
separate(DV, into= c("motive", "DV"), sep="_")
gjg_long$motive <- as.factor(gjg_long$motive)
# making a token for each word
tidy_treat <- gjg_long %>%
unnest_tokens(word, resp)
#removing stop words
tidy_treat <- tidy_treat %>%
anti_join(stop_words)
# word count sorted most to least frequent and by motive
tidy_treat %>%
dplyr::count(word, sort = TRUE) %>%
mutate(word = reorder(word, n)) %>%
slice_max(n = 10, order_by = n) %>%
ggplot(aes(word, n)) +
geom_col() +
xlab(NULL) +
coord_flip()
tidy_treat %>%
dplyr::count(motive, word, sort = TRUE) %>%
group_by(motive) %>%
mutate(rank = row_number()) %>%
filter(rank <= 10) %>%
ungroup() %>%
ggplot(aes(reorder(word, n), n, fill = motive)) +
geom_col(position = "dodge") +
xlab(NULL) +
coord_flip() +
facet_wrap(~ motive, scales = "free", ncol = 1)
tidy_treat %>%
dplyr::count(motive, word, sort = TRUE) %>%
pivot_wider(names_from = motive, values_from = n, values_fill = 0) %>%
mutate(difference = abs(`gen` - `justice`)) %>%
arrange(desc(difference)) %>%
slice_head(n = 10) %>%
ggplot(aes(reorder(word, difference), difference, fill = factor(`justice` > `gen`))) +
geom_col(position = "dodge") +
xlab(NULL) +
coord_flip()
tidy_treat %>%
anti_join(stop_words) %>%
dplyr::count(word) %>%
with(wordcloud(word, n, max.words = 100))
tidy_treat %>%
filter(tidy_treat$motive == "gen") %>%
anti_join(stop_words) %>%
dplyr::count(word) %>%
with(wordcloud(word, n, max.words = 100))
tidy_treat %>%
filter(tidy_treat$motive == "justice") %>%
anti_join(stop_words) %>%
dplyr::count(word) %>%
with(wordcloud(word, n, max.words = 100))
Sentiment Analysis
nrc <- get_sentiments("nrc")
sent_treat <- tidy_treat %>%
inner_join(nrc) %>%
group_by(motive, word) %>%
dplyr::count(word, sort = TRUE)
top_words_by_motive <- sent_treat %>%
group_by(motive) %>%
top_n(10, n) %>%
ungroup()
ggplot(top_words_by_motive, aes(reorder(word, n), n, fill = motive)) +
geom_col(position = "dodge") +
xlab(NULL) +
coord_flip() +
facet_wrap(~ motive, scales = "free", ncol = 1)
tidy_treat %>%
inner_join(get_sentiments("bing")) %>%
dplyr::count(motive, sentiment) %>%
spread(sentiment, n, fill = 0) %>%
mutate(sentiment = positive - negative)
## motive negative positive sentiment
## 1 gen 8 86 78
## 2 justice 40 60 20
tidy_treat %>%
filter(tidy_treat$motive == "gen") %>%
inner_join(get_sentiments("bing")) %>%
dplyr::count(word, sentiment, sort = TRUE) %>%
acast(word ~ sentiment, value.var = "n", fill = 0) %>%
comparison.cloud(colors = c("red", "green"),
max.words = 100)
tidy_treat %>%
filter(tidy_treat$motive == "justice") %>%
inner_join(get_sentiments("bing")) %>%
dplyr::count(word, sentiment, sort = TRUE) %>%
acast(word ~ sentiment, value.var = "n", fill = 0) %>%
comparison.cloud(colors = c("red", "green"),
max.words = 100)
