Skip to content

Commit

Permalink
adding newlines support for footers and titles (#751)
Browse files Browse the repository at this point in the history 
* adding newlines support for footers and titles

* small fix

* fix

* I will readd the nl empties here but there is a workaround simple
  • Loading branch information
@Melkiades
Melkiades authored Oct 18, 2023
1 parent dd74b7f commit fe25066
Show file tree
Hide file tree
Showing 3 changed files with 86 additions and 29 deletions.
30 changes: 27 additions & 3 deletions R/tt_toString.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -187,7 +187,6 @@ setMethod("matrix_form", "VTableTree",
indent_size = 2) {

stopifnot(is(obj, "VTableTree"))

header_content <- .tbl_header_mat(obj) # first col are for row.names

sr <- make_row_df(obj)
Expand Down Expand Up @@ -274,8 +273,26 @@ setMethod("matrix_form", "VTableTree",
body_ref_strs)),
nrow = nrow(body),
ncol = ncol(body))
# Solve \n in titles
if (any(grepl("\n", all_titles(obj)))) {
if (any(grepl("\n", main_title(obj)))) {
tmp_title_vec <- .quick_handle_nl(main_title(obj))
main_title(obj) <- tmp_title_vec[1]
subtitles(obj) <- c(tmp_title_vec[-1], .quick_handle_nl(subtitles(obj)))
} else {
subtitles(obj) <- .quick_handle_nl(subtitles(obj))
}
}

# Solve \n in footers
main_footer(obj) <- .quick_handle_nl(main_footer(obj))
prov_footer(obj) <- .quick_handle_nl(prov_footer(obj))

# xxx \n in page titles are not working atm (I think)
# ref_fnotes <- strsplit(get_formatted_fnotes(obj), "\n", fixed = TRUE)
ref_fnotes <- get_formatted_fnotes(obj) # pagination will not count extra lines coming from here
pag_titles <- page_titles(obj)

ref_fnotes <- get_formatted_fnotes(obj)
MatrixPrintForm(strings = body,
spans = spans,
aligns = aligns,
Expand All @@ -291,14 +308,21 @@ setMethod("matrix_form", "VTableTree",
has_topleft = TRUE,
main_title = main_title(obj),
subtitles = subtitles(obj),
page_titles = page_titles(obj),
page_titles = pag_titles,
main_footer = main_footer(obj),
prov_footer = prov_footer(obj),
table_inset = table_inset(obj),
indent_size = indent_size
)
})

.quick_handle_nl <- function(str_v){
if (any(grepl("\n", str_v))) {
return(unlist(strsplit(str_v, "\n", fixed = TRUE)))
} else {
return(str_v)
}
}

.resolve_fn_symbol <- function(fn) {
if(!is(fn, "RefFootnote"))
Expand Down
25 changes: 24 additions & 1 deletion tests/testthat/setup-fakedata.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -173,6 +173,29 @@ tt_to_test_wrapping <- function() {

tt_for_wrap <- tt_to_test_wrapping()

tt_to_test_newline_chars <- function(){
set.seed(1)
DM_trick <- DM %>%
mutate(ARM2 = sample(c("TWO\nwords\n ", "A wo\n\nrd\n\n"),
replace = TRUE, nrow(DM))) # last \n is eaten up if no empty space
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") %>%
split_cols_by("ARM2", split_label = "sda") %>%
analyze("BMRKR1", na_str = "asd\nasd") %>%
build_table(DM_trick)

main_footer(tbl) <- c("This", "is\na\n\nweird one\n")
prov_footer(tbl) <- c("This", "is\na\n\nweird one\n")
fnotes_at_path(tbl, rowpath = row_paths(tbl)[[6]]) <- c("a fancy footnote\ncrazy\n", "ahahha")
top_left(tbl) <- c("\na", "b\nd\n\n", "c\n\n") # last \n is eaten up if empty line everywhere
main_title(tbl) <- "why not\nalso here\n"
tbl
}

tt_for_nl <- tt_to_test_newline_chars()

# Helper function in R base to count how many times a character appears in a string.
# W: this works only for counting single characters from a single string of txt
.count_chr_from_str <- function(str, chr, negate = FALSE) {
Expand All @@ -181,4 +204,4 @@ tt_for_wrap <- tt_to_test_wrapping()
} else {
nchar(str) - nchar(gsub(chr, "", str, fixed = TRUE))
}
}
}
60 changes: 35 additions & 25 deletions tests/testthat/test-printing.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -545,35 +545,19 @@ test_that("row label indentation is kept even if there are 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]]
out <- strsplit(toString(tt_for_nl, hsep = "-"), "\\n")[[1]]
expected <- c(
"why not ",
"why not",
"also here",
"",
"",
"---------------------------------",
" ",
"a ",
"b ",
"d ",
" ",
" A wo",
"c TWO ",
" words rd ",
" ",
"a ",
"b A wo",
"d TWO ",
"c words rd ",
"---------------------------------",
"m ",
"annaggia ",
Expand All @@ -585,12 +569,38 @@ test_that("Support for newline characters in all the parts", {
" U ",
" N ",
" D ",
" ",
" {1, 2} ",
" Mean asd asd ",
" asd asd ",
" UNDIFFERENTIATED ",
" Mean asd asd ",
" asd asd "
" asd asd ",
"---------------------------------",
"",
"{1} - a fancy footnote",
"crazy",
"{2} - ahahha",
"---------------------------------",
"",
"This",
"is",
"a",
"",
"weird one",
"",
"This",
"is",
"a",
"",
"weird one"
)
expect_identical(out, expected)

# Resolution of footers work with tf_wrap = TRUE
out <- strsplit(toString(tt_for_nl, tf_wrap = TRUE, hsep = "-"), "\\n")[[1]]
expect_identical(out, expected)

# Export_as_txt too
out <- strsplit(export_as_txt(tt_for_nl, file = NULL, hsep = "-"), "\\n")[[1]]
expect_identical(out, expected)
})

0 comments on commit fe25066

Please sign in to comment.