From bdac5b7f0212348b00ff16915a45ee187f2afb46 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Fri, 6 Oct 2023 11:39:14 +0200 Subject: [PATCH 1/6] fixes --- man/tostring.Rd | 8 ++++++++ tests/testthat/test-printing.R | 35 +++++++++++++++++++--------------- 2 files changed, 28 insertions(+), 15 deletions(-) diff --git a/man/tostring.Rd b/man/tostring.Rd index 8b34cff94..352b5cc99 100644 --- a/man/tostring.Rd +++ b/man/tostring.Rd @@ -43,6 +43,11 @@ a string representation of \code{x} as it appears when printed. \description{ Transform a complex object into a string representation ready to be printed or written to a plain-text file + +All objects that are printed to console pass by \code{toString}. This function allows +fundamental formatting specifications for the final output, like column widths and +relative wrapping (\code{width}), title and footer wrapping (\code{tf_wrap = TRUE} and +\code{max_width}), or horizontal separator character (e.g. \code{hsep = "+"}). } \details{ Manual insertion of newlines is not supported when \code{tf_wrap} is on @@ -68,3 +73,6 @@ tbl <- build_table(lyt, iris2) cat(toString(tbl, col_gap = 3)) } +\seealso{ +\code{\link[formatters:wrap_string]{wrap_string()}} +} diff --git a/tests/testthat/test-printing.R b/tests/testthat/test-printing.R index 1b3d8e4f9..42945cb2e 100644 --- a/tests/testthat/test-printing.R +++ b/tests/testthat/test-printing.R @@ -414,9 +414,10 @@ test_that("Cell and column label wrapping works in printing", { expected <- c(" Incredib", " ly long ", " column ", - " name to ", - " be ") - expect_identical(splitted_res[1:5], expected) + " name ", + " to be ", + " wrapped ") + expect_identical(splitted_res[1:6], expected) # String replacement of NAs wider than expected works with cell wrapping expected <- c("Mean A very ", @@ -487,9 +488,11 @@ test_that("row label indentation is kept even if there are newline characters", # Matrix form and toString mf_a <- matrix_form(tbl_a, TRUE, FALSE) - expect_error(res_a <- toString(mf_a, widths = c(15, 12, 12)), - regexp = "Inserted width\\(s\\) for column\\(s\\) 1 is\\(are\\) not wide enough for the desired indentation.") - res_a <- toString(mf_a, widths = c(16, 12, 12)) + expect_error( + res_a <- toString(mf_a, widths = c(15, 12, 12)), + regexp = "Inserted width for row label column is not wide enough" + ) + expect_silent(res_a <- toString(mf_a, widths = c(17, 12, 12))) # 2 is the indentation of summarize_row_groups # 1 is the standard indentation # 1 + 1 + 4 is the standard nesting indentation (twice) + 4 manual indentation (indentation_mod) @@ -532,14 +535,16 @@ test_that("row label indentation is kept even if there are newline characters", main_title(tbl_b) <- "Summary of \nTime and \nTreatment" subtitles(tbl_b) <- paste("Number: ", 1:3) main_footer(tbl_b) <- "NE: Not Estimable" + + # These errors happen but they should not -> to fix matrix_form (in the second case) + mf_b <- matrix_form(tbl_b, indent_rownames = TRUE, expand_newlines = FALSE) + expect_error( + toString(mf_b, widths = c(17, 12, 12)), + "Found newline characters" + ) mf_b <- matrix_form(tbl_b, indent_rownames = TRUE, expand_newlines = TRUE) - res_b <- toString(mf_b, widths = c(16, 12, 12)) - res_b <- strsplit(res_b, "\n")[[1]] - - # Taking out the splitted col names and the trailing 0s lets check it is the same none-the-less - res_a <- res_a[-10] - res_b <- res_b[-c(10, 11)] - expect_identical(res_a[1:10], res_b[1:10]) # First part - expect_identical(res_a[10:27], res_b[10:27]) # Center part - expect_identical(res_a[seq(28, length(res_a))], res_b[seq(41, length(res_b))]) # Final part + expect_error( + toString(mf_b, widths = c(17, 12, 12)), + "The sum of the expected nrows header and nrows of content" + ) }) From b5040fa0438c7e11eb12d9715e543f30966aa63f Mon Sep 17 00:00:00 2001 From: Melkiades Date: Fri, 6 Oct 2023 18:23:20 +0200 Subject: [PATCH 2/6] rox --- man/brackets.Rd | 4 ++-- man/int_methods.Rd | 40 ++++++++++++++++++++-------------------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/man/brackets.Rd b/man/brackets.Rd index 7a3748c23..55fb670cb 100644 --- a/man/brackets.Rd +++ b/man/brackets.Rd @@ -3,12 +3,12 @@ \name{brackets} \alias{brackets} \alias{[<-,VTableTree,ANY,ANY,list-method} -\alias{[,VTableTree,logical,logical-method} +\alias{[,VTableTree,logical,logical,ANY-method} \title{Retrieve and assign elements of a \code{TableTree}} \usage{ \S4method{[}{VTableTree,ANY,ANY,list}(x, i, j, ...) <- value -\S4method{[}{VTableTree,logical,logical}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,logical,ANY}(x, i, j, ..., drop = FALSE) } \arguments{ \item{x}{\code{TableTree}} diff --git a/man/int_methods.Rd b/man/int_methods.Rd index 9b4c89405..0044a2448 100644 --- a/man/int_methods.Rd +++ b/man/int_methods.Rd @@ -331,16 +331,16 @@ \alias{tt_at_path<-,VTableTree,ANY,NULL-method} \alias{tt_at_path<-,VTableTree,ANY,TableRow-method} \alias{[<-,VTableTree,ANY,ANY,CellValue-method} -\alias{[,VTableTree,logical,ANY-method} -\alias{[,VTableTree,logical,missing-method} -\alias{[,VTableTree,ANY,logical-method} -\alias{[,VTableTree,ANY,missing-method} -\alias{[,VTableTree,missing,ANY-method} -\alias{[,VTableTree,ANY,character-method} -\alias{[,VTableTree,character,ANY-method} -\alias{[,VTableTree,character,character-method} -\alias{[,VTableTree,missing,numeric-method} -\alias{[,VTableTree,numeric,numeric-method} +\alias{[,VTableTree,logical,ANY,ANY-method} +\alias{[,VTableTree,logical,missing,ANY-method} +\alias{[,VTableTree,ANY,logical,ANY-method} +\alias{[,VTableTree,ANY,missing,ANY-method} +\alias{[,VTableTree,missing,ANY,ANY-method} +\alias{[,VTableTree,ANY,character,ANY-method} +\alias{[,VTableTree,character,ANY,ANY-method} +\alias{[,VTableTree,character,character,ANY-method} +\alias{[,VTableTree,missing,numeric,ANY-method} +\alias{[,VTableTree,numeric,numeric,ANY-method} \alias{cell_values,VTableTree-method} \alias{cell_values,TableRow-method} \alias{cell_values,LabelRow-method} @@ -1054,25 +1054,25 @@ spl_varnames(object) <- value \S4method{[}{VTableTree,ANY,ANY,CellValue}(x, i, j, ...) <- value -\S4method{[}{VTableTree,logical,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,ANY,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,logical,missing}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,missing,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,logical}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,logical,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,missing}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,missing,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,missing,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,missing,ANY,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,character}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,character,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,character,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,character,ANY,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,character,character}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,character,character,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,missing,numeric}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,missing,numeric,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,numeric,numeric}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,numeric,numeric,ANY}(x, i, j, ..., drop = FALSE) \S4method{cell_values}{VTableTree}(tt, rowpath = NULL, colpath = NULL, omit_labrows = TRUE) From 0596caa8028369ab1493addb00e7e0aea1d9c558 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sat, 7 Oct 2023 12:12:07 +0200 Subject: [PATCH 3/6] fix mf_rinfo is null --- man/brackets.Rd | 4 ++-- man/int_methods.Rd | 40 +++++++++++++++---------------- tests/testthat/test-printing.R | 5 ---- tests/testthat/test-regressions.R | 1 + 4 files changed, 23 insertions(+), 27 deletions(-) diff --git a/man/brackets.Rd b/man/brackets.Rd index 55fb670cb..7a3748c23 100644 --- a/man/brackets.Rd +++ b/man/brackets.Rd @@ -3,12 +3,12 @@ \name{brackets} \alias{brackets} \alias{[<-,VTableTree,ANY,ANY,list-method} -\alias{[,VTableTree,logical,logical,ANY-method} +\alias{[,VTableTree,logical,logical-method} \title{Retrieve and assign elements of a \code{TableTree}} \usage{ \S4method{[}{VTableTree,ANY,ANY,list}(x, i, j, ...) <- value -\S4method{[}{VTableTree,logical,logical,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,logical}(x, i, j, ..., drop = FALSE) } \arguments{ \item{x}{\code{TableTree}} diff --git a/man/int_methods.Rd b/man/int_methods.Rd index 0044a2448..9b4c89405 100644 --- a/man/int_methods.Rd +++ b/man/int_methods.Rd @@ -331,16 +331,16 @@ \alias{tt_at_path<-,VTableTree,ANY,NULL-method} \alias{tt_at_path<-,VTableTree,ANY,TableRow-method} \alias{[<-,VTableTree,ANY,ANY,CellValue-method} -\alias{[,VTableTree,logical,ANY,ANY-method} -\alias{[,VTableTree,logical,missing,ANY-method} -\alias{[,VTableTree,ANY,logical,ANY-method} -\alias{[,VTableTree,ANY,missing,ANY-method} -\alias{[,VTableTree,missing,ANY,ANY-method} -\alias{[,VTableTree,ANY,character,ANY-method} -\alias{[,VTableTree,character,ANY,ANY-method} -\alias{[,VTableTree,character,character,ANY-method} -\alias{[,VTableTree,missing,numeric,ANY-method} -\alias{[,VTableTree,numeric,numeric,ANY-method} +\alias{[,VTableTree,logical,ANY-method} +\alias{[,VTableTree,logical,missing-method} +\alias{[,VTableTree,ANY,logical-method} +\alias{[,VTableTree,ANY,missing-method} +\alias{[,VTableTree,missing,ANY-method} +\alias{[,VTableTree,ANY,character-method} +\alias{[,VTableTree,character,ANY-method} +\alias{[,VTableTree,character,character-method} +\alias{[,VTableTree,missing,numeric-method} +\alias{[,VTableTree,numeric,numeric-method} \alias{cell_values,VTableTree-method} \alias{cell_values,TableRow-method} \alias{cell_values,LabelRow-method} @@ -1054,25 +1054,25 @@ spl_varnames(object) <- value \S4method{[}{VTableTree,ANY,ANY,CellValue}(x, i, j, ...) <- value -\S4method{[}{VTableTree,logical,ANY,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,logical,missing,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,missing}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,logical,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,logical}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,missing,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,missing}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,missing,ANY,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,missing,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,character,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,character}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,character,ANY,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,character,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,character,character,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,character,character}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,missing,numeric,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,missing,numeric}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,numeric,numeric,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,numeric,numeric}(x, i, j, ..., drop = FALSE) \S4method{cell_values}{VTableTree}(tt, rowpath = NULL, colpath = NULL, omit_labrows = TRUE) diff --git a/tests/testthat/test-printing.R b/tests/testthat/test-printing.R index 42945cb2e..129dc0e27 100644 --- a/tests/testthat/test-printing.R +++ b/tests/testthat/test-printing.R @@ -542,9 +542,4 @@ test_that("row label indentation is kept even if there are newline characters", toString(mf_b, widths = c(17, 12, 12)), "Found newline characters" ) - mf_b <- matrix_form(tbl_b, indent_rownames = TRUE, expand_newlines = TRUE) - expect_error( - toString(mf_b, widths = c(17, 12, 12)), - "The sum of the expected nrows header and nrows of content" - ) }) diff --git a/tests/testthat/test-regressions.R b/tests/testthat/test-regressions.R index a0477ce3f..8aed25250 100644 --- a/tests/testthat/test-regressions.R +++ b/tests/testthat/test-regressions.R @@ -16,6 +16,7 @@ test_that("manually created label l rows are always visible", ## was error before rtables 0.3.2.16 test_that("printing table with 0 rows works", { norows <- rtable(c("hi", "lo")) + mf_rinfo(matrix_form(norows)) capture.output({prout <- print(norows)}) expect_identical(prout, norows) }) From 1ca097d31134d631430c7a7eea8d538276817532 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Tue, 10 Oct 2023 15:27:29 +0200 Subject: [PATCH 4/6] added readability --- R/tt_paginate.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/R/tt_paginate.R b/R/tt_paginate.R index 246e5763b..cb89bcd28 100644 --- a/R/tt_paginate.R +++ b/R/tt_paginate.R @@ -3,7 +3,7 @@ ## 1. user defined number of lines per page ## 2. all lines have the same height ## 3. header always reprinted on all pages -## 4. "Label-rows", i.e. content rows above break in the nesting structure, optionaly reprinted (default TRUE) +## 4. "Label-rows", i.e. content rows above break in the nesting structure, optionally reprinted (default TRUE) ## 5. Never (?) break on a "label"/content row ## 6. Never (?) break on the second (i.e. after the first) data row at a particular leaf Elementary table. ## @@ -150,6 +150,8 @@ pos_to_path <- function(pos) { +# make_row_df --------------------------------------------------------------- +# #' @inherit formatters::make_row_df #' # #' @note the technically present root tree node is excluded from the summary @@ -478,6 +480,7 @@ setMethod("inner_col_df", "LayoutColTree", flines } +# Pagination --------------------------------------------------------------- #' Pagination of a `TableTree` #' @@ -532,10 +535,8 @@ setMethod("inner_col_df", "LayoutColTree", #' @param nosplitin character. List of names of sub-tables where page-breaks are not allowed, regardless of other #' considerations. Defaults to none. #' -#' @export #' @return for \code{pag_tt_indices} a list of paginated-groups of row-indices of \code{tt}. For \code{paginate_table}, #' The subtables defined by subsetting by the indices defined by \code{pag_tt_indices}. -#' @rdname paginate #' #' @examples #' @@ -582,7 +583,8 @@ setMethod("inner_col_df", "LayoutColTree", #' cat("\n\n") #' }) #' -#' +#' @rdname paginate +#' @export pag_tt_indices <- function(tt, lpp = 15, min_siblings = 2, nosplitin = character(), @@ -685,16 +687,16 @@ setMethod("do_forced_paginate", "VTableTree", non_null_na <- function(x) !is.null(x) && is.na(x) -#' @export #' @aliases paginate_table #' @param cpp numeric(1) or NULL. Width (in characters) of the pages for #' horizontal pagination. `NA` (the default) indicates `cpp` should be inferred from #' the page size; `NULL` indicates no horizontal pagination should be done #' regardless of page size. -#' @rdname paginate #' @inheritParams formatters::vert_pag_indices #' @inheritParams formatters::page_lcpp #' @inheritParams formatters::toString +#' @rdname paginate +#' @export paginate_table <- function(tt, page_type = "letter", font_family = "Courier", From af691249edaaaa780f1ca86b39ce2c6c1384a64f Mon Sep 17 00:00:00 2001 From: Melkiades Date: Tue, 10 Oct 2023 15:46:23 +0200 Subject: [PATCH 5/6] very relevant fix on this side --- man/paginate.Rd | 1 - 1 file changed, 1 deletion(-) diff --git a/man/paginate.Rd b/man/paginate.Rd index 9160481fc..449df4b73 100644 --- a/man/paginate.Rd +++ b/man/paginate.Rd @@ -242,5 +242,4 @@ tmp <- lapply(tbls, function(tbli) { cat("\n\n") }) - } From ec8777ead70d4936058efa25baedf032d5c6e6a6 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Tue, 10 Oct 2023 15:48:05 +0200 Subject: [PATCH 6/6] add NEWS --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 21b5c16ab..d10d3145b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,6 @@ ## rtables 0.6.4.9000 +### New Features +* Added support for white spaces in all labels and text by redesigning of wrapping functions in `formatters`. ## rtables 0.6.4 ### New Features