highspeed-analysis-behavior.Rmd 35 KB

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