1- pbinom(0.6*144, 144, 0.5)[1] 0.007685257Replication of Does Seeing Faces of Young Black Boys Facilitate the Identification of Threatening Stimuli? by Todd et al. (2016, Psychological Science)
Introduction
The present project aims to rescue the replication of Experiment 1 of Todd et al. (2016, Psychological Science), which used photos of Black and White boys as primes for the categorization of objects (gun vs. toy) in a reaction time experiment. This experiment contributed to the literature on the perceptual basis of racism and stereotyping.
Specifically, the rescue will focus on attempting to replicate the results of an interaction of prime of race and speed of object categorization. For that, access to the stimuli utilized in the experiment (i.e., images of faces of boys and a set of images of objects to be categorized) was needed. In addition, the experiment was programmed in PsychoPy.
Challenges involved recreating the experimental paradigm in line with the original and analyzing the data using the same statistical techniques. Adding other controls to guarantee the high quality of the experiment (e.g., exclusion criteria) was also challenging.
Link to original study in repo
Summary of prior replication attempt
The prior replication attempt had a substantially smaller sample size (effective N=26) than the original study (N=63). This decision was based on a a priori power analysis indicating a sample size of N = 24 for 95% power. Additionally, the original study was conducted in an in-person lab setting, while the replication attempt was conducted online using Mechanical Turk. All other relevant criteria seem to be equal or comparable to the original study.
Other replication attempts
No other replication attempts of this experiment were found. Upon contact with the original author, they offered to run a parallel replication attempt at their university with an undergraduate student sample. The results of this parallel replication attempt are included in this report.
Methods
“White participants completed sequential priming tasks in which they categorized threatening and non-threatening objects (toys and guns) and words after brief presentations of Black and White children’s faces.”
The present rescue attempt will keep the same methodological paradigm and recode the original experiment in PsychoPy. Additionally, this rescue attempt will collect data online using Prolific as opposed to Mechanical Turk.
Power Analysis
The original effect size was ηp2 = .22 which translates into an effect size of 0.53. Power analysis shows that I need 16 participants for 80% power, 20 for 90%, and 24 for 95% power. This effect size is for the 2 (race of prime: Black, White) × 2 (target object: gun, toy) repeated measures analysis of variance (ANOVA). Attaining this number of participants is easily feasible with Prolific.
Considering the initial replication attempt failed to find an effect, I will propose a sample closer to the original sample of the study, aiming for effective N = 60. According to G*Power, a sample of N = 60 would have a power of near 1 to find the original effect size.
A sensitivity power analysis with G*Power revealed that, with 60 participants, this experiment has 80% power to detect an effect size as small as 0.07.
Planned Sample
We will recruit 66 participants to be close to the N of the original study. We added 6, which is 10% of 60 to ensure we will still have enough participants after the exclusion criteria. We will exclude non-White participants in the analysis. We will also exclude participants who have less than 60% level of accuracy. The original study excluded based on 50% accuracy or lower (chance-level), meaning that a participant who guesses every single trial might still have a reasonable chance of not being excluded. The chance of a participant reaching 60% accuracy over 144 trials is:
Materials
“The primes were 12 photos of boys (6 Black, 6 White) taken from the Child Affective Facial Expression set (LoBue & Thrasher, 2015). We selected these photos using the following criteria: The faces had to be easily categorized by race, to have a neutral expression, to have no idiosyncrasies (e.g., facial scars), and to be similar in actual age (mean age for Black faces = 4.98 years; mean age for White faces = 5.01 years; p > .250). Each photo was cropped so that it included only the head and was standardized in size. The target objects were 6 gun images taken from Payne (2001) and 6 toy images (e.g., a rattle) taken from online sources. The toy images were converted to grayscale and sized to match the gun images.”
Procedure
Instead of beginning with a blank screen (500 ms) like in the original article, we began with a screen that instructed participants to “Press the space bar to continue” after each trial. The rest of the procedures were the same. Participants were instructed to place their fingers on the P and Q keys on their keyboard, and told they would have to quickly press “P” when seeing a toy and “Q” when seeing a gun. After feedback from the original author, we edited visual features of the experimental paradigm to the best of our ability to match the original experiment.
“Each trial sequence began [..] followed by a face prime (200 ms), then a target object (200 ms), and finally a pattern mask (which remained on screen until participants responded). If participants did not respond within 500 ms, a message (“Please respond faster!”) appeared for 1 s. Each of the 12 face primes was paired once with each of the 12 target objects, which resulted in 144 randomly ordered experimental trials. Eight practice trials preceded the experimental trials.” After each trial, including the ones participants did not respond fast enough, participants had to press the space bar to move on to the next trial.
This replication included 12 practice trials instead of 8.
Additionally, following the recommendation in a commentary in the previous replication attempt report, we will include a cover page for the study, as recommended by the author: “This task is investigating object recognition under distracting conditions. You will be asked to quickly identify objects will being distracted by other stimuli.”
Controls
The experiment already contains built-in attention checks as it alerts the participant to pay attention if they are too slow to react to the image. Additionally, the rescue replication will exclude participants with less than 60% accuracy rate, virtually eliminating participants who do not complete the experiment in good faith. We will also exclude non-white participants, as did the original study and the 1st replication attempt.
Analysis Plan
“Before analysis, we excluded errors and RTs less than 100 ms. RTs exceeding the 500-ms deadline were excluded from analyses, and responses on those trials were treated as errors. We then subjected the remaining RTs to a log transformation (Payne, 2001); however, for interpretive ease, we report raw RTs. A 2 (race of prime: Black, White) × 2 (target object: gun, toy) repeated measures analysis of variance (ANOVA) revealed a significant interaction.” The key test will be the interaction effect of this 2 X 2 ANOVA.
We will only analyze data from people who indicated their race as White.
In the original paper, a repeated measures ANOVA yielded the following results: “A 2 (race of prime: Black, White) × 2 (target object: gun, toy) repeated measures analysis of variance (ANOVA) revealed a significant interaction, F(1, 62) = 17.21, p < .001, ηp2 = .22.”
In the first replication attempt, results of the same analysis were as follows: “One-way repeated-measures analysis of variance (ANOVA) revealed no significant interaction effect of condition on reaction times: F(1, 23) = 1.3, p = .27.”
Differences from Original Study and 1st replication
The only difference between the original study and the replication attempt in terms of procedure is that the replication attempt was made online and the original experiment was conducted in-person.
The present rescue attempt is going to try to get closer to the original study by aiming at a sample size closer to the original. Additionally, this rescue will use Prolific as opposed to MTurk. Since evidence has shown that Profilic consistently delivers higher quality data, the differences to an in-person setting could be further reduced. We will also raise the chance-exclusion cut-off to 60%.
No difference in claims is expected to occur from the original study.
Methods Addendum (Post Data Collection)
Actual Sample
We collected data from 71 Prolific participants. We excluded 1 participant for being non-white and 12 participants due to accuracy rates compatible with chance. An additional 3 participants were excluded passively for not having valid data (i.e., people that clicked on the experiment but did not follow through with it). The effective sample size was N=55.
Differences from pre-data collection methods plan
One important observation is that this data had to be recollected due to an error in the instructions of the experiment. No additional changes exist between the present analysis and the original methods plan.
Results
Data preparation
Data was imported and wrangled into a tidy format, renaming variables for better interpretability. Categorical variables were factored and relabeled.
Loading libraries
### Load Relevant Libraries
library(tidyverse)Warning: package 'tidyverse' was built under R version 4.2.3Warning: package 'ggplot2' was built under R version 4.2.3Warning: package 'tidyr' was built under R version 4.2.3Warning: package 'readr' was built under R version 4.2.3Warning: package 'stringr' was built under R version 4.2.3Warning: package 'lubridate' was built under R version 4.2.3library(rstatix)Warning: package 'rstatix' was built under R version 4.2.3library(ggplot2)
library(ggpubr)Warning: package 'ggpubr' was built under R version 4.2.3library(lme4)Warning: package 'lme4' was built under R version 4.2.3Warning: package 'Matrix' was built under R version 4.2.3library(ez)Warning: package 'ez' was built under R version 4.2.3library(ggthemes)Warning: package 'ggthemes' was built under R version 4.2.3library(reghelper)Warning: package 'reghelper' was built under R version 4.2.3library(apaTables)Warning: package 'apaTables' was built under R version 4.2.3library(optimx)Warning: package 'optimx' was built under R version 4.2.3library(forcats)
library(here)Warning: package 'here' was built under R version 4.2.3Importing data
combined_data <- read_csv(here("data", "data_csv.csv"))New names:
• `` -> `...1`
• `...97` -> `...94`
• `...98` -> `...95`
• `...99` -> `...96`Warning: One or more parsing issues, call `problems()` on your data frame for details,
e.g.:
dat <- vroom(...)
problems(dat)Rows: 10577 Columns: 96
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (21): intro_key.keys, participant, date, expName, psychopyVersion, press...
dbl (65): ...1, welcome.started, welcome.stopped, intro_key.rt, intro_key.du...
lgl (10): press_space_consent.duration, practice_ready_space.duration, press...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.How many participants in the dataset?
t1 <- table(combined_data$participant)
nrow(t1)[1] 71# OBS: this includes people who did not finish the experimentData exclusion / filtering
#Are there non-whites?
table(combined_data$key_resp_race_check.keys)
a b n w
1 1 1 62 non_whites <- combined_data %>%
select(participant, key_resp_race_check.keys) %>%
filter(key_resp_race_check.keys == "a"|
key_resp_race_check.keys =="b"|
key_resp_race_check.keys =="n")
non_whites# A tibble: 3 × 2
participant key_resp_race_check.keys
<chr> <chr>
1 51 a
2 24 n
3 05 b processed_dat <- combined_data %>%
#filtering non-whites
filter(!(participant == "51" |
participant == "24"|
participant == "05"))
# N check
t2 <- table(processed_dat$participant)
nrow(t2)[1] 68Preparing data for analysis - create columns etc.
processed_dat <- processed_dat %>%
mutate(
ID = participant,
StimRace = ifelse(grepl("w", face), "White", "Black"),
StimObj = ifelse(grepl("g", object), "Gun", "Toy"),
ReactionTime = key_resp.rt,
LogRT = log(key_resp.rt),
Correct = ifelse(StimObj == "Gun" & key_resp.keys == "p" | StimObj == "Toy" & key_resp.keys == "q" ,1, 0),
too_slow = ifelse(is.na(too_slow_resp.keys), FALSE, TRUE)
) %>%
mutate(Correct = ifelse(too_slow == T, 0, Correct )) %>%
filter(!(is.na(Correct))) %>%
select(c(ID, StimRace, StimObj, ReactionTime, LogRT, Correct, too_slow))
# N check
t3 <- table(processed_dat$ID)
nrow(t3)[1] 653 additional passive exclusions, probably due to there not being valid data points.
Results of control measures
Checking accuracy
acc_dat <- processed_dat %>%
group_by(ID) %>%
summarise(mean_accuracy = mean(Correct))
acc_dat# A tibble: 65 × 2
ID mean_accuracy
<chr> <dbl>
1 01 0.916
2 02 0.916
3 03 0.881
4 04 0.678
5 07 0.909
6 08 0.902
7 09 0.741
8 10 0.755
9 11 0.371
10 12 0
# ℹ 55 more rowsExcluding participants due to high likelihood of being guessing:
exclude_list <- acc_dat %>%
filter(mean_accuracy < 0.6) %>%
select(-c(mean_accuracy))
exclude_list <- c(exclude_list$ID) # N = 12 people
processed_dat <- processed_dat %>%
filter(!(ID %in% exclude_list))
# N check
t3 <- table(processed_dat$ID)
nrow(t3)[1] 543 people were excluded based on not meeting screener criteria (e.g., identifying as White). An additional 11 people were excluded due to accuracy rates compatible with chance level (below 60%). 3 people were passively exclude for lack of valid data points.
Filtering responses that were too slow or too fast
processed_dat <- processed_dat %>%
filter(ReactionTime > 0.1 & too_slow == F)
# N check
t4 <- table(processed_dat$ID)
nrow(t4)[1] 54Confirmatory analysis
A repeated measures ANOVA will be computed to probe for the significance of the Race of Prime X Object Classification interaction. RT logs will be used as per the original study and replication attempt. Box plots were generated for visualization. Additionally, bar plots with with 95% error bars were computed using ggplot2.
Preparing for analyses
# Turning into factors for ANOVA
processed_dat$ID <- as_factor(processed_dat$ID)
processed_dat$StimRace <- as_factor(processed_dat$StimRace)
processed_dat$StimObj <- as_factor(processed_dat$StimObj)
#Looking at summarized data
sum_dat <- processed_dat %>%
filter(Correct == 1) %>%
group_by(StimRace, StimObj, ID) %>%
get_summary_stats(LogRT, type = "mean_sd")
sum_dat# A tibble: 216 × 7
ID StimRace StimObj variable n mean sd
<fct> <fct> <fct> <fct> <dbl> <dbl> <dbl>
1 21 Black Toy LogRT 28 -1.35 0.293
2 04 Black Toy LogRT 20 -1.49 0.337
3 25 Black Toy LogRT 35 -1.38 0.238
4 13 Black Toy LogRT 27 -1.33 0.282
5 29 Black Toy LogRT 31 -1.04 0.194
6 64 Black Toy LogRT 30 -1.20 0.252
7 17 Black Toy LogRT 36 -1.03 0.087
8 49 Black Toy LogRT 34 -1.26 0.21
9 66 Black Toy LogRT 32 -1.37 0.219
10 26 Black Toy LogRT 29 -1.33 0.22
# ℹ 206 more rowsPlots
#Barplot with CI bars
sum_dat_plot <- processed_dat %>%
filter(Correct == 1) %>%
group_by(StimObj, StimRace) %>%
summarise(
n=n(),
MeanRT=mean(ReactionTime),
sd=sd(ReactionTime)
) %>%
mutate( se=sd/sqrt(n)) %>%
mutate( ci=se * qt((1-0.05)/2 + .5, n-1))`summarise()` has grouped output by 'StimObj'. You can override using the
`.groups` argument.sum_dat_plot# A tibble: 4 × 7
# Groups: StimObj [2]
StimObj StimRace n MeanRT sd se ci
<fct> <fct> <int> <dbl> <dbl> <dbl> <dbl>
1 Toy Black 1598 0.281 0.0741 0.00185 0.00364
2 Toy White 1620 0.278 0.0754 0.00187 0.00367
3 Gun Black 1567 0.254 0.0748 0.00189 0.00371
4 Gun White 1549 0.258 0.0736 0.00187 0.00367barplot_rescue <- sum_dat_plot %>%
ggplot(aes(x=StimObj, y=MeanRT, fill=StimRace)) +
geom_bar(stat = "identity", position=position_dodge()) +
geom_errorbar(aes(ymin=MeanRT-ci, ymax=MeanRT+ci), width=.2,
position=position_dodge(.9)) +
ggthemes::theme_few() +
coord_cartesian( ylim = c(0.15, 0.5)) +
scale_fill_brewer(palette="Paired") +
ggtitle( "Rescue Attempt" )
barplot_rescue
Running 2x2 repeated measures ANOVA
# ANOVA was not working due to one infinite value, so deleting this value
processed_dat <- processed_dat %>%
filter(Correct == 1) %>%
filter(is.finite(LogRT))
aov_model <- aov( data = processed_dat,
LogRT ~ StimObj*StimRace + Error(ID/(StimObj*StimRace)))
summary(aov_model)
Error: ID
Df Sum Sq Mean Sq F value Pr(>F)
StimObj 1 1.20 1.1976 0.506 0.480
StimRace 1 0.15 0.1546 0.065 0.799
StimObj:StimRace 1 2.51 2.5122 1.061 0.308
Residuals 50 118.38 2.3676
Error: ID:StimObj
Df Sum Sq Mean Sq F value Pr(>F)
StimObj 1 13.665 13.665 72.823 2.15e-11 ***
StimRace 1 0.216 0.216 1.150 0.289
StimObj:StimRace 1 0.004 0.004 0.021 0.885
Residuals 51 9.570 0.188
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Error: ID:StimRace
Df Sum Sq Mean Sq F value Pr(>F)
StimRace 1 0.0031 0.00314 0.063 0.802
StimObj:StimRace 1 0.0025 0.00254 0.051 0.822
Residuals 52 2.5707 0.04944
Error: ID:StimObj:StimRace
Df Sum Sq Mean Sq F value Pr(>F)
StimObj:StimRace 1 0.437 0.4374 3.644 0.0617 .
Residuals 53 6.362 0.1200
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Error: Within
Df Sum Sq Mean Sq F value Pr(>F)
Residuals 6118 395.9 0.06471 Interaction is marginally significant (p = 0.06) with this model.
Parallel replication
The original author of the study demonstrated interest in running a parallel replication attempt with an undergrad pool of participants at his institution. He collected data for N = 168 participants. In the following, I am going to analyze his data as well and include in my report and mini meta-analysis.
Demographics
Importantly, this undergraduate convenience sample is not homogeneously white, as is the case with the other samples. Below I investigate the ethnic/racial composition of the sample and create a white subsample.
demo_par <- readxl::read_excel(here("data","parallel_replication_demographics.xlsx")) %>%
select(Subject, subrace, subrace_open) %>%
mutate(race_ethnicity = case_when(
subrace == 1 ~ "Asian, Asian American, or Pacific Islander",
subrace == 2 ~ "Black or African American",
subrace == 3 ~ "Latino/a/x/e or Hispanic",
subrace == 4 ~ "Native American",
subrace == 5 ~ "White or European American",
subrace == 6 ~ "Mixed or Multiracial",
subrace == 7 ~ "Middle Eastern or North African",
subrace == 8 ~ "Prefer not to respond",
TRUE ~ "Unknown"))
prop.table(table(demo_par$race_ethnicity))
Asian, Asian American, or Pacific Islander
0.48214286
Black or African American
0.04166667
Latino/a/x/e or Hispanic
0.26190476
Middle Eastern or North African
0.01785714
Mixed or Multiracial
0.02976190
Native American
0.01785714
Prefer not to respond
0.01190476
White or European American
0.13690476 Only 13% (N = 23) of the sample is white. For power purposes, I will do the main analysis with the whole sample for now, but will create a subsample and run the ANOVA for comparison.
data_par_raw <- readxl::read_excel(here("data","parallel_replication_data.xlsx"))
data_par <- data_par_raw %>%
select(Subj, race_prime, target, RT, Correct)
# N check
nrow(table(data_par$Subj))[1] 168# Checking accuracy
acc_dat_par <- data_par %>%
group_by(Subj) %>%
summarise(mean_accuracy = mean(Correct))
hist(acc_dat_par$mean_accuracy)
Exclude people with accuracy below 60%
exclude_list_par <- acc_dat_par %>%
filter(mean_accuracy < 0.6) %>%
select(-c(mean_accuracy))
exclude_list_par <- c(exclude_list_par$Subj) # N = 7 people
data_par <- data_par %>%
filter(!(Subj %in% exclude_list_par))
# N check
nrow(table(data_par$Subj))[1] 161Filtering out responses that were too slow (> 500 ms) or too fast (< 100 ms)
data_par <- data_par %>%
filter(RT > 0.1 | RT < 500)
# N check
nrow(table(data_par$Subj))[1] 161Preparing for analyses
# Turning into factors for ANOVA
data_par$Subj <- as_factor(data_par$Subj)
data_par$race_prime <- as_factor(data_par$race_prime)
data_par$target <- as_factor(data_par$target)
#Looking at summarized data
sum_dat_par <- data_par %>%
filter(Correct == TRUE) %>%
mutate(LogRT = log(RT)) %>%
group_by(race_prime, target, Subj) %>%
get_summary_stats(LogRT, type = "mean_sd")
sum_dat_par# A tibble: 644 × 7
Subj race_prime target variable n mean sd
<fct> <fct> <fct> <fct> <dbl> <dbl> <dbl>
1 1 black gun LogRT 36 5.81 0.2
2 2 black gun LogRT 34 5.61 0.257
3 3 black gun LogRT 33 5.45 0.242
4 4 black gun LogRT 34 5.88 0.459
5 5 black gun LogRT 35 5.29 0.358
6 6 black gun LogRT 34 5.25 0.258
7 7 black gun LogRT 35 5.29 0.258
8 8 black gun LogRT 32 5.53 0.3
9 9 black gun LogRT 35 5.72 0.299
10 10 black gun LogRT 32 5.64 0.39
# ℹ 634 more rowsParallel replication plot
#Barplot with CI bars
sum_dat_plot_par <- data_par %>%
filter(Correct == T) %>%
group_by(race_prime, target) %>%
summarise(
n=n(),
MeanRT=mean(RT),
sd=sd(RT)
) %>%
mutate( se=sd/sqrt(n)) %>%
mutate( ci=se * qt((1-0.05)/2 + .5, n-1))`summarise()` has grouped output by 'race_prime'. You can override using the
`.groups` argument.sum_dat_plot_par# A tibble: 4 × 7
# Groups: race_prime [2]
race_prime target n MeanRT sd se ci
<fct> <fct> <int> <dbl> <dbl> <dbl> <dbl>
1 black gun 5245 295. 239. 3.29 6.46
2 black toy 5262 335. 226. 3.11 6.10
3 white gun 5197 300. 225. 3.13 6.13
4 white toy 5304 334. 279. 3.83 7.51barplot_par <- sum_dat_plot_par %>%
ggplot(aes(x=target, y=MeanRT, fill=race_prime)) +
geom_bar(stat = "identity", position=position_dodge()) +
geom_errorbar(aes(ymin=MeanRT-ci, ymax=MeanRT+ci), width=.2,
position=position_dodge(.9)) +
ggthemes::theme_few() +
guides(fill = F) +
coord_cartesian( ylim = c(150, 500)) +
scale_fill_brewer(palette="Paired") +
scale_x_discrete(limits = rev) +
ggtitle( "Parallel Replication Attempt" ) Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
of ggplot2 3.3.4.barplot_par
Data analysis of parallel replication attempt
# log transforming
data_par <- data_par %>%
mutate(LogRT = log(RT))
# repeated measures ANOVA
aov_model_par <- aov( data = data_par,
LogRT ~ target*race_prime + Error(Subj/(target*race_prime)))
summary(aov_model_par)
Error: Subj
Df Sum Sq Mean Sq F value Pr(>F)
Residuals 160 856.9 5.356
Error: Subj:target
Df Sum Sq Mean Sq F value Pr(>F)
target 1 92.32 92.32 267.7 <2e-16 ***
Residuals 160 55.17 0.34
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Error: Subj:race_prime
Df Sum Sq Mean Sq F value Pr(>F)
race_prime 1 0.189 0.1891 1.184 0.278
Residuals 160 25.540 0.1596
Error: Subj:target:race_prime
Df Sum Sq Mean Sq F value Pr(>F)
target:race_prime 1 0.558 0.5579 4.342 0.0388 *
Residuals 160 20.560 0.1285
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Error: Within
Df Sum Sq Mean Sq F value Pr(>F)
Residuals 22540 3858 0.1712 Interaction is significant at the 5% level in this model.
Exploratory analysis of rescue replication
Now considering a mixed-effects model that is more appropriate to handle unbalanced design:
# Consider this model
lmm <- lmerTest::lmer( data = processed_dat,
LogRT ~ StimObj*StimRace + (StimObj|ID))
summary(lmm)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: LogRT ~ StimObj * StimRace + (StimObj | ID)
Data: processed_dat
REML criterion at convergence: 937.2
Scaled residuals:
Min 1Q Median 3Q Max
-4.1665 -0.6379 0.0305 0.6597 3.1209
Random effects:
Groups Name Variance Std.Dev. Corr
ID (Intercept) 0.018310 0.13532
StimObjGun 0.004088 0.06393 -0.03
Residual 0.065045 0.25504
Number of obs: 6334, groups: ID, 54
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) -1.307e+00 1.951e-02 5.952e+01 -66.985 < 2e-16 ***
StimObjGun -1.106e-01 1.261e-02 9.587e+01 -8.773 6.48e-14 ***
StimRaceWhite -1.474e-02 9.007e-03 6.236e+03 -1.636 0.1019
StimObjGun:StimRaceWhite 3.337e-02 1.285e-02 6.234e+03 2.598 0.0094 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) StmObG StmRcW
StimObjGun -0.187
StimRaceWht -0.233 0.360
StmObjG:SRW 0.163 -0.509 -0.701simple_slopes(lmm) StimObj StimRace Test Estimate Std. Error df t value Pr(>|t|) Sig.
1 Toy sstest -0.0147 0.0090 6235.5260 -1.6360 0.10188
2 Gun sstest 0.0186 0.0092 6235.4342 2.0351 0.04188 *
3 sstest Black -0.1106 0.0126 95.8714 -8.7727 6.485e-14 ***
4 sstest White -0.0772 0.0126 95.9393 -6.1249 1.991e-08 ***In this model, we see a significant interaction of object and race of prime at the 1% level. Simple slopes analysis indicates there is an effect of race for gun, but not for toy.
OBS: A decision was made to include a random intercept and a random coefficient for StimObj (i.e., gun vs. toy) but not for StimRace or the interaction due to issues with singularity in the model.
Exploratory analysis of parallel replication
# Consider this model
lmm_par <- lmerTest::lmer( data = data_par,
LogRT ~ target*race_prime + (target|Subj))
summary(lmm_par) Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: LogRT ~ target * race_prime + (target | Subj)
Data: data_par
REML criterion at convergence: 25514.9
Scaled residuals:
Min 1Q Median 3Q Max
-8.4531 -0.4057 0.0334 0.4459 9.1779
Random effects:
Groups Name Variance Std.Dev. Corr
Subj (Intercept) 0.038056 0.19508
targettoy 0.004833 0.06952 -0.24
Residual 0.170800 0.41328
Number of obs: 23184, groups: Subj, 161
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 5.557e+00 1.630e-02 1.793e+02 340.806 <2e-16 ***
targettoy 1.360e-01 9.432e-03 3.572e+02 14.421 <2e-16 ***
race_primewhite 1.552e-02 7.677e-03 2.286e+04 2.022 0.0432 *
targettoy:race_primewhite -1.962e-02 1.086e-02 2.286e+04 -1.807 0.0707 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) trgtty rc_prm
targettoy -0.323
race_prmwht -0.235 0.407
trgtty:rc_p 0.166 -0.576 -0.707simple_slopes(lmm_par) target race_prime Test Estimate Std. Error df t value Pr(>|t|) Sig.
1 gun sstest 0.0155 0.0077 22859.9962 2.0219 0.0432 *
2 toy sstest -0.0041 0.0077 22859.9932 -0.5340 0.5933
3 sstest black 0.1360 0.0094 357.1676 14.4210 <2e-16 ***
4 sstest white 0.1164 0.0094 357.1677 12.3405 <2e-16 ***-1.962e-02 / sqrt(0.038056+0.004833) [1] -0.0947384Interaction is marginally significant in this model and simple slopes indicates an effect of race for guns.
OBS: A decision was made to include a random intercept and a random coefficient for target (i.e., gun vs. toy) but not for race_prime or the interaction due to issues with singularity in the model.
Below I investigate the effect by subsampling only white participants.
#Creating white subject list
white_subj_list <- demo_par %>%
filter(subrace == 5) %>%
select(Subject)
white_subj_list <- c(white_subj_list$Subject)
#Filtering the dataset
data_par_w <- data_par %>%
filter(Subj %in% white_subj_list)
#Running ANOVA
aov_model_par_w <- aov( data = data_par_w,
LogRT ~ target*race_prime + Error(Subj/(target*race_prime)))
summary(aov_model_par_w)
Error: Subj
Df Sum Sq Mean Sq F value Pr(>F)
Residuals 22 108.2 4.92
Error: Subj:target
Df Sum Sq Mean Sq F value Pr(>F)
target 1 15.162 15.162 55.17 1.98e-07 ***
Residuals 22 6.046 0.275
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Error: Subj:race_prime
Df Sum Sq Mean Sq F value Pr(>F)
race_prime 1 0.0146 0.01462 0.163 0.691
Residuals 22 1.9768 0.08985
Error: Subj:target:race_prime
Df Sum Sq Mean Sq F value Pr(>F)
target:race_prime 1 0.0229 0.02285 0.203 0.657
Residuals 22 2.4776 0.11262
Error: Within
Df Sum Sq Mean Sq F value Pr(>F)
Residuals 3220 451.5 0.1402 The interaction is not significant at the 5% level a smaller sample (N=23) of white participants.
Four-panel graph
The original study does not have a plot, so I am creating one based on table results
# Computing data from table in original paper
data_barplot_original <- tibble(
MeanRT = c(296.6, 287.7, 255.8, 261.9),
sd = c(30.7, 30.7, 35.0, 37.4 ),
n = c(63, 63, 63, 63),
StimRace = c("Black", "White", "Black", "White"),
StimObj = c( "Toy", "Toy", "Gun", "Gun"),
se=sd/sqrt(n),
ci=se * qt((1-0.05)/2 + .5, n-1))
# Creating barplot
barplot_original <- data_barplot_original %>%
ggplot(aes(x=StimObj, y=MeanRT, fill=StimRace)) +
guides(fill = F) +
geom_bar(stat = "identity", position=position_dodge()) +
geom_errorbar(aes(ymin=MeanRT-ci, ymax=MeanRT+ci), width=.2,
position=position_dodge(.9)) +
ggthemes::theme_few() +
coord_cartesian( ylim = c(150, 500)) +
scale_fill_brewer(palette="Paired") +
ggtitle("Original") +
scale_x_discrete(limits = rev)
barplot_original
Recreating first replication attempt plot
#Creating dataset from project report
data_barplot_1strep <- data_frame(
MeanRT = c(435.0216, 433.6726, 449.5880, 447.5060),
StimRace = c("Black", "White", "Black", "White"),
StimObj = c( "Toy", "Toy", "Gun", "Gun"),
ci.lo = c(414.3615, 410.6880, 440.6488, 438.9164),
ci.hi = c(455.6817, 456.6572, 458.5272, 456.0956)
)Warning: `data_frame()` was deprecated in tibble 1.1.0.
ℹ Please use `tibble()` instead.# Creating barplot
barplot_1strep <- data_barplot_1strep %>%
ggplot(aes(x=StimObj, y=MeanRT, fill=StimRace)) +
guides(fill = "none") +
geom_bar(stat = "identity", position=position_dodge()) +
geom_errorbar(aes(ymin=ci.lo, ymax=ci.hi), width=.2,
position=position_dodge(.9)) +
ggthemes::theme_few() +
coord_cartesian( ylim = c(150, 500)) +
scale_fill_brewer(palette="Paired") +
ggtitle("1st Replication") +
scale_x_discrete(limits = rev)
barplot_1strep
#Arranging plots side by side
all_plots <- ggarrange(
barplot_original,
barplot_1strep,
barplot_rescue + theme(legend.position = c(0.8, 0.8)),
barplot_par,
nrow = 1,
widths = c(3, 3, 3, 3))Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
3.5.0.
ℹ Please use the `legend.position.inside` argument of `theme()` instead.ggsave("Arranged plots.jpg", plot = all_plots,
width = 14)Saving 14 x 5 in imageknitr::include_graphics("Arranged plots.jpg")
Discussion
Summary of Replication Attempt
The present replication attempt found a marginally interaction effect of race of prime and reaction time of object categorization in a Prolific sample of 54 white participants between 18-35 years old. When using a more appropriate method (mixed-effects model), the interaction emerged more clearly and a significant effect of race of prime was found for the categorization of guns, but not for toys. The effect size was not as strong as observed in the original study (partial eta squared of 0.06 as opposed to 0.22).
Additionally, the author of the original study ran a parallel replication attempt with an undergrad participant pool at their institution. This experiment yielded a significant interaction of race of prime and object classification at the 5% significance level. From exploratory analysis with mixed effects models, as well as from patterns in the graph, it seems like the interaction is driven by a difference in reaction time for categorization of guns, but no difference for toys. The results of the parallel replication attempt are compatible with the results of the rescue experiment.
Interestingly, the sample of the parallel replication attempt (effective N = 161) was racially and ethnically diverse, which is different from the original study and the 1st and rescue replication attempts. Although a significant interaction was present in the full sample, it was not present when analyzing the white subset (N = 23) of the sample separately. Concerns of statistical power could explain a lack of effect in this subsample.
According to LeBel et al.’s (2018) taxonomy of replications, this study falls under a “Very Close Replication (Procedure or physical setting is different)”. In a scale of 0-1, the rating given to this replication attempt it 0.75. The effect was replicated for guns, but not for toys, and with a much smaller magnitude. Qualitatively, however, the interpretation of the finding remains similar, as in it would be reasonable to affirm that study participants reacted faster to categorize guns after seeing the face of a black boy versus after seeing the face of a white boy.
Mini meta-analysis
Combining across the original paper, 1st replication, rescue replication, and parallel replication what is the aggregate effect size?
library(metafor)Warning: package 'metafor' was built under R version 4.2.3Warning: package 'metadat' was built under R version 4.2.3#install.packages("MBESS")
library(MBESS)Warning: package 'MBESS' was built under R version 4.2.3#install.packages("sjstats")
library(sjstats)Warning: package 'sjstats' was built under R version 4.2.3Calculating partial eta sq with confidence intervals
## original
ci.pvaf(F.value=17.21, df.1=1, df.2=62, N=64, conf.level=.95)
## 1st replication
# calculating unreported partial eta sq based on anova variances:
0.000127/(0.000127+0.020138)
ci.pvaf(F.value=0.057, df.1=1, df.2=23, N=26, conf.level=.95)
# rescue
effectsize::eta_squared(aov_model)
ci.pvaf(F.value=3.552, df.1=1, df.2=54, N=56, conf.level=.95)
# parallel replication
effectsize::eta_squared(aov_model_par)
ci.pvaf(F.value=4.34, df.1=1, df.2=160, N=162, conf.level=.95)
# other option for ci (same results)
# apaTables::get.ci.partial.eta.squared(F.value=4.34, df1=1, df2=160, conf.level=.95)Creating dataset
d_meta <- tibble(
Study = c("Original", "1st replication", "Rescue", "Parallel"),
N = c(63, 26, 54, 161),
Effect_Size = c(0.22, 0.006, 0.06, 0.03),
ci.lo = c(0.06, 0, 0, 0),
ci.hi = c(0.37, 0.13, 0.21, 0.09)
)Mini meta-analysis
In this section, I aggregate results of the original study, the first replication attempt and the present rescue replication attempt.
for_meta <- d_meta %>%
mutate(se=(ci.hi-ci.lo)/(2*1.96))
mini_meta_mod <- rma(yi=Effect_Size, sei=se, slab=Study, data=for_meta)
summary(mini_meta_mod)
Random-Effects Model (k = 4; tau^2 estimator: REML)
logLik deviance AIC BIC AICc
3.2770 -6.5539 -2.5539 -4.3567 9.4461
tau^2 (estimated amount of total heterogeneity): 0.0000 (SE = 0.0010)
tau (square root of estimated tau^2 value): 0.0022
I^2 (total heterogeneity / total variability): 0.30%
H^2 (total variability / sampling variability): 1.00
Test for Heterogeneity:
Q(df = 3) = 6.5007, p-val = 0.0896
Model Results:
estimate se zval pval ci.lb ci.ub
0.0358 0.0174 2.0539 0.0400 0.0016 0.0699 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Plot
aggregate <- tibble(Study="Aggregate", Effect_Size=mini_meta_mod$b,
ci.lo=mini_meta_mod$ci.lb, ci.hi=mini_meta_mod$ci.ub,N=sum(d_meta$N))
for_plot <- d_meta %>%
bind_rows(aggregate) %>%
mutate(Study=factor(Study, levels=c("Aggregate", "Original", "1st replication", "Rescue", "Parallel")))
ggplot(for_plot,aes(x=Study, y=Effect_Size, ymin=ci.lo, ymax=ci.hi, size=N)) +
geom_errorbar(colour='darkgray',size=.5,width=.25)+
geom_point(data=for_plot |> filter(Study!="Aggregate"))+
geom_point(data=for_plot |> filter(Study=="Aggregate"),shape=18, color="red")+
coord_flip()+
scale_size_area()+
geom_hline(yintercept=0,color="black")+
theme(legend.position = "none")+
geom_vline(xintercept = 1.5, lty=2)+
labs(y="Partial eta squared of repeated measures ANOVA", x="")Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.
Results of the meta-analysis indicate an aggregate estimate of a partial eta squared of 0.036 for the interaction of race of prime and categorization of objects in predicting log reaction times. This estimate is significant at the 5% level. According to guidelines for interpreting partial eta squared (Miles & Shelvin, 2001), a partial eta squared of 0.036 is between a small (0.01) and medium (0.06) effect. Although this effect is substantially smaller than the one reported in the original study, the weight of the evidence points towards a small to medium effect that is significantly different from zero.
Commentary and conclusion
This rescue project aimed at investigating whether the race of a priming face image (Black vs. white) altered the speed necessary for participants to categorize toys and guns. There was some evidence of a statistically significant effect from Prolific data alone. When aggregated with data from the original study, the first replication attempt, and the parallel replication effort from the original author, the weight of the evidence pointed toward a small to medium effect, with a 95% confidence interval that did not include zero. Interestingly, the effect seemed to be present for a racially diverse sample of study participants, extrapolating from the original, the 1st replication, and the rescue attempt, which only included white participants.
One additional comment is the fact that the 1st replication attempt had very low quality data, a very small sample size and accuracy rates compatible with chance, so this data might be adding noise to the overall estimate of the aggregated effect.