From 335428ce59752675b30e5d75a909923215fe8188 Mon Sep 17 00:00:00 2001
From: davidrsch <daviddrsch@gmail.com>
Date: Tue, 12 Aug 2025 16:56:32 +0200
Subject: [PATCH 1/5] Modularizin x and y processors

---
 NAMESPACE                  |  1 +
 R/generic_functional_fit.R | 41 +++++++++++-----------
 R/generic_sequential_fit.R | 43 ++++++++++-------------
 R/utils.R                  | 71 ++++++++++++++++++++++++++++++++++++++
 4 files changed, 111 insertions(+), 45 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 7d6336f..70cc921 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/R/generic_functional_fit.R b/R/generic_functional_fit.R
index d7d5d4c..bab2f70 100644
--- a/R/generic_functional_fit.R
+++ b/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) ---
diff --git a/R/generic_sequential_fit.R b/R/generic_sequential_fit.R
index 9f97836..6c0009c 100644
--- a/R/generic_sequential_fit.R
+++ b/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 ---
diff --git a/R/utils.R b/R/utils.R
index 6e97028..5cce55c 100644
--- a/R/utils.R
+++ b/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
+  )
+}

From f45d5f374a70ea7db1ace013c4407dcd9efcb508 Mon Sep 17 00:00:00 2001
From: davidrsch <daviddrsch@gmail.com>
Date: Tue, 12 Aug 2025 16:57:44 +0200
Subject: [PATCH 2/5] Adding keras_evaluate function

---
 NAMESPACE             |  1 +
 R/keras_tools.R       | 34 ++++++++++++++++++++++++++++++++++
 man/keras_evaluate.Rd | 25 +++++++++++++++++++++++++
 3 files changed, 60 insertions(+)
 create mode 100644 R/keras_tools.R
 create mode 100644 man/keras_evaluate.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 70cc921..8bb8344 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -5,6 +5,7 @@ export(create_keras_sequential_spec)
 export(generic_functional_fit)
 export(generic_sequential_fit)
 export(inp_spec)
+export(keras_evaluate)
 export(keras_losses)
 export(keras_metrics)
 export(keras_optimizers)
diff --git a/R/keras_tools.R b/R/keras_tools.R
new file mode 100644
index 0000000..83f2a73
--- /dev/null
+++ b/R/keras_tools.R
@@ -0,0 +1,34 @@
+#' Evaluate a Kerasnip Model
+#'
+#' This function provides an `kera_evaluate()` method for `model_fit` objects
+#' created by `kerasnip`. It preprocesses the data into the format expected by
+#' Keras and then calls `keras3::evaluate()` on the underlying model.
+#'
+#' @param object A `model_fit` object produced by a `kerasnip` specification.
+#' @param x A data frame or matrix of predictors.
+#' @param y A vector or data frame of outcomes.
+#' @param ... Additional arguments passed on to `keras3::evaluate()`.
+#'
+#' @return A `list` with evaluation results
+#'
+#' @export
+keras_evaluate <- function(object, x, y = NULL, ...) {
+  # 1. Preprocess predictor data (x)
+  x_processed <- process_x(x)
+  x_proc <- x_processed$x_proc
+
+  # 2. Preprocess outcome data (y)
+  y_proc <- NULL
+  if (!is.null(y)) {
+    y_processed <- process_y(
+      y,
+      is_classification = !is.null(object$fit$lvl),
+      class_levels = object$fit$lvl
+    )
+    y_proc <- y_processed$y_proc
+  }
+
+  # 3. Call the underlying Keras evaluate method
+  keras_model <- object$fit$fit
+  keras3::evaluate(keras_model, x = x_proc, y = y_proc, ...)
+}
diff --git a/man/keras_evaluate.Rd b/man/keras_evaluate.Rd
new file mode 100644
index 0000000..684740a
--- /dev/null
+++ b/man/keras_evaluate.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/keras_tools.R
+\name{keras_evaluate}
+\alias{keras_evaluate}
+\title{Evaluate a Kerasnip Model}
+\usage{
+keras_evaluate(object, x, y = NULL, ...)
+}
+\arguments{
+\item{object}{A \code{model_fit} object produced by a \code{kerasnip} specification.}
+
+\item{x}{A data frame or matrix of predictors.}
+
+\item{y}{A vector or data frame of outcomes.}
+
+\item{...}{Additional arguments passed on to \code{keras3::evaluate()}.}
+}
+\value{
+A \code{list} with evaluation results
+}
+\description{
+This function provides an \code{kera_evaluate()} method for \code{model_fit} objects
+created by \code{kerasnip}. It preprocesses the data into the format expected by
+Keras and then calls \code{keras3::evaluate()} on the underlying model.
+}

