Merge branch 'main' into strict_tests

insightsengineering · Jan 24, 2024 · 191b9d4 · 191b9d4
2 parents 48b2525 + 7b05e38
commit 191b9d4
Show file tree

Hide file tree

Showing 10 changed files with 24 additions and 43 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -33,4 +33,6 @@ inst/extdata/Advanced_rtables_part1.pdf
 inst/extdata/Advances_rtables_part2.pdf
 inst/extdata/Clinical_Trial_Reporting_Tables_in_R.pdf
 inst/extdata/r_adoption_slides.pdf
+inst/cheatsheet/Cheatsheet_v1-rtables.pdf
+inst/cheatsheet/Cheatsheet_v1-rtables.pptx
 ^pkgdown$
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: rtables
 Title: Reporting Tables
-Version: 0.6.6.9003
-Date: 2024-01-10
+Version: 0.6.6.9005
+Date: 2024-01-19
 Authors@R: c(
     person("Gabriel", "Becker", , "[email protected]", role = "aut",
            comment = "Original creator of the package"),

diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,10 @@
-## rtables 0.6.6.9003
+## rtables 0.6.6.9005
 ### New Features
  * Added `top_level_section_div` for `basic_table` to set section dividers for top level rows.
 
+### Bug Fixes
+ * Fixed `rlistings` decoration (e.g. titles and footers) expansion when there are new lines. Moved relevant handling from `rtables`' `matrix_form` function to `formatters`' dedicated `mform_handle_newlines` function.
+
 ## rtables 0.6.6
 ### New Features
  * Removed `ref_group` reordering in column splits so not to change the order.

diff --git a/R/tt_toString.R b/R/tt_toString.R
@@ -243,20 +243,12 @@ setMethod(
     if (disp_ccounts(obj)) {
       hdr_fmt_blank[nrow(hdr_fmt_blank), ] <- c("", rep(colcount_format(obj), ncol(obj)))
     }
-    ## if(disp_ccounts(obj)) {
-    ##     formats <- rbind(matrix("", nrow = nrow(header_content$body) - 1L,
-    ##                             ncol = ncol(header_content$body)),
-
-    ##                      formats_strings)
-    ## } else {
-    ##     formats <- rbind(header_content$body, formats_strings)
-    ## }
+
     formats <- rbind(hdr_fmt_blank, formats_strings)
 
     spans <- rbind(header_content$span, body_spans)
     row.names(spans) <- NULL
 
-    ## unused??? space <- matrix(rep(0, length(body)), nrow = nrow(body))
     aligns <- rbind(
       matrix(rep("center", length(header_content$body)),
         nrow = nrow(header_content$body)
@@ -266,10 +258,6 @@ setMethod(
 
     aligns[, 1] <- "left" # row names and topleft (still needed for topleft)
 
-    ## if (any(apply(body, c(1, 2), function(x) grepl("\n", x, fixed = TRUE))))
-    ##   stop("no \\n allowed at the moment")
-
-
     nr_header <- nrow(header_content$body)
     if (indent_rownames) {
       body[, 1] <- indent_string(body[, 1], c(rep(0, nr_header), sr$indent),
@@ -300,23 +288,7 @@ setMethod(
       nrow = nrow(body),
       ncol = ncol(body)
     )
-    # Solve \n in titles
-    if (any(grepl("\n", all_titles(obj)))) {
-      if (any(grepl("\n", main_title(obj)))) {
-        tmp_title_vec <- .quick_handle_nl(main_title(obj))
-        main_title(obj) <- tmp_title_vec[1]
-        subtitles(obj) <- c(tmp_title_vec[-1], .quick_handle_nl(subtitles(obj)))
-      } else {
-        subtitles(obj) <- .quick_handle_nl(subtitles(obj))
-      }
-    }
-
-    # Solve \n in footers
-    main_footer(obj) <- .quick_handle_nl(main_footer(obj))
-    prov_footer(obj) <- .quick_handle_nl(prov_footer(obj))
-
-    # xxx \n in page titles are not working atm (I think)
-    # ref_fnotes <- strsplit(get_formatted_fnotes(obj), "\n", fixed = TRUE)
+
     ref_fnotes <- get_formatted_fnotes(obj) # pagination will not count extra lines coming from here
     pag_titles <- page_titles(obj)
 

diff --git a/inst/cheatsheet/rtables_cheatsheet_01-24.pdf b/inst/cheatsheet/rtables_cheatsheet_01-24.pdf
diff --git a/inst/cheatsheet/rtables_cheatsheet_01-24.pptx b/inst/cheatsheet/rtables_cheatsheet_01-24.pptx
diff --git a/tests/testthat/setup-fakedata.R b/tests/testthat/setup-fakedata.R
@@ -189,6 +189,7 @@ tt_for_wrap <- tt_to_test_wrapping()
 tt_to_test_newline_chars <- function() {
   set.seed(1)
   DM_trick <- DM %>%
+    mutate(ARM = "ARM \n\nA\n") %>%
     mutate(ARM2 = sample(c("TWO\nwords\n ", "A wo\n\nrd\n\n"),
       replace = TRUE, nrow(DM)
     )) # last \n is eaten up if no empty space
@@ -198,12 +199,13 @@ tt_to_test_newline_chars <- function() {
       split_label = "m\nannaggia\nsda\n",
       label_pos = "visible"
     ) %>%
+    split_cols_by("ARM") %>%
     split_cols_by("ARM2", split_label = "sda") %>%
     analyze("BMRKR1", na_str = "asd\nasd") %>%
     build_table(DM_trick)
 
-  main_footer(tbl) <- c("This", "is\na\n\nweird one\n")
-  prov_footer(tbl) <- c("This", "is\na\n\nweird one\n")
+  main_footer(tbl) <- c("main_footer: This", "is\na\n\nweird one\n")
+  prov_footer(tbl) <- c("prov_footer: This", "is\na\n\nweird one\n")
   fnotes_at_path(tbl, rowpath = row_paths(tbl)[[6]]) <- c("a fancy footnote\ncrazy\n", "ahahha")
   top_left(tbl) <- c("\na", "b\nd\n\n", "c\n\n") # last \n is eaten up if empty line everywhere
   main_title(tbl) <- "why not\nalso here\n"

diff --git a/tests/testthat/test-exporters.R b/tests/testthat/test-exporters.R
@@ -390,7 +390,7 @@ test_that("Can create flextable object that works with different styles", {
 
   # internal package check
   not_a_pkg <- "bwrereloakdosirabttjtaeerr"
-  expect_error(check_required_packages(c("flextable", not_a_pkg)), not_a_pkg)
+  suppressMessages(expect_error(check_required_packages(c("flextable", not_a_pkg)), not_a_pkg))
 })
 
 test_that("export_as_doc works thanks to tt_to_flextable", {

diff --git a/tests/testthat/test-pagination.R b/tests/testthat/test-pagination.R
@@ -447,9 +447,11 @@ test_that("Pagination works with non-default min_siblings", {
   expect_identical(length(ttlst), nlevels(DM$RACE))
   expect_identical(tt[1], ttlst[[1]])
 
-  expect_error(
-    paginate_table(tt, lpp = 3, min_siblings = 1),
-    "Unable to find any valid pagination split between rows 1 and 1"
+  suppressMessages(
+    expect_error(
+      paginate_table(tt, lpp = 3, min_siblings = 1),
+      "*Unable to find any valid pagination split for page 1 between rows 1 and 1*"
+    )
   )
 })
 

diff --git a/tests/testthat/test-printing.R b/tests/testthat/test-printing.R
@@ -630,9 +630,9 @@ test_that("Support for newline characters in all the parts", {
     "",
     "---------------------------------",
     "                                 ",
+    "                         ARM     ",
     "                                 ",
-    "                                 ",
-    "a                                ",
+    "a                         A      ",
     "b                            A wo",
     "d                     TWO        ",
     "c                    words    rd ",
@@ -660,13 +660,13 @@ test_that("Support for newline characters in all the parts", {
     "{2} - ahahha",
     "---------------------------------",
     "",
-    "This",
+    "main_footer: This",
     "is",
     "a",
     "",
     "weird one",
     "",
-    "This",
+    "prov_footer: This",
     "is",
     "a",
     "",