Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add tests@208 support for newline@main #746

Merged
merged 11 commits into from
Oct 17, 2023
18 changes: 10 additions & 8 deletions R/tt_export.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this exported was changed because now the extra line to pop is above and not below (top_left is bottom aligned)

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
}
}
Expand Down
10 changes: 5 additions & 5 deletions R/tt_toString.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Comment on lines +538 to +539
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is important imo @shajoezhu

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

for the align bottom of top_left

}
list(body = cbind(tl, body, deparse.level = 0), span = cbind(1, span),
footnotes = cbind(list(list()), fnote))
Expand Down
1 change: 1 addition & 0 deletions tests/testthat/test-exporters.R
Original file line number Diff line number Diff line change
Expand Up @@ -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, ...) {
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-lyt-tabulation.R
Original file line number Diff line number Diff line change
Expand Up @@ -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") %>%
Expand Down
53 changes: 52 additions & 1 deletion tests/testthat/test-printing.R
Original file line number Diff line number Diff line change
Expand Up @@ -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"))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

now It is bottom aligned


## cell has \n

Expand Down Expand Up @@ -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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

first \n are kept ->> note that if you want a blank line you could even do "\n " as group of spaces are considered words now

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)
})