Exercise - HSS-231-24-R

Introduction

Hamas’s violent conflict with Israel over Palestinian territories has recently escalated. This study examines how Israeli civilians’ perceptions of Hamas’s competence influence discriminatory behaviors. According to the Stereotype Content Model (Cuddy et al., 2008), warmth and competence predict emotional and behavioral responses toward outgroups. In conflict, outgroups are seen as low-warmth; perceived competence leads to contempt (low competence) or anger (high competence). Anger involves attacking the outgroup, while contempt entails exclusion and derogation (Fischer & Giner-Sorolla, 2016). Supporting violent and non violent actions, as well as calling Hamas terrorist is relevant to agressive attack strategies consistent with anger - in contrast, using humor and expecting Hamas to fail in the future is relevant to contempt reactions associated to feelings of ingroup superiority.

We hypothesize that perceiving Hamas as competent will elicit anger, whereas perceiving Hamas as low in competence will elicit contempt. We derive the following predictions:

• Manipulating a perception of Hamas as highly competent will increase support for action against Hamas
• Manipulating a perception of Hamas as highly competent will increase labeling Hamas as “terrorists.”
• Manipulating a perception of Hamas as not competent will increase the use of controversial humor to legitimize ingroup superiority
• Manipulating a perception of Hamas as not competent will increase expectations of outgroup failure.

This document presents the registered analyses for this fictitious study

---

if (!require(psych)) install.packages("psych")
if (!require(ggplot2)) install.packages("ggplot2")
if (!require(MASS)) install.packages("MASS")
if (!require(TOSTER)) install.packages("TOSTER")
if (!require(boot)) install.packages("boot")
if (!require(sfsmisc)) install.packages("sfsmisc")
if (!require(effectsize)) install.packages("effectsize")
if (!require(dplyr)) install.packages("dplyr")
if (!require(tidyr)) install.packages("tidyr")
if (!require(kableExtra)) install.packages("kableExtra")
if (!require(robustbase)) install.packages("robustbase")

My environment

I use R version 4.2.2 on macOS 14.5. Full details can be expanded below.

Show/Hide my R environment

sessionInfo()

## R version 4.2.2 (2022-10-31)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS 14.5
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] robustbase_0.99-2 kableExtra_1.4.0  tidyr_1.3.1       dplyr_1.1.4      
##  [5] effectsize_0.8.9  sfsmisc_1.1-17    boot_1.3-30       TOSTER_0.8.3     
##  [9] MASS_7.3-60.0.1   ggplot2_3.5.1     psych_2.4.1      
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.12          svglite_2.1.3        mvtnorm_1.2-4       
##  [4] lattice_0.22-5       zoo_1.8-12           digest_0.6.34       
##  [7] utf8_1.2.4           R6_2.5.1             evaluate_0.23       
## [10] coda_0.19-4.1        pillar_1.9.0         rlang_1.1.4         
## [13] multcomp_1.4-25      rstudioapi_0.15.0    jquerylib_0.1.4     
## [16] Matrix_1.6-5         rmarkdown_2.25       splines_4.2.2       
## [19] stringr_1.5.1        munsell_0.5.1        compiler_4.2.2      
## [22] xfun_0.42            systemfonts_1.0.5    pkgconfig_2.0.3     
## [25] parameters_0.22.0    mnormt_2.1.1         htmltools_0.5.7     
## [28] insight_0.20.1       tidyselect_1.2.1     tibble_3.2.1        
## [31] codetools_0.2-19     viridisLite_0.4.2    fansi_1.0.6         
## [34] withr_3.0.0          ggdist_3.3.2         grid_4.2.2          
## [37] distributional_0.4.0 xtable_1.8-4         nlme_3.1-164        
## [40] jsonlite_1.8.8       gtable_0.3.5         lifecycle_1.0.4     
## [43] magrittr_2.0.3       bayestestR_0.13.2    scales_1.3.0        
## [46] datawizard_0.11.0    stringi_1.8.4        estimability_1.4.1  
## [49] cli_3.6.3            cachem_1.1.0         xml2_1.3.6          
## [52] bslib_0.6.1          generics_0.1.3       vctrs_0.6.5         
## [55] sandwich_3.1-0       cowplot_1.1.3        TH.data_1.1-2       
## [58] tools_4.2.2          glue_1.7.0           DEoptimR_1.1-3      
## [61] purrr_1.0.2          emmeans_1.10.0       parallel_4.2.2      
## [64] fastmap_1.2.0        survival_3.5-8       yaml_2.3.8          
## [67] colorspace_2.1-0     knitr_1.45           sass_0.4.8

Power analyses

# Set parameters
d <- 0.36        # Effect size
sd1 <- 1     # Standard deviation of group HC
sd2 <- 1     # Standard deviation of group LC

# Compute mean difference based on effect size
pooled_sd <- sqrt((sd1^2 + sd2^2) / 2)
mean_diff <- d * pooled_sd
mean1 <- 0
mean2 <- mean1 + mean_diff

# Simulation settings
n_seq <- seq(10, 500, by = 5)  # Sample sizes per group
per_test_power_vals <- numeric(length(n_seq))
joint_power_vals <- numeric(length(n_seq))
alpha <- 0.0125                # Corrected significance level
B <- 5000                      # Number of simulations

set.seed(4493)

# Custom function
estimate_per_test_power <- function(n) {
  p_values <- replicate(B, {
    x1 <- rnorm(n, mean = mean1, sd = sd1)
    x2 <- rnorm(n, mean = mean2, sd = sd2)
    test <- t.test(x1, x2, var.equal = FALSE)
    test$p.value
  })
  mean(p_values < alpha)
}

# Estimate per-test and joint power for each sample size
per_test_power_vals <- sapply(n_seq, estimate_per_test_power)
joint_power_vals <- per_test_power_vals^4  # Joint power over 4 tests is the 4th power of the power: .96*.96*.96*.96 = .8 (see Francis et al. on excessive success)

# Create a data frame
power_data <- data.frame(
  SampleSize = n_seq,
  JointPower = joint_power_vals
)

# Find the sample size where joint power reaches or exceeds 80%
if(any(joint_power_vals >= .8)) {
  min_index <- which(joint_power_vals >= .8)[1]
  required_sample_size <- n_seq[min_index]
} else {
  required_sample_size <- NA
}

# Plot the joint power curve using ggplot2
plot <- ggplot(power_data, aes(x = SampleSize, y = JointPower)) +
  geom_line(size = 1, color = "blue") +
  geom_hline(yintercept = .8, linetype = "dashed", color = "red") +
  labs(
    title = "Joint Power Curve for 4 Welch t-tests (d = 0.36; corrected alpha = .0125)",
    x = "Sample Size per Group",
    y = "Joint Power",
    subtitle = "Power to detect 4 effects requires more participants than power to detect 1 effect"
  ) +
  theme_minimal() +
  theme(
    text = element_text(size = 14),
    plot.title = element_text(face = "bold", hjust = 0.5, size=12)
  ) +
  annotate("text", x = max(n_seq) * 0.7, y = .8 + 0.05,
           label = "80% Joint Power", color = "red", size = 5) 

# Add vertical line and annotation for required sample size
if(!is.na(required_sample_size)) {
  plot <- plot +
    geom_vline(xintercept = required_sample_size, linetype = "dashed", color = "darkgreen") +
    annotate("text", x = required_sample_size + 5, y = 0.1,
             label = paste("Sample Size =", required_sample_size), color = "darkgreen", angle = 90, hjust= 0.6)
}

