IS Gambling Pilot (N = 200)

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", "qualtRics")

# 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

• remove participant who shows up twice (first time they accidentally said no to the consent)

# read in data files
setwd("~/Desktop")
data_raw <-read_survey("/Users/mtrenfield17/Desktop/Research/Boston College Research/SISC Lab Research/IS Project/Gambling/IS_Gambling_N200.csv")
# Remove rows where 'condition' is NA
data <- data_raw %>% filter(!is.na(condition))

Functions

plot_fn <- function(data, iv, dv, coln = NULL, rown = NULL, facet_var = NULL, facet_var2 = NULL, 
                    x_label = "", y_label = "", title = "", 
                    x_text_size = 13, y_text_size = 13, x_title_size = 13, y_title_size = 13, 
                    plot_title_size = 16, facet_text_size = 12) {
  
  # Create the base plot
  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") +
    theme_classic() +
    xlab(x_label) +
    ylab(y_label) +
    ggtitle(title) +
    theme(
      panel.background = element_rect(fill = "transparent"), 
      legend.position = "right", 
      plot.title = element_text(face = "bold", hjust = 0.5, size = plot_title_size), 
      plot.subtitle = element_text(hjust = 0.5),
      panel.grid.major.y = element_line(color='grey75'), 
      axis.text.x = element_text(face = "plain", size = x_text_size, color = "black"),
      axis.text.y = element_text(face = "plain", size = y_text_size, color = "black"),
      axis.title.x = element_text(face = "plain", size = x_title_size, color = "black"), 
      axis.title.y = element_text(face = "plain", size = y_title_size, color = "black", 
                                  margin = margin(t = 0, r = 10, b = 0, l = 0)),
      panel.border = element_rect(color = "black", fill = NA, size = 1),
      strip.text = element_text(size = facet_text_size)  # Adjust the facet text size
    )
  
  # Check if a facet_var (row) and facet_var2 (column) are provided
  if (!is.null(facet_var) & !is.null(facet_var2)) {
    # If both row and column variables are provided, use facet_grid
    part1 <- part1 + facet_grid(as.formula(paste(facet_var, "~", facet_var2)))
  } else if (!is.null(facet_var)) {
    # If only one facet variable is provided, facet by rows
    part1 <- part1 + facet_wrap(as.formula(paste("~", facet_var)), 
                                ncol = if (!is.null(coln)) coln else NULL, 
                                nrow = if (!is.null(rown)) rown else NULL, 
                                scales = "free", as.table = TRUE)
  }
  
  # Final plot adjustments
  ggpar(part1, legend = "none")
}

Reshaping data

# making conservative, liberal, and moderate group 
data <- data %>%
  mutate(political_group = ifelse(pol < 4, "Conservative",
                                  ifelse(pol > 4, "Liberal", "Moderate")))

# making a column for white vs non-white
data$White <- ifelse(grepl("White", data$race_TEXT), "White", "Non-White")

# making a column for URM vs non-URM
urm_groups <- c("Black", "Hispanic or Latino/a/x", "American Indian and Native Alaskan", "Pacific Islander or Native Hawaiian", "Middle Eastern and North African")

data$URM <- ifelse(grepl(paste(urm_groups, collapse="|"), data$race_TEXT), "URM", "Non-URM")

## changing condition to factor and reordering ##
data$condition <- as.factor(data$condition)
data$condition <- factor(data$condition, levels = c("individualScope", "populationScope"))

# changing numeric DVs to numeric
data <- data %>% mutate_at(vars(policyDV, donation, helpDV_1:blame_2, age, pol, pid, edu, inc, gambling, charityRealYN, `Duration (in seconds)`), as.numeric)

## renaming matrix variables
names(data)[names(data) == 'helpDV_1'] <-'usGovHelp'
names(data)[names(data) == 'helpDV_2'] <-'industryHelp'
names(data)[names(data) == 'helpDV_3'] <-'gamblerHelp'
names(data)[names(data) == 'helpDV_4'] <-'individualHelp'
names(data)[names(data) == 'helpDV_5'] <-'youHelp'

