add butcher methods for all int_conform methods

DESCRIPTION

@@ -63,6 +63,7 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
 Collate: 
     'bound_prediction.R'
+    'butcher.R'
     'cal-apply-binary.R'
     'cal-apply-impl.R'
     'cal-apply-multi.R'

NEWS.md

@@ -2,6 +2,8 @@
 
 * Add `required_pkgs()` methods to `int_conformal_cv()`, `int_conformal_full()`, `int_conformal_quantile()`,  and `int_conformal_split()`. (#190)
 
+* Add butcher methods to `int_conformal_cv()`, `int_conformal_full()`, `int_conformal_quantile()`,  and `int_conformal_split()`. (#194)
+
 # probably 1.1.1
 
 * Updated unit tests for new ggplot2 release (#180).

R/butcher.R

@@ -0,0 +1,173 @@
+#' Butcher methods for conformal inteference intervals
+#'
+#' These methods allow you to use the butcher package to reduce the size of a
+#' conformal inference interval object. After calling `butcher::butcher()` on a
+#' conformal inference interval object, the only guarantee is that you will
+#' still be able to `predict()` from that conformal inference interval object.
+#' Other functions may not work as expected.
+#'
+#' @param x A conformal inference interval object.
+#' @param verbose Should information be printed about how much memory is freed
+#'   from butchering?
+#' @param ... Extra arguments possibly used by underlying methods.
+#'
+#' @keywords internal
+#' @name inf_conformal-butcher
+
+# int_conformal_full
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_call.int_conformal_full <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_call(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_ctrl.int_conformal_full <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_ctrl(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_data.int_conformal_full <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_data(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_env.int_conformal_full <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_env(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_fitted.int_conformal_full <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_fitted(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# int_conformal_split
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_call.int_conformal_split <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_call(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_ctrl.int_conformal_split <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_ctrl(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_data.int_conformal_split <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_data(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_env.int_conformal_split <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_env(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_fitted.int_conformal_split <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_fitted(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# int_conformal_quantile
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_call.int_conformal_quantile <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_call(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_ctrl.int_conformal_quantile <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_ctrl(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_data.int_conformal_quantile <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_data(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_env.int_conformal_quantile <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_env(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_fitted.int_conformal_quantile <- function(x, verbose = FALSE, ...) {
+  x$wflow <- butcher::axe_fitted(x$wflow, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# int_conformal_cv
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_call.int_conformal_cv <- function(x, verbose = FALSE, ...) {
+  x$models <- purrr::map(x$models, butcher::axe_call, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_ctrl.int_conformal_cv <- function(x, verbose = FALSE, ...) {
+  x$models <- purrr::map(x$models, butcher::axe_ctrl, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_data.int_conformal_cv <- function(x, verbose = FALSE, ...) {
+  x$models <- purrr::map(x$models, butcher::axe_data, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_env.int_conformal_cv <- function(x, verbose = FALSE, ...) {
+  x$models <- purrr::map(x$models, butcher::axe_env, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# @export - onLoad
+#' @rdname inf_conformal-butcher
+axe_fitted.int_conformal_cv <- function(x, verbose = FALSE, ...) {
+  x$models <- purrr::map(x$models, butcher::axe_fitted, verbose = verbose, ...)
+  add_butcher_class(x)
+}
+
+# ------------------------------------------------------------------------------
+
+# butcher:::add_butcher_class
+add_butcher_class <- function(x) {
+  if (!any(grepl("butcher", class(x)))) {
+    class(x) <- append(paste0("butchered_", rev(class(x))[1]), class(x))
+  }
+  x
+}

R/zzz.R

@@ -1,4 +1,28 @@
 .onLoad <- function(libname, pkgname) {
   vctrs::s3_register("tune::collect_metrics", "cal_rset")
   vctrs::s3_register("tune::collect_predictions", "cal_rset")
+
+  vctrs::s3_register("butcher::axe_call", "int_conformal_cv")
+  vctrs::s3_register("butcher::axe_ctrl", "int_conformal_cv")
+  vctrs::s3_register("butcher::axe_data", "int_conformal_cv")
+  vctrs::s3_register("butcher::axe_env", "int_conformal_cv")
+  vctrs::s3_register("butcher::axe_fitted", "int_conformal_cv")
+
+  vctrs::s3_register("butcher::axe_call", "int_conformal_full")
+  vctrs::s3_register("butcher::axe_ctrl", "int_conformal_full")
+  vctrs::s3_register("butcher::axe_data", "int_conformal_full")
+  vctrs::s3_register("butcher::axe_env", "int_conformal_full")
+  vctrs::s3_register("butcher::axe_fitted", "int_conformal_full")
+
+  vctrs::s3_register("butcher::axe_call", "int_conformal_split")
+  vctrs::s3_register("butcher::axe_ctrl", "int_conformal_split")
+  vctrs::s3_register("butcher::axe_data", "int_conformal_split")
+  vctrs::s3_register("butcher::axe_env", "int_conformal_split")
+  vctrs::s3_register("butcher::axe_fitted", "int_conformal_split")
+
+  vctrs::s3_register("butcher::axe_call", "int_conformal_quantile")
+  vctrs::s3_register("butcher::axe_ctrl", "int_conformal_quantile")
+  vctrs::s3_register("butcher::axe_data", "int_conformal_quantile")
+  vctrs::s3_register("butcher::axe_env", "int_conformal_quantile")
+  vctrs::s3_register("butcher::axe_fitted", "int_conformal_quantile")
 }