# Display the plot
print(plot)

WSpwr =function(d,n,nsim = 1000, alpha = .05){
  p.sim=c()    #Je créer un compartiment pour mes études
  for(i in 1:nsim) { # Pour un nombre donné ("nsim") de simulations...
    y1=rnorm(n=n/2) #Groupe 1: n données distribuées normalement autour de 0
    y2=rnorm(n=n/2, mean = d) # Groupe 2 : n données distribuées normalement autour de d
    y=c(y1,y2)  #Je réunis ces données en un seul data set (N total = 2*n)        
    p=t.test(y1,y2,var.equal=TRUE)$p.value  #Je fais un t-test et retiens la p-value
    p.sim=c(p.sim,p) #J'ajoute cette p-value dans mon compartiment p1
  } #Et je réitère tout ça un nombre "nsim" donné
  W=sum(p.sim<=alpha)/nsim  #Quel proportion d'études simulées donnent une p < .05 ?
  cat("\nFor a t test with ",n/2,"participants in each group and an effect size of d =  ",d)
  cat("\nOut of",nsim,"studies, there are",sum(p.sim<=alpha),"studies where all effects are significant with our adjusted alpha = ",alpha)
  cat("\nStatistical power for each test:",round(W,2)) #Petit output pour faire joli
  cat("\nJoint Statistical power for 4 tests:",round(W,2)^4) #Petit output pour faire joli
}

WSpwr(d = 0.36, n = 520, nsim = 30000,alpha = 0.0125)

## 
## For a t test with  260 participants in each group and an effect size of d =   0.36
## Out of 30000 studies, there are 28264 studies where all effects are significant with our adjusted alpha =  0.0125
## Statistical power for each test: 0.94
## Joint Statistical power for 4 tests: 0.781

Data simulation

Click “Show” to expand the codes involved in our data simulation.

set.seed(4493)

# We collect 600 participants
n <- 600
Participants <- data.frame(ID = 1:n)

# Coding Experimental condition, HC = High Competence and LC = Low Competence
Participants$Condition <- rep(c("HC", "LC"), each = n/2)

# Generate Gender (47% Female, 42% Male, 11% Other) [no particular reason]
Participants$Gender <- sample(c("Female", "Male", "Other"), n, replace = TRUE, prob = c(0.47, 0.42, 0.11))

# Generate Age (mean = 35, SD = 12) [no particular reason]
Participants$Age <- round(rnorm(n, mean = 35, sd = 12))
Participants$Age <- pmin(pmax(Participants$Age, 18), 65) # Those are my prolific min and max age.

# I want to simulate variables with specific relations to one another... this is tricky. I want support for violent actions to be correlated with support for non violent actions, but also I want them to saturate two distinct factors. I should create a function for this.
generate_items <- function(latent_scores, loadings, min_val, max_val) {
  items <- matrix(NA, nrow = length(latent_scores), ncol = length(loadings))
  for (i in 1:length(loadings)) {
    item_scores <- loadings[i] * latent_scores + rnorm(length(latent_scores), mean = 2.5, sd = sqrt(1 - loadings[i]^2))
    item_scores <- round(item_scores)
    item_scores <- pmin(pmax(item_scores, min_val), max_val)
    items[, i] <- item_scores
  }
  return(items)
}



# Now, I wand d = 0.38 for H1
mean_diff <- 0.38

# Non violent and violent actions are highly correlated (.5)
latent_correlation <- 0.5  

# Creating a matrix for the correlations
library(MASS)
Sigma <- matrix(c(1, latent_correlation, latent_correlation, 1), nrow = 2)
mu_LC <- c(0, 0)
mu_HC <- c(mean_diff, mean_diff)  # Both means increased by mean_diff in HC group

# for HC group
latent_HC <- mvrnorm(n/2, mu = mu_HC, Sigma = Sigma)
F1_HC <- latent_HC[, 1]
F2_HC <- latent_HC[, 2]

# for LC group
latent_LC <- mvrnorm(n/2, mu = mu_LC, Sigma = Sigma)
F1_LC <- latent_LC[, 1]
F2_LC <- latent_LC[, 2]

# Combine latent variables
F1 <- c(F1_HC, F1_LC)
F2 <- c(F2_HC, F2_LC)

# I want my "violent" factor to show a good internal consistency. Although it is a circular reasonning, I will use the prediction made by synthetic Evaluation on https://huggingface.co/spaces/magnolia-psychometrics/synthetic-correlations 
loadings_F1 <- c(0.75, 0.75, 0.75)  # High loadings for good internal consistency
items_F1 <- generate_items(F1, loadings_F1, min_val = 1, max_val = 5)
colnames(items_F1) <- c("Q1supv", "Q2supv", "Q3supv")

# For the fun of it, "non violent items" will show slightly lower internal consistency
loadings_F2 <- c(0.65, 0.65, 0.65)  # Lower loadings
items_F2 <- generate_items(F2, loadings_F2, min_val = 1, max_val = 5)
colnames(items_F2) <- c("Q4supnv", "Q5supnv", "Q6supnv")

# I add the generated items to my final data frame
Participants <- cbind(Participants, items_F1, items_F2)
# Function to generate variables with specified mean and SD
generate_variable <- function(n, mean, sd, min_val, max_val) {
  x <- round(rnorm(n, mean = mean, sd = sd))
  x <- pmin(pmax(x, min_val), max_val)
  return(x)
}
# my effect size for labelling Hamas as terrorists is very small .1 (for the fun of it) - I also anticipate a ceiling effect considering the current political situation in Palestine... I played a bit on the SD of the LC condition to reflect that it's not really affecting the general label of terrorists used by Israeli, but more the variability in the LC group
Participants$Label <- c(
  generate_variable(n/2, mean = 5, sd = 0.8, min_val = 1, max_val = 5),  # HC group
  generate_variable(n/2, mean = 5, sd = 1.2, min_val = 1, max_val = 5)                      # LC group
)

# Null effect for joke appreciation ans sharing
Participants$Joke_appreciation <- generate_variable(n, mean = 3, sd = 1, min_val = 1, max_val = 5)


Participants$Joke_sharing <- generate_variable(n, mean = 3, sd = 1, min_val = 1, max_val = 5)

# Laaaarge effect size for probability of success because this variable is redundant with the manipulation somehow ==> d = 0.7
sd_proba <- 0.25
mean_diff_proba <- 0.7 * sd_proba
Participants$ProbaSucces <- c(
  rnorm(n/2, mean = 0.5 + mean_diff_proba, sd = sd_proba),  # HC group
  rnorm(n/2, mean = 0.5, sd = sd_proba)                     # LC group
)
Participants$ProbaSucces <- pmin(pmax(Participants$ProbaSucces, 0), 1)

# Manip Check: Large effect (d = 0.47) on contempt
mean_diff_emocont <- 0.47
Participants$EmoCont <- c(
  generate_variable(n/2, mean = 3, sd = 1, min_val = 1, max_val = 5),                       # HC group
  generate_variable(n/2, mean = 3 + mean_diff_emocont, sd = 1, min_val = 1, max_val = 5)    # LC group
)