From 6e97de5a5cfa3e5fefce9a63adc13ed27177e423 Mon Sep 17 00:00:00 2001
From: davidrsch <daviddrsch@gmail.com>
Date: Tue, 12 Aug 2025 16:58:21 +0200
Subject: [PATCH 3/5] Adding extract tools for summary and history

---
 NAMESPACE                    |  2 ++
 R/keras_tools.R              | 26 ++++++++++++++++++++++++++
 man/extract_keras_history.Rd | 17 +++++++++++++++++
 man/extract_keras_summary.Rd | 19 +++++++++++++++++++
 4 files changed, 64 insertions(+)
 create mode 100644 man/extract_keras_history.Rd
 create mode 100644 man/extract_keras_summary.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 8bb8344..93756b5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -2,6 +2,8 @@
 
 export(create_keras_functional_spec)
 export(create_keras_sequential_spec)
+export(extract_keras_history)
+export(extract_keras_summary)
 export(generic_functional_fit)
 export(generic_sequential_fit)
 export(inp_spec)
diff --git a/R/keras_tools.R b/R/keras_tools.R
index 83f2a73..bda424b 100644
--- a/R/keras_tools.R
+++ b/R/keras_tools.R
@@ -32,3 +32,29 @@ keras_evaluate <- function(object, x, y = NULL, ...) {
   keras_model <- object$fit$fit
   keras3::evaluate(keras_model, x = x_proc, y = y_proc, ...)
 }
+
+#' Extract Keras Model Summary
+#'
+#' @description
+#' Extracts and returns the summary of a Keras model fitted with `kerasnip`.
+#'
+#' @param object A `model_fit` object produced by a `kerasnip` specification.
+#' @param ... Additional arguments passed on to `keras3::summary()`.
+#'
+#' @return A character vector, where each element is a line of the model summary.
+#' @export
+extract_keras_summary <- function(object, ...) {
+  object$fit$fit
+}
+
+#' Extract Keras Training History
+#'
+#' @description
+#' Extracts and returns the training history of a Keras model fitted with `kerasnip`.
+#'
+#' @param object A `model_fit` object produced by a `kerasnip` specification.
+#' @return A `keras_training_history` containing the training history (metrics per epoch).
+#' @export
+extract_keras_history <- function(object) {
+  object$fit$history
+}
diff --git a/man/extract_keras_history.Rd b/man/extract_keras_history.Rd
new file mode 100644
index 0000000..f8b1245
--- /dev/null
+++ b/man/extract_keras_history.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/keras_tools.R
+\name{extract_keras_history}
+\alias{extract_keras_history}
+\title{Extract Keras Training History}
+\usage{
+extract_keras_history(object)
+}
+\arguments{
+\item{object}{A \code{model_fit} object produced by a \code{kerasnip} specification.}
+}
+\value{
+A \code{keras_training_history} containing the training history (metrics per epoch).
+}
+\description{
+Extracts and returns the training history of a Keras model fitted with \code{kerasnip}.
+}
diff --git a/man/extract_keras_summary.Rd b/man/extract_keras_summary.Rd
new file mode 100644
index 0000000..8c161f3
--- /dev/null
+++ b/man/extract_keras_summary.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/keras_tools.R
+\name{extract_keras_summary}
+\alias{extract_keras_summary}
+\title{Extract Keras Model Summary}
+\usage{
+extract_keras_summary(object, ...)
+}
+\arguments{
+\item{object}{A \code{model_fit} object produced by a \code{kerasnip} specification.}
+
+\item{...}{Additional arguments passed on to \code{keras3::summary()}.}
+}
+\value{
+A character vector, where each element is a line of the model summary.
+}
+\description{
+Extracts and returns the summary of a Keras model fitted with \code{kerasnip}.
+}

From 97252372f16357a9af47786830a6618a04b3b5ad Mon Sep 17 00:00:00 2001
From: davidrsch <daviddrsch@gmail.com>
Date: Tue, 12 Aug 2025 16:58:38 +0200
Subject: [PATCH 4/5] Adding tests for new features

---
 tests/testthat/test-e2e-features.R | 118 +++++++++++++++++++++++++++++
 1 file changed, 118 insertions(+)

diff --git a/tests/testthat/test-e2e-features.R b/tests/testthat/test-e2e-features.R
index 6c47e6a..67e776e 100644
--- a/tests/testthat/test-e2e-features.R
+++ b/tests/testthat/test-e2e-features.R
@@ -148,3 +148,121 @@ test_that("E2E: Error handling for reserved names works", {
     regexp = "`compile`, `fit` and `optimizer` are protected names"
   )
 })
