Fixing the class checks and some minors

R/save_with_rmarkdown.R

@@ -12,7 +12,6 @@
 #'   `reference_docx:` R markdown field.
 #'
 #' @returns x (invisibly)
-#' @export
 #'
 #' @examples
 #' # create table
@@ -25,13 +24,20 @@
 #'     id = USUBJID,
 #'   )
 #'
-#' # save as docx
+#' # save as docx with flextable
 #' gtsummary::as_flex_table(tbl) |>
+#'   flextable::set_table_properties(layout = "autofit") |> # otherwise is going too wide
+#'   save_with_rmarkdown(path = tempfile(fileext = ".docx"))
+#'
+#' # save as docx with gt
+#' tbl |>
 #'   save_with_rmarkdown(path = tempfile(fileext = ".docx"))
 #'
-#' # split the tqble and save paginatted table
+#' # split the table and save paginated table
 #' gtsummary::tbl_split_by_rows(tbl, row_numbers = seq(20, nrow(tbl), by = 20)) |>
 #'   save_with_rmarkdown(path = tempfile(fileext = ".docx"))
+#'
+#' @export
 save_with_rmarkdown <- function(x,
                                 path,
                                 reference_docx = get_reference_docx("portrait")) {
@@ -42,6 +48,9 @@ save_with_rmarkdown <- function(x,
   check_string(path)
   check_string(reference_docx, allow_empty = TRUE)
 
+  # convert path to absolute path to ensure output is created in the correct location
+  path <- normalizePath(path, winslash = "/", mustWork = FALSE)
+
   check_class(x, cls = c(accepted_table_classes(), "list"))
   # check each object in the list is a table
   if (inherits(x, "list") && some(x, ~!inherits(.x, accepted_table_classes()))) {
@@ -60,9 +69,8 @@ save_with_rmarkdown <- function(x,
   # preparing for r markdown code vector ---------------------------------------
   pkg_to_attach <-
     ifelse(inherits(x, "list"), map(x, class), list(x)) |>
-    map_chr(class) |>
-    unlist() |>
-    intersect(accepted_table_classes())
+    map(\(xi) intersect(class(xi), accepted_table_classes())) |>
+    unlist()
   pkg_to_attach <- ifelse(pkg_to_attach == "gt_tbl", "gt", pkg_to_attach)
 
   # string of the yaml header

tests/testthat/test-save_with_rmarkdown.R

@@ -9,17 +9,50 @@ test_that("save_with_rmarkdown() works with flextable", {
     )
 
   # test with a single table
+  file_path <- tempfile(fileext = ".docx")
   expect_error(
     gtsummary::as_flex_table(tbl) |>
-      save_with_rmarkdown(, path = tempfile(fileext = ".docx")),
+      save_with_rmarkdown(, path = file_path),
     NA
   )
+  expect_true(file.exists(file_path))
 
   # test with a list of tables
+  file_path <- tempfile(fileext = ".docx")
   expect_error(
     gtsummary::tbl_split_by_rows(tbl, row_numbers = 20) |>
       map(gtsummary::as_flex_table) |>
-      save_with_rmarkdown(, path = tempfile(fileext = ".docx")),
+      save_with_rmarkdown(, path = file_path),
     NA
   )
+  expect_true(file.exists(file_path))
+})
+
+test_that("save_with_rmarkdown() works with gtsummary table", {
+  tbl <-
+    cards::ADAE[1:150,] |>
+    gtsummary::tbl_hierarchical(
+      variables = c(AESOC, AETERM),
+      by = TRTA,
+      denominator = cards::ADSL,
+      id = USUBJID,
+    )
+
+  # test with a single table
+  file_path <- tempfile(fileext = ".docx")
+  expect_error(
+    tbl |>
+      save_with_rmarkdown(, path = file_path),
+    NA
+  )
+  expect_true(file.exists(file_path))
+
+  # test with a list of tables
+  file_path <- tempfile(fileext = ".docx")
+  expect_error(
+    gtsummary::tbl_split_by_rows(tbl, row_numbers = 20) |>
+      save_with_rmarkdown(, path = file_path),
+    NA
+  )
+  expect_true(file.exists(file_path))
 })