names(data)[names(data) == 'preventDV_1'] <-'usGovPrevent'
names(data)[names(data) == 'preventDV_2'] <-'industryPrevent'
names(data)[names(data) == 'preventDV_3'] <-'gamblerPrevent'
names(data)[names(data) == 'preventDV_4'] <-'individualPrevent'
names(data)[names(data) == 'preventDV_5'] <-'youPrevent'

names(data)[names(data) == 'blame_1'] <-'industryBlame'
names(data)[names(data) == 'blame_2'] <-'individualBlame'

# making a gambling binary variable
data <- data %>%
  mutate(gambling_binary = ifelse(gambling > 1, "Never gamble",
                                  ifelse(gambling == 1, "Gamble", "Not Found")))

# reordering demos
data <- data %>%
  mutate(
    Gender_TEXT = factor(gen_TEXT, levels = c("Man", "Woman", "I identify as:")),
    pol_TEXT = factor(pol_TEXT, levels = c("Very Liberal", "Liberal", "Somewhat Liberal", "Moderate",
    "Somewhat Conservative", "Conservative", "Very Conservative")),
    edu_TEXT = factor(edu_TEXT, levels = c("Some schooling, but no high school diploma or degree", 
    "High school diploma or GED", "Some college, Technical degree, or Associates degree", 
    "Bachelor's degree", "Graduate degree (Masters, PhD, etc)")),
    inc_TEXT = factor(inc_TEXT, levels = c("less than $25,000", "$25,000 - $49,999", "$50,000 - $74,999", 
    "$75,000 - $99,999", "$100,000 - $149,999", "$150,000 - $199,999","more than $200,000")),
    political_group = factor(political_group, levels = c("Liberal", "Moderate", "Conservative")),
    White = factor(White, levels = c("White", "Non-White")),
    URM = factor(URM, levels = c("Non-URM", "URM")),
    gambling_TEXT = factor(gambling_TEXT, levels = c("Not at all", "A few times a year", "Once a month", 
    "A few times a month", "Once a week or more")),
    gambling_binary = factor(gambling_binary, levels = c("Never gamble", "Gamble", "Not Found")),
  )

Data Quality

Charity Belief

ggplot(data, aes(x = condition, y = charityRealYN)) +
  geom_violin() +
  geom_boxplot(width=0.1, fill="white") +
  theme_minimal() +
  labs(y = "Not at all to Extremely", x = "Condition", title = "Extent Participants Doubted the Charity was real")

Demographics

# Subset your data frame to include only the demographic columns
demo_data <- data[, c("gambling_TEXT", "gen_TEXT", "race_TEXT", "inc_TEXT", "edu_TEXT", "pol_TEXT", "pid_TEXT", "area_TEXT", "political_group", "White", "URM", "gambling_binary")]

# Age
mean(data$age, na.rm=TRUE)

[1] 37.67539

sd(data$age, na.rm=TRUE)

[1] 11.61892

# Loop through each demographic column and calculate frequency counts
freq_tables <- list()