# for the fun of it, smaller effect size of competence on Anger (0.27)
mean_diff_emoanger <- 0.27
Participants$EmoAnger <- c(
  generate_variable(n/2, mean = 3 + mean_diff_emoanger, sd = 1, min_val = 1, max_val = 5),  # HC group
  generate_variable(n/2, mean = 3, sd = 1, min_val = 1, max_val = 5)                        # LC group
)

# For the other emotions, I go with a completely random distribution
Emo_variables <- c("EmoEnvy", "EmoDisg", "EmoHate", "EmoFear")
for (variable in Emo_variables) {
  Participants[[variable]] <- generate_variable(n, mean = 3, sd = 1, min_val = 1, max_val = 5)
}

# Attention check, I want to generate 587 valid answer, the rest should be invalid
attention_check_2 <- rep(2, 587)
attention_check_random <- sample(c(1, 3, 4, 5), 13, replace = TRUE)
attention_check <- c(attention_check_2, attention_check_random)
attention_check <- sample(attention_check)

Participants$AttentionCheck <- attention_check

# For the fun of it: there should be some outliers. I choose outliers on the probability of success, 2% contamination
num_outliers <- round(0.02 * n)
outlier_indices <- sample(1:n, num_outliers)
Participants$ProbaSucces[outlier_indices] <- ifelse(
  runif(num_outliers) > 0.5,
  0,
  1
)

# Don't forget the control question about "feelings toward Hamas": completely random with mean of 1 (I expect Israeli to declare they dislike Hamas)
Participants$AttitudeHamas <- generate_variable(n, mean = 1, sd = 1, min_val = 1, max_val = 5)


# Compute mean Action support
Participants$SupportActionMean <-rowMeans(cbind(Participants$Q1supv, 
                                            Participants$Q2supv, 
                                            Participants$Q3supv,
                                            Participants$Q4supnv,
                                            Participants$Q5supnv,
                                            Participants$Q6supnv))

# Compute mean Joke appreciation
Participants$JokeMean <-rowMeans(cbind(Participants$Joke_appreciation, 
                                            Participants$Joke_sharing))

Summary of the simulation procedure:

• 600 hundred participants (47% Female, 42% Male, 11% Other; Mean age = 35, SD age = 12)
• Randomly assigned in High Competence vs Low Competence conditions
• For questions assessing support for violent and non violent actions: I established a structure such that violent and non violent actions are highly correlated, but belong to two different factors. Their internal structure should still be okay altogether (expected alpha = .75).
• I simulated effect sizes with arbitrary values, chosen to reflect that data is not always what we predict: medium effect size for Support for action, Large effect size for Expectancy of Success (because somehow redundant with manipulation), very small effect size for “Label of terrorists” (worsened by a ceiling effect), and null effect for Joke endorsement
• I simulated some failed attention checks.
• I simulated some outliers on the Probability of success (2% outliers).
• I simulated data for self-reported Emotions toward Hamas randomly, except for Contempt and Anger with a medium to large effect size on Contempt, and a medium effect size on Anger.
• I simulated the Control Question self-reported feeling toward Hamas (Very negative to Very positive) to reflect a ceiling effect with most Israeli having very negative feelings toward Hamas.

Note: The data was simulated following a “credibility” rationale. Some predicted effects were simulated as very small (Label of terrorists, Anger manipulation check), or even null (Joke appreciation) and we corrupted the data with outliers and failed attention checks. This approach allows a more severe test of the registered analyses.

---

Descriptives

# Varables I want to describe
vars <- c("Label", 
          "Joke_appreciation", 
          "Joke_sharing", 
          "ProbaSucces",
          "EmoCont", 
          "EmoAnger", 
          "EmoEnvy", 
          "EmoDisg",
          "EmoHate", 
          "EmoFear", 
          "AttitudeHamas",
          "SupportActionMean", 
          "JokeMean", 
          "Age")

# Initialize a list to store Cohen's d values
cohens_d_list <- list()

# Compute means, SDs, and Cohen's d
descriptives <- Participants %>%
  select(Condition, all_of(vars)) %>%
  pivot_longer(-Condition, names_to = "Variable", values_to = "Value") %>%
  mutate(Value = as.numeric(Value)) %>%
  group_by(Variable, Condition) %>%
  summarise(
    Mean = mean(Value, na.rm = TRUE),
    SD = sd(Value, na.rm = TRUE),
    .groups = 'drop'
  ) %>%
  pivot_wider(names_from = Condition, values_from = c(Mean, SD), names_sep = "_") %>%
  select(Variable, Mean_HC, SD_HC, Mean_LC, SD_LC)

# Compute Cohen's d for each variable
for (var in vars) {
  # Subset data for the variable
  data_var <- Participants %>%
    select(Condition, Value = !!sym(var)) %>%
    mutate(Value = as.numeric(Value)) %>%
    filter(!is.na(Value))
  
  # Compute Cohen's d
  d_result <- cohens_d(Value ~ Condition, data = data_var, pooled_sd = TRUE)
  
  # Extract Cohen's d value
  d_value <- d_result$Cohens_d
  
  # Store in the list
  cohens_d_list[[var]] <- d_value
}

# Convert the list to a data frame
cohens_d_df <- data.frame(
  Variable = names(cohens_d_list),
  Cohens_d = unlist(cohens_d_list)
)

# Merge Cohen's d values with descriptives
descriptives <- descriptives %>%
  left_join(cohens_d_df, by = "Variable") %>%
  mutate(
    Mean_HC = round(Mean_HC, 3),
    SD_HC = round(SD_HC, 3),
    Mean_LC = round(Mean_LC, 3),
    SD_LC = round(SD_LC, 3),
    Cohens_d = round(Cohens_d, 3)
  )


# Create a data frame of variable labels
variable_labels_df <- data.frame(
  Variable = vars,
  Variable_Label = c(
    "Label as Terrorist",
    "Joke Appreciation",
    "Joke Sharing",
    "Probability of future Success of Hamas",
    "Contempt toward Hamas",
    "Anger toward Hamas",
    "Envy toward Hamas",
    "Disgust toward Hamas",
    "Hatred toward Hamas",
    "Fear toward Hamas",
    "Attitude towards Hamas",
    "Support for Action against",
    "Mean Joke Endorsement",
    "Age"
  ),
  stringsAsFactors = FALSE
)

# Merge with descriptives
descriptives <- descriptives %>%
  left_join(variable_labels_df, by = "Variable") %>%
  select(Variable = Variable_Label, Mean_HC, SD_HC, Mean_LC, SD_LC, Cohens_d)

# Create a nicely formatted table
descriptives_table <- descriptives %>%
  kbl(caption = "Descriptive Statistics by Condition with Cohen's d",
      col.names = c("Variable", "Mean", "SD", "Mean", "SD", "Cohen's d"),
      align = "lccccc",
      format = "html") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"))%>%
  add_header_above(c(" " = 1, "High Competence " = 2, "Low Competence " = 2, "Difference" = 1)) %>%
  column_spec(5, border_right = TRUE)%>%
  column_spec(column = 3, border_right = TRUE)# Add a vertical border between SD LC and Cohen's d

# Display the table
descriptives_table

Descriptive Statistics by Condition with Cohen’s d

	High Competence		Low Competence		Difference
