Refactor a_count_values() (#1374)

edelarua · shajoezhu · web-flow · commit 296aeabf6da7 · 2025-01-17T03:39:46.000Z
# Pull Request Fixes #1373 --------- Co-authored-by: Joe Zhu <joe.zhu@roche.com>
diff --git a/NEWS.md b/NEWS.md
@@ -7,7 +7,7 @@
 * Added `rel_height_plot` parameter to `g_lineplot()` to control the line plot height relative to annotation table height.
 * Updated the `table_font_size` parameter of `g_lineplot()` to control the size of all text in the annotation table, including labels.
 * Added `as_list` parameter to `g_lineplot()` to allow users to return the line plot and annotation table elements as a list instead of stacked for more complex customization.
-* Refactored `summarize_change()` to work without `make_afun()` and access all additional function parameter.
+* Refactored `summarize_change()` and `count_values()` to work without `make_afun()`.
 * Added vignette "Understanding `tern` functions" for future reference.
 * Refactored `analyze_vars()` and `a_summary()` to take all options from `?rtables::additional_fun_params`.
 * Added to `analyze_vars()` statistical names that are used by `rtables::as_result_df()`.
diff --git a/R/count_values.R b/R/count_values.R
@@ -107,10 +107,61 @@ s_count_values.logical <- function(x, values = TRUE, ...) {
 #' a_count_values(x = factor(c("a", "b", "a")), values = "a", .N_col = 10, .N_row = 10)
 #'
 #' @export
-a_count_values <- make_afun(
-  s_count_values,
-  .formats = c(count_fraction = "xx (xx.xx%)", count = "xx")
-)
+a_count_values <- function(x,
+                           ...,
+                           .stats = NULL,
+                           .formats = NULL,
+                           .labels = NULL,
+                           .indent_mods = NULL) {
+  dots_extra_args <- list(...)
+
+  # Check for user-defined functions
+  default_and_custom_stats_list <- .split_std_from_custom_stats(.stats)
+  .stats <- default_and_custom_stats_list$default_stats
+  custom_stat_functions <- default_and_custom_stats_list$custom_stats
+
+  # Add extra parameters to the s_* function
+  extra_afun_params <- retrieve_extra_afun_params(
+    names(dots_extra_args$.additional_fun_parameters)
+  )
+  dots_extra_args$.additional_fun_parameters <- NULL
+
+  # Main statistic calculations
+  x_stats <- .apply_stat_functions(
+    default_stat_fnc = s_count_values,
+    custom_stat_fnc_list = custom_stat_functions,
+    args_list = c(
+      x = list(x),
+      extra_afun_params,
+      dots_extra_args
+    )
+  )
+
+  # Fill in formatting defaults
+  .stats <- c(
+    get_stats("analyze_vars_counts", stats_in = .stats),
+    names(custom_stat_functions) # Additional stats from custom functions
+  )
+  .formats <- get_formats_from_stats(.stats, .formats)
+  .labels <- get_labels_from_stats(.stats, .labels)
+  .indent_mods <- get_indents_from_stats(.stats, .indent_mods)
+
+  # Auto format handling
+  .formats <- apply_auto_formatting(
+    .formats,
+    x_stats,
+    extra_afun_params$.df_row,
+    extra_afun_params$.var
+  )
+
+  in_rows(
+    .list = x_stats[.stats],
+    .formats = .formats,
+    .names = names(.labels),
+    .labels = .labels,
+    .indent_mods = .indent_mods
+  )
+}
 
 #' @describeIn count_values Layout-creating function which can take statistics function arguments
 #'   and additional format arguments. This function is a wrapper for [rtables::analyze()].
@@ -132,26 +183,31 @@ count_values <- function(lyt,
                          vars,
                          values,
                          na_str = default_na_str(),
+                         na_rm = TRUE,
                          nested = TRUE,
                          ...,
                          table_names = vars,
                          .stats = "count_fraction",
-                         .formats = NULL,
+                         .formats = c(count_fraction = "xx (xx.xx%)", count = "xx"),
                          .labels = c(count_fraction = paste(values, collapse = ", ")),
                          .indent_mods = NULL) {
-  extra_args <- list(values = values, ...)
+  # Process extra args
+  extra_args <- list(".stats" = .stats)
+  if (!is.null(.formats)) extra_args[[".formats"]] <- .formats
+  if (!is.null(.labels)) extra_args[[".labels"]] <- .labels
+  if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods
+
+  # Add additional arguments to the analysis function
+  extra_args <- c(extra_args, "na_rm" = na_rm, "values" = list(values), ...)
+
+  # Adding additional info from layout to analysis function
+  extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE)
+  formals(a_count_values) <- c(formals(a_count_values), extra_args[[".additional_fun_parameters"]])
 
-  afun <- make_afun(
-    a_count_values,
-    .stats = .stats,
-    .formats = .formats,
-    .labels = .labels,
-    .indent_mods = .indent_mods
-  )
   analyze(
     lyt,
     vars,
-    afun = afun,
+    afun = a_count_values,
     na_str = na_str,
     nested = nested,
     extra_args = extra_args,
diff --git a/man/count_values.Rd b/man/count_values.Rd
diff --git a/tern.Rproj b/tern.Rproj
@@ -1,5 +1,4 @@
 Version: 1.0
-ProjectId: 74d75484-65e8-447e-93c0-fca42c4aeacd
 
 RestoreWorkspace: Default
 SaveWorkspace: Default
diff --git a/tests/testthat/_snaps/count_values.md b/tests/testthat/_snaps/count_values.md
@@ -298,3 +298,52 @@
           0 
       
 
+# count_values works with denom specified
+
+    Code
+      res
+    Output
+                 all obs  
+      ————————————————————
+      setosa   50 (33.33%)
+
+---
+
+    Code
+      case1
+    Output
+           A: Drug X    B: Placebo    C: Combination
+            (N=202)       (N=177)        (N=162)    
+      ——————————————————————————————————————————————
+      Y   80 (39.60%)   69 (38.98%)    65 (40.12%)  
+
+---
+
+    Code
+      case2
+    Output
+           A: Drug X     B: Placebo    C: Combination
+             (N=69)        (N=73)          (N=58)    
+      ———————————————————————————————————————————————
+      Y   80 (115.94%)   69 (94.52%)    65 (112.07%) 
+
+---
+
+    Code
+      case3
+    Output
+           A: Drug X    B: Placebo    C: Combination
+            (N=69)        (N=73)          (N=58)    
+      ——————————————————————————————————————————————
+      Y   80 (14.79%)   69 (12.75%)    65 (12.01%)  
+
+---
+
+    Code
+      case4
+    Output
+           A: Drug X    B: Placebo    C: Combination
+            (N=69)        (N=73)          (N=58)    
+      ——————————————————————————————————————————————
+      Y   80 (39.60%)   69 (38.98%)    65 (40.12%)  
+
diff --git a/tests/testthat/test-count_values.R b/tests/testthat/test-count_values.R
@@ -117,3 +117,46 @@ testthat::test_that("count_values works as expected with multiple values and var
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
 })
+
+testthat::test_that("count_values works with denom specified", {
+  result <- basic_table() %>%
+    count_values("Species", values = "setosa", denom = "N_col") %>%
+    build_table(iris)
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+
+  # Some more test cases
+  case1 <- testthat::expect_silent(
+    basic_table(show_colcounts = TRUE) %>%
+      split_cols_by("ACTARM") %>%
+      count_values("AESER", values = "Y") %>%
+      build_table(df = tern_ex_adae)
+  )
+  testthat::expect_snapshot(case1)
+
+  case2 <- testthat::expect_silent(
+    basic_table(show_colcounts = TRUE) %>%
+      split_cols_by("ACTARM") %>%
+      count_values("AESER", values = "Y", denom = "N_col") %>%
+      build_table(df = tern_ex_adae, alt_counts_df = tern_ex_adsl)
+  )
+  testthat::expect_snapshot(case2)
+
+  case3 <- testthat::expect_silent(
+    basic_table(show_colcounts = TRUE) %>%
+      split_cols_by("ACTARM") %>%
+      count_values("AESER", values = "Y", denom = "N_row") %>%
+      build_table(df = tern_ex_adae, alt_counts_df = tern_ex_adsl)
+  )
+  testthat::expect_snapshot(case3)
+
+  # case 4 should be the same as case 1 for the rows
+  case4 <- testthat::expect_silent(
+    basic_table(show_colcounts = TRUE) %>%
+      split_cols_by("ACTARM") %>%
+      count_values("AESER", values = "Y", denom = "n") %>%
+      build_table(df = tern_ex_adae, alt_counts_df = tern_ex_adsl)
+  )
+  testthat::expect_snapshot(case4)
+})

Original file line number	Diff line number	Diff line change
`@@ -1,5 +1,4 @@`
`1`	`1`	`Version: 1.0`
`2`		`-ProjectId: 74d75484-65e8-447e-93c0-fca42c4aeacd`
`3`	`2`
`4`	`3`	`RestoreWorkspace: Default`
`5`	`4`	`SaveWorkspace: Default`