From 30943e1add29086d2c6f87c3eba9c6861f7c93af Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Mon, 3 Feb 2025 15:49:12 -0800 Subject: [PATCH 1/2] hook up round_type support --- R/rlistings.R | 6 +++--- R/rlistings_methods.R | 29 +++++++++++++++++----------- inst/WORDLIST | 20 +++++++++++-------- man/listing_methods.Rd | 16 +++++++++++++-- man/make_row_df-listing_df-method.Rd | 7 ++++++- man/matrix_form-listing_df-method.Rd | 7 ++++++- man/vec_nlines.Rd | 16 ++++++++++++--- tests/testthat/test-print.R | 16 +++++++++++++++ 8 files changed, 88 insertions(+), 29 deletions(-) diff --git a/R/rlistings.R b/R/rlistings.R index 9b686a91..2028ffb4 100644 --- a/R/rlistings.R +++ b/R/rlistings.R @@ -284,7 +284,7 @@ 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 +306,7 @@ 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 +316,7 @@ 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 } } diff --git a/R/rlistings_methods.R b/R/rlistings_methods.R index cc5a3e36..68e699b3 100644 --- a/R/rlistings_methods.R +++ b/R/rlistings_methods.R @@ -14,7 +14,7 @@ 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 +24,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 +42,13 @@ 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 +71,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 +80,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 +95,20 @@ 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 +123,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 +152,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 +179,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( diff --git a/inst/WORDLIST b/inst/WORDLIST index 02351d79..e60bd98f 100644 --- a/inst/WORDLIST +++ b/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 diff --git a/man/listing_methods.Rd b/man/listing_methods.Rd index e4dd1e5e..554e0c5c 100644 --- a/man/listing_methods.Rd +++ b/man/listing_methods.Rd @@ -23,10 +23,18 @@ max_width = NULL, fontspec = NULL, col_gap = 3L, + round_type = c("iec", "sas"), ... ) -\S4method{toString}{listing_df}(x, widths = NULL, fontspec = NULL, col_gap = 3L, ...) +\S4method{toString}{listing_df}( + x, + widths = NULL, + fontspec = NULL, + col_gap = 3L, + round_type = c("iec", "sas"), + ... +) \S4method{[}{listing_df}(x, i, j, drop = FALSE) @@ -67,13 +75,17 @@ calculating string widths and heights, as returned by \code{\link[formatters:fon \item{col_gap}{(\code{numeric(1)})\cr space (in characters) between columns.} +\item{round_type}{(\code{"iec"} or \code{"sas"})\cr the type of rounding to perform. iec, +the default, peforms rounding compliant with IEC 60559 (see details), while +sas performs nearest-value rounding consistent with rounding within SAS.} + \item{...}{additional parameters passed to \code{\link[formatters:tostring]{formatters::toString()}}.} \item{i}{(\code{any})\cr object passed to base \code{[} methods.} \item{j}{(\code{any})\cr object passed to base \code{[} methods.} -\item{drop}{relevant for matrices and arrays. If \code{TRUE} the result is +\item{drop}{For matrices and arrays. If \code{TRUE} the result is coerced to the lowest possible dimension (see the examples). This only works for extracting elements, not for the replacement. See \code{\link[base]{drop}} for further details. diff --git a/man/make_row_df-listing_df-method.Rd b/man/make_row_df-listing_df-method.Rd index a2f43955..3053fc81 100644 --- a/man/make_row_df-listing_df-method.Rd +++ b/man/make_row_df-listing_df-method.Rd @@ -16,7 +16,8 @@ repr_inds = integer(), sibpos = NA_integer_, nsibs = NA_integer_, - fontspec = dflt_courier + fontspec = dflt_courier, + round_type = c("iec", "sas") ) } \arguments{ @@ -45,6 +46,10 @@ non-visible structural elements.} \item{fontspec}{(\code{font_spec})\cr a font_spec object specifying the font information to use for calculating string widths and heights, as returned by \code{\link[formatters:font_spec]{font_spec()}}.} + +\item{round_type}{(\code{"iec"} or \code{"sas"})\cr the type of rounding to perform. iec, +the default, peforms rounding compliant with IEC 60559 (see details), while +sas performs nearest-value rounding consistent with rounding within SAS.} } \value{ a \code{data.frame} with pagination information. diff --git a/man/matrix_form-listing_df-method.Rd b/man/matrix_form-listing_df-method.Rd index 35e42b4b..55bd6123 100644 --- a/man/matrix_form-listing_df-method.Rd +++ b/man/matrix_form-listing_df-method.Rd @@ -9,7 +9,8 @@ indent_rownames = FALSE, expand_newlines = TRUE, fontspec = font_spec, - col_gap = 3L + col_gap = 3L, + round_type = c("iec", "sas") ) } \arguments{ @@ -26,6 +27,10 @@ calculating string widths and heights, as returned by \code{\link[formatters:fon \item{col_gap}{(\code{numeric(1)})\cr the gap to be assumed between columns, in number of spaces with font specified by \code{fontspec}.} + +\item{round_type}{(\code{"iec"} or \code{"sas"})\cr the type of rounding to perform. iec, +the default, peforms rounding compliant with IEC 60559 (see details), while +sas performs nearest-value rounding consistent with rounding within SAS.} } \value{ a \link[formatters:MatrixPrintForm]{formatters::MatrixPrintForm} object. diff --git a/man/vec_nlines.Rd b/man/vec_nlines.Rd index c62339c7..0e468f6f 100644 --- a/man/vec_nlines.Rd +++ b/man/vec_nlines.Rd @@ -6,11 +6,21 @@ \alias{vec_nlines,ANY-method} \title{Utilities for formatting a listing column} \usage{ -format_colvector(df, colnm, colvec = df[[colnm]]) +format_colvector(df, colnm, colvec = df[[colnm]], round_type = c("iec", "sas")) -vec_nlines(vec, max_width = NULL, fontspec = dflt_courier) +vec_nlines( + vec, + max_width = NULL, + fontspec = dflt_courier, + round_type = c("iec", "sas") +) -\S4method{vec_nlines}{ANY}(vec, max_width = NULL, fontspec = dflt_courier) +\S4method{vec_nlines}{ANY}( + vec, + max_width = NULL, + fontspec = dflt_courier, + round_type = c("iec", "sas") +) } \arguments{ \item{df}{(\code{listing_df})\cr the listing.} diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index c1f1283d..839f3033 100644 --- a/tests/testthat/test-print.R +++ b/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")) +}) From c344dc8d49a9a8cf6f9ba05d18b022cca0ffddd1 Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Mon, 3 Feb 2025 16:11:51 -0800 Subject: [PATCH 2/2] fix silly lintr complaints --- R/rlistings.R | 17 ++++++++++++++--- R/rlistings_methods.R | 23 +++++++++++++++++++---- 2 files changed, 33 insertions(+), 7 deletions(-) diff --git a/R/rlistings.R b/R/rlistings.R index 2028ffb4..e6caf4fc 100644 --- a/R/rlistings.R +++ b/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, round_type = c("iec", "sas")) { + 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), round_type = round_type) + 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), round_type = round_type) + vec <- vapply(vec, format_value, "", + format = obj_format(vec), + na_str = obj_na_str(vec), + round_type = round_type) bodymat[, nonk] <- vec } } diff --git a/R/rlistings_methods.R b/R/rlistings_methods.R index 68e699b3..5cd1854e 100644 --- a/R/rlistings_methods.R +++ b/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, round_type = c("iec", "sas"), ...) { +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( @@ -42,7 +49,12 @@ 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, round_type = c("iec", "sas"), ...) { +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, round_type = round_type), fontspec = fontspec, @@ -95,7 +107,9 @@ format_colvector <- function(df, colnm, colvec = df[[colnm]], round_type = c("ie #' needed to render the elements of `vec` to width `max_width`. #' #' @keywords internal -setGeneric("vec_nlines", function(vec, max_width = NULL, fontspec = dflt_courier, round_type = c("iec", "sas")) 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. #' @@ -108,7 +122,8 @@ setMethod("vec_nlines", "ANY", function(vec, max_width = NULL, fontspec = dflt_c # NB: flooring as it is used as <= (also in base::strwrap) } # in formatters for characters - unlist(lapply(format_colvector(colvec = vec, round_type = round_type), 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) {