Added add_stat_label.tbl_ard_summary() method (ddsjoberg#1974)

* Added `add_stat_label.tbl_ard_summary()` method * fix: added snaps. Why were they absent? * Making AGEGR1 a factor --------- Co-authored-by: Melkiades <[email protected]>
jrob95 · Sep 16, 2024 · b8b3654 · b8b3654
1 parent fd4b156
commit b8b3654
Show file tree

Hide file tree

Showing 7 changed files with 215 additions and 1 deletion.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: gtsummary
 Title: Presentation-Ready Data Summary and Analytic Result Tables
-Version: 2.0.2.9002
+Version: 2.0.2.9003
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0862-2018")),

diff --git a/NAMESPACE b/NAMESPACE
@@ -25,6 +25,7 @@ S3method(add_p,tbl_cross)
 S3method(add_p,tbl_summary)
 S3method(add_p,tbl_survfit)
 S3method(add_p,tbl_svysummary)
+S3method(add_stat_label,tbl_ard_summary)
 S3method(add_stat_label,tbl_summary)
 S3method(add_stat_label,tbl_svysummary)
 S3method(as.data.frame,gtsummary)

diff --git a/NEWS.md b/NEWS.md
@@ -4,6 +4,8 @@
 
 * Removed the `"tbl_summary-arg:statistic"` theme that was incorrectly added to `tbl_continuous()`.
 
+* Added `add_stat_label.tbl_ard_summary()` method. (#1969)
+
 # gtsummary 2.0.2
 
 Updates to address regressions in the v2.0.0 release:

diff --git a/R/add_stat_label.R b/R/add_stat_label.R
@@ -233,6 +233,10 @@ add_stat_label.tbl_summary <- function(x, location = c("row", "column"), label =
 #' @rdname add_stat_label
 add_stat_label.tbl_svysummary <- add_stat_label.tbl_summary
 
+#' @export
+#' @rdname add_stat_label
+add_stat_label.tbl_ard_summary <- add_stat_label.tbl_summary
+
 .add_stat_label_default_label_arg <- function(x, statistic) {
   statistic |>
     imap(

diff --git a/man/add_stat_label.Rd b/man/add_stat_label.Rd
diff --git a/tests/testthat/_snaps/add_stat_label.tbl_ard_summary.md b/tests/testthat/_snaps/add_stat_label.tbl_ard_summary.md
@@ -0,0 +1,92 @@
+# add_stat_label(location='row') standard use
+
+    Code
+      as.data.frame(modify_column_hide(add_stat_label(tbl_ard, location = "row"),
+      all_stat_cols()))
+    Output
+          **Characteristic**
+      1        AGEGR1, n (%)
+      2                  <65
+      3                65-80
+      4                  >80
+      5 Age, Median (Q1, Q3)
+
+# add_stat_label(location='column') standard use
+
+    Code
+      as.data.frame(modify_column_hide(add_stat_label(tbl_ard, location = "column"),
+      all_stat_cols()))
+    Output
+        **Characteristic**   **Statistic**
+      1             AGEGR1            <NA>
+      2                <65           n (%)
+      3              65-80           n (%)
+      4                >80           n (%)
+      5                Age Median (Q1, Q3)
+
+---
+
+    Code
+      as.data.frame(modify_column_hide(add_stat_label(tbl_ard, location = "column",
+        label = all_categorical() ~ "no. (%)"), all_stat_cols()))
+    Output
+        **Characteristic**   **Statistic**
+      1             AGEGR1            <NA>
+      2                <65         no. (%)
+      3              65-80         no. (%)
+      4                >80         no. (%)
+      5                Age Median (Q1, Q3)
+
+# add_stat_label(label) standard use
+
+    Code
+      as.data.frame(add_stat_label(tbl_ard_summary(cards::ard_stack(data = cards::ADSL,
+      cards::ard_categorical(variables = "AGEGR1"), cards::ard_continuous(variables = "AGE"),
+      .attributes = TRUE, .missing = TRUE, .total_n = TRUE), type = all_continuous() ~
+        "continuous2", statistic = all_continuous() ~ c("{median} ({p25}, {p75})",
+        "{min} - {max}")), label = AGE ~ c("Median (IQR)", "Range")))
+    Output
+               **Characteristic**       **Overall**
+      1 Pooled Age Group 1, n (%)              <NA>
+      2                     65-80       144 (56.7%)
+      3                       <65        33 (13.0%)
+      4                       >80        77 (30.3%)
+      5                       Age              <NA>
+      6              Median (IQR) 77.0 (70.0, 81.0)
+      7                     Range       51.0 - 89.0
+
+# add_stat_label(label) messaging
+
+    Code
+      add_stat_label(tbl_ard_summary(cards::ard_stack(data = cards::ADSL, cards::ard_categorical(
+        variables = "AGEGR1"), cards::ard_continuous(variables = "AGE"), .attributes = TRUE,
+      .missing = TRUE, .total_n = TRUE), type = all_continuous() ~ "continuous2",
+      statistic = all_continuous() ~ c("{median} ({p25}, {p75})", "{min} - {max}")),
+      label = AGE ~ letters)
+    Condition
+      Error in `add_stat_label()`:
+      ! The element of the `label` argument for variable "AGE" must be a string of length 2.
+
+---
+
+    Code
+      add_stat_label(tbl_ard_summary(cards::ard_stack(data = cards::ADSL, cards::ard_categorical(
+        variables = "AGEGR1"), cards::ard_continuous(variables = "AGE"), .attributes = TRUE,
+      .missing = TRUE, .total_n = TRUE), type = all_continuous() ~ "continuous2",
+      statistic = all_continuous() ~ c("{median} ({p25}, {p75})", "{min} - {max}")),
+      label = AGE ~ c("Median (IQR)", "Range", "TOO LONG!"))
+    Condition
+      Error in `add_stat_label()`:
+      ! The element of the `label` argument for variable "AGE" must be a string of length 2.
+
+# add_stat_label() messaging
+
+    Code
+      invisible(add_stat_label(add_stat_label(tbl_ard_summary(cards::ard_stack(data = cards::ADSL,
+      cards::ard_categorical(variables = "AGEGR1"), cards::ard_continuous(variables = "AGE"),
+      .attributes = TRUE, .missing = TRUE, .total_n = TRUE), type = all_continuous() ~
+        "continuous2", statistic = all_continuous() ~ c("{median} ({p25}, {p75})",
+        "{min} - {max}")))))
+    Message
+      `add_stat_label()` has previously been applied. Returning gtsummary table unaltered.
+
diff --git a/tests/testthat/test-add_stat_label.tbl_ard_summary.R b/tests/testthat/test-add_stat_label.tbl_ard_summary.R
@@ -0,0 +1,112 @@
+skip_on_cran()
+skip_if_not(is_pkg_installed("survey", reference_pkg = "gtsummary"))
+
+tbl_ard <- cards::ard_stack(
+  data = cards::ADSL |> dplyr::mutate(AGEGR1 = factor(AGEGR1, levels = c("<65", "65-80", ">80"))),
+  cards::ard_categorical(variables = "AGEGR1"),
+  cards::ard_continuous(variables = "AGE"),
+  .attributes = TRUE,
+  .missing = TRUE,
+  .total_n = TRUE
+) |>
+  tbl_ard_summary()
+
+test_that("add_stat_label(location='row') standard use", {
+  expect_snapshot(
+    tbl_ard |>
+      add_stat_label(location='row') |>
+      modify_column_hide(all_stat_cols()) |>
+      as.data.frame()
+  )
+})
+
+test_that("add_stat_label(location='column') standard use", {
+  expect_snapshot(
+    tbl_ard |>
+      add_stat_label(location='column') |>
+      modify_column_hide(all_stat_cols()) |>
+      as.data.frame()
+  )
+
+  expect_snapshot(
+    tbl_ard |>
+      add_stat_label(location = "column", label = all_categorical() ~ "no. (%)") |>
+      modify_column_hide(all_stat_cols()) |>
+      as.data.frame()
+  )
+})
+
+test_that("add_stat_label(label) standard use", {
+  expect_snapshot(
+    cards::ard_stack(
+      data = cards::ADSL,
+      cards::ard_categorical(variables = "AGEGR1"),
+      cards::ard_continuous(variables = "AGE"),
+      .attributes = TRUE,
+      .missing = TRUE,
+      .total_n = TRUE
+    ) |>
+      tbl_ard_summary(
+        type = all_continuous() ~ "continuous2",
+        statistic = all_continuous() ~ c("{median} ({p25}, {p75})", "{min} - {max}")
+      ) |>
+      add_stat_label(label = AGE ~ c("Median (IQR)", "Range")) |>
+      as.data.frame()
+  )
+})
+
+test_that("add_stat_label(label) messaging", {
+  expect_snapshot(
+    error = TRUE,
+    cards::ard_stack(
+      data = cards::ADSL,
+      cards::ard_categorical(variables = "AGEGR1"),
+      cards::ard_continuous(variables = "AGE"),
+      .attributes = TRUE,
+      .missing = TRUE,
+      .total_n = TRUE
+    ) |>
+      tbl_ard_summary(
+        type = all_continuous() ~ "continuous2",
+        statistic = all_continuous() ~ c("{median} ({p25}, {p75})", "{min} - {max}")
+      ) |>
+      add_stat_label(label = AGE ~ letters)
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    cards::ard_stack(
+      data = cards::ADSL,
+      cards::ard_categorical(variables = "AGEGR1"),
+      cards::ard_continuous(variables = "AGE"),
+      .attributes = TRUE,
+      .missing = TRUE,
+      .total_n = TRUE
+    ) |>
+      tbl_ard_summary(
+        type = all_continuous() ~ "continuous2",
+        statistic = all_continuous() ~ c("{median} ({p25}, {p75})", "{min} - {max}")
+      ) |>
+      add_stat_label(label = AGE ~ c("Median (IQR)", "Range", "TOO LONG!"))
+  )
+})
+
+test_that("add_stat_label() messaging", {
+  expect_snapshot(
+    cards::ard_stack(
+      data = cards::ADSL,
+      cards::ard_categorical(variables = "AGEGR1"),
+      cards::ard_continuous(variables = "AGE"),
+      .attributes = TRUE,
+      .missing = TRUE,
+      .total_n = TRUE
+    ) |>
+      tbl_ard_summary(
+        type = all_continuous() ~ "continuous2",
+        statistic = all_continuous() ~ c("{median} ({p25}, {p75})", "{min} - {max}")
+      ) |>
+      add_stat_label() |>
+      add_stat_label() |>
+      invisible()
+  )
+})