Skip to content

Commit

Permalink
Close #155 and add test for export_as_txt (#162)
Browse files Browse the repository at this point in the history 
Closes #155. 

Depends on insightsengineering/formatters#206

---------

Co-authored-by: Melkiades <davide.garolini@roche.com>
  • Loading branch information
@anajens @Melkiades
anajens and Melkiades authored Oct 10, 2023
1 parent 609bbaa commit 0967436
Show file tree
Hide file tree
Showing 5 changed files with 144 additions and 39 deletions.
2 changes: 2 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -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.
Expand Down
67 changes: 35 additions & 32 deletions R/paginate_listing.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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")
}
57 changes: 57 additions & 0 deletions tests/testthat/_snaps/export.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

40 changes: 33 additions & 7 deletions tests/testthat/test-export.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")

Expand All @@ -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))
Expand All @@ -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))
})
17 changes: 17 additions & 0 deletions tests/testthat/test-paginate_listing.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down

0 comments on commit 0967436

Please sign in to comment.