Generosity Vs Justice Pilot 3
Marcus + Lizy + Nadia
6/12/2023
1 Overview & Methodology
- Study of third party forced-choice judgments of donors motivated by a justice or generosity virtue
- Data collected June 12, 2023
- N = 200
2 Key Findings
- Participants think justice-motivated donors are less moral, but more motivated by norm signaling desires
3 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", "RColorBrewer",
"RcmdrMisc")
# 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) 3.1 Load Data
# read in data files
gjg <-read.csv("/Users/mtrenfield17/Desktop/Research/Boston College Research/Morality Lab Research/Generosity Vs Justice Project/just_vs_gen_v3/Generosity vs Justice V3_Numeric (1).csv")3.2 Reshaping data
# Function to rename columns
rename_columns <- function(data, old_suffix, new_suffix) {
data %>% rename_with(~ gsub(paste0(old_suffix, "$"), new_suffix, .), ends_with(old_suffix))
}
gjg <- rename_columns(gjg, "_1", "_just")
gjg <- rename_columns(gjg, "_2", "_gen")
# changing appropriate DVs to numeric
gjg <- gjg %>% mutate_at(vars(age, income, ses, political_social, political_economic, attn_self, pid), as.numeric)4 Attention check
# filtering out failures/nonresponses to attention checks
length(gjg$pid)
gjg <- gjg %>%
filter(!is.na(attn_bucket), attn_self>2)
length(gjg$pid)4 participants failed the attention check.
5 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_text", "race_text", "income_text", "education_text", "political_party_text")]
# descriptive stats for numeric demos
describeBy(numeric_demos)## vars n mean sd median trimmed mad min max range
## age 1 201 41.18 14.67 38 40.12 16.31 19 81 62
## income 2 201 5.24 2.22 6 5.27 2.97 1 9 8
## ses 3 200 4.80 1.77 5 4.83 1.48 1 10 9
## political_social 4 201 3.09 1.84 3 2.94 1.48 1 7 6
## political_economic 5 201 3.49 1.83 3 3.40 1.48 1 7 6
## skew kurtosis se
## age 0.53 -0.71 1.03
## income -0.18 -0.97 0.16
## ses 0.04 -0.45 0.13
## political_social 0.55 -0.90 0.13
## political_economic 0.33 -0.98 0.13## 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_text :
## Var1 Freq Percent
## 1 Man 99 49.25
## 2 Nonbinary person or Other 4 1.99
## 3 Prefer not to disclose 1 0.50
## 4 Woman 97 48.26
##
## Table of frequencies for race_text :
## Var1
## 1
## 2 Asian
## 3 Asian,Native Hawaiian or Other Pacific Islander,White
## 4 Asian,White
## 5 Black or African American
## 6 Black or African American,Hispanic/Latino/a/x
## 7 Black or African American,White
## 8 Hispanic/Latino/a/x
## 9 Indigenous American or Alaskan Native
## 10 Indigenous American or Alaskan Native,Black or African American,White,Hispanic/Latino/a/x
## 11 Indigenous American or Alaskan Native,White
## 12 Prefer not to disclose
## 13 White
## 14 White,Hispanic/Latino/a/x
## Freq Percent
## 1 1 0.50
## 2 16 7.96
## 3 1 0.50
## 4 4 1.99
## 5 13 6.47
## 6 1 0.50
## 7 4 1.99
## 8 14 6.97
## 9 2 1.00
## 10 1 0.50
## 11 1 0.50
## 12 2 1.00
## 13 135 67.16
## 14 6 2.99
##
## Table of frequencies for income_text :
## Var1 Freq Percent
## 1 < $10,000 9 4.48
## 2 >$150,000 14 6.97
## 3 $10,000 to $19,999 20 9.95
## 4 $100,000 to $149,999 17 8.46
## 5 $20,000 to $29,999 25 12.44
## 6 $30,000 to $39,999 20 9.95
## 7 $40,000 to $49,999 23 11.44
## 8 $50,000 to $74,999 38 18.91
## 9 $75,000 to $99,999 35 17.41
##
## Table of frequencies for education_text :
## 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 0.50
## 2 17 8.46
## 3 76 37.81
## 4 32 15.92
## 5 3 1.49
## 6 22 10.95
## 7 50 24.88
##
## Table of frequencies for political_party_text :
## Var1 Freq Percent
## 1 1 0.50
## 2 Democrat 102 50.75
## 3 Independent 48 23.88
## 4 Republican 46 22.89
## 5 Something else 4 1.99# 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"))6 Correlation
DVs <- gjg[c("reputation_signal_just","reputation_signal_gen","norm_signal_just","norm_signal_gen","approval_just","approval_gen","moral_just","moral_gen","genuine_just","genuine_gen","deliberate_just","deliberate_gen","spontaneous_just","spontaneous_gen","emotion_just","emotion_gen","logic_just","logic_gen","quick_just","quick_gen","slow_just","slow_gen","warm_just","warm_gen","good.natured_just","good.natured_gen","tolerant_just","tolerant_gen","sincere_just","sincere_gen","competent_just","competent_gen","confident_just","confident_gen", "independent_just","independent_gen","competitive_just","competitive_gen","intelligent_just","intelligent_gen","age", "gender", "income", "education", "ses", "political_overall", "political_social", "political_economic")]
# Compute pairwise correlations
corr_DVs <- cor(DVs, use = "complete.obs")
# Plot the correlation matrix
corrplot(corr_DVs, is.corr = TRUE, type = "lower", lower = "circle", tl.cex = 0.7, insig = "label_sig", diag = TRUE)
# New columns for composite of warmth and competence
gjg <- gjg %>%
mutate(warmth_just=(warm_just+good.natured_just+tolerant_just+sincere_just)/4)%>%
mutate(warmth_gen=(warm_gen+good.natured_gen+tolerant_gen+sincere_gen)/4)%>%
mutate(competence_just=(competent_just+confident_just+independent_just+competitive_just+
intelligent_just)/5)%>%
mutate(competence_gen=(competent_gen+confident_gen+independent_gen+competitive_gen+
intelligent_gen)/5)
# DVs 2
DVs_2 <- gjg[c("reputation_signal_just","reputation_signal_gen","norm_signal_just","norm_signal_gen","approval_just","approval_gen","moral_just","moral_gen","genuine_just","genuine_gen","deliberate_just","deliberate_gen","spontaneous_just","spontaneous_gen","emotion_just","emotion_gen","logic_just","logic_gen","quick_just","quick_gen","slow_just","slow_gen","warmth_just","warmth_gen","competence_just","competence_gen","age", "gender", "income", "education", "ses", "political_overall", "political_social", "political_economic")]
# Compute pairwise correlations
corr_DVs_2 <- cor(DVs_2, use = "complete.obs")
# Plot the correlation matrix
corrplot(corr_DVs_2, is.corr = TRUE, type = "lower", lower = "circle", tl.cex = 0.7, insig = "label_sig", diag = TRUE)
7 Changing to long format
#renaming DVs with underscores in name
gjg <- gjg %>%
dplyr::rename("reputationSignal_just"="reputation_signal_just",
"reputationSignal_gen"="reputation_signal_gen",
"normSignal_just"="norm_signal_just",
"normSignal_gen"="norm_signal_gen")
gjg_long<-gjg %>% gather(DV, resp, "reputationSignal_just","reputationSignal_gen","normSignal_just","normSignal_gen","approval_just","approval_gen","moral_just","moral_gen","genuine_just","genuine_gen","deliberate_just","deliberate_gen","spontaneous_just","spontaneous_gen","emotion_just","emotion_gen","logic_just","logic_gen","quick_just","quick_gen","slow_just","slow_gen","warm_just","warm_gen","good.natured_just","good.natured_gen","tolerant_just","tolerant_gen","sincere_just","sincere_gen","competent_just","competent_gen","confident_just","confident_gen", "independent_just","independent_gen","competitive_just","competitive_gen","intelligent_just","intelligent_gen","warmth_just","warmth_gen","competence_just","competence_gen")
# splitting data into gen and just motives
gjg_long<-gjg_long %>%
separate(DV, into= c("DV", "motive"), sep="_")
gjg_long <- spread(gjg_long, DV, resp)8 Linear Mixed Effects
Norm signaling, approval, and genuine are significant.
plot_cooker <- function(dv, iv, Title, x_axis_labs, y_label, sample_size) {
part1 <- ggviolin(gjg_long, x = dv, y = iv, color = dv,
alpha = 0.1, fill = dv, xlab = "Motive",
trim = TRUE, ylab = y_label) +
stat_summary(fun.data = "mean_cl_normal", geom = "crossbar", fatten = 1) +
scale_y_continuous(breaks = c(1:5)) +
labs(title = paste0(Title, " (n = ", sample_size, ")")) +
scale_x_discrete(labels = x_axis_labs) +
theme(panel.background = element_rect(fill = "transparent"),
legend.position = "right", ## Consider “gray97” for fill
plot.title = element_text(face = "bold", hjust = 0.5, size = 16),
plot.subtitle = element_text(hjust = 0.5),
panel.grid.major.y = element_line(color='grey75'),
axis.text.x = element_text(face = "plain", size = 13, color = "black"),
axis.text.y = element_text(face = "plain", size = 13, color = "black"),
axis.title.y = element_text(face = "plain", size = 13, color = "black",
margin = margin(t = 0, r = 10, b = 0, l = 0)), ## lower X axis title
panel.border = element_rect(color = "black", fill = NA, size = 1))
ggpar(part1, legend = "none")
}
# mixed effects model
gjg_long$motive <- as.factor(gjg_long$motive)
mod_reputationSignaling <- lmer(reputationSignal ~ motive + (1 | pid), data = gjg_long)
summary(mod_reputationSignaling)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: reputationSignal ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1346.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.8945 -0.5469 -0.1688 0.4642 2.1898
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.8256 0.9086
## Residual 1.0197 1.0098
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.54726 0.09582 333.28710 26.585 <2e-16 ***
## motivejust 0.12438 0.10073 200.00000 1.235 0.218
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.526percep_plot_list <- list(plot_cooker("motive", "reputationSignal", "Reputation Signal", c("generosity","justice")," ", 201),plot_cooker("motive", "normSignal", "Norm Signal", c("generosity", "justice")," ", 201),plot_cooker("motive", "approval", "Approval", c("generosity", "justice")," ", 201),plot_cooker("motive", "moral", "Moral", c("generosity", "justice")," ", 201),plot_cooker("motive", "genuine", "Genuine", c("generosity", "justice")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 2, nrow = 3)
overall_percep_title <- ggdraw() +
draw_label("Perception DVs", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_reputationSignaling <- lmer(reputationSignal ~ motive + (1 | pid), data = gjg_long)
summary(mod_reputationSignaling)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: reputationSignal ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1346.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.8945 -0.5469 -0.1688 0.4642 2.1898
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.8256 0.9086
## Residual 1.0197 1.0098
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.54726 0.09582 333.28710 26.585 <2e-16 ***
## motivejust 0.12438 0.10073 200.00000 1.235 0.218
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.526mod_normSignaling <- lmer(normSignal ~ motive + (1 | pid), data = gjg_long)
summary(mod_normSignaling)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: normSignal ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1294.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.4438 -0.6374 0.1001 0.6681 2.1252
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.8193 0.9052
## Residual 0.8466 0.9201
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.32836 0.09104 322.09122 36.560 <2e-16 ***
## motivejust 0.20398 0.09178 200.00000 2.222 0.0274 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.504mod_approval <- lmer(approval ~ motive + (1 | pid), data = gjg_long)
summary(mod_approval)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: approval ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 946.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.0199 -0.3459 0.1692 0.4894 2.6180
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3928 0.6267
## Residual 0.3305 0.5749
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.45274 0.05998 308.90013 74.23 < 2e-16 ***
## motivejust -0.18408 0.05734 200.00000 -3.21 0.00155 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.478mod_moral <- lmer(moral ~ motive + (1 | pid), data = gjg_long)
summary(mod_moral)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: moral ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 966.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.97928 -0.42580 0.03548 0.49676 2.42391
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.4568 0.6759
## Residual 0.3280 0.5727
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.14925 0.06249 298.77978 66.403 <2e-16 ***
## motivejust -0.09453 0.05713 200.00000 -1.655 0.0996 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.457mod_genuine <- lmer(genuine ~ motive + (1 | pid), data = gjg_long)
summary(mod_genuine)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: genuine ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1099.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3541 -0.4489 0.1009 0.6724 2.1343
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3770 0.6140
## Residual 0.5895 0.7678
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.17413 0.06934 347.18168 60.196 < 2e-16 ***
## motivejust -0.21393 0.07659 200.00000 -2.793 0.00572 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.552Spontaneous, emotion, logic, and quick are significant.
percep_plot_list <- list(plot_cooker("motive", "deliberate", "Deliberate", c("generosity","justice")," ", 201),plot_cooker("motive", "spontaneous", "Spontaneous", c("generosity", "justice")," ", 201),plot_cooker("motive", "emotion", "Emotion", c("generosity", "justice")," ", 201),plot_cooker("motive", "logic", "Logic", c("generosity", "justice")," ", 201),plot_cooker("motive", "quick", "Quick", c("generosity", "justice")," ",201),plot_cooker("motive","slow","Slow",c("generosity","justice")," ",201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 2, nrow = 3)
overall_percep_title <- ggdraw() +
draw_label("Deliberation DVs", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_deliberate <- lmer(deliberate ~ motive + (1 | pid), data = gjg_long)
summary(mod_deliberate)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: deliberate ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1069.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.4634 -0.4225 0.3062 0.4121 2.5125
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.5717 0.7561
## Residual 0.4326 0.6577
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.10448 0.07069 302.09643 58.067 <2e-16 ***
## motivejust 0.06965 0.06561 200.00000 1.062 0.29
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.464mod_spontaneous <- lmer(spontaneous ~ motive + (1 | pid), data = gjg_long)
summary(mod_spontaneous)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: spontaneous ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1245.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.35543 -0.36357 -0.01238 0.27494 2.55412
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 1.0525 1.0259
## Residual 0.6073 0.7793
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.74129 0.09087 285.28516 30.17 <2e-16 ***
## motivejust -0.17413 0.07773 200.00000 -2.24 0.0262 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.428mod_emotion <- lmer(emotion ~ motive + (1 | pid), data = gjg_long)
summary(mod_emotion)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: emotion ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1172.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.83489 -0.59726 0.02718 0.65162 1.84076
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3162 0.5624
## Residual 0.7989 0.8938
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.88557 0.07448 370.22428 52.166 <2e-16 ***
## motivejust -0.17910 0.08916 200.00000 -2.009 0.0459 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.599mod_logic <- lmer(logic ~ motive + (1 | pid), data = gjg_long)
summary(mod_logic)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: logic ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1214.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.25712 -0.49372 0.04447 0.50993 1.80787
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.5559 0.7456
## Residual 0.7551 0.8690
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.24876 0.08076 339.04116 40.227 < 2e-16 ***
## motivejust 0.46766 0.08668 200.00000 5.395 1.92e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.537mod_quick <- lmer(quick ~ motive + (1 | pid), data = gjg_long)
summary(mod_quick)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: quick ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1098.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.5466 -0.3862 0.1003 0.3566 2.7471
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.9283 0.9635
## Residual 0.3566 0.5972
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.09453 0.07995 262.81725 38.704 <2e-16 ***
## motivejust -0.12935 0.05957 200.00000 -2.172 0.0311 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.373mod_slow <- lmer(slow ~ motive + (1 | pid), data = gjg_long)
summary(mod_slow)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: slow ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1012.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.94809 -0.31076 -0.06818 0.21421 3.09412
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.9053 0.9515
## Residual 0.2498 0.4998
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.18905 0.07581 247.79317 28.877 <2e-16 ***
## motivejust 0.01990 0.04986 200.00000 0.399 0.69
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.329Warmth and competence are both significant.
percep_plot_list <- list(plot_cooker("motive", "warmth", "Warmth", c("generosity","justice")," ", 201),plot_cooker("motive", "competence", "Competence", c("generosity", "justice")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 2, nrow = 1)
overall_percep_title <- ggdraw() +
draw_label("Warmth/Competence DVs", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_warmth <- lmer(warmth ~ motive + (1 | pid), data = gjg_long)
summary(mod_warmth)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: warmth ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 883.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.0710 -0.4375 0.1283 0.4617 2.3800
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3256 0.5706
## Residual 0.2870 0.5358
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.97139 0.05521 311.89620 71.934 < 2e-16 ***
## motivejust -0.23259 0.05344 200.00000 -4.352 2.15e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.484mod_competence <- lmer(competence ~ motive + (1 | pid), data = gjg_long)
summary(mod_competence)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: competence ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 586.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.1594 -0.3487 -0.0003 0.3146 2.7393
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.32485 0.5700
## Residual 0.08322 0.2885
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.59303 0.04506 244.84192 79.742 < 2e-16 ***
## motivejust 0.10050 0.02878 200.00000 3.492 0.000589 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.319Warm, good-natured, tolerant, and sincere are all significant.
percep_plot_list <- list(plot_cooker("motive", "warm", "Warm", c("generosity","justice")," ", 201),plot_cooker("motive", "good.natured", "Good-Natured", c("generosity", "justice")," ", 201),plot_cooker("motive", "tolerant", "Tolerant", c("generosity", "justice")," ", 201),plot_cooker("motive", "sincere", "Sincere", c("generosity", "justice")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 2, nrow = 2)
overall_percep_title <- ggdraw() +
draw_label("Warmth DVs", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_warm <- lmer(warm ~ motive + (1 | pid), data = gjg_long)
summary(mod_warm)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: warm ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1152.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.32109 -0.60741 -0.00574 0.61600 1.79374
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3450 0.5874
## Residual 0.7292 0.8539
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.87065 0.07311 362.59505 52.946 < 2e-16 ***
## motivejust -0.29353 0.08518 200.00000 -3.446 0.000693 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.583mod_good.natured <- lmer(good.natured ~ motive + (1 | pid), data = gjg_long)
summary(mod_good.natured)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: good.natured ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1079.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.0841 -0.4147 0.1710 0.5874 1.9360
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3589 0.5991
## Residual 0.5613 0.7492
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.09950 0.06766 347.18605 60.586 < 2e-16 ***
## motivejust -0.23881 0.07474 200.00000 -3.195 0.00162 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.552mod_tolerant <- lmer(tolerant ~ motive + (1 | pid), data = gjg_long)
summary(mod_tolerant)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: tolerant ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1097.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.14912 -0.43738 0.07267 0.58272 2.49697
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.451 0.6716
## Residual 0.544 0.7375
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.72139 0.07036 331.81836 52.893 <2e-16 ***
## motivejust -0.16418 0.07357 200.00000 -2.232 0.0268 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.523mod_sincere <- lmer(sincere ~ motive + (1 | pid), data = gjg_long)
summary(mod_sincere)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: sincere ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1080.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.1312 -0.2444 0.1064 0.7178 1.8139
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3328 0.5769
## Residual 0.5800 0.7616
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.19403 0.06739 353.07595 62.236 < 2e-16 ***
## motivejust -0.23383 0.07597 200.00000 -3.078 0.00238 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.564Only competitive is significant.
percep_plot_list <- list(plot_cooker("motive", "competent", "Competent", c("generosity","justice")," ", 201),plot_cooker("motive", "confident", "Confident", c("generosity", "justice")," ", 201),plot_cooker("motive", "independent", "Independent", c("generosity", "justice")," ", 201),plot_cooker("motive", "competitive", "Competitive", c("generosity", "justice")," ", 201),plot_cooker("motive", "intelligent", "Intelligent", c("generosity", "justice")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 2, nrow = 3)
overall_percep_title <- ggdraw() +
draw_label("Competence DVs", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_competent <- lmer(competent ~ motive + (1 | pid), data = gjg_long)
summary(mod_competent)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: competent ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 903.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.6243 -0.1952 0.1144 0.2368 4.0466
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.6273 0.7920
## Residual 0.2039 0.4516
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.97512 0.06431 254.85233 61.816 <2e-16 ***
## motivejust -0.08458 0.04504 200.00000 -1.878 0.0619 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.350mod_confident <- lmer(confident ~ motive + (1 | pid), data = gjg_long)
summary(mod_confident)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: confident ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 949.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.2072 -0.2382 0.1074 0.4530 2.8994
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.604 0.7772
## Residual 0.256 0.5059
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.90050 0.06541 267.86348 59.631 <2e-16 ***
## motivejust 0.08955 0.05047 200.00001 1.774 0.0775 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.386mod_independent <- lmer(independent ~ motive + (1 | pid), data = gjg_long)
summary(mod_independent)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: independent ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1025.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6450 -0.4156 0.1441 0.5079 3.0097
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.6321 0.7951
## Residual 0.3409 0.5839
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.81592 0.06958 281.28967 54.845 <2e-16 ***
## motivejust 0.11443 0.05824 200.00000 1.965 0.0508 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.419mod_competitive <- lmer(competitive ~ motive + (1 | pid), data = gjg_long)
summary(mod_competitive)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: competitive ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1236.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.4400 -0.4876 -0.1022 0.3281 2.6659
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.7082 0.8416
## Residual 0.7319 0.8555
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.53234 0.08465 322.09904 29.917 < 2e-16 ***
## motivejust 0.36816 0.08534 200.00000 4.314 2.52e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.504mod_intelligent <- lmer(intelligent ~ motive + (1 | pid), data = gjg_long)
summary(mod_intelligent)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: intelligent ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 844.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.7772 -0.2395 0.0556 0.3507 3.6304
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.6016 0.7756
## Residual 0.1624 0.4030
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.74129 0.06165 246.90139 60.684 <2e-16 ***
## motivejust 0.01493 0.04020 200.00000 0.371 0.711
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.326by_line <- function(data, iv, dv, x_label, y_label, color_label, plot_title) {
ggplot(data, aes(x = {{iv}}, y = {{dv}}, color = motive)) +
stat_summary(fun.data = "mean_cl_normal", geom = "line") +
geom_point(position = position_jitter(width = 0.1, height = 0.1), alpha = 0.2) +
labs(x = x_label, y = y_label, color = color_label, title = plot_title) +
ylim(0, 5) # Set the y-axis limits
}
by_line(gjg_long,political_overall,reputationSignal,"political leaning (1=liberal, 7=conservative)","","motive","Reputation Signaling")
by_line(gjg_long,political_overall,warmth,"political leaning (1=liberal, 7=conservative)","","motive","Warmth")
by_line(gjg_long,political_overall,competence,"political leaning (1=liberal, 7=conservative)","","motive","Competence")
by_line(gjg_long,political_overall,competitive,"political leaning (1=liberal, 7=conservative)","","motive","Competitive")
by_line(gjg_long,political_overall,normSignal,"political leaning (1=liberal, 7=conservative)","","motive","Norm Signaling")
by_line(gjg_long,political_overall,approval,"political leaning (1=liberal, 7=conservative)","","motive","Approval")
by_line(gjg_long,political_overall,genuine,"political leaning (1=liberal, 7=conservative)","","motive","Genuine")
by_line(gjg_long,political_overall,spontaneous,"political leaning (1=liberal, 7=conservative)","","motive","Spontaneous")
by_line(gjg_long,political_overall,emotion,"political leaning (1=liberal, 7=conservative)","","motive","Emotion")
by_line(gjg_long,political_overall,logic,"political leaning (1=liberal, 7=conservative)","","motive","Logic")
by_line(gjg_long,political_overall,quick,"political leaning (1=liberal, 7=conservative)","","motive","Quick")
9 Factor Analyses
9.1 Running Factor Analysis for Generosity, 5 factor
#deleting unrelated columns
gjg_long2 <- gjg_long[, ! names(gjg_long) %in% c("consent","attn_bucket","gender_text","race_text","income_text","education_text","political_party_text","political_party_4_TEXT","openFeedback","confusion","attn_self","polit_comp","pid","age","gender","race","income","education","ses","political_party","political_overall","political_social","political_economic","warmth","competence")]
#generous factor analysis
gjg_long_gen <- subset(gjg_long2, motive != "just")
gjg_long_gen <- gjg_long_gen[, ! names(gjg_long_gen) %in% c("motive")]
which(is.na(gjg_long_gen), arr.ind = TRUE)
str(gjg_long_gen)
gjg_long_gen<-as.data.frame(gjg_long_gen)
gjg_long_gen<-na.omit(gjg_long_gen)
#evaluating correlation matrix
write.csv(cor(gjg_long_gen)>0.8, file="Suspect_Correlations.csv")
write.csv(cor(gjg_long_gen), file="Correlation_Values.csv")
#KMO test
KMO(gjg_long_gen)
cortest.bartlett(gjg_long_gen)
#reject the null
ev <- eigen(cor(gjg_long_gen))
ev$values
scree(gjg_long_gen, pc=FALSE)
fa.parallel(gjg_long_gen, fa="fa")
Nfacs <- 5
fit <- factanal(gjg_long_gen, Nfacs, rotation="promax")
print(fit, digits=2, cutoff=0.3, sort=TRUE)
loads <- fit$loadings
fa.diagram(loads)
9.2 Running Factor Analysis for Justice, 4 factor
gjg_long_just <- subset(gjg_long2, motive != "gen")
gjg_long_just <- gjg_long_just[, ! names(gjg_long_just) %in% c("motive")]
which(is.na(gjg_long_just), arr.ind = TRUE)
str(gjg_long_just)
gjg_long_just<-as.data.frame(gjg_long_just)
gjg_long_just<-na.omit(gjg_long_just)
#evaluating correlation matrix
write.csv(cor(gjg_long_just)>0.8, file="Suspect_Correlations.csv")
write.csv(cor(gjg_long_just), file="Correlation_Values.csv")
#KMO test
KMO(gjg_long_just)
cortest.bartlett(gjg_long_just)
#reject the null
ev <- eigen(cor(gjg_long_just))
ev$values
scree(gjg_long_just, pc=FALSE)
fa.parallel(gjg_long_just, fa="fa")
Nfacs <- 4
fit <- factanal(gjg_long_just, Nfacs, rotation="promax")
print(fit, digits=2, cutoff=0.3, sort=TRUE)
loads <- fit$loadings
fa.diagram(loads)
9.3 Running Factor Analysis for Liberals, 4 factor
#deleting unrelated columns
gjg_long3 <- gjg_long[, ! names(gjg_long) %in% c("consent","attn_bucket","gender_text","race_text","income_text","education_text","political_party_text","political_party_4_TEXT","openFeedback","confusion","attn_self","polit_comp","pid","age","gender","race","income","education","ses","political_party","political_social","political_economic","warmth","competence","motive")]
#median split
median(gjg_long3$political_overall)
gjg_long3 <- gjg_long3[order(gjg_long3$political_overall),]
med <- median(gjg_long3$political_overall)
liberals <- gjg_long3[1:round(nrow(gjg_long3)/2),]
conservatives <- gjg_long3[round((nrow(gjg_long3)/2)+1):nrow(gjg_long3),]
liberals <- liberals[, ! names(liberals) %in%
c("political_overall")]
write.csv(cor(liberals)>0.8, file="Suspect_Correlations.csv")
write.csv(cor(liberals), file="Correlation_Values.csv")
#KMO test
KMO(liberals)
cortest.bartlett(liberals)
#reject the null
ev <- eigen(cor(liberals))
ev$values
scree(liberals, pc=FALSE)
fa.parallel(liberals, fa="fa")
Nfacs <- 4
fit <- factanal(liberals, Nfacs, rotation="promax")
print(fit, digits=2, cutoff=0.3, sort=TRUE)
loads <- fit$loadings
fa.diagram(loads)
9.4 Running Factor Analysis for Conservatives, 5 factor
conservatives <- conservatives[, ! names(conservatives) %in%
c("political_overall")]
write.csv(cor(conservatives)>0.8, file="Suspect_Correlations.csv")
write.csv(cor(conservatives), file="Correlation_Values.csv")
#KMO test
KMO(conservatives)
cortest.bartlett(conservatives)
#reject the null
ev <- eigen(cor(conservatives))
ev$values
scree(conservatives, pc=FALSE)
fa.parallel(conservatives, fa="fa")
Nfacs <- 5
fit <- factanal(conservatives, Nfacs, rotation="promax")
print(fit, digits=2, cutoff=0.3, sort=TRUE)
loads <- fit$loadings
fa.diagram(loads)
9.5 Running Factor Analysis Overall, 6 factor
#deleting unrelated columns
gjg_long4 <- gjg_long[, ! names(gjg_long) %in% c("consent","attn_bucket","gender_text","race_text","income_text","education_text","political_party_text","political_party_4_TEXT","openFeedback","confusion","attn_self","polit_comp","pid","age","gender","race","income","education","ses","political_party","political_social","political_economic","warmth","competence","motive","political_overall")]
write.csv(cor(gjg_long4)>0.8, file="Suspect_Correlations.csv")
write.csv(cor(gjg_long4), file="Correlation_Values.csv")
#KMO test
KMO(gjg_long4)
cortest.bartlett(gjg_long4)
#reject the null
ev <- eigen(cor(gjg_long4))
ev$values
scree(gjg_long4, pc=FALSE)
fa.parallel(gjg_long4, fa="fa")
Nfacs <- 6
fit <- factanal(gjg_long4, Nfacs, rotation="promax")
print(fit, digits=2, cutoff=0.3, sort=TRUE)
#diagram
loads <- fit$loadings
fa.diagram(loads)
10 Linear Mixed Effects for 6 Factors
#new columns for Factor 2-competence (plus logic, minus competitive), Factor 3-moral goodness (approval, moral, genuine), Factor 5-decision speed (quick, spontaneous)
gjg <- gjg %>%
mutate(competence2_just=(competent_just+confident_just+independent_just+logic_just+
logic_just)/5)%>%
mutate(competence2_gen=(competent_gen+confident_gen+independent_gen+logic_gen+
intelligent_gen)/5)%>%
mutate(moralGoodness_just=(approval_just+moral_just+genuine_just)/3)%>%
mutate(moralGoodness_gen=(approval_gen+moral_gen+genuine_gen)/3)%>%
mutate(decisionSpeed_just=(quick_just+spontaneous_just)/2)%>%
mutate(decisionSpeed_gen=(quick_gen+spontaneous_gen)/2)
gjg_long<-gjg %>% gather(DV, resp, "reputationSignal_just","reputationSignal_gen","normSignal_just","normSignal_gen","approval_just","approval_gen","moral_just","moral_gen","genuine_just","genuine_gen","deliberate_just","deliberate_gen","spontaneous_just","spontaneous_gen","emotion_just","emotion_gen","logic_just","logic_gen","quick_just","quick_gen","slow_just","slow_gen","warm_just","warm_gen","good.natured_just","good.natured_gen","tolerant_just","tolerant_gen","sincere_just","sincere_gen","competent_just","competent_gen","confident_just","confident_gen", "independent_just","independent_gen","competitive_just","competitive_gen","intelligent_just","intelligent_gen","warmth_just","warmth_gen","competence_just","competence_gen","competence2_just","competence2_gen","moralGoodness_just","moralGoodness_gen","decisionSpeed_just","decisionSpeed_gen")
# splitting data into gen and just motives
gjg_long<-gjg_long %>%
separate(DV, into= c("DV", "motive"), sep="_")
gjg_long <- spread(gjg_long, DV, resp) 10.1 Mixed Effects Model Warmth (Factor 1)
Generous donors are perceived to be significantly more warm than just donors.
percep_plot_list <- list(plot_cooker("motive", "warmth", "Warmth", c("justice","generosity")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 1, nrow = 1)
overall_percep_title <- ggdraw() +
draw_label("Factor 1 (Warmth)", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_warmth <- lmer(warmth ~ motive + (1 | pid), data = gjg_long)
summary(mod_warmth)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: warmth ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 883.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.0710 -0.4375 0.1283 0.4617 2.3800
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3256 0.5706
## Residual 0.2870 0.5358
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.97139 0.05521 311.89620 71.934 < 2e-16 ***
## motivejust -0.23259 0.05344 200.00000 -4.352 2.15e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.48410.2 Mixed Effects Model Competence (Factor 2)
Just donors are perceived to be significantly more competent than generous donors.
percep_plot_list <- list(plot_cooker("motive", "competence2", "Competence", c("justice","generosity")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 1, nrow = 1)
overall_percep_title <- ggdraw() +
draw_label("Factor 2 (Competence)", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_competence2 <- lmer(competence2 ~ motive + (1 | pid), data = gjg_long)
summary(mod_competence2)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: competence2 ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 747.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.42275 -0.44138 0.02851 0.49200 2.42917
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3763 0.6134
## Residual 0.1513 0.3890
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.73632 0.05124 265.14274 72.923 < 2e-16 ***
## motivejust 0.11244 0.03881 200.00000 2.897 0.00418 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.37910.3 Mixed Effects Model Moral Goodness (Factor 3)
Generous donors are perceived to be significantly more morally good than just donors.
percep_plot_list <- list(plot_cooker("motive", "moralGoodness", "Moral Goodness", c("justice","generosity")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 1, nrow = 1)
overall_percep_title <- ggdraw() +
draw_label("Factor 3 (Moral Goodness)", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_moralGoodness <- lmer(moralGoodness ~ motive + (1 | pid), data = gjg_long)
summary(mod_moralGoodness)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: moralGoodness ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 871.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.0527 -0.3645 0.1478 0.4533 2.2228
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.2938 0.5420
## Residual 0.2890 0.5375
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.25871 0.05384 318.94454 79.095 <2e-16 ***
## motivejust -0.16418 0.05362 200.00000 -3.062 0.0025 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.49810.4 Mixed Effects Model Reputation Signaling (Factor 4)
No significant findings.
percep_plot_list <- list(plot_cooker("motive", "reputationSignal", "Reputation Signaling", c("justice","generosity")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 1, nrow = 1)
overall_percep_title <- ggdraw() +
draw_label("Factor 4 (Reputation Signaling)", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_reputationSignal <- lmer(reputationSignal ~ motive + (1 | pid), data = gjg_long)
summary(mod_reputationSignal)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: reputationSignal ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1346.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.8945 -0.5469 -0.1688 0.4642 2.1898
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.8256 0.9086
## Residual 1.0197 1.0098
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.54726 0.09582 333.28710 26.585 <2e-16 ***
## motivejust 0.12438 0.10073 200.00000 1.235 0.218
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.52610.5 Mixed Effects Model Norm Signaling
Just donors are perceived to be engaging significantly more in norm signaling than just donors.
percep_plot_list <- list(plot_cooker("motive", "normSignal", "Norm Signaling", c("justice","generosity")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 1, nrow = 1)
overall_percep_title <- ggdraw() +
draw_label("Norm Signaling", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_normSignal <- lmer(normSignal ~ motive + (1 | pid), data = gjg_long)
summary(mod_normSignal)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: normSignal ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1294.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.4438 -0.6374 0.1001 0.6681 2.1252
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.8193 0.9052
## Residual 0.8466 0.9201
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.32836 0.09104 322.09122 36.560 <2e-16 ***
## motivejust 0.20398 0.09178 200.00000 2.222 0.0274 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.50410.6 Mixed Effects Model Decision Speed (Factor 5)
Generous donors are perceived to make decisions significantly more quickly/spontaneously than just donors.
percep_plot_list <- list(plot_cooker("motive", "decisionSpeed", "Decision Speed", c("justice","generosity")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 1, nrow = 1)
overall_percep_title <- ggdraw() +
draw_label("Factor 5 (Decision Speed)", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_decisionSpeed <- lmer(decisionSpeed ~ motive + (1 | pid), data = gjg_long)
summary(mod_decisionSpeed)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: decisionSpeed ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1043.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.00864 -0.40950 -0.08841 0.32965 3.00097
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.7920 0.8899
## Residual 0.3153 0.5615
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.91791 0.07422 264.62588 39.314 < 2e-16 ***
## motivejust -0.15174 0.05601 200.00001 -2.709 0.00733 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.37710.7 Mixed Effects Model Emotion (Factor 6)
Generous donors are perceived to make decisions significantly more from emotion than just donors.
percep_plot_list <- list(plot_cooker("motive", "emotion", "Emotion", c("justice","generosity")," ", 201))
percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 1, nrow = 1)
overall_percep_title <- ggdraw() +
draw_label("Factor 6 (Emotion)", fontface = "bold")
plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))
mod_emotion <- lmer(emotion ~ motive + (1 | pid), data = gjg_long)
summary(mod_emotion)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: emotion ~ motive + (1 | pid)
## Data: gjg_long
##
## REML criterion at convergence: 1172.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.83489 -0.59726 0.02718 0.65162 1.84076
##
## Random effects:
## Groups Name Variance Std.Dev.
## pid (Intercept) 0.3162 0.5624
## Residual 0.7989 0.8938
## Number of obs: 402, groups: pid, 201
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.88557 0.07448 370.22428 52.166 <2e-16 ***
## motivejust -0.17910 0.08916 200.00000 -2.009 0.0459 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## motivejust -0.599