new structure working up to fit and fit_xy

Author: topepo

NEWS.md

@@ -1,5 +1,10 @@
 # parsnip 0.0.2.9000
 
+## Breaking Changes
+
+ * The method that `parsnip` stores the model information has changed. Any custom models from previous versions will need to use the new method for registering models. 
+ * The mode need to be declared for models that can be used for more than one mode prior to fitting and/or translation). 
+
 ## New Features
 
  * `add_rowindex()` can create a column called `.row` to a data frame. 

R/engines.R

@@ -1,19 +1,9 @@
 
-get_model_info <-  function (x, engine)  {
-  cls <- specific_model(x)
-  nm <- paste(cls, engine, "data", sep = "_")
-  res <- try(get(nm), silent = TRUE)
-  if (inherits(res, "try-error"))
-    stop("Can't find model object ", nm)
-  res
-}
-
 specific_model <- function(x) {
   cls <- class(x)
   cls[cls != "model_spec"]
 }
 
-
 possible_engines <- function(object, ...) {
   m_env <- get_model_env()
   engs <- rlang::env_get(m_env, specific_model(object))

R/fit.R

@@ -52,8 +52,6 @@
 #'
 #' lr_mod <- logistic_reg()
 #'
-#' lr_mod <- logistic_reg()
-#'
 #' using_formula <-
 #'   lr_mod %>%
 #'   set_engine("glm") %>%
@@ -125,7 +123,7 @@ fit.model_spec <-
       )
 
     # populate `method` with the details for this model type
-    object <- get_method(object, engine = object$engine)
+    object <- add_methods(object, engine = object$engine)
 
     check_installs(object)
 
@@ -215,7 +213,7 @@ fit_xy.model_spec <-
       )
 
     # populate `method` with the details for this model type
-    object <- get_method(object, engine = object$engine)
+    object <- add_methods(object, engine = object$engine)
 
     check_installs(object)
 
@@ -239,7 +237,7 @@ fit_xy.model_spec <-
             ...
           ),
 
-        data.frame_data.frame =, matrix_data.frame =
+        data.frame_data.frame = , matrix_data.frame =
           xy_xy(
             object = object,
             env = eval_env,
@@ -249,7 +247,7 @@ fit_xy.model_spec <-
           ),
 
         # heterogenous combinations
-        matrix_formula =,  data.frame_formula =
+        matrix_formula = ,  data.frame_formula =
           xy_form(
             object = object,
             env = eval_env,
@@ -367,7 +365,7 @@ check_xy_interface <- function(x, y, cl, model) {
 print.model_fit <- function(x, ...) {
   cat("parsnip model object\n\n")
 
-  if(inherits(x$fit, "try-error")) {
+  if (inherits(x$fit, "try-error")) {
     cat("Model fit failed with error:\n", x$fit, "\n")
   } else {
     print(x$fit, ...)

R/translate.R

@@ -41,7 +41,7 @@
 #'
 #' @export
 
-translate <- function (x, ...)
+translate <- function(x, ...)
   UseMethod("translate")
 
 #' @importFrom utils getFromNamespace
@@ -58,12 +58,10 @@ translate.default <- function(x, engine = x$engine, ...) {
   x$engine <- engine
   x <- check_engine(x)
 
-  # TODOS
-  # what to do with unknown mode?
   if (x$mode == "unknown") {
     stop("Model code depends on the mode; please specify one.", call. = FALSE)
   }
-  # set the classes. Is a constructor not being used?
+
   if (is.null(x$method))
     x$method <- get_model_spec(mod_name, x$mode, engine)
 
@@ -78,11 +76,11 @@ translate.default <- function(x, engine = x$engine, ...) {
   x$eng_args <- check_eng_args(x$eng_args, x$method$fit, arg_key$original)
 
   # keep only modified args
-  modifed_args <- purrr::map_lgl(actual_args, null_value)
+  modifed_args <- !purrr::map_lgl(actual_args, null_value)
   actual_args <- actual_args[modifed_args]
 
   # look for defaults if not modified in other
-  if(length(x$method$fit$defaults) > 0) {
+  if (length(x$method$fit$defaults) > 0) {
     in_other <- names(x$method$fit$defaults) %in% names(x$eng_args)
     x$defaults <- x$method$fit$defaults[!in_other]
   }
@@ -96,40 +94,6 @@ translate.default <- function(x, engine = x$engine, ...) {
   x
 }
 
-get_method <- function(x, engine = x$engine, ...) {
-  check_empty_ellipse(...)
-  x$engine <- engine
-  x <- check_engine(x)
-  x$method <- get_model_info(x, x$engine)
-  x
-}
-
-
-get_module <- function(nm) {
-  arg_key <- try(
-    getFromNamespace(
-      paste0(nm, "_arg_key"),
-      ns = "parsnip"
-    ),
-    silent = TRUE
-  )
-  if(inherits(arg_key, "try-error")) {
-    arg_key <- try(
-      get(paste0(nm, "_arg_key")),
-      silent = TRUE
-    )
-  }
-  if(inherits(arg_key, "try-error")) {
-    stop(
-      "Cannot find the model code: `",
-      paste0(nm, "_arg_key"),
-      "`", call. = FALSE
-    )
-  }
-  arg_key
-}
-
-
 #' @export
 print.model_spec <- function(x, ...) {
   cat("Model Specification (", x$mode, ")\n\n", sep = "")
@@ -201,3 +165,10 @@ unionize <- function(args, key) {
   names(args) <- merged$original
   args[!is.na(merged$original)]
 }
+
+add_methods <- function(x, engine) {
+  x$engine <- engine
+  x <- check_engine(x)
+  x$method <- get_model_spec(specific_model(x), x$mode, x$engine)
+  x
+}