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

@@ -82,4 +82,5 @@ Config/Needs/check:
     bioc::mixOmics
 Config/testthat/edition: 3
 Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3

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
 

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)
 #'

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")
+      }
     }
   }
 }

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:

tests/testthat/_snaps/ui.md

@@ -0,0 +1,15 @@
+# Generate expected UI messages
+
+    Code
+      assess_object(big, small)
+    Message
+      v Memory released: <redacted>
+    Code
+      assess_object(small, small)
+    Message
+      x No memory released. Do not butcher.
+    Code
+      assess_object(small, big)
+    Message
+      x The butchered object is <redacted> larger than the original. Do not butcher.
+

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, "<redacted>", x, fixed = TRUE)
+  )
+})