Modularizin x and y processors

Author: davidrsch

NAMESPACE

@@ -14,6 +14,7 @@ export(register_keras_loss)
 export(register_keras_metric)
 export(register_keras_optimizer)
 export(remove_keras_spec)
+importFrom(keras3,to_categorical)
 importFrom(parsnip,update_dot_check)
 importFrom(rlang,arg_match)
 importFrom(rlang,dots_list)

R/generic_functional_fit.R

@@ -83,31 +83,32 @@ generic_functional_fit <- function(
   learn_rate <- all_args$learn_rate %||% 0.01
   verbose <- all_args$verbose %||% 0
 
-  if (is.data.frame(x) && ncol(x) == 1 && is.list(x[[1]])) {
-    x_proc <- do.call(abind::abind, c(x[[1]], list(along = 0)))
-  } else {
-    x_proc <- as.matrix(x)
-  }
-  input_shape <- if (length(dim(x_proc)) > 2) dim(x_proc)[-1] else ncol(x_proc)
-  is_classification <- is.factor(y)
-  if (is_classification) {
-    class_levels <- levels(y)
-    num_classes <- length(class_levels)
-    y_mat <- keras3::to_categorical(
-      as.numeric(y) - 1,
-      num_classes = num_classes
-    )
-    default_loss <- if (num_classes > 2) {
+  # Process x input
+  x_processed <- process_x(x)
+  x_proc <- x_processed$x_proc
+  input_shape <- x_processed$input_shape
+
+  # Process y input
+  y_processed <- process_y(y)
+  y_mat <- y_processed$y_proc
+  is_classification <- y_processed$is_classification
+  class_levels <- y_processed$class_levels
+  num_classes <- y_processed$num_classes
+
+  # Determine default compile arguments based on mode
+  default_loss <- if (is_classification) {
+    if (num_classes > 2) {
       "categorical_crossentropy"
     } else {
       "binary_crossentropy"
     }
-    default_metrics <- "accuracy"
   } else {
-    class_levels <- NULL
-    y_mat <- as.matrix(y)
-    default_loss <- "mean_squared_error"
-    default_metrics <- "mean_absolute_error"
+    "mean_squared_error"
+  }
+  default_metrics <- if (is_classification) {
+    "accuracy"
+  } else {
+    "mean_absolute_error"
   }
 
   # --- 2. Dynamic Model Architecture Construction (DIFFERENT from sequential) ---

R/generic_sequential_fit.R

@@ -78,39 +78,32 @@ generic_sequential_fit <- function(
   learn_rate <- all_args$learn_rate %||% 0.01
   verbose <- all_args$verbose %||% 0
 
-  # Handle both standard tabular data (matrix) and list-columns of arrays
-  # (for images/sequences) that come from recipes.
-  if (is.data.frame(x) && ncol(x) == 1 && is.list(x[[1]])) {
-    # Assumes a single predictor column containing a list of arrays.
-    # We stack them into a single higher-dimensional array.
-    x_proc <- do.call(abind::abind, c(x[[1]], list(along = 0)))
-  } else {
-    x_proc <- as.matrix(x)
-  }
+  # Process x input
+  x_processed <- process_x(x)
+  x_proc <- x_processed$x_proc
+  input_shape <- x_processed$input_shape
 
-  # Determine the correct input shape for the Keras model.
-  input_shape <- if (length(dim(x_proc)) > 2) dim(x_proc)[-1] else ncol(x_proc)
+  # Process y input
+  y_processed <- process_y(y)
+  y_mat <- y_processed$y_proc
+  is_classification <- y_processed$is_classification
+  class_levels <- y_processed$class_levels
+  num_classes <- y_processed$num_classes
 
   # Determine default compile arguments based on mode
-  is_classification <- is.factor(y)
-  if (is_classification) {
-    class_levels <- levels(y)
-    num_classes <- length(class_levels)
-    y_mat <- keras3::to_categorical(
-      as.numeric(y) - 1,
-      num_classes = num_classes
-    )
-    default_loss <- if (num_classes > 2) {
+  default_loss <- if (is_classification) {
+    if (num_classes > 2) {
       "categorical_crossentropy"
     } else {
       "binary_crossentropy"
     }
-    default_metrics <- "accuracy"
   } else {
-    class_levels <- NULL
-    y_mat <- as.matrix(y)
-    default_loss <- "mean_squared_error"
-    default_metrics <- "mean_absolute_error"
+    "mean_squared_error"
+  }
+  default_metrics <- if (is_classification) {
+    "accuracy"
+  } else {
+    "mean_absolute_error"
   }
 
   # --- 2. Dynamic Model Architecture Construction ---

R/utils.R

@@ -175,3 +175,74 @@ loss_function_keras <- function(values = NULL) {
     finalize = NULL
   )
 }
+
+#' Process Predictor Input for Keras
+#'
+#' @description
+#' Preprocesses predictor data (`x`) into a format suitable for Keras models.
+#' Handles both tabular data and list-columns of arrays (e.g., for images).
+#'
+#' @param x A data frame or matrix of predictors.
+#' @return A list containing:
+#'   - `x_proc`: The processed predictor data (matrix or array).
+#'   - `input_shape`: The determined input shape for the Keras model.
+#' @noRd
+process_x <- function(x) {
+  if (is.data.frame(x) && ncol(x) == 1 && is.list(x[[1]])) {
+    # Assumes a single predictor column containing a list of arrays.
+    # We stack them into a single higher-dimensional array.
+    x_proc <- do.call(abind::abind, c(x[[1]], list(along = 0)))
+  } else {
+    x_proc <- as.matrix(x)
+  }
+  input_shape <- if (length(dim(x_proc)) > 2) dim(x_proc)[-1] else ncol(x_proc)
+  list(x_proc = x_proc, input_shape = input_shape)
+}
+
+#' Process Outcome Input for Keras
+#'
+#' @description
+#' Preprocesses outcome data (`y`) into a format suitable for Keras models.
+#' Handles both regression (numeric) and classification (factor) outcomes,
+#' including one-hot encoding for classification.
+#'
+#' @param y A vector of outcomes.
+#' @param is_classification Logical, optional. If `TRUE`, treats `y` as
+#'   classification. If `FALSE`, treats as regression. If `NULL` (default),
+#'   it's determined from `is.factor(y)`.
+#' @param class_levels Character vector, optional. The factor levels for
+#'   classification outcomes. If `NULL` (default), determined from `levels(y)`.
+#' @return A list containing:
+#'   - `y_proc`: The processed outcome data (matrix or one-hot encoded array).
+#'   - `is_classification`: Logical, indicating if `y` was treated as classification.
+#'   - `num_classes`: Integer, the number of classes for classification, or `NULL`.
+#'   - `class_levels`: Character vector, the factor levels for classification, or `NULL`.
+#' @importFrom keras3 to_categorical
+#' @noRd
+process_y <- function(y, is_classification = NULL, class_levels = NULL) {
+  if (is.null(is_classification)) {
+    is_classification <- is.factor(y)
+  }
+
+  y_proc <- NULL
+  num_classes <- NULL
+  if (is_classification) {
+    if (is.null(class_levels)) {
+      class_levels <- levels(y)
+    }
+    num_classes <- length(class_levels)
+    y_factored <- factor(y, levels = class_levels)
+    y_proc <- keras3::to_categorical(
+      as.numeric(y_factored) - 1,
+      num_classes = num_classes
+    )
+  } else {
+    y_proc <- as.matrix(y)
+  }
+  list(
+    y_proc = y_proc,
+    is_classification = is_classification,
+    num_classes = num_classes,
+    class_levels = class_levels
+  )
+}