adding jama styling to tbl_svysummary()

ddsjoberg · Oct 21, 2024 · d1552ed · d1552ed
1 parent 09015d4
commit d1552ed
Show file tree

Hide file tree

Showing 3 changed files with 44 additions and 0 deletions.
diff --git a/R/theme_gtsummary.R b/R/theme_gtsummary.R
@@ -84,6 +84,8 @@ theme_gtsummary_journal <- function(journal = c("jama", "lancet", "nejm", "qjeco
         "add_stat_label-arg:location" = "row",
         "tbl_summary-arg:statistic" = list(all_continuous() ~ "{median} ({p25} \U2013 {p75})",
                                            all_categorical() ~ "{n} ({p})"),
+        "tbl_svysummary-arg:statistic" = list(all_continuous() ~ "{median} ({p25} \U2013 {p75})",
+                                           all_categorical() ~ "{n} ({p})"),
         "tbl_summary-fn:addnl-fn-to-run" = function(x) {
           add_stat_label(x) |>
             modify_table_body(
@@ -95,6 +97,17 @@ theme_gtsummary_journal <- function(journal = c("jama", "lancet", "nejm", "qjeco
               }
             )
         },
+        "tbl_svysummary-fn:addnl-fn-to-run" = function(x) {
+          add_stat_label(x) |>
+            modify_table_body(
+              \(x) {
+                if ("stat_label" %in% names(x)) {
+                  x$stat_label <- gsub("Q1 \U2013 Q3", "IQR", x = x$stat_label)
+                }
+                x
+              }
+            )
+        },
         "add_difference-fn:addnl-fn-to-run" = function(x) {
           # merging coef and CI columns, if error, returning x unaltered
           tryCatch(

diff --git a/tests/testthat/_snaps/theme_gtsummary.md b/tests/testthat/_snaps/theme_gtsummary.md
@@ -70,6 +70,20 @@
         **Characteristic** **Beta** **(95% CI)** **p-value**
       1                 am       -33 (-83 to 16)        0.18
 
+---
+
+    Code
+      with_gtsummary_theme(theme_gtsummary_journal("jama"), expr = as.data.frame(
+        modify_column_hide(add_difference(tbl_svysummary(svy_trial, by = trt,
+          include = age, label = age ~ "Age", missing = "no")), c("stat_2"))))
+    Message
+      Setting theme "JAMA"
+    Output
+        **Characteristic** **Drug A**  \nN = 98 **Difference** **(****95% CI****)**
+      1  Age, Median (IQR)         46 (37 – 60)                  0.44 (-3.7 to 4.6)
+        **p-value**
+      1        0.83
+
 # theme_gtsummary_journal('qjecon') works
 
     Code

diff --git a/tests/testthat/test-theme_gtsummary.R b/tests/testthat/test-theme_gtsummary.R
@@ -233,6 +233,23 @@ test_that("theme_gtsummary_journal('jama') works", {
     ),
     "-33 (95% CI -83, 16; p=0.18)"
   )
+
+  svy_trial <- survey::svydesign(~1, data = trial, weights = ~1)
+  # check that we get
+  #  - IQR separated with emdash in table
+  #  - pvalues are rounded to 2 places
+  #  - CI separator is " to "
+  #  - estimate and CI are in the same cell with appropriate header
+  expect_snapshot(
+    with_gtsummary_theme(
+      theme_gtsummary_journal("jama"),
+      expr = svy_trial |>
+        tbl_svysummary(by = trt, include = age, label = age ~ "Age", missing = "no") |>
+        add_difference() |>
+        modify_column_hide(c("stat_2"))|>
+        as.data.frame()
+    )
+  )
 })
 
 test_that("theme_gtsummary_journal('qjecon') works", {