Merge branch 'main' into 1070_expose_na_str@main

insightsengineering · Oct 5, 2023 · 36bb8ba · 36bb8ba
2 parents 2e879f0 + 4e76272
commit 36bb8ba
Show file tree

Hide file tree

Showing 23 changed files with 165 additions and 86 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: tern
 Title: Create Common TLGs Used in Clinical Trials
-Version: 0.9.0.9007
-Date: 2023-09-25
+Version: 0.9.1.9001
+Date: 2023-10-05
 Authors@R: c(
     person("Joe", "Zhu", , "[email protected]", role = c("aut", "cre")),
     person("Daniel", "Sabanés Bové", , "[email protected]", role = "aut"),
@@ -21,7 +21,7 @@ URL: https://github.com/insightsengineering/tern
 BugReports: https://github.com/insightsengineering/tern/issues
 Depends:
     R (>= 3.6),
-    rtables (>= 0.6.3)
+    rtables (>= 0.6.4)
 Imports:
     broom,
     car,
@@ -30,7 +30,7 @@ Imports:
     dplyr,
     emmeans (>= 1.4.5),
     forcats (>= 1.0.0),
-    formatters (>= 0.5.2),
+    formatters (>= 0.5.3),
     ggplot2 (>= 3.4.0),
     grid,
     gridExtra,

diff --git a/NAMESPACE b/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)

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,10 @@
-# tern 0.9.0.9007
+# tern 0.9.1.9001
+
+### Enhancements
+* Added formatting function `format_count_fraction_lt10` for formatting `count_fraction` with special consideration when count is less than 10.
+
+# tern 0.9.1
+
 ### New Features
 * Added `imputation_rule` function to apply imputation rule to data.
 * Added new format function `format_sigfig` to allow for numeric value formatting by a specified number of significant figures.
@@ -23,6 +29,7 @@
 * Began deprecation of `na_level` argument in `s_count_abnormal_by_baseline`, `a_summary`, `analyze_vars`, `analyze_vars_in_cols`, `compare_vars`, `h_map_for_count_abnormal`, `h_stack_by_baskets`, `summarize_colvars`, `a_coxreg`, and `summarize_coxreg` and replaced it with the `na_str` argument.
 
 # tern 0.9.0
+
 ### New Features
 * Added `stat_propdiff_ci` function to calculate proportion/risk difference and CI.
 * Added risk difference column functionality via the `riskdiff` argument to functions `count_occurrences`, `count_occurrences_by_grade`, `count_patients_with_event`, `count_patients_with_flags`, `analyze_num_patients`, and `summarize_num_patients`.

diff --git a/R/formatting_functions.R b/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

diff --git a/man/extreme_format.Rd b/man/extreme_format.Rd
diff --git a/man/format_auto.Rd b/man/format_auto.Rd
diff --git a/man/format_count_fraction.Rd b/man/format_count_fraction.Rd
diff --git a/man/format_count_fraction_fixed_dp.Rd b/man/format_count_fraction_fixed_dp.Rd
diff --git a/man/format_count_fraction_lt10.Rd b/man/format_count_fraction_lt10.Rd
diff --git a/man/format_extreme_values.Rd b/man/format_extreme_values.Rd
diff --git a/man/format_extreme_values_ci.Rd b/man/format_extreme_values_ci.Rd
diff --git a/man/format_fraction.Rd b/man/format_fraction.Rd
diff --git a/man/format_fraction_fixed_dp.Rd b/man/format_fraction_fixed_dp.Rd
diff --git a/man/format_fraction_threshold.Rd b/man/format_fraction_threshold.Rd
diff --git a/man/format_sigfig.Rd b/man/format_sigfig.Rd
diff --git a/man/format_xx.Rd b/man/format_xx.Rd
diff --git a/man/formatting_functions.Rd b/man/formatting_functions.Rd
diff --git a/tests/testthat/_snaps/formats.md b/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

diff --git a/tests/testthat/_snaps/summarize_glm_count.md b/tests/testthat/_snaps/summarize_glm_count.md
@@ -129,16 +129,6 @@
       Intervals are back-transformed from the log scale 
       
 
----
-
-    Code
-      res
-    Output
-                     rate asymp.LCL asymp.UCL            ARM
-      A: Drug X      3.07  2.836527   3.32269      A: Drug X
-      B: Placebo     3.07  2.836527   3.32269     B: Placebo
-      C: Combination 3.07  2.836527   3.32269 C: Combination
-
 # s_glm_count works with healthy input
 
     Code
@@ -148,12 +138,12 @@
       [1] 73
       
       $rate
-      [1] 3.486005
+      [1] 14.11838
       attr(,"label")
       [1] "Adjusted Rate"
       
       $rate_ci
-      [1] 3.047667 3.987387
+      [1] 11.81189 16.87525
       attr(,"label")
       [1] "95% CI"
       
@@ -182,12 +172,12 @@
       [1] 73
       
       $rate
-      [1] 3.486005
+      [1] 14.11838
       attr(,"label")
       [1] "Adjusted Rate"
       
       $rate_ci
-      [1] 3.047667 3.987387
+      [1] 11.81189 16.87525
       attr(,"label")
       [1] "95% CI"
       

diff --git a/tests/testthat/_snaps/utils_default_stats_formats_labels.md b/tests/testthat/_snaps/utils_default_stats_formats_labels.md
@@ -31,58 +31,6 @@
       [16] "iqr"          "range"        "min"          "max"          "median_range"
       [21] "cv"           "geom_mean"    "geom_mean_ci" "geom_cv"     
 
-# get_formats_from_stats works as expected
-
-    Code
-      res
-    Output
-      $count
-      [1] "xx."
-      
-      $count_fraction_fixed_dp
-      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] == 0) {
-          "0"
-        } else if (x[2] == 1) {
-          sprintf("%d (100%%)", x[1])
-        } else {
-          sprintf("%d (%.1f%%)", x[1], x[2] * 100)
-        }
-      
-        return(result)
-      }
-      <environment: namespace:tern>
-      
-      $fraction
-      function(x, ...) {
-        attr(x, "label") <- NULL
-        checkmate::assert_vector(x)
-        checkmate::assert_count(x["num"])
-        checkmate::assert_count(x["denom"])
-      
-        result <- if (x["num"] == 0) {
-          paste0(x["num"], "/", x["denom"])
-        } else {
-          paste0(
-            x["num"], "/", x["denom"],
-            " (", sprintf("%.1f", round(x["num"] / x["denom"] * 100, 1)), "%)"
-          )
-        }
-        return(result)
-      }
-      <environment: namespace:tern>
-      
-
 # get_labels_from_stats works as expected
 
     Code

diff --git a/tests/testthat/test-formats.R b/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),