highspeed-analysis-behavior.Rmd 38 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913
  1. # Behavior
  2. ## Initialization
  3. ### Load data and files
  4. We set the paths and source the basic setup script:
  5. ```{r, warning=FALSE, message=FALSE}
  6. knitr::opts_chunk$set(echo = TRUE)
  7. # find the path to the root of this project:
  8. if (!requireNamespace("here")) install.packages("here")
  9. if ( basename(here::here()) == "highspeed" ) {
  10. path_root = here::here("highspeed-analysis")
  11. } else {
  12. path_root = here::here()
  13. }
  14. # source all relevant functions from the setup R script:
  15. source(file.path(path_root, "code", "highspeed-analysis-setup.R"))
  16. ```
  17. ### Signal-detection labeling
  18. We assign labels from signal detection theory that will be used in one of the analyses below:
  19. ```{r}
  20. # denotes misses (key was not pressed and stimulus was upside-down):
  21. dt_events$sdt_type[
  22. dt_events$key_down == 0 & dt_events$stim_orient == 180] <- "miss"
  23. # denotes hits (key was pressed and stimulus was upside-down):
  24. dt_events$sdt_type[
  25. dt_events$key_down == 1 & dt_events$stim_orient == 180] <- "hit"
  26. # denotes correct rejection (key was not pressed and stimulus was upright):
  27. dt_events$sdt_type[
  28. dt_events$key_down == 0 & dt_events$stim_orient == 0] <- "correct rejection"
  29. # denotes false alarms (key was pressed and stimulus was upright):
  30. dt_events$sdt_type[
  31. dt_events$key_down == 1 & dt_events$stim_orient == 0] <- "false alarm"
  32. ```
  33. ## Stimulus timings
  34. We calculate the differences between consecutive stimulus onsets:
  35. ```{r}
  36. dt_events %>%
  37. # get duration of stimuli by calculating differences between consecutive onsets:
  38. .[, duration_check := shift(onset, type = "lead") - onset,
  39. by = .(subject, run_study)] %>%
  40. # get the difference between the expected and actual stimulus duration:
  41. .[, duration_diff := duration_check - duration, by = .(subject, run_study)] %>%
  42. # for each condition and trial check participants' responses:
  43. .[, by = .(subject, condition, trial), ":=" (
  44. # for each trial check if a key has been pressed:
  45. trial_key_down = ifelse(any(key_down == 1, na.rm = TRUE), 1, 0),
  46. # for each trial check if the participant was accurate:
  47. trial_accuracy = ifelse(any(accuracy == 1, na.rm = TRUE), 1, 0)
  48. )] %>%
  49. .[, trial_type := factor(trial_type, levels = rev(unique(trial_type)))]
  50. ```
  51. ```{r}
  52. timings_summary = dt_events %>%
  53. filter(condition %in% c("sequence", "repetition") & trial_type == "interval") %>%
  54. setDT(.) %>%
  55. .[, by = .(subject, condition, trial_type), {
  56. results = t.test(duration_diff, mu = 0.001, alternative = "two.sided")
  57. list(
  58. mean = mean(duration_diff, na.rm = TRUE),
  59. sd = sd(duration_diff, na.rm = TRUE),
  60. min = min(duration_diff, na.rm = TRUE),
  61. max = max(duration_diff, na.rm = TRUE),
  62. num = .N,
  63. tvalue = results$statistic,
  64. df = results$parameter,
  65. pvalue = results$p.value,
  66. pvalue_round = round_pvalues(results$p.value)
  67. )
  68. }] %>%
  69. .[, trial_type := factor(trial_type, levels = rev(unique(trial_type)))] %>%
  70. setorder(., condition, trial_type)
  71. rmarkdown::paged_table(timings_summary)
  72. ```
  73. ```{r, echo = FALSE}
  74. ggplot(data = dt_events, aes(
  75. y = as.numeric(duration_diff),
  76. x = as.factor(trial_type),
  77. fill = as.factor(trial_type)), na.rm = TRUE) +
  78. facet_grid(vars(as.factor(trial_key_down)), vars(as.factor(condition))) +
  79. geom_point(
  80. aes(y = as.numeric(duration_diff), color = as.factor(trial_type)),
  81. position = position_jitter(width = .15), size = .5, alpha = 1, na.rm = TRUE) +
  82. geom_boxplot(width = .1, outlier.shape = NA, alpha = 0.5, na.rm = TRUE) +
  83. scale_color_brewer(palette = "Spectral") +
  84. scale_fill_brewer(palette = "Spectral") +
  85. #coord_capped_flip(left = "both", bottom = "both", expand = TRUE) +
  86. coord_flip() +
  87. theme(legend.position = "none") +
  88. xlab("Trial event (in serial order)") +
  89. ylab("Difference between expected and actual timing (in s)") +
  90. theme(strip.text = element_text(margin = margin(unit(c(t = 2, r = 2, b = 2, l = 2), "pt")))) +
  91. theme(legend.position = "none") +
  92. theme(panel.background = element_blank())
  93. ```
  94. ```{r, echo=FALSE, eval=FALSE}
  95. ggsave(filename = "highspeed_plot_behavior_timing_differences.pdf",
  96. plot = last_plot(), device = cairo_pdf, path = path_figures, scale = 1,
  97. dpi = "retina", width = 6, height = 4)
  98. ```
  99. We check the timing of the inter-trial interval on oddball trials:
  100. ```{r}
  101. dt_odd_iti_mean = dt_events %>%
  102. # filter for the stimulus intervals on oddball trials:
  103. filter(condition == "oddball" & trial_type == "interval") %>%
  104. setDT(.) %>%
  105. # calculate the mean duration of the oddball intervals for each participant:
  106. .[, by = .(subject), .(
  107. mean_duration = mean(duration, na.rm = TRUE),
  108. num_trials = .N
  109. )] %>%
  110. verify(num_trials == 600)
  111. rmarkdown::paged_table(dt_odd_iti_mean)
  112. ```
  113. ## Overview: Behavioral performance
  114. ### Mean accuracy
  115. We calculate the mean behavioral accuracy across all trials of all three task conditions (slow, sequence, and repetition trials):
  116. ```{r, echo = TRUE}
  117. chance_level = 50
  118. dt_acc = dt_events %>%
  119. # filter out all events that are not related to a participants' response:
  120. filter(!is.nan(accuracy)) %>%
  121. # filter for only upside down stimuli on slow trials:
  122. filter(!(condition == "oddball" & stim_orient == 0)) %>%
  123. setDT(.) %>%
  124. # check if the number of trials matches for every subject:
  125. verify(.[(condition == "oddball"), by = .(subject), .(
  126. num_trials = .N)]$num_trials == 120) %>%
  127. verify(.[(condition == "sequence"), by = .(subject), .(
  128. num_trials = .N)]$num_trials == 75) %>%
  129. verify(.[(condition == "repetition"), by = .(subject), .(
  130. num_trials = .N)]$num_trials == 45) %>%
  131. # calculate the average accuracy for each participant and condition:
  132. .[, by = .(subject, condition), .(
  133. mean_accuracy = mean(accuracy, na.rm = TRUE) * 100,
  134. num_trials = .N)] %>%
  135. # check if the accuracy values are between 0 and 100:
  136. assert(within_bounds(lower.bound = 0, upper.bound = 100), mean_accuracy) %>%
  137. # create new variable that specifies excluded participants:
  138. mutate(exclude = ifelse(mean_accuracy < chance_level, "yes", "no")) %>%
  139. # create a short name for the conditions:
  140. mutate(condition_short = substr(condition, start = 1, stop = 3)) %>%
  141. # reorder the condition factor in descending order of accuracy:
  142. transform(condition_short = fct_reorder(
  143. condition_short, mean_accuracy, .desc = TRUE))
  144. rmarkdown::paged_table(dt_acc)
  145. ```
  146. We create a list of participants that will be excluded because their performance is below the 50% chance level in either or both sequence and repetition trials:
  147. ```{r, echo=TRUE}
  148. # create a list with all excluded subject ids and print the list:
  149. subjects_excluded = unique(dt_acc$subject[dt_acc$exclude == "yes"])
  150. print(subjects_excluded)
  151. ```
  152. We calculate the mean behavioral accuracy across all three task conditions (slow, sequence, and repetition trials), *excluding* partipants that performed below chance on either or both sequence and repetition trials:
  153. ```{r, echo=TRUE, results="hold"}
  154. dt_acc_mean = dt_acc %>%
  155. # filter out all data of excluded participants:
  156. filter(!(subject %in% unique(subject[exclude == "yes"]))) %>%
  157. # check if the number of participants matches expectations:
  158. verify(length(unique(subject)) == 36) %>%
  159. setDT(.) %>%
  160. # calculate mean behavioral accuracy across participants for each condition:
  161. .[, by = .(condition), {
  162. ttest_results = t.test(
  163. mean_accuracy, mu = chance_level, alternative = "greater")
  164. list(
  165. pvalue = ttest_results$p.value,
  166. pvalue_rounded = round_pvalues(ttest_results$p.value),
  167. tvalue = round(ttest_results$statistic, digits = 2),
  168. conf_lb = round(ttest_results$conf.int[1], digits = 2),
  169. conf_ub = round(ttest_results$conf.int[2], digits = 2),
  170. df = ttest_results$parameter,
  171. num_subs = .N,
  172. mean_accuracy = round(mean(mean_accuracy), digits = 2),
  173. SD = round(sd(mean_accuracy), digits = 2),
  174. cohens_d = round((mean(mean_accuracy) - chance_level) / sd(mean_accuracy), 2),
  175. sem_upper = mean(mean_accuracy) + (sd(mean_accuracy)/sqrt(.N)),
  176. sem_lower = mean(mean_accuracy) - (sd(mean_accuracy)/sqrt(.N))
  177. )}] %>%
  178. verify(num_subs == 36) %>%
  179. # create a short name for the conditions:
  180. mutate(condition_short = substr(condition, start = 1, stop = 3)) %>%
  181. # reorder the condition factor in descending order of accuracy:
  182. transform(condition_short = fct_reorder(condition_short, mean_accuracy, .desc = TRUE))
  183. # show the table (https://rstudio.github.io/distill/tables.html):
  184. rmarkdown::paged_table(dt_acc_mean)
  185. ```
  186. ### Above-chance performance
  187. We plot only data of above-chance performers:
  188. ```{r, echo = FALSE}
  189. fig_behav_all = ggplot(data = subset(dt_acc, exclude == "no"), aes(
  190. x = as.factor(condition_short), y = as.numeric(mean_accuracy),
  191. group = as.factor(condition_short), fill = as.factor(condition_short))) +
  192. geom_bar(stat = "summary", fun = "mean", color = "black", fill = "white") +
  193. geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
  194. color = "black", fill = "lightgray", alpha = 0.5,
  195. inherit.aes = TRUE, binwidth = 2) +
  196. geom_errorbar(stat = "summary", fun.data = "mean_se", width = 0.0, color = "black") +
  197. ylab("Accuracy (%)") + xlab("Condition") +
  198. scale_color_manual(values = c("darkgray", "red"), name = "Outlier") +
  199. geom_hline(aes(yintercept = 50), linetype = "dashed", color = "black") +
  200. guides(shape = FALSE, color = FALSE, fill = FALSE) +
  201. coord_capped_cart(left = "both", expand = TRUE, ylim = c(0, 100)) +
  202. theme(legend.position = "none") +
  203. theme(panel.border = element_blank()) +
  204. theme(axis.text = element_text(color = "black")) +
  205. theme(axis.ticks = element_line(color = "black")) +
  206. theme(axis.line.y = element_line(colour = "black"),
  207. axis.ticks.x = element_blank(),
  208. panel.grid.major = element_blank(),
  209. panel.grid.minor = element_blank(),
  210. panel.border = element_blank(),
  211. panel.background = element_blank())
  212. fig_behav_all
  213. ```
  214. ### Below chance performance
  215. We plot data of all participants with below chance performers highlighted in red.
  216. ```{r, echo=TRUE}
  217. fig_behav_all_outlier = ggplot(data = dt_acc_mean,
  218. mapping = aes(x = as.factor(condition_short), y = as.numeric(mean_accuracy),
  219. group = as.factor(condition_short), fill = as.factor(condition_short))) +
  220. geom_bar(aes(fill = as.factor(condition)), stat = "identity", color = "black", fill = "white") +
  221. geom_point(data = subset(dt_acc, exclude == "no"),
  222. aes(color = as.factor(exclude)),
  223. position = position_jitter(width = 0.2, height = 0, seed = 2),
  224. alpha = 0.5, inherit.aes = TRUE, pch = 21,
  225. color = "black", fill = "lightgray") +
  226. geom_point(data = subset(dt_acc, exclude == "yes"),
  227. aes(color = as.factor(exclude), shape = as.factor(subject)),
  228. position = position_jitter(width = 0.05, height = 0, seed = 4),
  229. alpha = 1, inherit.aes = TRUE, color = "red") +
  230. geom_errorbar(aes(ymin = sem_lower, ymax = sem_upper), width = 0.0, color = "black") +
  231. ylab("Accuracy (%)") + xlab("Condition") +
  232. scale_color_manual(values = c("darkgray", "red"), name = "Outlier") +
  233. geom_hline(aes(yintercept = 50), linetype = "dashed", color = "black") +
  234. coord_capped_cart(left = "both", bottom = "none", expand = TRUE, ylim = c(0, 100)) +
  235. theme(axis.ticks.x = element_line(color = "white"), axis.line.x = element_line(color = "white")) +
  236. guides(shape = FALSE, fill = FALSE) +
  237. theme(axis.text = element_text(color = "black")) +
  238. theme(axis.ticks = element_line(color = "black")) +
  239. theme(axis.line.y = element_line(colour = "black"),
  240. axis.ticks.x = element_blank(),
  241. panel.grid.major = element_blank(),
  242. panel.grid.minor = element_blank(),
  243. panel.border = element_blank(),
  244. panel.background = element_blank())
  245. fig_behav_all_outlier
  246. ```
  247. ## Slow trials
  248. ### Mean accuracy (all trials)
  249. We calculate the mean accuracy on slow trials (oddball task condition) across all trials in the final sample (only participants who performed above chance):
  250. ```{r, echo=TRUE}
  251. # we use the dataframe containing the accuracy data
  252. dt_acc_odd = dt_acc %>%
  253. # filter for oddball / slow trials only:
  254. filter(condition == "oddball") %>%
  255. # exclude participants with below chance performance::
  256. filter(!(subject %in% subjects_excluded)) %>%
  257. # verify that the number of participants (final sample) is correct:
  258. verify(all(.N == 36))
  259. ```
  260. We plot the mean behavioral accuracy on slow trials (oddball task condition) in the final sample:
  261. ```{r, echo=TRUE, fig.width=3}
  262. fig_behav_odd = ggplot(data = dt_acc_odd, aes(
  263. x = "mean_acc", y = as.numeric(mean_accuracy))) +
  264. geom_bar(stat = "summary", fun = "mean", fill = "lightgray") +
  265. #geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
  266. # color = "black", fill = "lightgray", alpha = 0.5,
  267. # inherit.aes = TRUE, binwidth = 0.5) +
  268. geom_point(position = position_jitter(width = 0.2, height = 0, seed = 2),
  269. alpha = 0.5, inherit.aes = TRUE, pch = 21,
  270. color = "black", fill = "lightgray") +
  271. geom_errorbar(stat = "summary", fun.data = "mean_se", width = 0.0, color = "black") +
  272. ylab("Accuracy (%)") + xlab("Condition") +
  273. scale_color_manual(values = c("darkgray", "red"), name = "Outlier") +
  274. geom_hline(aes(yintercept = 50), linetype = "dashed", color = "black") +
  275. #coord_capped_cart(left = "both", bottom = "none", expand = TRUE, ylim = c(90, 100)) +
  276. theme(plot.title = element_text(size = 12, face = "plain")) +
  277. theme(axis.ticks.x = element_line(color = "white"), axis.line.x = element_line(color = "white")) +
  278. theme(axis.title.x = element_text(color = "white"), axis.text.x = element_text(color = "white")) +
  279. ggtitle("Slow") +
  280. theme(plot.title = element_text(hjust = 0.5))
  281. fig_behav_odd
  282. ```
  283. ### Mean accuracy (per run)
  284. We calculate the mean behavioral accuracy on slow trials (oddball task condition) for each of the eight task runs *for each* participant:
  285. ```{r}
  286. # calculate the mean accuracy per session and run for every participant:
  287. dt_odd_behav_run_sub = dt_events %>%
  288. # exclude participants performing below chance:
  289. filter(!(subject %in% subjects_excluded)) %>%
  290. # select only oddball condition and stimulus events:
  291. filter(condition == "oddball" & trial_type == "stimulus") %>%
  292. # filter for upside-down trials (oddballs) only:
  293. filter(stim_orient == 180) %>%
  294. setDT(.) %>%
  295. # calculate mean accuracy per session and run:
  296. .[, by = .(subject, session, run_study, run_session), .(
  297. mean_accuracy = mean(accuracy))] %>%
  298. # express accuracy in percent by multiplying with 100:
  299. transform(mean_accuracy = mean_accuracy * 100) %>%
  300. # check whether the mean accuracy is within the expected range of 0 to 100:
  301. assert(within_bounds(lower.bound = 0, upper.bound = 100), mean_accuracy)
  302. ```
  303. We calculate the mean behavioral accuracy on slow trials (oddball task condition) for each of the eight task runs *across* participants:
  304. ```{r}
  305. # calculate mean accuracy per session and run across participants:
  306. dt_odd_behav_run_mean = dt_odd_behav_run_sub %>%
  307. setDT(.) %>%
  308. # average across participants:
  309. .[, by = .(session, run_study, run_session), .(
  310. mean_accuracy = mean(mean_accuracy),
  311. num_subs = .N,
  312. sem_upper = mean(mean_accuracy) + (sd(mean_accuracy)/sqrt(.N)),
  313. sem_lower = mean(mean_accuracy) - (sd(mean_accuracy)/sqrt(.N))
  314. )] %>%
  315. verify(num_subs == 36) %>%
  316. # z-score the accuracy values:
  317. mutate(mean_accuracy_z = scale(mean_accuracy, scale = TRUE, center = TRUE))
  318. ```
  319. We run a LME model to test the linear effect of task run on behavioral accuracy:
  320. ```{r, results="hold", echo=TRUE}
  321. lme_odd_behav_run = lmerTest::lmer(
  322. mean_accuracy ~ run_study + (1 + run_study | subject),
  323. data = dt_odd_behav_run_sub, na.action = na.omit, control = lcctrl)
  324. summary(lme_odd_behav_run)
  325. anova(lme_odd_behav_run)
  326. ```
  327. We run a second model to test run- and session-specific effects:
  328. ```{r, results="hold"}
  329. dt <- dt_odd_behav_run_sub %>%
  330. transform(run_session = as.factor(paste0("run-0", run_session)),
  331. session = as.factor(paste0("ses-0", session)))
  332. ```
  333. ```{r, results="hold"}
  334. lme_odd_behav_run = lmerTest::lmer(
  335. mean_accuracy ~ session + run_session + (1 + session + run_session | subject),
  336. data = dt, na.action = na.omit, control = lcctrl)
  337. summary(lme_odd_behav_run)
  338. emmeans(lme_odd_behav_run, list(pairwise ~ run_session | session))
  339. anova(lme_odd_behav_run)
  340. rm(dt)
  341. ```
  342. We plot the behavioral accuracy on slow trials (oddball task condition) across task runs (x-axis) for each study session (panels):
  343. ```{r, echo=TRUE}
  344. # change labels of the facet:
  345. facet_labels_new = unique(paste0("Session ", dt_events$session))
  346. facet_labels_old = as.character(unique(dt_events$session))
  347. names(facet_labels_new) = facet_labels_old
  348. # plot behavioral accuracy across runs:
  349. plot_odd_run = ggplot(data = dt_odd_behav_run_mean, mapping = aes(
  350. y = as.numeric(mean_accuracy), x = as.numeric(run_session))) +
  351. geom_ribbon(aes(ymin = sem_lower, ymax = sem_upper), alpha = 0.5, fill = "gray") +
  352. geom_line(color = "black") +
  353. facet_wrap(~ as.factor(session), labeller = as_labeller(facet_labels_new)) +
  354. ylab("Accuracy (%)") + xlab("Run") +
  355. ylim(c(90, 100)) +
  356. coord_capped_cart(left = "both", bottom = "both", expand = TRUE, ylim = c(90,100)) +
  357. theme(axis.ticks.x = element_text(color = "white"), axis.line.x = element_line(color = "white")) +
  358. theme(strip.text.x = element_text(margin = margin(b = 2, t = 2))) +
  359. theme(axis.text = element_text(color = "black")) +
  360. theme(axis.ticks = element_line(color = "black")) +
  361. theme(axis.line.y = element_line(colour = "black"),
  362. axis.ticks.x = element_blank(),
  363. panel.grid.major = element_blank(),
  364. panel.grid.minor = element_blank(),
  365. panel.border = element_blank(),
  366. panel.background = element_blank())
  367. plot_odd_run
  368. ```
  369. ### Misses vs. false alarms
  370. We calculate the mean frequency of misses (missed response to upside-down images) and false alarms (incorrect response to upright images):
  371. ```{r, echo=TRUE}
  372. dt_odd_behav_sdt_sub = dt_events %>%
  373. # exclude participants performing below chance:
  374. filter(!(subject %in% subjects_excluded)) %>%
  375. # select only oddball condition and stimulus events:
  376. filter(condition == "oddball" & trial_type == "stimulus") %>%
  377. setDT(.) %>%
  378. # create new variable with number of upside-down / upright stimuli per run:
  379. .[, by = .(subject, session, run_session, stim_orient), ":=" (
  380. num_orient = .N
  381. )] %>%
  382. # get the number of signal detection trial types for each run:
  383. .[, by = .(subject, session, run_session, sdt_type), .(
  384. num_trials = .N,
  385. freq = .N/unique(num_orient)
  386. )] %>%
  387. # add missing values:
  388. complete(nesting(subject, session, run_session), nesting(sdt_type),
  389. fill = list(num_trials = 0, freq = 0)) %>%
  390. transform(freq = freq * 100) %>%
  391. filter(sdt_type %in% c("false alarm", "miss")) %>%
  392. mutate(sdt_type_numeric = ifelse(sdt_type == "false alarm", 1, -1))
  393. ```
  394. We run a LME model to test the effect of signal detection type (miss vs. false alarm), task run and session on the frequency of those events:
  395. ```{r, results = "hold"}
  396. lme_odd_behav_sdt = lmer(
  397. freq ~ sdt_type + run_session * session + (1 + run_session + session | subject),
  398. data = subset(dt_odd_behav_sdt_sub), na.action = na.omit, control = lcctrl)
  399. summary(lme_odd_behav_sdt)
  400. anova(lme_odd_behav_sdt)
  401. emmeans_results = emmeans(lme_odd_behav_sdt, list(pairwise ~ sdt_type))
  402. emmeans_pvalues = round_pvalues(summary(emmeans_results[[2]])$p.value)
  403. emmeans_results
  404. ```
  405. We plot the frequency of misses and false alarms as a function of task run and study session:
  406. ```{r, echo=TRUE}
  407. plot_odd_sdt = ggplot(data = dt_odd_behav_sdt_sub, mapping = aes(
  408. y = as.numeric(freq), x = as.numeric(run_session),
  409. fill = as.factor(sdt_type), color = as.factor(sdt_type))) +
  410. stat_summary(geom = "bar", fun = mean, position = position_dodge(),
  411. na.rm = TRUE) +
  412. stat_summary(geom = "errorbar", fun.data = mean_se,
  413. position = position_dodge(0.9), width = 0, color = "black") +
  414. facet_wrap(~ as.factor(session), labeller = as_labeller(facet_labels_new)) +
  415. geom_dotplot(
  416. aes(group = interaction(run_session, session, sdt_type)),
  417. binaxis = "y", stackdir = "center", stackratio = 0.2, alpha = 0.7,
  418. inherit.aes = TRUE, binwidth = 0.2, position = position_dodge(),
  419. color = "black") +
  420. ylab("Frequency (%)") + xlab("Run") +
  421. coord_capped_cart(left = "both", bottom = "both",
  422. expand = TRUE, ylim = c(0, 15)) +
  423. scale_fill_viridis(name = "Error", discrete = TRUE) +
  424. scale_color_viridis(name = "Error", discrete = TRUE) +
  425. theme(strip.text.x = element_text(margin = margin(b = 2, t = 2))) +
  426. theme(legend.position = "top", legend.direction = "horizontal",
  427. legend.justification = "center", legend.margin = margin(0, 0, 0, 0),
  428. legend.box.margin = margin(t = 0, r = 0, b = -5, l = 0)) +
  429. theme(axis.text = element_text(color = "black")) +
  430. theme(axis.ticks.x = element_line(color = "white")) +
  431. theme(axis.line.x = element_line(color = "white")) +
  432. theme(axis.ticks.y = element_line(color = "black")) +
  433. theme(axis.line.y = element_line(colour = "black"),
  434. panel.grid.major = element_blank(),
  435. panel.grid.minor = element_blank(),
  436. panel.border = element_blank(),
  437. panel.background = element_blank())
  438. plot_odd_sdt
  439. ```
  440. ## Sequence trials
  441. ### Effect of sequence speed
  442. We calculate the mean behavioral accuracy on sequence trials for each of the five sequence speeds (inter-stimulus intervals):
  443. ```{r, echo=TRUE}
  444. dt_seq_behav = dt_events %>%
  445. # filter behavioral events data for sequence trials only:
  446. filter(condition == "sequence") %>%
  447. setDT(.) %>%
  448. # create additional variables to describe each trial:
  449. .[, by = .(subject, trial), ":=" (
  450. trial_key_down = ifelse(any(key_down == 1, na.rm = TRUE), 1, 0),
  451. trial_accuracy = ifelse(any(accuracy == 1, na.rm = TRUE), 1, 0),
  452. trial_target_position = serial_position[which(target == 1)],
  453. trial_speed = unique(interval_time[which(!is.na(interval_time))])
  454. )] %>%
  455. # filter for choice trials only:
  456. filter(trial_type == "choice") %>%
  457. setDT(.) %>%
  458. # group speed conditions into fast and slow conditions:
  459. mutate(speed = ifelse(trial_speed %in% c(2.048, 0.512), "slow", "fast")) %>%
  460. # define variable factors of interest as numeric:
  461. transform(trial_speed = as.numeric(trial_speed)) %>%
  462. transform(trial_target_position = as.numeric(trial_target_position)) %>%
  463. setDT(.)
  464. ```
  465. ```{r}
  466. dt_seq_behav_speed = dt_seq_behav %>%
  467. # filter out excluded subjects:
  468. filter(!(subject %in% subjects_excluded)) %>%
  469. setDT(.) %>%
  470. # average accuracy for each participant:
  471. .[, by = .(subject, trial_speed), .(
  472. num_trials = .N,
  473. mean_accuracy = mean(accuracy)
  474. )] %>%
  475. transform(mean_accuracy = mean_accuracy * 100) %>%
  476. setDT(.) %>%
  477. verify(all(num_trials == 15)) %>%
  478. verify(.[, by = .(trial_speed), .(
  479. num_subjects = .N
  480. )]$num_subjects == 36) %>%
  481. setorder(subject, trial_speed) %>%
  482. mutate(trial_speed = as.numeric(trial_speed)) %>%
  483. setDT(.)
  484. ```
  485. We run a LME model to test the effect of sequence speed (inter-stimulus interval) on mean behavioral accuracy on sequence trials:
  486. ```{r, results="hold", echo=TRUE}
  487. lme_seq_behav = lmer(
  488. mean_accuracy ~ trial_speed + (1 + trial_speed | subject),
  489. data = dt_seq_behav_speed, na.action = na.omit, control = lcctrl)
  490. summary(lme_seq_behav)
  491. anova(lme_seq_behav)
  492. emmeans_results = emmeans(lme_seq_behav, list(pairwise ~ trial_speed))
  493. emmeans_pvalues = round_pvalues(summary(emmeans_results[[2]])$p.value)
  494. emmeans_results
  495. emmeans_pvalues
  496. ```
  497. We compare mean behavioral accuracy at each sequence speed level to the chancel level of 50%:
  498. ```{r}
  499. chance_level = 50
  500. dt_seq_behav_mean = dt_seq_behav_speed %>%
  501. # average across participants:
  502. .[, by = .(trial_speed), {
  503. ttest_results = t.test(
  504. mean_accuracy, mu = chance_level, alternative = "greater")
  505. list(
  506. mean_accuracy = round(mean(mean_accuracy), digits = 2),
  507. sd_accuracy = round(sd(mean_accuracy), digits = 2),
  508. tvalue = round(ttest_results$statistic, digits = 2),
  509. conf_lb = round(ttest_results$conf.int[1], digits = 2),
  510. conf_ub = round(ttest_results$conf.int[2], digits = 2),
  511. pvalue = ttest_results$p.value,
  512. cohens_d = round((mean(mean_accuracy) - chance_level)/sd(mean_accuracy), 2),
  513. df = ttest_results$parameter,
  514. num_subs = .N,
  515. sem_upper = mean(mean_accuracy) + (sd(mean_accuracy)/sqrt(.N)),
  516. sem_lower = mean(mean_accuracy) - (sd(mean_accuracy)/sqrt(.N))
  517. )}] %>%
  518. verify(num_subs == 36) %>%
  519. mutate(sem_range = sem_upper - sem_lower) %>%
  520. mutate(pvalue_adjust = p.adjust(pvalue, method = "fdr")) %>%
  521. mutate(pvalue_adjust_round = round_pvalues(pvalue_adjust))
  522. # print paged table:
  523. rmarkdown::paged_table(dt_seq_behav_mean)
  524. ```
  525. We calculate the reduction in mean behavioral accuracy comparing the fastest and slowest speed condition:
  526. ```{r}
  527. a = dt_seq_behav_mean$mean_accuracy[dt_seq_behav_mean$trial_speed == 2.048]
  528. b = dt_seq_behav_mean$mean_accuracy[dt_seq_behav_mean$trial_speed == 0.032]
  529. reduced_acc = round((1 - (b/a)) * 100, 2)
  530. sprintf("reduction in accuracy: %.2f", reduced_acc)
  531. ```
  532. ```{r, echo=FALSE}
  533. fig_seq_speed = ggplot(data = dt_seq_behav_speed, mapping = aes(
  534. y = as.numeric(mean_accuracy), x = as.factor(as.numeric(trial_speed)*1000),
  535. fill = as.factor(trial_speed), color = as.factor(trial_speed))) +
  536. geom_bar(stat = "summary", fun = "mean") +
  537. geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
  538. color = "black", alpha = 0.5,
  539. inherit.aes = TRUE, binwidth = 2) +
  540. geom_errorbar(stat = "summary", fun.data = "mean_se", width = 0.0, color = "black") +
  541. geom_hline(aes(yintercept = 50), linetype = "dashed", color = "black") +
  542. ylab("Accuracy (%)") + xlab("Sequence speed (ms)") +
  543. scale_fill_viridis(discrete = TRUE, guide = FALSE, option = "cividis") +
  544. scale_color_viridis(discrete = TRUE, guide = FALSE, option = "cividis") +
  545. coord_capped_cart(left = "both", bottom = "both", expand = TRUE, ylim = c(0, 100)) +
  546. theme(plot.title = element_text(size = 12, face = "plain")) +
  547. theme(axis.ticks.x = element_blank(), axis.line.x = element_blank()) +
  548. ggtitle("Sequence") +
  549. theme(plot.title = element_text(hjust = 0.5)) +
  550. theme(axis.text = element_text(color = "black")) +
  551. theme(axis.ticks.x = element_line(color = "white")) +
  552. theme(axis.line.x = element_line(color = "white")) +
  553. theme(axis.ticks.y = element_line(color = "black")) +
  554. theme(axis.line.y = element_line(colour = "black"),
  555. panel.grid.major = element_blank(),
  556. panel.grid.minor = element_blank(),
  557. panel.border = element_blank(),
  558. panel.background = element_blank())
  559. fig_seq_speed
  560. ```
  561. ### Effect of target position
  562. We calculate the mean behavioral accuracy on sequence trials for each of possible serial position of the target stimulus:
  563. ```{r}
  564. dt_seq_behav_position = dt_seq_behav %>%
  565. # filter out excluded subjects:
  566. filter(!(subject %in% subjects_excluded)) %>% setDT(.) %>%
  567. # average accuracy for each participant:
  568. .[, by = .(subject, trial_target_position), .(
  569. num_trials = .N,
  570. mean_accuracy = mean(accuracy)
  571. )] %>%
  572. verify(.[, by = .(trial_target_position), .(
  573. num_subs = .N
  574. )]$num_subs == 36) %>%
  575. transform(mean_accuracy = mean_accuracy * 100) %>%
  576. setorder(subject, trial_target_position)
  577. ```
  578. ```{r}
  579. lme_seq_behav_position = lmer(
  580. mean_accuracy ~ trial_target_position + (1 + trial_target_position | subject),
  581. data = dt_seq_behav_position, na.action = na.omit, control = lcctrl)
  582. summary(lme_seq_behav_position)
  583. anova(lme_seq_behav_position)
  584. ```
  585. ```{r, echo=TRUE}
  586. fig_seq_position = ggplot(data = dt_seq_behav_position, mapping = aes(
  587. y = as.numeric(mean_accuracy), x = as.factor(trial_target_position),
  588. fill = as.factor(trial_target_position), color = as.factor(trial_target_position))) +
  589. geom_bar(stat = "summary", fun = "mean") +
  590. geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
  591. color = "black", alpha = 0.5,
  592. inherit.aes = TRUE, binwidth = 2) +
  593. geom_errorbar(stat = "summary", fun.data = "mean_se", width = 0.0, color = "black") +
  594. geom_hline(aes(yintercept = 50), linetype = "dashed", color = "black") +
  595. ylab("Accuracy (%)") + xlab("Target position") +
  596. scale_fill_manual(values = color_events, guide = FALSE) +
  597. scale_color_manual(values = color_events, guide = FALSE) +
  598. coord_capped_cart(left = "both", bottom = "both", expand = TRUE, ylim = c(0, 100)) +
  599. theme(axis.ticks.x = element_blank(), axis.line.x = element_blank()) +
  600. theme(axis.text = element_text(color = "black")) +
  601. theme(axis.ticks.x = element_line(color = "white")) +
  602. theme(axis.line.x = element_line(color = "white")) +
  603. theme(axis.ticks.y = element_line(color = "black")) +
  604. theme(axis.line.y = element_line(colour = "black"),
  605. panel.grid.major = element_blank(),
  606. panel.grid.minor = element_blank(),
  607. panel.border = element_blank(),
  608. panel.background = element_blank())
  609. fig_seq_position
  610. ```
  611. ## Repetition trials
  612. ### Mean accuracy
  613. We calculate mean behavioral accuracy in repetition trials for each participant:
  614. ```{r}
  615. dt_rep_behav = dt_events %>%
  616. # filter for repetition trials only:
  617. filter(condition == "repetition") %>% setDT(.) %>%
  618. # create additional variables to describe each trial:
  619. .[, by = .(subject, trial), ":=" (
  620. trial_key_down = ifelse(any(key_down == 1, na.rm = TRUE), 1, 0),
  621. trial_accuracy = ifelse(any(accuracy == 1, na.rm = TRUE), 1, 0),
  622. trial_target_position = serial_position[which(target == 1)],
  623. trial_speed = unique(interval_time[which(!is.na(interval_time))])
  624. )] %>%
  625. # select only choice trials that contain the accuracy data:
  626. filter(trial_type == "choice") %>% setDT(.) %>%
  627. verify(all(trial_accuracy == accuracy)) %>%
  628. # average across trials separately for each participant:
  629. .[, by = .(subject, trial_target_position), .(
  630. num_trials = .N,
  631. mean_accuracy = mean(accuracy)
  632. )] %>%
  633. verify(all(num_trials == 5)) %>%
  634. # transform mean accuracy into percent (%)
  635. transform(mean_accuracy = mean_accuracy * 100) %>%
  636. # check if accuracy values range between 0 and 100
  637. verify(between(x = mean_accuracy, lower = 0, upper = 100)) %>%
  638. mutate(interference = ifelse(
  639. trial_target_position == 2, "fwd", trial_target_position)) %>%
  640. transform(interference = ifelse(
  641. trial_target_position == 9, "bwd", interference))
  642. ```
  643. We run separate one-sided one-sample t-tests to access if mean behavioral performance for every repetition condition differs from a 50% chance level:
  644. ```{r}
  645. chance_level = 50
  646. dt_rep_behav_chance = dt_rep_behav %>%
  647. # filter out excluded subjects:
  648. filter(!(subject %in% subjects_excluded)) %>%
  649. setDT(.) %>%
  650. # average across participants:
  651. .[, by = .(trial_target_position), {
  652. ttest_results = t.test(
  653. mean_accuracy, mu = chance_level, alternative = "greater")
  654. list(
  655. mean_accuracy = round(mean(mean_accuracy), digits = 2),
  656. sd_accuracy = round(sd(mean_accuracy), digits = 2),
  657. tvalue = round(ttest_results$statistic, digits = 2),
  658. pvalue = ttest_results$p.value,
  659. conf_lb = round(ttest_results$conf.int[1], digits = 2),
  660. conf_ub = round(ttest_results$conf.int[2], digits = 2),
  661. cohens_d = round((mean(mean_accuracy) - chance_level)/sd(mean_accuracy), 2),
  662. df = ttest_results$parameter,
  663. num_subs = .N,
  664. sem_upper = mean(mean_accuracy) + (sd(mean_accuracy)/sqrt(.N)),
  665. sem_lower = mean(mean_accuracy) - (sd(mean_accuracy)/sqrt(.N))
  666. )}] %>% verify(num_subs == 36) %>%
  667. mutate(sem_range = sem_upper - sem_lower) %>%
  668. setDT(.) %>%
  669. filter(trial_target_position %in% seq(2,9)) %>%
  670. # create additional variable to label forward and backward interference:
  671. mutate(interference = ifelse(
  672. trial_target_position == 2, "fwd", trial_target_position)) %>%
  673. transform(interference = ifelse(
  674. trial_target_position == 9, "bwd", interference)) %>%
  675. mutate(pvalue_adjust = p.adjust(pvalue, method = "fdr")) %>%
  676. mutate(pvalue_adjust_round = round_pvalues(pvalue_adjust)) %>%
  677. mutate(significance = ifelse(pvalue_adjust < 0.05, "*", "")) %>%
  678. mutate(cohens_d = paste0("d = ", cohens_d, significance)) %>%
  679. mutate(label = paste0(
  680. trial_target_position - 1, "/", 10 - trial_target_position)) %>%
  681. setDT(.) %>%
  682. setorder(trial_target_position)
  683. # print table:
  684. rmarkdown::paged_table(dt_rep_behav_chance)
  685. ```
  686. We plot the results of the forward and backward interference conditions:
  687. ```{r, echo=TRUE}
  688. plot_data = dt_rep_behav_chance %>% filter(trial_target_position %in% c(2,9))
  689. fig_behav_rep = ggplot(data = plot_data, mapping = aes(
  690. y = as.numeric(mean_accuracy), x = fct_rev(as.factor(interference)),
  691. fill = as.factor(interference))) +
  692. geom_bar(stat = "summary", fun = "mean") +
  693. geom_dotplot(data = dt_rep_behav %>%
  694. filter(!(subject %in% subjects_excluded)) %>%
  695. filter(trial_target_position %in% c(2,9)) %>% setDT(.) %>%
  696. .[, by = .(subject, interference), .(
  697. mean_accuracy = mean(mean_accuracy)
  698. )],
  699. binaxis = "y", stackdir = "center", stackratio = 0.5,
  700. color = "black", alpha = 0.5, inherit.aes = TRUE, binwidth = 2) +
  701. geom_errorbar(aes(ymin = sem_lower, ymax = sem_upper), width = 0.0, color = "black") +
  702. ylab("Accuracy (%)") + xlab("Interfererence") +
  703. ggtitle("Repetition") +
  704. theme(plot.title = element_text(hjust = 0.5)) +
  705. scale_fill_manual(values = c("red", "dodgerblue"), guide = FALSE) +
  706. coord_capped_cart(left = "both", bottom = "both", expand = TRUE, ylim = c(0,100)) +
  707. theme(axis.ticks.x = element_blank(), axis.line.x = element_blank()) +
  708. theme(plot.title = element_text(size = 12, face = "plain")) +
  709. #scale_y_continuous(labels = label_fill(seq(0, 100, 12.5), mod = 2), breaks = seq(0, 100, 12.5)) +
  710. geom_hline(aes(yintercept = 50), linetype = "dashed", color = "black") +
  711. #geom_text(aes(y = as.numeric(mean_accuracy) + 10, label = pvalue_adjust_round), size = 3) +
  712. theme(axis.text = element_text(color = "black")) +
  713. theme(axis.ticks.x = element_line(color = "white")) +
  714. theme(axis.line.x = element_line(color = "white")) +
  715. theme(axis.ticks.y = element_line(color = "black")) +
  716. theme(axis.line.y = element_line(colour = "black"),
  717. panel.grid.major = element_blank(),
  718. panel.grid.minor = element_blank(),
  719. panel.border = element_blank(),
  720. panel.background = element_blank())
  721. fig_behav_rep
  722. ```
  723. We plot the results of all intermediate repetition conditions:
  724. ```{r, echo=TRUE}
  725. plot_data = dt_rep_behav_chance %>% filter(trial_target_position %in% seq(2,9))
  726. plot_behav_rep_all = ggplot(data = plot_data, mapping = aes(
  727. y = as.numeric(mean_accuracy), x = as.numeric(trial_target_position),
  728. fill = as.numeric(trial_target_position))) +
  729. geom_bar(stat = "identity") +
  730. geom_dotplot(data = dt_rep_behav %>%
  731. filter(!(subject %in% subjects_excluded)) %>%
  732. filter(trial_target_position %in% seq(2,9)) %>% setDT(.) %>%
  733. .[, by = .(subject, trial_target_position), .(
  734. mean_accuracy = mean(mean_accuracy)
  735. )],
  736. aes(x = as.numeric(trial_target_position),
  737. fill = as.numeric(trial_target_position),
  738. group = as.factor(trial_target_position)),
  739. binaxis = "y", stackdir = "center", stackratio = 0.5,
  740. inherit.aes = TRUE, binwidth = 2, color = "black", alpha = 0.5) +
  741. geom_errorbar(aes(ymin = sem_lower, ymax = sem_upper), width = 0.0, color = "black") +
  742. geom_text(aes(y = as.numeric(mean_accuracy) + 7, label = cohens_d), size = 2.5) +
  743. ylab("Accuracy (%)") + xlab("First / second item repetitions") +
  744. scale_fill_gradient(low = "dodgerblue", high = "red", guide = FALSE) +
  745. coord_capped_cart(left = "both", bottom = "both", expand = TRUE, ylim = c(0,100)) +
  746. scale_x_continuous(labels = plot_data$label, breaks = seq(2, 9, 1)) +
  747. geom_hline(aes(yintercept = 50), linetype = "dashed", color = "black") +
  748. theme(axis.ticks.x = element_blank(), axis.line.x = element_blank()) +
  749. theme(axis.text = element_text(color = "black")) +
  750. theme(axis.ticks.x = element_line(color = "white")) +
  751. theme(axis.line.x = element_line(color = "white")) +
  752. theme(axis.ticks.y = element_line(color = "black")) +
  753. theme(axis.line.y = element_line(colour = "black"),
  754. panel.grid.major = element_blank(),
  755. panel.grid.minor = element_blank(),
  756. panel.border = element_blank(),
  757. panel.background = element_blank())
  758. plot_behav_rep_all
  759. ```
  760. ```{r, echo=TRUE, eval=FALSE}
  761. ggsave(filename = "highspeed_plot_behavior_repetition_supplement.pdf",
  762. plot = last_plot(), device = cairo_pdf, path = path_figures,
  763. scale = 1, dpi = "retina", width = 5, height = 3, units = "in")
  764. ```
  765. We run a LME model to test the effect of repetition condition on mean behavioral accuracy in repetition trials:
  766. ```{r}
  767. lme_rep_behav_condition = lmer(
  768. mean_accuracy ~ trial_target_position + (1 + trial_target_position|subject),
  769. data = dt_rep_behav, na.action = na.omit, control = lcctrl)
  770. summary(lme_rep_behav_condition)
  771. anova(lme_rep_behav_condition)
  772. ```
  773. ## Figure Main
  774. We plot the figure for the main text:
  775. ```{r, echo=FALSE}
  776. plot_grid(fig_behav_odd, fig_seq_speed, fig_behav_rep, ncol = 3,
  777. rel_widths = c(2, 4.5, 2.5), labels = c("d", "e", "f"))
  778. ```
  779. ```{r, echo=FALSE, eval=FALSE}
  780. ggsave(filename = "highspeed_plot_behavior_horizontal.pdf",
  781. plot = last_plot(), device = cairo_pdf, path = path_figures,
  782. scale = 1, dpi = "retina", width = 7, height = 3, units = "in")
  783. ```
  784. ## Figure SI
  785. We plot the figure for the supplementary information:
  786. ```{r, echo=FALSE}
  787. plot_grid(
  788. plot_grid(
  789. fig_behav_all_outlier, plot_odd_sdt, plot_odd_run,
  790. rel_widths = c(3.5, 6, 5), ncol = 3, nrow = 1, labels = c("a", "b", "c")),
  791. plot_grid(
  792. fig_seq_position, plot_behav_rep_all, labels = c("d", "e"),
  793. ncol = 2, nrow = 1, rel_widths = c(4, 6)),
  794. nrow = 2)
  795. ```
  796. ```{r, echo=FALSE, eval=FALSE}
  797. ggsave(filename = "highspeed_plot_behavior_supplement.pdf",
  798. plot = last_plot(), device = cairo_pdf, path = path_figures, scale = 1,
  799. dpi = "retina", width = 8, height = 5)
  800. ggsave(filename = "wittkuhn_schuck_figure_s1.pdf",
  801. plot = last_plot(), device = cairo_pdf, path = path_figures, scale = 1,
  802. dpi = "retina", width = 8, height = 5)
  803. ```
  804. # Participants
  805. We analyze characteristics of the participants:
  806. ```{r, results="hold"}
  807. # read data table with participant information:
  808. dt_participants <- do.call(rbind, lapply(Sys.glob(path_participants), fread))
  809. # remove selected participants from the data table:
  810. dt_participants = dt_participants %>%
  811. filter(!(participant_id %in% subjects_excluded)) %>%
  812. setDT(.)
  813. base::table(dt_participants$sex)
  814. round(sd(dt_participants$age), digits = 2)
  815. base::summary(
  816. dt_participants[, c("age", "digit_span", "session_interval"), with = FALSE])
  817. round(sd(dt_participants$session_interval), digits = 2)
  818. ```