R/pipeline-glassbox.R

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

#' The opinionated "glass box" `eyeris` pipeline
#'
#' This `glassbox` function (in contrast to a "black box" function where you run
#' it and get a result but have no (or little) idea as to how you got from input
#' to output) has a few primary benefits over calling each exported function
#' from `eyeris` separately.
#'
#' First, this `glassbox` function provides a highly opinionated prescription of
#' steps and starting parameters we believe any pupillometry researcher should
#' use as their defaults when preprocessing pupillometry data.
#'
#' Second, and not mutually exclusive from the first point, using this function
#' should ideally reduce the probability of accidental mishaps when
#' "reimplementing" the steps from the preprocessing pipeline both within and
#' across projects. We hope to streamline the process in such a way that you
#' could collect a pupillometry dataset and within a few minutes assess the
#' quality of those data while simultaneously running a full preprocessing
#' pipeline in 1-ish line of code!
#'
#' Third, `glassbox` provides an "interactive" framework where you can evaluate
#' the consequences of the parameters within each step on your data in real
#' time, facilitating a fairly easy-to-use workflow for parameter optimization
#' on your particular dataset. This process essentially takes each of the
#' opinionated steps and provides a pre-/post-plot of the timeseries data for
#' each step so you can adjust parameters and re-run the pipeline until you are
#' satisfied with the choices of your paramters and their consequences on your
#' pupil timeseries data.
#'
#' @param file An SR Research EyeLink `.asc` file generated by the official
#' EyeLink `edf2asc` command.
#' @param confirm A flag to indicate whether to run the `glassbox` pipeline
#' autonomously all the way through (set to `FALSE` by default), or to
#' interactively provide a visualization after each pipeline step, where you
#' must also indicate "(y)es" or "(n)o" to either proceed or cancel the
#' current `glassbox` pipeline operation (set to `TRUE`).
#' @param detrend_data A flag to indicate whether to run the `detrend` step (set
#' to `FALSE` by default). Detrending your pupil timeseries can have unintended
#' consequences; we thus recommend that users understand the implications of
#' detrending -- in addition to whether detrending is appropriate for the
#' research design and question(s) -- before using this function.
#' @param num_previews Number of random example "epochs" to generate for
#' previewing the effect of each preprocessing step on the pupil timeseries.
#' @param preview_duration Time in seconds of each randomly selected preview.
#' @param preview_window The start and stop raw timestamps used to subset the
#' preprocessed data from each step of the `eyeris` workflow for visualization.
#' Defaults to NULL, meaning random epochs as defined by `num_previews` and
#' `preview_duration` will be plotted. To override the random epochs, set
#' `preview_window` here to a vector with relative start and stop times
#' (e.g., `c(5000, 6000)` to indicate the raw data from 5-6 seconds on data that
#' were recorded at 1000 Hz). Note, the start/stop time values indicated here
#' relate to the raw index position of each pupil sample from 1 to n (which
#' will need to be specified manually by the user depending on the sampling rate
#' of the recording; i.e., 5000-6000 for the epoch positioned from 5-6 seconds
#' after the start of the timeseries, sampled at 1000 Hz).
#' @param skip_detransient A flag to indicate whether to skip the `detransient`
#' step (set to `FALSE` by default). In most cases, this should remain `FALSE`.
#' For a more detailed description about likely edge cases that would prompt
#' you to set this to `TRUE`, see the docs for [eyeris::detransient()].
#' @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 ... Additional arguments to override the default, prescribed settings.
#'
#' @return Preprocessed pupil data contained within an object of class `eyeris`.
#'
#' @examples
#' demo_data <- system.file("extdata", "memory.asc", package = "eyeris")
#'
#' # (1) examples using the default prescribed parameters and pipeline recipe
#'
#' ## (a) run an automated pipeline with no real-time inspection of parameters
#' output <- eyeris::glassbox(demo_data)
#'
#' plot(
#'   output,
#'   steps = c(1, 5),
#'   preview_window = c(0, nrow(output$timeseries$block_1)),
#'   seed = 0
#' )
#'
#' ## (b) run a interactive workflow (with confirmation prompts after each step)
#' \donttest{
#' output <- eyeris::glassbox(demo_data, confirm = TRUE, seed = 0)
#' }
#'
#' # (2) examples overriding the default parameters
#' output <- eyeris::glassbox(
#'   demo_data,
#'   confirm = FALSE, # TRUE if you want to visualize each step in real-time
#'   deblink = list(extend = 40),
#'   lpfilt = list(plot_freqz = FALSE)
#' )
#'
#' plot(output, seed = 0)
#'
#' @export
glassbox <- function(file, confirm = FALSE, detrend_data = FALSE,
                     num_previews = 3, preview_duration = 5,
                     preview_window = NULL, skip_detransient = FALSE,
                     verbose = TRUE, ...) {
  # the default parameters
  params <- list(
    load_asc = list(block = "auto"),
    deblink = list(extend = 50),
    detransient = list(n = 16, mad_thresh = NULL),
    lpfilt = list(wp = 4, ws = 8, rp = 1, rs = 35, plot_freqz = TRUE)
  )

  # override defaults
  params <- utils::modifyList(params, list(...))

  # eyeris workflow data structure
  pipeline <- list(
    load_asc = function(data, params) {
      eyeris::load_asc(data, block = params$load_asc$block)
    },
    deblink = function(data, params) {
      eyeris::deblink(data, extend = params$deblink$extend)
    },
    detransient = function(data, params) {
      if (skip_detransient) {
        data
      } else {
        eyeris::detransient(data, n = params$detransient$n)
      }
    },
    interpolate = function(data, params) {
      eyeris::interpolate(data, verbose = verbose)
    },
    lpfilt = function(data, params) {
      eyeris::lpfilt(data,
        wp = params$lpfilt$wp,
        ws = params$lpfilt$ws,
        rp = params$lpfilt$rp,
        rs = params$lpfilt$rs,
        plot_freqz = params$lpfilt$plot_freqz
      )
    },
    detrend = function(data, params) {
      if (detrend_data) {
        eyeris::detrend(data)
      } else {
        data
      }
    },
    zscore = function(data, params) {
      eyeris::zscore(data)
    }
  )

  seed <- NULL
  step_counter <- 1
  only_linear_trend <- FALSE
  next_step <- c()

  for (step_name in names(pipeline)) {
    action <- "Running "
    skip_plot <- FALSE

    if (!detrend_data) {
      if (step_name == "detrend") {
        action <- "Skipping "
        step_counter <- step_counter - 1
        skip_plot <- TRUE
      }
    } else {
      if (step_name == "detrend") {
        only_linear_trend <- TRUE
      }
    }

    if (verbose) {
      cli::cli_alert_success(
        paste0("[  OK  ] - ", action, "eyeris::", step_name, "()")
      )
    }

    step_to_run <- pipeline[[step_name]]
    err_thrown <- FALSE
    file <- tryCatch(
      {
        step_to_run(file, params)
      },
      error = function(e) {
        if (verbose) {
          cli::cli_alert_info(
            paste0(
              "[ INFO ] - ", "Skipping eyeris::", step_name, "(): ",
              e$message
            )
          )
        }
        err_thrown <<- TRUE
        step_counter <<- step_counter - 1
        file
      }
    )

    pupil_steps <- grep("^pupil_",
      colnames(file$timeseries$block_1),
      value = TRUE
    )

    if (confirm) {
      if (!err_thrown) {
        if (!skip_plot) {
          if (step_counter + 1 <= length(names(pipeline))) {
            next_step <- c(next_step, pupil_steps[step_counter])
          } else {
            next_step <- NULL
          }

          for (block_name in names(file$timeseries)) {
            bn <- get_block_numbers(block_name)
            withr::with_seed(
              rlang::`%||%`(seed, sample.int(.Machine$integer.max, 1)),
              {
                plot(
                  file,
                  steps = step_counter,
                  num_previews = num_previews,
                  seed = seed,
                  preview_duration = preview_duration,
                  preview_window = preview_window,
                  only_linear_trend = only_linear_trend,
                  next_step = next_step,
                  block = bn
                )
              }
            )
          }

          if (step_name == "detrend") {
            # reset linear trend flags
            only_linear_trend <- FALSE
          }
        }
        if (step_name != "zscore") {
          if (!prompt_user()) {
            if (verbose) {
              cli::cli_alert_info(
                paste(
                  "Process cancelled after running the", step_name, "step.",
                  "Adjust your parameters and re-run!\n"
                )
              )
            }

            break
          }
        }
      }
    }

    step_counter <- step_counter + 1
  }

  return(file)
}

prompt_user <- function() {
  resp <- readline(prompt = "Continue? [Yes/No]: ")
  tolower(resp) == "yes" | tolower(resp) == "y"
}