implement optional 'sas' rounding, pass round_type and na_str to fmt fun

R/generics.R

@@ -10,6 +10,7 @@
 #' (like [`MatrixPrintForm`]).
 #'
 #' @inheritParams open_font_dev
+#' @inheritParams format_value
 #' @param tt (`ANY`)\cr object representing the table-like object to be summarized.
 #' @param visible_only (`flag`)\cr should only visible aspects of the table structure be reflected
 #'   in this summary. Defaults to `TRUE`. May not be supported by all methods.
@@ -66,7 +67,8 @@ setGeneric("make_row_df", function(tt, colwidths = NULL, visible_only = TRUE,
                                    nsibs = NA_integer_,
                                    max_width = NULL,
                                    fontspec = font_spec(),
-                                   col_gap = 3L) {
+                                   col_gap = 3L,
+                                   round_type = c("iec", "sas")) {
   standardGeneric("make_row_df")
 })
 
@@ -82,7 +84,8 @@ setMethod("make_row_df", "MatrixPrintForm", function(tt, colwidths = NULL, visib
                                                      nsibs = NA_integer_,
                                                      max_width = NULL,
                                                      fontspec = font_spec(),
-                                                     col_gap = mf_colgap(tt) %||% 3L) {
+                                                     col_gap = mf_colgap(tt) %||% 3L,
+                                                     round_type = c("iec", "sas")) {
   msg <- paste0(
     "make_row_df can be used only on {rtables} table objects, and not on `matrix_form`-",
     "generated objects (MatrixPrintForm)."
@@ -96,6 +99,7 @@ setMethod("make_row_df", "MatrixPrintForm", function(tt, colwidths = NULL, visib
 #' it is useful to map the `rtable` to an in-between state with the formatted cells in a matrix form.
 #'
 #' @inheritParams make_row_df
+#' @inheritParams format_value
 #' @param obj (`ANY`)\cr object to be transformed into a ready-to-render form (a [`MatrixPrintForm`] object).
 #' @param indent_rownames (`flag`)\cr if `TRUE`, the row names column in the `strings` matrix of `obj`
 #'   will have indented row names (strings pre-fixed).
@@ -122,7 +126,8 @@ setGeneric("matrix_form", function(obj,
                                    expand_newlines = TRUE,
                                    indent_size = 2,
                                    fontspec = NULL,
-                                   col_gap = NULL) {
+                                   col_gap = NULL,
+                                   round_type = c("iec", "sas")) {
   standardGeneric("matrix_form")
 })
 
@@ -134,7 +139,8 @@ setMethod("matrix_form", "MatrixPrintForm", function(obj,
                                                      expand_newlines = TRUE,
                                                      indent_size = 2,
                                                      fontspec = NULL,
-                                                     col_gap = NULL) {
+                                                     col_gap = NULL,
+                                                     round_type = c("iec", "sas")) {
   if (!is.null(fontspec)) {
     mf_fontspec(obj) <- fontspec
   }

R/mpf_exporters.R

@@ -59,7 +59,8 @@ export_as_txt <- function(x,
                           page_break = "\\s\\n",
                           page_num = default_page_number(),
                           fontspec = font_spec(font_family, font_size, lineheight),
-                          col_gap = 3) {
+                          col_gap = 3,
+                          round_type = c("iec", "sas")) {
   # Processing lists of tables or listings
   if (.is_list_of_tables_or_listings(x)) {
     if (isFALSE(paginate)) {
@@ -94,11 +95,20 @@ export_as_txt <- function(x,
       rep_cols = rep_cols,
       page_num = page_num,
       fontspec = fontspec,
-      col_gap = col_gap
+      col_gap = col_gap,
+      round_type = round_type
     )
   } else {
-    mf <- matrix_form(x, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec, col_gap = col_gap)
-    mf_col_widths(mf) <- colwidths %||% propose_column_widths(mf, fontspec = fontspec)
+    mf <- matrix_form(
+      x,
+      TRUE,
+      TRUE,
+      indent_size = indent_size,
+      fontspec = fontspec,
+      col_gap = col_gap,
+      round_type = round_type
+    )
+    mf_col_widths(mf) <- colwidths %||% propose_column_widths(mf, fontspec = fontspec, round_type = round_type)
     pages <- list(mf)
   }
 
@@ -176,11 +186,11 @@ prep_header_line <- function(mf, i) {
 ##   )
 ## }
 
-mpf_to_dfbody <- function(mpf, colwidths, fontspec) {
-  mf <- matrix_form(mpf, indent_rownames = TRUE, fontspec = fontspec)
+mpf_to_dfbody <- function(mpf, colwidths, fontspec, round_type = c("iec", "sas")) {
+  mf <- matrix_form(mpf, indent_rownames = TRUE, fontspec = fontspec, round_type = round_type)
   nlr <- mf_nlheader(mf)
   if (is.null(colwidths)) {
-    colwidths <- propose_column_widths(mf, fontspec = fontspec)
+    colwidths <- propose_column_widths(mf, fontspec = fontspec, round_type = round_type)
   }
   mf$strings[1:nlr, 1] <- ifelse(nzchar(mf$strings[1:nlr, 1, drop = TRUE]),
     mf$strings[1:nlr, 1, drop = TRUE],
@@ -222,24 +232,25 @@ mpf_to_rtf <- function(mpf,
                        font_size = 8,
                        lineheight = 1,
                        fontspec = font_spec(font_family, font_size, lineheight),
+                       round_type = round_type,
                        ...) {
   if (!requireNamespace("r2rtf")) {
     stop("RTF export requires the 'r2rtf' package, please install it.")
   }
   if (fontspec$family != "Courier") {
     stop("Experimental RTF export does not currently support fonts other than Courier")
   }
-  mpf <- matrix_form(mpf, indent_rownames = TRUE, fontspec = fontspec)
+  mpf <- matrix_form(mpf, indent_rownames = TRUE, fontspec = fontspec, round_type = round_type)
   nlr <- mf_nlheader(mpf)
   if (is.null(colwidths)) {
-    colwidths <- propose_column_widths(mpf, fontspec = fontspec)
+    colwidths <- propose_column_widths(mpf, fontspec = fontspec, round_type = round_type)
   }
   mpf$strings[1:nlr, 1] <- ifelse(nzchar(mpf$strings[1:nlr, 1, drop = TRUE]),
     mpf$strings[1:nlr, 1, drop = TRUE],
     strrep(" ", colwidths)
   )
 
-  myfakedf <- mpf_to_dfbody(mpf, colwidths, fontspec = fontspec)
+  myfakedf <- mpf_to_dfbody(mpf, colwidths, fontspec = fontspec, round_type = round_type)
 
   rtfpg <- r2rtf::rtf_page(myfakedf,
     width = pg_width,
@@ -550,7 +561,8 @@ export_as_pdf <- function(x,
                           max_width = NULL,
                           colwidths = NULL,
                           fontspec = font_spec(font_family, font_size, lineheight),
-                          ttype_ok = FALSE) {
+                          ttype_ok = FALSE,
+                          round_type = c("iec", "sas")) {
   ## this has to happen at the very beginning before the first use of fontspec
   ## which happens in the default value of colwidths. yay lazy evaluation...
   if (missing(font_size) && !missing(fontsize)) {
@@ -626,10 +638,11 @@ export_as_pdf <- function(x,
       indent_size = indent_size,
       verbose = FALSE,
       rep_cols = rep_cols,
-      page_num = page_num
+      page_num = page_num,
+      round_type = round_type
     )
   } else {
-    mf <- matrix_form(x, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec)
+    mf <- matrix_form(x, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec, round_type = round_type)
     mf_col_widths(mf) <- colwidths %||% propose_column_widths(mf, fontspec = fontspec)
     tbls <- list(mf)
   }

R/pagination.R

@@ -568,6 +568,7 @@ pag_indices_inner <- function(pagdf,
 #'
 #' @inheritParams pag_indices_inner
 #' @inheritParams open_font_dev
+#' @inheritParams format_value
 #' @param obj (`ANY`)\cr object to be paginated. Must have a [matrix_form()] method.
 #' @param cpp (`numeric(1)`)\cr number of characters per page (width).
 #' @param colwidths (`numeric`)\cr vector of column widths (in characters) for use in vertical pagination.
@@ -588,11 +589,12 @@ vert_pag_indices <- function(obj,
                              verbose = FALSE,
                              rep_cols = 0L,
                              fontspec,
-                             nosplitin = character()) {
+                             nosplitin = character(),
+                             round_type = c("iec", "sas")) {
   if (is.list(nosplitin)) {
     nosplitin <- nosplitin[["cols"]]
   }
-  mf <- matrix_form(obj, indent_rownames = TRUE, fontspec = fontspec)
+  mf <- matrix_form(obj, indent_rownames = TRUE, fontspec = fontspec, round_type = round_type)
   clwds <- colwidths %||% propose_column_widths(mf, fontspec = fontspec)
   if (is.null(mf_cinfo(mf))) { ## like always, ugh.
     mf <- mpf_infer_cinfo(mf, colwidths = clwds, rep_cols = rep_cols, fontspec = fontspec)
@@ -998,6 +1000,7 @@ paginate_indices <- function(obj,
                              rep_cols = num_rep_cols(obj),
                              col_gap = 3,
                              fontspec = font_spec(font_family, font_size, lineheight),
+                             round_type = c("iec", "sas"),
                              verbose = FALSE) {
   ## this preserves backwards compatibility
   ## could start deprecation cycle of char input
@@ -1031,9 +1034,9 @@ paginate_indices <- function(obj,
 
   ## order is annoying here, since we won't actually need the mpf if
   ## we run into forced pagination, but life is short and this should work fine.
-  mpf <- matrix_form(obj, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec)
+  mpf <- matrix_form(obj, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec, round_type = round_type)
   if (is.null(colwidths)) {
-    colwidths <- mf_col_widths(mpf) %||% propose_column_widths(mpf, fontspec = fontspec)
+    colwidths <- mf_col_widths(mpf) %||% propose_column_widths(mpf, fontspec = fontspec, round_type = round_type)
   } else {
     mf_col_widths(mpf) <- colwidths
   }
@@ -1139,6 +1142,7 @@ paginate_indices <- function(obj,
       cpp = pg_size_spec$cpp, colwidths = colwidths,
       rep_cols = rep_cols, fontspec = fontspec,
       nosplitin = nosplitin[["cols"]],
+      round_type = round_type,
       verbose = verbose
     )
   }
@@ -1176,6 +1180,7 @@ paginate_to_mpfs <- function(obj,
                              # col_gap = 3, # this could be change in default - breaking change
                              col_gap = 3,
                              fontspec = font_spec(font_family, font_size, lineheight),
+                             round_type = c("iec", "sas"),
                              verbose = FALSE) {
   newdev <- open_font_dev(fontspec)
   if (newdev) {
@@ -1216,7 +1221,7 @@ paginate_to_mpfs <- function(obj,
     prov_footer(obj) <- c(prov_footer(obj), page_num)
   }
 
-  mpf <- matrix_form(obj, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec)
+  mpf <- matrix_form(obj, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec, round_type = round_type)
   # For listings, keycols are mandatory rep_num_cols
   if (is.null(rep_cols)) {
     rep_cols <- num_rep_cols(obj)
@@ -1230,7 +1235,7 @@ paginate_to_mpfs <- function(obj,
 
   # Checking colwidths
   if (is.null(colwidths)) {
-    colwidths <- mf_col_widths(mpf) %||% propose_column_widths(mpf, fontspec = fontspec)
+    colwidths <- mf_col_widths(mpf) %||% propose_column_widths(mpf, fontspec = fontspec, round_type = round_type)
   } else {
     cur_ncol <- ncol(mpf)
     if (!.is_listing_mf(mpf)) {
@@ -1299,18 +1304,19 @@ paginate_to_mpfs <- function(obj,
       fontspec = fontspec,
       verbose = verbose,
       rep_cols = rep_cols,
-      page_num = page_num
+      page_num = page_num,
+      round_type = round_type
     )
     return(deep_pag)
   } else if (has_page_title(fpags[[1]])) {
     obj <- fpags[[1]]
   }
 
   ## we run into forced pagination, but life is short and this should work fine.
-  mpf <- matrix_form(obj, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec)
+  mpf <- matrix_form(obj, TRUE, TRUE, indent_size = indent_size, fontspec = fontspec, round_type = round_type)
   num_rep_cols(mpf) <- rep_cols
   if (is.null(colwidths)) {
-    colwidths <- mf_col_widths(mpf) %||% propose_column_widths(mpf, fontspec = fontspec)
+    colwidths <- mf_col_widths(mpf) %||% propose_column_widths(mpf, fontspec = fontspec, round_type = round_type)
   }
   mf_col_widths(mpf) <- colwidths
   mf_colgap(mpf) <- col_gap
@@ -1336,7 +1342,8 @@ paginate_to_mpfs <- function(obj,
     rep_cols = rep_cols,
     verbose = verbose,
     col_gap = col_gap,
-    fontspec = fontspec
+    fontspec = fontspec,
+    round_type = round_type
   )
 
   pagmats <- lapply(page_indices$pag_row_indices, function(ii) {
@@ -1460,7 +1467,9 @@ diagnose_pagination <- function(obj,
                                 cpp = NA_integer_,
                                 min_siblings = 2,
                                 nosplitin = character(),
-                                colwidths = propose_column_widths(matrix_form(obj, TRUE), fontspec = fontspec),
+                                colwidths = propose_column_widths(matrix_form(obj, TRUE, round_type = round_type),
+                                  fontspec = fontspec, round_type = round_type
+                                ),
                                 tf_wrap = FALSE,
                                 max_width = NULL,
                                 indent_size = 2,
@@ -1473,6 +1482,7 @@ diagnose_pagination <- function(obj,
                                   font_size,
                                   lineheight
                                 ),
+                                round_type = c("iec", "sas"),
                                 ...) {
   new_dev <- open_font_dev(fontspec)
   if (new_dev) {
@@ -1496,7 +1506,8 @@ diagnose_pagination <- function(obj,
       col_gap = col_gap,
       min_siblings = min_siblings,
       nosplitin = nosplitin,
-      fontspec = fontspec
+      fontspec = fontspec,
+      round_type = round_type
     ))
   }
 
@@ -1520,6 +1531,7 @@ diagnose_pagination <- function(obj,
           min_siblings = min_siblings,
           nosplitin = nosplitin,
           fontspec = fontspec,
+          round_type = round_type,
           verbose = TRUE
         )
       )

R/tostring.R

@@ -607,6 +607,7 @@ calc_str_adj <- function(str, fontspec) {
 #'
 #' @inheritParams MatrixPrintForm
 #' @inheritParams open_font_dev
+#' @inheritParams format_value
 #' @param widths (`numeric` or  `NULL`)\cr Proposed widths for the columns of `x`. The expected
 #'   length of this numeric vector can be retrieved with `ncol(x) + 1` as the column of row names
 #'   must also be considered.
@@ -644,7 +645,8 @@ setMethod("toString", "MatrixPrintForm", function(x,
                                                   col_gap = mf_colgap(x),
                                                   hsep = NULL,
                                                   fontspec = font_spec(),
-                                                  ttype_ok = FALSE) {
+                                                  ttype_ok = FALSE,
+                                                  round_type = c("iec", "sas")) {
   checkmate::assert_flag(tf_wrap)
 
   ## we are going to use the pdf device and grid to understand the actual
@@ -660,7 +662,7 @@ setMethod("toString", "MatrixPrintForm", function(x,
       "If you truly want this behavior please set ttype_ok = TRUE in the call to toString/export_as_txt/export_as_pdf"
     )
   }
-  mat <- matrix_form(x, indent_rownames = TRUE, fontspec = fontspec)
+  mat <- matrix_form(x, indent_rownames = TRUE, fontspec = fontspec, round_type = round_type)
 
   # Check for \n in mat strings -> if there are any, matrix_form did not work
   if (any(grepl("\n", mf_strings(mat)))) {
@@ -694,7 +696,7 @@ setMethod("toString", "MatrixPrintForm", function(x,
   # if cells are decimal aligned, run propose column widths
   # if the provided widths is less than proposed width, return an error
   if (any_dec_align(mf_aligns(mat))) {
-    aligned <- propose_column_widths(x, fontspec = fontspec)
+    aligned <- propose_column_widths(x, fontspec = fontspec, round_type = round_type)
 
     # catch any columns that require widths more than what is provided
     if (!is.null(widths)) {
@@ -716,7 +718,7 @@ setMethod("toString", "MatrixPrintForm", function(x,
   # Column widths are fixed here
   if (is.null(widths)) {
     # if mf does not have widths -> propose them
-    widths <- mf_col_widths(x) %||% propose_column_widths(x, fontspec = fontspec)
+    widths <- mf_col_widths(x) %||% propose_column_widths(x, fontspec = fontspec, round_type = round_type)
   } else {
     mf_col_widths(x) <- widths
   }
@@ -1362,6 +1364,7 @@ spans_to_viscell <- function(spans) {
 #' Row names are also considered a column for the output.
 #'
 #' @inheritParams open_font_dev
+#' @inheritParams format_value
 #' @param x (`ANY`)\cr a `MatrixPrintForm` object, or an object with a `matrix_form` method.
 #' @param indent_size (`numeric(1)`)\cr indent size, in characters. Ignored when `x` is already
 #'   a `MatrixPrintForm` object in favor of information there.
@@ -1375,14 +1378,15 @@ spans_to_viscell <- function(spans) {
 #' @export
 propose_column_widths <- function(x,
                                   indent_size = 2,
-                                  fontspec = font_spec()) {
+                                  fontspec = font_spec(),
+                                  round_type = c("iec", "sas")) {
   new_dev <- open_font_dev(fontspec)
   if (new_dev) {
     on.exit(close_font_dev())
   }
 
   if (!is(x, "MatrixPrintForm")) {
-    x <- matrix_form(x, indent_rownames = TRUE, indent_size = indent_size, fontspec = fontspec)
+    x <- matrix_form(x, indent_rownames = TRUE, indent_size = indent_size, fontspec = fontspec, round_type = round_type)
   }
   body <- mf_strings(x)
   spans <- mf_spans(x)