Variable	Mean	SD	Mean	SD	Cohen’s d
Age	36.03	11.576	35.407	11.426	0.054
Attitude towards Hamas	1.38	0.619	1.313	0.538	0.115
Anger toward Hamas	3.17	1.003	3.017	0.898	0.165
Contempt toward Hamas	2.95	1.030	3.463	1.042	-0.492
Disgust toward Hamas	2.95	1.036	3.077	0.977	-0.129
Envy toward Hamas	2.93	1.011	3.017	1.062	-0.084
Fear toward Hamas	2.98	0.988	2.943	0.985	0.037
Hatred toward Hamas	3.01	0.988	2.897	1.031	0.116
Mean Joke Endorsement	3.00	0.725	3.007	0.718	-0.016
Joke Appreciation	2.99	0.995	3.080	1.022	-0.093
Joke Sharing	3.00	1.046	2.933	1.006	0.068
Label as Terrorist	4.72	0.511	4.500	0.715	0.359
Probability of future Success of Hamas	0.66	0.238	0.524	0.236	0.574
Support for Action against	2.75	0.683	2.461	0.659	0.432

Registered Analyses

Attention check

Participants_Attentive <- subset(Participants, Participants$AttentionCheck == 2)

There were 13 participants that failed the attention check. As registered, they are removed from the sample.

---

Outlier detection

We use 2.5 MAD as a criterion for outliers’ detection (Leys et al., 2013)

outliers_SupportAgainst <- abs(Participants_Attentive$SupportActionMean - median(Participants_Attentive$SupportActionMean)) > 2.5 * mad(Participants_Attentive$SupportActionMean)
Remove_Outliers_support<-which(outliers_SupportAgainst == T)


outliers_Label <- abs(Participants_Attentive$Label - median(Participants_Attentive$Label)) > 2.5 * mad(Participants_Attentive$Label)
Remove_Outliers_Label<-which(outliers_Label == T)

outliers_ExpectSucc <- abs(Participants_Attentive$ProbaSucces - median(Participants_Attentive$ProbaSucces)) > 2.5 * mad(Participants_Attentive$ProbaSucces)
Remove_Outliers_Success<-which(outliers_ExpectSucc == T)

outliers_Joke <- abs(Participants_Attentive$JokeMean - median(Participants_Attentive$JokeMean)) > 2.5 * mad(Participants_Attentive$JokeMean)
Remove_Outliers_Joke<-which(outliers_Joke == T)

There are 3 outliers for “Support actions against Hamas” ==> %Outliers < 10%: proceed with Welch t tests after deletion of outliers

There are 187 outliers for “Labeling Hamas as terrorists” ==> %Outliers > 10%: proceed with Huber Weighted Robust Regression

There are 0 outliers for “Future Success expectancy” ==> %Outliers < 10%: proceed with Welch t tests after deletion of outliers

There are 5 outliers for “Joke appreciation” ==> %Outliers < 10%: proceed with Welch t tests after deletion of outliers

---

Questionnaire structure

# Computing alpha when more than 2 items, else, the Spearman-brown prophecy alpha is used.
alpha <- psych::alpha(Participants_Attentive[, c("Q1supv",
                              "Q2supv",
                              "Q3supv",
                              "Q4supnv",
                              "Q5supnv",
                              "Q6supnv")])

# The SB prophecy is computed as follow (see https://en.wikipedia.org/wiki/Spearman%E2%80%93Brown_prediction_formula):
correlation <- cor(Participants_Attentive$Joke_appreciation, Participants_Attentive$Joke_sharing)
spearman_brown <- (2 * correlation) / (1 + correlation)

For the 6 items questionnaire, alpha = 0.762

For the two items we should use Spearman Brown alpha (Eisinga et al., 2013). Here, SB = 0.021 (note: negative SB indicates a very poor reliability - recommendation, use separate analyses for the joke dimension)

Control question

Initial feelings toward Hamas should be equivalent in both group. We use a TOST test to evaluate statistical equivalence to 0 using a smallest effect size of interest of d = 0.16 (i.e., small effect size in social psychology).

res<-TOSTER::t_TOST(x = subset(Participants_Attentive,Condition== "HC")$AttitudeHamas,
               y = subset(Participants_Attentive,Condition=="LC")$AttitudeHamas,
               eqb = .16)
describe(res)

## [1] "Using the Welch Two Sample t-test, a null hypothesis significance test (NHST), and a equivalence test, via two one-sided tests (TOST), were performed with an alpha-level of 0.05. These tested the null hypotheses that true mean difference is equal to 0 (NHST), and true mean difference is more extreme than -0.16 and 0.16 (TOST). The equivalence test was significant, t(574.335) = -1.97, p = 0.025 (mean difference = 0.066 90% C.I.[-0.0129, 0.145]; Hedges's g(av) = 0.114 90% C.I.[-0.0221, 0.249]). At the desired error rate, it can be stated that the true mean difference is between -0.16 and 0.16."

So true effect size should be equivalent to 0 here. If this wasn’t the case, we should use Feelings toward Hamas as a covariate in our analyses.

---

Manipulation check.

Participants in the High compentence condition should report more anger toward Hamas

t.test(Participants_Attentive$EmoAnger ~ Participants_Attentive$Condition)

## 
##  Welch Two Sample t-test
## 
## data:  Participants_Attentive$EmoAnger by Participants_Attentive$Condition
## t = 2, df = 580, p-value = 0.04
## alternative hypothesis: true difference in means between group HC and group LC is not equal to 0
## 95 percent confidence interval:
##  0.00394 0.31024
## sample estimates:
## mean in group HC mean in group LC 
##             3.18             3.03

effectsize::cohens_d(Participants_Attentive$EmoAnger ~ Participants_Attentive$Condition)

## Cohen's d |       95% CI
## ------------------------
## 0.17      | [0.00, 0.33]
## 
## - Estimated using pooled SD.

==> Not Verified at alpha level of .0125 - This information will be used to color our interpretations of the results: it would explain null effects, and would point to the idea that anger is not the driver of our effects in case those were significant (alternative emotional predictors could be explored, such as Hate, Envy, or Fear).

---

Participants in the Low competence condition should report more contempt toward Hamas

t.test(Participants_Attentive$EmoCont ~ Participants_Attentive$Condition)

## 
##  Welch Two Sample t-test
## 
## data:  Participants_Attentive$EmoCont by Participants_Attentive$Condition
## t = -6, df = 585, p-value = 0.00000002
## alternative hypothesis: true difference in means between group HC and group LC is not equal to 0
## 95 percent confidence interval:
##  -0.658 -0.321
## sample estimates:
## mean in group HC mean in group LC 
##             2.96             3.45

effectsize::cohens_d(Participants_Attentive$EmoCont ~ Participants_Attentive$Condition)

## Cohen's d |         95% CI
## --------------------------
## -0.47     | [-0.64, -0.31]
## 
## - Estimated using pooled SD.

==> Verified

---

Main tests

H1: Manipulating a perception of Hamas as highly competent will increase support for action against Hamas [Welch t-test after deletion of outliers]

SampleAction <- Participants_Attentive[-Remove_Outliers_support, ]
t_test_action<-t.test(SampleAction$SupportActionMean ~ SampleAction$Condition)

cohen_d_action<-effectsize::cohens_d(SampleAction$SupportActionMean ~ SampleAction$Condition)

Participants in the High Competence condition displayed significantly more support for violent and nonviolent actions against Hamas (M = 2.735, SD = 0.669) than participants in the Low Competence condition (M = 2.448; SD = 0.653), t(581.441) = 5.247, p = 0, d = , 95%CI[ 0.27; 0.598].

