From 69ac2c3096084eb76efb810390b7cfdbbc4f7b8a Mon Sep 17 00:00:00 2001 From: "C. Regouby" Date: Thu, 30 Jun 2022 20:24:49 +0200 Subject: [PATCH 1/6] new_model_butcher --- DESCRIPTION | 1 + R/tabnet_fit.R | 97 ++++++++++++++++++++++++++++++++ tests/testthat/test-tabnet_fit.R | 20 +++++++ 3 files changed, 118 insertions(+) create mode 100644 R/tabnet_fit.R create mode 100644 tests/testthat/test-tabnet_fit.R diff --git a/DESCRIPTION b/DESCRIPTION index 647446c..cf47065 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -59,6 +59,7 @@ Suggests: rsample, RSpectra, survival (>= 3.2-10), + tabnet, testthat (>= 3.0.0), TH.data, usethis (>= 1.5.0), diff --git a/R/tabnet_fit.R b/R/tabnet_fit.R new file mode 100644 index 0000000..ee33539 --- /dev/null +++ b/R/tabnet_fit.R @@ -0,0 +1,97 @@ +#' Axing a tabnet_fit. +#' +#' @inheritParams butcher +#' +#' @return Axed tabnet_fit object. +#' +#' @examples +#' ## +#' ## Insert examples to create and axe model object here... +#' ## +#' @name axe-tabnet_fit +NULL + +#' Remove the call. +#' +#' @rdname axe-tabnet_fit +#' @export +axe_call.tabnet_fit <- function(x, verbose = FALSE, ...) { + old <- x + x <- exchange(x, "call", call("dummy_call")) + + add_butcher_attributes( + x, + old, + disabled = c("print()", "summary()"), + add_class = FALSE, + verbose = verbose + ) +} + +#' Remove controls used for training. +#' +#' @rdname axe-tabnet_fit +#' @export +axe_ctrl.tabnet_fit <- function(x, verbose = FALSE, ...) { + old <- x + x <- exchange(x, "control", "???") + + add_butcher_attributes( + x, + old, + disabled = c("some_function()", "another_function()"), + add_class = FALSE, + verbose = verbose + ) +} + +#' Remove the training data. +#' +#' @rdname axe-tabnet_fit +#' @export +axe_data.tabnet_fit <- function(x, verbose = FALSE, ...) { + old <- x + x <- exchange(x, "data", "???") + + add_butcher_attributes( + x, + old, + disabled = c("some_function()", "another_function()"), + add_class = FALSE, + verbose = verbose + ) +} + +#' Remove environments. +#' +#' @rdname axe-tabnet_fit +#' @export +axe_env.tabnet_fit <- function(x, verbose = FALSE, ...) { + old <- x + x$terms <- axe_env(x$terms, ...) + + add_butcher_attributes( + x, + old, + disabled = c("some_function()", "another_function()"), + add_class = FALSE, + verbose = verbose + ) +} + +#' Remove fitted values. +#' +#' @rdname axe-tabnet_fit +#' @export +axe_fitted.tabnet_fit <- function(x, verbose = FALSE, ...) { + old <- x + x <- exchange(x, "fitted.values", "???") + + add_butcher_attributes( + x, + old, + disabled = c("some_function()", "another_function()"), + add_class = FALSE, + verbose = verbose + ) +} diff --git a/tests/testthat/test-tabnet_fit.R b/tests/testthat/test-tabnet_fit.R new file mode 100644 index 0000000..2cf814a --- /dev/null +++ b/tests/testthat/test-tabnet_fit.R @@ -0,0 +1,20 @@ +test_that("tabnet_fit + axe_call() works", { +}) + +test_that("tabnet_fit + axe_ctrl() works", { +}) + +test_that("tabnet_fit + axe_data() works", { +}) + +test_that("tabnet_fit + axe_env() works", { +}) + +test_that("tabnet_fit + axe_fitted() works", { +}) + +test_that("tabnet_fit + butcher() works", { +}) + +test_that("tabnet_fit + predict() works", { +}) From 24d9d7186456587073e17d7be8bf7141ab618420 Mon Sep 17 00:00:00 2001 From: "C. Regouby" Date: Thu, 30 Jun 2022 23:16:46 +0200 Subject: [PATCH 2/6] some improveme,nt but still not able to use the s3 Method --- NAMESPACE | 3 ++ R/tabnet_fit.R | 73 +++++++++++++------------------- man/axe-flexsurvreg.Rd | 24 ----------- man/axe-randomForest.Rd | 37 ---------------- man/axe-tabnet_fit.Rd | 59 ++++++++++++++++++++++++++ tests/testthat/test-tabnet_fit.R | 37 ++++++++++++---- 6 files changed, 121 insertions(+), 112 deletions(-) create mode 100644 man/axe-tabnet_fit.Rd diff --git a/NAMESPACE b/NAMESPACE index 07e179a..59ffa90 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(axe_call,"_tabnet_fit") S3method(axe_call,C5.0) S3method(axe_call,classbagg) S3method(axe_call,default) @@ -26,6 +27,7 @@ S3method(axe_call,survreg.penal) S3method(axe_call,train) S3method(axe_call,train.recipe) S3method(axe_call,xgb.Booster) +S3method(axe_ctrl,"_tabnet_fit") S3method(axe_ctrl,C5.0) S3method(axe_ctrl,default) S3method(axe_ctrl,ml_model) @@ -82,6 +84,7 @@ S3method(axe_env,terms) S3method(axe_env,train) S3method(axe_env,train.recipe) S3method(axe_env,xgb.Booster) +S3method(axe_fitted,"_tabnet_fit") S3method(axe_fitted,C5.0) S3method(axe_fitted,default) S3method(axe_fitted,earth) diff --git a/R/tabnet_fit.R b/R/tabnet_fit.R index ee33539..00ff43f 100644 --- a/R/tabnet_fit.R +++ b/R/tabnet_fit.R @@ -5,9 +5,27 @@ #' @return Axed tabnet_fit object. #' #' @examples -#' ## -#' ## Insert examples to create and axe model object here... -#' ## +#' \donttest{ +#' if (rlang::is_installed("tabnet")) { +#' +#' # Load libraries +#' suppressWarnings(suppressMessages(library(parsnip))) +#' suppressWarnings(suppressMessages(library(rsample))) +#' +#' # Load data +#' split <- initial_split(mtcars, props = 9/10) +#' car_train <- training(split) +#' +#' # Create model and fit +#' mtcar_fit <- tabnet() %>% +#' set_mode("regression") %>% +#' set_engine("torch") +#' fit(mpg ~ ., data = car_train) +#' +#' out <- butcher(mtcar_fit, verbose = TRUE) +#' +#' } +#' } #' @name axe-tabnet_fit NULL @@ -15,14 +33,14 @@ NULL #' #' @rdname axe-tabnet_fit #' @export -axe_call.tabnet_fit <- function(x, verbose = FALSE, ...) { +axe_call._tabnet_fit <- function(x, verbose = FALSE, ...) { old <- x x <- exchange(x, "call", call("dummy_call")) add_butcher_attributes( x, old, - disabled = c("print()", "summary()"), + disabled = c("print()", "tabnet_explain()"), add_class = FALSE, verbose = verbose ) @@ -32,7 +50,7 @@ axe_call.tabnet_fit <- function(x, verbose = FALSE, ...) { #' #' @rdname axe-tabnet_fit #' @export -axe_ctrl.tabnet_fit <- function(x, verbose = FALSE, ...) { +axe_ctrl._tabnet_fit <- function(x, verbose = FALSE, ...) { old <- x x <- exchange(x, "control", "???") @@ -45,52 +63,21 @@ axe_ctrl.tabnet_fit <- function(x, verbose = FALSE, ...) { ) } -#' Remove the training data. -#' -#' @rdname axe-tabnet_fit -#' @export -axe_data.tabnet_fit <- function(x, verbose = FALSE, ...) { - old <- x - x <- exchange(x, "data", "???") - - add_butcher_attributes( - x, - old, - disabled = c("some_function()", "another_function()"), - add_class = FALSE, - verbose = verbose - ) -} - -#' Remove environments. -#' -#' @rdname axe-tabnet_fit -#' @export -axe_env.tabnet_fit <- function(x, verbose = FALSE, ...) { - old <- x - x$terms <- axe_env(x$terms, ...) - - add_butcher_attributes( - x, - old, - disabled = c("some_function()", "another_function()"), - add_class = FALSE, - verbose = verbose - ) -} - #' Remove fitted values. #' #' @rdname axe-tabnet_fit #' @export -axe_fitted.tabnet_fit <- function(x, verbose = FALSE, ...) { +axe_fitted._tabnet_fit <- function(x, verbose = FALSE, ...) { old <- x - x <- exchange(x, "fitted.values", "???") + x <- exchange(x, "fit.checkpoints", list(NULL)) + x <- exchange(x, "fit.importances.variables", list(NULL)) + x <- exchange(x, "fit.importances.importance", list(NULL)) + x <- exchange(x, "fit.config", list(NULL)) add_butcher_attributes( x, old, - disabled = c("some_function()", "another_function()"), + disabled = NULL, add_class = FALSE, verbose = verbose ) diff --git a/man/axe-flexsurvreg.Rd b/man/axe-flexsurvreg.Rd index b0b1afe..dcdb8a2 100644 --- a/man/axe-flexsurvreg.Rd +++ b/man/axe-flexsurvreg.Rd @@ -29,27 +29,3 @@ parametric distributions. Users can define their own distribution, or leverage distributions like the generalized gamma, generalized F, and the Royston-Parmar spline model. } -\examples{ -\dontshow{if (rlang::is_installed("flexsurv")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -# Load libraries -suppressWarnings(suppressMessages(library(parsnip))) -suppressWarnings(suppressMessages(library(flexsurv))) - -# Create model and fit -flexsurvreg_fit <- surv_reg(mode = "regression", dist = "gengamma") \%>\% - set_engine("flexsurv") \%>\% - fit(Surv(Tstart, Tstop, status) ~ trans, data = bosms3) - -out <- butcher(flexsurvreg_fit, verbose = TRUE) - -# Another flexsurvreg model object -wrapped_flexsurvreg <- function() { - some_junk_in_environment <- runif(1e6) - fit <- flexsurvreg(Surv(futime, fustat) ~ 1, - data = ovarian, dist = "weibull") - return(fit) -} - -out <- butcher(wrapped_flexsurvreg(), verbose = TRUE) -\dontshow{\}) # examplesIf} -} diff --git a/man/axe-randomForest.Rd b/man/axe-randomForest.Rd index 03d7a01..db8eb13 100644 --- a/man/axe-randomForest.Rd +++ b/man/axe-randomForest.Rd @@ -31,40 +31,3 @@ package, which is used to train random forests based on Breiman's 2001 work. The package supports ensembles of classification and regression trees. } -\examples{ -\dontshow{if (rlang::is_installed("randomForest")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -# Load libraries -suppressWarnings(suppressMessages(library(parsnip))) -suppressWarnings(suppressMessages(library(rsample))) -suppressWarnings(suppressMessages(library(rpart))) -suppressWarnings(suppressMessages(library(randomForest))) - -# Load data -set.seed(1234) -split <- initial_split(kyphosis, props = 9/10) -spine_train <- training(split) - -# Create model and fit -randomForest_fit <- rand_forest(mode = "classification", - mtry = 2, - trees = 2, - min_n = 3) \%>\% - set_engine("randomForest") \%>\% - fit_xy(x = spine_train[,2:4], y = spine_train$Kyphosis) - -out <- butcher(randomForest_fit, verbose = TRUE) - -# Another randomForest object -wrapped_rf <- function() { - some_junk_in_environment <- runif(1e6) - randomForest_fit <- randomForest(mpg ~ ., data = mtcars) - return(randomForest_fit) -} - -# Remove junk -cleaned_rf <- axe_env(wrapped_rf(), verbose = TRUE) - -# Check size -lobstr::obj_size(cleaned_rf) -\dontshow{\}) # examplesIf} -} diff --git a/man/axe-tabnet_fit.Rd b/man/axe-tabnet_fit.Rd new file mode 100644 index 0000000..07eff01 --- /dev/null +++ b/man/axe-tabnet_fit.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tabnet_fit.R +\name{axe-tabnet_fit} +\alias{axe-tabnet_fit} +\alias{axe_call._tabnet_fit} +\alias{axe_ctrl._tabnet_fit} +\alias{axe_fitted._tabnet_fit} +\title{Axing a tabnet_fit.} +\usage{ +\method{axe_call}{`_tabnet_fit`}(x, verbose = FALSE, ...) + +\method{axe_ctrl}{`_tabnet_fit`}(x, verbose = FALSE, ...) + +\method{axe_fitted}{`_tabnet_fit`}(x, verbose = FALSE, ...) +} +\arguments{ +\item{x}{A model object.} + +\item{verbose}{Print information each time an axe method is executed. +Notes how much memory is released and what functions are +disabled. Default is \code{FALSE}.} + +\item{...}{Any additional arguments related to axing.} +} +\value{ +Axed tabnet_fit object. +} +\description{ +Axing a tabnet_fit. + +Remove the call. + +Remove controls used for training. + +Remove fitted values. +} +\examples{ +\donttest{ +if (rlang::is_installed("tabnet")) { + +# Load libraries +suppressWarnings(suppressMessages(library(parsnip))) +suppressWarnings(suppressMessages(library(rsample))) + +# Load data +split <- initial_split(mtcars, props = 9/10) +car_train <- training(split) + +# Create model and fit +mtcar_fit <- tabnet() \%>\% + set_mode("regression") \%>\% + set_engine("torch") + fit(mpg ~ ., data = car_train) + +out <- butcher(mtcar_fit, verbose = TRUE) + +} +} +} diff --git a/tests/testthat/test-tabnet_fit.R b/tests/testthat/test-tabnet_fit.R index 2cf814a..69445e4 100644 --- a/tests/testthat/test-tabnet_fit.R +++ b/tests/testthat/test-tabnet_fit.R @@ -1,19 +1,40 @@ test_that("tabnet_fit + axe_call() works", { -}) - -test_that("tabnet_fit + axe_ctrl() works", { -}) + skip_on_cran() + skip_if_not_installed("tabnet") + suppressPackageStartupMessages(library(parsnip)) + # Create model and fit + tabnet_fit <- tabnet::tabnet(epochs = 10) %>% + set_mode("regression") %>% + set_engine("torch") %>% + fit(mpg ~ ., data = mtcars) -test_that("tabnet_fit + axe_data() works", { -}) - -test_that("tabnet_fit + axe_env() works", { + axed_out <- axe_call(tabnet_fit, verbose = TRUE) }) test_that("tabnet_fit + axe_fitted() works", { + skip_on_cran() + skip_if_not_installed("tabnet") + suppressPackageStartupMessages(library(parsnip)) + # Create model and fit + tabnet_fit <- tabnet::tabnet(epochs = 10) %>% + set_mode("regression") %>% + set_engine("torch") %>% + fit(mpg ~ ., data = mtcars) + + axed_out <- axe_fitted(tabnet_fit, verbose = TRUE) }) test_that("tabnet_fit + butcher() works", { + skip_on_cran() + skip_if_not_installed("tabnet") + suppressPackageStartupMessages(library(parsnip)) + # Create model and fit + tabnet_fit <- tabnet::tabnet(epochs = 10) %>% + set_mode("regression") %>% + set_engine("torch") %>% + fit(mpg ~ ., data = mtcars) + + tabnet_out <- butcher(tabnet_fit, verbose = TRUE) }) test_that("tabnet_fit + predict() works", { From a5e4c578905cf2f9cf404cb6adbc78f8126874b6 Mon Sep 17 00:00:00 2001 From: "C. Regouby" Date: Sat, 2 Jul 2022 14:43:15 +0200 Subject: [PATCH 3/6] add proper expect functions in tests remove axe_call and axe_ctrl that are not pertinent here --- NAMESPACE | 2 -- R/tabnet_fit.R | 41 +++----------------------------- man/axe-tabnet_fit.Rd | 10 -------- tests/testthat/test-tabnet_fit.R | 16 ++++++------- 4 files changed, 11 insertions(+), 58 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 59ffa90..208bead 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method(axe_call,"_tabnet_fit") S3method(axe_call,C5.0) S3method(axe_call,classbagg) S3method(axe_call,default) @@ -27,7 +26,6 @@ S3method(axe_call,survreg.penal) S3method(axe_call,train) S3method(axe_call,train.recipe) S3method(axe_call,xgb.Booster) -S3method(axe_ctrl,"_tabnet_fit") S3method(axe_ctrl,C5.0) S3method(axe_ctrl,default) S3method(axe_ctrl,ml_model) diff --git a/R/tabnet_fit.R b/R/tabnet_fit.R index 00ff43f..dc60577 100644 --- a/R/tabnet_fit.R +++ b/R/tabnet_fit.R @@ -29,50 +29,15 @@ #' @name axe-tabnet_fit NULL -#' Remove the call. -#' -#' @rdname axe-tabnet_fit -#' @export -axe_call._tabnet_fit <- function(x, verbose = FALSE, ...) { - old <- x - x <- exchange(x, "call", call("dummy_call")) - - add_butcher_attributes( - x, - old, - disabled = c("print()", "tabnet_explain()"), - add_class = FALSE, - verbose = verbose - ) -} - -#' Remove controls used for training. -#' -#' @rdname axe-tabnet_fit -#' @export -axe_ctrl._tabnet_fit <- function(x, verbose = FALSE, ...) { - old <- x - x <- exchange(x, "control", "???") - - add_butcher_attributes( - x, - old, - disabled = c("some_function()", "another_function()"), - add_class = FALSE, - verbose = verbose - ) -} - #' Remove fitted values. #' #' @rdname axe-tabnet_fit #' @export axe_fitted._tabnet_fit <- function(x, verbose = FALSE, ...) { old <- x - x <- exchange(x, "fit.checkpoints", list(NULL)) - x <- exchange(x, "fit.importances.variables", list(NULL)) - x <- exchange(x, "fit.importances.importance", list(NULL)) - x <- exchange(x, "fit.config", list(NULL)) + x$fit$fit <- exchange(x$fit$fit, "checkpoints", list(NULL)) + x$fit$fit$importances <- exchange(x$fit$fit$importances, "variables", list(NULL)) + x$fit$fit$importances <- exchange(x$fit$fit$importances, "importance", list(NULL)) add_butcher_attributes( x, diff --git a/man/axe-tabnet_fit.Rd b/man/axe-tabnet_fit.Rd index 07eff01..6293359 100644 --- a/man/axe-tabnet_fit.Rd +++ b/man/axe-tabnet_fit.Rd @@ -2,15 +2,9 @@ % Please edit documentation in R/tabnet_fit.R \name{axe-tabnet_fit} \alias{axe-tabnet_fit} -\alias{axe_call._tabnet_fit} -\alias{axe_ctrl._tabnet_fit} \alias{axe_fitted._tabnet_fit} \title{Axing a tabnet_fit.} \usage{ -\method{axe_call}{`_tabnet_fit`}(x, verbose = FALSE, ...) - -\method{axe_ctrl}{`_tabnet_fit`}(x, verbose = FALSE, ...) - \method{axe_fitted}{`_tabnet_fit`}(x, verbose = FALSE, ...) } \arguments{ @@ -28,10 +22,6 @@ Axed tabnet_fit object. \description{ Axing a tabnet_fit. -Remove the call. - -Remove controls used for training. - Remove fitted values. } \examples{ diff --git a/tests/testthat/test-tabnet_fit.R b/tests/testthat/test-tabnet_fit.R index 69445e4..c4de0a6 100644 --- a/tests/testthat/test-tabnet_fit.R +++ b/tests/testthat/test-tabnet_fit.R @@ -1,4 +1,4 @@ -test_that("tabnet_fit + axe_call() works", { +test_that("tabnet_fit + axe_fitted() works", { skip_on_cran() skip_if_not_installed("tabnet") suppressPackageStartupMessages(library(parsnip)) @@ -8,10 +8,11 @@ test_that("tabnet_fit + axe_call() works", { set_engine("torch") %>% fit(mpg ~ ., data = mtcars) - axed_out <- axe_call(tabnet_fit, verbose = TRUE) + expect_error(axed_out <- axe_fitted(tabnet_fit, verbose = TRUE), NA) + expect_lt(lobstr::obj_size(axed_out),lobstr::obj_size(tabnet_fit)) }) -test_that("tabnet_fit + axe_fitted() works", { +test_that("tabnet_fit + butcher() works", { skip_on_cran() skip_if_not_installed("tabnet") suppressPackageStartupMessages(library(parsnip)) @@ -21,10 +22,10 @@ test_that("tabnet_fit + axe_fitted() works", { set_engine("torch") %>% fit(mpg ~ ., data = mtcars) - axed_out <- axe_fitted(tabnet_fit, verbose = TRUE) + expect_error(tabnet_out <- butcher(tabnet_fit, verbose = TRUE), NA) }) -test_that("tabnet_fit + butcher() works", { +test_that("tabnet_fit + predict() works", { skip_on_cran() skip_if_not_installed("tabnet") suppressPackageStartupMessages(library(parsnip)) @@ -35,7 +36,6 @@ test_that("tabnet_fit + butcher() works", { fit(mpg ~ ., data = mtcars) tabnet_out <- butcher(tabnet_fit, verbose = TRUE) -}) - -test_that("tabnet_fit + predict() works", { + new_data <- as.matrix(mtcars[1:3, 2:11]) + expect_equal(predict(tabnet_out,new_data), predict(tabnet_fit, new_data)) }) From 648a777fe0a495a7f011ebb856e61c0b4f84b1b1 Mon Sep 17 00:00:00 2001 From: "C. Regouby" Date: Sat, 2 Jul 2022 14:49:50 +0200 Subject: [PATCH 4/6] revert those two Rd files --- man/axe-flexsurvreg.Rd | 24 ++++++++++++++++++++++++ man/axe-randomForest.Rd | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 61 insertions(+) diff --git a/man/axe-flexsurvreg.Rd b/man/axe-flexsurvreg.Rd index dcdb8a2..b0b1afe 100644 --- a/man/axe-flexsurvreg.Rd +++ b/man/axe-flexsurvreg.Rd @@ -29,3 +29,27 @@ parametric distributions. Users can define their own distribution, or leverage distributions like the generalized gamma, generalized F, and the Royston-Parmar spline model. } +\examples{ +\dontshow{if (rlang::is_installed("flexsurv")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# Load libraries +suppressWarnings(suppressMessages(library(parsnip))) +suppressWarnings(suppressMessages(library(flexsurv))) + +# Create model and fit +flexsurvreg_fit <- surv_reg(mode = "regression", dist = "gengamma") \%>\% + set_engine("flexsurv") \%>\% + fit(Surv(Tstart, Tstop, status) ~ trans, data = bosms3) + +out <- butcher(flexsurvreg_fit, verbose = TRUE) + +# Another flexsurvreg model object +wrapped_flexsurvreg <- function() { + some_junk_in_environment <- runif(1e6) + fit <- flexsurvreg(Surv(futime, fustat) ~ 1, + data = ovarian, dist = "weibull") + return(fit) +} + +out <- butcher(wrapped_flexsurvreg(), verbose = TRUE) +\dontshow{\}) # examplesIf} +} diff --git a/man/axe-randomForest.Rd b/man/axe-randomForest.Rd index db8eb13..03d7a01 100644 --- a/man/axe-randomForest.Rd +++ b/man/axe-randomForest.Rd @@ -31,3 +31,40 @@ package, which is used to train random forests based on Breiman's 2001 work. The package supports ensembles of classification and regression trees. } +\examples{ +\dontshow{if (rlang::is_installed("randomForest")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# Load libraries +suppressWarnings(suppressMessages(library(parsnip))) +suppressWarnings(suppressMessages(library(rsample))) +suppressWarnings(suppressMessages(library(rpart))) +suppressWarnings(suppressMessages(library(randomForest))) + +# Load data +set.seed(1234) +split <- initial_split(kyphosis, props = 9/10) +spine_train <- training(split) + +# Create model and fit +randomForest_fit <- rand_forest(mode = "classification", + mtry = 2, + trees = 2, + min_n = 3) \%>\% + set_engine("randomForest") \%>\% + fit_xy(x = spine_train[,2:4], y = spine_train$Kyphosis) + +out <- butcher(randomForest_fit, verbose = TRUE) + +# Another randomForest object +wrapped_rf <- function() { + some_junk_in_environment <- runif(1e6) + randomForest_fit <- randomForest(mpg ~ ., data = mtcars) + return(randomForest_fit) +} + +# Remove junk +cleaned_rf <- axe_env(wrapped_rf(), verbose = TRUE) + +# Check size +lobstr::obj_size(cleaned_rf) +\dontshow{\}) # examplesIf} +} From 7257f9a2979c97e20b2599d2c5883bd9b9b6e009 Mon Sep 17 00:00:00 2001 From: "C. Regouby" Date: Sat, 2 Jul 2022 14:51:32 +0200 Subject: [PATCH 5/6] update NEWS --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 1b60df4..480cf61 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # butcher (development version) +* Added butcher methods for `tabnet()` (@cregouby #226). + + # butcher 0.2.0 * Added an `axe_fitted()` method to butcher the `template` slot for prepped From 8b5cd49d4145ff1f87d385c4486e74838642c4ba Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Tue, 22 Nov 2022 12:22:32 -0700 Subject: [PATCH 6/6] Use `@examplesIf` --- R/tabnet_fit.R | 6 +----- man/axe-tabnet_fit.Rd | 7 ++----- 2 files changed, 3 insertions(+), 10 deletions(-) diff --git a/R/tabnet_fit.R b/R/tabnet_fit.R index dc60577..f5f06c4 100644 --- a/R/tabnet_fit.R +++ b/R/tabnet_fit.R @@ -4,9 +4,7 @@ #' #' @return Axed tabnet_fit object. #' -#' @examples -#' \donttest{ -#' if (rlang::is_installed("tabnet")) { +#' @examplesIf rlang::is_installed("tabnet") #' #' # Load libraries #' suppressWarnings(suppressMessages(library(parsnip))) @@ -24,8 +22,6 @@ #' #' out <- butcher(mtcar_fit, verbose = TRUE) #' -#' } -#' } #' @name axe-tabnet_fit NULL diff --git a/man/axe-tabnet_fit.Rd b/man/axe-tabnet_fit.Rd index 6293359..d2a8b26 100644 --- a/man/axe-tabnet_fit.Rd +++ b/man/axe-tabnet_fit.Rd @@ -25,8 +25,7 @@ Axing a tabnet_fit. Remove fitted values. } \examples{ -\donttest{ -if (rlang::is_installed("tabnet")) { +\dontshow{if (rlang::is_installed("tabnet")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # Load libraries suppressWarnings(suppressMessages(library(parsnip))) @@ -43,7 +42,5 @@ mtcar_fit <- tabnet() \%>\% fit(mpg ~ ., data = car_train) out <- butcher(mtcar_fit, verbose = TRUE) - -} -} +\dontshow{\}) # examplesIf} }