This week was a much slower week as we had finished reproducing the plots from the original paper!
Now I had to move on to exploratory analyses. Leading me to my goals for this week:
What are my questions?
In my summary and reaction, I talk mainly about how the results from the Hu et al. paper could not be replicated, potentially due to a list of factors.
In an attempt to find a significant result to potentially show an effect, I have settled on the following questions so far:
Is there a significant effect for specific biases? i.e. is there an effect if we only look at race bias changes, or gender bias changes?
The cues were played for a large range of different times for each participant ranging from 7 minutes to even 44 minutes. Does time length of cue played influence changes in implicit bias?
Huminston and Wamsley also implemented the study slightly differently to the original paper, with a questionaire at the start of the study, timing of when they asked if the participant heard the cue after the nap, and also introducing a new exit questionnaire. Differently to the original study, the post nap questionnaire was given immediately after the nap. Furthermore, in the original study, the participants were only compensated with course credits, whereas in the presented study, some were financially compensated.
We will start with the first question!
Load packages
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.2 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(readspss)
library(plotrix)
This is my attempt to determine if gender or race influences the effect of the TMR (targeted memory reactivation) is influenced by type of bias.
The question I’m proposing is:
Is there a significant effect for specific biases?
Loading data
data <- read.sav("Humiston & Wamsley 2019 data.sav")
Cleaning data
cleandata <- data %>%
filter(exclude == "no")
possible relevant variables
Here I am removing participants who were presented the race cue during the nap
Genderparticipants <- cleandata %>%
filter(Cue_condition == "gender cue played")
Selecting relevant variables for time points of measurement for bias change, calculating means using the summarise function, and calculating SE using the std.error function.
genderchange <- Genderparticipants %>%
select(base_IAT_gen, pre_IAT_gen, post_IAT_gen, week_IAT_gen)
genderchangedata <- genderchange %>%
summarise(across(contains("IAT"), list(mean = "mean")))
genderchangeSE <- std.error(genderchange)
print(genderchangedata)
## base_IAT_gen_mean pre_IAT_gen_mean post_IAT_gen_mean week_IAT_gen_mean
## 1 0.49767 0.3357758 0.3389568 0.4857734
print(genderchangeSE)
## base_IAT_gen pre_IAT_gen post_IAT_gen week_IAT_gen
## 0.07186912 0.11089910 0.12809562 0.08824424
Now I repeat the method.
Raceparticipants <- cleandata %>%
filter(Cue_condition == "race cue played")
racechange <- Raceparticipants %>%
select(base_IAT_race, pre_IAT_race, post_IAT_race, week_IAT_race)
racechangedata <- racechange %>%
summarise(across(contains("IAT"), list(mean = "mean")))
racechangeSE <- std.error(racechange)
print(racechangedata)
## base_IAT_race_mean pre_IAT_race_mean post_IAT_race_mean week_IAT_race_mean
## 1 0.533979 0.1080363 0.2803619 0.3292815
print(racechangeSE)
## base_IAT_race pre_IAT_race post_IAT_race week_IAT_race
## 0.1051369 0.1394592 0.1035415 0.1031192
Now I have the means for each type of bias for each timepoint, including SE, separated by the type of bias played.
i.e. I’m looking at changes of race bias over time, for participants played the race cue during the nap and vice versa.
Time to try putting this into a plot!
Since the plot will be showing changes over time, I believe a line plot would be suitable to show trends over time.
biasdata <- data.frame(
condition = factor(c("Gender", "Gender", "Gender", "Gender", "Race", "Race", "Race", "Race")),
time = factor(c("Baseline", "Prenap", "Postnap", "1-week", "Baseline", "Prenap", "Postnap", "1-week")),
levels = c("Baseline", "Prenap", "Postnap", "1-week"),
bias_av = c(0.49767, 0.3357758, 0.3389568, 0.4857734, 0.533979, 0.1080363, 0.2803619, 0.3292815),
se = c( 0.07186912, 0.11089910, 0.12809562, 0.08824424, 0.1051369, 0.1394592, 0.1035415, 0.1031192)
)
I also looked up how to change label names and how to add title names using labs
ggplot(data = biasdata, aes(
x = factor(time, level = c("Baseline", "Prenap", "Postnap", "1-week")),
y = bias_av,
colour = condition,
group = condition)) +
geom_line() +
geom_errorbar(aes(
x= time,
ymin=bias_av-se,
ymax=bias_av+se),
width=0.1, colour="grey", alpha= 0.9) +
labs(x = "time", title = "Bias change for bias type")
I find this plot very interesting!
Both biases decrease following treatment (race more than gender), and both increase after the nap and follow up. However, It is noted that the race condition doesn’t return as close to baseline as gender does.
Perhaps this is because race bias decreased more than gender bias generally? Or perhaps the treatment somewhat worked?
To see if TMR worked for gender biases, I would need to calculate more data and a new plot to compare cued vs uncued conditions, as this plot only looks at differences between cued participants for each bias type.
Lets try that out:
There is no specific variable for participants cued with race cues. However there are variables that look at bias levels for cued bias types. i.e. both gender and race cued participants in the same column.
Therefore, I need to filter out the participants that were cued with gender.
Here I am selecting participants played the race cue, and selecting the variables which contain the measurements of bias for each time point for these participants.
racedatacued <- Raceparticipants %>%
select(base_IAT_race, pre_IAT_race, post_IAT_race, week_IAT_race)
racedatacuedmeans <- racedatacued %>%
summarise(across(contains("IAT"), list(mean = "mean")))
racedatacueSE <- std.error(racedatacued)
print(racedatacuedmeans)
## base_IAT_race_mean pre_IAT_race_mean post_IAT_race_mean week_IAT_race_mean
## 1 0.533979 0.1080363 0.2803619 0.3292815
print(racedatacueSE)
## base_IAT_race pre_IAT_race post_IAT_race week_IAT_race
## 0.1051369 0.1394592 0.1035415 0.1031192
Since I am choosing to use data for pariticpants played the gender cue, it implies they were not played the race cue, and should show no change for race bias.
racedatauncued <- Genderparticipants %>%
select(base_IAT_race, pre_IAT_race, post_IAT_race, week_IAT_race)
racedatauncuedmeans <- racedatauncued %>%
summarise(across(contains("IAT"), list(mean = "mean")))
racedatauncuedSE <- std.error(racedatauncued)
print(racedatauncuedmeans)
## base_IAT_race_mean pre_IAT_race_mean post_IAT_race_mean week_IAT_race_mean
## 1 0.7215597 0.3168438 0.3243954 0.5191932
print(racedatauncuedSE)
## base_IAT_race pre_IAT_race post_IAT_race week_IAT_race
## 0.1193954 0.1462797 0.1344576 0.1267464
racebiasdata <- data.frame(
condition = factor(c("Cued", "Cued", "Cued", "Cued", "Uncued", "Uncued", "Uncued", "Uncued")),
time = factor(c("Baseline", "Prenap", "Postnap", "1-week", "Baseline", "Prenap", "Postnap", "1-week")),
levels = c("Baseline", "Prenap", "Postnap", "1-week"),
bias_av = c(0.533979, 0.1080363, 0.2803619 , 0.3292815, 0.1080363, 0.2803619, 0.3292815, 0.5191932),
se = c( 0.1051369, 0.1394592, 0.1035415, 0.1031192, 0.1193954, 0.1462797, 0.1344576, 0.1267464)
)
ggplot(data = racebiasdata, aes(
x = factor(time, level = c("Baseline", "Prenap", "Postnap", "1-week")),
y = bias_av,
colour = condition,
group = condition)) +
geom_line() +
geom_errorbar(aes(
x= time,
ymin=bias_av-se,
ymax=bias_av+se),
width=0.1, colour="grey", alpha= 0.9) +
labs(x = "time", title = "Race Bias Change")
Hm, not sure if I did this right. The baseline measures are drastically different, whereas I would assume they should be similar, along with the prenap scores.
This is because all participants undergo training for both biases. Therefore, race biases for both conditions should be similar for prenap measures.
However, I think I found the problem. I copy pasted the wrong data!
racebiasdata2 <- data.frame(
condition = factor(c("Cued", "Cued", "Cued", "Cued", "Uncued", "Uncued", "Uncued", "Uncued")),
time = factor(c("Baseline", "Prenap", "Postnap", "1-week", "Baseline", "Prenap", "Postnap", "1-week")),
levels = c("Baseline", "Prenap", "Postnap", "1-week"),
bias_av = c(0.533979, 0.1080363, 0.2803619 , 0.3292815, 0.7215597, 0.3168438, 0.3243954, 0.5191932),
se = c( 0.1051369, 0.1394592, 0.1035415, 0.1031192, 0.1193954, 0.1462797, 0.1344576, 0.1267464)
)
ggplot(data = racebiasdata2, aes(
x = factor(time, level = c("Baseline", "Prenap", "Postnap", "1-week")),
y = bias_av,
colour = condition,
group = condition)) +
geom_line() +
geom_errorbar(aes(
x= time,
ymin=bias_av-se,
ymax=bias_av+se),
width=0.1, colour="grey", alpha= 0.9) +
labs(x = "time", title = "Race Bias Change")
This looks more like it. Interestingly, they both show a similar trend of decreasing in bias following training but increasing after the nap. I will not that the cued condition has less increase in bias from postnap to 1 week delay measures. Perhaps this effect could be significant?
I believe next week we will be looking into statistical analysis. Perhaps I could use this to determine if the above is a significant effect?
Although this week was quite light in terms of challenges, I think the questions I want to tackle next week are a little more complicated and may involve splitting the data into high/low groups etc.
The next steps for that aspect of my coding journey would to be to do some research on how to do that, and what functions may be useful. I recall something similar being looked at in the Q and A, so I plan to go back to that!