From f395712cb2c2c8e1635454b3d9a2b42140c0ed68 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Tue, 20 Feb 2024 18:48:18 +0100 Subject: [PATCH 1/7] fix --- NEWS.md | 1 + R/formatting_functions.R | 2 +- tests/testthat/test-formats.R | 19 +++++++++++++++++++ 3 files changed, 21 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 3e13d07dcc..16b814f039 100644 --- a/NEWS.md +++ b/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. diff --git a/R/formatting_functions.R b/R/formatting_functions.R index 95a9c6724b..309c1013e7 100644 --- a/R/formatting_functions.R +++ b/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 (all.equal(x[2], 1)) { sprintf("%d (100%%)", x[1]) } else { sprintf("%d (%.1f%%)", x[1], x[2] * 100) diff --git a/tests/testthat/test-formats.R b/tests/testthat/test-formats.R index 1ff90a747a..29272d51ef 100644 --- a/tests/testthat/test-formats.R +++ b/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 = all.equal(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)) + ) +}) From eca8ba9beeabde85db56cefe513b7c661f0b79dd Mon Sep 17 00:00:00 2001 From: Melkiades Date: Wed, 21 Feb 2024 10:59:43 +0100 Subject: [PATCH 2/7] better fix --- R/formatting_functions.R | 2 +- R/utils.R | 26 +++++++++++++++++++++++++- man/dot-is_equal_float.Rd | 24 ++++++++++++++++++++++++ tests/testthat/test-formats.R | 2 +- 4 files changed, 51 insertions(+), 3 deletions(-) create mode 100644 man/dot-is_equal_float.Rd diff --git a/R/formatting_functions.R b/R/formatting_functions.R index 309c1013e7..d697d112c1 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -151,7 +151,7 @@ format_count_fraction_fixed_dp <- function(x, ...) { result <- if (x[1] == 0) { "0" - } else if (all.equal(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) diff --git a/R/utils.R b/R/utils.R index a5dcaed550..3798da1e2e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -135,12 +135,36 @@ 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 +#' +#' @examples +#' .is_equal_float(49/49, 1) +#' +#' @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. diff --git a/man/dot-is_equal_float.Rd b/man/dot-is_equal_float.Rd new file mode 100644 index 0000000000..14f3c4fe09 --- /dev/null +++ b/man/dot-is_equal_float.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{.is_equal_float} +\alias{.is_equal_float} +\title{Utility function to check if a float is equal to another float} +\usage{ +.is_equal_float(x, y) +} +\arguments{ +\item{x}{(\code{float})\cr A single number.} + +\item{y}{(\code{float})\cr A single number.} +} +\value{ +\code{TRUE}, if identical. \code{FALSE}, otherwise +} +\description{ +Uses \code{.Machine$double.eps} as the tolerance for the comparison. +} +\examples{ +.is_equal_float(49/49, 1) + +} +\keyword{internal} diff --git a/tests/testthat/test-formats.R b/tests/testthat/test-formats.R index 29272d51ef..ef95aa72a4 100644 --- a/tests/testthat/test-formats.R +++ b/tests/testthat/test-formats.R @@ -223,7 +223,7 @@ testthat::test_that("formats with nominator == to denominator are always formatt rowwise() %>% mutate(count = Ncol) %>% mutate(pct = count * (1 / Ncol)) %>% - mutate(check_new = all.equal(pct, 1)) %>% + mutate(check_new = .is_equal_float(pct, 1)) %>% mutate(check = pct == 1) %>% mutate(fmt_print = format_count_fraction_fixed_dp(c(count, pct))) From a4e27c6438f8be84522e55ad4a175f44694ae24a Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 21 Feb 2024 10:02:22 +0000 Subject: [PATCH 3/7] [skip actions] Restyle files --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index 3798da1e2e..6a488ef014 100644 --- a/R/utils.R +++ b/R/utils.R @@ -151,7 +151,7 @@ check_same_n <- function(..., omit_null = TRUE) { #' @return `TRUE`, if identical. `FALSE`, otherwise #' #' @examples -#' .is_equal_float(49/49, 1) +#' .is_equal_float(49 / 49, 1) #' #' @keywords internal .is_equal_float <- function(x, y) { From 811570e5f2eaabc15eca7f841e70165b67f807d3 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Wed, 21 Feb 2024 11:04:40 +0100 Subject: [PATCH 4/7] empty From 8eef9fd98aceff09b6959901bb74549292df4231 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Wed, 21 Feb 2024 10:07:27 +0000 Subject: [PATCH 5/7] [skip actions] Roxygen Man Pages Auto Update --- man/dot-is_equal_float.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/dot-is_equal_float.Rd b/man/dot-is_equal_float.Rd index 14f3c4fe09..0f0c63c810 100644 --- a/man/dot-is_equal_float.Rd +++ b/man/dot-is_equal_float.Rd @@ -18,7 +18,7 @@ Uses \code{.Machine$double.eps} as the tolerance for the comparison. } \examples{ -.is_equal_float(49/49, 1) +.is_equal_float(49 / 49, 1) } \keyword{internal} From e597d0008623a80c79a1bbe5a081ee58226b32ba Mon Sep 17 00:00:00 2001 From: Melkiades Date: Wed, 21 Feb 2024 11:07:52 +0100 Subject: [PATCH 6/7] empty From fadce91135a7afa11f20581d41932fb8c0c4d730 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Wed, 21 Feb 2024 11:36:40 +0100 Subject: [PATCH 7/7] taking out examples --- R/utils.R | 3 --- man/dot-is_equal_float.Rd | 4 ---- 2 files changed, 7 deletions(-) diff --git a/R/utils.R b/R/utils.R index 6a488ef014..5aa0102f1c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -150,9 +150,6 @@ check_same_n <- function(..., omit_null = TRUE) { #' #' @return `TRUE`, if identical. `FALSE`, otherwise #' -#' @examples -#' .is_equal_float(49 / 49, 1) -#' #' @keywords internal .is_equal_float <- function(x, y) { checkmate::assert_number(x) diff --git a/man/dot-is_equal_float.Rd b/man/dot-is_equal_float.Rd index 0f0c63c810..c90e32e8ab 100644 --- a/man/dot-is_equal_float.Rd +++ b/man/dot-is_equal_float.Rd @@ -16,9 +16,5 @@ } \description{ Uses \code{.Machine$double.eps} as the tolerance for the comparison. -} -\examples{ -.is_equal_float(49 / 49, 1) - } \keyword{internal}