fixing toString and pagination issues from export_txt and paginate_li…

…stings (#109)

Fixes #108 and #106

---------

Co-authored-by: Gabriel Becker <gabembecker@gmail.com>

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)

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

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

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)
+}

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)))
 })

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)
 })