Add tests@208 support for newline@main (#746)

* Fixing Viewer and as_html for \n manual varlabels

* fixes

* Tests for newline allowance

* additions

* bug fix for bottom alignment for topleft materials

* fixing top_left material in case of (N=xx)

* relevant fix for topleft

* allowing bottom topleft

* empty

R/tt_export.R

@@ -736,19 +736,21 @@ tt_to_flextable <- function(tt,
       if (isFALSE(counts_in_newline) && any(has_nclab)) {
         whsnc <- which(has_nclab) # which rows have it
         what_is_nclab <- det_nclab[whsnc, ]
+
         # condition for popping the interested row by merging the upper one
-        hdr[whsnc - 1, what_is_nclab] <- paste(hdr[whsnc - 1, what_is_nclab],
+        hdr[whsnc, what_is_nclab] <- paste(hdr[whsnc - 1, what_is_nclab],
           hdr[whsnc, what_is_nclab],
           sep = " "
         )
-        hdr[whsnc, what_is_nclab] <- ""
-
+        hdr[whsnc - 1, what_is_nclab] <- ""
+        
         # We can remove the row if they are all ""
-        if (all(!nzchar(hdr[whsnc, ]))) {
-          hdr <- hdr[-whsnc, , drop = FALSE]
-          spans <- spans[-whsnc, , drop = FALSE]
-          body <- body[-whsnc, , drop = FALSE]
-          mpf_aligns <- mpf_aligns[-whsnc, , drop = FALSE]
+        row_to_pop <- whsnc - 1
+        if (all(!nzchar(hdr[row_to_pop, ]))) {
+          hdr <- hdr[-row_to_pop, , drop = FALSE]
+          spans <- spans[-row_to_pop, , drop = FALSE]
+          body <- body[-row_to_pop, , drop = FALSE]
+          mpf_aligns <- mpf_aligns[-row_to_pop, , drop = FALSE]
           hnum <- hnum - 1
         }
       }

R/tt_toString.R

@@ -531,12 +531,12 @@ get_formatted_fnotes <- function(tt) {
     if(lentl == 0) {
         tl <- rep("", nli)
     } else if(lentl > nli) {
-        npad <- lentl - nli
-        body <- rbind(matrix("", nrow = npad, ncol = ncol(body)), body)
-        span <- rbind(matrix(1, nrow = npad, ncol = ncol(span)), span)
-        fnote <- rbind(matrix(list(), nrow = npad, ncol = ncol(body)), fnote)
+        tl_tmp <- paste0(tl, collapse = "\n")
+        tl <- rep("", nli)
+        tl[length(tl)] <- tl_tmp
     } else if (lentl < nli) {
-        tl <- c(tl, rep("", nli - lentl))
+        # We want topleft alignment that goes to the bottom!
+        tl <- c(rep("", nli - lentl), tl)
     }
     list(body = cbind(tl, body, deparse.level = 0), span = cbind(1, span),
          footnotes = cbind(list(list()), fnote))

tests/testthat/test-exporters.R

@@ -255,6 +255,7 @@ test_that("export_as_rtf works", {
     res <- export_as_rtf(tbl, file = tmpf)
     expect_true(file.exists(tmpf))
 })
+
 # Flextable and docx support ---------------------------------------------------
 test_that("Can create flextable object that works with different styles", {
   analysisfun <- function(x, ...) {

tests/testthat/test-lyt-tabulation.R

@@ -1029,7 +1029,7 @@ test_that("cut functions work", {
 
     mf <- matrix_form(tbl)
     expect_identical(mf$strings[2, , drop = TRUE],
-                     c("", rep(ctnames, 3)))
+                     c("counts", rep(ctnames, 3)))
 
     lcm <- basic_table() %>%
         split_cols_by("ARM") %>%

tests/testthat/test-printing.R

@@ -147,7 +147,7 @@ test_that("newline in column names and possibly cell values work", {
     expect_identical(mf_nlheader(matform2),
                      4L)
     expect_identical(matform2$strings[1:4, 1, drop = TRUE],
-                     c("Ethnicity", "  Factor2", "", ""))
+                     c("", "", "Ethnicity", "  Factor2"))
 
     ## cell has \n
 
@@ -543,3 +543,54 @@ test_that("row label indentation is kept even if there are newline characters",
         "Found newline characters"
     )
 })
+
+test_that("Support for newline characters in all the parts", {
+    set.seed(1)
+    DM_trick <- DM %>% 
+        mutate(ARM2 = sample(c("TWO\nwords\n", "A wo\n\nrd"),
+                             replace = TRUE, nrow(DM))) # last \n is eaten up
+    levels(DM_trick$SEX)[3] <- "U\nN\nD\n"
+    tbl <- basic_table() %>% 
+        split_rows_by("SEX", split_label = "m\nannaggia\nsda\n",
+                      label_pos = "visible") %>% # last \n bug
+        split_cols_by("ARM2", split_label = "sda") %>% 
+        analyze("BMRKR1", na_str = "asd\nasd") %>%  # \n error
+        build_table(DM_trick)
+
+    top_left(tbl) <- c("\na", "b\nd\n\n", "c\n\n") # last \n is eaten up, if in the middle error
+    main_title(tbl) <- "why not \nalso here\n"
+    out <- strsplit(toString(tbl, hsep = "-"), "\\n")[[1]]
+    expected <- c(
+        "why not ",
+        "also here",
+        "",
+        "",
+        "---------------------------------",
+        "                                 ",
+        "a                                ",
+        "b                                ",
+        "d                                ",
+        "                                 ",
+        "                             A wo",
+        "c                     TWO        ",
+        "                     words    rd ",
+        "---------------------------------",
+        "m                                ",
+        "annaggia                         ",
+        "sda                              ",
+        "  F                              ",
+        "    Mean             5.81    6.29",
+        "  M                              ",
+        "    Mean             6.15    5.21",
+        "  U                              ",
+        "  N                              ",
+        "  D                              ",
+        "                                 ",
+        "    Mean              asd    asd ",
+        "                      asd    asd ",
+        "  UNDIFFERENTIATED               ",
+        "    Mean              asd    asd ",
+        "                      asd    asd "
+    )
+    expect_identical(out, expected)
+})