# Load necessary libraries
library(ggplot2)
library(dplyr)

# Prepare the data
SampleAction <- Participants_Attentive[-Remove_Outliers_support, ]

# Create a density plot
ggplot(SampleAction, aes(x = SupportActionMean, fill = Condition)) +
  geom_density(alpha = 0.7) +
  labs(title = "Density Plot of Support for Action Against Hamas",
       x = "Support For Action Against Hamas",
       y = "Density",
       fill = "Condition") +
    scale_fill_discrete(labels = c("High Condition", "Low Condition")) +
  theme_minimal() 

---

H2: Participants in the High Competence condition should be more likely to label Hamas soldiers as terrorists [Huber Weighted regressions because outliers > 10%]

SampleLabel <- Participants_Attentive
# Dummy code COndition:
SampleLabel$Condition_dummy <- ifelse(SampleLabel$Condition == "LC", -0.5, 0.5)

mod2<-rlm(SampleLabel$Label~SampleLabel$Condition_dummy)
mod2_p<-f.robftest(mod2, var = "SampleLabel$Condition_dummy")
mod2_CI<-confint.default(object = mod2, parm = "SampleLabel$Condition_dummy", level = 0.95)

Participants in the High Competence condition significantly agreed more with labelling Hamas as terrorists (M = 4.72, SD = 0.514) than participants in the Low Competence condition (M = 4.507; SD = 0.714), B = 0.149, t(585) = 12.68, p = 0, 95%CI[ 0.067; 0.23].

Participants_Attentive$
Participants_Attentive$Label <- factor(Participants_Attentive$Label, levels = 1:5, ordered = TRUE)

summary_data <- Participants_Attentive %>%
  group_by(Condition, Label) %>%
  summarise(
    count = n()
  ) %>%
  ungroup() %>%
  # Calculate total counts per condition
  group_by(Condition) %>%
  mutate(
    total = sum(count),
    proportion = count / total
  ) %>%
  # Calculate standard error of the proportion
  mutate(
    se = sqrt((proportion * (1 - proportion)) / total)
  )



