R/pipeline-loadasc.R

In eyeris: Flexible, Extensible, & Reproducible Processing of Pupil Data

#' Load and parse SR Research EyeLink `.asc` files
#'
#' This function builds upon the [eyelinker::read.asc()] function to parse the
#' messages and metadata within the EyeLink `.asc` file. After loading and
#' additional processing, this function returns an S3 `eyeris` class for use in
#' all subsequent `eyeris` pipeline steps and functions.
#'
#' @param file An SR Research EyeLink `.asc` file generated by the official
#' EyeLink `edf2asc` command.
#' @param block Optional block number specification. The following are valid
#' options:
#'   * "auto" (default): Automatically handles multiple recording segments
#'   embedded within the same `.asc` file. We recommend using this default as
#'   this is likely the safer choice then assuming a single-block recording
#'   (unless you know what you're doing).
#'   * `NULL`: Omits block column. Suitable for single-block recordings.
#'   * Numeric value: Manually sets block number based on the value provided
#'   here.
#'
#' @return An object of S3 class `eyeris` with the following attributes:
#' \enumerate{
#'   \item `file`: Path to the original `.asc` file.
#'   \item `timeseries`: Dataframe of all raw timeseries data from the tracker.
#'   \item `events`: Dataframe of all event messages and their timestamps.
#'   \item `blinks`: Dataframe of all blink events.
#'   \item `info`: Dataframe of various metadata parsed from the file header.
#'   \item `latest`: `eyeris` variable for tracking pipeline run history.
#' }
#'
#' @seealso [eyelinker::read.asc()] which this function wraps.
#'
#' @examples
#' # Basic usage (no block column specified)
#' system.file("extdata", "memory.asc", package = "eyeris") |>
#'   eyeris::load_asc()
#'
#' # Manual specification of block number
#' system.file("extdata", "memory.asc", package = "eyeris") |>
#'   eyeris::load_asc(block = 3)
#'
#' # Auto-detect multiple recording segments embedded within the same file
#' system.file("extdata", "memory.asc", package = "eyeris") |>
#'   eyeris::load_asc(block = "auto")
#'
#' @export
load_asc <- function(file, block = "auto") {
  if (!tools::file_ext(file) %in% c("asc", "gz")) {
    stop(sprintf("Error: The file '%s' is not a .asc file.", file))
  }

  x <- eyelinker::read.asc(
    fname = file,
    samples = TRUE,
    events = TRUE,
    parse_all = FALSE
  )

  # parse metadata
  is_mono <- x$info$mono
  is_left <- x$info$left
  is_right <- x$info$right
  if (is_mono) {
    if (is_left) eye <- "L"
    if (is_right) eye <- "R"
  } else {
    if (is_left && is_right) eye <- "LR"
  }
  hz <- x$info$sample.rate
  pupil_type <- tolower(x$info$pupil.dtype)

  # raw data processing
  raw_df <- x$raw |>
    dplyr::select(
      block,
      time_orig = time,
      pupil_raw = ps,
      eye_x = xp,
      eye_y = yp
    ) |>
    dplyr::mutate(
      eye = eye,
      hz = hz,
      type = pupil_type
    ) |>
    dplyr::relocate(pupil_raw, .after = type)

  # return list object
  list_out <- vector("list", length = 6)
  names.out <- c(
    "file",
    "timeseries",
    "events",
    "blinks",
    "info",
    "latest"
  )
  names(list_out) <- names.out

  # block handler
  if (!is.null(block)) {
    if (block == "auto") {
      # check existing blocks parsed by eyelinker
      existing_blocks <- unique(x$raw$block)
      if (length(existing_blocks) > 1) {
        # split raw data by eyelinker-detected blocks
        list_out$timeseries <- split(
          raw_df,
          paste0("block_", x$raw$block)
        )
        list_out$events <- split(
          x$msg,
          paste0("block_", x$msg$block)
        )
        list_out$blinks <- split(
          x$blinks,
          paste0("block_", x$blinks$block)
        )
      } else {
        # if eyelinker parses only 1 block, then use that single block
        list_out$timeseries <- list("block_1" = raw_df)
        list_out$events <- list("block_1" = x$msg)
        list_out$blinks <- list("block_1" = x$blinks)
      }
    } else if (is.numeric(block)) {
      # manual setting
      list_out$timeseries <- setNames(
        list(raw_df),
        paste0("block_", as.character(block))
      )
      list_out$events <- setNames(
        list(x$msg),
        paste0("block_", as.character(block))
      )
      list_out$blinks <- setNames(
        list(x$blinks),
        paste0("block_", as.character(block))
      )
    } else {
      stop("`block` must be either: NULL, numeric, or 'auto'.")
    }
  } else {
    # fallback to direct assignment if all block cases fail
    list_out$timeseries <- raw_df
    list_out$events <- x$msg
    list_out$blinks <- x$blinks
  }

  # fix metadata (info) for newer versions of eyelink
  fixed_info <- parse_eyelink_info(x$info$version, x$info$model)
  x$info$version <- fixed_info$version
  x$info$model <- fixed_info$model

  list_out$file <- file
  list_out$info <- x$info
  list_out$latest <- "pupil_raw"
  class(list_out) <- "eyeris"

  return(list_out)
}