TESTS: Add support for marshalling {parsnip} objects [#5]

DESCRIPTION

@@ -11,14 +11,15 @@ Suggests:
       tensorflow,
     magick,
     ncdf4,
+    parsnip,
     raster,
     stats,
     terra,
     tools,
     xgboost,
     XML,
     xml2
-Version: 0.0.0-9022
+Version: 0.0.0-9023
 Authors@R: 
     person(given = "Henrik", family = "Bengtsson",
            role = c("aut", "cre", "cph"),

NAMESPACE

@@ -9,6 +9,7 @@ S3method(marshal,XMLAbstractDocument)
 S3method(marshal,XMLAbstractNode)
 S3method(marshal,connection)
 S3method(marshal,keras.engine.base_layer.Layer)
+S3method(marshal,model_fit)
 S3method(marshal,ncdf4)
 S3method(marshal,train)
 S3method(marshal,xgb.Booster)

R/marshal.parsnip.R

@@ -0,0 +1,41 @@
+#' Marshal and Unmarshal a 'parsnip' object
+#'
+#' @param x
+#' A `parnsip:model_fit` object.
+#'
+#' @param \dots Not used.
+#'
+#' @return
+#' A `marshalled` object as described in [marshal()].
+#'
+#' @details
+#' The `fit` element of the `model_fit` object is marshalled.
+#'
+#' @example incl/marshal.parsnip.R
+#'
+#' @rdname marshal.parsnip
+#' @aliases marshal.model_fit
+#' @export
+marshal.model_fit <- function(x, ...) {
+  x[["fit"]] <- marshal(x[["fit"]])
+  res <- list(
+    marshalled = x
+  )
+  class(res) <- marshal_class(x)
+
+  ## IMPORTANT: We don't want any of the input arguments
+  ## to be part of the unmarshal() environment
+  rm(list = c("x", names(list(...))))
+
+  res[["unmarshal"]] <- unmarshal_model_fit
+  assert_no_references(res)
+  res
+}
+
+unmarshal_model_fit <- function(x, ...) {
+  object <- x[["marshalled"]]
+  object[["fit"]] <- unmarshal(object[["fit"]])
+  res <- object
+  stopifnot(all.equal(class(res), marshal_unclass(x), check.attributes = FALSE))
+  res
+}

incl/marshal.parsnip.R

@@ -0,0 +1,29 @@
+if (requireNamespace("parsnip", quietly = TRUE) && requireNamespace("xgboost", quietly = TRUE)) {
+  library(parsnip)
+
+  ## Adopted from example("boost_tree", package = "parsnip")
+  model <- boost_tree(mode = "classification", trees = 20L, engine = "xgboost")  
+  model <- set_mode(model, "regression")
+  fit <- fit(model, mpg ~ ., data = datasets::mtcars)
+
+  ## Marshal
+  fit_ <- marshal(fit)
+
+  ## Unmarshal
+  fit2 <- unmarshal(fit_)
+
+  ## Marshal again
+  fit2_ <- marshal(fit2)
+
+  ## Assert identity
+  stopifnot(
+    all.equal(fit2_, fit_)
+  )
+
+  fit3 <- unmarshal(fit2_)
+
+  ## Assert identity
+  stopifnot(
+    all.equal(fit3, fit2)
+  )
+}  

tests/marshal.parsnip.R

@@ -0,0 +1,31 @@
+library(marshal)
+
+if (requireNamespace("parsnip", quietly = TRUE) && requireNamespace("xgboost", quietly = TRUE)) {
+  library(parsnip)
+
+  ## Adopted from example("boost_tree", package = "parsnip")
+  model <- boost_tree(mode = "classification", trees = 20L, engine = "xgboost")  
+  model <- set_mode(model, "regression")
+  fit <- fit(model, mpg ~ ., data = datasets::mtcars)
+
+  ## Marshal
+  fit_ <- marshal(fit)
+
+  ## Unmarshal
+  fit2 <- unmarshal(fit_)
+
+  ## Marshal again
+  fit2_ <- marshal(fit2)
+
+  ## Assert identity
+  stopifnot(
+    all.equal(fit2_, fit_)
+  )
+
+  fit3 <- unmarshal(fit2_)
+
+  ## Assert identity
+  stopifnot(
+    all.equal(fit3, fit2)
+  )
+}