Merge pull request #76 from JamesHWade/feat/baseline-algorithms

feat: Add advanced baseline correction algorithms

Author: JamesHWade

.beads/.sync.lock

@@ -30,11 +30,15 @@ S3method(bake,step_measure_augment_shift)
 S3method(bake,step_measure_baseline_airpls)
 S3method(bake,step_measure_baseline_als)
 S3method(bake,step_measure_baseline_arpls)
+S3method(bake,step_measure_baseline_aspls)
 S3method(bake,step_measure_baseline_auto)
 S3method(bake,step_measure_baseline_custom)
+S3method(bake,step_measure_baseline_fastchrom)
 S3method(bake,step_measure_baseline_gpc)
+S3method(bake,step_measure_baseline_iarpls)
 S3method(bake,step_measure_baseline_minima)
 S3method(bake,step_measure_baseline_morph)
+S3method(bake,step_measure_baseline_morphological)
 S3method(bake,step_measure_baseline_poly)
 S3method(bake,step_measure_baseline_py)
 S3method(bake,step_measure_baseline_rf)
@@ -192,11 +196,15 @@ S3method(prep,step_measure_augment_shift)
 S3method(prep,step_measure_baseline_airpls)
 S3method(prep,step_measure_baseline_als)
 S3method(prep,step_measure_baseline_arpls)
+S3method(prep,step_measure_baseline_aspls)
 S3method(prep,step_measure_baseline_auto)
 S3method(prep,step_measure_baseline_custom)
+S3method(prep,step_measure_baseline_fastchrom)
 S3method(prep,step_measure_baseline_gpc)
+S3method(prep,step_measure_baseline_iarpls)
 S3method(prep,step_measure_baseline_minima)
 S3method(prep,step_measure_baseline_morph)
+S3method(prep,step_measure_baseline_morphological)
 S3method(prep,step_measure_baseline_poly)
 S3method(prep,step_measure_baseline_py)
 S3method(prep,step_measure_baseline_rf)
@@ -316,11 +324,15 @@ S3method(print,step_measure_augment_shift)
 S3method(print,step_measure_baseline_airpls)
 S3method(print,step_measure_baseline_als)
 S3method(print,step_measure_baseline_arpls)
+S3method(print,step_measure_baseline_aspls)
 S3method(print,step_measure_baseline_auto)
 S3method(print,step_measure_baseline_custom)
+S3method(print,step_measure_baseline_fastchrom)
 S3method(print,step_measure_baseline_gpc)
+S3method(print,step_measure_baseline_iarpls)
 S3method(print,step_measure_baseline_minima)
 S3method(print,step_measure_baseline_morph)
+S3method(print,step_measure_baseline_morphological)
 S3method(print,step_measure_baseline_poly)
 S3method(print,step_measure_baseline_py)
 S3method(print,step_measure_baseline_rf)
@@ -480,11 +492,15 @@ S3method(tidy,step_measure_augment_shift)
 S3method(tidy,step_measure_baseline_airpls)
 S3method(tidy,step_measure_baseline_als)
 S3method(tidy,step_measure_baseline_arpls)
+S3method(tidy,step_measure_baseline_aspls)
 S3method(tidy,step_measure_baseline_auto)
 S3method(tidy,step_measure_baseline_custom)
+S3method(tidy,step_measure_baseline_fastchrom)
 S3method(tidy,step_measure_baseline_gpc)
+S3method(tidy,step_measure_baseline_iarpls)
 S3method(tidy,step_measure_baseline_minima)
 S3method(tidy,step_measure_baseline_morph)
+S3method(tidy,step_measure_baseline_morphological)
 S3method(tidy,step_measure_baseline_poly)
 S3method(tidy,step_measure_baseline_py)
 S3method(tidy,step_measure_baseline_rf)
@@ -568,7 +584,10 @@ S3method(tunable,step_measure_align_shift)
 S3method(tunable,step_measure_baseline_airpls)
 S3method(tunable,step_measure_baseline_als)
 S3method(tunable,step_measure_baseline_arpls)
+S3method(tunable,step_measure_baseline_aspls)
 S3method(tunable,step_measure_baseline_custom)
