diff --git a/R/tt_export.R b/R/tt_export.R index d99e5c7df..00455691d 100644 --- 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/R/tt_toString.R b/R/tt_toString.R index 640ac954f..24f223b53 100644 --- a/R/tt_toString.R +++ b/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)) diff --git a/tests/testthat/test-exporters.R b/tests/testthat/test-exporters.R index abf2a0cac..15d35a285 100644 --- 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 index cf3b965e2..d4be1fe00 100644 --- 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 index 129dc0e27..3298f373f 100644 --- 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 @@ -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) +})