+
+test_that("E2E: extract_keras_summary works", {
+  skip_if_no_keras()
+
+  # Reuse model setup from previous tests
+  input_block_feat <- function(model, input_shape) {
+    keras3::keras_model_sequential(input_shape = input_shape)
+  }
+  dense_block_feat <- function(model, units = 16) {
+    model |> keras3::layer_dense(units = units, activation = "relu")
+  }
+  output_block_feat <- function(model) {
+    model |> keras3::layer_dense(units = 1)
+  }
+
+  model_name <- "e2e_mlp_summary_test"
+  on.exit(suppressMessages(remove_keras_spec(model_name)), add = TRUE)
+
+  create_keras_sequential_spec(
+    model_name = model_name,
+    layer_blocks = list(
+      input = input_block_feat,
+      dense = dense_block_feat,
+      output = output_block_feat
+    ),
+    mode = "regression"
+  )
+
+  spec <- e2e_mlp_summary_test(fit_epochs = 1) |>
+    parsnip::set_engine("keras")
+
+  fit_obj <- parsnip::fit(spec, mpg ~ ., data = mtcars)
+
+  summary_output <- extract_keras_summary(fit_obj)
+
+  expect_type(summary_output, "closure")
+  expect_true(any(grepl("Layer ", summary_output)))
+  expect_true(any(grepl("Output Shape", summary_output)))
+  expect_true(any(grepl("Param #", summary_output)))
+})
+
+test_that("E2E: extract_keras_history works", {
+  skip_if_no_keras()
+
+  # Reuse model setup from previous tests
+  input_block_feat <- function(model, input_shape) {
+    keras3::keras_model_sequential(input_shape = input_shape)
+  }
+  dense_block_feat <- function(model, units = 16) {
+    model |> keras3::layer_dense(units = units, activation = "relu")
+  }
+  output_block_feat <- function(model) {
+    model |> keras3::layer_dense(units = 1)
+  }
+
+  model_name <- "e2e_mlp_history_test"
+  on.exit(suppressMessages(remove_keras_spec(model_name)), add = TRUE)
+
+  create_keras_sequential_spec(
+    model_name = model_name,
+    layer_blocks = list(
+      input = input_block_feat,
+      dense = dense_block_feat,
+      output = output_block_feat
+    ),
+    mode = "regression"
+  )
+
+  epochs_to_train <- 2
+  spec <- e2e_mlp_history_test(fit_epochs = epochs_to_train) |>
+    parsnip::set_engine("keras")
+
+  fit_obj <- parsnip::fit(spec, mpg ~ ., data = mtcars)
+
+  history_output <- extract_keras_history(fit_obj)
+
+  expect_s3_class(history_output, "keras_training_history")
+})
+
+test_that("E2E: keras_evaluate works", {
+  skip_if_no_keras()
+
+  # Reuse model setup from previous tests
+  input_block_eval <- function(model, input_shape) {
+    keras3::keras_model_sequential(input_shape = input_shape)
+  }
+  dense_block_eval <- function(model, units = 16) {
+    model |> keras3::layer_dense(units = units, activation = "relu")
+  }
+  output_block_eval <- function(model) {
+    model |> keras3::layer_dense(units = 1)
+  }
+
+  model_name <- "e2e_mlp_evaluate_test"
+  on.exit(suppressMessages(remove_keras_spec(model_name)), add = TRUE)
+
+  create_keras_sequential_spec(
+    model_name = model_name,
+    layer_blocks = list(
+      input = input_block_eval,
+      dense = dense_block_eval,
+      output = output_block_eval
+    ),
+    mode = "regression"
+  )
+
+  spec <- e2e_mlp_evaluate_test(fit_epochs = 1) |>
+    parsnip::set_engine("keras")
+
+  fit_obj <- parsnip::fit(spec, mpg ~ ., data = mtcars)
+
+  # Evaluate the model
+  eval_output <- keras_evaluate(fit_obj, x = mtcars[, -1], y = mtcars$mpg)
+
+  expect_true(class(eval_output) == "list")
+  expect_true("loss" %in% names(eval_output))
+  expect_true("mean_absolute_error" %in% names(eval_output))
+})

From 7878e800412fc8c47f4f6d87e755f085487a8a9f Mon Sep 17 00:00:00 2001
From: davidrsch <daviddrsch@gmail.com>
Date: Tue, 12 Aug 2025 18:05:28 +0200
Subject: [PATCH 5/5] Updating pkdown

---
 _pkgdown.yml | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/_pkgdown.yml b/_pkgdown.yml
index d340cad..ebce87e 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -42,6 +42,15 @@ reference:
       - register_keras_optimizer
       - keras_objects
 
+  - title: "Model Inspection and Evaluation"
+    desc: >
+      Functions for summarizing, evaluating, and extracting information
+      from trained Keras models.
+    contents:
+      - extract_keras_history
+      - extract_keras_summary
+      - keras_evaluate
+
 development:
   mode: auto