Merge branch 'main' into strict_tests

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rlistings
 Title: Clinical Trial Style Data Readout Listings
-Version: 0.2.7.9001
-Date: 2023-12-11
+Version: 0.2.7.9002
+Date: 2024-01-19
 Authors@R: c(
     person("Gabriel", "Becker", , "gabembecker@gmail.com", role = "aut",
            comment = "original creator of the package"),

NEWS.md

@@ -1,16 +1,18 @@
-## rlistings 0.2.7.9001
+## rlistings 0.2.7.9002
+ * Added relevant tests for pagination when key columns need to be repeated in each page and when they are all empty.
+ * Added relevant tests for new line characters' handling in footnotes and titles.
 
 ## rlistings 0.2.7
-* Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.
-* Fixed bug in `add_listing_col` when both a function and a format are specified.
-* Added a vignette on referential footnotes workaround.
-* Added a vignette on formatting columns. 
-* Added a vignette on pagination. 
+ * Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.
+ * Fixed bug in `add_listing_col` when both a function and a format are specified.
+ * Added a vignette on referential footnotes workaround.
+ * Added a vignette on formatting columns. 
+ * Added a vignette on pagination. 
 
 ## rlistings 0.2.6
-* 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.
-* Integrated support for newline characters.
+ * 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.
+ * Integrated support for newline characters.
 
 ## rlistings 0.2.5
  * Fixed bug in `as_listing` preventing custom formatting from being applied to key columns.

R/rlistings.R

@@ -258,20 +258,24 @@ get_keycols <- function(df) {
   names(which(sapply(df, is_keycol)))
 }
 
-#' @export
 #' @inherit formatters::matrix_form
 #' @seealso [formatters::matrix_form()]
 #' @param indent_rownames logical(1). Silently ignored, as listings do not have row names
-#' nor indenting structure.
+#'   nor indenting structure.
 #'
 #' @examples
 #' lsting <- as_listing(mtcars)
 #' mf <- matrix_form(lsting)
 #'
 #' @return a `MatrixPrintForm` object
+#'
+#' @note Parameter `expand_newlines` should always be `TRUE` for listings. We keep it for
+#'   debugging reasons.
+#'
+#' @export
 setMethod(
   "matrix_form", "listing_df",
-  rix_form <- function(obj, indent_rownames = FALSE) {
+  rix_form <- function(obj, indent_rownames = FALSE, expand_newlines = TRUE) {
     ##  we intentionally silently ignore indent_rownames because listings have
     ## no rownames, but formatters::vert_pag_indices calls matrix_form(obj, TRUE)
     ## unconditionally.
@@ -338,11 +342,11 @@ setMethod(
         ncol = ncol(fullmat)
       ),
       row_info = make_row_df(obj),
-      nlines_header = 1, ## XXX this is probably wrong!!!
+      nlines_header = 1, # We allow only one level of headers and nl expansion happens after
       nrow_header = 1,
       has_topleft = FALSE,
       has_rowlabs = FALSE,
-      expand_newlines = TRUE,
+      expand_newlines = expand_newlines,
       main_title = main_title(obj),
       subtitles = subtitles(obj),
       page_titles = page_titles(obj),

tests/testthat/_snaps/paginate_listing.md

@@ -34,3 +34,66 @@
          AB12345-BRA-1-id-65      25    MEDIUM                       
       
 
+# pagination repeats keycols in other pages
+
+    Code
+      cat(toString(mf_pages[[3]]))
+    Output
+      a   b 
+      ——————
+      1   17
+          18
+          19
+          20
+          21
+          22
+          23
+          24
+
+---
+
+    Code
+      cat(toString(mf_pages[[3]]))
+    Output
+      a   b 
+      ——————
+          17
+          18
+          19
+          20
+          21
+          22
+          23
+          24
+
+# paginate_to_mpfs works with wrapping on keycols
+
+    Code
+      null <- sapply(pgs, function(x) toString(x) %>% cat())
+    Output
+                 Species               Petal.Width   Petal.Length
+      ———————————————————————————————————————————————————————————
+         SOMETHING VERY LONG THAT          0.1           1.5     
+            BREAKS PAGINATION                                    
+                                           0.2           1.4     
+                 Species               Petal.Width   Petal.Length
+      ———————————————————————————————————————————————————————————
+         SOMETHING VERY LONG THAT          0.2           1.4     
+            BREAKS PAGINATION                                    
+                                                         1.3     
+                 Species               Petal.Width   Petal.Length
+      ———————————————————————————————————————————————————————————
+         SOMETHING VERY LONG THAT          0.2           1.5     
+            BREAKS PAGINATION                                    
+                                                         1.4     
+                 Species               Petal.Width   Petal.Length
+      ———————————————————————————————————————————————————————————
+         SOMETHING VERY LONG THAT          0.2           1.5     
+            BREAKS PAGINATION                                    
+                                                         1.4     
+                 Species               Petal.Width   Petal.Length
+      ———————————————————————————————————————————————————————————
+         SOMETHING VERY LONG THAT          0.3           1.4     
+            BREAKS PAGINATION                                    
+                                           0.4           1.7     
+

tests/testthat/_snaps/print.md

@@ -136,17 +136,33 @@
     Code
       res
     Output
-       [1] "                                                      "
-       [2] "                                                      "
-       [3] "       Unique           Description          a        "
-       [4] "       Subject              Of                        "
-       [5] "     Identifier         Planned Arm          n        "
-       [6] "------------------------------------------------------"
-       [7] "AB12345-CHN-11-id-220   -             10.2627340069523"
-       [8] "                        asd                           "
-       [9] "AB12345-CHN-15-id-262   ARM #: 3      4.05546277230382"
-      [10] " AB12345-RUS-3-id-378   -             2.80323956920649"
-      [11] "                        asd                           "
-      [12] "             aaatrial   ARM #: 1      14.424933692778 "
-      [13] "                trial                                 "
+       [1] "main_title: argh"                                      
+       [2] "asr"                                                   
+       [3] "subtitle: argh"                                        
+       [4] "asr"                                                   
+       [5] "sada"                                                  
+       [6] ""                                                      
+       [7] "------------------------------------------------------"
+       [8] "                                                      "
+       [9] "                                                      "
+      [10] "       Unique           Description          a        "
+      [11] "       Subject              Of                        "
+      [12] "     Identifier         Planned Arm          n        "
+      [13] "------------------------------------------------------"
+      [14] "AB12345-CHN-11-id-220   -             10.2627340069523"
+      [15] "                        asd                           "
+      [16] "AB12345-CHN-15-id-262   ARM #: 3      4.05546277230382"
+      [17] " AB12345-RUS-3-id-378   -             2.80323956920649"
+      [18] "                        asd                           "
+      [19] "             aaatrial   ARM #: 1      14.424933692778 "
+      [20] "                trial                                 "
+      [21] "------------------------------------------------------"
+      [22] ""                                                      
+      [23] "main_footer: argh"                                     
+      [24] "asr"                                                   
+      [25] "sada"                                                  
+      [26] ""                                                      
+      [27] "prov_footer: argh"                                     
+      [28] "asr"                                                   
+      [29] "sada"                                                  
 

tests/testthat/test-paginate_listing.R

@@ -192,8 +192,99 @@ testthat::test_that("pagination repeats keycols in other pages", {
     "AB12345-BRA-1-id-42",
     paginate_to_mpfs(lsting, lpp = 33, cpp = 550)[[2]]$strings
   )[2])
+
+  # Simplified test
+  mf_pages <- as_listing(tibble("a" = rep("1", 25), "b" = seq(25)), key_cols = "a") %>%
+    paginate_to_mpfs(lpp = 10)
+
+  testthat::expect_snapshot(cat(toString(mf_pages[[3]])))
+
+  # Warning from empty key col
+  mf_pages <- suppressWarnings(
+    testthat::expect_warning(
+      as_listing(tibble("a" = rep("", 25), "b" = seq(25)), key_cols = "a") %>%
+        paginate_to_mpfs(lpp = 10)
+    )
+  )
+  mf_pages <- suppressWarnings(
+    as_listing(tibble("a" = rep("", 25), "b" = seq(25)), key_cols = "a") %>%
+      paginate_to_mpfs(lpp = 10)
+  )
+
+  testthat::expect_snapshot(
+    cat(toString(mf_pages[[3]]))
+  )
 })
 
 testthat::test_that("defunct is defunct", {
-  expect_error(pag_listing_indices(), "defunct")
+  testthat::expect_error(pag_listing_indices(), "defunct")
+})
+
+testthat::test_that("paginate_to_mpfs works with wrapping on keycols", {
+  iris2 <- iris[1:10, 3:5]
+  iris2$Species <- "SOMETHING VERY LONG THAT BREAKS PAGINATION"
+
+  lst <- as_listing(iris2, key_cols = c("Species", "Petal.Width"))
+
+  pgs <- paginate_to_mpfs(lst, colwidths = c(30, 11, 12), lpp = 5)
+
+  testthat::expect_equal(
+    sapply(pgs, function(x) strsplit(toString(x), "\n")[[1]] %>% length()),
+    rep(5, 5)
+  )
+  testthat::expect_snapshot(null <- sapply(pgs, function(x) toString(x) %>% cat()))
+
+  # Errors
+  testthat::expect_error(
+    suppressMessages(pgs <- paginate_to_mpfs(lst, colwidths = c(30, 11, 12), lpp = 3, verbose = TRUE))
+  )
+  testthat::expect_error(
+    suppressMessages(pgs <- paginate_to_mpfs(lst, colwidths = c(30, 11, 12), lpp = 8, cpp = 5, verbose = TRUE))
+  )
+
+  # Test 2 with double wrapping
+  tmp_fct <- factor(iris2$Petal.Width)
+  levels(tmp_fct) <- paste0("Very long level name ", levels(tmp_fct))
+  iris2$Petal.Width <- as.character(tmp_fct)
+
+  lst <- as_listing(iris2, key_cols = c("Species", "Petal.Width"))
+
+  pgs <- paginate_to_mpfs(lst, colwidths = c(30, 15, 12), lpp = 8)
+
+  testthat::expect_equal(
+    sapply(pgs, function(x) strsplit(toString(x), "\n")[[1]] %>% length()),
+    seq(8, 6)
+  )
+})
+
+testthat::test_that("paginate_to_mpfs works with wrapping on keycols when doing horizontal pagination", {
+  iris2 <- iris[1:10, 3:5]
+  iris2$Species <- "SOMETHING VERY LONG THAT BREAKS PAGINATION"
+  iris2 <- cbind("Petal.L3ngth" = iris2$Petal.Length, iris2)
+
+  lst <- as_listing(iris2, key_cols = c("Species", "Petal.Width"))
+  cw <- propose_column_widths(lst)
+  cw[1] <- 30
+  colgap <- matrix_form(lst)$col_gap
+  expected_min_cpp <- sum(cw[seq_len(3)]) + 2 * colgap
+  pgs <- paginate_to_mpfs(lst, colwidths = cw, lpp = 150, cpp = expected_min_cpp + 3) # why + 3? -> + colgap
+
+  testthat::expect_equal(
+    sapply(pgs, function(x) strsplit(toString(x), "\n")[[1]][1] %>% nchar()),
+    rep(expected_min_cpp, 2) # no colgap
+  )
+
+  pgs <- paginate_to_mpfs(lst, colwidths = cw, lpp = 5, cpp = expected_min_cpp + 3)
+
+  # testing nrow
+  testthat::expect_equal(
+    sapply(pgs, function(x) strsplit(toString(x), "\n")[[1]] %>% length()),
+    rep(5, 10)
+  )
+  # testing nchars
+  testthat::expect_equal(
+    sapply(pgs, function(x) strsplit(toString(x), "\n")[[1]][1] %>% nchar()),
+    rep(expected_min_cpp, 10)
+  )
+
 })

tests/testthat/test-print.R

@@ -128,6 +128,10 @@ testthat::test_that("listings support newline characters", {
       ARM = fmt_config(format = sprintf_format("ARM #: %s"), na_str = "-\nasd\n", align = "left")
     )
   )
+  main_footer(lsting) <- c("main_footer: argh\nasr", "sada\n")
+  prov_footer(lsting) <- c("prov_footer: argh\nasr", "sada\n")
+  main_title(lsting) <- "main_title: argh\nasr"
+  subtitles(lsting) <- c("subtitle: argh\nasr", "sada\n")
 
   res <- strsplit(toString(matrix_form(lsting), hsep = "-"), "\\n")[[1]]
   testthat::expect_snapshot(res)