Merge pull request #1526 from seb09/error-step-isomap-neighbor

Author: EmilHvitfeldt

R/isomap.R

@@ -10,8 +10,8 @@
 #'   If `num_terms` is greater than the number of columns or the number of
 #'   possible dimensions, a smaller value will be used.
 #' @param neighbors The number of neighbors.
-#' @param options A list of options to `dimRed::Isomap()``.
-#' @param res The `dimRed::Isomap()`` object is stored here once this
+#' @param options A list of options to `dimRed::embed()``.
+#' @param res The `dimRed::embed()`` object is stored here once this
 #'   preprocessing step has be trained by [prep()].
 #' @template step-return
 #' @family multivariate transformation steps
@@ -161,6 +161,14 @@ step_isomap_new <-
     )
   }
 
+embed_mod <- function(..., msg = FALSE) {
+  if (msg) {
+    utils::getFromNamespace("embed", ns = "dimRed")(...)
+  } else {
+    suppressMessages(utils::getFromNamespace("embed", ns = "dimRed")(...))
+  }
+}
+
 #' @export
 prep.step_isomap <- function(x, training, info = NULL, ...) {
   col_names <- recipes_eval_select(x$terms, training, info)
@@ -175,23 +183,15 @@ prep.step_isomap <- function(x, training, info = NULL, ...) {
 
     iso_map <- try_fetch_eval_tidy(
       eval_dimred_call(
-        "embed",
+        "embed_mod",
         .data = dimred_data(training[, col_names, drop = FALSE]),
         .method = "Isomap",
         knn = x$neighbors,
         ndim = x$num_terms,
-        .mute = x$options$.mute
+        .mute = setdiff(x$options$.mute, "message"),
+        msg = !"message" %in% x$options$.mute
       )
     )
-
-    if (inherits(iso_map, "try-error")) {
-      cli::cli_abort(
-        c(
-          x = "Failed with error:",
-          i = as.character(iso_map)
-        )
-      )
-    }
   } else {
     iso_map <- NULL
   }

R/misc.R

@@ -828,7 +828,12 @@ changelog <- function(show, before, after, x) {
 # ------------------------------------------------------------------------------
 
 eval_dimred_call <- function(fn, ...) {
-  cl <- rlang::call2(fn, .ns = "dimRed", ...)
+  .ns <- if (exists(fn, where = asNamespace("dimRed"), inherits = FALSE)) {
+    "dimRed"
+  } else {
+    NULL
+  }
+  cl <- rlang::call2(fn, .ns = .ns, ...)
   rlang::eval_tidy(cl)
 }
 

man/step_isomap.Rd

@@ -23,19 +23,49 @@
       Sepal.Width, deg_free = 1, degree = 1), Sepal.Length, deg_free = 1, degree = 1),
       Species, threshold = 1e-09), all_numeric_predictors(), num_terms = 1,
       neighbors = 1))
-    Message
     Condition
       Error in `step_isomap()`:
       Caused by error in `prep()`:
       ! Failed to compute:
       Caused by error:
       ! TridiagEigen: eigen decomposition failed
 
+# ISOmap suppresses only messages, not errors
+
+    Code
+      prep(step_isomap(recipe(mpg ~ ., data = mtcars), all_numeric_predictors(),
+      neighbors = 31, options = list(.mute = character(0))))
+    Message
+      
+      -- Recipe ----------------------------------------------------------------------
+      
+      -- Inputs 
+      Number of variables by role
+      outcome:    1
+      predictor: 10
+      
+      -- Training information 
+      Training data contained 32 data points and no incomplete rows.
+      
+      -- Operations 
+      * Isomap approximation with: cyl, disp, hp, drat, wt, qsec, ... | Trained
+
+---
+
+    Code
+      prep(step_isomap(recipe(mpg ~ ., data = mtcars), all_numeric_predictors(),
+      neighbors = 32, options = list(.mute = c("message"))))
+    Condition
+      Error in `step_isomap()`:
+      Caused by error in `prep()`:
+      ! Failed to compute:
+      Caused by error in `RANN::nn2()`:
+      ! Cannot find more nearest neighbours than there are points
+
 # check_name() is used
 
     Code
       prep(rec, training = dat)
-    Message
     Condition
       Error in `step_isomap()`:
       Caused by error in `bake()`:
@@ -98,7 +128,6 @@
 
     Code
       rec <- prep(rec)
-    Message
     Condition
       Warning:
       `keep_original_cols` was added to `step_isomap()` after this recipe was created.

tests/testthat/_snaps/isomap.md

@@ -116,6 +116,48 @@ test_that("ISOmap fails gracefully", {
   )
 })
 
+test_that("ISOmap suppresses only messages, not errors", {
+  skip_if_not_installed("RSpectra")
+  skip_if_not_installed("igraph")
+  skip_if_not_installed("RANN")
+  skip_if_not_installed("dimRed")
+  skip_if(getRversion() <= "3.4.4")
+
+  expect_snapshot(
+    transform = scrub_timestamp,
+    recipe(mpg ~ ., data = mtcars) |>
+      step_isomap(
+        all_numeric_predictors(),
+        neighbors = 31,
+        options = list(.mute = character(0))
+      ) |>
+      prep()
+  )
+
+  expect_no_message(
+    recipe(mpg ~ ., data = mtcars) |>
+      step_isomap(
+        all_numeric_predictors(),
+        neighbors = 31,
+        options = list(.mute = c("message"))
+      ) |>
+      prep()
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    transform = scrub_timestamp,
+    recipe(mpg ~ ., data = mtcars) |>
+      step_isomap(
+        all_numeric_predictors(),
+        # number of neighbors has to be < nrow
+        neighbors = 32,
+        options = list(.mute = c("message"))
+      ) |>
+      prep()
+  )
+})
+
 test_that("check_name() is used", {
   skip_on_cran()
   skip_if_not_installed("RSpectra")