Merge 7cff5e6 into cd58cb8

NEWS.md

@@ -8,6 +8,7 @@
 ### Bug Fixes
 * Fixed nested column split label overlay issue in `rtable2gg` to clean up appearance of text labels.
 * Fixed bug in `s_ancova` causing incorrect difference calculations for arm variables with irregular levels.
+* Fixed bug in `format_count_fraction_fixed_dp` that did not have the same print when the fraction was 1 (100%).
 
 ### Miscellaneous
 * Added function `expect_snapshot_ggplot` to test setup file to process plot snapshot tests and allow plot dimensions to be set.

R/formatting_functions.R

@@ -151,7 +151,7 @@ format_count_fraction_fixed_dp <- function(x, ...) {
 
   result <- if (x[1] == 0) {
     "0"
-  } else if (x[2] == 1) {
+  } else if (.is_equal_float(x[2], 1)) {
     sprintf("%d (100%%)", x[1])
   } else {
     sprintf("%d (%.1f%%)", x[1], x[2] * 100)

R/utils.R

@@ -135,12 +135,33 @@ check_same_n <- function(..., omit_null = TRUE) {
 
   if (length(unique(n)) > 1) {
     sel <- which(n != n[1])
-    stop("dimension mismatch:", paste(names(n)[sel], collapse = ", "), " do not have N=", n[1])
+    stop("Dimension mismatch:", paste(names(n)[sel], collapse = ", "), " do not have N=", n[1])
   }
 
   TRUE
 }
 
+#' Utility function to check if a float is equal to another float
+#'
+#' @description Uses `.Machine$double.eps` as the tolerance for the comparison.
+#'
+#' @param x (`float`)\cr A single number.
+#' @param y (`float`)\cr A single number.
+#'
+#' @return `TRUE`, if identical. `FALSE`, otherwise
+#'
+#' @keywords internal
+.is_equal_float <- function(x, y) {
+  checkmate::assert_number(x)
+  checkmate::assert_number(y)
+
+  # Define a tolerance
+  tolerance <- .Machine$double.eps
+
+  # Check if x is close enough to y
+  abs(x - y) < tolerance
+}
+
 #' Make Names Without Dots
 #'
 #' @param nams (`character`)\cr vector of original names.

tests/testthat/test-formats.R

@@ -216,3 +216,22 @@ testthat::test_that("format_extreme_values_ci works with easy inputs", {
     "Number of inserted values as result \\(1\\)*"
   )
 })
+
+testthat::test_that("formats with nominator == to denominator are always formatted as 1", {
+  # Regression test for #1191
+  df <- data.frame(Ncol = seq(500)) %>%
+    rowwise() %>%
+    mutate(count = Ncol) %>%
+    mutate(pct = count * (1 / Ncol)) %>%
+    mutate(check_new = .is_equal_float(pct, 1)) %>%
+    mutate(check = pct == 1) %>%
+    mutate(fmt_print = format_count_fraction_fixed_dp(c(count, pct)))
+
+  testthat::expect_true(nrow(df %>% filter(isFALSE(check))) > 0)
+  testthat::expect_equal(nrow(df %>% filter(isFALSE(check_new))), 0)
+
+  testthat::expect_equal(
+    sapply(df$fmt_print, function(x) substr(x, max(1, nchar(x) - 5), nchar(x)), USE.NAMES = FALSE),
+    rep("(100%)", nrow(df))
+  )
+})