Support for newlines (#214)

Fixes #208
insightsengineering · Oct 17, 2023 · 49f4ac3 · 49f4ac3
1 parent 0d0bd84
commit 49f4ac3
Show file tree

Hide file tree

Showing 4 changed files with 58 additions and 38 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,6 @@
 ## formatters 0.5.3.9002
  * Fixed a bug in `paginate_to_mpfs()` so that formatting in listings key columns is retained with pagination [`insightsengineering/rlistings#155`](https://github.com/insightsengineering/rlistings/issues/155).
+ * Added full support of newline characters in any part of `rtables` objects.
 
 ## formatters 0.5.3
  * Decimal alignment now throws informative error if scientific notation is used.

diff --git a/R/matrix_form.R b/R/matrix_form.R
@@ -15,49 +15,62 @@ mform_handle_newlines <- function(matform) {
   has_topleft <- mf_has_topleft(matform)
   strmat <- mf_strings(matform)
   frmmat <- mf_formats(matform)
+  nr_header <- mf_nrheader(matform)
+  hdr_inds <- 1:nr_header
+
+  # hack that is necessary only if bottom aligned
+  topleft_has_nl_char <- FALSE
+  if (has_topleft) {
+    tl <- strmat[hdr_inds, 1, drop = TRUE]
+    strmat[hdr_inds, 1] <- ""
+    tl <- tl[nzchar(tl)] # we are not interested in initial "" but we cover initial \n
+    topleft_has_nl_char <- any(grepl("\n", tl))
+    tl_to_add_back <- strsplit(paste0(tl, collapse = "\n"), split = "\n", fixed = TRUE)[[1]]
+    how_many_nl <- length(tl_to_add_back)
+  }
   # nlines detects if there is a newline character
   row_nlines <- apply(strmat, 1, function(x) max(vapply(x, nlines, 1L), 1L))
-  nr_header <- mf_nrheader(matform)
+
+  if (has_topleft && (sum(row_nlines[hdr_inds]) < how_many_nl)) {
+    row_nlines[1] <- row_nlines[1] + how_many_nl - sum(row_nlines[hdr_inds])
+  }
 
   # There is something to change
-  if (any(row_nlines > 1)) {
-    # Header indices
-    hdr_inds <- 1:nr_header
-    ## groundwork for sad haxx to get tl to not be messed up
-    if (has_topleft) {
-        tl <- strmat[hdr_inds, 1]
-        strmat[hdr_inds, 1] <- ""
-        ## recalc them without topleft cause thats handled separately
-        row_nlines <- apply(strmat, 1, function(x) max(vapply(x, nlines, 1L), 1L))
-    } else {
-      tl <- character()
-    }
-    ## used below even though we don't store it on the resulting object
-    new_nlines_hdr <- sum(row_nlines[hdr_inds])
+  if (any(row_nlines > 1) || topleft_has_nl_char) {
+
+    # False: Padder should be bottom aligned if no topleft (case of rlistings)
+    # It is always bottom: tl_padder <- ifelse(has_topleft, pad_vert_top, pad_vert_bottom)
+
     newstrmat <- rbind(
-      expand_mat_rows(strmat[hdr_inds, , drop = FALSE],
-        row_nlines[hdr_inds],
-        cpadder = pad_vert_bottom
+      cbind(
+        expand_mat_rows(strmat[hdr_inds, 1, drop = FALSE],
+                        row_nlines[hdr_inds],
+                        cpadder = pad_vert_bottom # topleft info is NOT top aligned
+        ),
+        expand_mat_rows(strmat[hdr_inds, -1, drop = FALSE],
+                        row_nlines[hdr_inds],
+                        cpadder = pad_vert_bottom # colnames are bottom aligned
+        )
       ),
       expand_mat_rows(strmat[-1 * hdr_inds, , drop = FALSE], row_nlines[-hdr_inds])
     )
+
     newfrmmat <- rbind(
       expand_mat_rows(frmmat[hdr_inds, , drop = FALSE],
-        row_nlines[hdr_inds],
-        cpadder = pad_vert_bottom
-      ),
+                      row_nlines[hdr_inds],
+                      cpadder = pad_vert_bottom),
       expand_mat_rows(frmmat[-1 * hdr_inds, , drop = FALSE], row_nlines[-hdr_inds])
     )
-    ## sad haxx :(
+
     if (has_topleft) {
-      newtl <- unlist(strsplit(tl, "\n"))
-      if (length(newtl) > new_nlines_hdr) {
-        stop("Expanding top-left material resulted in more lines (", length(newtl), # nocov
-             "than fit in the header.") # nocov
+      starts_from_ind <- if (sum(row_nlines[hdr_inds]) - how_many_nl > 0){
+        sum(row_nlines[hdr_inds]) - how_many_nl
+      } else {
+        0
       }
-      newstrmat[1:new_nlines_hdr, 1] <- c(newtl, rep("", new_nlines_hdr - length(newtl)))
-      newfrmmat[1:new_nlines_hdr, 1] <- "xx"
+      newstrmat[starts_from_ind + seq_along(tl_to_add_back), 1] <- tl_to_add_back
     }
+
     mf_strings(matform) <- newstrmat
     mf_formats(matform) <- newfrmmat
     mf_spans(matform) <- expand_mat_rows(mf_spans(matform), row_nlines, rep_vec_to_len)
@@ -211,7 +224,6 @@ MatrixPrintForm <- function(strings = NULL,
                             indent_size = 2) {
     display <- disp_from_spans(spans)
 
-
     ncs <- if (has_rowlabs) ncol(strings) - 1 else ncol(strings)
     ret <- structure(
         list(
@@ -239,7 +251,6 @@ MatrixPrintForm <- function(strings = NULL,
         class = c("MatrixPrintForm", "list")
     )
 
-
     ## .do_mat_expand(ret)
     if (expand_newlines) {
         ret <- mform_handle_newlines(ret)

diff --git a/R/tostring.R b/R/tostring.R
@@ -175,7 +175,11 @@ do_cell_fnotes_wrap <- function(mat, widths, max_width, tf_wrap) {
   correct_indentation <- vapply(seq_along(mf_lgrp), function(xx) {
     grouping <- mf_lgrp[xx]
     if (nzchar(real_indent[grouping])) {
-      return(stringi::stri_detect(mf_str[xx, 1], regex = paste0("^", real_indent[grouping])))
+      has_correct_indentation <- stringi::stri_detect(
+        mf_str[xx, 1],
+        regex = paste0("^", real_indent[grouping])
+      )
+      return(has_correct_indentation || !nzchar(mf_str[xx, 1])) # "" is still an ok indentation
     }
     # Cases where no indent are true by definition
     return(TRUE)
@@ -750,8 +754,12 @@ wrap_string <- function(str, width, collapse = NULL, smart = TRUE) {
           paste0(ret[we_interval], collapse = " "),
           width
         )
+        # Taking out repetitions if there are more than one
+        if (length(we_interval) > 1) {
+          ret <- ret[-we_interval[-1]]
+        }
         # Paste together and rerun
-        ret <- paste0(unique(ret), collapse = " ")
+        ret <- paste0(ret, collapse = " ")
         return(wrap_string(str = ret, width = width, collapse = collapse, smart = smart))
       }
     } else {
@@ -800,12 +808,12 @@ wrap_txt <- function(str, width, collapse = NULL) {
   unlist(wrap_string(str, width, collapse), use.names = FALSE)
 }
 
-pad_vert_top <- function(x, len) {
-  c(x, rep("", len - length(x)))
+pad_vert_top <- function(x, len, default = "") {
+  c(x, rep(default, len - length(x)))
 }
 
-pad_vert_bottom <- function(x, len) {
-  c(rep("", len - length(x)), x)
+pad_vert_bottom <- function(x, len, default = "") {
+  c(rep(default, len - length(x)), x)
 }
 
 pad_vec_to_len <- function(vec, len, cpadder = pad_vert_top, rlpadder = cpadder) {

diff --git a/tests/testthat/test-pagination.R b/tests/testthat/test-pagination.R
@@ -47,7 +47,7 @@ test_that("pagination works", {
     strs <- mf_strings(dfmf_sillytopleft)
     strs[1,1] <- "ha\nha\nha\nha\nha\nha\n"
     mf_strings(dfmf_sillytopleft) <- strs
-    expect_error(formatters:::mform_handle_newlines(dfmf_sillytopleft))
+    expect_silent(formatters:::mform_handle_newlines(dfmf_sillytopleft))
 
     dfmf_cont <- dfmf
     mf_rinfo(dfmf_cont)$node_class <- "ContentRow"
@@ -70,7 +70,7 @@ test_that("pagination works", {
     dfmf2 <- formatters:::mform_handle_newlines(dfmf2)
     expect_identical(
         dfmf2$strings[1:2, 1:2],
-        matrix(c("tleft mats", "", "m", "pg"), nrow = 2, ncol = 2)
+        matrix(c("", "tleft mats", "m", "pg"), nrow = 2, ncol = 2)
     )