From 0967436f0b01ffcd17e0bb5057ae242e9fba75fa Mon Sep 17 00:00:00 2001 From: Jana Stoilova <43623360+anajens@users.noreply.github.com> Date: Tue, 10 Oct 2023 07:55:33 -0400 Subject: [PATCH] Close #155 and add test for export_as_txt (#162) Closes #155. Depends on https://github.com/insightsengineering/formatters/pull/206 --------- Co-authored-by: Melkiades --- NEWS.md | 2 + R/paginate_listing.R | 67 ++++++++++++++------------ tests/testthat/_snaps/export.md | 57 ++++++++++++++++++++++ tests/testthat/test-export.R | 40 ++++++++++++--- tests/testthat/test-paginate_listing.R | 17 +++++++ 5 files changed, 144 insertions(+), 39 deletions(-) diff --git a/NEWS.md b/NEWS.md index eb0cdcde..7e8d334c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,6 @@ ## rlistings 0.2.5.9000 +* Fixed bug in pagination preventing key column values to appear in paginated listings when `export_as_txt` was used. +* Added tests to cover for `export_as_txt` outputs. ## rlistings 0.2.5 * Fixed bug in `as_listing` preventing custom formatting from being applied to key columns. diff --git a/R/paginate_listing.R b/R/paginate_listing.R index 44862a19..a0c5423e 100644 --- a/R/paginate_listing.R +++ b/R/paginate_listing.R @@ -62,43 +62,46 @@ paginate_listing <- function(lsting, checkmate::assert_count(max_width, null.ok = TRUE) checkmate::assert_flag(verbose) - - - indx <- paginate_indices(lsting, - page_type = page_type, - font_family = font_family, - font_size = font_size, - lineheight = lineheight, - landscape = landscape, - pg_width = pg_width, - pg_height = pg_height, - margins = margins, - lpp = lpp, - cpp = cpp, - colwidths = colwidths, - tf_wrap = tf_wrap, - max_width = max_width, - rep_cols = length(get_keycols(lsting)), - verbose = verbose) - + page_type = page_type, + font_family = font_family, + font_size = font_size, + lineheight = lineheight, + landscape = landscape, + pg_width = pg_width, + pg_height = pg_height, + margins = margins, + lpp = lpp, + cpp = cpp, + colwidths = colwidths, + tf_wrap = tf_wrap, + max_width = max_width, + rep_cols = length(get_keycols(lsting)), + verbose = verbose + ) - vert_pags <- lapply(indx$pag_row_indices, - function(ii) lsting[ii, ]) + vert_pags <- lapply( + indx$pag_row_indices, + function(ii) lsting[ii, ] + ) dispnames <- listing_dispcols(lsting) - full_pag <- lapply(vert_pags, - function(onepag) { + full_pag <- lapply( + vert_pags, + function(onepag) { if (!is.null(indx$pag_col_indices)) { - lapply(indx$pag_col_indices, - function(jj) { - res <- onepag[, dispnames[jj], drop = FALSE] - listing_dispcols(res) <- intersect(dispnames, names(res)) - res - }) + lapply( + indx$pag_col_indices, + function(jj) { + res <- onepag[, dispnames[jj], drop = FALSE] + listing_dispcols(res) <- intersect(dispnames, names(res)) + res + } + ) } else { - list(onepag) + list(onepag) } - }) + } + ) ret <- unlist(full_pag, recursive = FALSE) ret @@ -117,5 +120,5 @@ pag_listing_indices <- function(lsting, colwidths = NULL, max_width = NULL, verbose = FALSE) { - .Defunct("paginate_indices", package = "formatters") + .Defunct("paginate_indices", package = "formatters") } diff --git a/tests/testthat/_snaps/export.md b/tests/testthat/_snaps/export.md index 5fdbd219..ccee0143 100644 --- a/tests/testthat/_snaps/export.md +++ b/tests/testthat/_snaps/export.md @@ -41,3 +41,60 @@ 1.4 0.2 1.7 0.4 +# export_as_txt works and repeats the correct lines in pagination + + Code + cat(pages_listings) + Output + Example Title for Listing + This is the subtitle for this Adverse Events Table + + ———————————————————————————————————————————————————————————————————————————————————————————————————————————— + Unique Subject Identifier Primary System Organ Class Study Identifier Subject Identifier for the Study + ———————————————————————————————————————————————————————————————————————————————————————————————————————————— + AB12345-BRA-1-id-134 cl A AB12345 id-134 + AB12345 id-134 + cl B AB12345 id-134 + cl D AB12345 id-134 + AB12345-BRA-1-id-141 cl A AB12345 id-141 + AB12345 id-141 + AB12345 id-141 + cl B AB12345 id-141 + cl D AB12345 id-141 + AB12345 id-141 + AB12345-BRA-1-id-236 cl B AB12345 id-236 + AB12345 id-236 + AB12345 id-236 + AB12345-BRA-1-id-265 cl C AB12345 id-265 + AB12345 id-265 + cl D AB12345 id-265 + AB12345 id-265 + AB12345-BRA-1-id-42 cl A AB12345 id-42 + AB12345 id-42 + AB12345 id-42 + ———————————————————————————————————————————————————————————————————————————————————————————————————————————— + + Main footer for the listing + + You can even add a subfooter + Second element is place on a new line + Third string + \s\nExample Title for Listing + This is the subtitle for this Adverse Events Table + + ———————————————————————————————————————————————————————————————————————————————————————————————————————————— + Unique Subject Identifier Primary System Organ Class Study Identifier Subject Identifier for the Study + ———————————————————————————————————————————————————————————————————————————————————————————————————————————— + AB12345-BRA-1-id-42 cl B AB12345 id-42 + AB12345 id-42 + cl C AB12345 id-42 + AB12345 id-42 + cl D AB12345 id-42 + ———————————————————————————————————————————————————————————————————————————————————————————————————————————— + + Main footer for the listing + + You can even add a subfooter + Second element is place on a new line + Third string + diff --git a/tests/testthat/test-export.R b/tests/testthat/test-export.R index b4417bb0..50c43570 100644 --- a/tests/testthat/test-export.R +++ b/tests/testthat/test-export.R @@ -14,8 +14,8 @@ testthat::test_that("key columns repeat with export_as_txt", { dplyr::distinct(USUBJID, AGE, BMRKR1, .keep_all = TRUE) lsting <- as_listing(tmp_data, - key_cols = c("USUBJID", "AGE"), - disp_cols = character() + key_cols = c("USUBJID", "AGE"), + disp_cols = character() ) %>% add_listing_col("BMRKR1", format = "xx.x") @@ -33,8 +33,10 @@ testthat::test_that("key columns repeat with pagination with export_as_txt", { disp_cols = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width") ) - listing <- suppressMessages(export_as_txt(head(tbl), cpp = 50, paginate = TRUE, - page_break = "\n")) + listing <- suppressMessages(export_as_txt(head(tbl), + cpp = 50, paginate = TRUE, + page_break = "\n" + )) testthat::expect_snapshot(cat(listing)) @@ -45,7 +47,31 @@ testthat::test_that("Listing print correctly, with paginate", { lsting <- as_listing(dat[1:25, 1:8], key_cols = c("USUBJID", "AGE", "SEX")) page_out <- export_as_txt(lsting, file = NULL, paginate = TRUE, rep_cols = length(get_keycols(lsting))) - expect_identical(length(gregexpr(c("Unique Subject Identifier"), page_out)[[1]]), 2L) - expect_identical(length(gregexpr(c("Age"), page_out)[[1]]), 2L) - expect_identical(length(gregexpr(c("Sex"), page_out)[[1]]), 2L) + expect_identical(length(gregexpr(c("Unique Subject Identifier"), page_out)[[1]]), 2L) + expect_identical(length(gregexpr(c("Age"), page_out)[[1]]), 2L) + expect_identical(length(gregexpr(c("Sex"), page_out)[[1]]), 2L) +}) + +testthat::test_that("export_as_txt works and repeats the correct lines in pagination", { + dat <- formatters::ex_adae + lsting <- suppressMessages( + as_listing(dat[1:25, c(seq(1, 3), 40)], + key_cols = c("USUBJID", "AESOC"), + main_title = "Example Title for Listing", + subtitles = "This is the subtitle for this Adverse Events Table", + main_footer = "Main footer for the listing", + prov_footer = c( + "You can even add a subfooter", "Second element is place on a new line", + "Third string" + ) + ) + ) + # There are differences in pagination that should be taken into account (ref footnotes and rinfo) + testthat::expect_equal( + matrix_form(paginate_listing(lsting, lpp = 33, cpp = 550)[[2]], TRUE, TRUE)$strings, + paginate_to_mpfs(lsting, lpp = 33, cpp = 550)[[2]]$strings + ) + + pages_listings <- export_as_txt(lsting, file = NULL, paginate = TRUE, lpp = 33, cpp = 550) + testthat::expect_snapshot(cat(pages_listings)) }) diff --git a/tests/testthat/test-paginate_listing.R b/tests/testthat/test-paginate_listing.R index 1246f73d..9d8d7d9c 100644 --- a/tests/testthat/test-paginate_listing.R +++ b/tests/testthat/test-paginate_listing.R @@ -176,6 +176,23 @@ testthat::test_that("pagination works with col wrapping", { testthat::expect_error(paginate_listing(lsting, colwidths = c(12, 15))) }) +testthat::test_that("pagination repeats keycols in other pages", { + dat <- formatters::ex_adae + lsting <- as_listing(dat[1:25, c(1:6, 40)], + key_cols = c("USUBJID", "AESOC"), + main_title = "Example Title for Listing", + subtitles = "This is the subtitle for this Adverse Events Table", + main_footer = "Main footer for the listing", + prov_footer = c( + "You can even add a subfooter", "Second element is place on a new line", + "Third string" + ) + ) + testthat::expect_true(grepl( + "AB12345-BRA-1-id-42", + paginate_to_mpfs(lsting, lpp = 33, cpp = 550)[[2]]$strings + )[2]) +}) testthat::test_that("defunct is defunct", { expect_error(pag_listing_indices(), "defunct")