Add formatting function with special case when count less than 10

NAMESPACE

@@ -114,6 +114,7 @@ export(forest_viewport)
 export(format_auto)
 export(format_count_fraction)
 export(format_count_fraction_fixed_dp)
+export(format_count_fraction_lt10)
 export(format_extreme_values)
 export(format_extreme_values_ci)
 export(format_fraction)

NEWS.md

@@ -13,6 +13,7 @@
 * Updated `analyze_vars_in_cols` to use caching, allow implementation of imputation rule via the `imp_rule` argument, and allow user to specify cell alignment via the `.aligns` argument.
 * Updated `add_rowcounts` to allow addition of row counts from `alt_counts_df` using the `alt_counts` argument.
 * Added `gp` argument to `g_forest` to control graphical parameters such as font size.
+* Added formatting function `format_count_fraction_lt10` for formatting `count_fraction` with special consideration when count is less than 10. 
 
 ### Miscellaneous
 * Grouped functions relating to valid method names and their default formats and labels into new source file `utils_defaults_handling.R`.

R/formatting_functions.R

@@ -160,6 +160,43 @@ format_count_fraction_fixed_dp <- function(x, ...) {
   return(result)
 }
 
+#' Formatting Count and Fraction with Special Case for Count < 10
+#'
+#' @description `r lifecycle::badge("stable")`
+#'
+#' Formats a count together with fraction with special consideration when count is less than 10.
+#'
+#' @inheritParams format_count_fraction
+#'
+#' @return A string in the format `count (fraction %)`. If `count` is less than 10, only `count` is printed.
+#'
+#' @examples
+#' format_count_fraction_lt10(x = c(275, 0.9673))
+#' format_count_fraction_lt10(x = c(2, 0.6667))
+#' format_count_fraction_lt10(x = c(9, 1))
+#'
+#' @family formatting functions
+#' @export
+format_count_fraction_lt10 <- function(x, ...) {
+  attr(x, "label") <- NULL
+
+  if (any(is.na(x))) {
+    return("NA")
+  }
+
+  checkmate::assert_vector(x)
+  checkmate::assert_integerish(x[1])
+  assert_proportion_value(x[2], include_boundaries = TRUE)
+
+  result <- if (x[1] < 10) {
+    paste0(x[1])
+  } else {
+    paste0(x[1], " (", round(x[2] * 100, 1), "%)")
+  }
+
+  return(result)
+}
+
 #' Formatting: XX as Formatting Function
 #'
 #' Translate a string where x and dots are interpreted as number place

tests/testthat/_snaps/formats.md

@@ -68,6 +68,20 @@
     Output
       [1] "0"
 
+# format_count_fraction_lt10 works with healthy inputs
+
+    Code
+      res
+    Output
+      [1] "10 (100%)"  "19 (51.8%)" "76 (99.6%)"
+
+# format_count_fraction_lt10 works with count less than 10
+
+    Code
+      res
+    Output
+      [1] "9" "1" "7"
+
 # format_xx works with easy inputs
 
     Code

tests/testthat/test-formats.R

@@ -73,6 +73,30 @@ testthat::test_that("format_count_fraction_fixed_dp works with count of 0", {
   testthat::expect_snapshot(res)
 })
 
+testthat::test_that("format_count_fraction_lt10 works with healthy inputs", {
+  x <- list(c(10, 1), c(19, 0.5183), c(76, 0.996))
+
+  result <- sapply(x, format_count_fraction_lt10)
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+})
+
+testthat::test_that("format_count_fraction_lt10 works with count less than 10", {
+  x <- list(c(9, 1), c(1, 0.5), c(7, 0.99))
+
+  result <- sapply(x, format_count_fraction_lt10)
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+})
+
+testthat::test_that("format_count_fraction_lt10 works with NA input", {
+  result <- format_count_fraction_lt10(NA)
+  testthat::expect_identical(result, "NA")
+})
+
+
 testthat::test_that("format_fraction fails with bad inputs", {
   x <- list(
     c(num = c(1L, 2L, 3L), denom = 5L),