From b9fb8527d292176c36db3ccd4d64244f26834c53 Mon Sep 17 00:00:00 2001 From: Davide Garolini Date: Tue, 11 Apr 2023 22:22:45 +0200 Subject: [PATCH] fixing toString and pagination issues from export_txt and paginate_listings (#109) Fixes #108 and #106 --------- Co-authored-by: Gabriel Becker --- NAMESPACE | 1 - R/paginate_listing.R | 4 +- R/rlistings_methods.R | 50 ------------------ man/toString-listing_df-method.Rd | 32 ------------ tests/testthat/helper-rlistings.R | 3 -- tests/testthat/setup.R | 5 ++ tests/testthat/test-paginate_listing.R | 31 ++++++----- tests/testthat/test-print.R | 72 ++++++++++++++++++++++++-- 8 files changed, 94 insertions(+), 104 deletions(-) delete mode 100644 man/toString-listing_df-method.Rd delete mode 100644 tests/testthat/helper-rlistings.R diff --git a/NAMESPACE b/NAMESPACE index d3fd09ee..afc16036 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,7 +23,6 @@ exportMethods(make_row_df) exportMethods(matrix_form) exportMethods(prov_footer) exportMethods(subtitles) -exportMethods(toString) import(formatters) import(methods) import(tibble) diff --git a/R/paginate_listing.R b/R/paginate_listing.R index d9a39005..ce8d1668 100644 --- a/R/paginate_listing.R +++ b/R/paginate_listing.R @@ -58,7 +58,6 @@ paginate_listing <- function(lsting, verbose = FALSE) { checkmate::assert_class(lsting, "listing_df") checkmate::assert_numeric(colwidths, lower = 0, len = length(listing_dispcols(lsting)), null.ok = TRUE) - checkmate::assert_set_equal(names(colwidths), listing_dispcols(lsting)) checkmate::assert_flag(tf_wrap) checkmate::assert_count(max_width, null.ok = TRUE) checkmate::assert_flag(verbose) @@ -161,14 +160,13 @@ pag_listing_indices <- function(lsting, verbose = FALSE) { checkmate::assert_class(lsting, "listing_df") checkmate::assert_numeric(colwidths, lower = 0, len = length(listing_dispcols(lsting)), null.ok = TRUE) - checkmate::assert_set_equal(names(colwidths), listing_dispcols(lsting)) checkmate::assert_count(max_width, null.ok = TRUE) checkmate::assert_flag(verbose) dheight <- divider_height(lsting) dcols <- listing_dispcols(lsting) cinfo_lines <- max( - mapply(nlines, x = var_labels(lsting)[dcols], max_width = colwidths[dcols]) + mapply(nlines, x = var_labels(lsting)[dcols], max_width = colwidths) ) + dheight tlines <- if (any(nzchar(all_titles(lsting)))) { length(all_titles(lsting)) + dheight + 1L diff --git a/R/rlistings_methods.R b/R/rlistings_methods.R index 7364ab4d..13846470 100644 --- a/R/rlistings_methods.R +++ b/R/rlistings_methods.R @@ -227,56 +227,6 @@ setMethod( } ) -#' toString method for listing_df object -#' @param x listing_df object -#' @param widths numeric (or NULL). (proposed) widths for the columns -#' of \code{x}. The expected length of this numeric vector can be -#' retrieved with `ncol() + 1` as the column of row names must -#' also be considered. -#' @param hsep character(1). Characters to repeat to create -#' header/body separator line. -#' @param col_gap numeric(1). Space (in characters) between columns -#' @exportMethod toString -#' -#' @examples -#' lsting <- as_listing(mtcars) -#' toString(lsting) -#' @return A character value containing the listing rendered into -#' ASCII text. -setMethod("toString", "listing_df", function(x, - widths = NULL, - col_gap = 3, - hsep = default_hsep()) { - # gap_str <- strrep(" ", col_gap) - # txt_head <- .paste_no_na(names(x), collapse = gap_str) - # - if (is.null(widths)) { - widths <- propose_column_widths(x) - } - ncchar <- sum(widths) + (length(widths) - 1) * col_gap - - div <- substr(strrep(hsep, ncchar), 1, ncchar) - - inset <- 0L - x0 <- x - main_title(x0) <- NULL - main_footer(x0) <- NULL - titles_txt <- main_title(x) - paste0(paste( - c( - titles_txt, - .do_inset(div, inset), - toString(matrix_form(x0)), - .do_inset(div, inset), - .do_inset(main_footer(x), inset) - # .do_inset(txt_body, inset)#, - # .footer_inset_helper(allfoots, div, inset) - ), - collapse = "\n" - ), "\n") -}) - - #' @rdname listing_methods #' @param obj The object. #' @export diff --git a/man/toString-listing_df-method.Rd b/man/toString-listing_df-method.Rd deleted file mode 100644 index 3283fd81..00000000 --- a/man/toString-listing_df-method.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/rlistings_methods.R -\name{toString,listing_df-method} -\alias{toString,listing_df-method} -\title{toString method for listing_df object} -\usage{ -\S4method{toString}{listing_df}(x, widths = NULL, col_gap = 3, hsep = default_hsep()) -} -\arguments{ -\item{x}{listing_df object} - -\item{widths}{numeric (or NULL). (proposed) widths for the columns -of \code{x}. The expected length of this numeric vector can be -retrieved with \code{ncol() + 1} as the column of row names must -also be considered.} - -\item{col_gap}{numeric(1). Space (in characters) between columns} - -\item{hsep}{character(1). Characters to repeat to create -header/body separator line.} -} -\value{ -A character value containing the listing rendered into -ASCII text. -} -\description{ -toString method for listing_df object -} -\examples{ -lsting <- as_listing(mtcars) -toString(lsting) -} diff --git a/tests/testthat/helper-rlistings.R b/tests/testthat/helper-rlistings.R deleted file mode 100644 index 4607e669..00000000 --- a/tests/testthat/helper-rlistings.R +++ /dev/null @@ -1,3 +0,0 @@ -h_lsting_adae <- function(disp_cols = c("USUBJID", "AESOC", "RACE", "AETOXGR", "BMRKR1")) { - as_listing(ex_adae[1:25, ], disp_cols = disp_cols) -} diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index e7541ebd..76090b4a 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -6,3 +6,8 @@ anl <- var_relabel(anl, USUBJID = "Unique\nSubject\nIdentifier", ARM = "Description\nOf\nPlanned Arm" ) + +# Helper function used in pagination tests +h_lsting_adae <- function(disp_cols = c("USUBJID", "AESOC", "RACE", "AETOXGR", "BMRKR1")) { + as_listing(ex_adae[1:25, ], disp_cols = disp_cols) +} diff --git a/tests/testthat/test-paginate_listing.R b/tests/testthat/test-paginate_listing.R index 55048783..104b8b60 100644 --- a/tests/testthat/test-paginate_listing.R +++ b/tests/testthat/test-paginate_listing.R @@ -10,7 +10,7 @@ testthat::test_that("pagination works vertically", { ) %>% add_listing_col("BMRKR1", format = "xx.x") - pages_listings <- paginate_listing(lsting, lpp = 4, verbose = TRUE) + pages_listings <- suppressMessages(paginate_listing(lsting, lpp = 4, verbose = TRUE)) page1_result <- toString(matrix_form(pages_listings[[1]])) page2_result <- toString(matrix_form(pages_listings[[2]])) @@ -30,7 +30,7 @@ testthat::test_that("pagination works vertically", { testthat::expect_equal(page1_result, page1_expected) lsting2 <- lsting %>% add_listing_col("BMRKR2") - pages_listings2 <- paginate_listing(lsting2, lpp = 4, cpp = 70, verbose = TRUE) + pages_listings2 <- suppressMessages(paginate_listing(lsting2, lpp = 4, cpp = 70, verbose = TRUE)) testthat::expect_equal( toString(matrix_form(pages_listings2[[1]])), page1_expected @@ -62,7 +62,7 @@ testthat::test_that("horizontal pagination with 0 or 1 key column specified work add_listing_col("BMRKR1", format = "xx.x") %>% add_listing_col("BMRKR2") - pages_listings <- paginate_listing(lsting, cpp = 70, verbose = TRUE) + pages_listings <- suppressMessages(paginate_listing(lsting, cpp = 70, verbose = TRUE)) pg1_header <- strsplit(toString(matrix_form(pages_listings[[1]])), "\n")[[1]][1:2] pg2_header <- strsplit(toString(matrix_form(pages_listings[[2]])), "\n")[[1]][1:2] pg1_header_expected <- c( @@ -86,7 +86,7 @@ testthat::test_that("horizontal pagination with 0 or 1 key column specified work add_listing_col("BMRKR1", format = "xx.x") %>% add_listing_col("BMRKR2") - pages_listings2 <- paginate_listing(lsting2, cpp = 70, verbose = TRUE) + pages_listings2 <- paginate_listing(lsting2, cpp = 70) pg1_header2 <- strsplit(toString(matrix_form(pages_listings2[[1]])), "\n")[[1]][1:2] pg2_header2 <- strsplit(toString(matrix_form(pages_listings2[[2]])), "\n")[[1]][1:2] pg3_header2 <- strsplit(toString(matrix_form(pages_listings2[[3]])), "\n")[[1]][1:2] @@ -122,7 +122,7 @@ testthat::test_that("listing works with no vertical pagination", { ) %>% add_listing_col("BMRKR1", format = "xx.x") - pages_listings <- paginate_listing(lsting, lpp = NULL, verbose = TRUE) + pages_listings <- paginate_listing(lsting, lpp = NULL) page1_result <- matrix_form(pages_listings[[1]]) testthat::expect_equal(length(pages_listings), 1) @@ -143,7 +143,7 @@ testthat::test_that("checking vertical pagination line calculation.", { ) %>% add_listing_col("BMRKR1", format = "xx.x") - pages_listings <- paginate_listing(lsting, lpp = 8, verbose = TRUE) + pages_listings <- paginate_listing(lsting, lpp = 8) # there is always a gap between the end of the table and the footer. Line calculation is correct given this behavior page1_result <- matrix_form(pages_listings[[1]]) @@ -157,37 +157,44 @@ testthat::test_that("pagination: lpp and cpp correctly computed for pg_width and lsting <- h_lsting_adae() pag <- paginate_listing(lsting, lpp = 24, cpp = 135) res <- paginate_listing(lsting, pg_width = 15, pg_height = 5) - expect_identical(res, pag) + testthat::expect_identical(res, pag) }) testthat::test_that("pagination: lpp and cpp correctly computed for page_type and font_size", { lsting <- h_lsting_adae() pag1 <- paginate_listing(lsting, lpp = 69, cpp = 73) res1 <- paginate_listing(lsting, page_type = "a4", font_size = 11) - expect_identical(res1, pag1) + testthat::expect_identical(res1, pag1) pag2 <- paginate_listing(lsting, lpp = 85, cpp = 76) res2 <- paginate_listing(lsting, page_type = "legal", font_size = 11) - expect_identical(res2, pag2) + testthat::expect_identical(res2, pag2) }) testthat::test_that("pagination: lpp and cpp correctly computed for lineheight", { lsting <- h_lsting_adae() pag <- paginate_listing(lsting, lpp = 20, cpp = 70) res <- paginate_listing(lsting, lineheight = 3) - expect_identical(res, pag) + testthat::expect_identical(res, pag) }) testthat::test_that("pagination: lpp and cpp correctly computed for landscape", { lsting <- h_lsting_adae() pag <- paginate_listing(lsting, lpp = 45, cpp = 95) res <- paginate_listing(lsting, landscape = TRUE) - expect_identical(res, pag) + testthat::expect_identical(res, pag) }) testthat::test_that("pagination: lpp and cpp correctly computed for margins", { lsting <- h_lsting_adae() pag <- paginate_listing(lsting, lpp = 42, cpp = 65) res <- paginate_listing(lsting, margins = c(top = 2, bottom = 2, left = 1, right = 1)) - expect_identical(res, pag) + testthat::expect_identical(res, pag) +}) + +testthat::test_that("pagination works with col wrapping", { + lsting <- h_lsting_adae(disp_cols = c("USUBJID", "AESOC", "RACE")) + pag <- paginate_listing(lsting, colwidths = c(15, 15, 15, 15)) + + testthat::expect_error(paginate_listing(lsting, colwidths = c(12, 15))) }) diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index 7609a23d..db98ad97 100644 --- a/tests/testthat/test-print.R +++ b/tests/testthat/test-print.R @@ -1,7 +1,73 @@ testthat::test_that("Listing print correctly", { lsting <- as_listing(anl, key_cols = c("USUBJID")) %>% add_listing_col("ARM") - testthat::expect_output({ - print(lsting) - }) + + res <- strsplit(toString(matrix_form(lsting)), "\\n")[[1]] + exp <- c( + " Unique Description ", + " Subject Of ", + " Identifier Planned Arm Continous Level Biomarker 1", + "————————————————————————————————————————————————————————————————————", + "AB12345-CHN-1-id-307 B: Placebo 4.57499101339464 ", + "AB12345-CHN-11-id-220 B: Placebo 10.2627340069523 ", + "AB12345-CHN-15-id-201 C: Combination 6.9067988141075 ", + "AB12345-CHN-15-id-262 C: Combination 4.05546277230382 ", + "AB12345-CHN-3-id-128 A: Drug X 14.424933692778 ", + "AB12345-CHN-7-id-267 B: Placebo 6.2067627167943 ", + "AB12345-NGA-11-id-173 C: Combination 4.99722573047567 ", + "AB12345-RUS-3-id-378 C: Combination 2.80323956920649 ", + "AB12345-USA-1-id-261 B: Placebo 2.85516419937308 ", + "AB12345-USA-1-id-45 A: Drug X 0.463560441314472 " + ) + + testthat::expect_identical(res, exp) +}) + +testthat::test_that("Listing print correctly with different widths", { + lsting <- as_listing(anl, key_cols = c("USUBJID")) %>% + add_listing_col("ARM") + + res <- strsplit(toString(matrix_form(lsting), widths = c(7, 8, 9)), "\\n")[[1]] + exp <- c( + " Descript ", + "Unique ion ", + "Subject Of ", + "Identif Planned Continous", + " ier Arm Level ", + " Biomarker", + " 1 ", + "——————————————————————————————", + "AB12345 B: 4.5749910", + "-CHN-1- Placebo 1339464 ", + "id-307 ", + "AB12345 B: 10.262734", + "-CHN-11 Placebo 0069523 ", + "-id-220 ", + "AB12345 C: Combi 6.9067988", + "-CHN-15 nation 141075 ", + "-id-201 ", + "AB12345 C: Combi 4.0554627", + "-CHN-15 nation 7230382 ", + "-id-262 ", + "AB12345 A: Drug 14.424933", + "-CHN-3- X 692778 ", + "id-128 ", + "AB12345 B: 6.2067627", + "-CHN-7- Placebo 167943 ", + "id-267 ", + "AB12345 C: Combi 4.9972257", + "-NGA-11 nation 3047567 ", + "-id-173 ", + "AB12345 C: Combi 2.8032395", + "-RUS-3- nation 6920649 ", + "id-378 ", + "AB12345 B: 2.8551641", + "-USA-1- Placebo 9937308 ", + "id-261 ", + "AB12345 A: Drug 0.4635604", + "-USA-1- X 41314472 ", + "id-45 " + ) + + testthat::expect_identical(res, exp) })