From 7e162c9f23fc55a63fac6f132c24038419a94416 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Wed, 26 Apr 2023 15:06:10 -0600 Subject: [PATCH] Fix docs (especially for `coxph`) and UI messaging (#261) * Add disclaimer for coxph (plus `markdown = TRUE`) * Adjust logic for UI messaging * Add test for UI logic * Redocument * Redact real object size for snapshots, just in case * More readable redaction * Fix abs value * No more quotes, which seem weird for numbers in a sentence * Render README --- DESCRIPTION | 1 + NEWS.md | 3 +++ R/coxph.R | 31 +++++++++++++++++++++++++++++++ R/ui.R | 25 ++++++++++++++----------- README.md | 2 +- man/axe-coxph.Rd | 29 +++++++++++++++++++++++++++++ man/axe-ipred.Rd | 4 ++-- man/axe-nested_model_fit.Rd | 2 +- man/axe-pls.Rd | 8 ++++---- man/butcher-package.Rd | 10 +++++----- man/butcher_example.Rd | 4 ++-- man/new_model_butcher.Rd | 10 +++++----- tests/testthat/_snaps/ui.md | 15 +++++++++++++++ tests/testthat/test-ui.R | 16 ++++++++++++++++ 14 files changed, 129 insertions(+), 31 deletions(-) create mode 100644 tests/testthat/_snaps/ui.md create mode 100644 tests/testthat/test-ui.R diff --git a/DESCRIPTION b/DESCRIPTION index 2d69c978..bf376e88 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -82,4 +82,5 @@ Config/Needs/check: bioc::mixOmics Config/testthat/edition: 3 Encoding: UTF-8 +Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 diff --git a/NEWS.md b/NEWS.md index 401dc4e0..8867f75c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,9 @@ * Updated methods for `mgcv::gam()` to also remove the `hat` and `offset` components (@rdavis120, #255). + +* Clarified the messaging for butchering results, as well as when butchering + may not work for `survival::coxph()` (#261). # butcher 0.3.2 diff --git a/R/coxph.R b/R/coxph.R index a2fe5782..3bdd4361 100644 --- a/R/coxph.R +++ b/R/coxph.R @@ -4,6 +4,37 @@ #' #' @return Axed coxph object. #' +#' @details +#' The [survival::coxph()] model is unique in how it uses environments in +#' its components, and butchering such an object can behave in surprising ways +#' in any environment other than the +#' [global environment](https://adv-r.hadley.nz/environments.html#important-environments) +#' (such as when wrapped in a function). We do not recommend that you use +#' `butcher()` with a `coxph` object anywhere other than the global environment. +#' +#' Do this: +#' +#' ```r +#' my_coxph_func <- function(df) { +#' coxph(Surv(time, status) ~ x + strata(covar), df) +#' } +#' ## in global environment only: +#' butcher(my_coxph_func(df)) +#' ``` +#' +#' Do *not* do this: +#' +#' ```r +#' my_coxph_func <- function(df) { +#' res <- coxph(Surv(time, status) ~ x + strata(covar), df) +#' ## no: +#' butcher(res) +#' } +#' +#' ## will not work correctly: +#' my_coxph_func(df) +#' ``` +#' #' @examplesIf rlang::is_installed("survival") #' library(survival) #' diff --git a/R/ui.R b/R/ui.R index d187764d..04ca41f6 100644 --- a/R/ui.R +++ b/R/ui.R @@ -15,13 +15,11 @@ memory_released <- function(og, butchered) { old <- lobstr::obj_size(og) new <- lobstr::obj_size(butchered) rel <- old - new - rel <- format(rel, big.mark = ",", scientific = FALSE) if (length(rel) == 1) { - if (rel <= 0) { + if (isTRUE(all.equal(old, new))) { return(NULL) - } else { - return(rel) } + return(rel) } else { return(NULL) } @@ -35,13 +33,18 @@ assess_object <- function(og, butchered) { if (is.null(mem)) { cli::cli_alert_danger("No memory released. Do not butcher.") } else { - cli::cli_alert_success("Memory released: {.val {mem}}") - if (!is.null(disabled)) { - cli::cli_alert_danger("Disabled: {.code {disabled}}") - } - if (length(class_added) == 0) { - class_name <- "butchered" - cli::cli_alert_danger("Could not add {.cls {class_name}} class") + abs_mem <- format(abs(mem), big.mark = ",", scientific = FALSE) + if (mem < 0) { + cli::cli_alert_danger("The butchered object is {.field {abs_mem}} larger than the original. Do not butcher.") + } else { + cli::cli_alert_success("Memory released: {.field {abs_mem}}") + if (!is.null(disabled)) { + cli::cli_alert_danger("Disabled: {.code {disabled}}") + } + if (length(class_added) == 0) { + class_name <- "butchered" + cli::cli_alert_danger("Could not add {.cls {class_name}} class") + } } } } diff --git a/README.md b/README.md index c8f844c0..c1b7f2ba 100644 --- a/README.md +++ b/README.md @@ -110,7 +110,7 @@ To remove this (mostly) extraneous component, we can use `axe_env()`: ``` r cleaned_lm <- butcher::axe_env(big_lm, verbose = TRUE) -#> ✔ Memory released: "8.03 MB" +#> ✔ Memory released: 8.03 MB ``` Comparing it against our `small_lm`, we’ll find: diff --git a/man/axe-coxph.Rd b/man/axe-coxph.Rd index ffaf92cb..d1289b67 100644 --- a/man/axe-coxph.Rd +++ b/man/axe-coxph.Rd @@ -25,6 +25,35 @@ Axed coxph object. \description{ Axing a coxph. } +\details{ +The \code{\link[survival:coxph]{survival::coxph()}} model is unique in how it uses environments in +its components, and butchering such an object can behave in surprising ways +in any environment other than the +\href{https://adv-r.hadley.nz/environments.html#important-environments}{global environment} +(such as when wrapped in a function). We do not recommend that you use +\code{butcher()} with a \code{coxph} object anywhere other than the global environment. + +Do this: + +\if{html}{\out{
}}\preformatted{my_coxph_func <- function(df) \{ + coxph(Surv(time, status) ~ x + strata(covar), df) +\} +## in global environment only: +butcher(my_coxph_func(df)) +}\if{html}{\out{
}} + +Do \emph{not} do this: + +\if{html}{\out{
}}\preformatted{my_coxph_func <- function(df) \{ + res <- coxph(Surv(time, status) ~ x + strata(covar), df) + ## no: + butcher(res) +\} + +## will not work correctly: +my_coxph_func(df) +}\if{html}{\out{
}} +} \examples{ \dontshow{if (rlang::is_installed("survival")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(survival) diff --git a/man/axe-ipred.Rd b/man/axe-ipred.Rd index e381b2e9..30b973c9 100644 --- a/man/axe-ipred.Rd +++ b/man/axe-ipred.Rd @@ -53,10 +53,10 @@ disabled. Default is \code{FALSE}.} \item{...}{Any additional arguments related to axing.} } \value{ -Axed `*_bagg` object. +Axed \verb{*_bagg} object. } \description{ -`*_bagg` objects are created from the \pkg{ipred} package, which +\verb{*_bagg} objects are created from the \pkg{ipred} package, which is used for bagging classification, regression and survival trees. } \examples{ diff --git a/man/axe-nested_model_fit.Rd b/man/axe-nested_model_fit.Rd index 34b6bfaf..d58db34f 100644 --- a/man/axe-nested_model_fit.Rd +++ b/man/axe-nested_model_fit.Rd @@ -55,5 +55,5 @@ butcher(fit) \dontshow{\}) # examplesIf} } \seealso{ -[axe-model_fit] +\link{axe-model_fit} } diff --git a/man/axe-pls.Rd b/man/axe-pls.Rd index a71233e4..61bd3e70 100644 --- a/man/axe-pls.Rd +++ b/man/axe-pls.Rd @@ -33,16 +33,16 @@ disabled. Default is \code{FALSE}.} \item{...}{Any additional arguments related to axing.} } \value{ -Axed `mixo_pls`, `mixo_spls`, or `mixo_plsda` object. +Axed \code{mixo_pls}, \code{mixo_spls}, or \code{mixo_plsda} object. } \description{ -`mixo_pls` (via `pls()`), `mixo_spls` (via `spls()`), and `mixo_plsda` -(via `plsda()`) objects are created with the mixOmics package, +\code{mixo_pls} (via \code{pls()}), \code{mixo_spls} (via \code{spls()}), and \code{mixo_plsda} +(via \code{plsda()}) objects are created with the mixOmics package, leveraged to fit partial least squares models. } \details{ The mixOmics package is not available on CRAN, but can be installed -from the Bioconductor repository via `remotes::install_bioc("mixOmics")`. +from the Bioconductor repository via \code{remotes::install_bioc("mixOmics")}. } \examples{ \dontshow{if (rlang::is_installed("mixOmics")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} diff --git a/man/butcher-package.Rd b/man/butcher-package.Rd index fdc150f8..6f4c3faf 100644 --- a/man/butcher-package.Rd +++ b/man/butcher-package.Rd @@ -13,11 +13,11 @@ should support additional analysis functions outside of just \code{predict}. This package provides five S3 generics: \itemize{ - \item \code{\link{axe_call}} To remove the call object. - \item \code{\link{axe_ctrl}} To remove controls associated with training. - \item \code{\link{axe_data}} To remove the original data. - \item \code{\link{axe_env}} To remove inherited environments. - \item \code{\link{axe_fitted}} To remove fitted values. +\item \code{\link{axe_call}} To remove the call object. +\item \code{\link{axe_ctrl}} To remove controls associated with training. +\item \code{\link{axe_data}} To remove the original data. +\item \code{\link{axe_env}} To remove inherited environments. +\item \code{\link{axe_fitted}} To remove fitted values. } These specific attributes of the model objects are chosen as they are diff --git a/man/butcher_example.Rd b/man/butcher_example.Rd index 7975d6c4..59b50c21 100644 --- a/man/butcher_example.Rd +++ b/man/butcher_example.Rd @@ -7,10 +7,10 @@ butcher_example(path = NULL) } \arguments{ -\item{path}{Name of file. If `NULL`, the example files will be listed.} +\item{path}{Name of file. If \code{NULL}, the example files will be listed.} } \description{ -butcher comes bundled with some example files in its `inst/extdata` +butcher comes bundled with some example files in its \code{inst/extdata} directory. This function was copied from readxl and placed here to make the instantiated model objects easy to access. } diff --git a/man/new_model_butcher.Rd b/man/new_model_butcher.Rd index d286b6ef..880eae9c 100644 --- a/man/new_model_butcher.Rd +++ b/man/new_model_butcher.Rd @@ -18,11 +18,11 @@ opens the new files for editing.} } \description{ \code{new_model_butcher()} will instantiate the following to help - us develop new axe functions around removing parts of a new - modeling object: +us develop new axe functions around removing parts of a new +modeling object: \itemize{ - \item Add modeling package to \code{Suggests} - \item Generate and populate an axe file under \code{R/} - \item Generate and populate an test file under \code{testthat/} +\item Add modeling package to \code{Suggests} +\item Generate and populate an axe file under \code{R/} +\item Generate and populate an test file under \code{testthat/} } } diff --git a/tests/testthat/_snaps/ui.md b/tests/testthat/_snaps/ui.md new file mode 100644 index 00000000..050c1b12 --- /dev/null +++ b/tests/testthat/_snaps/ui.md @@ -0,0 +1,15 @@ +# Generate expected UI messages + + Code + assess_object(big, small) + Message + v Memory released: + Code + assess_object(small, small) + Message + x No memory released. Do not butcher. + Code + assess_object(small, big) + Message + x The butchered object is larger than the original. Do not butcher. + diff --git a/tests/testthat/test-ui.R b/tests/testthat/test-ui.R new file mode 100644 index 00000000..08eeeec9 --- /dev/null +++ b/tests/testthat/test-ui.R @@ -0,0 +1,16 @@ +test_that("Generate expected UI messages", { + big <- runif(1e4) + big <- add_butcher_class(big) + small <- runif(1e3) + small <- add_butcher_class(small) + obj_size_diff <- lobstr::obj_size(big) - lobstr::obj_size(small) + obj_size_diff <- format(obj_size_diff, big.mark = ",", scientific = FALSE) + + expect_snapshot({ + assess_object(big, small) + assess_object(small, small) + assess_object(small, big) + }, + transform = function(x) gsub(obj_size_diff, "", x, fixed = TRUE) + ) +})