Updated show_header_names() output format (ddsjoberg#1953)

* add unit tests for new `show_header_names()` output

* add_difference.tbl_summary() snaps

* updating `show_header_names()

* Update modify.R

* updates

---------

Co-authored-by: ayogasekaram <[email protected]>

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gtsummary
 Title: Presentation-Ready Data Summary and Analytic Result Tables
-Version: 2.0.1.9012
+Version: 2.0.1.9013
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0862-2018")),
@@ -45,7 +45,7 @@ BugReports: https://github.com/ddsjoberg/gtsummary/issues
 Depends: 
     R (>= 4.2)
 Imports: 
-    cards (>= 0.2.1.9017),
+    cards (>= 0.2.2),
     cli (>= 3.6.1),
     dplyr (>= 1.1.3),
     glue (>= 1.6.2),
@@ -60,7 +60,7 @@ Suggests:
     broom.helpers (>= 1.17.0),
     broom.mixed (>= 0.2.9),
     car (>= 3.0-11),
-    cardx (>= 0.2.0.9008),
+    cardx (>= 0.2.1),
     cmprsk,
     effectsize (>= 0.6.0),
     emmeans (>= 1.7.3),
@@ -85,7 +85,6 @@ Suggests:
     testthat (>= 3.2.0),
     withr (>= 2.5.0),
     workflows (>= 0.2.4)
-Remotes: insightsengineering/cards, insightsengineering/cardx
 VignetteBuilder: 
     knitr
 RdMacros: 

NEWS.md

@@ -28,6 +28,8 @@ Updates to address regressions in the v2.0.0 release:
 
 * Fix where error or warning condition messages containing curly brace pairs could not be printed.
 
+* Updated the `show_header_names()` output to include the values that may be dynamically placed in the headers. Additionally, the `include_example` and `quiet` arguments have been deprecated. (#1696)
+
 # gtsummary 2.0.1
 
 Updates to address regressions in the v2.0.0 release:

R/modify.R

@@ -27,9 +27,8 @@
 #' @param text_interpret (`string`)\cr
 #'   String indicates whether text will be interpreted with
 #'   [`gt::md()`] or [`gt::html()`]. Must be `"md"` (default) or `"html"`.
-#' @param include_example (scalar `logical`)\cr
-#   Logical whether to include print of `modify_header()` example
 #' @param update,quiet `r lifecycle::badge("deprecated")`
+#' @param include_example `r lifecycle::badge("deprecated")`
 #'
 #' @author Daniel D. Sjoberg
 #'
@@ -225,36 +224,54 @@ modify_spanning_header <- function(x, ..., text_interpret = c("md", "html"),
 
 #' @name modify
 #' @export
-show_header_names <- function(x = NULL, include_example = TRUE, quiet = NULL) {
-  # setting defaults -----------------------------------------------------------
-  quiet <- quiet %||% get_theme_element("pkgwide-lgl:quiet") %||% FALSE
-
+show_header_names <- function(x, include_example, quiet) {
   # checking input -------------------------------------------------------------
   check_class(x, "gtsummary")
 
-  df_cols <-
-    x$table_styling$header %>%
-    dplyr::filter(.data$hide == FALSE) %>%
-    dplyr::select("column", "label")
-
-  if (identical(quiet, FALSE) && isTRUE(include_example)) {
-    cat("\n")
-    cli::cli_alert_info("As a usage guide, the code below re-creates the current column headers.")
-    block <- dplyr::mutate(df_cols, formula = glue("  {column} = {shQuote(label)}")) %>%
-      dplyr::pull("formula") %>%
-      paste0("", collapse = ",\n") %>%
-      {
-        glue("modify_header(\n{.}\n)")
-      }
-
-    cli::cli_code(block)
+  # deprecated arguments -------------------------------------------------------
+  if (!missing(include_example)) {
+    lifecycle::deprecate_warn(
+      when = "2.0.0",
+      what = "gtsummary::show_header_names(include_example)",
+      details = "Argument has been ignored."
+    )
+  }
+  if (!missing(quiet)) {
+    lifecycle::deprecate_warn(
+      when = "2.0.0",
+      what = "gtsummary::show_header_names(quiet)",
+      details = "Argument has been ignored."
+    )
   }
-  if (identical(quiet, FALSE)) {
-    knitr::kable(df_cols, col.names = c("Column Name", "Column Header"), format = "pandoc") %>%
-      print()
+
+  # printing info --------------------------------------------------------------
+  df_print <-
+    x$table_styling$header |>
+    dplyr::filter(!.data$hide) |>
+    dplyr::select("column", "label", starts_with("modify_stat_"))
+
+  # if any columns begin with 'modify_stat_', then rename
+  if (any(str_detect(names(df_print), "^modify_stat_"))) {
+    df_print <- df_print |>
+      dplyr::rename_with(
+        .fn = ~ str_remove(., pattern = "^modify_stat_")|> paste0("*"),
+        .cols = starts_with("modify_stat_")
+      )
   }
 
-  return(invisible(df_cols))
+  df_print |>
+    dplyr::mutate(
+      across(where(is.integer), label_style_number()),
+      across(where(is.numeric), label_style_sigfig(digits = 3)),
+      across(-c(where(is.integer) | where(is.numeric)), as.character),
+      label = cli::cli_format(.data$label)
+    ) |>
+    tibble_as_cli(label = list(column = "Column Name", label = "Header"))
+
+  cat("\n")
+  cli::cli_inform(c("* These values may be dynamically placed into headers (and other locations).",
+                    "i" = "Review the {.help [{.fun modify_header}](gtsummary::modify)} help for examples."))
+
 }
 
 .evaluate_string_with_glue <- function(x, dots) {

tests/testthat/_snaps/show_header_names.md

@@ -1,26 +1,60 @@
-# show_header_names() works
+# show_header_names() works with tbl_summary()
 
     Code
       show_header_names(tbl_summary(trial, include = age, by = trt, missing = "no"))
     Output
+      Column Name   Header                    level*   N*    n*    p*       
+      label         "**Characteristic**"               200                  
+      stat_1        "**Drug A**  \nN = 98"    Drug A   200   98    0.490    
+      stat_2        "**Drug B**  \nN = 102"   Drug B   200   102   0.510    
       
     Message
-      i As a usage guide, the code below re-creates the current column headers.
-      modify_header(
-        label = '**Characteristic**',
-        stat_1 = '**Drug A**  
-      N = 98',
-        stat_2 = '**Drug B**  
-      N = 102'
-      )
+      * These values may be dynamically placed into headers (and other locations).
+      i Review the `modify_header()` (`?gtsummary::modify()`) help for examples.
+
+# show_header_names() works with tbl_regression
+
+    Code
+      show_header_names(tbl_regression(mod_logistic))
     Output
+      Column Name   Header                 N*    N_event*    
+      label         "**Characteristic**"   183   58.0        
+      estimate      "**log(OR)**"          183   58.0        
+      conf.low      "**95% CI**"           183   58.0        
+      p.value       "**p-value**"          183   58.0        
       
+    Message
+      * These values may be dynamically placed into headers (and other locations).
+      i Review the `modify_header()` (`?gtsummary::modify()`) help for examples.
+
+# show_header_names() works with tbl_uvregression
+
+    Code
+      show_header_names(tbl_uvregression(trial, x = trt, include = c(marker, age),
+      show_single_row = trt, method = lm))
+    Output
+      Column Name   Header           
+      label         "**Outcome**"    
+      stat_n        "**N**"          
+      estimate      "**Beta**"       
+      conf.low      "**95% CI**"     
+      p.value       "**p-value**"    
       
-      Column Name   Column Header       
-      ------------  --------------------
-      label         **Characteristic**  
-      stat_1        **Drug A**  
-      N = 98  
-      stat_2        **Drug B**  
-      N = 102 
+    Message
+      * These values may be dynamically placed into headers (and other locations).
+      i Review the `modify_header()` (`?gtsummary::modify()`) help for examples.
+
+# show_header_names() works with tbl_survfit
+
+    Code
+      show_header_names(tbl_survfit(trial, include = trt, y = "Surv(ttdeath, death)",
+        probs = 0.5))
+    Output
+      Column Name   Header                 prob*    
+      label         "**Characteristic**"            
+      stat_1        "**50% Percentile**"   0.500    
+      
+    Message
+      * These values may be dynamically placed into headers (and other locations).
+      i Review the `modify_header()` (`?gtsummary::modify()`) help for examples.
 

tests/testthat/test-show_header_names.R

@@ -1,8 +1,39 @@
-skip_on_os("windows")
-
-test_that("show_header_names() works", {
+test_that("show_header_names() works with tbl_summary()", {
   expect_snapshot(
     tbl_summary(trial, include = age, by = trt, missing = "no") |>
       show_header_names()
   )
 })
+
+test_that("show_header_names() works with tbl_regression", {
+  mod_logistic <- glm(response ~ age + stage, trial, family = binomial)
+  expect_snapshot(
+    tbl_regression(mod_logistic) |>
+      show_header_names()
+  )
+})
+
+test_that("show_header_names() works with tbl_uvregression", {
+  expect_snapshot(
+    tbl_uvregression(
+      trial,
+      x = trt,
+      include = c(marker, age),
+      show_single_row = trt,
+      method = lm
+    )|>
+      show_header_names()
+  )
+})
+
+test_that("show_header_names() works with tbl_survfit", {
+  expect_snapshot(
+    trial |>
+      tbl_survfit(
+        include = trt,
+        y = "Surv(ttdeath, death)",
+        probs = 0.5
+      )|>
+      show_header_names()
+  )
+})