+S3method(tunable,step_measure_baseline_fastchrom)
+S3method(tunable,step_measure_baseline_iarpls)
 S3method(tunable,step_measure_baseline_poly)
 S3method(tunable,step_measure_baseline_py)
 S3method(tunable,step_measure_baseline_rf)
@@ -599,11 +618,13 @@ export(align_segment_length)
 export(all_pass)
 export(assess_deconv_quality)
 export(augment)
+export(baseline_alpha)
 export(baseline_asymmetry)
 export(baseline_degree)
 export(baseline_half_window)
 export(baseline_lambda)
 export(baseline_span)
+export(baseline_window)
 export(bigaussian_peak_model)
 export(bin_width)
 export(check_axis_consistency)
@@ -741,11 +762,15 @@ export(step_measure_augment_shift)
 export(step_measure_baseline_airpls)
 export(step_measure_baseline_als)
 export(step_measure_baseline_arpls)
+export(step_measure_baseline_aspls)
 export(step_measure_baseline_auto)
 export(step_measure_baseline_custom)
+export(step_measure_baseline_fastchrom)
 export(step_measure_baseline_gpc)
+export(step_measure_baseline_iarpls)
 export(step_measure_baseline_minima)
 export(step_measure_baseline_morph)
+export(step_measure_baseline_morphological)
 export(step_measure_baseline_poly)
 export(step_measure_baseline_py)
 export(step_measure_baseline_rf)

NAMESPACE

