data_dir <- here("data_and_analysis","imagery")
plot_dir <- here("data_and_analysis","imagery","plots")
df.data <- read.csv(paste0(data_dir, "/", "stroop_data_clean.csv")) %>%
mutate(participant_id = as.factor(participant_id))
df.summary_patch <- df.data %>%
filter(wm_correct) %>%
group_by(participant_id, word_cond, stim_congruent) %>%
summarise(mean_patch_acc = mean(patch_correct, na.rm = TRUE),
mean_patch_rt = mean(patch_rt, na.rm = TRUE),
n_cell = n(),
.groups = "keep"
) %>%
ungroup()
df.summary_wm <- df.data %>%
group_by(participant_id, word_cond, stim_congruent) %>%
summarise(mean_wm_acc = mean(wm_correct, na.rm = TRUE),
mean_wm_rt = mean(wm_rt, na.rm = TRUE),
n_cell = n(),
.groups = "keep"
) %>%
ungroup()wm_stroop_semantic
WM Stroop Semantic (Imagery)
Setup
Load packages
You can add options to executable code like this
Load data
Who is in our data? We excluded participants who responded to fewer than 2/3 of trials OR whose mean accuracy was below 0.3 for the color naming task (chance is 0.25) and below 0.55 for the working memory task (chance is 0.5).
Trial filtering: Following Kiyonaga & Egner (2014), we included only trials where participants correctly responded to the memory task.
Patch congruence on RT
Plot of RT for color naming task in each word condition
patch_rt <- df.summary_patch %>%
ggplot(aes(x = stim_congruent, y = mean_patch_rt, color = stim_congruent)) +
geom_line(aes(group = participant_id), color = "gray80", alpha = 0.6) +
geom_jitter(width = 0.1, alpha = 0.6) +
facet_grid(~word_cond) +
labs(x = "Patch congruency", y = "Mean Response Time") +
scale_x_discrete(labels = c("FALSE" = "Incongruent", "TRUE" = "Congruent")) +
scale_color_brewer(palette = "Dark2", guide="none") +
stat_summary(fun.data = mean_se, geom = "errorbar", width = 0.2, color = "black") +
stat_summary(fun = mean, geom = "point", size = 3, color = "black") +
theme_light()
patch_rt
if (SAVE_PLOTS){
save_plot(patch_rt, "patch_rt.png", plot_dir)
}Statistics
Does holding color-conflicting information in WM affect performance on a color naming task?
Approach: We fit linear mixed effects models to the trial-by-trial data. Our fixed effect was whether the word and color patch were congruent (e.g. banana + a yellow color patch) or incongruent (e.g., banana + a blue color patch).
Response time: We assumed a Gaussian family with an identity link function for the response time data (although RTs tend to be skewed, linear mixed effects models are pretty robust to violations of non-normality). Participants were entered as random intered, and we included a by-participant random slope for stimulus congruency, as participants do not “Stroop” equally.
Accuracy: We fit the accuracy data (0s and 1s) with a generalized linear mixed effects model, assuming a binomial distribution. Mirroring our response time analysis, participants were entered as random intercepts, and although we attempted to include a by-participant random slope for congruency, our model fits displayed typical signs of overfitting.
The results: Participants were significantly faster on the color judgement task (by about 72 ms) when
set.seed(42)
patch_rt_mod <- df.data %>%
filter(wm_correct) %>%
lmerTest::lmer(patch_rt ~ 1 + word_cond*stim_congruent + (1 + stim_congruent | participant_id),
data = .)
summary(patch_rt_mod)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: patch_rt ~ 1 + word_cond * stim_congruent + (1 + stim_congruent |
participant_id)
Data: .
REML criterion at convergence: 131668.5
Scaled residuals:
Min 1Q Median 3Q Max
-3.3702 -0.6639 -0.1799 0.4742 5.4352
Random effects:
Groups Name Variance Std.Dev. Corr
participant_id (Intercept) 16341 127.8
stim_congruentTRUE 2580 50.8 -0.17
Residual 52950 230.1
Number of obs: 9582, groups: participant_id, 55
Fixed effects:
Estimate Std. Error df t value
(Intercept) 741.245 17.904 57.865 41.401
word_condsemantic 7.888 6.739 9475.061 1.171
stim_congruentTRUE -64.952 9.605 90.631 -6.762
word_condsemantic:stim_congruentTRUE 15.626 9.414 9474.363 1.660
Pr(>|t|)
(Intercept) < 2e-16 ***
word_condsemantic 0.242
stim_congruentTRUE 1.29e-09 ***
word_condsemantic:stim_congruentTRUE 0.097 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) wrd_cn s_TRUE
wrd_cndsmnt -0.192
stm_cngTRUE -0.255 0.358
wrd_c:_TRUE 0.138 -0.716 -0.498# Fixed effects:
# Estimate Std. Error df t value Pr(>|t|)
# (Intercept) 741.245 17.904 57.865 41.401 < 2e-16 ***
# word_condsemantic 7.888 6.739 9475.061 1.171 0.242
# stim_congruentTRUE -64.952 9.605 90.631 -6.762 1.29e-09 ***
# word_condsemantic:stim_congruentTRUE 15.626 9.414 9474.363 1.660 0.097 .
anova(patch_rt_mod)Type III Analysis of Variance Table with Satterthwaite's method
Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
word_cond 589155 589155 1 9474.2 11.127 0.0008542 ***
stim_congruent 2491389 2491389 1 51.3 47.052 8.836e-09 ***
word_cond:stim_congruent 145880 145880 1 9474.4 2.755 0.0969812 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Type III Analysis of Variance Table with Satterthwaite's method
# Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
# word_cond 589155 589155 1 9474.2 11.127 0.0008542 ***
# stim_congruent 2491389 2491389 1 51.3 47.052 8.836e-09 ***
# word_cond:stim_congruent 145880 145880 1 9474.4 2.755 0.0969812 . Breaking down by word condition (color words and color-associated words) and computing effect sizes…
emm_rt <- emmeans(patch_rt_mod, ~ stim_congruent | word_cond,
lmer.df = "satterthwaite",
lmerTest.limit = 9582,
pbkrtest.limit = 9582)
contrasts <- pairs(emm_rt, adjust = "none")
contrastsword_cond = color:
contrast estimate SE df t.ratio p.value
FALSE - TRUE 65.0 9.60 90.6 6.762 <.0001
word_cond = semantic:
contrast estimate SE df t.ratio p.value
FALSE - TRUE 49.3 9.53 87.8 5.175 <.0001
Degrees-of-freedom method: satterthwaite # word_cond = color:
# contrast estimate SE df t.ratio p.value
# FALSE - TRUE 65.0 9.60 90.6 6.762 <.0001
#
# word_cond = semantic:
# contrast estimate SE df t.ratio p.value
# FALSE - TRUE 49.3 9.53 87.8 5.175 <.0001
eff_size(emm_rt,
sigma = sigma(patch_rt_mod),
edf = df.residual(patch_rt_mod))word_cond = color:
contrast effect.size SE df lower.CL upper.CL
FALSE - TRUE 0.282 0.0418 57.6 0.199 0.366
word_cond = semantic:
contrast effect.size SE df lower.CL upper.CL
FALSE - TRUE 0.214 0.0414 57.5 0.131 0.297
sigma used for effect sizes: 230.1
Degrees-of-freedom method: inherited from satterthwaite when re-gridding
Confidence level used: 0.95 # word_cond = color:
# contrast effect.size SE df lower.CL upper.CL
# FALSE - TRUE 0.282 0.0418 57.6 0.199 0.366
#
# word_cond = semantic:
# contrast effect.size SE df lower.CL upper.CL
# FALSE - TRUE 0.214 0.0414 57.5 0.131 0.297
# We also want to obtain Cohen's d for the effect size on participant-level means
df.wide_patch_rt_color <- df.summary_patch %>%
filter(word_cond == "color") %>%
tidyr::pivot_wider(
names_from = stim_congruent,
values_from = mean_patch_rt,
id_cols = c(participant_id, word_cond)
) %>%
rename(congruent = `TRUE`, incongruent = `FALSE`)
effsize_rt_color <- effsize::cohen.d(
df.wide_patch_rt_color$congruent,
df.wide_patch_rt_color$incongruent,
paired = TRUE
)
effsize_rt_color
Cohen's d
d estimate: -0.486646 (small)
95 percent confidence interval:
lower upper
-0.6401991 -0.3330930 # Cohen's d
#
# d estimate: -0.486646 (small)
# 95 percent confidence interval:
# lower upper
# -0.6401991 -0.3330930
df.wide_patch_rt_semantic <- df.summary_patch %>%
filter(word_cond == "semantic") %>%
tidyr::pivot_wider(
names_from = stim_congruent,
values_from = mean_patch_rt,
id_cols = c(participant_id, word_cond)
) %>%
rename(congruent = `TRUE`, incongruent = `FALSE`)
effsize_rt_semantic <- effsize::cohen.d(
df.wide_patch_rt_semantic$congruent,
df.wide_patch_rt_semantic$incongruent,
paired = TRUE
)
effsize_rt_semantic
Cohen's d
d estimate: -0.3809264 (small)
95 percent confidence interval:
lower upper
-0.5279477 -0.2339052 # d estimate: -0.3809264 (small)
# 95 percent confidence interval:
# lower upper
# -0.5279477 -0.2339052 Patch congruence on accuracy
Plot of accuracy for color naming task
patch_acc <- df.summary_patch %>%
ggplot(aes(x = stim_congruent, y = mean_patch_acc, color = stim_congruent)) +
geom_line(aes(group = participant_id), color = "gray80", alpha = 0.6) +
geom_jitter(width = 0.1, alpha = 0.6) +
facet_grid(~word_cond) +
labs(x = "Patch congruency", y = "Mean Accuracy") +
scale_x_discrete(labels = c("FALSE" = "Incongruent", "TRUE" = "Congruent")) +
scale_color_brewer(palette = "Dark2", guide="none") +
stat_summary(fun.data = mean_se, geom = "errorbar", width = 0.2, color = "black") +
stat_summary(fun = mean, geom = "point", size = 3, color = "black") +
theme_light()
patch_acc
if (SAVE_PLOTS){
save_plot(patch_acc, "patch_acc.png", plot_dir)
}Statistics
set.seed(42)
patch_acc_mod <- df.data %>%
filter(wm_correct) %>%
glmer(patch_correct ~ 1 + word_cond*stim_congruent + (1 + stim_congruent | participant_id), data = ., family = "binomial")
summary(patch_acc_mod)Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
Formula:
patch_correct ~ 1 + word_cond * stim_congruent + (1 + stim_congruent |
participant_id)
Data: .
AIC BIC logLik -2*log(L) df.resid
6045.6 6096.0 -3015.8 6031.6 9915
Scaled residuals:
Min 1Q Median 3Q Max
-7.5774 0.2153 0.2666 0.3362 1.2603
Random effects:
Groups Name Variance Std.Dev. Corr
participant_id (Intercept) 0.6923 0.8321
stim_congruentTRUE 0.1457 0.3817 -0.01
Number of obs: 9922, groups: participant_id, 55
Fixed effects:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.42571 0.13573 17.871 <2e-16 ***
word_condsemantic -0.13090 0.09837 -1.331 0.1833
stim_congruentTRUE -0.10825 0.11717 -0.924 0.3555
word_condsemantic:stim_congruentTRUE 0.32853 0.13757 2.388 0.0169 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) wrd_cn s_TRUE
wrd_cndsmnt -0.390
stm_cngTRUE -0.366 0.453
wrd_c:_TRUE 0.279 -0.715 -0.590# Fixed effects:
# Estimate Std. Error z value Pr(>|z|)
# (Intercept) 2.42571 0.13573 17.871 <2e-16 ***
# word_condsemantic -0.13090 0.09837 -1.331 0.1833
# stim_congruentTRUE -0.10825 0.11717 -0.924 0.3555
# word_condsemantic:stim_congruentTRUE 0.32853 0.13757 2.388 0.0169 *
anova(patch_acc_mod)Analysis of Variance Table
npar Sum Sq Mean Sq F value
word_cond 1 0.2510 0.2510 0.2510
stim_congruent 1 0.4091 0.4091 0.4091
word_cond:stim_congruent 1 5.6084 5.6084 5.6084# Analysis of Variance Table
# npar Sum Sq Mean Sq F value
# word_cond 1 0.2510 0.2510 0.2510
# stim_congruent 1 0.4091 0.4091 0.4091
# word_cond:stim_congruent 1 5.6084 5.6084 5.6084
emm_acc <- emmeans(patch_acc_mod, ~ stim_congruent | word_cond, type = "response",
glmer.df = "satterthwaite",
lmerTest.limit = 9582,
pbkrtest.limit = 9582)
contrasts <- pairs(emm_acc, adjust = "none")
contrastsword_cond = color:
contrast odds.ratio SE df null z.ratio p.value
FALSE / TRUE 1.114 0.1310 Inf 1 0.924 0.3555
word_cond = semantic:
contrast odds.ratio SE df null z.ratio p.value
FALSE / TRUE 0.802 0.0937 Inf 1 -1.887 0.0592
Tests are performed on the log odds ratio scale # word_cond = color:
# contrast odds.ratio SE df null z.ratio p.value
# FALSE / TRUE 1.114 0.1310 Inf 1 0.924 0.3555
#
# word_cond = semantic:
# contrast odds.ratio SE df null z.ratio p.value
# FALSE / TRUE 0.802 0.0937 Inf 1 -1.887 0.0592WM Performance by Patch Congruency
wm_acc <- df.summary_wm %>%
ggplot(aes(x = stim_congruent, y = mean_wm_acc, color = stim_congruent)) +
geom_line(aes(group = participant_id), color = "gray80", alpha = 0.6) +
geom_jitter(width = 0.1, alpha = 0.6) +
facet_grid(~word_cond) +
labs(x = "Patch congruency", y = "Mean WM Accuracy") +
scale_x_discrete(labels = c("FALSE" = "Incongruent", "TRUE" = "Congruent")) +
scale_color_brewer(palette = "Dark2", guide="none") +
stat_summary(fun.data = mean_se, geom = "errorbar", width = 0.2, color = "black") +
stat_summary(fun = mean, geom = "point", size = 3, color = "black") +
theme_light()
wm_acc
if (SAVE_PLOTS){
save_plot(wm_acc, "wm_acc.png", plot_dir)
}
wm_acc_mod <- df.data %>%
glmer(wm_correct ~ 1 + word_cond*stim_congruent + (1 + stim_congruent | participant_id), data = ., family = "binomial")
summary(wm_acc_mod)Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
Formula: wm_correct ~ 1 + word_cond * stim_congruent + (1 + stim_congruent |
participant_id)
Data: .
AIC BIC logLik -2*log(L) df.resid
6877.0 6928.2 -3431.5 6863.0 11103
Scaled residuals:
Min 1Q Median 3Q Max
-7.7261 0.1870 0.2648 0.3605 1.0362
Random effects:
Groups Name Variance Std.Dev. Corr
participant_id (Intercept) 0.9111 0.9545
stim_congruentTRUE 0.3254 0.5705 -0.43
Number of obs: 11110, groups: participant_id, 55
Fixed effects:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.1359 0.1445 14.783 < 2e-16 ***
word_condsemantic 0.2325 0.0846 2.748 0.00599 **
stim_congruentTRUE 0.5154 0.1275 4.044 5.26e-05 ***
word_condsemantic:stim_congruentTRUE -0.2334 0.1290 -1.809 0.07043 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) wrd_cn s_TRUE
wrd_cndsmnt -0.270
stm_cngTRUE -0.463 0.305
wrd_c:_TRUE 0.177 -0.656 -0.492# Fixed effects:
# Estimate Std. Error z value Pr(>|z|)
# (Intercept) 2.1359 0.1445 14.783 < 2e-16 ***
# word_condsemantic 0.2325 0.0846 2.748 0.00599 **
# stim_congruentTRUE 0.5154 0.1275 4.044 5.26e-05 ***
# word_condsemantic:stim_congruentTRUE -0.2334 0.1290 -1.809 0.07043 .
emm_wm_acc <- emmeans(wm_acc_mod, ~ stim_congruent | word_cond, type = "response",
glmer.df = "satterthwaite",
lmerTest.limit = 9582,
pbkrtest.limit = 9582)
contrasts <- pairs(emm_wm_acc, adjust = "none")
contrastsword_cond = color:
contrast odds.ratio SE df null z.ratio p.value
FALSE / TRUE 0.597 0.0761 Inf 1 -4.044 0.0001
word_cond = semantic:
contrast odds.ratio SE df null z.ratio p.value
FALSE / TRUE 0.754 0.0975 Inf 1 -2.181 0.0292
Tests are performed on the log odds ratio scale # word_cond = color:
# contrast odds.ratio SE df null z.ratio p.value
# FALSE / TRUE 0.597 0.0761 Inf 1 -4.044 0.0001
#
# word_cond = semantic:
# contrast odds.ratio SE df null z.ratio p.value
# FALSE / TRUE 0.754 0.0975 Inf 1 -2.181 0.0292Imagery on Stroop effect
Let’s first just use the combined color and semantic data…
# Get each person's mean difference
patch_diffs_by_id <- df.data %>%
filter(wm_correct) %>%
group_by(participant_id, stim_congruent) %>%
summarise(
mean_patch_rt = mean(patch_rt, na.rm = TRUE),
mean_patch_acc = mean(patch_correct, na.rm = TRUE),
.groups = "keep"
) %>%
ungroup() %>%
pivot_wider(
id_cols = c(participant_id),
names_from = stim_congruent,
values_from = c(mean_patch_acc, mean_patch_rt),
names_glue = "{.value}_{ifelse(stim_congruent, 'cong', 'incong')}"
) %>%
mutate(
patch_acc_diff = mean_patch_acc_cong - mean_patch_acc_incong,
patch_rt_diff = mean_patch_rt_incong - mean_patch_rt_cong,
)
wm_diffs_by_id <- df.data %>%
group_by(participant_id, stim_congruent) %>%
summarise(
mean_wm_rt = mean(wm_rt, na.rm = TRUE),
mean_wm_acc = mean(wm_correct, na.rm = TRUE),
.groups = "keep"
) %>%
ungroup() %>%
pivot_wider(
id_cols = c(participant_id),
names_from = stim_congruent,
values_from = c(mean_wm_acc, mean_wm_rt),
names_glue = "{.value}_{ifelse(stim_congruent, 'cong', 'incong')}"
) %>%
mutate(
wm_acc_diff = mean_wm_acc_cong - mean_wm_acc_incong,
wm_rt_diff = mean_wm_rt_incong - mean_wm_rt_cong,
)
# load imagery data
df.imagery_scores <- read.csv(paste0(data_dir, "/imagery_scored.csv")) %>%
mutate(participant_id = as.factor(participant_id),
sum_score = as.numeric(sum_score)) %>%
unite(col = "measure", questionnaire, category, sep = "_") %>%
pivot_wider(
id_cols = participant_id,
names_from = measure,
values_from = sum_score
)
df.imagery_scores <- left_join(df.imagery_scores, patch_diffs_by_id, by = "participant_id")
df.imagery_scores <- left_join(df.imagery_scores, wm_diffs_by_id, by = "participant_id")
imagery_cols <- c("irq_manipulation","irq_orthographic","irq_verbal","irq_visual", "osivq_spatial", "osivq_verbal", "osivq_visual", "vviq_visual")
cor_results_rt <- purrr::map_dfr(imagery_cols, function(m) {
test <- cor.test(df.imagery_scores[[m]],
df.imagery_scores$patch_rt_diff,
use = "complete.obs")
tibble(measure = m, r = test$estimate, p = test$p.value, n = sum(complete.cases(df.imagery_scores[[m]], df.imagery_scores$patch_rt_diff)))
}) %>%
mutate(p_fdr = p.adjust(p, method = "BH"))
cor_results_rt# A tibble: 8 × 5
measure r p n p_fdr
<chr> <dbl> <dbl> <int> <dbl>
1 irq_manipulation 0.153 0.274 53 0.435
2 irq_orthographic 0.129 0.356 53 0.435
3 irq_verbal 0.169 0.226 53 0.435
4 irq_visual 0.231 0.0968 53 0.348
5 osivq_spatial 0.257 0.0629 53 0.348
6 osivq_verbal -0.0557 0.692 53 0.692
7 osivq_visual 0.123 0.381 53 0.435
8 vviq_visual 0.210 0.131 53 0.348cor_results_acc <- purrr::map_dfr(imagery_cols, function(m) {
test <- cor.test(df.imagery_scores[[m]],
df.imagery_scores$patch_acc_diff,
use = "complete.obs")
tibble(measure = m, r = test$estimate, p = test$p.value, n = sum(complete.cases(df.imagery_scores[[m]], df.imagery_scores$patch_acc_diff)))
}) %>%
mutate(p_fdr = p.adjust(p, method = "BH"))
cor_results_acc# A tibble: 8 × 5
measure r p n p_fdr
<chr> <dbl> <dbl> <int> <dbl>
1 irq_manipulation 0.241 0.0821 53 0.164
2 irq_orthographic 0.184 0.186 53 0.213
3 irq_verbal 0.279 0.0427 53 0.114
4 irq_visual 0.456 0.000595 53 0.00476
5 osivq_spatial 0.168 0.229 53 0.229
6 osivq_verbal -0.206 0.138 53 0.184
7 osivq_visual 0.426 0.00146 53 0.00585
8 vviq_visual 0.211 0.130 53 0.184 cor_results_wm_acc <- purrr::map_dfr(imagery_cols, function(m) {
test <- cor.test(df.imagery_scores[[m]],
df.imagery_scores$wm_acc_diff,
use = "complete.obs")
tibble(measure = m, r = test$estimate, p = test$p.value, n = sum(complete.cases(df.imagery_scores[[m]], df.imagery_scores$wm_acc_diff)))
}) %>%
mutate(p_fdr = p.adjust(p, method = "BH"))
cor_results_wm_acc# A tibble: 8 × 5
measure r p n p_fdr
<chr> <dbl> <dbl> <int> <dbl>
1 irq_manipulation 0.267 0.0528 53 0.211
2 irq_orthographic 0.171 0.220 53 0.396
3 irq_verbal 0.191 0.170 53 0.396
4 irq_visual 0.162 0.247 53 0.396
5 osivq_spatial -0.0412 0.769 53 0.873
6 osivq_verbal -0.396 0.00330 53 0.0264
7 osivq_visual 0.137 0.327 53 0.435
8 vviq_visual 0.0224 0.873 53 0.873 df.imagery_scores %>%
ggplot(aes(x = irq_visual, y = patch_acc_diff)) +
geom_point() +
geom_smooth(method='lm', formula= y~x) +
theme_light()
df.imagery_scores %>%
ggplot(aes(x = osivq_visual, y = patch_acc_diff)) +
geom_point() +
geom_smooth(method='lm', formula= y~x) +
theme_light()
df.imagery_scores %>%
ggplot(aes(x = osivq_verbal, y = wm_acc_diff)) +
geom_point() +
geom_smooth(method='lm', formula= y~x) +
theme_light()
# Look at correlations between OVERALL performance and these metrics