Merge pull request #13 from davidrsch/getting-starte-updt

Getting started update

Author: davidrsch

.github/workflows/R-CMD-check.yaml

@@ -62,7 +62,11 @@ jobs:
         if: runner.os == 'Linux'
         run: |
           sudo apt-get update
-          sudo apt-get install -y qpdf ghostscript
+          sudo apt-get install -y qpdf ghostscript graphviz
+        if: runner.os == 'macOS'
+        run: brew install graphviz
+        if: runner.os == 'Windows'
+        run: choco install graphviz -y
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:

.gitignore

@@ -7,3 +7,4 @@ docs
 .httr-oauth
 .DS_Store
 .quarto
+vignettes/*_cache

R/generic_functional_fit.R

@@ -128,7 +128,15 @@ generic_functional_fit <- function(
 
     # --- Get Repetition Count ---
     num_repeats_arg <- paste0("num_", block_name)
-    num_repeats <- all_args[[num_repeats_arg]] %||% 1
+    num_repeats_val <- all_args[[num_repeats_arg]]
+
+    # If num_repeats_val is NULL or zapped, default to 1.
+    # Otherwise, use the value provided by the user.
+    if (is.null(num_repeats_val) || inherits(num_repeats_val, "rlang_zap")) {
+      num_repeats <- 1
+    } else {
+      num_repeats <- as.integer(num_repeats_val)
+    }
 
     # --- Get Hyperparameters for this block ---
     # Hyperparameters are formals that are NOT other block names (graph connections)

R/generic_sequential_fit.R

@@ -118,7 +118,14 @@ generic_sequential_fit <- function(
 
     num_repeats_arg <- paste0("num_", block_name)
     num_repeats_val <- all_args[[num_repeats_arg]]
-    num_repeats <- num_repeats_val %||% 1
+
+    # If num_repeats_val is NULL or zapped, default to 1.
+    # Otherwise, use the value provided by the user.
+    if (is.null(num_repeats_val) || inherits(num_repeats_val, "rlang_zap")) {
+      num_repeats <- 1
+    } else {
+      num_repeats <- as.integer(num_repeats_val)
+    }
 
     # Get the arguments for this specific block from `...`
     block_arg_names <- names(block_fmls)[-1] # Exclude 'model'

R/register_fit_predict.R

@@ -57,7 +57,7 @@ register_fit_predict <- function(model_name, mode, layer_blocks, functional) {
         func = c(fun = "predict"),
         args = list(
           object = rlang::expr(object$fit$fit),
-          x = rlang::expr(as.matrix(new_data))
+          x = rlang::expr(process_x(new_data)$x_proc)
         )
       )
     )
@@ -74,7 +74,7 @@ register_fit_predict <- function(model_name, mode, layer_blocks, functional) {
         func = c(fun = "predict"),
         args = list(
           object = rlang::expr(object$fit$fit),
-          x = rlang::expr(as.matrix(new_data))
+          x = rlang::expr(process_x(new_data)$x_proc)
         )
       )
     )
@@ -89,7 +89,7 @@ register_fit_predict <- function(model_name, mode, layer_blocks, functional) {
         func = c(fun = "predict"),
         args = list(
           object = rlang::expr(object$fit$fit),
-          x = rlang::expr(as.matrix(new_data))
+          x = rlang::expr(process_x(new_data)$x_proc)
         )
       )
     )

R/utils.R

@@ -220,6 +220,11 @@ process_x <- function(x) {
 #' @importFrom keras3 to_categorical
 #' @noRd
 process_y <- function(y, is_classification = NULL, class_levels = NULL) {
+  # If y is a data frame/tibble, extract the first column
+  if (is.data.frame(y)) {
+    y <- y[[1]]
+  }
+
   if (is.null(is_classification)) {
     is_classification <- is.factor(y)
   }

_pkgdown.yml

@@ -17,8 +17,8 @@ guides:
   - title: "Getting Started"
     navbar: ~
     contents:
-      - getting-started
-      - functional-api
+      - getting_started
+      - functional_api
 
 # examples:
 
@@ -63,7 +63,7 @@ navbar:
   components:
     intro:
       text: "Getting started"
-      href: guides/getting-started.html
+      href: guides/getting_started.html
     github:
       icon: fa-github
       href: https://github.com/davidrsch/kerasnip

tests/testthat/helper-keras.R renamed to tests/testthat/helper_keras.R

@@ -6,6 +6,7 @@ library(modeldata)
 library(rsample)
 library(dials)
 library(tune)
+library(purrr)
 
 skip_if_no_keras <- function() {
   testthat::skip_if_not_installed("keras3")

tests/testthat/test-e2e-classification.R renamed to tests/testthat/test_e2e_classification.R

@@ -102,14 +102,19 @@ test_that("E2E: Customizing fit arguments works", {
   expect_lt(length(fit_obj$fit$history$metrics$loss), 5)
 })
 
-test_that("E2E: Setting num_blocks = 0 works", {
+test_that("E2E: Setting num_blocks = 0 works for sequential models", {
   skip_if_no_keras()
 
   input_block_zero <- function(model, input_shape) {
     keras3::keras_model_sequential(input_shape = input_shape)
   }
   dense_block_zero <- function(model, units = 16) {
-    model |> keras3::layer_dense(units = units, activation = "relu")
+    model |>
+      keras3::layer_dense(
+        units = units,
+        activation = "relu",
+        name = "i_should_not_exist"
+      )
   }
   output_block_zero <- function(model) {
     model |> keras3::layer_dense(units = 1)
@@ -128,10 +133,18 @@ test_that("E2E: Setting num_blocks = 0 works", {
     mode = "regression"
   )
 
-  spec <- e2e_mlp_zero(num_dense = 0, fit_epochs = 2) |>
+  spec <- e2e_mlp_zero(num_dense = 0, fit_epochs = 1) |>
     parsnip::set_engine("keras")
-  # This should fit a model with only an input and output layer
-  expect_no_error(parsnip::fit(spec, mpg ~ ., data = mtcars))
+
+  fit_obj <- parsnip::fit(spec, mpg ~ ., data = mtcars)
+
+  # Check that the dense layer is NOT in the model
+  keras_model <- fit_obj |> extract_keras_summary()
+  expect_equal(length(keras_model$layers), 1) # Output layers only
+
+  # Check layer names explicitly
+  layer_names <- sapply(keras_model$layers, function(l) l$name)
+  expect_false("i_should_not_exist" %in% layer_names)
 })
 
 test_that("E2E: Error handling for reserved names works", {