Fix trailing "." when using format_sigfig, add functionality for multiple values

NAMESPACE

@@ -295,6 +295,7 @@ import(ggplot2)
 import(rtables)
 importFrom(Rdpack,reprompt)
 importFrom(broom,tidy)
+importFrom(formatters,format_value)
 importFrom(formatters,propose_column_widths)
 importFrom(grid,drawDetails)
 importFrom(grid,heightDetails)

R/formatting_functions.R

@@ -214,6 +214,13 @@ format_xx <- function(str) {
 #' Format numeric values to print with a specified number of significant figures.
 #'
 #' @param sigfig (`integer`)\cr number of significant figures to display.
+#' @param format (`character`)\cr the format label (string) to apply when printing the value. Decimal
+#'   places in string are ignored in favor of formatting by significant figures. Formats options are:
+#'   `"xx"`, `"xx / xx"`, `"(xx, xx)"`, `"xx - xx"`, and `"xx (xx)"`.
+#' @param num_fmt (`character`)\cr numeric format modifiers to apply to the value. Defaults to `"fg"` for
+#'   standard significant figures formatting - fixed (non-scientific notation) format (`"f"`)
+#'   and `sigfig` equal to number of significant figures instead of decimal places (`"g"`). See the
+#'   [formatC()] `format` argument for more options.
 #'
 #' @return An `rtables` formatting function.
 #'
@@ -228,11 +235,16 @@ format_xx <- function(str) {
 #'
 #' @family formatting functions
 #' @export
-format_sigfig <- function(sigfig) {
+format_sigfig <- function(sigfig, format = "xx", num_fmt = "fg") {
   checkmate::assert_integerish(sigfig)
+  format <- gsub("xx\\.|xx\\.x+", "xx", format)
+  checkmate::assert_choice(format, c("xx", "xx / xx", "(xx, xx)", "xx - xx", "xx (xx)"))
   function(x, ...) {
     if (!is.numeric(x)) stop("`format_sigfig` cannot be used for non-numeric values. Please choose another format.")
-    formatC(signif(x, digits = sigfig), digits = sigfig, format = "fg", flag = "#")
+    num <- formatC(signif(x, digits = sigfig), digits = sigfig, format = num_fmt, flag = "#")
+    num <- gsub("\\.$", "", num) # remove trailing "."
+
+    format_value(num, format)
   }
 }
 

R/package.R

@@ -6,7 +6,7 @@
 
 #' @import rtables ggplot2
 #' @importFrom broom tidy
-#' @importFrom formatters propose_column_widths
+#' @importFrom formatters format_value propose_column_widths
 #' @importFrom magrittr %>%
 #' @importFrom methods new
 #' @importFrom Rdpack reprompt

tests/testthat/_snaps/formats.md

@@ -80,7 +80,21 @@
     Code
       res
     Output
-      [1] "1.66"    "0.576"   "0.100"   "78.6"    "0.00123"
+      [1] "1.66"    "0.576"   "0.100"   "78.6"    "0.00123" "200"    
+
+# format_sigfig works with different format types
+
+    Code
+      res
+    Output
+      [1] "1.66 (0.576)"  "0.100 (78.6)"  "0.00123 (200)"
+
+---
+
+    Code
+      res
+    Output
+      [1] "1.66 - 0.576"  "0.100 - 78.6"  "0.00123 - 200"
 
 # format_fraction_threshold works with easy inputs
 

tests/testthat/test-formats.R

@@ -93,14 +93,30 @@ testthat::test_that("format_xx works with easy inputs", {
 })
 
 testthat::test_that("format_sigfig works with easy inputs", {
-  test <- list(1.658, 0.5761, 1e-1, 78.6, 1234e-6)
+  test <- list(1.658, 0.5761, 1e-1, 78.6, 1234e-6, 200.00)
   z <- format_sigfig(3)
   result <- sapply(test, z)
 
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
 })
 
+testthat::test_that("format_sigfig works with different format types", {
+  test <- list(c(1.658, 0.5761), c(1e-1, 78.6), c(1234e-6, 200.00))
+  z <- format_sigfig(3, "xx (xx)")
+  result <- sapply(test, z)
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+
+  test <- list(c(1.658, 0.5761), c(1e-1, 78.6), c(1234e-6, 200.00))
+  z <- format_sigfig(3, "xx - xx")
+  result <- sapply(test, z)
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+})
+
 testthat::test_that("format_fraction_threshold works with easy inputs", {
   test <- list(c(100, 0.1), c(10, 0.01), c(0, 0))
   format_fun <- format_fraction_threshold(0.02)