Nothing
#' Save out pupil timeseries data in a BIDS-like structure
#'
#' This method provides a structured way to save out pupil data in a BIDS-like
#' structure. The method saves out epoched data as well as the raw pupil
#' timeseries, and formats the directory and filename structures based on the
#' metadata you provide.
#'
#' In the future, we intend for this function to save out the data in an
#' official BIDS format for eyetracking data (see [the proposal currently under
#' review here](https://github.com/bids-standard/bids-specification/pull/1128)).
#' At this time, however, this function instead takes a more BIDS-inspired
#' approach to organizing the output files for preprocessed pupil data.
#'
#' @param eyeris An object of class `eyeris` derived from [eyeris::load_asc()]
#' @param save_all Logical flag indicating whether all epochs are to be saved
#' or only a subset of them. Defaults to `TRUE`
#' @param epochs_list List of epochs to be saved. Defaults to `NULL`
#' @param merge_epochs Logical flag indicating whether epochs should be saved
#' as one file or as separate files. Defaults to `FALSE` (no merge)
#' @param bids_dir Base bids_directory. Defaults to `NULL`
#' @param participant_id BIDS subject ID. Defaults to `NULL`
#' @param session_num BIDS session ID. Defaults to `NULL`
#' @param task_name BIDS task ID. Defaults to `NULL`
#' @param run_num BIDS run ID. Optional override for the run number when there's
#' only one block of data present in a given `.asc` file. This allows you to
#' manually specify a run number (e.g., "03") instead of using the default block
#' number in `.asc` files (1). This is especially useful if you have a single
#' `.asc` file for a single run of a task and want your BIDSified derivatives to
#' be labeled correctly. However, for files with multiple recording blocks
#' embedded within the **same** `.asc` file, this parameter is ignored and
#' blocks are automatically numbered as runs (block 1 = run-01, block 2 =
#' run-02, etc.) in the order they appeared/were recorded. Defaults to `NULL`
#' (no override)
#' @param merge_runs Logical flag indicating whether multiple runs (either
#' from multiple recording blocks existing within the **same** `.asc` file
#' (see above), or manually specified) should be combined into a single
#' output file. When `TRUE`, adds a 'run' column to identify the source run
#' Defaults to `FALSE` (i.e., separate files per block/run -- the standard
#' BIDS-like-behavior)
#' @param save_raw Logical flag indicating whether to save_raw pupil data in
#' addition to epoched data. Defaults to `TRUE`
#' @param html_report Logical flag indicating whether to save out the `eyeris`
#' preprocessing summary report as an HTML file. Defaults to `TRUE`
#' @param report_seed Random seed for the plots that will appear in the report
#' Defaults to `0`. See [eyeris::plot()] for a more detailed description
#' @param report_epoch_grouping_var_col String name of grouping column to use
#' for epoch-by-epoch diagnostic plots in an interactive rendered HTML report.
#' Column name must exist (i.e., be a custom grouping variable name set within
#' the metadata template of your `epoch()` call).
#' Defaults to `"matched_event"`, which all epoched dataframes have as a valid
#' column name. To disable these epoch-level diagnostic plots, set to `NULL`
#' @param verbose A flag to indicate whether to print detailed logging messages.
#' Defaults to `TRUE`. Set to `FALSE` to suppress messages about the current
#' processing step and run silently
#' @param pdf_report **(Deprecated)** Use `html_report = TRUE` instead
#'
#' @return Invisibly returns `NULL`. Called for its side effects
#'
#' @seealso [lifecycle::deprecate_warn()]
#'
#' @examples
#' # Bleed around blink periods just long enough to remove majority of
#' # deflections due to eyelid movements
#' \donttest{
#' demo_data <- eyelink_asc_demo_dataset()
#'
#' # example with unepoched data
#' demo_data |>
#' eyeris::glassbox() |>
#' eyeris::bidsify(
#' bids_dir = tempdir(), # <- MAKE SURE TO UPDATE TO YOUR DESIRED LOCAL PATH
#' participant_id = "001",
#' session_num = "01",
#' task_name = "assocret",
#' run_num = "01",
#' save_raw = TRUE, # save out raw timeseries
#' html_report = TRUE, # generate interactive report document
#' report_seed = 0 # make randomly selected plot epochs reproducible
#' )
#'
#' # example with epoched data
#' demo_data |>
#' eyeris::glassbox() |>
#' eyeris::epoch(
#' events = "PROBE_{type}_{trial}",
#' limits = c(-1, 1), # grab 1 second prior to and 1 second post event
#' label = "prePostProbe" # custom epoch label name
#' ) |>
#' eyeris::bidsify(
#' bids_dir = tempdir(), # <- MAKE SURE TO UPDATE TO YOUR DESIRED LOCAL PATH
#' participant_id = "001",
#' session_num = "01",
#' task_name = "assocret",
#' run_num = "01"
#' )
#'
#' # example with run_num for single block data
#' demo_data <- eyelink_asc_demo_dataset()
#'
#' demo_data |>
#' eyeris::glassbox() |>
#' eyeris::epoch(
#' events = "PROBE_{type}_{trial}",
#' limits = c(-1, 1),
#' label = "prePostProbe"
#' ) |>
#' eyeris::bidsify(
#' bids_dir = tempdir(),
#' participant_id = "001",
#' session_num = "01",
#' task_name = "assocret",
#' run_num = "03" # override default run-01 (block_1) to use run-03 instead
#' )
#' }
#'
#' @export
bidsify <- function(eyeris, save_all = TRUE, epochs_list = NULL,
merge_epochs = FALSE, bids_dir = NULL,
participant_id = NULL, session_num = NULL,
task_name = NULL, run_num = NULL, merge_runs = FALSE,
save_raw = TRUE, html_report = TRUE, report_seed = 0,
report_epoch_grouping_var_col = "matched_event",
verbose = TRUE, pdf_report = deprecated()) {
# deprecation warning for pdf_report
if (is_present(pdf_report)) {
deprecate_warn(
"1.3.0",
"bidsify(pdf_report)",
"bidsify(html_report)"
)
html_report <- pdf_report
}
# nolint start
# setup
if (is.list(eyeris$timeseries) && !is.data.frame(eyeris$timeseries)) {
actual_block_count <- length(eyeris$timeseries)
if (actual_block_count > 1) {
# case: multiple blocks: show warning if run_num was provided
if (!is.null(run_num)) {
warning(
paste0(
"Note: `run_num` is ignored when data contains multiple blocks.",
"Blocks will be automatically numbered as runs (block 1 = run-01,",
"block 2 = run-02, etc.) in the order they appeared/were recorded."
)
)
}
has_multiple_runs <- TRUE
num_runs <- actual_block_count
} else {
# case: single block in list format, here allow override
has_multiple_runs <- FALSE
num_runs <- 1
if (verbose) {
alert("info", "Only 1 block detected...")
}
if (!is.null(run_num)) {
if (verbose) {
alert("info", "Using run_num = %s for single block data", run_num)
}
original_block_name <- names(eyeris$timeseries)[1]
run_num_stripped <- as.character(as.integer(run_num))
new_block_name <- paste0("block_", run_num_stripped)
names(eyeris$timeseries)[1] <- new_block_name
if ("block" %in% colnames(eyeris$timeseries[[1]])) {
eyeris$timeseries[[1]]$block <- as.numeric(run_num)
}
if (is.list(eyeris$events) && length(eyeris$events) == 1) {
names(eyeris$events)[1] <- new_block_name
if ("block" %in% colnames(eyeris$events[[1]])) {
eyeris$events[[1]]$block <- as.numeric(run_num)
}
}
if (is.list(eyeris$blinks) && length(eyeris$blinks) == 1) {
names(eyeris$blinks)[1] <- new_block_name
if ("block" %in% colnames(eyeris$blinks[[1]])) {
eyeris$blinks[[1]]$block <- as.numeric(run_num)
}
}
epoch_names <- names(eyeris)[grep("^epoch_", names(eyeris))]
for (epoch_name in epoch_names) {
if (
is.list(eyeris[[epoch_name]]) && original_block_name
%in% names(eyeris[[epoch_name]])) {
names(eyeris[[epoch_name]])[names(eyeris[[epoch_name]]) ==
original_block_name] <- new_block_name
if (!is.null(eyeris[[epoch_name]]$info)) {
names(eyeris[[epoch_name]]$info)[
names(eyeris[[epoch_name]]$info) == original_block_name] <-
new_block_name
}
if (is.data.frame(eyeris[[epoch_name]][[new_block_name]]) &&
"block" %in%
colnames(eyeris[[epoch_name]][[new_block_name]])) {
eyeris[[epoch_name]][[new_block_name]]$block <-
as.numeric(run_num)
}
}
}
if (!is.null(eyeris$confounds)) {
if (!is.null(eyeris$confounds$unepoched_timeseries) &&
original_block_name %in%
names(eyeris$confounds$unepoched_timeseries)) {
names(eyeris$confounds$unepoched_timeseries)[
names(eyeris$confounds$unepoched_timeseries) ==
original_block_name] <- new_block_name
}
if (!is.null(eyeris$confounds$epoched_timeseries)) {
for (epoch_name in names(eyeris$confounds$epoched_timeseries)) {
if (original_block_name %in%
names(eyeris$confounds$epoched_timeseries[[epoch_name]])) {
names(eyeris$confounds$epoched_timeseries[[epoch_name]])[
names(eyeris$confounds$epoched_timeseries[[epoch_name]]) ==
original_block_name] <- new_block_name
}
}
}
if (!is.null(eyeris$confounds$epoched_epoch_wide)) {
for (epoch_name in names(eyeris$confounds$epoched_epoch_wide)) {
if (original_block_name %in%
names(eyeris$confounds$epoched_epoch_wide[[epoch_name]])) {
names(eyeris$confounds$epoched_epoch_wide[[epoch_name]])[
names(eyeris$confounds$epoched_epoch_wide[[epoch_name]]) ==
original_block_name] <- new_block_name
}
}
}
}
baseline_names <- names(eyeris)[grep("^baseline_", names(eyeris))]
for (baseline_name in baseline_names) {
if (is.list(eyeris[[baseline_name]]) && original_block_name
%in% names(eyeris[[baseline_name]])) {
names(eyeris[[baseline_name]])[
names(eyeris[[baseline_name]]) == original_block_name
] <- new_block_name
if (is.data.frame(eyeris[[baseline_name]][[new_block_name]]) &&
"block" %in%
colnames(eyeris[[baseline_name]][[new_block_name]])) {
eyeris[[baseline_name]][[new_block_name]]$block <-
as.numeric(run_num)
}
}
}
} else {
original_block_name <- names(eyeris$timeseries)[1]
run_num <- as.numeric(sub("block_", "", original_block_name))
if (verbose) {
alert("info", "No value for run_num supplied...")
alert("info", "Using default run_num = %s for single block data",
run_num)
}
}
}
} else {
# case: single df fallback, no override
has_multiple_runs <- FALSE
num_runs <- 1
}
sub <- participant_id
ses <- session_num
task <- task_name
dir <- bids_dir
tryCatch(
{
check_data(eyeris, "bidsify")
},
error = function(e) {
error_handler(e, "input_data_type_error")
}
)
tryCatch(
{
check_input(arg = participant_id)
},
error = function(e) {
error_handler(e, "input_arg_missing_error")
}
)
tryCatch(
{
check_input(arg = task_name)
},
error = function(e) {
error_handler(e, "input_arg_missing_error")
}
)
epochs <- filter_epochs(eyeris, epochs_list)
n_epochs <- length(epochs)
any_epochs <- n_epochs > 0
if (verbose) {
alert("info", "Filtered epochs: %s", paste(epochs, collapse = ", "))
}
if (save_all && any_epochs) {
epochs_to_save <- eyeris[epochs]
} else if (!is.null(epochs_list)) {
epochs_to_save <- eyeris[epochs_list]
} else {
epochs_to_save <- NULL
}
if (verbose && any_epochs) {
alert("info", "Epochs to save structure:")
alert("info", " Names: %s", paste(names(epochs_to_save), collapse = ", "))
for (epoch_name in names(epochs_to_save)) {
epoch_data <- epochs_to_save[[epoch_name]]
if (is.list(epoch_data)) {
alert(
"info", " %s: list with %d elements", epoch_name, length(epoch_data)
)
for (block_name in names(epoch_data)) {
block_data <- epoch_data[[block_name]]
if (is.data.frame(block_data)) {
alert(
"info", " %s: data.frame with %d rows",
block_name, nrow(block_data)
)
} else {
alert("info", " %s: %s", block_name, class(block_data))
}
}
} else if (is.data.frame(epoch_data)) {
alert(
"info", " %s: data.frame with %d rows", epoch_name, nrow(epoch_data)
)
} else {
alert("info", " %s: %s", epoch_name, class(epoch_data))
}
}
}
check_and_create_dir(dir, verbose = verbose)
p <- file.path("derivatives")
check_and_create_dir(dir, p, verbose = verbose)
if (!is.null(sub)) {
p <- file.path(p, paste0("sub-", sub))
check_and_create_dir(dir, p, verbose = verbose)
}
if (!is.null(ses)) {
p <- file.path(p, paste0("ses-", ses))
check_and_create_dir(dir, p, verbose = verbose)
}
# normalize report_path
report_path <- file.path(bids_dir, p)
report_path <- normalizePath(report_path, winslash = "/", mustWork = FALSE)
p <- file.path(p, "eye")
check_and_create_dir(dir, p, verbose = verbose)
block_numbers <- get_block_numbers(eyeris)
if (!merge_epochs && any_epochs) {
if (has_multiple_runs) {
for (epoch_id in names(epochs_to_save)) {
current_label <- substr(epoch_id, 7, nchar(epoch_id))
if (verbose) {
alert(
"info", "Processing epoch: %s (label: %s)", epoch_id, current_label
)
}
if (merge_runs) {
epochs_with_runs <- do.call(
rbind, lapply(names(eyeris$timeseries), function(i) {
run_epochs <- epochs_to_save[[epoch_id]][[i]]
run_epochs$run <- sprintf("%02d", get_block_numbers(i))
run_epochs
})
)
f <- make_bids_fname(
sub_id = sub, ses_id = ses, task_name = task, run_num = run_num,
desc = paste0("preproc_pupil_allruns_", current_label)
)
if (verbose) {
alert(
"info",
"Writing combined runs epoched data for epoch '%s' to '%s'...",
current_label, file.path(dir, p, f)
)
}
write.csv(epochs_with_runs,
file = file.path(bids_dir, p, f),
row.names = FALSE
)
if (verbose) {
alert(
"success",
"Combined runs epoched data for epoch '%s' written to: '%s'",
current_label, file.path(dir, p, f)
)
}
} else {
for (i in names(eyeris$timeseries)) {
run_epochs <- epochs_to_save[[epoch_id]][[i]]
if (verbose) {
alert("info", "Processing run %s for epoch %s", i, epoch_id)
}
if (is.null(run_epochs)) {
if (verbose) {
alert(
"warning", "Skipping run %s for epoch %s - no data",
i, epoch_id
)
}
next
}
if (!is.data.frame(run_epochs) || nrow(run_epochs) == 0) {
if (verbose) {
alert(
"warning",
"Skipping run %s for epoch %s - empty or invalid data", i,
epoch_id
)
}
next
}
if (verbose) {
alert(
"info", "Run %s for epoch %s has %d rows", i, epoch_id,
nrow(run_epochs)
)
}
evs <- if (!is.null(find_baseline_structure(eyeris, current_label))
&& !is.null(eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$epoch_events)) {
epoch_events <- eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
epoch_events
} else {
paste(epoch_events, collapse = ", ")
}
} else {
paste(epoch_events, collapse = ", ")
}
} else {
epoch_data <- eyeris[[epoch_id]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
for (block_name in names(epoch_data$info)) {
if (!is.null(epoch_data$info[[block_name]]$epoch_events)) {
epoch_events <- epoch_data$info[[block_name]]$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
result <- epoch_events
} else {
result <- paste(epoch_events, collapse = ", ")
}
} else {
result <- paste(epoch_events, collapse = ", ")
}
message("Found epoch events in epoch structure: ", result)
}
}
}
NULL
}
c_bline <- !is.null(
find_baseline_structure(eyeris, current_label)
) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$baseline_events)
bline_evs <- if (c_bline) {
baseline_events <- eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$baseline_events
if (is.character(baseline_events)) {
if (length(baseline_events) == 1) {
baseline_events
} else {
paste(baseline_events, collapse = ", ")
}
} else {
paste(baseline_events, collapse = ", ")
}
} else {
NULL
}
bline_type <- if (c_bline) {
baseline_type <- eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$baseline_type
if (is.character(baseline_type)) {
if (length(baseline_type) == 1) {
baseline_type
} else {
paste(baseline_type, collapse = ", ")
}
} else {
paste(baseline_type, collapse = ", ")
}
} else {
NULL
}
f <- make_bids_fname(
sub_id = sub,
ses_id = ses,
task_name = task,
run_num = sprintf("%02d", get_block_numbers(i)),
desc = "preproc_pupil",
epoch_name = current_label,
epoch_events = evs,
baseline_events = bline_evs,
baseline_type = bline_type
)
if (verbose) {
alert(
"info",
"Writing run %02d epoched data for epoch '%s' to '%s'...",
get_block_numbers(i), current_label, file.path(dir, p, f)
)
}
write.csv(run_epochs,
file = file.path(bids_dir, p, f),
row.names = FALSE
)
if (verbose) {
alert(
"success",
"Run %02d epoched data for epoch '%s' written to: '%s'",
get_block_numbers(i), current_label, file.path(dir, p, f)
)
}
}
}
}
} else {
for (epoch_id in names(epochs_to_save)) {
current_label <- substr(epoch_id, 7, nchar(epoch_id))
if (verbose) {
alert(
"info", "Processing single-run epoch: %s (label: %s)",
epoch_id, current_label
)
}
epoch_entry <- epochs_to_save[[epoch_id]]
block_names <- setdiff(names(epoch_entry), "info")
any_written <- FALSE
for (block_name in block_names) {
block_data <- epoch_entry[[block_name]]
if (is.null(block_data) || !is.data.frame(block_data) || nrow(block_data) == 0) {
if (verbose) {
alert(
"warning", "Skipping block %s for epoch %s - empty or invalid data", block_name, epoch_id
)
}
next
}
if (verbose) {
alert(
"info", "Block %s for epoch %s has %d rows", block_name, epoch_id, nrow(block_data)
)
}
evs <- if (!is.null(find_baseline_structure(eyeris, current_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$epoch_events)) {
epoch_events <- eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
epoch_events
} else {
paste(epoch_events, collapse = ", ")
}
} else {
paste(epoch_events, collapse = ", ")
}
} else {
epoch_data <- eyeris[[epoch_id]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
for (bn in names(epoch_data$info)) {
if (!is.null(epoch_data$info[[bn]]$epoch_events)) {
epoch_events <- epoch_data$info[[bn]]$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
result <- epoch_events
} else {
result <- paste(epoch_events, collapse = ", ")
}
} else {
result <- paste(epoch_events, collapse = ", ")
}
message("Found epoch events in epoch structure: ", result)
}
}
}
NULL
}
c_bline <- !is.null(find_baseline_structure(eyeris, current_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$baseline_events)
bline_evs <- if (c_bline) {
baseline_events <- eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$baseline_events
if (is.character(baseline_events)) {
if (length(baseline_events) == 1) {
baseline_events
} else {
paste(baseline_events, collapse = ", ")
}
} else {
paste(baseline_events, collapse = ", ")
}
} else {
NULL
}
bline_type <- if (c_bline) {
baseline_type <- eyeris[[find_baseline_structure(
eyeris, current_label
)]]$block_1$info$baseline_type
if (is.character(baseline_type)) {
if (length(baseline_type) == 1) {
baseline_type
} else {
paste(baseline_type, collapse = ", ")
}
} else {
paste(baseline_type, collapse = ", ")
}
} else {
NULL
}
f <- make_bids_fname(
sub_id = sub,
ses_id = ses,
task_name = task,
run_num = sprintf("%02d", as.numeric(run_num)),
desc = "preproc_pupil",
epoch_name = current_label,
epoch_events = evs,
baseline_events = bline_evs,
baseline_type = bline_type
)
if (verbose) {
alert(
"info",
"Writing epoched data for epoch '%s' (block %s) to '%s'...",
current_label, block_name, file.path(dir, p, f)
)
}
write.csv(block_data,
file = file.path(bids_dir, p, f),
row.names = FALSE
)
if (verbose) {
alert(
"success", "Epoched data for epoch '%s' (block %s) written to: '%s'",
current_label, block_name, file.path(dir, p, f)
)
}
any_written <- TRUE
}
if (!any_written && verbose) {
alert("warning", "No valid blocks found for epoch %s", epoch_id)
}
}
}
} else if (any_epochs) {
# merge all epochs and runs (if multiple runs exist)
if (has_multiple_runs && merge_runs) {
merged_epochs <- do.call(
rbind, lapply(names(epochs_to_save), function(epoch_id) {
epochs_with_runs <- do.call(
rbind, lapply(names(eyeris$timeseries), function(i) {
run_epochs <- epochs_to_save[[epoch_id]][[i]]
run_epochs$run <- sprintf("%02d", get_block_numbers(i))
run_epochs$epoch_type <- epoch_id
run_epochs
})
)
epochs_with_runs
})
)
f <- make_bids_fname(
sub_id = sub, ses_id = ses, task_name = task, run_num = run_num,
desc = "preproc_pupil_allruns",
epoch_name = if (length(epochs_to_save) > 0) {
first_epoch_id <- names(epochs_to_save)[1]
first_label <- substr(first_epoch_id, 7, nchar(first_epoch_id))
first_label
} else {
NULL
},
epoch_events = if (length(epochs_to_save) > 0) {
first_epoch_id <- names(epochs_to_save)[1]
first_label <- substr(first_epoch_id, 7, nchar(first_epoch_id))
if (!is.null(find_baseline_structure(eyeris, first_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$epoch_events)) {
epoch_events <- eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
epoch_events
} else {
paste(epoch_events, collapse = ", ")
}
} else {
paste(epoch_events, collapse = ", ")
}
} else {
epoch_data <- eyeris[[first_epoch_id]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
for (block_name in names(epoch_data$info)) {
if (!is.null(epoch_data$info[[block_name]]$epoch_events)) {
epoch_events <- epoch_data$info[[block_name]]$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
result <- epoch_events
} else {
result <- paste(epoch_events, collapse = ", ")
}
} else {
result <- paste(epoch_events, collapse = ", ")
}
message("Found epoch events in epoch structure: ", result)
}
}
}
NULL
}
} else {
NULL
},
baseline_events = if (length(epochs_to_save) > 0) {
first_epoch_id <- names(epochs_to_save)[1]
first_label <- substr(first_epoch_id, 7, nchar(first_epoch_id))
if (!is.null(find_baseline_structure(eyeris, first_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$baseline_events)) {
baseline_events <- eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$baseline_events
if (is.character(baseline_events)) {
if (length(baseline_events) == 1) {
result <- baseline_events
} else {
result <- paste(baseline_events, collapse = ", ")
}
} else {
result <- paste(baseline_events, collapse = ", ")
}
message("Found baseline events: ", result)
return(result)
}
} else {
NULL
},
baseline_type = if (length(epochs_to_save) > 0) {
first_epoch_id <- names(epochs_to_save)[1]
first_label <- substr(first_epoch_id, 7, nchar(first_epoch_id))
if (!is.null(find_baseline_structure(eyeris, first_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$baseline_type)) {
baseline_type <- eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$baseline_type
if (is.character(baseline_type)) {
if (length(baseline_type) == 1) {
result <- baseline_type
} else {
result <- paste(baseline_type, collapse = ", ")
}
} else {
result <- paste(baseline_type, collapse = ", ")
}
message("Found baseline type: ", result)
return(result)
} else {
NULL
}
} else {
NULL
}
)
} else {
merged_epochs <- do.call(
rbind, lapply(names(epochs_to_save), function(epoch_id) {
epochs <- epochs_to_save[[epoch_id]]
epochs$epoch_type <- epoch_id
epochs
})
)
f <- make_bids_fname(
sub_id = sub,
ses_id = ses,
task_name = task,
run_num = sprintf("%02d", as.numeric(run_num)),
desc = "preproc_pupil",
epoch_name = if (length(epochs_to_save) > 0) {
first_epoch_id <- names(epochs_to_save)[1]
first_label <- substr(first_epoch_id, 7, nchar(first_epoch_id))
first_label
} else {
NULL
},
epoch_events = if (length(epochs_to_save) > 0) {
first_epoch_id <- names(epochs_to_save)[1]
first_label <- substr(first_epoch_id, 7, nchar(first_epoch_id))
if (!is.null(find_baseline_structure(eyeris, first_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$epoch_events)) {
epoch_events <- eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
epoch_events
} else {
paste(epoch_events, collapse = ", ")
}
} else {
paste(epoch_events, collapse = ", ")
}
} else {
epoch_data <- eyeris[[first_epoch_id]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
for (block_name in names(epoch_data$info)) {
if (!is.null(epoch_data$info[[block_name]]$epoch_events)) {
epoch_events <- epoch_data$info[[block_name]]$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
result <- epoch_events
} else {
result <- paste(epoch_events, collapse = ", ")
}
} else {
result <- paste(epoch_events, collapse = ", ")
}
message("Found epoch events in epoch structure: ", result)
}
}
}
NULL
}
} else {
NULL
},
baseline_events = if (length(epochs_to_save) > 0) {
first_epoch_id <- names(epochs_to_save)[1]
first_label <- substr(first_epoch_id, 7, nchar(first_epoch_id))
if (!is.null(find_baseline_structure(eyeris, first_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$baseline_events)) {
baseline_events <- eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$baseline_events
if (is.character(baseline_events)) {
if (length(baseline_events) == 1) {
result <- baseline_events
} else {
result <- paste(baseline_events, collapse = ", ")
}
} else {
result <- paste(baseline_events, collapse = ", ")
}
message("Found baseline events: ", result)
return(result)
}
} else {
NULL
},
baseline_type = if (length(epochs_to_save) > 0) {
first_epoch_id <- names(epochs_to_save)[1]
first_label <- substr(first_epoch_id, 7, nchar(first_epoch_id))
if (!is.null(find_baseline_structure(eyeris, first_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$baseline_type)) {
baseline_type <- eyeris[[find_baseline_structure(
eyeris, first_label
)]]$block_1$info$baseline_type
if (is.character(baseline_type)) {
if (length(baseline_type) == 1) {
result <- baseline_type
} else {
result <- paste(baseline_type, collapse = ", ")
}
} else {
result <- paste(baseline_type, collapse = ", ")
}
message("Found baseline type: ", result)
return(result)
} else {
NULL
}
} else {
NULL
}
)
}
if (verbose) {
alert("info", "Writing merged epochs to '%s'...", file.path(dir, p, f))
}
write.csv(merged_epochs,
file = file.path(bids_dir, p, f),
row.names = FALSE
)
if (verbose) {
alert(
"success", "Merged epochs written to: '%s'",
file.path(dir, p, f)
)
}
}
if (save_raw) {
if (has_multiple_runs) {
if (merge_runs) {
# save all runs together
combined_timeseries <- do.call(
rbind, lapply(seq_len(num_runs), function(i) {
if (has_multiple_runs) {
run_data <- eyeris$timeseries[[i]]
} else {
run_data <- eyeris$timeseries
}
run_data$run <- sprintf("%02d", i)
run_data
})
)
f <- make_bids_fname(
sub_id = sub, ses_id = ses, task_name = task, run_num = run_num,
desc = "timeseries_pupil_allruns"
)
if (verbose) {
alert(
"info", "Writing combined raw pupil timeseries to '%s'...",
file.path(dir, p, f)
)
}
write.csv(combined_timeseries,
file.path(dir, p, f),
row.names = FALSE
)
if (verbose) {
alert(
"success",
"Combined raw pupil timeseries written to: '%s'",
file.path(dir, p, f)
)
}
} else {
# save each run separately
lapply(seq_len(num_runs), function(i) {
if (has_multiple_runs) {
run_data <- eyeris$timeseries[[i]]
} else {
run_data <- eyeris$timeseries
}
f <- make_bids_fname(
sub_id = sub,
ses_id = ses,
task_name = task,
run_num = sprintf("%02d", i),
desc = "timeseries_pupil"
)
if (verbose) {
alert(
"info",
"Writing run %02d raw pupil timeseries to '%s'...",
i, file.path(dir, p, f)
)
}
write.csv(run_data, file.path(dir, p, f), row.names = FALSE)
if (verbose) {
alert(
"success",
"Run %02d raw pupil timeseries written to: '%s'",
i, file.path(dir, p, f)
)
}
})
}
} else {
# single run fallback case
f <- make_bids_fname(
sub_id = sub,
ses_id = ses,
task_name = task,
run_num = sprintf("%02d", as.numeric(run_num)),
desc = "timeseries_pupil"
)
if (verbose) {
alert(
"info", "Writing single raw pupil timeseries to '%s'...",
file.path(dir, p, f)
)
}
timeseries_data <- if (is.list(eyeris$timeseries) && !is.data.frame(eyeris$timeseries)) {
eyeris$timeseries[[1]]
} else {
eyeris$timeseries
}
write.csv(timeseries_data, file.path(dir, p, f), row.names = FALSE)
if (verbose) {
alert(
"success", "Single raw pupil timeseries written to: '%s'",
file.path(dir, p, f)
)
}
}
}
# first export confounds for unepoched timeseries
if (!is.null(eyeris$confounds$unepoched_timeseries)) {
if (length(block_numbers) == 1) {
# case: single block
export_confounds_to_csv(
confounds_list = eyeris$confounds$unepoched_timeseries,
output_dir = file.path(dir, p),
filename_prefix = function(i) {
paste0(
"sub-", sub,
if (!is.null(ses)) paste0("_ses-", ses) else "",
"_task-", task,
if (!merge_runs) sprintf("_run-%02d",
as.numeric(block_numbers)) else "",
"_desc-confounds"
)
},
verbose = verbose,
run_num = if (!merge_runs) as.numeric(block_numbers) else run_num
)
} else {
# case: multiple blocks - export each block's confounds separately
for (block in block_numbers) {
block_name <- paste0("block_", block)
if (block_name %in% names(eyeris$confounds$unepoched_timeseries)) {
single_block_confounds <- list()
single_block_confounds[[block_name]] <-
eyeris$confounds$unepoched_timeseries[[block_name]]
export_confounds_to_csv(
confounds_list = single_block_confounds,
output_dir = file.path(dir, p),
filename_prefix = function(i) {
paste0(
"sub-", sub,
if (!is.null(ses)) paste0("_ses-", ses) else "",
"_task-", task,
if (!merge_runs) sprintf("_run-%02d",
as.numeric(block)) else "",
"_desc-confounds"
)
},
verbose = verbose,
run_num = if (!merge_runs) as.numeric(block) else run_num
)
}
}
}
}
if (!is.null(eyeris$confounds$epoched_timeseries) ||
!is.null(eyeris$confounds$epoched_epoch_wide) && any_epochs) {
# create summary files for each block
for (block in block_numbers) {
epoch_summary <- data.frame(
epoch_type = names(eyeris)[grep("^epoch_", names(eyeris))],
epoch_events = sapply(names(eyeris)[grep("^epoch_", names(eyeris))],
function(epoch_name) {
epoch_label <- sub("^epoch_", "", epoch_name)
baseline_structure <- find_baseline_structure(eyeris, epoch_label)
message("Processing epoch: ", epoch_name, " -> label: ",
epoch_label, " -> baseline: ", baseline_structure)
if (!is.null(baseline_structure) &&
!is.null(eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$epoch_events)) {
epoch_events <- eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
result <- epoch_events
} else {
result <- paste(epoch_events, collapse = ", ")
}
} else {
result <- paste(epoch_events, collapse = ", ")
}
message("Found epoch events in baseline structure: ", result)
return(result)
} else {
epoch_data <- eyeris[[epoch_name]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
block_name <- paste0("block_", block)
if (block_name %in% names(epoch_data$info) &&
!is.null(epoch_data$info[[block_name]]$epoch_events)) {
epoch_events <- epoch_data$info[[block_name]]$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
result <- epoch_events
} else {
result <- paste(epoch_events, collapse = ", ")
}
} else {
result <- paste(epoch_events, collapse = ", ")
}
message("Found epoch events in epoch structure: ", result)
return(result)
}
}
message("No epoch events found for: ", epoch_name)
NA_character_
}
}),
epoch_limits = sapply(names(eyeris)[grep("^epoch_", names(eyeris))],
function(epoch_name) {
epoch_label <- sub("^epoch_", "", epoch_name)
baseline_structure <- find_baseline_structure(eyeris, epoch_label)
if (!is.null(baseline_structure) &&
!is.null(eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$epoch_limits)) {
paste(eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$epoch_limits, collapse = ", ")
} else {
epoch_data <- eyeris[[epoch_name]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
block_name <- paste0("block_", block)
if (block_name %in% names(epoch_data$info) &&
!is.null(epoch_data$info[[block_name]]$epoch_limits)) {
paste(epoch_data$info[[block_name]]$epoch_limits, collapse = ", ")
} else {
NA_character_
}
} else {
NA_character_
}
}
}),
n_epochs = sapply(names(eyeris)[grep("^epoch_", names(eyeris))],
function(epoch_name) {
epoch_label <- sub("^epoch_", "", epoch_name)
baseline_structure <- find_baseline_structure(eyeris, epoch_label)
if (!is.null(baseline_structure) &&
!is.null(eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$n_epochs)) {
eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$n_epochs
} else {
epoch_data <- eyeris[[epoch_name]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
block_name <- paste0("block_", block)
if (block_name %in% names(epoch_data$info) &&
!is.null(epoch_data$info[[block_name]]$n_epochs)) {
return(epoch_data$info[[block_name]]$n_epochs)
}
}
# fallback: count epochs from the data itself for this block
epoch_data <- eyeris[[epoch_name]]
if (is.list(epoch_data)) {
block_name <- paste0("block_", block)
if (block_name %in% names(epoch_data) &&
is.data.frame(epoch_data[[block_name]]) &&
"matched_event" %in% colnames(epoch_data[[block_name]])) {
length(unique(epoch_data[[block_name]]$matched_event))
} else {
0
}
} else if (is.data.frame(epoch_data) &&
"matched_event" %in% colnames(epoch_data)) {
length(unique(epoch_data$matched_event))
} else {
NA_integer_
}
}
}),
baseline_events = sapply(names(eyeris)[grep("^epoch_", names(eyeris))],
function(epoch_name) {
epoch_label <- sub("^epoch_", "", epoch_name)
baseline_structure <- find_baseline_structure(eyeris, epoch_label)
if (!is.null(baseline_structure) &&
!is.null(eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$baseline_events)) {
baseline_events <- eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$baseline_events
if (is.character(baseline_events)) {
if (length(baseline_events) == 1) {
result <- baseline_events
} else {
result <- paste(baseline_events, collapse = ", ")
}
} else {
result <- paste(baseline_events, collapse = ", ")
}
message("Found baseline events: ", result)
return(result)
} else {
message("No baseline events found for: ", epoch_name)
NA_character_
}
}),
baseline_period = sapply(names(eyeris)[grep("^epoch_", names(eyeris))],
function(epoch_name) {
epoch_label <- sub("^epoch_", "", epoch_name)
baseline_structure <- find_baseline_structure(eyeris, epoch_label)
if (!is.null(baseline_structure) &&
!is.null(eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$baseline_period)) {
paste(eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$baseline_period, collapse = ", ")
} else {
NA_character_
}
}),
n_baseline_epochs = sapply(names(eyeris)[
grep("^epoch_", names(eyeris))], function(epoch_name) {
epoch_label <- sub("^epoch_", "", epoch_name)
baseline_structure <- find_baseline_structure(eyeris, epoch_label)
if (!is.null(baseline_structure) &&
!is.null(eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$n_baseline_epochs)) {
eyeris[[baseline_structure]][[
paste0("block_", block)]]$info$n_baseline_epochs
} else {
# if no baseline structure, there are no baseline epochs
NA_integer_
}
})
)
summary_filename <- make_bids_fname(
sub_id = sub,
ses_id = ses,
task_name = task,
run_num = if (!merge_runs) sprintf("%02d",
as.numeric(block)) else run_num,
desc = "epoch_summary"
)
summary_filepath <- file.path(dir, p, summary_filename)
if (verbose) {
alert("info", "Writing epoch summary for block %d to '%s'...", block,
summary_filepath)
}
write.csv(epoch_summary, summary_filepath, row.names = FALSE)
if (verbose) {
alert("success", "Epoch summary for block %d written to: '%s'", block,
summary_filepath)
}
}
# export epoch-wide confounds
if (!is.null(eyeris$confounds$epoched_epoch_wide) && any_epochs) {
for (epoch_name in names(eyeris$confounds$epoched_epoch_wide)) {
epoch_label <- sub("^epoch_", "", epoch_name)
epoch_folder <- file.path(dir, p, paste0("epoch_", epoch_label))
if (!dir.exists(epoch_folder)) {
dir.create(epoch_folder, recursive = TRUE)
}
epoch_events_info <- if (!is.null(find_baseline_structure(
eyeris, epoch_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$epoch_events)) {
epoch_events <- eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
epoch_events
} else {
paste(epoch_events, collapse = ", ")
}
} else {
paste(epoch_events, collapse = ", ")
}
} else {
epoch_data <- eyeris[[epoch_name]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
for (block_name in names(epoch_data$info)) {
if (!is.null(epoch_data$info[[block_name]]$epoch_events)) {
epoch_events <- epoch_data$info[[block_name]]$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
result <- epoch_events
} else {
result <- paste(epoch_events, collapse = ", ")
}
} else {
result <- paste(epoch_events, collapse = ", ")
}
message("Found epoch events in epoch structure: ", result)
}
}
}
NULL
}
baseline_events_info <-
if (!is.null(find_baseline_structure(eyeris, epoch_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$baseline_events)) {
baseline_events <- eyeris[[
find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$baseline_events
if (is.character(baseline_events)) {
if (length(baseline_events) == 1) {
baseline_events
} else {
paste(baseline_events, collapse = ", ")
}
} else {
paste(baseline_events, collapse = ", ")
}
} else {
NULL
}
baseline_type_info <-
if (!is.null(find_baseline_structure(eyeris, epoch_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$baseline_type)) {
baseline_type <- eyeris[[
find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$baseline_type
if (is.character(baseline_type)) {
if (length(baseline_type) == 1) {
baseline_type
} else {
paste(baseline_type, collapse = ", ")
}
} else {
paste(baseline_type, collapse = ", ")
}
} else {
NULL
}
for (block_name in names(
eyeris$confounds$epoched_epoch_wide[[epoch_name]])) {
block_confounds <-
eyeris$confounds$epoched_epoch_wide[[epoch_name]][[block_name]]
if (nrow(block_confounds) == 0) next
matched_events <- unique(block_confounds$matched_event)
for (event in matched_events) {
event_confounds <- block_confounds[
block_confounds$matched_event == event, ]
if (nrow(event_confounds) == 0) next
event_unique <- if ("text_unique" %in% colnames(event_confounds)) {
unique(event_confounds$text_unique)[1]
} else {
event
}
epoch_filename <- make_bids_fname(
sub_id = sub,
ses_id = ses,
task_name = task,
run_num = sprintf("%02d", get_block_numbers(block_name)),
epoch_name = epoch_label,
desc = paste0("confounds_epoch_wide_", event_unique),
epoch_events = epoch_events_info,
baseline_events = baseline_events_info,
baseline_type = baseline_type_info
)
epoch_filepath <- file.path(epoch_folder, epoch_filename)
if (verbose) {
alert(
"info",
paste0("Writing epoch-wide confounds for event '%s'",
"(unique: '%s') to '%s'..."),
event, event_unique, epoch_filepath
)
}
write.csv(event_confounds, epoch_filepath, row.names = FALSE)
if (verbose) {
alert(
"success",
paste0("Epoch-wide confounds for event '%s'",
"(unique: '%s') written to: '%s'"),
event, event_unique, epoch_filepath
)
}
}
}
}
}
if (!is.null(eyeris$confounds$epoched_timeseries)) {
for (epoch_name in names(eyeris$confounds$epoched_timeseries)) {
epoch_label <- sub("^epoch_", "", epoch_name)
epoch_folder <- file.path(dir, p, paste0("epoch_", epoch_label))
if (!dir.exists(epoch_folder)) {
dir.create(epoch_folder, recursive = TRUE)
}
epoch_events_info <-
if (!is.null(find_baseline_structure(eyeris, epoch_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$epoch_events)) {
epoch_events <- eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
epoch_events
} else {
paste(epoch_events, collapse = ", ")
}
} else {
paste(epoch_events, collapse = ", ")
}
} else {
epoch_data <- eyeris[[epoch_name]]
if (is.list(epoch_data) && !is.null(epoch_data$info)) {
for (block_name in names(epoch_data$info)) {
if (!is.null(epoch_data$info[[block_name]]$epoch_events)) {
epoch_events <- epoch_data$info[[block_name]]$epoch_events
if (is.character(epoch_events)) {
if (length(epoch_events) == 1) {
result <- epoch_events
} else {
result <- paste(epoch_events, collapse = ", ")
}
} else {
result <- paste(epoch_events, collapse = ", ")
}
message("Found epoch events in epoch structure: ", result)
}
}
}
NULL
}
baseline_events_info <-
if (!is.null(find_baseline_structure(eyeris, epoch_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$baseline_events)) {
baseline_events <- eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$baseline_events
if (is.character(baseline_events)) {
if (length(baseline_events) == 1) {
result <- baseline_events
} else {
result <- paste(baseline_events, collapse = ", ")
}
} else {
result <- paste(baseline_events, collapse = ", ")
}
} else {
NULL
}
baseline_type_info <-
if (!is.null(find_baseline_structure(eyeris, epoch_label)) &&
!is.null(eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$baseline_type)) {
baseline_type <- eyeris[[find_baseline_structure(
eyeris, epoch_label)]]$block_1$info$baseline_type
if (is.character(baseline_type)) {
if (length(baseline_type) == 1) {
result <- baseline_type
} else {
result <- paste(baseline_type, collapse = ", ")
}
} else {
result <- paste(baseline_type, collapse = ", ")
}
} else {
NULL
}
for (block_name in names(
eyeris$confounds$epoched_timeseries[[epoch_name]])) {
block_confounds <- eyeris$confounds$epoched_timeseries[[
epoch_name]][[block_name]]
if (nrow(block_confounds) == 0) next
matched_events <- unique(block_confounds$matched_event)
for (event in matched_events) {
event_confounds <-
block_confounds[block_confounds$matched_event == event, ]
if (nrow(event_confounds) == 0) next
event_unique <- if ("text_unique" %in% colnames(event_confounds)) {
unique(event_confounds$text_unique)[1]
} else {
event
}
event_filename <- make_bids_fname(
sub_id = sub,
ses_id = ses,
task_name = task,
run_num = sprintf("%02d", get_block_numbers(block_name)),
epoch_name = epoch_label,
desc = paste0("confounds_steps_", event_unique),
epoch_events = epoch_events_info,
baseline_events = baseline_events_info,
baseline_type = baseline_type_info
)
event_filepath <- file.path(epoch_folder, event_filename)
if (verbose) {
alert(
"info",
paste0("Writing step-specific confounds for event '%s'",
"(unique: '%s') to '%s'..."),
event, event_unique, event_filepath
)
}
write.csv(event_confounds, event_filepath, row.names = FALSE)
if (verbose) {
alert(
"success",
paste0("Step-specific confounds for event '%s'",
"(unique: '%s') written to: '%s'"),
event, event_unique, event_filepath
)
}
}
}
}
}
}
should_render_report <- html_report
if (should_render_report) {
# normalize the bids_dir path
bids_dir <- normalizePath(path.expand(bids_dir), mustWork = FALSE)
# create full path for figures
figs_out <- file.path(report_path, "source", "figures")
# create directories with normalized path
check_and_create_dir(figs_out, verbose = verbose)
fig_paths <- c()
# first check if there are multiple runs
if (is.list(eyeris$timeseries) && !is.data.frame(eyeris$timeseries)) {
has_multiple_runs <- TRUE
num_runs <- length(eyeris$timeseries)
} else {
has_multiple_runs <- FALSE
num_runs <- 1
}
for (i_run in block_numbers) {
current_data <- if (has_multiple_runs) {
eyeris$timeseries[[paste0("block_", i_run)]]
} else {
eyeris$timeseries
}
pupil_steps <- grep("^pupil_", colnames(current_data), value = TRUE)
run_fig_paths <- rep(NA, length(pupil_steps) * 2)
run_dir <- file.path(figs_out, sprintf("run-%02d", i_run))
check_and_create_dir(run_dir, verbose = verbose)
# make step-by-step plots
plot_types <- c("timeseries", "histogram")
for (i in seq_along(pupil_steps)) {
for (p in seq_along(plot_types)) {
fig_name <- sprintf(
"run-%02d_fig-%d_desc-%s.jpg",
i_run, i, plot_types[p]
)
run_fig_paths[(i - 1) * 2 + p] <- file.path(run_dir, fig_name)
}
}
# plot random epoch panel
for (i in seq_along(run_fig_paths)) {
plot_dist <- i %% 2 == 0
jpeg(run_fig_paths[i],
width = 12, height = 7, units = "in",
res = 300, pointsize = 14
)
tryCatch(
{
plot(eyeris,
steps = ceiling(i / 2),
seed = report_seed,
block = i_run,
plot_distributions = plot_dist,
add_progressive_summary = FALSE
)
},
error = function(e) {
# create empty plot with error message
plot(NA,
xlim = c(0, 1), ylim = c(0, 1), type = "n",
xlab = "", ylab = "",
main = paste("No data to plot for block", i_run)
)
text(0.5, 0.5,
paste("Error plotting block", i_run, ":\n", e$message),
cex = 0.8, col = "red"
)
}
)
dev.off()
}
# make full timeseries plots for all intermediate steps
for (i_step in seq_along(pupil_steps)) {
for (p in seq_along(plot_types)[1]) {
plot_dist <- p %% 2 == 0
fig_filename <- file.path(
run_dir,
sprintf(
"run-%02d_fig-full-%d_desc-%s.jpg",
i_run,
i_step,
plot_types[p]
)
)
run_fig_paths <- c(run_fig_paths, fig_filename)
jpeg(fig_filename,
width = 12, height = 7, units = "in", res = 300, pointsize = 18
)
max_time <- max(current_data$time_secs, na.rm = TRUE)
if (!is.finite(max_time)) {
max_time <- 1 # default if no time data
}
tryCatch(
{
plot(eyeris,
steps = i_step,
preview_window = c(0, max_time),
block = i_run,
plot_distributions = plot_dist
)
},
error = function(e) {
plot(NA,
xlim = c(0, 1), ylim = c(0, 1), type = "n",
xlab = "", ylab = "",
main = paste("No data to plot for block", i_run)
)
text(0.5, 0.5,
paste("Error plotting block", i_run, ":\n", e$message),
cex = 0.8, col = "red"
)
}
)
dev.off()
}
}
fig_paths <- c(fig_paths, run_fig_paths)
}
for (i_run in block_numbers) {
current_data <- eyeris
if (all(c("eye_x", "eye_y") %in% colnames(current_data$timeseries[[paste0("block_", i_run)]])) &&
all(c("screen.x", "screen.y") %in% colnames(eyeris$info))) {
run_dir <- file.path(figs_out, sprintf("run-%02d", i_run))
check_and_create_dir(run_dir, verbose = verbose)
heatmap_filename <- file.path(
run_dir,
sprintf("run-%02d_gaze_heatmap.png", i_run)
)
png(heatmap_filename,
width = 8, height = 6, units = "in", res = 300, pointsize = 12
)
tryCatch({
plot_gaze_heatmap(
eyeris = current_data,
block = i_run,
screen_width = eyeris$info$screen.x,
screen_height = eyeris$info$screen.y,
n_bins = 50,
col_palette = "viridis",
main = sprintf("Gaze Heatmap (run-%02d)", i_run)
)
}, error = function(e) {
plot(NA,
xlim = c(0, 1), ylim = c(0, 1), type = "n",
xlab = "", ylab = "",
main = sprintf("Error creating gaze heatmap for run-%02d", i_run)
)
text(0.5, 0.5,
paste("Error:", e$message),
cex = 0.8, col = "red"
)
})
dev.off()
if (verbose) {
alert("info", "Created gaze heatmap for run-%02d", i_run)
}
}
}
# now handle epochs (if present)
if (!is.null(report_epoch_grouping_var_col)) {
for (i in seq_along(epochs_to_save)) {
epoch_data <- epochs_to_save[[i]]
if (is.null(epoch_data) || !is.list(epoch_data)) {
if (verbose) {
alert("warning",
"Skipping epoch %d for report generation - no valid data", i)
}
next
}
for (bn in names(epoch_data)) {
if (is.null(epoch_data[[bn]]) ||
!is.data.frame(epoch_data[[bn]]) || nrow(epoch_data[[bn]]) == 0) {
if (verbose) {
alert("warning",
"Skipping block %s for epoch %d - no valid data", bn, i)
}
next
}
tryCatch(
{
check_column(
epochs_to_save[[i]][[bn]],
report_epoch_grouping_var_col
)
},
error = function(e) {
error_handler(e, "column_doesnt_exist_in_df_error")
}
)
run_dir <- file.path(
figs_out,
sprintf(
"run-%02d",
get_block_numbers(bn)
)
)
check_and_create_dir(run_dir, verbose = verbose)
epochs_out <- file.path(run_dir, names(epochs_to_save)[i])
check_and_create_dir(epochs_out, verbose = verbose)
epoch_groups <- as.vector(
unique(epochs_to_save[[i]][[bn]]
[report_epoch_grouping_var_col])[[1]]
)
for (group in epoch_groups) {
group_df <- epochs_to_save[[i]][[bn]]
group_df <- group_df[
group_df[[report_epoch_grouping_var_col]] == group,
]
for (pstep in seq_along(pupil_steps)) {
if (grepl("z", pupil_steps[pstep])) {
y_units <- "(z)"
} else {
y_units <- "(a.u.)"
}
colorpal <- eyeris_color_palette()
colors <- c("black", colorpal)
y_label <- paste("pupil size", y_units)
file_out <- file.path(epochs_out, sprintf(
"run-%02d_%s_%d.png",
get_block_numbers(bn), group, pstep
))
png(file_out,
width = 3.25,
height = 2.5,
units = "in",
res = 600,
pointsize = 6
)
y_values <- group_df[[pupil_steps[pstep]]]
if (any(is.finite(y_values))) {
plot(group_df$timebin, y_values,
type = "l", xlab = "time (s)", ylab = y_label,
col = colors[pstep],
main = paste0(
group, "\n", pupil_steps[pstep],
sprintf(
" (Run %d)",
get_block_numbers(bn)
)
)
)
} else {
plot(NA,
xlim = range(group_df$timebin, na.rm = TRUE),
ylim = c(0, 1), type = "n", xlab = "time (s)",
ylab = y_label, main = paste0(
group, "\n",
pupil_steps[pstep],
"\nNO DATA"
)
)
warning(
paste("eyeris: no finite pupillometry data to plot for
current epoch...", "plotting empty epoch plot.")
)
}
dev.off()
}
}
for (group in epoch_groups) {
group_df <- epochs_to_save[[i]][[bn]]
group_df <- group_df[
group_df[[report_epoch_grouping_var_col]] == group,
]
if (all(c("eye_x", "eye_y") %in% colnames(group_df)) &&
all(c("screen.x", "screen.y") %in% colnames(eyeris$info))) {
heatmap_filename <- file.path(epochs_out, sprintf(
"run-%02d_%s_gaze_heatmap.png",
get_block_numbers(bn), group
))
png(heatmap_filename,
width = 6, height = 4, units = "in", res = 300, pointsize = 10
)
tryCatch({
plot_gaze_heatmap(
eyeris = group_df,
block = get_block_numbers(bn),
screen_width = eyeris$info$screen.x,
screen_height = eyeris$info$screen.y,
n_bins = 30,
col_palette = "viridis",
main = sprintf("%s\nGaze Heatmap (run-%02d)",
group, get_block_numbers(bn))
)
}, error = function(e) {
plot(NA,
xlim = c(0, 1), ylim = c(0, 1), type = "n",
xlab = "", ylab = "",
main = paste("Error creating gaze heatmap for epoch", group)
)
text(0.5, 0.5,
paste("Error:", e$message),
cex = 0.8, col = "red"
)
})
dev.off()
if (verbose) {
alert("info", "Created gaze heatmap for epoch %s (run-%02d)",
group, get_block_numbers(bn))
}
}
}
if (any_epochs) {
epochs <- list.files(epochs_out,
full.names = FALSE,
pattern = "\\.(jpg|jpeg|png|gif)$",
ignore.case = TRUE
)
epochs <- file.path(
"source", "figures",
sprintf("run-%02d", get_block_numbers(bn)),
names(epochs_to_save)[i],
epochs
)
make_gallery(eyeris, epochs, report_path,
sprintf(
"%s%s",
names(epochs_to_save)[i],
sprintf("_run-%02d", get_block_numbers(bn))
),
sub = sub, ses = ses, task = task,
run = sprintf("%02d", get_block_numbers(bn))
)
}
}
}
}
# make final report
report_output <- make_report(
eyeris,
report_path,
fig_paths,
sub = sub, ses = ses, task = task
)
render_report(report_output)
}
invisible(NULL)
}
make_bids_fname <- function(sub_id, task_name, run_num,
desc = "", ses_id = NULL, epoch_name = NULL,
epoch_events = NULL, baseline_events = NULL,
baseline_type = NULL) {
desc_parts <- c(desc)
if (!is.null(epoch_events)) {
epoch_event_name <- if (is.character(epoch_events) &&
length(epoch_events) == 1) {
gsub("[*{}]", "", epoch_events)
} else {
"multi_events"
}
desc_parts <- c(desc_parts,
paste0("epoch-", sanitize_event_tag(epoch_event_name, "")))
} else if (!is.null(epoch_name)) {
# fallback: use epoch_name with "epoch_" prefix removed
epoch_name_clean <- sub("^epoch_", "", epoch_name)
desc_parts <- c(desc_parts,
paste0("epoch-", sanitize_event_tag(epoch_name_clean, "")))
}
if (!is.null(baseline_events)) {
baseline_event_name <-
if (is.character(baseline_events) && length(baseline_events) == 1) {
gsub("[*{}]", "", baseline_events)
} else {
"multi_baseline"
}
bline_string <- "bline"
if (!is.null(baseline_type)) {
bline_string <- paste0(bline_string, "-", baseline_type)
}
bline_string <- paste0(bline_string, "-",
sanitize_event_tag(baseline_event_name, ""))
desc_parts <- c(desc_parts, bline_string)
}
final_desc <- paste(desc_parts, collapse = "_")
f <- paste0(
"sub-", sub_id,
if (!is.null(ses_id)) paste0("_ses-", ses_id) else "",
"_task-", task_name,
if (!is.null(run_num)) paste0("_run-", run_num) else "",
"_desc-", final_desc,
".csv"
)
return(gsub("__", "_", f)) # replace double underscores
}
#' Find baseline structure name for a given epoch
#'
#' Helper function to find the correct baseline structure name that matches
#' the complex baseline naming scheme used by eyeris.
#'
#' @param eyeris An object of class `eyeris` derived from [eyeris::load_asc()]
#' @param epoch_label The epoch label (without "epoch_" prefix)
#'
#' @return The baseline structure name or `NULL` if not found
#'
#' @keywords internal
find_baseline_structure <- function(eyeris, epoch_label) {
baseline_names <- names(eyeris)[grep("^baseline_", names(eyeris))]
if (length(baseline_names) > 0) {
message("Available baseline structures: ",
paste(baseline_names, collapse = ", "))
message("Looking for epoch label: ", epoch_label)
}
for (baseline_name in baseline_names) {
if (grepl(paste0("_epoch_", epoch_label, "$"), baseline_name)) {
message("Found matching baseline structure: ", baseline_name)
return(baseline_name)
}
}
simple_name <- paste0("baseline_", epoch_label)
if (simple_name %in% names(eyeris)) {
message("Found simple baseline structure: ", simple_name)
return(simple_name)
}
message("No baseline structure found for epoch label: ", epoch_label)
NULL
}
# nolint end
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.