From b7e455b2a03ff903b9eef30d4183888667951335 Mon Sep 17 00:00:00 2001 From: Davide Garolini Date: Fri, 19 Jan 2024 14:15:25 +0100 Subject: [PATCH] Fix of newlines in footers; towards fixing pagination for rlistings (#246) Fixes the following issues - [x] #243 - [x] https://github.com/insightsengineering/formatters/issues/232 - [x] https://github.com/insightsengineering/rlistings/issues/183 - [x] True fix for https://github.com/insightsengineering/rlistings/issues/155 - [x] https://github.com/insightsengineering/scda.test/pull/99 To merge with https://github.com/insightsengineering/rlistings/pull/192 (tests and misc) and https://github.com/insightsengineering/rtables/pull/813 (tests and removed titles/footers newline handling) --------- Signed-off-by: Davide Garolini Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> --- NAMESPACE | 1 - NEWS.md | 13 +- R/matrix_form.R | 94 +++++++++++--- R/mpf_exporters.R | 19 +++ R/pagination.R | 220 +++++++++++++++++++++++---------- R/tostring.R | 62 ++++++++-- README.md | 2 +- _pkgdown.yml | 2 +- man/MatrixPrintForm.Rd | 31 +---- man/basic_pagdf.Rd | 2 +- man/export_as_pdf.Rd | 3 +- man/export_as_txt.Rd | 3 +- man/pag_indices_inner.Rd | 13 +- man/paginate_indices.Rd | 3 +- tests/testthat/Rplots.pdf | Bin 0 -> 3611 bytes tests/testthat/test-txt_wrap.R | 30 ++++- vignettes/formatters.Rmd | 2 +- 17 files changed, 360 insertions(+), 140 deletions(-) create mode 100644 tests/testthat/Rplots.pdf diff --git a/NAMESPACE b/NAMESPACE index 1e52a2529..6350ebf6a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -49,7 +49,6 @@ export(main_footer) export(main_title) export(make_row_df) export(matrix_form) -export(matrix_print_form) export(mf_aligns) export(mf_cinfo) export(mf_colgap) diff --git a/NEWS.md b/NEWS.md index 2f6ed6a83..ecc194e3c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,13 @@ ## formatters 0.5.5.9004 - * Added "N=xx" format and unit test for it + * Added "N=xx" format and unit test for it. * Allow tables with content rows in the end be exported. + * Removed redundant references to `matrix_print_form` constructor (now only `MatrixPrintForm`). + * Moved new line expansion for decorations from `rtables`' `matrix_form` to `formatters`' constructor `MatrixPrintForm` so to cover also `rlistings`. + * Fixed pagination unexpected counts for `rlistings`' pagination by removing the manual subsetting workaround and fixing [`insightsengineering/rlistings#155`](https://github.com/insightsengineering/rlistings/issues/155). + * Improved relevant information feedback during pagination. + * Removed the possibility to set `min_siblings > 0` when dealing with listings. This allows smooth pagination when having only 2 lines. + * Added error catch for `\r` recursive special character. + * Fixed mismatch between pagination and exports regarding the value assigned to parameter `max_width`. Introduced general handler `.handle_max_width` for pagination, exports, and `toString`. ## formatters 0.5.5 * Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2. @@ -54,8 +61,8 @@ * `MatrixPrintForm` objects infer detailed referential footnote information from their `strings` element for backward compatibility. * Fix to test that failed on old Windows CRAN machine due to imperfect UTF support there. * If `lpp` and `cpp` in pagination or exporter functions are assigned to `NULL`, no pagination in the vertical or horizontal direction happens, respectively. -* The new default of `NA_integer_` for `lpp` and `cpp` now means those values should be inferred from page size. -* Added `hexSticker` logo. + * The new default of `NA_integer_` for `lpp` and `cpp` now means those values should be inferred from page size. + * Added `hexSticker` logo. ## formatters 0.4.0 * Cell values and row labels are now word-wrapped based on column widths (`widths` in `toString` and `colwidths` in pagination and exporters. diff --git a/R/matrix_form.R b/R/matrix_form.R index 295d402be..e81e5b621 100644 --- a/R/matrix_form.R +++ b/R/matrix_form.R @@ -21,7 +21,7 @@ mform_handle_newlines <- function(matform) { nl_inds_header <- seq(1, mf_nlheader(matform)) hdr_inds <- 1:nr_header - # hack that is necessary only if bottom aligned + # hack that is necessary only if top-left is bottom aligned (default) topleft_has_nl_char <- FALSE if (has_topleft) { tl <- strmat[nl_inds_header, 1, drop = TRUE] @@ -43,6 +43,7 @@ mform_handle_newlines <- function(matform) { # nlines detects if there is a newline character row_nlines <- apply(strmat, 1, function(x) max(vapply(x, nlines, 1L), 1L)) + # Correction for the case where there are more lines for topleft material than for cols if (has_topleft && (sum(row_nlines[nl_inds_header]) < how_many_nl)) { row_nlines[1] <- row_nlines[1] + how_many_nl - sum(row_nlines[nl_inds_header]) } @@ -92,9 +93,34 @@ mform_handle_newlines <- function(matform) { mf_lgrouping(matform) <- rep(line_grouping, times = row_nlines) } + # Solve \n in titles + if (any(grepl("\n", all_titles(matform)))) { + if (any(grepl("\n", main_title(matform)))) { + tmp_title_vec <- .quick_handle_nl(main_title(matform)) + main_title(matform) <- tmp_title_vec[1] + subtitles(matform) <- c(tmp_title_vec[-1], .quick_handle_nl(subtitles(matform))) + } else { + subtitles(matform) <- .quick_handle_nl(subtitles(matform)) + } + } + + # Solve \n in footers + main_footer(matform) <- .quick_handle_nl(main_footer(matform)) + prov_footer(matform) <- .quick_handle_nl(prov_footer(matform)) + + # xxx \n in page titles are not working atm (I think) + matform } +.quick_handle_nl <- function(str_v) { + if (any(grepl("\n", str_v))) { + return(unlist(strsplit(str_v, "\n", fixed = TRUE))) + } else { + return(str_v) + } +} + # Helper function to recompact the lines following line groupings to then have them expanded again .compress_mat <- function(mat, line_grouping, collapse_method = c("nl", "unique")) { list_compacted_mat <- lapply(unique(line_grouping), function(lg) { @@ -208,7 +234,6 @@ disp_from_spans <- function(spans) { #' if non-NULL, must have length equal to `ncol(strings)` #' @param indent_size numeric(1). Number of spaces to be used per level of indent (if supported by #' the relevant method). Defaults to 2. -#' @export #' @return An object of class `MatrixPrintForm`. Currently this is #' implemented as an S3 class inheriting from list with the following #' elements: @@ -241,6 +266,11 @@ disp_from_spans <- function(spans) { #' \item{\code{ncols}}{number of columns \emph{of the table}, not including #' any row names/row labels} #' } +#' +#' @examples +#' basic_matrix_form(iris) # calls matrix_form that calls this constructor +#' +#' @export MatrixPrintForm <- function(strings = NULL, spans, aligns, @@ -439,13 +469,6 @@ mform_build_refdf <- function(mform) { - -## constructor with snake_case naming convention -#' @rdname MatrixPrintForm -#' @export -matrix_print_form <- MatrixPrintForm - - ## hide the implementation behind abstraction in case we decide we want a real class someday #' `Setters` and `getters` for aspects of `MatrixPrintForm` Objects #' @@ -871,7 +894,7 @@ basic_matrix_form <- function(df, parent_path = "root") { ) ) - ret <- matrix_print_form( + ret <- MatrixPrintForm( strings = strings, aligns = aligns, spans = matrix(1, nrow = fnr, ncol = fnc), @@ -901,14 +924,14 @@ reconstruct_basic_fnote_list <- function(mf) { paste0("{", refdf$symbol, "} - ", refdf$msg) } -.mf_subset_core_mats <- function(mf, i, row = TRUE) { +.mf_subset_core_mats <- function(mf, i, keycols = NULL, row = TRUE) { fillnum <- if (row) nrow(mf_strings(mf)) - mf_nlheader(mf) else mf_ncol(mf) if (is.logical(i) || all(i < 0)) { i <- seq_len(fillnum)[i] } + nlh <- mf_nlheader(mf) if (row) { - nlh <- mf_nlheader(mf) ncolrows <- mf_nrheader(mf) i_mat <- c(seq_len(nlh), which(mf_lgrouping(mf) %in% (i + ncolrows))) j_mat <- seq_len(ncol(mf_strings(mf))) @@ -918,9 +941,46 @@ reconstruct_basic_fnote_list <- function(mf) { j_mat <- c(seq_len(nlabcol), i + nlabcol) } + tmp_strmat <- mf_strings(mf)[i_mat, j_mat, drop = FALSE] + + # Only for listings + if (nrow(tmp_strmat) > 0 && .is_listing(mf)) { # safe check for empty listings + + # Fix for missing labels in key columns (only for rlistings) + empty_keycols <- !nzchar(tmp_strmat[-seq_len(nlh), keycols, drop = FALSE][1, ]) + + if (any(empty_keycols)) { # only if there are missing keycol labels + # find the first non-empty label in the key columns + keycols_needed <- mf_strings(mf)[, empty_keycols, drop = FALSE] + first_nonempty <- apply(keycols_needed, 2, function(x) { + section_ind <- i_mat[-seq_len(nlh)][1] + sec_ind_no_header <- seq_len(section_ind)[-seq_len(nlh)] + tail(x[sec_ind_no_header][nzchar(x[sec_ind_no_header])], 1) + }) + + # if there are only "" the previous returns character() + any_chr_empty <- if (length(first_nonempty) > 1) { + vapply(first_nonempty, length, numeric(1)) + } else { + length(first_nonempty) + } + if (any(any_chr_empty == 0L)) { + warning( + "There are empty key columns in the listing. ", + "We keep empty strings for each page." + ) + first_nonempty[any_chr_empty == 0L] <- "" + } + + # replace the empty labels with the first non-empty label + tmp_strmat[nlh + 1, empty_keycols] <- unlist(first_nonempty) + } + } + + mf_strings(mf) <- tmp_strmat - mf_strings(mf) <- mf_strings(mf)[i_mat, j_mat, drop = FALSE] mf_lgrouping(mf) <- as.integer(as.factor(mf_lgrouping(mf)[i_mat])) + if (!row) { newspans <- truncate_spans(mf_spans(mf), j_mat) # 'i' is the columns here, b/c row is FALSE } else { @@ -962,7 +1022,7 @@ truncate_spans <- function(spans, j) { } -mpf_subset_rows <- function(mf, i) { +mpf_subset_rows <- function(mf, i, keycols = NULL) { nlh <- mf_nlheader(mf) lgrps <- mf_lgrouping(mf) row_lgrps <- tail(lgrps, -1 * nlh) @@ -970,7 +1030,7 @@ mpf_subset_rows <- function(mf, i) { ncolrows <- length(unique(lgrps[seq_len(nlh)])) ncs <- mf_ncol(mf) - mf <- .mf_subset_core_mats(mf, i, row = TRUE) + mf <- .mf_subset_core_mats(mf, i, keycols = keycols, row = TRUE) map <- data.frame( old_idx = c(seq_len(ncolrows), i + ncolrows), new_idx = c(seq_len(ncolrows), ncolrows + order(i)) @@ -1003,7 +1063,7 @@ mpf_subset_rows <- function(mf, i) { ## they are currently the only place we're tracking ## column information that will need to be touched up ## but lets be careful and do a bit more anyway -mpf_subset_cols <- function(mf, j) { +mpf_subset_cols <- function(mf, j, keycols = NULL) { nc <- mf_ncol(mf) if (is.logical(j) || all(j < 0)) { j <- seq_len(nc)[j] @@ -1023,7 +1083,7 @@ mpf_subset_cols <- function(mf, j) { ## this has to happen before the remap inher refdf <- mf_fnote_df(mf) - mf <- .mf_subset_core_mats(mf, j, row = FALSE) + mf <- .mf_subset_core_mats(mf, j, keycols = keycols, row = FALSE) ## future proofing (pipe dreams) diff --git a/R/mpf_exporters.R b/R/mpf_exporters.R index 4c89b31f0..ae63df1ac 100644 --- a/R/mpf_exporters.R +++ b/R/mpf_exporters.R @@ -84,6 +84,16 @@ export_as_txt <- function(x, mf_col_widths(mf) <- colwidths %||% propose_column_widths(mf) pages <- list(mf) } + + # Needs to be here because of adding cpp if it is not "auto" + if (!is.character(max_width)) { + max_width <- .handle_max_width( + tf_wrap = tf_wrap, + max_width = max_width, + cpp = cpp + ) + } + ## we dont' set widths here because we already but that info on mpf ## so its on each of the pages. strings <- vapply( @@ -593,6 +603,15 @@ export_as_pdf <- function(x, tbls <- list(mf) } + # Needs to be here because of adding cpp if it is not "auto" + if (!is.character(max_width)) { + max_width <- .handle_max_width( + tf_wrap = tf_wrap, + max_width = max_width, + cpp = cpp + ) + } + gtbls <- lapply(tbls, function(txt) { grid::textGrob( label = toString(txt, diff --git a/R/pagination.R b/R/pagination.R index 187b431b0..d0c992846 100644 --- a/R/pagination.R +++ b/R/pagination.R @@ -176,6 +176,7 @@ calc_ref_nlines_df <- function(pagdf) { build_fail_msg <- function(row, lines, raw_rowlines, + allowed_lines, lpp, decoration_lines, start, guess, rep_ext, n_reprint, reflines, n_refs, sectlines) { if (row) { @@ -183,12 +184,17 @@ build_fail_msg <- function(row, lines, raw_rowlines, spacetype_abr <- "lns" structtype_abr <- "rws" sprintf( - paste( - "\t....................... FAIL: requires %d %s [raw: %d %s (%d %s), rep.", - "context: %d %s (%d %s), refs: %d %s (%d) sect. divs: %d %s]." + paste0( + " FAIL: rows selected for pagination require %d %s while only %d are available from ", + "lpp = %d and %d header/footers lines.\n", + " details: [raw: %d %s (%d %s), rep. context: %d %s (%d %s), ", + "refs: %d %s (%d) sect. divs: %d %s]." ), lines, spacetype, + allowed_lines, + lpp, + decoration_lines, # header + footers raw_rowlines, spacetype_abr, guess - start + 1, # because it includes both start and guess @@ -208,7 +214,7 @@ build_fail_msg <- function(row, lines, raw_rowlines, spacetype_abr <- "chars" structtype_abr <- "cols" sprintf( - "\t....................... FAIL: requires %d %s (%d %s).", + " FAIL: selected columns require %d %s (%d %s).", lines, spacetype, guess - start + 1, # because it includes both start and guess @@ -221,21 +227,29 @@ valid_pag <- function(pagdf, guess, start, rlpp, + lpp, # for informational purposes only + context_lpp, # for informational purposes only (headers/footers) min_sibs, nosplit = NULL, div_height = 1L, verbose = FALSE, row = TRUE, have_col_fnotes = FALSE) { + # FALSE output from this function means that another guess is taken till success or failure rw <- pagdf[guess, ] - if (verbose) { message( - "Checking pagination after ", - paste(ifelse(row, "row", "column"), guess) + "-> Attempting pagination between ", start, " and ", guess, " ", + paste(ifelse(row, "row", "column")) ) } + + # Fix for counting the right number of lines when there is wrapping on a keycols + if (.is_listing(pagdf) && !is.null(pagdf$self_extent_page_break)) { + pagdf$self_extent[start] <- pagdf$self_extent_page_break[start] + } + raw_rowlines <- sum(pagdf[start:guess, "self_extent"] - pagdf[start:guess, "nreflines"]) refdf_ii <- calc_ref_nlines_df(pagdf[start:guess, ]) @@ -259,35 +273,40 @@ valid_pag <- function(pagdf, spacetype <- ifelse(row, "lines", "chars") spacetype_abr <- ifelse(row, "lns", "chrs") msg <- build_fail_msg( - row, lines, raw_rowlines, start, guess, rep_ext, length(pagdf$reprint_inds[[start]]), + row, lines, raw_rowlines, + allowed_lines = rlpp, lpp = lpp, decoration_lines = context_lpp, + start, guess, rep_ext, length(pagdf$reprint_inds[[start]]), reflines, NROW(refdf_ii), sectlines ) message(msg) } return(FALSE) } + + # Special cases: is it a label or content row? if (rw[["node_class"]] %in% c("LabelRow", "ContentRow")) { # check if it has children; if no children then valid has_children <- rw$abs_rownumber %in% unlist(pagdf$reprint_inds) if (rw$abs_rownumber == nrow(pagdf)) { if (verbose) { - message("\t....................... EXCEPTION: last row is a label or content row but in lpp") + message(" EXCEPTION: last row is a label or content row but in lpp") } } else if (!any(has_children)) { if (verbose) { message( - "\t....................... EXCEPTION: last row is a label or content row\n", + " EXCEPTION: last row is a label or content row\n", "but does not have rows and row groups depending on it" ) } } else { if (verbose) { - message("\t....................... FAIL: last row is a label or content row") + message(" FAIL: last row is a label or content row") } return(FALSE) } } + # Siblings handling sibpos <- rw[["pos_in_siblings"]] nsib <- rw[["n_siblings"]] # okpos <- min(min_sibs + 1, rw[["n_siblings"]]) @@ -297,7 +316,7 @@ valid_pag <- function(pagdf, retfalse <- TRUE if (verbose) { message( - "\t....................... FAIL: last row had only ", sibpos - 1, + " FAIL: last row had only ", sibpos - 1, " preceding siblings, needed ", min_sibs ) } @@ -305,7 +324,7 @@ valid_pag <- function(pagdf, retfalse <- TRUE if (verbose) { message( - "\t....................... FAIL: last row had only ", nsib - sibpos - 1, + " FAIL: last row had only ", nsib - sibpos - 1, " following siblings, needed ", min_sibs ) } @@ -330,7 +349,7 @@ valid_pag <- function(pagdf, if (!all(ok_split)) { if (verbose) { message( - "\t....................... FAIL: nosplit variable [", + " FAIL: nosplit variable [", inplay[min(which(!ok_split))], "] would be constant [", curvals, "] across this pagebreak." ) @@ -339,17 +358,22 @@ valid_pag <- function(pagdf, } } } + + # Usual output when found if (verbose) { - message("\t....................... OK [", lines + rep_ext, if (row) " lines]" else " chars]") + message(" OK [", lines + rep_ext, if (row) " lines]" else " chars]") } TRUE } find_pag <- function(pagdf, + current_page, start, guess, rlpp, + lpp_or_cpp, + context_lpp_or_cpp, min_siblings, nosplitin = character(), verbose = FALSE, @@ -357,11 +381,22 @@ find_pag <- function(pagdf, have_col_fnotes = FALSE, div_height = 1L, do_error = FALSE) { + if (verbose) { + if (row) { + message("--------- ROW-WISE: Checking possible pagination for page ", current_page) + } else { + message("========= COLUMN-WISE: Checking possible pagination for page ", current_page) + } + } + origuess <- guess while (guess >= start && !valid_pag( pagdf, guess, - start = start, rlpp = rlpp, min_sibs = min_siblings, - nosplit = nosplitin, verbose, row = row, have_col_fnotes = have_col_fnotes, + start = start, + rlpp = rlpp, lpp = lpp_or_cpp, context_lpp = context_lpp_or_cpp, # only lpp goes to row pagination + min_sibs = min_siblings, + nosplit = nosplitin, verbose, row = row, + have_col_fnotes = have_col_fnotes, div_height = div_height )) { guess <- guess - 1 @@ -371,9 +406,10 @@ find_pag <- function(pagdf, if (isFALSE(do_error) && isFALSE(verbose)) { find_pag( pagdf = pagdf, + current_page = current_page, start = start, guess = origuess, - rlpp = rlpp, + rlpp = rlpp, lpp_or_cpp = lpp_or_cpp, context_lpp_or_cpp = context_lpp_or_cpp, min_siblings = min_siblings, nosplitin = nosplitin, verbose = TRUE, @@ -384,13 +420,19 @@ find_pag <- function(pagdf, ) } stop( - "Unable to find any valid pagination split\ between ", + "-------------------------------------- Error Summary ----------------------------------------\n", + "Unable to find any valid pagination split for page ", current_page, " between ", ifelse(row, "rows ", "columns "), start, " and ", origuess, ". \n", "Inserted ", ifelse(row, "lpp (row-space, lines per page) ", "cpp (column-space, content per page) "), - ": ", pagdf$par_extent[start] + rlpp, "\n", - "Need-to-repeat-in-each-page space (key values): ", pagdf$par_extent[start], "\n", - "Remaining space: ", rlpp, "\n", - "Current space needed (with padding): ", pagdf$self_extent[start] + ": ", lpp_or_cpp, "\n", + "Context-relevant additional ", ifelse(row, "header/footers lines", "fixed column characters"), + ": ", context_lpp_or_cpp, "\n", + ifelse(row, + paste("Limit of allowed row lines per page:", rlpp, "\n"), + paste("Check the minimum allowed column characters per page in the last FAIL(ed) attempt. \n") + ), + "Note: take a look at the last FAIL(ed) attempt above to see what went wrong. It could be, for example, ", + "that the inserted column width induces some wrapping, hence the inserted number of lines (lpp) is not enough." ) } guess @@ -410,21 +452,29 @@ find_pag <- function(pagdf, #' #' @inheritSection pagination_algo Pagination Algorithm #' @param pagdf data.frame. A pagination info data.frame as created by -#' either `make_rows_df` or `make_cols_df`. +#' either `make_rows_df` or `make_cols_df`. #' @param rlpp numeric. Maximum number of \emph{row} lines per page (not including header materials), including #' (re)printed header and context rows +#' @param lpp_or_cpp numeric. Total maximum number of \emph{row} lines or content (column-wise characters) per page +#' (including header materials and context rows). This is only for informative results with `verbose = TRUE`. +#' It will print `NA` if not specified by the pagination machinery. +#' @param context_lpp_or_cpp numeric. Total number of context \emph{row} lines or content (column-wise characters) +#' per page (including header materials). Uses `NA` if not specified by the pagination machinery and is only +#' for informative results with `verbose = TRUE`. #' @param min_siblings numeric. Minimum sibling rows which must appear on either side of pagination row for a -#' mid-subtable split to be valid. Defaults to 2. +#' mid-subtable split to be valid. Defaults to 2 for tables. It is automatically turned off +#' (by using only 0) for listings. #' @param nosplitin character. List of names of sub-tables where page-breaks are not allowed, regardless of other #' considerations. Defaults to none. #' @param verbose logical(1). Should additional informative messages about the search for -#' pagination breaks be shown. Defaults to \code{FALSE}. +#' pagination breaks be shown. Defaults to \code{FALSE}. #' @param row logical(1). Is pagination happening in row -#' space (`TRUE`, the default) or column space (`FALSE`) +#' space (`TRUE`, the default) or column space (`FALSE`) #' @param have_col_fnotes logical(1). Does the table-like object being rendered have -#' column-associated referential footnotes. +#' column-associated referential footnotes. #' @param div_height numeric(1). The height of the divider line when the -#' associated object is rendered. Defaults to `1`. +#' associated object is rendered. Defaults to `1`. +#' #' @return A list containing the vector of row numbers, broken up by page #' #' @examples @@ -434,7 +484,9 @@ find_pag <- function(pagdf, #' lapply(paginds, function(x) mtcars[x, ]) #' #' @export -pag_indices_inner <- function(pagdf, rlpp, +pag_indices_inner <- function(pagdf, + rlpp, + lpp_or_cpp = NA_integer_, context_lpp_or_cpp = NA_integer_, # Context number of lines min_siblings, nosplitin = character(), verbose = FALSE, @@ -442,6 +494,7 @@ pag_indices_inner <- function(pagdf, rlpp, have_col_fnotes = FALSE, div_height = 1L) { start <- 1 + current_page <- 1 nr <- nrow(pagdf) ret <- list() while (start <= nr) { @@ -454,8 +507,10 @@ pag_indices_inner <- function(pagdf, rlpp, } } guess <- min(nr, start + adjrlpp - 1) - end <- find_pag(pagdf, start, guess, - rlpp = adjrlpp, + end <- find_pag( + pagdf = pagdf, + current_page = current_page, start = start, guess = guess, + rlpp = adjrlpp, lpp_or_cpp = lpp_or_cpp, context_lpp_or_cpp = context_lpp_or_cpp, min_siblings = min_siblings, nosplitin = nosplitin, verbose = verbose, @@ -468,6 +523,7 @@ pag_indices_inner <- function(pagdf, rlpp, start:end ))) start <- end + 1 + current_page <- current_page + 1 } ret } @@ -512,7 +568,8 @@ vert_pag_indices <- function(obj, cpp = 40, colwidths = NULL, verbose = FALSE, r ) } res <- pag_indices_inner(mf_cinfo(mf), - rlpp = rcpp, # cpp - sum(clwds[seq_len(rep_cols)]), + rlpp = rcpp, lpp_or_cpp = cpp, context_lpp_or_cpp = cpp - rcpp, + # cpp - sum(clwds[seq_len(rep_cols)]), verbose = verbose, min_siblings = 1, row = FALSE @@ -570,7 +627,7 @@ mpf_infer_cinfo <- function(mf, colwidths = NULL, rep_cols = num_rep_cols(mf)) { #' @param extents integer. Number of lines each row will take to print, defaults to 1 for all rows #' @param rclass character. Class(es) for the rows. Defaults to "NA" #' -#' @return A data.frame suitable for use in both the `matrix_print_form` constructor and the pagination machinery +#' @return A data.frame suitable for use in both the `MatrixPrintForm` constructor and the pagination machinery #' #' @examples #' @@ -642,15 +699,9 @@ calc_lcpp <- function(page_type = NULL, cpp <- pg_lcpp$cpp } stopifnot(!is.na(cpp)) - if (!tf_wrap && !is.null(max_width)) { - warning("tf_wrap is FALSE - ignoring non-null max_width value.") - max_width <- NULL - } else if (tf_wrap && is.null(max_width)) { - max_width <- cpp - } - if (is.character(max_width) && identical(max_width, "auto")) { - max_width <- inset + sum(colwidths) + (length(colwidths) - 1) * col_gap - } + + max_width <- .handle_max_width(tf_wrap, max_width, cpp, colwidths, col_gap, inset) + page_size_spec(lpp = lpp, cpp = cpp, max_width = max_width) } @@ -930,26 +981,50 @@ paginate_indices <- function(obj, ## forced pagination is generally going to set page titles, which ## we can't preserve when just returning lists of indices. ## Instead we make a hard assumption here that any forced pagination - ## has already occured. - - - - + ## has already occurred. ## this wraps the cell contents AND shoves referential footnote - ## info into mf_rinfo(mpf) + ## info mf_rinfo(mpf) mpf <- do_cell_fnotes_wrap(mpf, colwidths, max_width, tf_wrap = tf_wrap) + # rlistings note: if there is a wrapping in a keycol, it is not calculated correctly + # in the above call, so we need to keep this information in mf_rinfo + # and use it here. + mfri <- mf_rinfo(mpf) + if (NROW(mfri) > 0 && .is_listing(mpf)) { + # Lets determine the groupings created by keycols + keycols_grouping_df <- NULL + keycols <- .keycols_from_listing(obj) + for (i in seq_along(keycols)) { + kcol <- keycols[i] + kcolvec <- obj[[kcol]] + kcolvec <- vapply(kcolvec, format_value, "", format = obj_format(kcolvec), na_str = obj_na_str(kcolvec)) + groupings <- as.numeric(factor(kcolvec, levels = unique(kcolvec))) + where_they_start <- which(c(1, diff(groupings)) > 0) + keycols_grouping_df <- cbind( + keycols_grouping_df, + where_they_start[groupings] + ) # take the groupings + } + + # Creating the real self_extend for mf_rinfo (if the line is chosen for pagination start) + self_extent_df <- apply(keycols_grouping_df, 2, function(x) mfri$self_extent[x]) + mf_rinfo(mpf) <- cbind(mfri, "self_extent_page_break" = apply(self_extent_df, 1, max)) + } + if (is.null(pg_size_spec$lpp)) { pag_row_indices <- list(seq_len(mf_nrow(mpf))) } else { + rlpp <- calc_rlpp( + pg_size_spec, mpf, + colwidths = colwidths, + tf_wrap = tf_wrap, verbose = verbose + ) pag_row_indices <- pag_indices_inner( pagdf = mf_rinfo(mpf), - rlpp = calc_rlpp( - pg_size_spec, mpf, - colwidths = colwidths, - tf_wrap = tf_wrap, verbose = verbose - ), + rlpp = rlpp, + lpp_or_cpp = pg_size_spec$lpp, + context_lpp_or_cpp = pg_size_spec$lpp - rlpp, verbose = verbose, min_siblings = min_siblings, nosplitin = nosplitin @@ -997,6 +1072,12 @@ paginate_to_mpfs <- function(obj, col_gap = 2, verbose = FALSE) { mpf <- matrix_form(obj, TRUE, TRUE, indent_size = indent_size) + + # Turning off min_siblings for listings + if (.is_listing(mpf)) { + min_siblings <- 0 + } + if (is.null(colwidths)) { colwidths <- mf_col_widths(mpf) %||% propose_column_widths(mpf) } else { @@ -1081,32 +1162,35 @@ paginate_to_mpfs <- function(obj, verbose = verbose ) - # This needs to be fixed better - if (inherits(fpags[[1]], "listing_df") && length(fpags) < 2) { - pagmats <- lapply( - page_indices$pag_row_indices, - function(ii) { - mf_tmp <- matrix_form(obj[ii, ], TRUE, TRUE, indent_size = indent_size) - mf_col_widths(mf_tmp) <- colwidths - mf_tmp - } - ) + ind_keycols <- if (.is_listing(mpf)) { + which(colnames(obj) %in% .keycols_from_listing(obj)) } else { - pagmats <- lapply(page_indices$pag_row_indices, function(ii) { - mpf_subset_rows(mpf, ii) - }) + NULL } + pagmats <- lapply(page_indices$pag_row_indices, function(ii) { + mpf_subset_rows(mpf, ii, keycols = ind_keycols) + }) + ## these chunks now carry around their (correctly subset) col widths... res <- lapply(pagmats, function(matii) { lapply(page_indices$pag_col_indices, function(jj) { - mpf_subset_cols(matii, jj) + mpf_subset_cols(matii, jj, keycols = ind_keycols) }) }) unlist(res, recursive = FALSE) } +.is_listing <- function(mpf) { + all(mf_rinfo(mpf)$node_class == "listing_df") +} + +# Shallow copy of get_keycols +.keycols_from_listing <- function(obj) { + names(which(sapply(obj, inherits, what = "listing_keycol"))) +} + #' @importFrom utils capture.output #' @details diff --git a/R/tostring.R b/R/tostring.R index 5b6aa663e..e61126e06 100644 --- a/R/tostring.R +++ b/R/tostring.R @@ -446,6 +446,12 @@ setMethod("toString", "MatrixPrintForm", function(x, "Please contact the maintainer or file an issue." ) # nocov } + if (any(grepl("\r", mf_strings(mat)))) { + stop( + "Found recursive special characters (\\r) in string matrix produced by matrix_form. ", + "This special character is not supported and should be removed." + ) # nocov + } # Check that expansion worked for header -> should not happen if (!is.null(mf_rinfo(mat)) && # rare case of rtables::rtable() @@ -494,15 +500,14 @@ setMethod("toString", "MatrixPrintForm", function(x, # Total number of characters for the table ncchar <- sum(widths) + (length(widths) - 1) * col_gap - ## Text wrapping checks (widths) - if (tf_wrap) { - if (is.null(max_width)) { - max_width <- getOption("width", 80L) - } else if (is.character(max_width) && identical(max_width, "auto")) { - max_width <- ncchar + inset - } - assert_number(max_width, lower = 0) - } + ## max_width for wrapping titles and footers (not related to ncchar if not indirectly) + max_width <- .handle_max_width( + tf_wrap = tf_wrap, + max_width = max_width, + colwidths = widths, + col_gap = col_gap, + inset = inset + ) # Main wrapper function for table core mat <- do_cell_fnotes_wrap(mat, widths, max_width = max_width, tf_wrap = tf_wrap) @@ -548,7 +553,7 @@ setMethod("toString", "MatrixPrintForm", function(x, bdy_cont <- tail(content, -nl_header) ## unfortunately we count "header rows" wrt line grouping so it ## doesn't match the real (i.e. body) rows as is - row_grouping <- tail(mf_lgrouping(mat), - nl_header) - mf_nrheader(mat) + row_grouping <- tail(mf_lgrouping(mat), -nl_header) - mf_nrheader(mat) nrbody <- NROW(bdy_cont) stopifnot(length(row_grouping) == nrbody) ## all rows with non-NA section divs and the final row (regardless of NA status) @@ -634,6 +639,38 @@ setMethod("toString", "MatrixPrintForm", function(x, ) }) +# Switcher for the 3 options for max_width (NULL, numeric, "auto")) +.handle_max_width <- function(tf_wrap, max_width, + cpp = NULL, # Defaults to getOption("width", 80L) + # Things for auto + inset = NULL, colwidths = NULL, col_gap = NULL) { + max_width <- if (!tf_wrap) { + if (!is.null(max_width)) { + warning("tf_wrap is FALSE - ignoring non-null max_width value.") + } + NULL + } else if (tf_wrap) { + if (is.null(max_width)) { + if (is.null(cpp) || is.na(cpp)) { + getOption("width", 80L) + } else { + cpp + } + } else if (is.numeric(max_width)) { + max_width + } else if (is.character(max_width) && identical(max_width, "auto")) { + # This should not happen, but just in case + if (any(sapply(list(inset, colwidths, col_gap), is.null))) { + stop("inset, colwidths, and col_gap must all be non-null when max_width is \"auto\".") + } + inset + sum(colwidths) + (length(colwidths) - 1) * col_gap + } else { + stop("max_width must be NULL, a numeric value, or \"auto\".") + } + } + return(max_width) +} + .do_inset <- function(x, inset) { if (inset == 0 || !any(nzchar(x))) { return(x) @@ -647,7 +684,6 @@ setMethod("toString", "MatrixPrintForm", function(x, x } - .inset_div <- function(txt, div, inset) { c(.do_inset(div, inset), "", txt) } @@ -820,8 +856,8 @@ wrap_string <- function(str, width, collapse = NULL) { broken_char_ori <- sum(nchar(ori_wrapped_txt_v) > width) # how many issues there were broken_char_cur <- sum(nchar(cur_wrapped_txt_v) > width) # how many issues there are - if (setequal(ori_wrapped_txt_v, cur_wrapped_txt_v) || - broken_char_cur >= broken_char_ori) { # we did not solve the current issue! + # if still broken, we did not solve the current issue! + if (setequal(ori_wrapped_txt_v, cur_wrapped_txt_v) || broken_char_cur >= broken_char_ori) { # help function: Very rare case where the recursion is stuck in a loop ret_tmp <- force_split_words_by(ret[we_interval], width) # here we_interval is only one ind ret <- append(ret, ret_tmp, we_interval)[-we_interval] diff --git a/README.md b/README.md index 7a0baee9d..5a483cc76 100644 --- a/README.md +++ b/README.md @@ -147,7 +147,7 @@ matrix_form.data.frame <- function(df) { matrix("left", nrow = NROW(df), ncol = fnc)) ## build up fake pagination df, rowdf <- basic_pagdf(row.names(df)) - matrix_print_form(strings = strings, + MatrixPrintForm(strings = strings, aligns = aligns, spans = matrix(1, nrow = fnr, ncol = fnc), formats = NULL, diff --git a/_pkgdown.yml b/_pkgdown.yml index 67331d5bb..852644e6d 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -48,7 +48,7 @@ reference: - title: MatrixPrintForm desc: MatrixPrintForm class and constructor contents: - - matrix_print_form + - MatrixPrintForm - MatrixPrintForm-class - title: ASCII Rendering of MatrixPrintForm objects desc: ASCII rendering-related functions which operate on MatrixPrintForm objects diff --git a/man/MatrixPrintForm.Rd b/man/MatrixPrintForm.Rd index f46061470..fb1f97398 100644 --- a/man/MatrixPrintForm.Rd +++ b/man/MatrixPrintForm.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/matrix_form.R \name{MatrixPrintForm} \alias{MatrixPrintForm} -\alias{matrix_print_form} \title{Matrix Print Form - Intermediate Representation for ASCII Table Printing} \usage{ MatrixPrintForm( @@ -30,32 +29,6 @@ MatrixPrintForm( colwidths = NULL, indent_size = 2 ) - -matrix_print_form( - strings = NULL, - spans, - aligns, - formats, - row_info, - line_grouping = seq_len(NROW(strings)), - ref_fnotes = list(), - nlines_header, - nrow_header, - has_topleft = TRUE, - has_rowlabs = has_topleft, - expand_newlines = TRUE, - main_title = "", - subtitles = character(), - page_titles = character(), - main_footer = "", - prov_footer = character(), - header_section_div = NA_character_, - horizontal_sep = default_hsep(), - col_gap = 3, - table_inset = 0L, - colwidths = NULL, - indent_size = 2 -) } \arguments{ \item{strings}{character matrix. Matrix of formatted, ready to @@ -182,3 +155,7 @@ Matrix Print Form - Intermediate Representation for ASCII Table Printing The bare constructor for the \code{MatrixPrintForm} should generally only be called by \code{matrix_form} custom methods, and almost never from other code. } +\examples{ +basic_matrix_form(iris) # calls matrix_form that calls this constructor + +} diff --git a/man/basic_pagdf.Rd b/man/basic_pagdf.Rd index 44cf5e0d3..85d9ede78 100644 --- a/man/basic_pagdf.Rd +++ b/man/basic_pagdf.Rd @@ -28,7 +28,7 @@ basic_pagdf( defaults to \code{"root"}, and generally should not matter to end users.} } \value{ -A data.frame suitable for use in both the \code{matrix_print_form} constructor and the pagination machinery +A data.frame suitable for use in both the \code{MatrixPrintForm} constructor and the pagination machinery } \description{ Returns a minimal pagination info data.frame (with no sibling/footnote/etc info). diff --git a/man/export_as_pdf.Rd b/man/export_as_pdf.Rd index 7a08de231..7b28f0c8f 100644 --- a/man/export_as_pdf.Rd +++ b/man/export_as_pdf.Rd @@ -56,7 +56,8 @@ be inverted for landscape? Defaults to \code{FALSE}, ignored when bottom, left, top, and right sides of the page.} \item{min_siblings}{numeric. Minimum sibling rows which must appear on either side of pagination row for a -mid-subtable split to be valid. Defaults to 2.} +mid-subtable split to be valid. Defaults to 2 for tables. It is automatically turned off +(by using only 0) for listings.} \item{font_family}{character(1). Name of a font family. An error will be thrown if the family named is not monospaced. Defaults diff --git a/man/export_as_txt.Rd b/man/export_as_txt.Rd index a04d7e07d..e5c9adeb1 100644 --- a/man/export_as_txt.Rd +++ b/man/export_as_txt.Rd @@ -100,7 +100,8 @@ completely if \code{tf_wrap} is \code{FALSE}.} use with vertical pagination.} \item{min_siblings}{numeric. Minimum sibling rows which must appear on either side of pagination row for a -mid-subtable split to be valid. Defaults to 2.} +mid-subtable split to be valid. Defaults to 2 for tables. It is automatically turned off +(by using only 0) for listings.} \item{nosplitin}{character. List of names of sub-tables where page-breaks are not allowed, regardless of other considerations. Defaults to none.} diff --git a/man/pag_indices_inner.Rd b/man/pag_indices_inner.Rd index 85e312186..b29e7caac 100644 --- a/man/pag_indices_inner.Rd +++ b/man/pag_indices_inner.Rd @@ -7,6 +7,8 @@ pag_indices_inner( pagdf, rlpp, + lpp_or_cpp = NA_integer_, + context_lpp_or_cpp = NA_integer_, min_siblings, nosplitin = character(), verbose = FALSE, @@ -22,8 +24,17 @@ either \code{make_rows_df} or \code{make_cols_df}.} \item{rlpp}{numeric. Maximum number of \emph{row} lines per page (not including header materials), including (re)printed header and context rows} +\item{lpp_or_cpp}{numeric. Total maximum number of \emph{row} lines or content (column-wise characters) per page +(including header materials and context rows). This is only for informative results with \code{verbose = TRUE}. +It will print \code{NA} if not specified by the pagination machinery.} + +\item{context_lpp_or_cpp}{numeric. Total number of context \emph{row} lines or content (column-wise characters) +per page (including header materials). Uses \code{NA} if not specified by the pagination machinery and is only +for informative results with \code{verbose = TRUE}.} + \item{min_siblings}{numeric. Minimum sibling rows which must appear on either side of pagination row for a -mid-subtable split to be valid. Defaults to 2.} +mid-subtable split to be valid. Defaults to 2 for tables. It is automatically turned off +(by using only 0) for listings.} \item{nosplitin}{character. List of names of sub-tables where page-breaks are not allowed, regardless of other considerations. Defaults to none.} diff --git a/man/paginate_indices.Rd b/man/paginate_indices.Rd index 59c794aa7..e3fa1f4cc 100644 --- a/man/paginate_indices.Rd +++ b/man/paginate_indices.Rd @@ -119,7 +119,8 @@ this is calculated automatically based on the specified page size). \code{NULL} indicates no horizontal pagination should occur.} \item{min_siblings}{numeric. Minimum sibling rows which must appear on either side of pagination row for a -mid-subtable split to be valid. Defaults to 2.} +mid-subtable split to be valid. Defaults to 2 for tables. It is automatically turned off +(by using only 0) for listings.} \item{nosplitin}{character. List of names of sub-tables where page-breaks are not allowed, regardless of other considerations. Defaults to none.} diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000000000000000000000000000000000000..0e35ba715002a7c45501bfbaf976b1de372db6b2 GIT binary patch literal 3611 zcmZ`+c{r479~L1~kuA+3Ua}TmGZH1kf@v4?D5R7zR16`xN+ zwkQde7+XqdQzs%z2o2RY(>bSeuJc{rdtLAKUeEpfe)sQwp7)>oR&vByYM?ZA5K8fr z@o(c<@gu%81PagsD93(97#Sfza~gz)i4-yp4?}<|&H$~2*3m+tbWyt6SQJJL0oqdn z|L>kF5hiiEoB=Buo*F_V&;bVqOl82FHb)vIkU@ZG++7__ZA}yh`!S2ch13uS4RBuX#*`|w(2~e40V!xgRC8%jV7*9t8}} zm5Ou9uGofFeH~Y7o?WMqc4~`L-RxE*ZuA6ILOS_b^uapYTJ4Xx*1>7l%< zLq;FL@TlfYXuhYr1d=oeIjZOcjkggzudN>(T^t5IAF;&yM7jqad25O(R;D7AeO;0> z&x)tNVX^F|(z_pN3F~F!cSM_cL|*gpnyRL5JrRIU?{N|#LGUv7_nVVVjN}9|TJ71NlN}eeRn)aDig@0+~*=gQX>=Yu#mW&kK zrzKR;>3v<4#9trafZdjrB-Qy~5sj78OlZ1up2`=!Yd*=L>%wbMPsE}4O3}Doq6Sye zwM2K{wKU5PR}>PJuRbGI#!EDLc1E^Lt|iSnyYjw|gn)$w%F*uJ_J?wkrzWrDmbjN- zN~@d%9Sg1=9CaI2{T1<9)ZX&=mHwfDX&zYJ09lZ(Y3WgXd2sJ^{j}%`mMtleSVG7^ zW$lTzlTnte=dDN9OOIsfpF;Lz;4A7p|7|cPGn=-vn|A#e33U?@wJS<2ir+AcnYeEf zrryLJ^))(@df=YhYj3Iw)q^VDjJzfGa@RtJNcZw$-zR9@GFl{N+o7x?c~$WYq5mXV zo9)MIl;jLrVr`pk!%Y>%KBpeJN4*l)oa}kn2xsIVqtv0~WF4f4QHxiU50#%&DNuN! z&<>n^U>PVvGxD-~X+~Bql7FRg+o^cJ=l-p#ixTb!MpfbczE0s4sUAA6E3Ur(zF6y7 z5{^4z{pp&R{{!pOHTRsn%Uw%h*AL0V4QRJ;^N4y{`V#+dRubynsgve!oYGV` zRD)Fsu1Qr6kW0%bW7KlSYX-a1T)TpQ(3x1?KnY1~P?JncE3j#>DYVIactTQbZ;A8} z-}HwSG#k%munpZb+#K9GW|SXe9v`Txef<7v#MMuaZAPCxwj6zVO?#9%Ix^aHE$rH> z5fkD?V$$(G@yl63oZ_UU+p%#X+n=8p}JEsZ=Jt{OHd z{p@=AKXWAoRqf^*NvmbTZoT$a#r5V>Wdnp{MAzBufvbTls0vt@@s**}`nff+RXegL z(kb#(~^+`fPsL#0KY(uK-11o$?9DaU4F@5lWQ|GGLL0o_Arpf zXm@R4tpPoozXahS+FtubXyo_~Oue2hsv0GYPU+wKi2r?Ce~QN7 z?jyU+(go6`?ZigT=5>*vEbn2BM2+nlZR$l{NY8Gc(E6Dsc1S3tfczqa*_(V!Jj5kr zgs@y)lc(|IX3y#~-zDEyE!9&eSxj;;xwq*#A#9}ZSGi-iJ3F3yOH3?HykF9fA0E1c z8mb%nB#_>NAcO`Lgqaye=+~Syc)v0>-s$x*`so)bsS4Xmw&{JP5k1T6%fC!zw#>B9 zd}sa2$vc{GP3>goFu$;@sKgCE5vE9?)!E*p%4@+@Q>Lt7|1p1sTH)F!q~KMXRW-`J z=d8ASQG+Ry;=j4f(O-G6^v0VWhdpGyq?~%C7TXYe<~!!Q^cL?e6LIh3u9@`SIUmn7 zEi2|XeQYX{(4Sz@X)I5*4!FO1rfqrW)b^>cQwf7{gL5TocQd+jPch}PghaO23dQch zi#zQax*gXV@E{?VzgD4Lp-*7}mxnuiC9+hqRQ$^2(xbiMz2|zZ2{p$&di>KyQpN8v zdI@h!-(H@qlwzw-v`~#Y50+rxuod1~M5Jq~k9p>Itgnl8E9EO$i4C1boz^(LpkITx>L1mo)tB|lv(B7t#u~C;=_wOZI&#OU&il{_)3$edyAay3aAQKIxKa z7TtQ7X42K?sn1lOVw;Kc6;<|fw&6-rwl%f~Y+g~`lRMVW_j{Z_%6yj709}7nLSnf; za(^>6`+TBlud0V83zT~$W#+y^+4-evo5h;|!Bw z^VvGn!#=7eXs+VfleUPq+K-=}j<{F4d3djpYXcVgBX6?@1WJ?Bm=~G)8?qQnz17%$ zc5BPw(rXPLx?AvM{m18rmFBW$We@%m-q6%rUimhvZ(&Vt z#Mqtg`&;<9(B0El#EXu+FUmi7o-y;`!@CheyKUq`{%K=+4S0*PNE#epo{DA_d|3N< zDB|Vk&AROaQd$0ieji)kQLoYO#1y|3+>kR6*ehU|B9qbz8v4y63-zKW(>BhJc(m6R zw(X|Q4d36)elzRzg!0n5S-$;2+m~r~cFj~1oy?l>qDwKG-W3kFr)^wXlaA5(TIV+d z7$2N5HdqYkOf)1+)TtbTzOTgGnwI~9?@k)PE$@47)vL@@0T21Fhi@JpJDXS8edxe< z-;GD_#=~xhZ=$s%4Rycyu56CfUOsyD_S5gf^UwnPbmglDvNp*7!Y!v*`fH8Z(C=** z!^E{)7U~ub9J&}Y{bkR}r}@eZhoTt1wWQ?@jsgF}E&gG}^?uq=#2;4Ng3R%iL^8*V zb8YKiD-R;sluRf72_QfmF(?S4L1Y5Qu=@Zyx?m`g%%B7M81Mvx0z)Jy2u7fEbihCg zCo<6KL;wt?;ZJfrE}p>PT3rH>Mqq>nk)Ut@goz}Mmjy%d1R8}5fX8SMw~*6`ClDYq zi~s|PoKbWl9RM}S6gUtH0zldikpzz2Cz0@f!$TP4U_6ZxO2RW>0Hg#{$k1`lH2e={ zI@h`T{Vj`x)1V-P7Jx-){d@q7uCBH&5Cr_h(473leE{-L429u@l7C=m6erpI6T|BN z52mfpi6;N3(?S0apEe4G{i_b9;fW-O#))tM=t7Ky04x9=CI?XfZnkp_I literal 0 HcmV?d00001 diff --git a/tests/testthat/test-txt_wrap.R b/tests/testthat/test-txt_wrap.R index 723561c8c..2b6810c19 100644 --- a/tests/testthat/test-txt_wrap.R +++ b/tests/testthat/test-txt_wrap.R @@ -51,14 +51,13 @@ test_that("tf_wordwrap and table inset work (including together)", { ) }) -test_that("toString() throws a warning when newline is in string", { +test_that("toString() is silent when newline is in decorations (footnotes, titles) as matrix_form constructor expands all newlines", { bmf <- basic_matrix_form(iris) main_title(bmf) <- "some\nvery\nspacious\ntitle" prov_footer(bmf) <- "some\nvery\nspacious\nfooter" bmf$ref_footnotes <- "some\nvery\nspacious\nreference" expect_silent(toString(bmf, tf_wrap = FALSE)) - expect_warning(expect_error(toString(bmf, tf_wrap = TRUE), "in a string that was meant to be wrapped")) - # xxx the warning will go away as it is not necessary once \\n will be added + expect_silent(toString(bmf, tf_wrap = TRUE)) }) test_that("works with words that are too big (no warning)", { @@ -302,3 +301,28 @@ test_that("toString and wrapping cooperates well with separator divisors", { mf_rinfo(bmf)$trailing_sep[c(1, 3, 4)] <- " " expect_silent(toString(bmf, widths = c(4, 4, 4))) }) + +test_that("max_width is handled correctly as expected", { + tmp_width <- getOption("width") + options("width" = 150) + expect_equal(.handle_max_width(tf_wrap = TRUE, max_width = NULL), 150) + options("width" = tmp_width) + expect_null(.handle_max_width(FALSE, NULL)) + suppressMessages( + expect_warning( + expect_null(.handle_max_width(FALSE, "asd")) + ) + ) + expect_equal(.handle_max_width(tf_wrap = TRUE, max_width = 100), 100) + expect_equal(.handle_max_width(tf_wrap = TRUE, max_width = 100, cpp = 150), 100) + suppressMessages( + expect_error(.handle_max_width(tf_wrap = TRUE, max_width = "no")) + ) + suppressMessages( + expect_error(.handle_max_width(tf_wrap = TRUE, max_width = "auto")) + ) + expect_equal(.handle_max_width( + tf_wrap = TRUE, max_width = "auto", + inset = 1, colwidths = c(10, 20, 30), col_gap = 2 + ), 65) +}) diff --git a/vignettes/formatters.Rmd b/vignettes/formatters.Rmd index f9bfbe7d2..066d7ca09 100644 --- a/vignettes/formatters.Rmd +++ b/vignettes/formatters.Rmd @@ -130,7 +130,7 @@ matrix_form.data.frame <- function(df) { ## build up fake pagination df, rowdf <- basic_pagdf(row.names(df)) - matrix_print_form( + MatrixPrintForm( strings = strings, aligns = aligns, spans = matrix(1, nrow = fnr, ncol = fnc),