tolerate gtsummary in save_txt

Author: BFalquet

R/save_as_txt.R

@@ -14,9 +14,13 @@ create_yaml_header_txt <- function(object_path, pkg_to_attach) {
     "knitr::opts_chunk$set(echo = FALSE, message = FALSE)",
     paste0("library(", pkg_to_attach, ")"),
     paste("x <-", rlang::call2("readRDS", file = as.character(object_path)) |> rlang::expr_deparse(width = Inf)),
-    "if (!inherits(x, 'list') || inherits(x, 'gt_tbl')) x <- list(x)",
+    "if (!inherits(x, 'list') || inherits(x, 'gt_tbl') || inherits(x, 'gtsummary')) x <- list(x)",
     "as_kable_txt <- function(obj) {",
-    "  knitr::kable(gt:::dt_data_get(obj))",
+    "  if (inherits(obj, 'gtsummary')) {",
+    "    gtsummary::as_kable(obj)",
+    "  } else {",
+    "    knitr::kable(gt:::dt_data_get(obj))",
+    "  }",
     "}",
     "```",
     ""
@@ -69,11 +73,11 @@ save_txt_with_rmarkdown <- function(x,
   # convert path to absolute path to ensure output is created in the correct location
   path <- normalizePath(path, winslash = "/", mustWork = FALSE)
 
-  # txt output only supports gt_tbl objects
-  check_class(x, cls = c("gt_tbl", "list"))
-  if (is_simple_list(x) && some(x, ~ !inherits(.x, "gt_tbl"))) {
+  # txt output supports gt_tbl and gtsummary objects
+  check_class(x, cls = c("gt_tbl", "gtsummary", "list"))
+  if (is_simple_list(x) && some(x, ~ !inherits(.x, c("gt_tbl", "gtsummary")))) {
     cli::cli_abort(
-      "When argument {.arg x} is a list, each list element must be of class {.cls gt_tbl}.",
+      "When argument {.arg x} is a list, each list element must be of class {.cls gt_tbl} or {.cls gtsummary}.",
       call = get_cli_abort_call()
     )
   }
@@ -84,8 +88,10 @@ save_txt_with_rmarkdown <- function(x,
   # save the input object to a tempfile (which will be loaded in the rmd file) -
   saveRDS(x, file = temp_file_x)
 
-  # gt package is always attached for gt_tbl objects
-  pkg_to_attach <- "gt"
+  # determine which packages need to be attached based on object class(es)
+  x_list <- if (is_simple_list(x)) x else list(x)
+  has_gtsummary <- some(x_list, ~ inherits(.x, "gtsummary"))
+  pkg_to_attach <- if (has_gtsummary) c("gt", "gtsummary") else "gt"
 
   # string of the yaml header and chunks
   chr_rmarkdown_yaml <- create_yaml_header_txt(temp_file_x, pkg_to_attach)
@@ -120,11 +126,14 @@ save_txt_with_rmarkdown <- function(x,
 
 #' Save as txt (plain text / Markdown)
 #'
-#' Save a `gt_tbl` object as a plain text (Markdown-formatted) file via R markdown.
-#' Only `gt_tbl` objects (from the gt package) are supported for plain text output.
+#' Save a `gt_tbl` or `gtsummary` object as a plain text (Markdown-formatted)
+#' file via R markdown. Both `gt_tbl` objects (from the gt package) and
+#' `gtsummary` objects are supported for plain text output.
 #'
-#' @param x (`gt_tbl`/`list`)\cr
-#'   object of class `'gt_tbl'` (gt table), or a list of `'gt_tbl'` objects.
+#' @param x (`gt_tbl`/`gtsummary`/`list`)\cr
+#'   object of class `'gt_tbl'` (gt table) or `'gtsummary'`, or a list of
+#'   such objects. Lists may contain a mix of `'gt_tbl'` and `'gtsummary'`
+#'   objects.
 #' @param path (`path`)\cr
 #'   path to save file to, e.g. `"rendered_table.txt"` or `"rendered_table.md"`.
 #' @param encoding (`string`)\cr

tests/testthat/_snaps/save_as_txt.md

@@ -28,21 +28,21 @@
       save_txt(x = "not_a_table", path = tempfile(fileext = ".txt"))
     Condition
       Error in `save_txt()`:
-      ! The `x` argument must be class <gt_tbl/list>, not a string.
+      ! The `x` argument must be class <gt_tbl/gtsummary/list>, not a string.
 
 ---
 
     Code
       save_txt(list("a", "b"), path = tempfile(fileext = ".txt"))
     Condition
       Error in `save_txt()`:
-      ! When argument `x` is a list, each list element must be of class <gt_tbl>.
+      ! When argument `x` is a list, each list element must be of class <gt_tbl> or <gtsummary>.
 
-# save_txt() fails with non-gt_tbl objects
+# save_txt() fails with non-gt_tbl/gtsummary objects
 
     Code
       save_txt(ft, path = tempfile(fileext = ".txt"))
     Condition
       Error in `save_txt()`:
-      ! The `x` argument must be class <gt_tbl/list>, not a <flextable> object.
+      ! The `x` argument must be class <gt_tbl/gtsummary/list>, not a <flextable> object.
 

tests/testthat/test-save_as_txt.R

@@ -1,5 +1,10 @@
 gt_tbl_single <- gt::gt(head(mtcars))
 gt_tbl_list <- list(gt::gt(head(mtcars)), gt::gt(tail(mtcars)))
+gtsummary_single <- gtsummary::tbl_summary(gtsummary::trial[, c("age", "trt")])
+gtsummary_list <- list(
+  gtsummary::tbl_summary(gtsummary::trial[, c("age", "trt")]),
+  gtsummary::tbl_summary(gtsummary::trial[, c("grade", "trt")])
+)
 
 test_that("save_txt() works with a single gt_tbl", {
   file_path <- tempfile(fileext = ".txt")
@@ -15,7 +20,7 @@ test_that("save_txt() works with a single gt_tbl", {
   # setup chunk attaches gt
   expect_match(res[9], "library(gt)", fixed = TRUE)
   # first table chunk renders correctly
-  expect_match(res[19], "as_kable_txt(x[[1]])", fixed = TRUE)
+  expect_match(res[23], "as_kable_txt(x[[1]])", fixed = TRUE)
 })
 
 test_that("save_txt() works with a list of gt_tbl objects", {
@@ -32,8 +37,8 @@ test_that("save_txt() works with a list of gt_tbl objects", {
   # setup chunk attaches gt
   expect_match(res[9], "library(gt)", fixed = TRUE)
   # both table chunks rendered
-  expect_match(res[19], "as_kable_txt(x[[1]])", fixed = TRUE)
-  expect_match(res[25], "as_kable_txt(x[[2]])", fixed = TRUE)
+  expect_match(res[23], "as_kable_txt(x[[1]])", fixed = TRUE)
+  expect_match(res[29], "as_kable_txt(x[[2]])", fixed = TRUE)
 })
 
 test_that("save_txt() fails with incorrect inputs", {
@@ -63,7 +68,7 @@ test_that("save_txt() fails with incorrect inputs", {
   )
 })
 
-test_that("save_txt() fails with non-gt_tbl objects", {
+test_that("save_txt() fails with non-gt_tbl/gtsummary objects", {
   # flextable is not supported for txt output
   skip_if_not_installed("flextable")
   ft <- flextable::flextable(head(mtcars))
@@ -82,3 +87,69 @@ test_that("save_txt() works with .md extension", {
   )
   expect_true(file.exists(file_path))
 })
+
+test_that("save_txt() works with a single gtsummary object", {
+  skip_if_not_installed("gtsummary")
+  file_path <- tempfile(fileext = ".txt")
+  expect_error(
+    res <- gtsummary_single |>
+      save_txt(path = file_path),
+    NA
+  )
+  expect_true(file.exists(file_path))
+
+  # YAML header uses md_document output
+  expect_match(res[3], "md_document", fixed = TRUE)
+  # setup chunk attaches both gt and gtsummary
+  expect_match(res[9], "library(gt)", fixed = TRUE)
+  expect_match(res[10], "library(gtsummary)", fixed = TRUE)
+  # as_kable_txt dispatches on gtsummary class
+  expect_match(res, "gtsummary::as_kable(obj)", fixed = TRUE, all = FALSE)
+  # first table chunk renders correctly
+  expect_match(res[length(res) - 1L], "as_kable_txt(x[[1]])", fixed = TRUE)
+})
+
+test_that("save_txt() works with a list of gtsummary objects", {
+  skip_if_not_installed("gtsummary")
+  file_path <- tempfile(fileext = ".txt")
+  expect_error(
+    res <- gtsummary_list |>
+      save_txt(path = file_path),
+    NA
+  )
+  expect_true(file.exists(file_path))
+
+  # both gt and gtsummary attached
+  expect_match(res[9], "library(gt)", fixed = TRUE)
+  expect_match(res[10], "library(gtsummary)", fixed = TRUE)
+  # both table chunks rendered
+  expect_match(res, "as_kable_txt(x[[1]])", fixed = TRUE, all = FALSE)
+  expect_match(res, "as_kable_txt(x[[2]])", fixed = TRUE, all = FALSE)
+})
+
+test_that("save_txt() works with a mixed list of gt_tbl and gtsummary objects", {
+  skip_if_not_installed("gtsummary")
+  mixed_list <- list(gt_tbl_single, gtsummary_single)
+  file_path <- tempfile(fileext = ".txt")
+  expect_error(
+    res <- mixed_list |>
+      save_txt(path = file_path),
+    NA
+  )
+  expect_true(file.exists(file_path))
+
+  # both packages attached because list contains a gtsummary object
+  expect_match(res[9], "library(gt)", fixed = TRUE)
+  expect_match(res[10], "library(gtsummary)", fixed = TRUE)
+  # both chunks present
+  expect_match(res, "as_kable_txt(x[[1]])", fixed = TRUE, all = FALSE)
+  expect_match(res, "as_kable_txt(x[[2]])", fixed = TRUE, all = FALSE)
+})
+
+test_that("save_txt() only attaches gt when no gtsummary objects present", {
+  res <- save_txt(gt_tbl_single, path = tempfile(fileext = ".txt"))
+
+  # only gt is attached — no gtsummary library() call in the header
+  expect_match(res[9], "library(gt)", fixed = TRUE)
+  expect_false(any(grepl("library(gtsummary)", res, fixed = TRUE)))
+})