ggplot(summary_data, aes(x = as.factor(Label), y = proportion, fill = Condition)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_errorbar(aes(ymin = proportion - se, ymax = proportion + se),
                width = 0.2, position = position_dodge(0.9)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Proportion of Each Label level by Condition",
       x = "Label levels",
       y = "Proportion of Participants (%)",
       fill = "Condition") +
  theme_minimal()

Note: As shown in descriptive plot above, there is a ceiling effect - Suggested deviation from registration: recode variable as 1 (Full agreement with the label of “terrorists”) and 0 (all other possible answers) and compute a robust logistic regression to predict “Full agreement with the label of”Terrorists”. This is a somewhat less interesting question.

Show/Hide Robust Binomial Regression

***ROBUST BINOMIAL REGRESSION***:


```r
SampleLabel$FullAgree <- ifelse(SampleLabel$Label == 5, 1, 0)
summary(robustbase::glmrob(SampleLabel$FullAgree ~ SampleLabel$Condition, family = "binomial" ))
```

```
## 
## Call:  robustbase::glmrob(formula = SampleLabel$FullAgree ~ SampleLabel$Condition,      family = "binomial") 
## 
## 
## Coefficients:
##                         Estimate Std. Error z value            Pr(>|z|)    
## (Intercept)                1.085      0.135    8.04 0.00000000000000087 ***
## SampleLabel$ConditionLC   -0.614      0.180   -3.40             0.00067 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Robustness weights w.r * w.x: 
##  513 weights are ~= 1. The remaining 74 ones are summarized as
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.782   0.782   0.782   0.782   0.782   0.782 
## 
## Number of observations: 587 
## Fitted by method 'Mqle'  (in 1 iterations)
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
## No deviance values available 
## Algorithmic parameters: 
##    acc    tcc 
## 0.0001 1.3450 
## maxit 
##    50 
## test.acc 
##   "coef"
```

---

H3: Manipulating a perception of Hamas as not competent will increase the use of controversial humor to legitimize ingroup superiority

SampleJoke <- Participants_Attentive[-Remove_Outliers_Joke, ]
t_test_Joke<-t.test(SampleJoke$JokeMean ~ SampleJoke$Condition)
cohen_d_Joke<-effectsize::cohens_d(SampleJoke$JokeMean ~ SampleJoke$Condition)

Participants in the High Competence condition did not displayed significantly less endorsement of controversial jokes, (M = 3, SD = 0.706) than participants in the Low Competence condition (M = 2.986; SD = 0.705), t(579.955) = 0.234, p = 0.815, d = , 95%CI[ -0.143; 0.182].

ggplot(SampleJoke, aes(x = Condition, y = JokeMean, fill = Condition)) +
  geom_boxplot(alpha = 0.6, outlier.shape = NA, width = 0.5) +
  geom_jitter(position = position_jitter(width = 0.15), size = 2, alpha = 0.1, color = "black") +
  labs(
    title = "endorsement of Controversial Jokes by Condition",
    x = "Condition",
    y = "Mean endorsement Rating for Jokes"
  ) +
  theme_minimal() +
  theme(
    legend.position = "none",
    plot.title = element_text(size = 14, face = "bold")
  )

As registered, because the effect is not significant at the alpha level of .0125, we compute an equivalence test using a small effect size by social psychology standards (d = 0.16, Lovakov & Agadullina, 2021)

res<-TOSTER::t_TOST(x = subset(SampleJoke,Condition== "HC")$JokeMean,
               y = subset(SampleJoke,Condition=="LC")$JokeMean,
               eqb = .16)
describe(res)

## [1] "Using the Welch Two Sample t-test, a null hypothesis significance test (NHST), and a equivalence test, via two one-sided tests (TOST), were performed with an alpha-level of 0.05. These tested the null hypotheses that true mean difference is equal to 0 (NHST), and true mean difference is more extreme than -0.16 and 0.16 (TOST). The equivalence test was significant, t(579.955) = -2.5, p = 0.006 (mean difference = 0.014 90% C.I.[-0.0826, 0.11]; Hedges's g(av) = 0.019 90% C.I.[-0.117, 0.156]). At the desired error rate, it can be stated that the true mean difference is between -0.16 and 0.16."

The two means are equivalent. We can conclude that the effect size might be too small to be interesting, considering that it is significantly smaller than a small effect size (d = 0.16).

(Note: these are simulated data, so we actually know that the true difference between the groups is = 0).

---

H4: Manipulating a perception of Hamas as competent will increase the expectations of future successes by Hamas

SampleSuccess <- Participants_Attentive

t_test_Success<- t.test(SampleSuccess$ProbaSucces ~ SampleSuccess$Condition)
cohen_d_Success<- effectsize::cohens_d(SampleSuccess$ProbaSucces ~ SampleSuccess$Condition)

Participants in the High Competence condition displayed significantly more future Hamas success (M = 0.662, SD = 0.237) than participants in the Low Competence condition (M = 0.523; SD = 0.232), t(584.617) = 7.138, p = 0, d = , 95%CI[ 0.424; 0.754].

# Create a density plot
ggplot(SampleSuccess, aes(x = ProbaSucces, fill = Condition)) +
  geom_density(alpha = 0.7) +
  labs(title = "Density Plot of Expected future Successes of Hamas (probability)",
       x = "Expectation of future success by Hamas",
       y = "Density",
       fill = "Condition") +
    scale_fill_discrete(labels = c("High Condition", "Low Condition")) +
  theme_minimal() 

---

Alternative Approach: Initial attitudes toward Hamas are not equivalent

NOTE: In case Attitudes toward Hamas were not equivalent between the two groups from the start (see control), we should use Initial attitudes toward Hamas as a covariate. This would be done in robust regressions (see registration).

Show/Hide Alternative analyses if initial attitudes toward Hamas differ between the two groups

# Dummy code COndition:
Participants_Attentive$Condition_dummy <- ifelse(Participants_Attentive$Condition == "LC", -0.5, 0.5)

summary(mod1<-rlm(Participants_Attentive$SupportActionMean ~Participants_Attentive$Condition_dummy + scale(Participants_Attentive$AttitudeHamas)))

## 
## Call: rlm(formula = Participants_Attentive$SupportActionMean ~ Participants_Attentive$Condition_dummy + 
##     scale(Participants_Attentive$AttitudeHamas))
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.7667 -0.4231 -0.0699  0.4301  2.0769 
## 
## Coefficients:
##                                             Value  Std. Error t value
## (Intercept)                                  2.590  0.030     86.141 
## Participants_Attentive$Condition_dummy       0.313  0.060      5.204 
## scale(Participants_Attentive$AttitudeHamas)  0.017  0.030      0.578 
## 
## Residual standard error: 0.638 on 584 degrees of freedom

mod1_p<-f.robftest(mod1, var = "Participants_Attentive$Condition_dummy")
mod1_CI<-confint.default(object = mod1, parm = "Participants_Attentive$Condition_dummy", level = 0.95)

summary(mod2<-rlm(Participants_Attentive$Label ~Participants_Attentive$Condition_dummy+ scale(Participants_Attentive$AttitudeHamas)))

## 
## Call: rlm(formula = Participants_Attentive$Label ~ Participants_Attentive$Condition_dummy + 
##     scale(Participants_Attentive$AttitudeHamas))
## Residuals:
##    Min     1Q Median     3Q    Max 
## -2.657 -0.617  0.232  0.383  0.494 
## 
## Coefficients:
##                                             Value   Std. Error t value
## (Intercept)                                   4.673   0.022    207.971
## Participants_Attentive$Condition_dummy        0.151   0.045      3.348
## scale(Participants_Attentive$AttitudeHamas)  -0.032   0.023     -1.433
## 
## Residual standard error: 0.567 on 584 degrees of freedom

mod2_p<-f.robftest(mod2, var = "Participants_Attentive$Condition_dummy")
mod2_CI<-confint.default(object = mod2, parm = "Participants_Attentive$Condition_dummy", level = 0.95)

summary(mod3<-rlm(Participants_Attentive$ProbaSucces ~Participants_Attentive$Condition_dummy+ scale(Participants_Attentive$AttitudeHamas)))

## 
## Call: rlm(formula = Participants_Attentive$ProbaSucces ~ Participants_Attentive$Condition_dummy + 
##     scale(Participants_Attentive$AttitudeHamas))
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.67714 -0.16329  0.00472  0.16134  0.47783 
## 
## Coefficients:
##                                             Value  Std. Error t value
## (Intercept)                                  0.600  0.010     59.352 
## Participants_Attentive$Condition_dummy       0.154  0.020      7.620 
## scale(Participants_Attentive$AttitudeHamas)  0.000  0.010     -0.041 
## 
## Residual standard error: 0.24 on 584 degrees of freedom

mod3_p<-f.robftest(mod3, var = "Participants_Attentive$Condition_dummy")
mod3_CI<-confint.default(object = mod3, parm = "Participants_Attentive$Condition_dummy", level = 0.95)

summary(mod4<-rlm(Participants_Attentive$JokeMean ~Participants_Attentive$Condition_dummy+ scale(Participants_Attentive$AttitudeHamas)))

## 
## Call: rlm(formula = Participants_Attentive$JokeMean ~ Participants_Attentive$Condition_dummy + 
##     scale(Participants_Attentive$AttitudeHamas))
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.00194 -0.49076  0.00924  0.50924  2.02563 
## 
## Coefficients:
##                                             Value  Std. Error t value
## (Intercept)                                  2.991  0.033     91.506 
## Participants_Attentive$Condition_dummy       0.011  0.065      0.171 
## scale(Participants_Attentive$AttitudeHamas) -0.009  0.033     -0.290 
## 
## Residual standard error: 0.744 on 584 degrees of freedom

mod4_p<-f.robftest(mod4, var = "Participants_Attentive$Condition_dummy")
mod4_CI<-confint.default(object = mod4, parm = "Participants_Attentive$Condition_dummy", level = 0.95)


results_df <- data.frame(
  Predictor = c("SupportActionMean", "Label", "ProbaSucces", "JokeMean"),
  Coefficient = c(coef(mod1)["Participants_Attentive$Condition_dummy"],
                  coef(mod2)["Participants_Attentive$Condition_dummy"],
                  coef(mod3)["Participants_Attentive$Condition_dummy"],
                  coef(mod4)["Participants_Attentive$Condition_dummy"]),
  t_value = c(mod1_p$statistic, mod2_p$statistic, mod3_p$statistic, mod4_p$statistic),
  p_value = c(mod1_p$p.value, mod2_p$p.value, mod3_p$p.value, mod4_p$p.value),
  CI_95 = c(paste0("[", round(mod1_CI[1], 3), ", ", round(mod1_CI[2], 3), "]"),
            paste0("[", round(mod2_CI[1], 3), ", ", round(mod2_CI[2], 3), "]"),
            paste0("[", round(mod3_CI[1], 3), ", ", round(mod3_CI[2], 3), "]"),
            paste0("[", round(mod4_CI[1], 3), ", ", round(mod4_CI[2], 3), "]"))
)

knitr::kable(results_df, caption = "Results from this alternative approach", format = "markdown")

Results from this alternative approach

Predictor	Coefficient	t_value	p_value	CI_95
SupportActionMean	0.313	27.101	0.000	[0.195, 0.432]
Label	0.151	11.199	0.001	[0.062, 0.239]
ProbaSucces	0.154	58.076	0.000	[0.115, 0.194]
JokeMean	0.011	0.029	0.864	[-0.117, 0.14]

We also registered some additional exploratory analyses.

Show/Hide Exploratory Analyses

Exploratory analyses:

Anger Level should positively moderate the effect of condition on Support for actions:

Participants_Attentive$EmoAnger<- scale(Participants_Attentive$EmoAnger)
Participants_Attentive$EmoCont<- scale(Participants_Attentive$EmoCont)

summary(mod1<-rlm(Participants_Attentive$SupportActionMean ~Participants_Attentive$Condition_dummy*Participants_Attentive$EmoAnger))

## 
## Call: rlm(formula = Participants_Attentive$SupportActionMean ~ Participants_Attentive$Condition_dummy * 
##     Participants_Attentive$EmoAnger)
## Residuals:
##    Min     1Q Median     3Q    Max 
## -1.673 -0.437 -0.030  0.450  2.070 
## 
## Coefficients:
##                                                                        Value 
## (Intercept)                                                             2.588
## Participants_Attentive$Condition_dummy                                  0.310
## Participants_Attentive$EmoAnger                                         0.028
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger  0.063
##                                                                        Std. Error
## (Intercept)                                                             0.030    
## Participants_Attentive$Condition_dummy                                  0.060    
## Participants_Attentive$EmoAnger                                         0.030    
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger  0.060    
##                                                                        t value
## (Intercept)                                                            86.122 
## Participants_Attentive$Condition_dummy                                  5.161 
## Participants_Attentive$EmoAnger                                         0.940 
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger  1.046 
## 
## Residual standard error: 0.648 on 583 degrees of freedom

mod1_p<-f.robftest(mod1, var = "Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger")
mod1_CI<-confint.default(object = mod1, parm = "Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger", level = 0.95)

# Create the interaction plot
ggplot(Participants_Attentive, aes(x = EmoAnger, y = SupportActionMean, color = Condition)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "lm", se = TRUE, fullrange = TRUE, aes(fill = Condition)) +
  labs(
    title = "Interaction between Anger and Condition on Support for action against Hamas",
    x = "Anger (scaled)",
    y = "Supporting Action against Hamas",
    color = "Condition",
    fill = "Condition"
  ) +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Interaction effect: B = NA, t(584) = 11.199, p = 0.001, 95%CI[ 0.062; 0.239]. ==> N.S.

---

Anger Level should positively moderate the effect of condition on Characterisation of Hamas as terrorists:

summary(mod1<-rlm(Participants_Attentive$Label ~Participants_Attentive$Condition_dummy*Participants_Attentive$EmoAnger))

## 
## Call: rlm(formula = Participants_Attentive$Label ~ Participants_Attentive$Condition_dummy * 
##     Participants_Attentive$EmoAnger)
## Residuals:
##    Min     1Q Median     3Q    Max 
## -2.730 -0.598  0.256  0.400  0.408 
## 
## Coefficients:
##                                                                        Value  
## (Intercept)                                                              4.671
## Participants_Attentive$Condition_dummy                                   0.148
## Participants_Attentive$EmoAnger                                          0.005
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger   0.015
##                                                                        Std. Error
## (Intercept)                                                              0.021   
## Participants_Attentive$Condition_dummy                                   0.042   
## Participants_Attentive$EmoAnger                                          0.021   
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger   0.042   
##                                                                        t value
## (Intercept)                                                            222.734
## Participants_Attentive$Condition_dummy                                   3.524
## Participants_Attentive$EmoAnger                                          0.230
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger   0.362
## 
## Residual standard error: 0.597 on 583 degrees of freedom

mod1_p<-f.robftest(mod1, var = "Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger")
mod1_CI<-confint.default(object = mod1, parm = "Participants_Attentive$Condition_dummy:Participants_Attentive$EmoAnger", level = 0.95)

# Create the interaction plot
ggplot(Participants_Attentive, aes(x = EmoAnger, y = Label, color = Condition)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "lm", se = TRUE, fullrange = TRUE, aes(fill = Condition)) +
  labs(
    title = "Interaction between Anger and Condition on Label of Hamas as Terrorists",
    x = "Anger (scaled)",
    y = "Label",
    color = "Condition",
    fill = "Condition"
  ) +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Interaction effect: B = NA, t(584) = 11.199, p = 0.001, 95%CI[ 0.062; 0.239]. ==> N.S.

---

Contempt Level should positively moderate the effect of low competence on Dark Humor Appreciation:

summary(mod1<-rlm(Participants_Attentive$JokeMean ~Participants_Attentive$Condition_dummy*Participants_Attentive$EmoCont))

## 
## Call: rlm(formula = Participants_Attentive$JokeMean ~ Participants_Attentive$Condition_dummy * 
##     Participants_Attentive$EmoCont)
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.12544 -0.49746  0.00254  0.50254  2.02945 
## 
## Coefficients:
##                                                                       Value 
## (Intercept)                                                            3.009
## Participants_Attentive$Condition_dummy                                 0.035
## Participants_Attentive$EmoCont                                         0.052
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont  0.162
##                                                                       Std. Error
## (Intercept)                                                            0.035    
## Participants_Attentive$Condition_dummy                                 0.071    
## Participants_Attentive$EmoCont                                         0.035    
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont  0.071    
##                                                                       t value
## (Intercept)                                                           84.967 
## Participants_Attentive$Condition_dummy                                 0.491 
## Participants_Attentive$EmoCont                                         1.472 
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont  2.282 
## 
## Residual standard error: 0.74 on 583 degrees of freedom

mod1_p<-f.robftest(mod1, var = "Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont")
mod1_CI<-confint.default(object = mod1, parm = "Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont", level = 0.95)

# Create the interaction plot
ggplot(Participants_Attentive, aes(x = EmoCont, y = JokeMean, color = Condition)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "lm", se = TRUE, fullrange = TRUE, aes(fill = Condition)) +
  labs(
    title = "Interaction between Contempt and Condition on Endorsement of controversial jokes",
    x = "Contempt (scaled)",
    y = "Controversial joke endorsement",
    color = "Condition",
    fill = "Condition"
  ) +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Interaction effect: B = NA, t(584) = 11.199, p = 0.001, 95%CI[ 0.062; 0.239]. ==> N.S.

---

Contempt Level should positively moderate the effect of low competence on Expectations of future failures:

summary(mod1<-rlm(Participants_Attentive$ProbaSucces ~Participants_Attentive$Condition_dummy*Participants_Attentive$EmoCont))

## 
## Call: rlm(formula = Participants_Attentive$ProbaSucces ~ Participants_Attentive$Condition_dummy * 
##     Participants_Attentive$EmoCont)
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.70233 -0.16787  0.00849  0.15869  0.51832 
## 
## Coefficients:
##                                                                       Value 
## (Intercept)                                                            0.592
## Participants_Attentive$Condition_dummy                                 0.152
## Participants_Attentive$EmoCont                                         0.000
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont -0.061
##                                                                       Std. Error
## (Intercept)                                                            0.010    
## Participants_Attentive$Condition_dummy                                 0.020    
## Participants_Attentive$EmoCont                                         0.010    
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont  0.021    
##                                                                       t value
## (Intercept)                                                           57.801 
## Participants_Attentive$Condition_dummy                                 7.415 
## Participants_Attentive$EmoCont                                         0.005 
## Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont -2.960 
## 
## Residual standard error: 0.243 on 583 degrees of freedom

mod1_p<-f.robftest(mod1, var = "Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont")
mod1_CI<-confint.default(object = mod1, parm = "Participants_Attentive$Condition_dummy:Participants_Attentive$EmoCont", level = 0.95)

# Create the interaction plot
ggplot(Participants_Attentive, aes(x = EmoCont, y = ProbaSucces, color = Condition)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "lm", se = TRUE, fullrange = TRUE, aes(fill = Condition)) +
  labs(
    title = "Interaction between Contempt and Condition on Probability of Success",
    x = "Contempt (scaled)",
    y = "Probability of Success",
    color = "Condition",
    fill = "Condition"
  ) +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Interaction effect: B = NA, t(584) = 11.199, p = 0.001, 95%CI[ 0.062; 0.239]. ==> N.S.

---

Analysing separately violent vs non violent actions:

Participants_Attentive$Violent <-rowMeans(cbind(Participants_Attentive$Q1supv,
                                            Participants_Attentive$Q2supv,
                                            Participants_Attentive$Q3supv))       
outliers_SupportAgainstV <- abs(Participants_Attentive$Violent - median(Participants_Attentive$Violent)) > 2.5 * mad(Participants_Attentive$Violent)
Remove_Outliers_support<-which(outliers_SupportAgainstV == T)
sum(Remove_Outliers_support) # No outliers

## [1] 0

t_test_action<-t.test(SampleAction$SupportActionMean ~ SampleAction$Condition)

cohen_d_action<-effectsize::cohens_d(SampleAction$SupportActionMean ~ SampleAction$Condition)

t_test_action<-t.test(Participants_Attentive$Violent ~ Participants_Attentive$Condition)
cohen_d_action<- effectsize::cohens_d(Participants_Attentive$Violent ~ Participants_Attentive$Condition)


Participants_Attentive$NonViolent <-rowMeans(cbind(Participants_Attentive$Q4supnv,
                                            Participants_Attentive$Q5supnv,
                                            Participants_Attentive$Q6supnv)) 

outliers_SupportAgainstNV <- abs(Participants_Attentive$NonViolent - median(Participants_Attentive$NonViolent)) > 2.5 * mad(Participants_Attentive$NonViolent)
Remove_Outliers_support<-which(outliers_SupportAgainstNV == T)
sum(Remove_Outliers_support) # No outliers

## [1] 0

t_test_actionNV<- t.test(Participants_Attentive$NonViolent ~ Participants_Attentive$Condition)
cohen_d_actionNV<- effectsize::cohens_d(Participants_Attentive$NonViolent ~ Participants_Attentive$Condition)


# Violent actions
t_value_violent <- t_test_action$statistic
df_violent <- t_test_action$parameter
p_value_violent <- t_test_action$p.value
cohen_d_violent <- cohen_d_action$Cohens_d
ci_low_violent <- cohen_d_action$CI_low
ci_high_violent <- cohen_d_action$CI_high

# NonViolent actions
t_value_nonviolent <- t_test_actionNV$statistic
df_nonviolent <- t_test_actionNV$parameter
p_value_nonviolent <- t_test_actionNV$p.value
cohen_d_nonviolent <- cohen_d_actionNV$Cohens_d
ci_low_nonviolent <- cohen_d_actionNV$CI_low
ci_high_nonviolent <- cohen_d_actionNV$CI_high


# Create a data frame with the results
results_table <- data.frame(
  Action = c("Violent", "NonViolent"),
  t_value = c(round(t_value_violent, 2), round(t_value_nonviolent, 2)),
  df = c(round(df_violent, 2), round(df_nonviolent, 2)),
  p_value = c(signif(p_value_violent, 3), signif(p_value_nonviolent, 3)),
  Cohen_d = c(round(cohen_d_violent, 2), round(cohen_d_nonviolent, 2)),
  `95% CI Lower` = c(round(ci_low_violent, 2), round(ci_low_nonviolent, 2)),
  `95% CI Upper` = c(round(ci_high_violent, 2), round(ci_high_nonviolent, 2))
)

kable(
  results_table,
  caption = "Results of t-tests and Cohen's d for Violent and NonViolent Actions separately",
  col.names = c("Action", "t-value", "df", "p-value", "Cohen's d", "95% CI Lower", "95% CI Upper"),
  align = c('l', 'c', 'c', 'c', 'c', 'c', 'c')
)

Results of t-tests and Cohen’s d for Violent and NonViolent Actions separately

Action	t-value	df	p-value	Cohen’s d	95% CI Lower	95% CI Upper
Violent	4.87	580	0	0.40	0.24	0.56
NonViolent	3.85	584	0	0.32	0.15	0.48

Analysing separately appreciating the joke and sharing it (in case of low consistency)

outliers_JokeAppreciation <- abs(Participants_Attentive$Joke_appreciation - median(Participants_Attentive$Joke_appreciation)) > 2.5 * mad(Participants_Attentive$Joke_appreciation)
Remove_Outliers_J1<-which(outliers_JokeAppreciation == T)
sum(Remove_Outliers_J1) # No outliers

## [1] 0

t_test_action<-t.test(SampleAction$Joke_appreciation ~ SampleAction$Condition)

cohen_d_action<-effectsize::cohens_d(SampleAction$SupportActionMean ~ SampleAction$Condition)

outliers_JokeSharing <- abs(Participants_Attentive$Joke_sharing - median(Participants_Attentive$Joke_sharing)) > 2.5 * mad(Participants_Attentive$Joke_sharing)
Remove_Outliers_J2<-which(outliers_JokeSharing == T)
sum(Remove_Outliers_J2) # No outliers

## [1] 0

t_test_action2<- t.test(Participants_Attentive$Joke_sharing ~ Participants_Attentive$Condition)
cohen_d_action2<- effectsize::cohens_d(Participants_Attentive$Joke_sharing ~ Participants_Attentive$Condition)


# Violent actions
t_value_violent <- t_test_action$statistic
df_violent <- t_test_action$parameter
p_value_violent <- t_test_action$p.value
cohen_d_violent <- cohen_d_action$Cohens_d
ci_low_violent <- cohen_d_action$CI_low
ci_high_violent <- cohen_d_action$CI_high

# NonViolent actions
t_value_nonviolent <- t_test_action2$statistic
df_nonviolent <- t_test_action2$parameter
p_value_nonviolent <- t_test_action2$p.value
cohen_d_nonviolent <- cohen_d_action2$Cohens_d
ci_low_nonviolent <- cohen_d_action2$CI_low
ci_high_nonviolent <- cohen_d_action2$CI_high


# Create a data frame with the results
results_table <- data.frame(
  Action = c("Joke Appreciation", "Joke Sharing"),
  t_value = c(round(t_value_violent, 2), round(t_value_nonviolent, 2)),
  df = c(round(df_violent, 2), round(df_nonviolent, 2)),
  p_value = c(signif(p_value_violent, 3), signif(p_value_nonviolent, 3)),
  Cohen_d = c(round(cohen_d_violent, 2), round(cohen_d_nonviolent, 2)),
  `95% CI Lower` = c(round(ci_low_violent, 2), round(ci_low_nonviolent, 2)),
  `95% CI Upper` = c(round(ci_high_violent, 2), round(ci_high_nonviolent, 2))
)

results_table

##              Action t_value  df p_value Cohen_d X95..CI.Lower X95..CI.Upper
## 1 Joke Appreciation   -1.19 582   0.236    0.43          0.27          0.60
## 2      Joke Sharing    0.92 584   0.358    0.08         -0.09          0.24

kable(
  results_table,
  caption = "Results of t-tests and Cohen's d for Joke appreciation and Joke sharing separately",
  col.names = c("Action", "t-value", "df", "p-value", "Cohen's d", "95% CI Lower", "95% CI Upper"),
  align = c('l', 'c', 'c', 'c', 'c', 'c', 'c')
)

Results of t-tests and Cohen’s d for Joke appreciation and Joke sharing separately

Action	t-value	df	p-value	Cohen’s d	95% CI Lower	95% CI Upper
Joke Appreciation	-1.19	582	0.236	0.43	0.27	0.60
Joke Sharing	0.92	584	0.358	0.08	-0.09	0.24

NOTE: Further exploratory analyses are available using the following Shiny app:

---