transition update internals

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: parsnip
 Title: A Common API to Modeling and Analysis Functions
-Version: 0.2.1.9001
+Version: 0.2.1.9002
 Authors@R: c(
     person("Max", "Kuhn", , "max@rstudio.com", role = c("aut", "cre")),
     person("Davis", "Vaughan", , "davis@rstudio.com", role = "aut"),

NAMESPACE

@@ -295,6 +295,7 @@ export(update_dot_check)
 export(update_engine_parameters)
 export(update_main_parameters)
 export(update_model_info_file)
+export(update_spec)
 export(varying)
 export(varying_args)
 export(xgb_predict)

NEWS.md

@@ -6,7 +6,7 @@
 
 * Exported `xgb_predict()` which wraps xgboost's `predict()` method for use with parsnip extension packages (#688).
 
-## Bug fixes
+* Fixed bug where previously set engine arguments would propagate through `update()` methods despite `fresh = TRUE` (#704).
 
 *  An inconsistency for probability type predictions for two-class GAM models was fixed (#708)
 

R/bag_mars.R

@@ -65,36 +65,20 @@ update.bag_mars <-
            parameters = NULL,
            num_terms = NULL, prod_degree = NULL, prune_method = NULL,
            fresh = FALSE, ...) {
-    update_dot_check(...)
 
-    if (!is.null(parameters)) {
-      parameters <- check_final_param(parameters)
-    }
     args <- list(
       num_terms   = enquo(num_terms),
       prod_degree  = enquo(prod_degree),
       prune_method  = enquo(prune_method)
     )
 
-    args <- update_main_parameters(args, parameters)
-
-    if (fresh) {
-      object$args <- args
-    } else {
-      null_args <- map_lgl(args, null_value)
-      if (any(null_args))
-        args <- args[!null_args]
-      if (length(args) > 0)
-        object$args[names(args)] <- args
-    }
-
-    new_model_spec(
-      "bag_mars",
-      args = object$args,
-      eng_args = object$eng_args,
-      mode = object$mode,
-      method = NULL,
-      engine = object$engine
+    update_spec(
+      object = object,
+      parameters = parameters,
+      args_enquo_list = args,
+      fresh = fresh,
+      cls = "bag_mars",
+      ...
     )
   }
 

R/bag_tree.R

@@ -71,37 +71,21 @@ update.bag_tree <-
            cost_complexity = NULL, tree_depth = NULL, min_n = NULL,
            class_cost = NULL,
            fresh = FALSE, ...) {
-    update_dot_check(...)
 
-    if (!is.null(parameters)) {
-      parameters <- check_final_param(parameters)
-    }
     args <- list(
-      cost_complexity   = enquo(cost_complexity),
-      tree_depth  = enquo(tree_depth),
-      min_n  = enquo(min_n),
-      class_cost = enquo(class_cost)
+      cost_complexity = enquo(cost_complexity),
+      tree_depth      = enquo(tree_depth),
+      min_n           = enquo(min_n),
+      class_cost      = enquo(class_cost)
     )
 
-    args <- update_main_parameters(args, parameters)
-
-    if (fresh) {
-      object$args <- args
-    } else {
-      null_args <- map_lgl(args, null_value)
-      if (any(null_args))
-        args <- args[!null_args]
-      if (length(args) > 0)
-        object$args[names(args)] <- args
-    }
-
-    new_model_spec(
-      "bag_tree",
-      args = object$args,
-      eng_args = object$eng_args,
-      mode = object$mode,
-      method = NULL,
-      engine = object$engine
+    update_spec(
+      object = object,
+      parameters = parameters,
+      args_enquo_list = args,
+      fresh = fresh,
+      cls = "bag_tree",
+      ...
     )
   }
 

R/bart.R

@@ -121,41 +121,20 @@ update.bart <-
            prior_outcome_range = NULL,
            fresh = FALSE, ...) {
 
-    eng_args <- update_engine_parameters(object$eng_args, ...)
-
-    if (!is.null(parameters)) {
-      parameters <- check_final_param(parameters)
-    }
-
     args <- list(
       trees = enquo(trees),
       prior_terminal_node_coef = enquo(prior_terminal_node_coef),
       prior_terminal_node_expo = enquo(prior_terminal_node_expo),
       prior_outcome_range = enquo(prior_outcome_range)
     )
 
-    args <- update_main_parameters(args, parameters)
-
-    if (fresh) {
-      object$args <- args
-      object$eng_args <- eng_args
-    } else {
-      null_args <- map_lgl(args, null_value)
-      if (any(null_args))
-        args <- args[!null_args]
-      if (length(args) > 0)
-        object$args[names(args)] <- args
-      if (length(eng_args) > 0)
-        object$eng_args[names(eng_args)] <- eng_args
-    }
-
-    new_model_spec(
-      "bart",
-      args = object$args,
-      eng_args = object$eng_args,
-      mode = object$mode,
-      method = NULL,
-      engine = object$engine
+    update_spec(
+      object = object,
+      parameters = parameters,
+      args_enquo_list = args,
+      fresh = fresh,
+      cls = "bart",
+      ...
     )
   }
 

R/boost_tree.R

@@ -105,12 +105,6 @@ update.boost_tree <-
            stop_iter = NULL,
            fresh = FALSE, ...) {
 
-    eng_args <- update_engine_parameters(object$eng_args, ...)
-
-    if (!is.null(parameters)) {
-      parameters <- check_final_param(parameters)
-    }
-
     args <- list(
       mtry = enquo(mtry),
       trees = enquo(trees),
@@ -122,29 +116,13 @@ update.boost_tree <-
       stop_iter = enquo(stop_iter)
     )
 
-    args <- update_main_parameters(args, parameters)
-
-    # TODO make these blocks into a function and document well
-    if (fresh) {
-      object$args <- args
-      object$eng_args <- eng_args
-    } else {
-      null_args <- map_lgl(args, null_value)
-      if (any(null_args))
-        args <- args[!null_args]
-      if (length(args) > 0)
-        object$args[names(args)] <- args
-      if (length(eng_args) > 0)
-        object$eng_args[names(eng_args)] <- eng_args
-    }
-
-    new_model_spec(
-      "boost_tree",
-      args = object$args,
-      eng_args = object$eng_args,
-      mode = object$mode,
-      method = NULL,
-      engine = object$engine
+    update_spec(
+      object = object,
+      parameters = parameters,
+      args_enquo_list = args,
+      fresh = fresh,
+      cls = "boost_tree",
+      ...
     )
   }
 

R/c5_rules.R

@@ -100,35 +100,19 @@ update.C5_rules <-
            parameters = NULL,
            trees = NULL, min_n = NULL,
            fresh = FALSE, ...) {
-    update_dot_check(...)
 
-    if (!is.null(parameters)) {
-      parameters <- check_final_param(parameters)
-    }
     args <- list(
       trees = enquo(trees),
       min_n = enquo(min_n)
     )
 
-    args <- update_main_parameters(args, parameters)
-
-    if (fresh) {
-      object$args <- args
-    } else {
-      null_args <- map_lgl(args, null_value)
-      if (any(null_args))
-        args <- args[!null_args]
-      if (length(args) > 0)
-        object$args[names(args)] <- args
-    }
-
-    new_model_spec(
-      "C5_rules",
-      args = object$args,
-      eng_args = object$eng_args,
-      mode = object$mode,
-      method = NULL,
-      engine = object$engine
+    update_spec(
+      object = object,
+      parameters = parameters,
+      args_enquo_list = args,
+      fresh = fresh,
+      cls = "C5_rules",
+      ...
     )
   }
 

R/cubist_rules.R

@@ -124,36 +124,20 @@ update.cubist_rules <-
            parameters = NULL,
            committees = NULL, neighbors = NULL, max_rules = NULL,
            fresh = FALSE, ...) {
-    update_dot_check(...)
 
-    if (!is.null(parameters)) {
-      parameters <- check_final_param(parameters)
-    }
     args <- list(
       committees = enquo(committees),
-      neighbors = enquo(neighbors),
-      max_rules = enquo(max_rules)
+      neighbors  = enquo(neighbors),
+      max_rules  = enquo(max_rules)
     )
 
-    args <- update_main_parameters(args, parameters)
-
-    if (fresh) {
-      object$args <- args
-    } else {
-      null_args <- map_lgl(args, null_value)
-      if (any(null_args))
-        args <- args[!null_args]
-      if (length(args) > 0)
-        object$args[names(args)] <- args
-    }
-
-    new_model_spec(
-      "cubist_rules",
-      args = object$args,
-      eng_args = object$eng_args,
-      mode = object$mode,
-      method = NULL,
-      engine = object$engine
+    update_spec(
+      object = object,
+      parameters = parameters,
+      args_enquo_list = args,
+      fresh = fresh,
+      cls = "cubist_rules",
+      ...
     )
   }
 

R/decision_tree.R

@@ -74,39 +74,19 @@ update.decision_tree <-
            cost_complexity = NULL, tree_depth = NULL, min_n = NULL,
            fresh = FALSE, ...) {
 
-    eng_args <- update_engine_parameters(object$eng_args, ...)
-
-    if (!is.null(parameters)) {
-      parameters <- check_final_param(parameters)
-    }
     args <- list(
       cost_complexity   = enquo(cost_complexity),
       tree_depth  = enquo(tree_depth),
       min_n  = enquo(min_n)
     )
 
-    args <- update_main_parameters(args, parameters)
-
-    if (fresh) {
-      object$args <- args
-      object$eng_args <- eng_args
-    } else {
-      null_args <- map_lgl(args, null_value)
-      if (any(null_args))
-        args <- args[!null_args]
-      if (length(args) > 0)
-        object$args[names(args)] <- args
-      if (length(eng_args) > 0)
-        object$eng_args[names(eng_args)] <- eng_args
-    }
-
-    new_model_spec(
-      "decision_tree",
-      args = object$args,
-      eng_args = object$eng_args,
-      mode = object$mode,
-      method = NULL,
-      engine = object$engine
+    update_spec(
+      object = object,
+      parameters = parameters,
+      args_enquo_list = args,
+      fresh = fresh,
+      cls = "decision_tree",
+      ...
     )
   }
 

R/discrim_flexible.R

@@ -75,30 +75,20 @@ update.discrim_flexible <-
            prod_degree = NULL,
            prune_method = NULL,
            fresh = FALSE, ...) {
-    update_dot_check(...)
+
     args <- list(
       num_terms    = enquo(num_terms),
       prod_degree  = enquo(prod_degree),
       prune_method = enquo(prune_method)
     )
 
-    if (fresh) {
-      object$args <- args
-    } else {
-      null_args <- map_lgl(args, null_value)
-      if (any(null_args))
-        args <- args[!null_args]
-      if (length(args) > 0)
-        object$args[names(args)] <- args
-    }
-
-    new_model_spec(
-      "discrim_flexible",
-      args = object$args,
-      eng_args = object$eng_args,
-      mode = object$mode,
-      method = NULL,
-      engine = object$engine
+    update_spec(
+      object = object,
+      parameters = NULL,
+      args_enquo_list = args,
+      fresh = fresh,
+      cls = "discrim_flexible",
+      ...
     )
   }