add method for dbarts::bart() (#65)

DESCRIPTION

@@ -32,6 +32,7 @@ Suggests:
     callr,
     caret,
     covr,
+    dbarts,
     embed,
     h2o,
     keras,

NAMESPACE

@@ -4,6 +4,7 @@ S3method(bundle,H2OAutoML)
 S3method(bundle,H2OBinomialModel)
 S3method(bundle,H2OMultinomialModel)
 S3method(bundle,H2ORegressionModel)
+S3method(bundle,bart)
 S3method(bundle,default)
 S3method(bundle,keras.engine.training.Model)
 S3method(bundle,luz_module_fitted)

NEWS.md

@@ -1,5 +1,8 @@
 # bundle (development version)
 
+* Added bundle method for objects from `dbarts::bart()` and, by extension,
+  `parsnip::bart(engine = "dbarts")` (#64).
+
 # bundle 0.1.1
 
 * Fixed bundling of recipes steps situated inside of workflows.

R/bundle_bart.R

@@ -0,0 +1,60 @@
+#' @templateVar class a `bart`
+#' @template title_desc
+#'
+#' @templateVar outclass `bundled_bart`
+#' @templateVar default .
+#' @template return_bundle
+#' @family bundlers
+#'
+#' @param x A `bart` object returned from [dbarts::bart()]. Notably, this ought
+#' not to be the output of [parsnip::bart()].
+#' @template param_unused_dots
+#' @rdname bundle_bart
+#' @template butcher_details
+#' @examplesIf rlang::is_installed(c("dbarts"))
+#' # fit model and bundle ------------------------------------------------
+#' library(dbarts)
+#'
+#' mtcars$vs <- as.factor(mtcars$vs)
+#'
+#' set.seed(1)
+#' fit <- dbarts::bart(mtcars[c("disp", "hp")], mtcars$vs, keeptrees = TRUE)
+#'
+#' fit_bundle <- bundle(fit)
+#'
+#' # then, after saveRDS + readRDS or passing to a new session ----------
+#' fit_unbundled <- unbundle(fit_bundle)
+#'
+#' fit_unbundled_preds <- predict(fit_unbundled, mtcars)
+#' @aliases bundle.bart
+#' @method bundle bart
+#' @export
+bundle.bart <- function(x, ...) {
+  rlang::check_installed("dbarts")
+  rlang::check_dots_empty()
+
+  # `parsnip::bart()` and `dbarts::bart()` unfortunately both inherit from `bart`
+  if (inherits(x, "model_spec")) {
+    rlang::abort(c(
+      paste0("`x` should be the output of `dbarts::bart()`, not a model ",
+             "specification from `parsnip::bart()`."),
+      "To bundle `parsnip::bart()` output, train it with `parsnip::fit()` first."
+    ))
+  }
+
+  if (is.null(x$fit)) {
+    rlang::abort(c(
+      "`x` can't be bundled.",
+      "`x` must have been fitted with argument `keeptrees = TRUE`."
+    ))
+  }
+
+  # "touch" the object's state (#64)
+  invisible(x$fit$state)
+
+  bundle_constr(
+    object = x,
+    situate = situate_constr(identity),
+    desc_class = class(x)[1]
+  )
+}

tests/testthat/_snaps/bundle_bart.md

@@ -0,0 +1,18 @@
+# bundle.bart errors informatively with model_spec input (#64)
+
+    Code
+      bundle(parsnip::bart())
+    Condition
+      Error in `bundle()`:
+      ! `x` should be the output of `dbarts::bart()`, not a model specification from `parsnip::bart()`.
+      * To bundle `parsnip::bart()` output, train it with `parsnip::fit()` first.
+
+# bundle.bart errors informatively when `keeptrees = FALSE` (#64)
+
+    Code
+      bundle(fit)
+    Condition
+      Error in `bundle()`:
+      ! `x` can't be bundled.
+      * `x` must have been fitted with argument `keeptrees = TRUE`.
+