improve prompting about missing implementations (#793)

* move missing extension prompt from `new_model_spec` to `print_model_spec`

also, deprecates `check_missing_spec` argument

* tighten logic for no-engines-in-parsnip case

this code used to miss the edge case where a non-relevant extension package was loaded. e.g.:

```
bag_tree() %>%
  set_engine("C5.0")
#> parsnip could not locate an implementation for `bag_tree` model specifications
#> using the `C5.0` engine.
#> Bagged Decision Tree Model Specification (unknown)
#>
#> Main Arguments:
#>   cost_complexity = 0
#>   min_n = 2
#>
#> Computational engine: C5.0

library(censored)

bag_tree() %>%
  set_engine("C5.0")
#> Error in `check_spec_mode_engine_val()`:
#> ! Engine 'C5.0' is not supported for `bag_tree()`. See `show_engines('bag_tree')`.
```

* tighten logic with modes, transition prompts from `rlang` -> `cli`

* prompt on missing implementation in `fit`

also:

* fixes duplicated packages in prompt
* appends a newline regardless of whether a specific extension is recommended
* allows passing additional arguments to `prompt`

* update snapshots + tests

mostly undoing changes made for 732.

* add tests

still need to test interactions with extensions--this will have to live in extratests

* re`document`

* use `cli` formatting for `.pkg`s

* integrate `default` attributes for engine and mode

* migrate arg attributes to new model spec slots

e.g. `attr(model_spec$mode, "default")` now lives at `model_spec$user_specified_mode`. a likely _less_ breaking change and lives more visibly in the object structure.

* test fixes + updates, swimming in edge case spaghetti

* re`document()` with new `new_model_spec()` args

* address some review comments

* transition `model_info_table` read to a helper
* `implementation_exists_somewhere` -> `spec_is_possible`
* comment on `*_filter_condition` helpers
* minimal testing for old/external objects

* address remainder of review comments

* comment on checking strategy
* name arguments to `prompt_missing_implementation`
* mark parsnip with `.pkg` cli tag

* export and document model spec checking functions

also, renames `has_loaded_implementation` -> `spec_is_loaded`

Author: simonpcouch

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)
     )
   }