fixing top_left material in case of (N=xx)

insightsengineering · Oct 16, 2023 · 75eb2f6 · 75eb2f6
1 parent 7994851
commit 75eb2f6
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 15 deletions.
diff --git a/R/tt_export.R b/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
         }
       }

diff --git a/tests/testthat/test-exporters.R b/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, ...) {

diff --git a/tests/testthat/test-lyt-tabulation.R b/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") %>%

diff --git a/tests/testthat/test-printing.R b/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
 
@@ -557,23 +557,22 @@ test_that("Support for newline characters in all the parts", {
         analyze("BMRKR1", na_str = "asd\nasd") %>%  # \n error
         build_table(DM_trick)
 
-    top_left(tbl) <- c("a", "b\nd\n\n", "c\n\n") # last \n is eaten up, if in the middle error
+    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"
-    # matrix_form(tbl)
-    to_string_matrix2(tbl, hsep = "-", with_spaces = TRUE, print_txt_to_copy = TRUE)
     out <- strsplit(toString(tbl, hsep = "-"), "\\n")[[1]]
     expected <- c(
         "why not ",
         "also here",
         "",
         "",
         "---------------------------------",
+        "                                 ",
         "a                                ",
         "b                                ",
         "d                                ",
         "                                 ",
-        "c                            A wo",
-        "                      TWO        ",
+        "                             A wo",
+        "c                     TWO        ",
         "                     words    rd ",
         "---------------------------------",
         "m                                ",