for (col in names(demo_data)) {
  {
    freq_table <- as.data.frame(table(demo_data[[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 gambling_TEXT :
                 Var1 Freq Percent
1          Not at all  101   53.16
2  A few times a year   63   33.16
3        Once a month    7    3.68
4 A few times a month   11    5.79
5 Once a week or more    8    4.21

Table of frequencies for gen_TEXT :
            Var1 Freq Percent
1 I identify as:    1    0.52
2            Man   97   50.79
3          Woman   93   48.69

Table of frequencies for race_TEXT :
                                       Var1 Freq Percent
1        American Indian and Native Alaskan    1    0.52
2  American Indian and Native Alaskan,White    2    1.05
3                                     Black   22   11.52
4                                East Asian    6    3.14
5                East Asian,Southeast Asian    1    0.52
6                          East Asian,White    1    0.52
7                    Hispanic or Latino/a/x    8    4.19
8              Hispanic or Latino/a/x,White    3    1.57
9          Middle Eastern and North African    2    1.05
10   Middle Eastern and North African,White    3    1.57
11                              South Asian    4    2.09
12                          Southeast Asian    3    1.57
13                    Southeast Asian,White    1    0.52
14                                    White  134   70.16

Table of frequencies for inc_TEXT :
                 Var1 Freq Percent
1   less than $25,000   28   14.66
2   $25,000 - $49,999   36   18.85
3   $50,000 - $74,999   50   26.18
4   $75,000 - $99,999   32   16.75
5 $100,000 - $149,999   20   10.47
6 $150,000 - $199,999   13    6.81
7  more than $200,000   12    6.28

Table of frequencies for edu_TEXT :
                                                  Var1 Freq Percent
1 Some schooling, but no high school diploma or degree    2    1.05
2                           High school diploma or GED   32   16.75
3 Some college, Technical degree, or Associates degree   59   30.89
4                                    Bachelor's degree   71   37.17
5                  Graduate degree (Masters, PhD, etc)   27   14.14

Table of frequencies for pol_TEXT :
                   Var1 Freq Percent
1          Very Liberal   32   16.75
2               Liberal   36   18.85
3      Somewhat Liberal   28   14.66
4              Moderate   44   23.04
5 Somewhat Conservative   24   12.57
6          Conservative   19    9.95
7     Very Conservative    8    4.19

Table of frequencies for pid_TEXT :
                 Var1 Freq Percent
1            Democrat   85   44.50
2 Independent / Other   63   32.98
3          Republican   43   22.51

Table of frequencies for area_TEXT :
      Var1 Freq Percent
1    Rural   35   18.32
2 Suburban  101   52.88
3    Urban   55   28.80

Table of frequencies for political_group :
          Var1 Freq Percent
1      Liberal   96   50.26
2     Moderate   44   23.04
3 Conservative   51   26.70

Table of frequencies for White :
       Var1 Freq Percent
1     White  144   75.39
2 Non-White   47   24.61

Table of frequencies for URM :
     Var1 Freq Percent
1 Non-URM  150   78.53
2     URM   41   21.47

Table of frequencies for gambling_binary :
          Var1 Freq Percent
1 Never gamble   89   46.84
2       Gamble  101   53.16
3    Not Found    0    0.00

Demographic Plot

# List of demographic columns to plot
demographic_columns <- c("gambling_TEXT", "gambling_binary", "gen_TEXT", "race_TEXT", "inc_TEXT", "edu_TEXT", "pol_TEXT", "pid_TEXT", "area_TEXT", "political_group", "White", "URM")

# Function to create percent plot
create_percent_plot <- function(data, column) {
  # Calculate the frequency and percentage for each category
  freq_table <- data %>%
    group_by(across(all_of(column))) %>%
    dplyr::summarise(Freq = n()) %>%
    mutate(Percent = Freq / sum(Freq) * 100)
  
  # Create the plot
  p <- ggplot(freq_table, aes_string(x = column, y = "Percent", fill = column)) +
    geom_bar(stat = "identity", position = "dodge") +
    scale_y_continuous(labels = scales::percent_format(scale = 1)) +
    labs(x = column, y = "Percentage", title = paste("Distribution of", column)) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  return(p)
}

# Loop through demographic columns and plot
plots <- lapply(demographic_columns, function(col) create_percent_plot(demo_data, col))

# Display the plots
print(plots)

[[1]]

[[2]]

[[3]]

[[4]]

[[5]]

[[6]]

[[7]]

[[8]]

[[9]]

[[10]]

[[11]]

[[12]]

Correlations

DVs <- data[c("policyDV", "donation", "usGovHelp", "industryHelp", "gamblerHelp", "individualHelp", "youHelp", "usGovPrevent", "industryPrevent", "gamblerPrevent", "individualPrevent", "youPrevent", "individualBlame", "industryBlame", "pol", "edu", "inc", "age", "gambling")]

# 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)

Behavioral Outcomes

data$condition <- factor(data$condition, levels = c("individualScope", "populationScope", "mergedScope"))

percep_plot_list <- list(plot_fn(data, condition, donation),
                         plot_fn(data, condition, policyDV))

# Adding titles to each plot
percep_plot_list[[1]] <- percep_plot_list[[1]] +
  ggtitle("Donations")
  
percep_plot_list[[2]] <- percep_plot_list[[2]] +
  ggtitle("Support for Policy")

percep_plot_arranged <- ggarrange(plotlist = percep_plot_list, ncol = 2, nrow = 1)

overall_percep_title <- ggdraw() +
  draw_label("Behavioral DVs", fontface = "bold")

plot_grid(overall_percep_title, percep_plot_arranged, ncol = 1, rel_heights = c(0.1, 0.9))

data %>%
  group_by(condition) %>%
  dplyr::summarise(mean(policyDV))

# A tibble: 2 × 2
  condition       `mean(policyDV)`
  <fct>                      <dbl>
1 individualScope             4.02
2 populationScope             4.30

data %>%
  group_by(condition) %>%
  dplyr::summarise(mean(donation))

# A tibble: 2 × 2
  condition       `mean(donation)`
  <fct>                      <dbl>
1 individualScope             4.02
2 populationScope             2.59

Inferential Stats

data$condition <- relevel(data$condition, ref = "individualScope")

mod_donation<- lm(donation ~ condition, data = data)
summary(mod_donation)

Call:
lm(formula = donation ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-4.0211 -2.5938 -0.5938  1.4062  7.4062 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                4.0211     0.3293  12.211  < 2e-16 ***
conditionpopulationScope  -1.4273     0.4645  -3.073  0.00243 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 3.21 on 189 degrees of freedom
Multiple R-squared:  0.04758,   Adjusted R-squared:  0.04254 
F-statistic: 9.442 on 1 and 189 DF,  p-value: 0.002434

mod_donation_pol <- lm(donation ~ condition*pol, data = data)
summary(mod_donation_pol)

Call:
lm(formula = donation ~ condition * pol, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-4.9018 -2.4823 -0.7471  1.6037  8.0811 

Coefficients:
                             Estimate Std. Error t value Pr(>|t|)   
(Intercept)                    2.3880     0.8641   2.763  0.00629 **
conditionpopulationScope       1.5026     1.3159   1.142  0.25497   
pol                            0.3591     0.1760   2.040  0.04272 * 
conditionpopulationScope:pol  -0.6408     0.2692  -2.380  0.01831 * 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 3.176 on 187 degrees of freedom
Multiple R-squared:  0.07755,   Adjusted R-squared:  0.06275 
F-statistic:  5.24 on 3 and 187 DF,  p-value: 0.001706

mod_policy<- lm(policyDV ~ condition, data = data)
summary(mod_policy)

Call:
lm(formula = policyDV ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.3021 -2.0211 -0.0211  1.6979  2.9789 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                4.0211     0.2058  19.542   <2e-16 ***
conditionpopulationScope   0.2810     0.2902   0.968    0.334    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 2.006 on 189 degrees of freedom
Multiple R-squared:  0.004936,  Adjusted R-squared:  -0.0003287 
F-statistic: 0.9376 on 1 and 189 DF,  p-value: 0.3341

mod_policy_pol<- lm(policyDV ~ condition*pol, data = data)
summary(mod_policy_pol)

Call:
lm(formula = policyDV ~ condition * pol, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.4352 -1.8702 -0.1679  1.8321  3.3375 

Coefficients:
                             Estimate Std. Error t value Pr(>|t|)    
(Intercept)                    3.5614     0.5432   6.557 5.22e-10 ***
conditionpopulationScope       1.7549     0.8272   2.122   0.0352 *  
pol                            0.1011     0.1106   0.914   0.3621    
conditionpopulationScope:pol  -0.3214     0.1692  -1.899   0.0591 .  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.996 on 187 degrees of freedom
Multiple R-squared:  0.02472,   Adjusted R-squared:  0.009076 
F-statistic:  1.58 on 3 and 187 DF,  p-value: 0.1957

Faceted by political orientation

plot_fn(data, condition, donation, coln = 3, rown = 2, "political_group", title = "Amount Donated", x_text_size = 13, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

plot_fn(data, condition, policyDV, coln = 3, rown = 2, "political_group", title = "Policy Support", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Faceted by Gender

# Create the genderMF column that retains only "Man" and "Woman" values
data <- data %>%
  mutate(genderMF = ifelse(gen_TEXT %in% c("Man", "Woman"), gen_TEXT, NA))

plot_fn(data %>% filter(!is.na(genderMF)), condition, donation, coln = 3, rown = 2, "genderMF", title = "Amount Donated", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

plot_fn(data %>% filter(!is.na(genderMF)), condition, policyDV, coln = 3, rown = 2, "genderMF", title = "Policy Support", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Faceted by gambling history

plot_fn(data %>% filter(!is.na(gambling_binary)), condition, donation, coln = 3, rown = 2, "gambling_binary", title = "Amount Donated", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

plot_fn(data %>% filter(!is.na(gambling_binary)), condition, policyDV, coln = 3, rown = 2, "gambling_binary", title = "Policy Support", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Responsibility to help victims

data_long<-data %>% gather(stim, resp, "usGovHelp":"individualBlame")  

data_long$condition <- factor(data_long$condition, levels = c("individualScope", "populationScope"))

responsibilityHelpLong <- data_long %>%
  filter(grepl("Help", stim))

plot_fn(responsibilityHelpLong, condition, resp, coln = 3, rown = 5, "stim", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Inferential Stats

mod_usGovHelp <- lm(usGovHelp ~ condition, data = data)
summary(mod_usGovHelp)

Call:
lm(formula = usGovHelp ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-2.4421 -1.3125 -0.3125  0.6875  1.6875 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                3.4421     0.1297  26.538   <2e-16 ***
conditionpopulationScope  -0.1296     0.1830  -0.708     0.48    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.264 on 189 degrees of freedom
Multiple R-squared:  0.002648,  Adjusted R-squared:  -0.002629 
F-statistic: 0.5019 on 1 and 189 DF,  p-value: 0.4796

mod_manufacturerHelp <- lm(industryHelp ~ condition, data = data)
summary(mod_manufacturerHelp)

Call:
lm(formula = industryHelp ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.1146 -0.9684  0.8854  0.8854  1.0316 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                3.9684     0.1255  31.629   <2e-16 ***
conditionpopulationScope   0.1462     0.1770   0.826     0.41    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.223 on 189 degrees of freedom
Multiple R-squared:  0.003596,  Adjusted R-squared:  -0.001676 
F-statistic: 0.6821 on 1 and 189 DF,  p-value: 0.4099

mod_gamblerHelp <- lm(gamblerHelp ~ condition, data = data)
summary(mod_gamblerHelp)

Call:
lm(formula = gamblerHelp ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-2.8316 -0.8316  0.1684  1.1684  1.3958 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                3.8316     0.1254  30.559   <2e-16 ***
conditionpopulationScope  -0.2274     0.1769  -1.286      0.2    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.222 on 189 degrees of freedom
Multiple R-squared:  0.008673,  Adjusted R-squared:  0.003428 
F-statistic: 1.653 on 1 and 189 DF,  p-value: 0.2001

mod_individualHelp <- lm(individualHelp ~ condition, data = data)
summary(mod_individualHelp)

Call:
lm(formula = individualHelp ~ condition, data = data)

Residuals:
     Min       1Q   Median       3Q      Max 
-2.02105 -0.93750 -0.02105  0.97895  2.06250 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)               3.02105    0.12917  23.388   <2e-16 ***
conditionpopulationScope -0.08355    0.18220  -0.459    0.647    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.259 on 189 degrees of freedom
Multiple R-squared:  0.001111,  Adjusted R-squared:  -0.004174 
F-statistic: 0.2103 on 1 and 189 DF,  p-value: 0.6471

mod_youHelp <- lm(youHelp ~ condition, data = data)
summary(mod_youHelp)

Call:
lm(formula = youHelp ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-1.3263 -1.3229 -0.3229  0.6771  2.6771 

Coefficients:
                          Estimate Std. Error t value Pr(>|t|)    
(Intercept)               2.326316   0.130520  17.823   <2e-16 ***
conditionpopulationScope -0.003399   0.184102  -0.018    0.985    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.272 on 189 degrees of freedom
Multiple R-squared:  1.804e-06, Adjusted R-squared:  -0.005289 
F-statistic: 0.0003409 on 1 and 189 DF,  p-value: 0.9853

Faceted by political orientation

plot_fn(responsibilityHelpLong, condition, resp, coln = 3, rown = 5, "political_group", "stim", x_text_size = 10, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Faceted by Gender

plot_fn(responsibilityHelpLong %>% filter(!is.na(genderMF)), condition, resp, coln = 3, rown = 5, "genderMF", "stim", x_text_size = 10, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Faceted by gambling history

plot_fn(responsibilityHelpLong %>% filter(!is.na(gambling_binary)), condition, resp, coln = 3, rown = 5, "gambling_binary", "stim", x_text_size = 10, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Responsibility to prevent harm

responsibilityPreventLong <- data_long %>%
  filter(grepl("Prevent", stim))

plot_fn(responsibilityPreventLong, condition, resp, coln = 3, rown = 5, "stim", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Inferential Stats

mod_usGovPrevent <- lm(usGovPrevent ~ condition, data = data)
summary(mod_usGovPrevent)

Call:
lm(formula = usGovPrevent ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-2.4583 -0.4583 -0.4000  1.0708  1.6000 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)               3.40000    0.12766  26.632   <2e-16 ***
conditionpopulationScope  0.05833    0.18007   0.324    0.746    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.244 on 189 degrees of freedom
Multiple R-squared:  0.0005549, Adjusted R-squared:  -0.004733 
F-statistic: 0.1049 on 1 and 189 DF,  p-value: 0.7463

mod_manufacturerPrevent <- lm(industryPrevent ~ condition, data = data)
summary(mod_manufacturerPrevent)

Call:
lm(formula = industryPrevent ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.1458 -0.1458  0.8542  0.8542  0.9053 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                4.0947     0.1180  34.694   <2e-16 ***
conditionpopulationScope   0.0511     0.1665   0.307    0.759    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.15 on 189 degrees of freedom
Multiple R-squared:  0.0004982, Adjusted R-squared:  -0.00479 
F-statistic: 0.09421 on 1 and 189 DF,  p-value: 0.7592

mod_gamblerPrevent <- lm(gamblerPrevent ~ condition, data = data)
summary(mod_gamblerPrevent)

Call:
lm(formula = gamblerPrevent ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-2.8526 -0.7812  0.2188  1.1474  1.2188 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)               3.85263    0.12406  31.055   <2e-16 ***
conditionpopulationScope -0.07138    0.17499  -0.408    0.684    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.209 on 189 degrees of freedom
Multiple R-squared:  0.0008796, Adjusted R-squared:  -0.004407 
F-statistic: 0.1664 on 1 and 189 DF,  p-value: 0.6838

mod_individualPrevent <- lm(individualPrevent ~ condition, data = data)
summary(mod_individualPrevent)

Call:
lm(formula = individualPrevent ~ condition, data = data)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.97895 -0.97895  0.02105  1.09375  2.09375 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                2.9790     0.1392   21.39   <2e-16 ***
conditionpopulationScope  -0.0727     0.1964   -0.37    0.712    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.357 on 189 degrees of freedom
Multiple R-squared:  0.0007244, Adjusted R-squared:  -0.004563 
F-statistic: 0.137 on 1 and 189 DF,  p-value: 0.7117

mod_youPrevent <- lm(youPrevent ~ condition, data = data)
summary(mod_youPrevent)

Call:
lm(formula = youPrevent ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-1.3684 -1.3333 -0.3333  0.6667  2.6667 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)               2.36842    0.13463  17.592   <2e-16 ***
conditionpopulationScope -0.03509    0.18990  -0.185    0.854    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.312 on 189 degrees of freedom
Multiple R-squared:  0.0001806, Adjusted R-squared:  -0.005109 
F-statistic: 0.03414 on 1 and 189 DF,  p-value: 0.8536

Faceted by political orientation

plot_fn(responsibilityPreventLong, condition, resp, coln = 3, rown = 5, "political_group", "stim", x_text_size = 10, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Faceted by Gender

plot_fn(responsibilityPreventLong %>% filter(!is.na(genderMF)), condition, resp, coln = 3, rown = 5, "genderMF", "stim", x_text_size = 10, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Faceted by gambling history

plot_fn(responsibilityPreventLong %>% filter(!is.na(gambling_binary)), condition, resp, coln = 3, rown = 5, "gambling_binary", "stim", x_text_size = 10, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Blame

blameLong <- data_long %>%
  filter(grepl("Blame", stim))

plot_fn(blameLong, condition, resp, coln = 3, rown = 5, "stim", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Inferential Stats

mod_manufacturerBlame <- lm(industryBlame ~ condition, data = data)
summary(mod_manufacturerBlame)

Call:
lm(formula = industryBlame ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.0417 -0.6842  0.3158  0.9583  1.3158 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                3.6842     0.1167  31.581   <2e-16 ***
conditionpopulationScope   0.3575     0.1646   2.172   0.0311 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.137 on 189 degrees of freedom
Multiple R-squared:  0.02436,   Adjusted R-squared:  0.0192 
F-statistic: 4.719 on 1 and 189 DF,  p-value: 0.03108

mod_indBlame <- lm(individualBlame ~ condition, data = data)
summary(mod_indBlame)

Call:
lm(formula = individualBlame ~ condition, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-2.5895 -0.5895  0.4105  0.6771  1.6771 

Coefficients:
                         Estimate Std. Error t value Pr(>|t|)    
(Intercept)                3.5895     0.1180  30.421   <2e-16 ***
conditionpopulationScope  -0.2666     0.1664  -1.602    0.111    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.15 on 189 degrees of freedom
Multiple R-squared:  0.01339,   Adjusted R-squared:  0.00817 
F-statistic: 2.565 on 1 and 189 DF,  p-value: 0.1109

##Faceted by political orientation

plot_fn(blameLong, condition, resp, coln = 3, rown = 5, "political_group", "stim", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Faceted by Gender

plot_fn(blameLong %>% filter(!is.na(genderMF)), condition, resp, coln = 3, rown = 5, "genderMF", "stim", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Faceted by gambling history

plot_fn(blameLong %>% filter(!is.na(gambling_binary)), condition, resp, coln = 3, rown = 5, "gambling_binary", "stim", x_text_size = 15, y_text_size = 20, plot_title_size = 25, facet_text_size = 18)

Bonus

bonus_data <- data %>% filter(Finished == 1, consent == 8)
bonus_data <- bonus_data %>%
  dplyr::select(PROLIFIC_PID, donation)

# view(bonus_data)
winners_bonus_data <- bonus_data[seq(20, nrow(bonus_data), 20), ]

# write.csv(winners_bonus_data, "BONUS_IS_gambling.csv", row.names = FALSE)