refactor model specification printing (#739)

* add model printing helper

* delete redundant model print methods

note that the only changes needed to pass existing tests is 4 snapshot updates, where `"Model "` is added preceding `"Specification"` in the header.

* delete old model spec printing tests

* add new model spec printing tests

* add `NEWS` entry

* move print helpers and methods to new `R/print.R` file

* re`document()`

* add null model description

* test fixes re: upstream merge

Co-authored-by: Max Kuhn <[email protected]>

Author: simonpcouch

NAMESPACE

@@ -49,39 +49,10 @@ S3method(predict_raw,"_multnet")
 S3method(predict_raw,model_fit)
 S3method(predict_survival,model_fit)
 S3method(predict_time,model_fit)
-S3method(print,C5_rules)
-S3method(print,bag_mars)
-S3method(print,bag_tree)
-S3method(print,bart)
-S3method(print,boost_tree)
 S3method(print,control_parsnip)
-S3method(print,cubist_rules)
-S3method(print,decision_tree)
-S3method(print,discrim_flexible)
-S3method(print,discrim_linear)
-S3method(print,discrim_quad)
-S3method(print,discrim_regularized)
-S3method(print,gen_additive_mod)
-S3method(print,linear_reg)
-S3method(print,logistic_reg)
-S3method(print,mars)
-S3method(print,mlp)
 S3method(print,model_fit)
 S3method(print,model_spec)
-S3method(print,multinom_reg)
-S3method(print,naive_Bayes)
-S3method(print,nearest_neighbor)
 S3method(print,nullmodel)
-S3method(print,pls)
-S3method(print,poisson_reg)
-S3method(print,proportional_hazards)
-S3method(print,rand_forest)
-S3method(print,rule_fit)
-S3method(print,surv_reg)
-S3method(print,survival_reg)
-S3method(print,svm_linear)
-S3method(print,svm_poly)
-S3method(print,svm_rbf)
 S3method(req_pkgs,model_fit)
 S3method(req_pkgs,model_spec)
 S3method(required_pkgs,model_fit)
@@ -267,6 +238,7 @@ export(predict_survival.model_fit)
 export(predict_time)
 export(predict_time.model_fit)
 export(prepare_data)
+export(print_model_spec)
 export(proportional_hazards)
 export(rand_forest)
 export(repair_call)

NEWS.md

@@ -23,6 +23,8 @@
 
 * Model type functions will now message informatively if a needed parsnip extension package is not loaded (#731).
 
+* Refactored internals of model specification printing functions. These changes are non-breaking for extension packages, but the new `print_model_spec()` helper is exported for use in extensions if desired (#739).
+
 
 # parsnip 0.2.1
 

R/bag_mars.R

@@ -42,18 +42,6 @@ bag_mars <-
     )
   }
 
-#' @export
-print.bag_mars <- function(x, ...) {
-  cat("Bagged MARS Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update bag_mars

R/bag_tree.R

@@ -46,18 +46,6 @@ bag_tree <-
     )
   }
 
-#' @export
-print.bag_tree <- function(x, ...) {
-  cat("Bagged Decision Tree Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update bag_tree

R/bart.R

@@ -90,18 +90,6 @@ bart <-
     )
   }
 
-#' @export
-print.bart <- function(x, ...) {
-  cat("BART Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update bart

R/boost_tree.R

@@ -80,18 +80,6 @@ boost_tree <-
     )
   }
 
-#' @export
-print.boost_tree <- function(x, ...) {
-  cat("Boosted Tree Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update boost_tree

R/c5_rules.R

@@ -63,20 +63,6 @@ C5_rules <-
     )
   }
 
-#' @export
-print.C5_rules <- function(x, ...) {
-  cat("C5.0 Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
-
 # ------------------------------------------------------------------------------
 
 #' Updating a model specification

R/cubist_rules.R

@@ -89,20 +89,6 @@ cubist_rules <-
     )
   }
 
-#' @export
-print.cubist_rules <- function(x, ...) {
-  cat("Cubist Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
-
 # ------------------------------------------------------------------------------
 
 #' @param object A Cubist model specification.

R/decision_tree.R

@@ -51,18 +51,6 @@ decision_tree <-
     )
   }
 
-#' @export
-print.decision_tree <- function(x, ...) {
-  cat("Decision Tree Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update decision_tree

R/discrim_flexible.R

@@ -45,19 +45,6 @@ discrim_flexible <-
     )
   }
 
-#' @export
-print.discrim_flexible <- function(x, ...) {
-  cat("Flexible Discriminant Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' Update a model specification

R/discrim_linear.R

@@ -47,19 +47,6 @@ discrim_linear <-
     )
   }
 
-#' @export
-print.discrim_linear <- function(x, ...) {
-  cat("Linear Discriminant Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update discrim_linear

R/discrim_quad.R

@@ -41,19 +41,6 @@ discrim_quad <-
     )
   }
 
-#' @export
-print.discrim_quad <- function(x, ...) {
-  cat("Quadratic Discriminant Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update discrim_quad

R/discrim_regularized.R

@@ -62,19 +62,6 @@ discrim_regularized <-
     )
   }
 
-#' @export
-print.discrim_regularized <- function(x, ...) {
-  cat("Regularized Discriminant Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update discrim_regularized

R/gen_additive_mod.R

@@ -50,19 +50,6 @@ gen_additive_mod <- function(mode = "unknown",
 
 }
 
-#' @export
-print.gen_additive_mod <- function(x, ...) {
-  cat("GAM Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
 #' @export
 #' @rdname parsnip_update
 #' @inheritParams gen_additive_mod

R/linear_reg.R

@@ -58,20 +58,6 @@ linear_reg <-
     )
   }
 
-#' @export
-print.linear_reg <- function(x, ...) {
-  cat("Linear Regression Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
-
 #' @export
 translate.linear_reg <- function(x, engine = x$engine, ...) {
   x <- translate.default(x, engine, ...)

R/logistic_reg.R

@@ -65,19 +65,6 @@ logistic_reg <-
     )
   }
 
-#' @export
-print.logistic_reg <- function(x, ...) {
-  cat("Logistic Regression Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-
-  invisible(x)
-}
-
 #' @export
 translate.logistic_reg <- function(x, engine = x$engine, ...) {
   x <- translate.default(x, engine, ...)

R/mars.R

@@ -49,18 +49,6 @@ mars <-
     )
   }
 
-#' @export
-print.mars <- function(x, ...) {
-  cat("MARS Model Specification (", x$mode, ")\n\n", sep = "")
-  model_printer(x, ...)
-
-  if (is_printable_spec(x)) {
-    cat("Model fit template:\n")
-    print(show_call(x))
-  }
-  invisible(x)
-}
-
 # ------------------------------------------------------------------------------
 
 #' @method update mars