improve prompting about missing implementations

NAMESPACE

@@ -246,6 +246,7 @@ export(predict_time)
 export(predict_time.model_fit)
 export(prepare_data)
 export(print_model_spec)
+export(prompt_missing_implementation)
 export(proportional_hazards)
 export(rand_forest)
 export(repair_call)
@@ -271,6 +272,8 @@ export(show_call)
 export(show_engines)
 export(show_fit)
 export(show_model_info)
+export(spec_is_loaded)
+export(spec_is_possible)
 export(stan_conf_int)
 export(surv_reg)
 export(survival_reg)

R/aaa_models.R

@@ -37,6 +37,15 @@ pred_types <-
 
 # ------------------------------------------------------------------------------
 
+read_model_info_table <- function() {
+  model_info_table <-
+    utils::read.delim(system.file("models.tsv", package = "parsnip"))
+
+  model_info_table
+}
+
+# ------------------------------------------------------------------------------
+
 #' Working with the parsnip model environment
 #'
 #' These functions read and write to the environment where the package stores
@@ -220,7 +229,14 @@ check_spec_mode_engine_val <- function(cls, eng, mode) {
 
   # Cases where the model definition is in parsnip but all of the engines
   # are contained in a different package
-  if (nrow(model_info) == 0) {
+  model_info_parsnip_only <-
+    dplyr::inner_join(
+      read_model_info_table() %>% dplyr::filter(is.na(pkg)) %>% dplyr::select(-pkg),
+      model_info %>% dplyr::mutate(model = cls),
+      by = c("model", "engine", "mode")
+    )
+
+  if (nrow(model_info_parsnip_only) == 0) {
     check_mode_with_no_engine(cls, mode)
     return(invisible(NULL))
   }

R/arguments.R

@@ -71,9 +71,10 @@ set_args.model_spec <- function(object, ...) {
     args = object$args,
     eng_args = object$eng_args,
     mode = object$mode,
+    user_specified_mode = object$user_specified_mode,
     method = NULL,
     engine = object$engine,
-    check_missing_spec = FALSE
+    user_specified_engine = object$user_specified_engine
   )
 }
 
@@ -97,8 +98,18 @@ set_mode.model_spec <- function(object, mode) {
     spec_modes <- rlang::env_get(get_model_env(), paste0(cls, "_modes"))
     stop_incompatible_mode(spec_modes, cls = cls)
   }
-  check_spec_mode_engine_val(cls, object$engine, mode)
+
+  # determine if the model specification could feasibly match any entry
+  # in the union of the parsnip model environment and model_info_table.
+  # if not, trigger an error based on the (possibly inferred) model spec slots.
+  if (!spec_is_possible(cls,
+                        object$engine, object$user_specified_engine,
+                        mode, user_specified_mode = TRUE)) {
+    check_spec_mode_engine_val(cls, object$engine, mode)
+  }
+
   object$mode <- mode
+  object$user_specified_mode <- TRUE
   object
 }
 

R/bag_mars.R

@@ -37,8 +37,10 @@ bag_mars <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/bag_tree.R

@@ -41,8 +41,10 @@ bag_tree <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/bart.R

@@ -85,8 +85,10 @@ bart <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/boost_tree.R

@@ -74,9 +74,11 @@ boost_tree <-
       "boost_tree",
       args,
       eng_args = NULL,
-      mode,
+      mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/c5_rules.R

@@ -58,8 +58,10 @@ C5_rules <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/cubist_rules.R

@@ -84,8 +84,10 @@ cubist_rules <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/decision_tree.R

@@ -46,8 +46,10 @@ decision_tree <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/discrim_flexible.R

@@ -40,8 +40,10 @@ discrim_flexible <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/discrim_linear.R

@@ -42,8 +42,10 @@ discrim_linear <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/discrim_quad.R

@@ -36,8 +36,10 @@ discrim_quad <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/discrim_regularized.R

@@ -57,8 +57,10 @@ discrim_regularized <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/engines.R

@@ -116,7 +116,15 @@ set_engine.model_spec <- function(object, engine, ...) {
     stop_missing_engine(mod_type)
   }
   object$engine <- engine
-  check_spec_mode_engine_val(mod_type, object$engine, object$mode)
+
+  # determine if the model specification could feasibly match any entry
+  # in the union of the parsnip model environment and model_info_table.
+  # if not, trigger an error based on the (possibly inferred) model spec slots.
+  if (!spec_is_possible(mod_type,
+                        object$engine, user_specified_engine = TRUE,
+                        object$mode, object$user_specified_mode)) {
+    check_spec_mode_engine_val(mod_type, object$engine, object$mode)
+  }
 
   if (object$engine == "liquidSVM") {
     lifecycle::deprecate_soft(
@@ -130,9 +138,10 @@ set_engine.model_spec <- function(object, engine, ...) {
     args = object$args,
     eng_args = enquos(...),
     mode = object$mode,
+    user_specified_mode = object$user_specified_mode,
     method = NULL,
     engine = object$engine,
-    check_missing_spec = FALSE
+    user_specified_engine = TRUE
   )
 }
 

R/fit.R

@@ -120,12 +120,14 @@ fit.model_spec <-
     dots <- quos(...)
 
     if (length(possible_engines(object)) == 0) {
-      rlang::abort(
-        glue::glue(
-          "No engines were loaded for `{class(object)[1]}`.",
-          " Please load a parsnip extension package that provides one.",
-          " See https://www.tidymodels.org/find/parsnip/ "
-        )
+      prompt_missing_implementation(
+        cls = class(object)[1],
+        engine = object$engine,
+        user_specified_engine = object$user_specified_engine,
+        mode = object$mode,
+        user_specified_mode = object$user_specified_mode,
+        prompt = cli::cli_abort,
+        call = call2("fit")
       )
     }
     if (is.null(object$engine)) {

R/gen_additive_mod.R

@@ -43,9 +43,11 @@ gen_additive_mod <- function(mode = "unknown",
     "gen_additive_mod",
     args     = args,
     eng_args = NULL,
-    mode     = mode,
-    method   = NULL,
-    engine   = engine
+    mode = mode,
+    user_specified_mode = !missing(mode),
+    method = NULL,
+    engine = engine,
+    user_specified_engine = !missing(engine)
   )
 
 }

R/linear_reg.R

@@ -53,8 +53,10 @@ linear_reg <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/logistic_reg.R

@@ -60,8 +60,10 @@ logistic_reg <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }
 

R/mars.R

@@ -44,8 +44,10 @@ mars <-
       args = args,
       eng_args = NULL,
       mode = mode,
+      user_specified_mode = !missing(mode),
       method = NULL,
-      engine = engine
+      engine = engine,
+      user_specified_engine = !missing(engine)
     )
   }