diff --git a/NEWS.md b/NEWS.md index 6f42dcda3..0c651c594 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ ## formatters 0.5.3.9002 * Fixed a bug in `paginate_to_mpfs()` so that formatting in listings key columns is retained with pagination [`insightsengineering/rlistings#155`](https://github.com/insightsengineering/rlistings/issues/155). + * Added full support of newline characters in any part of `rtables` objects. ## formatters 0.5.3 * Decimal alignment now throws informative error if scientific notation is used. diff --git a/R/matrix_form.R b/R/matrix_form.R index a7a36fb6d..93ae02617 100644 --- a/R/matrix_form.R +++ b/R/matrix_form.R @@ -15,49 +15,62 @@ mform_handle_newlines <- function(matform) { has_topleft <- mf_has_topleft(matform) strmat <- mf_strings(matform) frmmat <- mf_formats(matform) + nr_header <- mf_nrheader(matform) + hdr_inds <- 1:nr_header + + # hack that is necessary only if bottom aligned + topleft_has_nl_char <- FALSE + if (has_topleft) { + tl <- strmat[hdr_inds, 1, drop = TRUE] + strmat[hdr_inds, 1] <- "" + tl <- tl[nzchar(tl)] # we are not interested in initial "" but we cover initial \n + topleft_has_nl_char <- any(grepl("\n", tl)) + tl_to_add_back <- strsplit(paste0(tl, collapse = "\n"), split = "\n", fixed = TRUE)[[1]] + how_many_nl <- length(tl_to_add_back) + } # nlines detects if there is a newline character row_nlines <- apply(strmat, 1, function(x) max(vapply(x, nlines, 1L), 1L)) - nr_header <- mf_nrheader(matform) + + if (has_topleft && (sum(row_nlines[hdr_inds]) < how_many_nl)) { + row_nlines[1] <- row_nlines[1] + how_many_nl - sum(row_nlines[hdr_inds]) + } # There is something to change - if (any(row_nlines > 1)) { - # Header indices - hdr_inds <- 1:nr_header - ## groundwork for sad haxx to get tl to not be messed up - if (has_topleft) { - tl <- strmat[hdr_inds, 1] - strmat[hdr_inds, 1] <- "" - ## recalc them without topleft cause thats handled separately - row_nlines <- apply(strmat, 1, function(x) max(vapply(x, nlines, 1L), 1L)) - } else { - tl <- character() - } - ## used below even though we don't store it on the resulting object - new_nlines_hdr <- sum(row_nlines[hdr_inds]) + if (any(row_nlines > 1) || topleft_has_nl_char) { + + # False: Padder should be bottom aligned if no topleft (case of rlistings) + # It is always bottom: tl_padder <- ifelse(has_topleft, pad_vert_top, pad_vert_bottom) + newstrmat <- rbind( - expand_mat_rows(strmat[hdr_inds, , drop = FALSE], - row_nlines[hdr_inds], - cpadder = pad_vert_bottom + cbind( + expand_mat_rows(strmat[hdr_inds, 1, drop = FALSE], + row_nlines[hdr_inds], + cpadder = pad_vert_bottom # topleft info is NOT top aligned + ), + expand_mat_rows(strmat[hdr_inds, -1, drop = FALSE], + row_nlines[hdr_inds], + cpadder = pad_vert_bottom # colnames are bottom aligned + ) ), expand_mat_rows(strmat[-1 * hdr_inds, , drop = FALSE], row_nlines[-hdr_inds]) ) + newfrmmat <- rbind( expand_mat_rows(frmmat[hdr_inds, , drop = FALSE], - row_nlines[hdr_inds], - cpadder = pad_vert_bottom - ), + row_nlines[hdr_inds], + cpadder = pad_vert_bottom), expand_mat_rows(frmmat[-1 * hdr_inds, , drop = FALSE], row_nlines[-hdr_inds]) ) - ## sad haxx :( + if (has_topleft) { - newtl <- unlist(strsplit(tl, "\n")) - if (length(newtl) > new_nlines_hdr) { - stop("Expanding top-left material resulted in more lines (", length(newtl), # nocov - "than fit in the header.") # nocov + starts_from_ind <- if (sum(row_nlines[hdr_inds]) - how_many_nl > 0){ + sum(row_nlines[hdr_inds]) - how_many_nl + } else { + 0 } - newstrmat[1:new_nlines_hdr, 1] <- c(newtl, rep("", new_nlines_hdr - length(newtl))) - newfrmmat[1:new_nlines_hdr, 1] <- "xx" + newstrmat[starts_from_ind + seq_along(tl_to_add_back), 1] <- tl_to_add_back } + mf_strings(matform) <- newstrmat mf_formats(matform) <- newfrmmat mf_spans(matform) <- expand_mat_rows(mf_spans(matform), row_nlines, rep_vec_to_len) @@ -211,7 +224,6 @@ MatrixPrintForm <- function(strings = NULL, indent_size = 2) { display <- disp_from_spans(spans) - ncs <- if (has_rowlabs) ncol(strings) - 1 else ncol(strings) ret <- structure( list( @@ -239,7 +251,6 @@ MatrixPrintForm <- function(strings = NULL, class = c("MatrixPrintForm", "list") ) - ## .do_mat_expand(ret) if (expand_newlines) { ret <- mform_handle_newlines(ret) diff --git a/R/tostring.R b/R/tostring.R index a2818d868..6c36da3ef 100644 --- a/R/tostring.R +++ b/R/tostring.R @@ -175,7 +175,11 @@ do_cell_fnotes_wrap <- function(mat, widths, max_width, tf_wrap) { correct_indentation <- vapply(seq_along(mf_lgrp), function(xx) { grouping <- mf_lgrp[xx] if (nzchar(real_indent[grouping])) { - return(stringi::stri_detect(mf_str[xx, 1], regex = paste0("^", real_indent[grouping]))) + has_correct_indentation <- stringi::stri_detect( + mf_str[xx, 1], + regex = paste0("^", real_indent[grouping]) + ) + return(has_correct_indentation || !nzchar(mf_str[xx, 1])) # "" is still an ok indentation } # Cases where no indent are true by definition return(TRUE) @@ -750,8 +754,12 @@ wrap_string <- function(str, width, collapse = NULL, smart = TRUE) { paste0(ret[we_interval], collapse = " "), width ) + # Taking out repetitions if there are more than one + if (length(we_interval) > 1) { + ret <- ret[-we_interval[-1]] + } # Paste together and rerun - ret <- paste0(unique(ret), collapse = " ") + ret <- paste0(ret, collapse = " ") return(wrap_string(str = ret, width = width, collapse = collapse, smart = smart)) } } else { @@ -800,12 +808,12 @@ wrap_txt <- function(str, width, collapse = NULL) { unlist(wrap_string(str, width, collapse), use.names = FALSE) } -pad_vert_top <- function(x, len) { - c(x, rep("", len - length(x))) +pad_vert_top <- function(x, len, default = "") { + c(x, rep(default, len - length(x))) } -pad_vert_bottom <- function(x, len) { - c(rep("", len - length(x)), x) +pad_vert_bottom <- function(x, len, default = "") { + c(rep(default, len - length(x)), x) } pad_vec_to_len <- function(vec, len, cpadder = pad_vert_top, rlpadder = cpadder) { diff --git a/tests/testthat/test-pagination.R b/tests/testthat/test-pagination.R index 00bc5c1b5..9d89cfcc8 100644 --- a/tests/testthat/test-pagination.R +++ b/tests/testthat/test-pagination.R @@ -47,7 +47,7 @@ test_that("pagination works", { strs <- mf_strings(dfmf_sillytopleft) strs[1,1] <- "ha\nha\nha\nha\nha\nha\n" mf_strings(dfmf_sillytopleft) <- strs - expect_error(formatters:::mform_handle_newlines(dfmf_sillytopleft)) + expect_silent(formatters:::mform_handle_newlines(dfmf_sillytopleft)) dfmf_cont <- dfmf mf_rinfo(dfmf_cont)$node_class <- "ContentRow" @@ -70,7 +70,7 @@ test_that("pagination works", { dfmf2 <- formatters:::mform_handle_newlines(dfmf2) expect_identical( dfmf2$strings[1:2, 1:2], - matrix(c("tleft mats", "", "m", "pg"), nrow = 2, ncol = 2) + matrix(c("", "tleft mats", "m", "pg"), nrow = 2, ncol = 2) )