From 082b739a3040146a224e501e42b32199f25c440a Mon Sep 17 00:00:00 2001 From: Melkiades Date: Tue, 9 Jan 2024 13:19:51 +0100 Subject: [PATCH 1/2] fix + expanded tests slightly --- NEWS.md | 3 +++ R/tt_toString.R | 32 ++------------------------------ tests/testthat/setup-fakedata.R | 6 ++++-- tests/testthat/test-printing.R | 8 ++++---- 4 files changed, 13 insertions(+), 36 deletions(-) diff --git a/NEWS.md b/NEWS.md index 83e7cd9a6..5d62ef138 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ ## rtables 0.6.6.9001 +### 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 index 2f46d5510..3b9763c43 100644 --- a/R/tt_toString.R +++ b/R/tt_toString.R @@ -239,20 +239,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) @@ -262,10 +254,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), @@ -296,23 +284,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/tests/testthat/setup-fakedata.R b/tests/testthat/setup-fakedata.R index 0f69c310d..c39215679 100644 --- 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-printing.R b/tests/testthat/test-printing.R index 0ab5f8dd0..3507aad3f 100644 --- a/tests/testthat/test-printing.R +++ b/tests/testthat/test-printing.R @@ -629,9 +629,9 @@ test_that("Support for newline characters in all the parts", { "", "---------------------------------", " ", + " ARM ", " ", - " ", - "a ", + "a A ", "b A wo", "d TWO ", "c words rd ", @@ -659,13 +659,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", "", From f9ef125371fec61a7296de4c00202bb63ae13de1 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Fri, 12 Jan 2024 10:23:37 +0100 Subject: [PATCH 2/2] fix error messages --- tests/testthat/test-exporters.R | 2 +- tests/testthat/test-pagination.R | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-exporters.R b/tests/testthat/test-exporters.R index ec10f6793..dd5f5a93f 100644 --- 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 index ee9ffc80b..3e4ebf814 100644 --- 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*" + ) ) })