Abstract Moral Obligation Comparison
Marcus
5/16/2023
1 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",
"corrplot", "effects", "RColorBrewer"
)
# 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) 1.1 Load Data
# read in data files
gjg <-read.csv("/Users/mtrenfield17/Desktop/Research/Boston College Research/Morality Lab Research/Moral Obligation/Abstract Moral Obligation Comparison Study.csv")1.2 Functions
plot_cooker <- function(data, iv, dv, title) {
part1 <- ggplot(data, aes(x = {{iv}}, y = {{dv}}, fill = {{iv}})) +
geom_violin(alpha = 0.3, scale = "count") +
stat_summary(fun = "mean", geom = "point", size = 3, color = "black") +
stat_summary(fun.data = mean_cl_normal, geom = "errorbar", width = 0.2,
#change to make a data set from allEffects with mean, low CI, high CI
size = 1.5, color = "black") +
theme_classic() +
xlab("") +
ylab("") +
ggtitle(title)
ggpar(part1, legend = "none")
}
wrapped_plot_cooker <- function(data, iv, dv, title, facet_var) {
part1 <- ggplot(data, aes(x = {{iv}}, y = {{dv}}, fill = {{iv}})) +
geom_violin(alpha = 0.3, scale = "count") +
stat_summary(fun = "mean", geom = "point", size = 3, color = "black") +
stat_summary(fun.data = mean_cl_normal, geom = "errorbar", width = 0.2,
size = 1.5, color = "black", limits = c(0, 100)) +
theme_classic() +
xlab("") +
ylab("") +
ggtitle(title) +
facet_wrap(vars({{facet_var}}))
ggpar(part1, legend = "none")
}
by_line <- function(data, iv, dv, x_label, y_label, color_label, plot_title) {
ggplot(data, aes(x = {{iv}}, y = {{dv}}, color = DV)) +
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, 100) # Set the y-axis limits
}1.3 Reshaping Data
gjg <- gjg %>%
mutate(
most_obligated = as.character(most_obligated),
most_obligated_text = case_when(
most_obligated == "1" ~ "Outcome \n\ Severity",
most_obligated == "2" ~ "Capacity \n\ to help",
most_obligated == "3" ~ "Victim's \n\ past help",
most_obligated == "4" ~ "Prior \n\ Agreement",
most_obligated == "5" ~ "Married",
TRUE ~ most_obligated
),
most_obligated = as.numeric(most_obligated)
)
gjg$outcome_obl <- ifelse(!is.na(gjg$severity_obl_0_15), gjg$severity_obl_0_15,
ifelse(!is.na(gjg$severity_obl_100_15), gjg$severity_obl_100_15,
ifelse(!is.na(gjg$severity_obl_50_15), gjg$severity_obl_50_15, NA)))
gjg$capable_obl <- ifelse(!is.na(gjg$severity_obl_0_18), gjg$severity_obl_0_18,
ifelse(!is.na(gjg$severity_obl_100_18), gjg$severity_obl_100_18,
ifelse(!is.na(gjg$severity_obl_50_18), gjg$severity_obl_50_18, NA)))
gjg$helped_obl <- ifelse(!is.na(gjg$severity_obl_0_19), gjg$severity_obl_0_19,
ifelse(!is.na(gjg$severity_obl_100_19), gjg$severity_obl_100_19,
ifelse(!is.na(gjg$severity_obl_50_19), gjg$severity_obl_50_19, NA)))
gjg$agreement_obl <- ifelse(!is.na(gjg$severity_obl_0_20), gjg$severity_obl_0_20,
ifelse(!is.na(gjg$severity_obl_100_20), gjg$severity_obl_100_20,
ifelse(!is.na(gjg$severity_obl_50_20), gjg$severity_obl_50_20, NA)))
gjg$married_obl <- ifelse(!is.na(gjg$severity_obl_0_21), gjg$severity_obl_0_21,
ifelse(!is.na(gjg$severity_obl_100_21), gjg$severity_obl_100_21,
ifelse(!is.na(gjg$severity_obl_50_21), gjg$severity_obl_50_21, NA)))
#### make dataset long ####
gjg_long<-gjg %>% gather(DV, resp, "outcome_obl":"married_obl")
gjg_long <- gjg_long %>%
mutate(
DV = case_when(
DV == "outcome_obl" ~ "Outcome \n\ Severity",
DV == "capable_obl" ~ "Capacity \n\ to help",
DV == "helped_obl" ~ "Victim's \n\ past help",
DV == "agreement_obl" ~ "Prior \n\ Agreement",
DV == "married_obl" ~ "Married",
TRUE ~ DV
)
)
## renaming different slider starting point columns
gjg <- dplyr::rename(gjg, "severity_0" = "severity_obl_0_15", "severity_50" = "severity_obl_50_15", "severity_100" = "severity_obl_100_15", "capable_0" = "severity_obl_0_18", "capable_50" = "severity_obl_50_18", "capable_100" = "severity_obl_100_18", "helped_0" = "severity_obl_0_19", "helped_50" = "severity_obl_50_19", "helped_100" = "severity_obl_100_19", "agreement_0" = "severity_obl_0_20", "agreement_50" = "severity_obl_50_20", "agreement_100" = "severity_obl_100_20", "married_0" = "severity_obl_0_21", "married_50" = "severity_obl_50_21", "married_100" = "severity_obl_100_21")
gjg_slider_long<-gjg %>% gather(stim, resp, "severity_0":"married_100")
gjg_slider_long<-gjg_slider_long %>%
separate(stim, into= c("DV", "start_point"), sep="_")
view(gjg_slider_long)2 Demographics
# Subset your data frame to include only the demographic columns
demo_gjg <- gjg[, c("gender_text", "race_text", "income_text", "education_text", "political_overall_text")]
summary_table <- gjg %>%
summarize(
mean_age = mean(age, na.rm = TRUE),
sd_age = sd(age, na.rm = TRUE),
mean_political_social = mean(political_social, na.rm = TRUE),
sd_political_social = sd(political_social, na.rm = TRUE),
mean_political_economic = mean(political_economic, na.rm = TRUE),
sd_political_economic = sd(political_economic, na.rm = TRUE)
)
summary_table## mean_age sd_age mean_political_social sd_political_social
## 1 37.25628 12.85387 2.994975 1.625235
## mean_political_economic sd_political_economic
## 1 3.251256 1.725386# Loop through each demographic column and calculate frequency counts
freq_tables <- list()
for (col in names(demo_gjg)) {
{
freq_table <- as.data.frame(table(demo_gjg[[col]]))
freq_table$Percent <- round(freq_table$Freq / sum(freq_table$Freq) * 100, 2)
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 6 2.93
## 2 Man 96 46.83
## 3 Nonbinary person or Other 4 1.95
## 4 Prefer not to disclose 3 1.46
## 5 Woman 96 46.83
##
## Table of frequencies for race_text :
## Var1 Freq Percent
## 1 6 2.93
## 2 Asian 14 6.83
## 3 Asian,Native Hawaiian or Other Pacific Islander 1 0.49
## 4 Asian,White 4 1.95
## 5 Black or African American 21 10.24
## 6 Black or African American,White 3 1.46
## 7 Hispanic/Latino/a/x 12 5.85
## 8 Indigenous American or Alaskan Native 1 0.49
## 9 Indigenous American or Alaskan Native,Hispanic/Latino/a/x 2 0.98
## 10 Indigenous American or Alaskan Native,White,Hispanic/Latino/a/x 1 0.49
## 11 Other 1 0.49
## 12 Prefer not to disclose 4 1.95
## 13 White 129 62.93
## 14 White,Hispanic/Latino/a/x 6 2.93
##
## Table of frequencies for income_text :
## Var1 Freq Percent
## 1 6 2.93
## 2 < $10,000 10 4.88
## 3 >$150,000 14 6.83
## 4 $10,000 to $19,999 13 6.34
## 5 $100,000 to $149,999 24 11.71
## 6 $20,000 to $29,999 19 9.27
## 7 $30,000 to $39,999 24 11.71
## 8 $40,000 to $49,999 21 10.24
## 9 $50,000 to $74,999 43 20.98
## 10 $75,000 to $99,999 31 15.12
##
## 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 6 2.93
## 2 22 10.73
## 3 81 39.51
## 4 29 14.15
## 5 1 0.49
## 6 28 13.66
## 7 38 18.54
##
## Table of frequencies for political_overall_text :
## Var1 Freq Percent
## 1 7 3.41
## 2 Democrat 93 45.37
## 3 Independent 68 33.17
## 4 Republican 29 14.15
## 5 Something else 8 3.903 Correlation
DVs <- gjg[c("outcome_obl", "capable_obl", "helped_obl", "agreement_obl", "married_obl", "age", "political_social", "political_economic", "income", "education", "ses")]
# Compute pairwise correlations
corr_DVs <- cor(DVs, use = "complete.obs")
colnames(corr_DVs) <- c("outcome \n\ severity", "capacity \n\ to help", "Victim \n\ past help", "Prior \n\ agreement", "married", "age", "social \n\ leaning", "economic \n\ leaning", "income", "education", "ses")
rownames(corr_DVs) <- c("outcome \n\ severity", "capacity \n\ to help", "Victim \n\ past help", "Prior \n\ agreement", "married", "age", "social \n\ leaning", "economic \n\ leaning", "income", "education", "ses")
# Plot the correlation matrix
corrplot(corr_DVs, is.corr = TRUE, type = "full", method = "circle", tl.cex = 0.6, insig = "label_sig", diag = FALSE)
corrplot.mixed(corr_DVs, is.corr = TRUE, lower = 'circle', upper = 'number', insig = "label_sig")
4 Strongest Moral Obligation Plots
Which individual was most obligated to help Person A?
ggplot(data = gjg, aes(x = most_obligated_text)) +
geom_bar() +
labs(x = "Feature", y = "Frequency", title = "Most Obligated Frequency Plot")+
theme(plot.title = element_text(hjust = 0.5))
4.1 Signifigance
- Significantly more people select Married as most obligation driving feature)
# Create a contingency table
contingency_table <- table(gjg$most_obligated_text == "Married")
# Perform the chi-squared test
chisq.test(contingency_table)##
## Chi-squared test for given probabilities
##
## data: contingency_table
## X-squared = 9.68, df = 1, p-value = 0.0018634.2 Faceted by Gender
gjg_gender <- gjg %>% filter(gender_text == "Man" | gender_text == "Woman")
ggplot(data = gjg_gender, aes(x = most_obligated_text)) +
geom_bar() +
labs(x = "Feature", y = "Frequency", title = "Most Obligated Frequency Plot By Gender") +
facet_wrap(~ gender_text) + # Replace 'facet_variable' with the name of the variable you want to facet wrap
theme(plot.title = element_text(hjust = 0.5))
4.2.1 Signifigance (Not Significant)
# Subset data for men
men_data <- gjg[gjg$gender_text == "Man", ]
# Subset data for women
women_data <- gjg[gjg$gender_text == "Woman", ]
# Create a contingency table
contingency_table <- table(men_data$most_obligated_text == "Married", women_data$most_obligated_text == "Married")
# Perform the chi-squared test
chisq.test(contingency_table)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: contingency_table
## X-squared = 0.20385, df = 1, p-value = 0.65164.3 Faceted by Political Ideology
gjg_pol <- gjg %>% filter(political_overall_text == "Republican" | political_overall_text == "Independent" | political_overall_text == "Democrat")
ggplot(data = gjg_pol, aes(x = most_obligated_text)) +
geom_bar() +
labs(x = "Feature", y = "Frequency", title = "Most Obligated Frequency Plot By Political Identification") +
facet_wrap(~ political_overall_text) + # Replace 'facet_variable' with the name of the variable you want to facet wrap
theme(plot.title = element_text(hjust = 0.5))
5 Strength of Moral Obligation Plots
How strong of an obligation does the individual have to help Person A? (None at all to Extremely Strong)
plot_cooker(gjg_long, DV, resp, "Strength of Moral Obligation")
5.1 Significance
Capacity to help and Victim’s past help are significantly lower than outcome severity, prior agreement, and capacity to help
Outcome severity is significantly lower than marriage and prior agreement
gjg_long$DV <- as.factor(gjg_long$DV)
gjg_long$DV <- relevel(gjg_long$DV, ref = "Capacity \n\ to help")
mod_obligation_fit1 <- lmer(resp ~ DV + (1 | PID), data = gjg_long)
summary(mod_obligation_fit1)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ DV + (1 | PID)
## Data: gjg_long
##
## REML criterion at convergence: 9057.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3254 -0.5546 0.1023 0.6847 2.6421
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 135.3 11.63
## Residual 445.8 21.11
## Number of obs: 995, groups: PID, 199
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 52.015 1.709 813.513 30.439 <2e-16 ***
## DVMarried 30.025 2.117 792.000 14.186 <2e-16 ***
## DVOutcome \n Severity 18.965 2.117 792.000 8.960 <2e-16 ***
## DVPrior \n Agreement 26.447 2.117 792.000 12.495 <2e-16 ***
## DVVictim's \n past help 2.995 2.117 792.000 1.415 0.157
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) DVMrrd DVOtcS DVPrrA
## DVMarried -0.619
## DVOtcmSvrty -0.619 0.500
## DVPrrAgrmnt -0.619 0.500 0.500
## DVVctm'spsh -0.619 0.500 0.500 0.500gjg_long$DV <- relevel(gjg_long$DV, ref = "Married")
mod_obligation_fit2 <- lmer(resp ~ DV + (1 | PID), data = gjg_long)
summary(mod_obligation_fit2)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ DV + (1 | PID)
## Data: gjg_long
##
## REML criterion at convergence: 9057.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3254 -0.5546 0.1023 0.6847 2.6421
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 135.3 11.63
## Residual 445.8 21.11
## Number of obs: 995, groups: PID, 199
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 82.040 1.709 813.513 48.010 < 2e-16 ***
## DVCapacity \n to help -30.025 2.117 792.000 -14.186 < 2e-16 ***
## DVOutcome \n Severity -11.060 2.117 792.000 -5.225 2.22e-07 ***
## DVPrior \n Agreement -3.578 2.117 792.000 -1.690 0.0913 .
## DVVictim's \n past help -27.030 2.117 792.000 -12.771 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) DVCpth DVOtcS DVPrrA
## DVCpctythlp -0.619
## DVOtcmSvrty -0.619 0.500
## DVPrrAgrmnt -0.619 0.500 0.500
## DVVctm'spsh -0.619 0.500 0.500 0.500gjg_long$DV <- relevel(gjg_long$DV, ref = "Outcome \n Severity")
mod_obligation_fit3 <- lmer(resp ~ DV + (1 | PID), data = gjg_long)
summary(mod_obligation_fit3)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ DV + (1 | PID)
## Data: gjg_long
##
## REML criterion at convergence: 9057.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3254 -0.5546 0.1023 0.6847 2.6421
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 135.3 11.63
## Residual 445.8 21.11
## Number of obs: 995, groups: PID, 199
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 70.980 1.709 813.513 41.538 < 2e-16 ***
## DVMarried 11.060 2.117 792.000 5.225 2.22e-07 ***
## DVCapacity \n to help -18.965 2.117 792.000 -8.960 < 2e-16 ***
## DVPrior \n Agreement 7.482 2.117 792.000 3.535 0.000431 ***
## DVVictim's \n past help -15.970 2.117 792.000 -7.545 1.24e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) DVMrrd DVCpth DVPrrA
## DVMarried -0.619
## DVCpctythlp -0.619 0.500
## DVPrrAgrmnt -0.619 0.500 0.500
## DVVctm'spsh -0.619 0.500 0.500 0.5005.2 Faceted by Gender
gjg_long_gender <- gjg_long %>% filter(gender_text == "Man" | gender_text == "Woman")
wrapped_plot_cooker(gjg_long_gender, DV, resp, "Strength of Moral Obligation", gender_text)
5.2.1 Significance
- Women think outcome severity is a stronger driver of moral obligation than men
mod_gender_fit1 <- lmer(resp ~ gender_text + (1 | PID), data = gjg_long_gender)
summary(mod_gender_fit1)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ gender_text + (1 | PID)
## Data: gjg_long_gender
##
## REML criterion at convergence: 8958.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.7964 -0.6639 0.1250 0.7729 1.8328
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 100.8 10.04
## Residual 621.5 24.93
## Number of obs: 955, groups: PID, 191
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 68.1833 1.5314 189.0000 44.524 <2e-16 ***
## gender_textWoman -0.3181 2.1714 189.0000 -0.146 0.884
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## gndr_txtWmn -0.705mod_gender_fit2 <- lmer(resp ~ DV * gender_text + (1 | PID), data = gjg_long_gender)
summary(mod_gender_fit2)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ DV * gender_text + (1 | PID)
## Data: gjg_long_gender
##
## REML criterion at convergence: 8658.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.5064 -0.5403 0.1121 0.6674 2.7191
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 137.0 11.70
## Residual 440.8 20.99
## Number of obs: 955, groups: PID, 191
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 67.802 2.453 771.528 27.638
## DVMarried 14.917 3.030 756.000 4.923
## DVCapacity \n to help -13.594 3.030 756.000 -4.486
## DVPrior \n Agreement 11.844 3.030 756.000 3.908
## DVVictim's \n past help -11.260 3.030 756.000 -3.716
## gender_textWoman 6.661 3.478 771.528 1.915
## DVMarried:gender_textWoman -6.832 4.297 756.000 -1.590
## DVCapacity \n to help:gender_textWoman -9.490 4.297 756.000 -2.209
## DVPrior \n Agreement:gender_textWoman -9.275 4.297 756.000 -2.159
## DVVictim's \n past help:gender_textWoman -9.297 4.297 756.000 -2.164
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## DVMarried 1.05e-06 ***
## DVCapacity \n to help 8.39e-06 ***
## DVPrior \n Agreement 0.000101 ***
## DVVictim's \n past help 0.000217 ***
## gender_textWoman 0.055868 .
## DVMarried:gender_textWoman 0.112219
## DVCapacity \n to help:gender_textWoman 0.027490 *
## DVPrior \n Agreement:gender_textWoman 0.031188 *
## DVVictim's \n past help:gender_textWoman 0.030788 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) DVMrrd DVCpth DVPrrA DVVc'ph gndr_W DVM:_W DVCth: DVPA:_
## DVMarried -0.618
## DVCpctythlp -0.618 0.500
## DVPrrAgrmnt -0.618 0.500 0.500
## DVVctm'spsh -0.618 0.500 0.500 0.500
## gndr_txtWmn -0.705 0.436 0.436 0.436 0.436
## DVMrrd:gn_W 0.436 -0.705 -0.353 -0.353 -0.353 -0.618
## DVCthlp:g_W 0.436 -0.353 -0.705 -0.353 -0.353 -0.618 0.500
## DVPAgrmn:_W 0.436 -0.353 -0.353 -0.705 -0.353 -0.618 0.500 0.500
## DVVct'ph:_W 0.436 -0.353 -0.353 -0.353 -0.705 -0.618 0.500 0.500 0.5005.3 Faceted by Political Ideology
gjg_long_pol <- gjg_long %>% filter(political_overall_text == "Republican" | political_overall_text == "Independent" | political_overall_text == "Democrat")
wrapped_plot_cooker(gjg_long_pol, DV, resp, "Strength of Moral Obligation", political_overall_text)
5.4 Across Age
by_line(gjg_long, age, resp, "Age", "Strength of Obligation", "Feature", "Strength of Obligation Across Age")
5.5 Across Social Political Affiliation
by_line(gjg_long, income, resp, "How conservative are you in terms of social issues", "Strength of Obligation", "Feature", "Strength of Obligation Across Social Political Affiliation")
5.6 Across Economic Political Affiliation
by_line(gjg_long, political_economic, resp, "How conservative are you in terms of economic issues", "Strength of Obligation", "Feature", "Strength of Obligation Across Social Political Affiliation")
5.7 Across Income
by_line(gjg_long, income, resp, "Income", "Strength of Obligation", "Feature", "Strength of Obligation Across Social Political Affiliation")
5.8 Across education
by_line(gjg_long, education, resp, "Education", "Strength of Obligation", "Feature", "Strength of Obligation Across Age")
5.9 Across ses
by_line(gjg_long, ses, resp, "SES", "Strength of Obligation", "Feature", "Strength of Obligation Across Age")
5.10 Faceted by Slider starting point
gjg_slider_long$start_point <- factor(gjg_slider_long$start_point, levels = c("0", "50", "100"))
wrapped_plot_cooker(gjg_slider_long, DV, resp, "Strength of Moral Obligation", start_point)
5.10.1 Significance
- People whose sliders start at 100 view outcome severity as driving less obligation than those whose sliders start at 0.
## 0 as reference
gjg_slider_long$start_point <- relevel(gjg_slider_long$start_point, ref = "0")
mod_starting_point_fit1 <- lmer(resp ~ start_point + (1 | PID), data = gjg_slider_long)
summary(mod_starting_point_fit1)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ start_point + (1 | PID)
## Data: gjg_slider_long
##
## REML criterion at convergence: 9337.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.7993 -0.6716 0.1213 0.7803 1.7989
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 98.7 9.935
## Residual 628.3 25.067
## Number of obs: 995, groups: PID, 199
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 65.539 1.844 196.000 35.547 <2e-16 ***
## start_point50 2.961 2.607 196.000 1.135 0.258
## start_point100 3.505 2.598 196.000 1.349 0.179
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) str_50
## start_pnt50 -0.707
## strt_pnt100 -0.710 0.502mod_starting_point_fit2 <- lmer(resp ~ DV * start_point + (1 | PID), data = gjg_slider_long)
summary(mod_starting_point_fit2)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ DV * start_point + (1 | PID)
## Data: gjg_slider_long
##
## REML criterion at convergence: 9003.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3893 -0.5536 0.0908 0.6773 2.6571
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 135.1 11.62
## Residual 446.4 21.13
## Number of obs: 995, groups: PID, 199
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 72.455 2.968 806.007 24.410 < 2e-16 ***
## DVcapable -22.818 3.678 784.000 -6.204 8.90e-10 ***
## DVhelped -17.848 3.678 784.000 -4.853 1.47e-06 ***
## DVmarried 7.758 3.678 784.000 2.109 0.0352 *
## DVseverity -1.667 3.678 784.000 -0.453 0.6506
## start_point50 7.303 4.198 806.007 1.740 0.0823 .
## start_point100 10.650 4.182 806.007 2.547 0.0111 *
## DVcapable:start_point50 -3.924 5.201 784.000 -0.754 0.4508
## DVhelped:start_point50 -6.939 5.201 784.000 -1.334 0.1825
## DVmarried:start_point50 -5.621 5.201 784.000 -1.081 0.2802
## DVseverity:start_point50 -5.227 5.201 784.000 -1.005 0.3152
## DVcapable:start_point100 -6.913 5.182 784.000 -1.334 0.1826
## DVhelped:start_point100 -9.808 5.182 784.000 -1.893 0.0588 .
## DVmarried:start_point100 -6.877 5.182 784.000 -1.327 0.1849
## DVseverity:start_point100 -12.124 5.182 784.000 -2.340 0.0195 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1## 0 as reference
gjg_slider_long$start_point_fifty <- relevel(gjg_slider_long$start_point, ref = "50")
mod_starting_point_fit3 <- lmer(resp ~ start_point_fifty + (1 | PID), data = gjg_slider_long)
summary(mod_starting_point_fit3)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ start_point_fifty + (1 | PID)
## Data: gjg_slider_long
##
## REML criterion at convergence: 9337.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.7993 -0.6716 0.1213 0.7803 1.7989
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 98.7 9.935
## Residual 628.3 25.067
## Number of obs: 995, groups: PID, 199
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 68.5000 1.8438 196.0000 37.152 <2e-16 ***
## start_point_fifty0 -2.9606 2.6075 196.0000 -1.135 0.258
## start_point_fifty100 0.5448 2.5977 196.0000 0.210 0.834
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) str__0
## strt_pnt_f0 -0.707
## strt_pn_100 -0.710 0.502mod_starting_point_fit4 <- lmer(resp ~ DV * start_point_fifty + (1 | PID), data = gjg_slider_long)
summary(mod_starting_point_fit4)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp ~ DV * start_point_fifty + (1 | PID)
## Data: gjg_slider_long
##
## REML criterion at convergence: 9003.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3893 -0.5536 0.0908 0.6773 2.6571
##
## Random effects:
## Groups Name Variance Std.Dev.
## PID (Intercept) 135.1 11.62
## Residual 446.4 21.13
## Number of obs: 995, groups: PID, 199
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 79.758 2.968 806.007 26.870 < 2e-16
## DVcapable -26.742 3.678 784.000 -7.271 8.65e-13
## DVhelped -24.788 3.678 784.000 -6.740 3.08e-11
## DVmarried 2.136 3.678 784.000 0.581 0.5615
## DVseverity -6.894 3.678 784.000 -1.874 0.0612
## start_point_fifty0 -7.303 4.198 806.007 -1.740 0.0823
## start_point_fifty100 3.347 4.182 806.007 0.800 0.4238
## DVcapable:start_point_fifty0 3.924 5.201 784.000 0.754 0.4508
## DVhelped:start_point_fifty0 6.939 5.201 784.000 1.334 0.1825
## DVmarried:start_point_fifty0 5.621 5.201 784.000 1.081 0.2802
## DVseverity:start_point_fifty0 5.227 5.201 784.000 1.005 0.3152
## DVcapable:start_point_fifty100 -2.989 5.182 784.000 -0.577 0.5642
## DVhelped:start_point_fifty100 -2.869 5.182 784.000 -0.554 0.5800
## DVmarried:start_point_fifty100 -1.256 5.182 784.000 -0.242 0.8086
## DVseverity:start_point_fifty100 -6.897 5.182 784.000 -1.331 0.1836
##
## (Intercept) ***
## DVcapable ***
## DVhelped ***
## DVmarried
## DVseverity .
## start_point_fifty0 .
## start_point_fifty100
## DVcapable:start_point_fifty0
## DVhelped:start_point_fifty0
## DVmarried:start_point_fifty0
## DVseverity:start_point_fifty0
## DVcapable:start_point_fifty100
## DVhelped:start_point_fifty100
## DVmarried:start_point_fifty100
## DVseverity:start_point_fifty100
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1