hook up round_type support

R/rlistings.R

@@ -284,7 +284,12 @@ get_keycols <- function(df) {
 #' @export
 setMethod(
   "matrix_form", "listing_df",
-  rix_form <- function(obj, indent_rownames = FALSE, expand_newlines = TRUE, fontspec = font_spec, col_gap = 3L) {
+  rix_form <- function(obj,
+                       indent_rownames = FALSE,
+                       expand_newlines = TRUE,
+                       fontspec = font_spec,
+                       col_gap = 3L,
+                       round_type = c("iec", "sas")) {
     ##  we intentionally silently ignore indent_rownames because listings have
     ## no rownames, but formatters::vert_pag_indices calls matrix_form(obj, TRUE)
     ## unconditionally.
@@ -306,7 +311,10 @@ setMethod(
     for (i in seq_along(keycols)) {
       kcol <- keycols[i]
       kcolvec <- listing[[kcol]]
-      kcolvec <- vapply(kcolvec, format_value, "", format = obj_format(kcolvec), na_str = obj_na_str(kcolvec))
+      kcolvec <- vapply(kcolvec, format_value, "",
+                        format = obj_format(kcolvec),
+                        na_str = obj_na_str(kcolvec),
+                        round_type = round_type)
       curkey <- paste0(curkey, kcolvec)
       disp <- c(TRUE, tail(curkey, -1) != head(curkey, -1))
       bodymat[disp, kcol] <- kcolvec[disp]
@@ -316,7 +324,10 @@ setMethod(
     if (length(nonkeycols) > 0) {
       for (nonk in nonkeycols) {
         vec <- listing[[nonk]]
-        vec <- vapply(vec, format_value, "", format = obj_format(vec), na_str = obj_na_str(vec))
+        vec <- vapply(vec, format_value, "",
+                      format = obj_format(vec),
+                      na_str = obj_na_str(vec),
+                      round_type = round_type)
         bodymat[, nonk] <- vec
       }
     }

R/rlistings_methods.R

@@ -14,7 +14,14 @@ dflt_courier <- font_spec("Courier", 9, 1)
 #'
 #' @export
 #' @name listing_methods
-print.listing_df <- function(x, widths = NULL, tf_wrap = FALSE, max_width = NULL, fontspec = NULL, col_gap = 3L,  ...) {
+print.listing_df <- function(x,
+                             widths = NULL,
+                             tf_wrap = FALSE,
+                             max_width = NULL,
+                             fontspec = NULL,
+                             col_gap = 3L,
+                             round_type = c("iec", "sas"),
+                             ...) {
   tryCatch({
     cat(
       toString(
@@ -24,8 +31,10 @@ print.listing_df <- function(x, widths = NULL, tf_wrap = FALSE, max_width = NULL
         max_width = max_width,
         fontspec = fontspec,
         col_gap = col_gap,
+        round_type = round_type,
         ...
-      )
+      ),
+      round_type = round_type
     )
   }, error = function(e) {
     if (nrow(x) == 0) {
@@ -40,12 +49,18 @@ print.listing_df <- function(x, widths = NULL, tf_wrap = FALSE, max_width = NULL
 #' @exportMethod toString
 #' @name listing_methods
 #' @aliases toString,listing_df-method
-setMethod("toString", "listing_df", function(x, widths = NULL, fontspec = NULL, col_gap = 3L,  ...) {
+setMethod("toString", "listing_df", function(x,
+                                             widths = NULL,
+                                             fontspec = NULL,
+                                             col_gap = 3L,
+                                             round_type = c("iec", "sas"),
+                                             ...) {
   toString(
-    matrix_form(x, fontspec = fontspec, col_gap = col_gap),
+    matrix_form(x, fontspec = fontspec, col_gap = col_gap, round_type = round_type),
     fontspec = fontspec,
     col_gap = col_gap,
     widths = widths,
+    round_type = round_type,
     ...
   )
 })
@@ -68,7 +83,7 @@ basic_run_lens <- function(x) {
 #'
 #' @rdname vec_nlines
 #' @keywords internal
-format_colvector <- function(df, colnm, colvec = df[[colnm]]) {
+format_colvector <- function(df, colnm, colvec = df[[colnm]], round_type = c("iec", "sas")) {
   if (missing(colvec) && !(colnm %in% names(df))) {
     stop("column ", colnm, " not found")
   }
@@ -77,7 +92,7 @@ format_colvector <- function(df, colnm, colvec = df[[colnm]]) {
     na_str <- rep("-", max(1L, length(na_str)))
   }
 
-  strvec <- vapply(colvec, format_value, "", format = obj_format(colvec), na_str = na_str)
+  strvec <- vapply(colvec, format_value, "", format = obj_format(colvec), na_str = na_str, round_type = round_type)
   strvec
 }
 
@@ -92,19 +107,23 @@ format_colvector <- function(df, colnm, colvec = df[[colnm]]) {
 #'   needed to render the elements of `vec` to width `max_width`.
 #'
 #' @keywords internal
-setGeneric("vec_nlines", function(vec, max_width = NULL, fontspec = dflt_courier) standardGeneric("vec_nlines"))
+setGeneric("vec_nlines", function(vec, max_width = NULL, fontspec = dflt_courier, round_type = c("iec", "sas")) {
+  standardGeneric("vec_nlines")
+})
 
 #' @param vec (`vector`)\cr a vector.
 #'
 #' @rdname vec_nlines
 #' @keywords internal
-setMethod("vec_nlines", "ANY", function(vec, max_width = NULL, fontspec = dflt_courier) {
+setMethod("vec_nlines", "ANY", function(vec, max_width = NULL, fontspec = dflt_courier, round_type = c("iec", "sas")) {
+  round_type <- match.arg(round_type)
   if (is.null(max_width)) {
     max_width <- floor(0.9 * getOption("width")) # default of base::strwrap
     # NB: flooring as it is used as <= (also in base::strwrap)
   }
   # in formatters for characters
-  unlist(lapply(format_colvector(colvec = vec), nlines, max_width = max_width, fontspec = fontspec))
+  unlist(lapply(format_colvector(colvec = vec, round_type = round_type), nlines,
+                max_width = max_width, fontspec = fontspec))
 })
 
 ## setMethod("vec_nlines", "character", function(vec, max_width = NULL) {
@@ -119,6 +138,8 @@ setMethod("vec_nlines", "ANY", function(vec, max_width = NULL, fontspec = dflt_c
 ##   ret[is.na(ret)] <- format_value(NA_character
 ## })
 
+
+
 #' Make pagination data frame for a listing
 #'
 #' @inheritParams formatters::make_row_df
@@ -146,7 +167,8 @@ setMethod(
            repr_inds = integer(),
            sibpos = NA_integer_,
            nsibs = NA_integer_,
-           fontspec = dflt_courier) {
+           fontspec = dflt_courier,
+           round_type = c("iec", "sas")) {
     ## assume sortedness by keycols
     keycols <- get_keycols(tt)
     dispcols <- listing_dispcols(tt)
@@ -172,7 +194,7 @@ setMethod(
     ## if that column has any rows wider than the previously recorded extent.
     for (col in dispcols) {
       ## duplicated from matrix_form method, refactor!
-      col_ext <- vec_nlines(tt[[col]], max_width = colwidths[col], fontspec = fontspec)
+      col_ext <- vec_nlines(tt[[col]], max_width = colwidths[col], fontspec = fontspec, round_type = round_type)
       extents <- ifelse(col_ext > extents, col_ext, extents)
     }
     ret <- data.frame(

inst/WORDLIST

@@ -1,22 +1,26 @@
 ADAE
+api
 Biomarker
 Cheatsheet
-Forkers
-Hoffmann
-ORCID
-README
-Repo
-Rua
-WIP
-api
 cheatsheet
 csv
 customizations
 de
 droppage
+Forkers
 formatter
 funder
+Hoffmann
+IEC
+iec
+ORCID
 pagesize
 paginations
+peforms
 pre
+README
+Repo
 repo
+Rua
+sas
+WIP

tests/testthat/test-print.R

@@ -160,3 +160,19 @@ testthat::test_that("listings supports wrapping", {
   # Fix C stack inf rec loop
   testthat::expect_silent(toString(lsting, widths = c(10, 10, 1)))
 })
+
+
+testthat::test_that("sas rounding support", {
+  df <- data.frame(id = 1:3 + 0.845, value = 0.845)
+  lsting <- as_listing(df, key_cols = "id", default_formatting = list(all = fmt_config("xx.xx")))
+  txt1 <- export_as_txt(lsting)
+  txtlns1 <- strsplit(txt1, "\n", fixed = TRUE)[[1]]
+  expect_true(all(grepl(".*84.*84 $", txtlns1[3:5])))
+  expect_false(any(grepl("85", txtlns1)))
+  txt2 <- export_as_txt(lsting, round_type = "sas")
+  txtlns2 <- strsplit(txt2, "\n", fixed = TRUE)[[1]]
+  expect_true(all(grepl(".*85.*85 $", txtlns2[3:5])))
+  expect_false(any(grepl("84", txtlns2)))
+  expect_identical(export_as_txt(lsting, round_type = "sas"),
+                   toString(lsting, round_type = "sas"))
+})