Picture-Word-N1/04 Analysis/analyse_07_sample_picture_word_roi.R

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<br>× 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<br>× 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")