@@ -0,0 +1,239 @@
+# ==============================================================================
+# Morphological Baseline Correction Methods
+#
+# This file contains the morphological baseline correction algorithm:
+# - step_measure_baseline_morphological: Erosion/dilation
+#
+# Note: step_measure_baseline_tophat and step_measure_baseline_minima
+# are defined in baseline-extended.R
+# ==============================================================================
+
+# ==============================================================================
+# step_measure_baseline_morphological
+# ==============================================================================
+
+#' Morphological Baseline Correction (Erosion/Dilation)
+#'
+#' `step_measure_baseline_morphological()` creates a *specification* of a recipe
+#' step that applies morphological erosion followed by dilation for baseline
+#' estimation.
+#'
+#' @param recipe A recipe object.
+#' @param measures An optional character vector of measure column names.
+#' @param window_size Size of the structuring element. Default is 50.
+#' @param iterations Number of erosion iterations. Default is 1.
+#' @param role Not used.
+#' @param trained Logical indicating if the step has been trained.
+#' @param skip Logical. Should the step be skipped when baking?
+#' @param id Unique step identifier.
+#'
+#' @return An updated recipe with the new step added.
+#'
+#' @details
+#' This morphological approach uses erosion (local minimum) to push the
+#' baseline down below peaks, followed by dilation (local maximum) to
+#' smooth the result.
+#'
+#' Multiple erosion iterations can be used for signals with tall peaks
+#' that require more aggressive baseline estimation.
+#'
+#' @family measure-baseline
+#' @export
+#'
+#' @examples
+#' library(recipes)
+#'
+#' \donttest{
+#' rec <- recipe(water + fat + protein ~ ., data = meats_long) |>
+#'   update_role(id, new_role = "id") |>
+#'   step_measure_input_long(transmittance, location = vars(channel)) |>
+#'   step_measure_baseline_morphological(window_size = 50) |>
+#'   prep()
+#'
+#' bake(rec, new_data = NULL)
+#' }
+step_measure_baseline_morphological <- function(
+  recipe,
+  measures = NULL,
+  window_size = 50L,
+  iterations = 1L,
+  role = NA,
+  trained = FALSE,
+  skip = FALSE,
+  id = recipes::rand_id("measure_baseline_morphological")
+) {
+  recipes::add_step(
+    recipe,
+    step_measure_baseline_morphological_new(
+      measures = measures,
+      window_size = as.integer(window_size),
+      iterations = as.integer(iterations),
+      role = role,
+      trained = trained,
+      skip = skip,
+      id = id
+    )
+  )
+}
+
+step_measure_baseline_morphological_new <- function(
+  measures,
+  window_size,
+  iterations,
+  role,
+  trained,
+  skip,
+  id
+) {
+  recipes::step(
+    subclass = "measure_baseline_morphological",
+    measures = measures,
+    window_size = window_size,
+    iterations = iterations,
+    role = role,
+    trained = trained,
+    skip = skip,
+    id = id
+  )
+}
+
+#' @export
+prep.step_measure_baseline_morphological <- function(
+  x,
+  training,
+  info = NULL,
+  ...
+) {
+  check_for_measure(training)
+
+  # Validate parameters
+  if (
+    !is.numeric(x$window_size) ||
+      length(x$window_size) != 1 ||
+      x$window_size < 3
+  ) {
+    cli::cli_abort(
+      "{.arg window_size} must be a single integer >= 3, not {.val {x$window_size}}."
+    )
+  }
+  if (
+    !is.numeric(x$iterations) || length(x$iterations) != 1 || x$iterations < 1
+  ) {
+    cli::cli_abort(
+      "{.arg iterations} must be a positive integer, not {.val {x$iterations}}."
+    )
+  }
+
+  if (is.null(x$measures)) {
+    measure_cols <- find_measure_cols(training)
+  } else {
+    measure_cols <- x$measures
+  }
+
+  step_measure_baseline_morphological_new(
+    measures = measure_cols,
+    window_size = as.integer(x$window_size),
+    iterations = as.integer(x$iterations),
+    role = x$role,
+    trained = TRUE,
+    skip = x$skip,
+    id = x$id
+  )
+}
+
+#' Morphological baseline algorithm
+#' @noRd
+.morphological_baseline <- function(y, window_size, iterations) {
+  n <- length(y)
+
+  # Validate input
+  if (n < 3) {
+    cli::cli_warn("Input vector has fewer than 3 points, returning original.")
+    return(y)
+  }
+  if (anyNA(y)) {
+    cli::cli_warn(
+      "Input contains {sum(is.na(y))} NA value{?s}. NA values will propagate."
+    )
+  }
+  if (any(!is.finite(y) & !is.na(y))) {
+    cli::cli_abort("Input contains Inf/-Inf values. Cannot compute baseline.")
+  }
+
+  baseline <- y
+  half_window <- window_size %/% 2
+
+  # Multiple erosion iterations (local minimum)
+  for (iter in seq_len(iterations)) {
+    eroded <- numeric(n)
+    for (i in seq_len(n)) {
+      start <- max(1, i - half_window)
+      end <- min(n, i + half_window)
+      eroded[i] <- min(baseline[start:end])
+    }
+    baseline <- eroded
+  }
+
+  # Dilation (local maximum) to recover baseline level after erosion
+  dilated <- numeric(n)
+  for (i in seq_len(n)) {
+    start <- max(1, i - half_window)
+    end <- min(n, i + half_window)
+    dilated[i] <- max(baseline[start:end])
+  }
+
+  dilated
+}
+
+#' @export
+bake.step_measure_baseline_morphological <- function(object, new_data, ...) {
+  window_size <- object$window_size
+  iterations <- object$iterations
+
+  for (col in object$measures) {
+    result <- purrr::map(new_data[[col]], function(m) {
+      baseline <- .morphological_baseline(m$value, window_size, iterations)
+      new_measure_tbl(
+        location = m$location,
+        value = m$value - baseline
+      )
+    })
+    new_data[[col]] <- new_measure_list(result)
+  }
+
+  tibble::as_tibble(new_data)
+}
+
+#' @export
+print.step_measure_baseline_morphological <- function(
+  x,
+  width = max(20, options()$width - 30),
+  ...
+) {
+  title <- paste0(
+    "Morphological baseline (window=",
+    x$window_size,
+    ", iter=",
+    x$iterations,
+    ")"
+  )
+  if (x$trained) {
+    cat(title, " on <internal measurements>", sep = "")
+  } else {
+    cat(title)
+  }
+  cat("\n")
+  invisible(x)
+}
+
+#' @rdname tidy.recipe
+#' @export
+#' @keywords internal
+tidy.step_measure_baseline_morphological <- function(x, ...) {
+  tibble::tibble(
+    terms = if (recipes::is_trained(x)) x$measures else "<all measure columns>",
+    window_size = x$window_size,
+    iterations = x$iterations,
+    id = x$id
+  )
+}