fix vec_nlines and complete support newline character (#167)

Fixes insightsengineering/tlg-catalog#48
insightsengineering · Oct 17, 2023 · 5258875 · 5258875
1 parent c3ab2e9
commit 5258875
Show file tree

Hide file tree

Showing 4 changed files with 41 additions and 14 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,6 +1,7 @@
 ## rlistings 0.2.5.9002
 * 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.

diff --git a/R/rlistings_methods.R b/R/rlistings_methods.R
@@ -84,19 +84,8 @@ setMethod("vec_nlines", "ANY", function(vec, max_width = NULL) {
     max_width <- floor(0.9 * getOption("width")) # default of base::strwrap
     # NB: flooring as it is used as <= (also in base::strwrap)
   }
-  str_to_wrap_wnl <- format_colvector(colvec = vec) # with newlines
-
-  mtchs <- gregexpr("\n", str_to_wrap_wnl, fixed = TRUE) # counting manual \n
-  line_extension_count <- 1L + vapply(mtchs, function(vi) sum(vi > 0), 1L)
-
-  # Previous implementation of wrap_string was just removing manual \n with space
-  # Taking out the natural \n (matrix_form will take care of these)
-  str_to_wrap <- sub("\n", " ", str_to_wrap_wnl) # this was happening before
-  strvec <- wrap_txt(str_to_wrap, width = max_width, collapse = "\n")
-
-  # This is not used in rlistings - it seems
-  mtchs <- gregexpr("\n", strvec, fixed = TRUE) # this was and is never seeing a \n
-  line_extension_count + vapply(mtchs, function(vi) sum(vi > 0), 1L)
+  # in formatters for characters
+  unlist(lapply(format_colvector(colvec = vec), nlines, max_width = max_width))
 })
 
 ## setMethod("vec_nlines", "character", function(vec, max_width = NULL) {
@@ -135,7 +124,6 @@ setMethod(
            repr_inds = integer(),
            sibpos = NA_integer_,
            nsibs = NA_integer_) {
-
     ## assume sortedness by keycols
     keycols <- get_keycols(tt)
     dispcols <- listing_dispcols(tt)

diff --git a/tests/testthat/_snaps/print.md b/tests/testthat/_snaps/print.md
@@ -132,3 +132,22 @@
       AB12345-USA-1-id-261                 3             
        AB12345-USA-1-id-45                 0             
 
+# listings support newline characters
+
+    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                                 "
+
diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R
@@ -112,3 +112,22 @@ testthat::test_that("as_listing produces correct output when col_formatting is s
     "All format configurations supplied in `col_formatting` must be of type `fmt_config`."
   )
 })
+
+testthat::test_that("listings support newline characters", {
+  anl$ARM[3:6] <- NA
+  anl$USUBJID[1] <- "aaatrial\ntrial\n" # last \n is trimmed
+  vl <- var_labels(anl)
+  vl[3] <- "\n\na\n\nn\n"
+  var_labels(anl) <- vl
+  anl_tmp <- anl[1:4, ]
+  lsting <- as_listing(
+    anl_tmp,
+    key_cols = "USUBJID",
+    col_formatting = list(
+      USUBJID = fmt_config(align = "right"),
+      ARM = fmt_config(format = sprintf_format("ARM #: %s"), na_str = "-\nasd\n", align = "left")
+    )
+  )
+  res <- strsplit(toString(matrix_form(lsting), hsep = "-"), "\\n")[[1]]
+  testthat::expect_snapshot(res)
+})