diff --git a/R/bids_subject.R b/R/bids_subject.R index 1f11a52..db66148 100644 --- a/R/bids_subject.R +++ b/R/bids_subject.R @@ -10,7 +10,10 @@ #' #' @return A list containing helper functions: #' \itemize{ -#' \item{\code{events}:}{Read event files via [read_events()].} +#' \item{\code{events}:}{Read event files via [read_events()]. When +#' called with `concatenate = TRUE`, returns a tibble (or a list of +#' tibbles if multiple tasks are loaded) with `.task` and, optionally, +#' `.run` columns appended to each event table.} #' \item{\code{scans}:}{Retrieve functional scan paths via [func_scans()].} #' \item{\code{confounds}:}{Read confound tables with [read_confounds()].} #' \item{\code{preproc_scans}:}{Retrieve preprocessed scan paths with [preproc_scans()].} @@ -21,6 +24,8 @@ #' proj <- bids_project(system.file("extdata/ds001", package="bidser")) #' subj <- bids_subject(proj, "01") #' subj$events() +#' # Concatenate events across runs with run indicator +#' subj$events(concatenate = TRUE, add_run = TRUE) #' subj$scans() bids_subject.bids_project <- function(x, subid, ...) { if (!inherits(x, "bids_project")) { @@ -34,7 +39,40 @@ bids_subject.bids_project <- function(x, subid, ...) { stop("Subject not found: ", sid) } list( - events = function(...) read_events(x, subid = sid, ...), + events = function(task = ".*", run = ".*", session = ".*", + concatenate = FALSE, add_run = FALSE, ...) { + evs <- read_events(x, subid = sid, task = task, run = run, + session = session, ...) + + if (!concatenate) { + return(evs) + } + + if (nrow(evs) == 0) { + return(tibble::tibble()) + } + + df_list <- lapply(seq_len(nrow(evs)), function(i) { + d <- evs$data[[i]] + if (add_run) { + d$.run <- evs$.run[i] + } + d$.task <- evs$.task[i] + d$.session <- evs$.session[i] + d$.subid <- evs$.subid[i] + d + }) + + combined <- dplyr::bind_rows(df_list) + + task_split <- split(combined, combined$.task) + + if (length(task_split) == 1) { + task_split[[1]] + } else { + task_split + } + }, scans = function(...) func_scans(x, subid = sid, ...), confounds = function(...) read_confounds(x, subid = sid, ...), preproc_scans = function(...) preproc_scans(x, subid = sid, ...) diff --git a/tests/testthat/test_bids_subject.R b/tests/testthat/test_bids_subject.R index fccf578..c739eb4 100644 --- a/tests/testthat/test_bids_subject.R +++ b/tests/testthat/test_bids_subject.R @@ -11,6 +11,11 @@ test_that("bids_subject exposes subject-level helpers", { sc <- subj$scans() expect_equal(nrow(ev), 3) expect_equal(length(sc), 3) + + ev_concat <- subj$events(concatenate = TRUE, add_run = TRUE) + expect_true(is.data.frame(ev_concat)) + expect_true(all(c(".task", ".run") %in% names(ev_concat))) + expect_equal(length(unique(ev_concat$.run)), 3) }) test_that("bids_subject works with fmriprep data", { @@ -22,3 +27,12 @@ test_that("bids_subject works with fmriprep data", { expect_true(length(pscans) > 0) expect_true(all(grepl("sub-1001", pscans))) }) + +test_that("concatenation returns list when multiple tasks", { + proj <- bids_project(system.file("extdata/ds002", package="bidser"), fmriprep=FALSE) + subj <- bids_subject(proj, "07") + evs <- subj$events(concatenate = TRUE, add_run = TRUE) + expect_true(is.list(evs)) + expect_equal(length(evs), 3) + expect_true(all(sapply(evs, is.data.frame))) +})