library(lme4)
library(dplyr)
library(tidyr)
library(purrr)
library(readr)
library(ggplot2)
library(ggtext)
library(cowplot)
library(patchwork)
library(parallel)
ggplot2::theme_set(ggplot2::theme_classic())
cong_cols <- c("#E69F00", "#009E73")
n_cores <- 14
library(RColorBrewer)
eff_cols <- c("#000000", brewer.pal(3, "Set1")[1:2], brewer.pal(5, "Set1")[5])
cong_cols <- c("#E69F00", "#009E73")
cong_cols_alpha_0.4_white <- c("#F5D899", "#99D8C7")
roi <- c("TP7", "CP5", "P5", "P7", "P9", "PO3", "PO7", "O1")
time_lims <- c(-250, 650)
# function to normalise between 0 and 1
norm01 <- function(x, ...) (x-min(x, ...))/(max(x, ...)-min(x, ...))
# get the stimuli's percentage of name agreement values
stim <- read_csv("boss.csv", col_types = cols(perc_name_agree_denom_fq_inputs = col_number())) %>%
select(filename, perc_name_agree_denom_fq_inputs) %>%
rename(perc_name_agree = perc_name_agree_denom_fq_inputs)
# import the max electrode data from the preprocessing, and set up the variables for the model
get_sample_data <- function(ch_i = NA) {
list.files("sample_data", pattern=".+\\.csv$", full.names=TRUE) %>%
map_dfr(function(f) {
x <- read_csv(
f,
col_types=cols(
subj_id = col_character(),
stim_grp = col_integer(),
resp_grp = col_integer(),
item_nr = col_integer(),
ch_name = col_character(),
time = col_double(),
uV = col_double(),
condition = col_character(),
image = col_character(),
string = col_character(),
.default = col_double()
),
progress = FALSE
) |>
select(-stim_grp, -resp_grp, -item_nr) |>
filter(time > time_lims[[1]] & time < time_lims[[2]])
if (all(!is.na(ch_i))) x <- filter(x, ch_name %in% ch_i)
x
}) %>%
left_join(stim, by=c("image" = "filename")) %>%
mutate(
prop_agree = perc_name_agree/100,
pred_norm = norm01(prop_agree, na.rm=TRUE),
pred_norm_max = pred_norm - 1
) %>%
select(-perc_name_agree)
}
unique_ids <- list.files("sample_data", pattern=".+\\.csv$", full.names=TRUE) %>%
first() %>%
read_csv() |>
filter(time > time_lims[[1]] & time < time_lims[[2]]) |>
select(ch_name, time) %>%
as.list() %>%
lapply(unique)
target_time_ids <- unique_ids$time
# get models for each timepoint, for each electrode, and extract fixed effects
d_i_list <- get_sample_data(roi) |>
mutate(
cong_dev = as.numeric(scale(ifelse(condition=="A2", 0, 1), center=TRUE, scale=FALSE)),
cong_dum_incong = as.numeric(condition=="A1"), # 0 is at incongruent
cong_dum_cong = as.numeric(condition=="A2") # 0 is at congruent
) |>
group_split(time)
gc()
# # sanity check
# sc_pl <- d_i_list |>
# reduce(bind_rows) |>
# mutate(pred_bin = factor(case_when(
# pred_norm <.33 ~ "low",
# pred_norm <.66 ~ "medium",
# pred_norm < Inf ~ "high"
# ), levels = c("low", "medium", "high"))) |>
# group_by(time, condition, pred_bin, ch_name) |>
# summarise(mean_uV = mean(uV)) |>
# ungroup() |>
# pivot_wider(names_from=condition, values_from=mean_uV) |>
# mutate(cong_minus_incong = A1-A2) |>
# ggplot(aes(time, cong_minus_incong, colour=ch_name)) +
# geom_line() +
# facet_wrap(vars(pred_bin))
message("Fitting models in parallel to OT channels in picture-word experiment")
# d_i_list <- get_sample_data(roi) %>%
# mutate(cong_dev = as.numeric(scale(ifelse(condition=="A2", 0, 1), center=TRUE, scale=FALSE))) %>%
# filter(time <= 655) %>%
# arrange(time) %>%
# split(time)
#
# gc()
cl <- makeCluster(n_cores)
cl_packages <- clusterEvalQ(cl, {
library(dplyr)
library(lme4)
})
fe_res <- parLapply(cl, d_i_list, function(d_i) {
# m <- lme4::lmer(
# uV ~ cong_dev * pred_norm +
# (cong_dev * pred_norm | subj_id) +
# (cong_dev * pred_norm | ch_name:subj_id) +
# (cong_dev | image) +
# (1 | string),
# REML=FALSE,
# control = lmerControl(optimizer="bobyqa"),
# data=d_i
# )
m <- lme4::lmer(
uV ~ cong_dev * pred_norm +
(1 | subj_id) +
(1 | ch_name:subj_id) +
(1 | image) +
(1 | string),
REML=FALSE,
control = lmerControl(optimizer="bobyqa"),
data=d_i
)
m %>%
summary() %>%
with(coefficients) %>%
as_tibble(rownames = "fe")
}) %>%
reduce(bind_rows) %>%
mutate(time = rep(target_time_ids, each=4))
stopCluster(cl)
fe_res_tidy <- fe_res %>%
mutate(
fe_lab = factor(recode(
fe,
`(Intercept)` = "Intercept",
cong_dev = "Congruency",
pred_norm = "Predictability",
`cong_dev:pred_norm` = "Congruency * Predictability",
), levels = c("Intercept", "Congruency", "Predictability", "Congruency * Predictability")),
fe_lab_newline = fe_lab,
bound_lower = Estimate - 1.96 * `Std. Error`,
bound_upper = Estimate + 1.96 * `Std. Error`
)
levels(fe_res_tidy$fe_lab) <- c("Intercept"="Intercept", "Congruency"="Congruency", "Predictability"="Predictability", "Congruency * Predictability"="Congruency × Predictability")
levels(fe_res_tidy$fe_lab_newline) <- c("Intercept"="Intercept", "Congruency"="Congruency", "Predictability"="Predictability", "Congruency * Predictability"="Congruency
× Predictability")
overlay_dat <- fe_res_tidy %>%
filter(fe_lab=="Intercept") %>%
select(-fe_lab, -fe_lab_newline) %>%
expand_grid(fe_lab = unique(fe_res_tidy$fe_lab)) %>%
mutate(
Estimate = ifelse(fe_lab=="Intercept", NA, Estimate),
fe_lab_newline = fe_lab
)
levels(overlay_dat$fe_lab) <- c("Intercept"="Intercept", "Congruency"="Congruency", "Predictability"="Predictability", "Congruency * Predictability"="Congruency × Predictability")
levels(overlay_dat$fe_lab_newline) <- c("Intercept"="Intercept", "Congruency"="Congruency", "Predictability"="Predictability", "Congruency * Predictability"="Congruency
× Predictability")
ylims <- round(c(min(fe_res_tidy$bound_lower), max(fe_res_tidy$bound_upper)))
pl_roi <- fe_res_tidy %>%
ggplot(aes(time, Estimate, ymin=bound_lower, ymax=bound_upper, group=fe_lab)) +
geom_line(colour="black", data=overlay_dat, alpha=0.6) +
geom_ribbon(alpha=0.5, linewidth=0.1, fill="dodgerblue") +
geom_line() +
geom_vline(xintercept=0, linetype="dashed") +
geom_hline(yintercept=0, linetype="dashed") +
facet_wrap(vars(fe_lab), nrow=2) +
labs(x = "Time (ms)", y = "Fixed Effect Estimate (µV)", tag="a") +
# scale_colour_manual(values = eff_cols) +
# scale_fill_manual(values = eff_cols) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(limits=ylims) +
theme(
legend.position = "none",
strip.background = element_blank(),
legend.background = element_blank(),
axis.line.x = element_blank(),
panel.spacing.x = unit(12, "pt"),
strip.text.x = ggtext::element_markdown()
) +
coord_cartesian(xlim=c(-250, time_lims[2]))
pl_roi_1row <- fe_res_tidy %>%
ggplot(aes(time, Estimate, ymin=bound_lower, ymax=bound_upper, group=fe_lab)) +
geom_line(colour="darkgrey", data=overlay_dat) +
geom_ribbon(alpha=0.5, linewidth=0.1, fill="dodgerblue") +
geom_line() +
geom_vline(xintercept=0, linetype="dashed") +
geom_hline(yintercept=0, linetype="dashed") +
facet_wrap(vars(fe_lab_newline), nrow=1) +
labs(x = "Time (ms)", y = "Effect Estimate (µV)", tag="a") +
# scale_colour_manual(values = eff_cols) +
# scale_fill_manual(values = eff_cols) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(limits=ylims) +
theme(
legend.position = "none",
strip.background = element_blank(),
legend.background = element_blank(),
axis.line.x = element_blank(),
panel.spacing.x = unit(12, "pt"),
strip.text.x = ggtext::element_markdown(),
strip.clip = "off"
) +
coord_cartesian(xlim=c(-250, time_lims[2]))
preds <- expand_grid(
prop_agree = seq(0.1, 1, 0.1),
condition = factor(c("Picture-Congruent", "Picture-Incongruent"), levels=c("Picture-Congruent", "Picture-Incongruent"))
) %>%
rowwise() %>%
mutate(pred_norm = ifelse(prop_agree==1, 1, norm01(c(0.07, prop_agree, 1))[2])) %>%
expand_grid(time = target_time_ids) %>%
ungroup() %>%
mutate(
perc_name_agree = prop_agree*100,
cong_dev = as.numeric(scale(ifelse(condition=="Picture-Incongruent", 0, 1), center=TRUE, scale=FALSE))
) %>%
left_join(
fe_res %>%
select(time, fe, Estimate) %>%
pivot_wider(names_from=fe, values_from=Estimate, names_prefix="fe_"),
by = "time"
) %>%
mutate(
pred_uV = `fe_(Intercept)` +
cong_dev * fe_cong_dev +
pred_norm * fe_pred_norm +
cong_dev * pred_norm * `fe_cong_dev:pred_norm`
)
pl_preds <- preds %>%
ggplot(aes(time, pred_uV, colour=prop_agree)) +
geom_line(aes(group = as.factor(prop_agree))) +
geom_vline(xintercept=0, linetype="dashed") +
geom_hline(yintercept=0, linetype="dashed") +
scale_colour_continuous(
type="viridis", breaks=sort(unique(preds$prop_agree)),
labels=sprintf("%s%%", sort(unique(preds$prop_agree))*100),
# guide=guide_colourbar(barheight = 7.6, barwidth = 1)
guide = guide_legend(override.aes = list(linewidth=1), reverse = TRUE)
) +
scale_x_continuous(expand=c(0, 0)) +
scale_y_continuous(limits=ylims) +
facet_wrap(vars(condition), nrow=1) +
labs(
x = "Time (ms)",
y = "Predicted Amplitude (µV)",
colour = "Predictability",
tag = "b"
) +
theme(
legend.position = "right",
legend.key.height = unit(11, "pt"),
legend.text.align = 1,
strip.background = element_blank(),
plot.background = element_blank(),
axis.line.x = element_blank(),
panel.spacing.x = unit(12, "pt")
) +
coord_cartesian(xlim=c(-250, time_lims[2]))
pl <- plot_grid(pl_roi, pl_preds, ncol=1, rel_heights = c(1, 0.8), align="v", axis="l")
ggsave(file.path("figs", "sample_level", "picture_word", "roi.pdf"), pl, width=6.5, height=6, device="pdf")
ggsave(file.path("figs", "sample_level", "picture_word", "roi.png"), pl, width=6.5, height=6, device="png", type="cairo")
pl_preds_bypred <- preds %>%
mutate(
perc_lab = factor(
sprintf("%s%%", perc_name_agree),
levels = sprintf("%s%%", sort(unique(perc_name_agree)))
),
cong_lab = ifelse(condition=="Picture-Congruent", "Congruent", "Incongruent")
) %>%
ggplot(aes(time, pred_uV, colour=cong_lab)) +
geom_vline(xintercept=0, linetype="dashed") +
geom_hline(yintercept=0, linetype="dashed") +
geom_line() +
scale_colour_manual(
values = cong_cols,
guide=guide_legend(nrow=1, override.aes = list(linewidth=1))
) +
scale_x_continuous(expand=c(0, 0)) +
scale_y_continuous(limits=ylims) +
facet_wrap(vars(perc_lab), nrow=3) +
labs(
x = "Time (ms)",
y = "Predicted Amplitude (µV)",
colour = "Picture-Word Congruency"
) +
theme(
legend.position = c(0.925, -0.025),
legend.justification = c(1, 0),
legend.margin = margin(),
legend.key.height = unit(12, "pt"),
strip.background = element_blank(),
plot.background = element_blank(),
axis.line.x = element_blank(),
panel.spacing.x = unit(12, "pt")
) +
coord_cartesian(xlim=c(-250, time_lims[2]))
pl_plus_C <- plot_grid(
pl_roi_1row + theme(strip.text = element_text(margin=margin(t=2.5, b=2.5, unit="pt"))),
pl_preds +
theme(
strip.text = element_text(margin=margin(t=2.5, b=2.5, unit="pt")),
legend.key.height = unit(9.5, "pt")
),
pl_preds_bypred +
labs(tag="c") +
theme(strip.text = element_text(margin=margin(t=2.5, b=2.5, unit="pt"))),
ncol=1, rel_heights = c(0.85, 1.2, 1.5), align="v", axis="l"
)
ggsave(file.path("figs", "sample_level", "picture_word", "roi_3panels.pdf"), pl_plus_C, width=6.5, height=7, device="pdf")
ggsave(file.path("figs", "sample_level", "picture_word", "roi_3panels.png"), pl_plus_C, width=6.5, height=7, device="png", type="cairo")
# simple effects models ---------------------------------------------------
cl <- makeCluster(n_cores)
cl_packages <- clusterEvalQ(cl, {
library(dplyr)
library(lme4)
})
fe_res_cong <- parLapply(cl, d_i_list, function(d_i) {
m <- lme4::lmer(
uV ~ cong_dum_cong * pred_norm +
(1 | subj_id) +
(1 | ch_name:subj_id) +
(1 | image) +
(1 | string),
REML=FALSE,
control = lmerControl(optimizer="bobyqa"),
data=d_i
)
m %>%
summary() %>%
with(coefficients) %>%
as_tibble(rownames = "fe")
}) %>%
reduce(bind_rows) %>%
mutate(time = rep(target_time_ids, each=4))
fe_res_incong <- parLapply(cl, d_i_list, function(d_i) {
m <- lme4::lmer(
uV ~ cong_dum_incong * pred_norm +
(1 | subj_id) +
(1 | ch_name:subj_id) +
(1 | image) +
(1 | string),
REML=FALSE,
control = lmerControl(optimizer="bobyqa"),
data=d_i
)
m %>%
summary() %>%
with(coefficients) %>%
as_tibble(rownames = "fe")
}) %>%
reduce(bind_rows) %>%
mutate(time = rep(target_time_ids, each=4))
stopCluster(cl)
fe_res_tidy_se <- bind_rows(
fe_res_cong %>%
mutate(
cong_level = "Congruent",
fe_lab = factor(recode(
fe,
`(Intercept)` = "Intercept",
cong_dum_cong = "Congruency",
pred_norm = "Predictability",
`cong_dum_cong:pred_norm` = "Congruency * Predictability"
), levels = c("Intercept", "Congruency", "Predictability", "Congruency * Predictability")),
fe_lab_newline = factor(fe_lab, labels = c("Intercept", "Congruency", "Predictability", "Congruency\n* Predictability")),
bound_lower = Estimate - 1.96 * `Std. Error`,
bound_upper = Estimate + 1.96 * `Std. Error`
),
fe_res_incong %>%
mutate(
cong_level = "Incongruent",
fe_lab = factor(recode(
fe,
`(Intercept)` = "Intercept",
cong_dum_incong = "Congruency",
pred_norm = "Predictability",
`cong_dum_incong:pred_norm` = "Congruency * Predictability"
), levels = c("Intercept", "Congruency", "Predictability", "Congruency * Predictability")),
fe_lab_newline = factor(fe_lab, labels = c("Intercept", "Congruency", "Predictability", "Congruency\n* Predictability")),
bound_lower = Estimate - 1.96 * `Std. Error`,
bound_upper = Estimate + 1.96 * `Std. Error`
)
)
fe_res_tidy_se_pred <- filter(fe_res_tidy_se, fe_lab=="Predictability")
fe_se_pl_alpha <- 0.4
fe_se_pl <- fe_res_tidy_se_pred %>%
ggplot(aes(time, Estimate, ymin=bound_lower, ymax=bound_upper, colour=cong_level, fill=cong_level)) +
geom_ribbon(alpha=fe_se_pl_alpha, linewidth=0.25, data=filter(fe_res_tidy_se_pred, cong_level=="Congruent")) +
geom_line(data=filter(fe_res_tidy_se_pred, cong_level=="Congruent")) +
geom_ribbon(alpha=fe_se_pl_alpha, linewidth=0.25, data=filter(fe_res_tidy_se_pred, cong_level=="Incongruent")) +
geom_line(data=filter(fe_res_tidy_se_pred, cong_level=="Incongruent")) +
geom_vline(xintercept=0, linetype="dashed") +
geom_hline(yintercept=0, linetype="dashed") +
scale_colour_manual(values = cong_cols) +
scale_fill_manual(values = cong_cols) +
scale_x_continuous(expand=c(0, 0), breaks = seq(-200, time_lims[2], 100), limits=c(-250, time_lims[2])) +
scale_y_continuous(breaks=scales::breaks_pretty(n=6)) +
guides(
colour = guide_legend(nrow=1),
fill = guide_legend(nrow=1, override.aes = list(alpha=1, fill=cong_cols_alpha_0.4_white))
) +
labs(
x = "Time (ms)",
y = "Effect of Predictability (µV)",
colour = "Picture-Word Congruency",
fill = "Picture-Word Congruency"
) +
theme(
legend.key.height = unit(12, "pt"),
legend.position = "top",
axis.line.x = element_blank()
)
ggsave(file.path("figs", "sample_level", "picture_word", "roi_simple_effs.pdf"), fe_se_pl, width=4.75, height=2.75, device="pdf")
ggsave(file.path("figs", "sample_level", "picture_word", "roi_simple_effs.png"), fe_se_pl, width=4.75, height=2.75, device="png", type="cairo")