Fix analysis function refactor bugs

R/count_occurrences.R

@@ -170,11 +170,6 @@ a_count_occurrences <- function(df,
   .stats <- default_and_custom_stats_list$all_stats
   custom_stat_functions <- default_and_custom_stats_list$custom_stats
 
-  # if empty, return NA
-  if (nrow(df) == 0) {
-    return(in_rows(.list = as.list(rep(NA, length(.stats))) %>% stats::setNames(.stats)))
-  }
-
   # Apply statistics function
   x_stats <- .apply_stat_functions(
     default_stat_fnc = s_count_occurrences,
@@ -186,6 +181,11 @@ a_count_occurrences <- function(df,
     )
   )
 
+  # if empty, return NA
+  if (is.null(unlist(x_stats))) {
+    return(in_rows(.list = as.list(rep(NA, length(.stats))) %>% stats::setNames(.stats)))
+  }
+
   # Fill in formatting defaults
   .stats <- get_stats("count_occurrences", stats_in = .stats, custom_stats_in = names(custom_stat_functions))
   x_stats <- x_stats[.stats]
@@ -320,7 +320,7 @@ summarize_occurrences <- function(lyt,
                                   .stats = "count_fraction_fixed_dp",
                                   .stat_names = NULL,
                                   .formats = NULL,
-                                  .indent_mods = NULL,
+                                  .indent_mods = 0L,
                                   .labels = NULL) {
   checkmate::assert_flag(riskdiff)
   afun <- if (isFALSE(riskdiff)) a_count_occurrences else afun_riskdiff
@@ -330,7 +330,14 @@ summarize_occurrences <- function(lyt,
   if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names
   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
+  if (is.null(.indent_mods)) {
+    indent_mod <- 0L
+  } else if (length(.indent_mods) == 1) {
+    indent_mod <- .indent_mods
+  } else {
+    indent_mod <- 0L
+    extra_args[[".indent_mods"]] <- .indent_mods
+  }
 
   # Process additional arguments to the statistic function
   extra_args <- c(
@@ -349,6 +356,7 @@ summarize_occurrences <- function(lyt,
     var = var,
     cfun = afun,
     na_str = na_str,
-    extra_args = extra_args
+    extra_args = extra_args,
+    indent_mod = indent_mod
   )
 }

R/count_occurrences_by_grade.R

@@ -376,8 +376,8 @@ count_occurrences_by_grade <- function(lyt,
                                        .stats = "count_fraction",
                                        .stat_names = NULL,
                                        .formats = list(count_fraction = format_count_fraction_fixed_dp),
-                                       .indent_mods = NULL,
-                                       .labels = NULL) {
+                                       .labels = NULL,
+                                       .indent_mods = NULL) {
   checkmate::assert_flag(riskdiff)
   afun <- if (isFALSE(riskdiff)) a_count_occurrences_by_grade else afun_riskdiff
 
@@ -455,8 +455,8 @@ summarize_occurrences_by_grade <- function(lyt,
                                            .stats = "count_fraction",
                                            .stat_names = NULL,
                                            .formats = list(count_fraction = format_count_fraction_fixed_dp),
-                                           .indent_mods = NULL,
-                                           .labels = NULL) {
+                                           .labels = NULL,
+                                           .indent_mods = 0L) {
   checkmate::assert_flag(riskdiff)
   afun <- if (isFALSE(riskdiff)) a_count_occurrences_by_grade else afun_riskdiff
 
@@ -465,7 +465,14 @@ summarize_occurrences_by_grade <- function(lyt,
   if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names
   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
+  if (is.null(.indent_mods)) {
+    indent_mod <- 0L
+  } else if (length(.indent_mods) == 1) {
+    indent_mod <- .indent_mods
+  } else {
+    indent_mod <- 0L
+    extra_args[[".indent_mods"]] <- .indent_mods
+  }
 
   # Process additional arguments to the statistic function
   extra_args <- c(
@@ -484,6 +491,7 @@ summarize_occurrences_by_grade <- function(lyt,
     var = var,
     cfun = afun,
     na_str = na_str,
-    extra_args = extra_args
+    extra_args = extra_args,
+    indent_mod = indent_mod
   )
 }

R/summarize_num_patients.R

@@ -235,7 +235,7 @@ summarize_num_patients <- function(lyt,
                                      unique = "Number of patients with at least one event",
                                      nonunique = "Number of events"
                                    ),
-                                   .indent_mods = NULL) {
+                                   .indent_mods = 0L) {
   checkmate::assert_flag(riskdiff)
   afun <- if (isFALSE(riskdiff)) a_num_patients else afun_riskdiff
 
@@ -244,7 +244,14 @@ summarize_num_patients <- function(lyt,
   if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names
   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
+  if (is.null(.indent_mods)) {
+    indent_mod <- 0L
+  } else if (length(.indent_mods) == 1) {
+    indent_mod <- .indent_mods
+  } else {
+    indent_mod <- 0L
+    extra_args[[".indent_mods"]] <- .indent_mods
+  }
 
   # Process additional arguments to the statistic function
   extra_args <- c(
@@ -263,7 +270,8 @@ summarize_num_patients <- function(lyt,
     var = var,
     cfun = afun,
     na_str = na_str,
-    extra_args = extra_args
+    extra_args = extra_args,
+    indent_mod = indent_mod
   )
 }
 

R/utils_default_stats_formats_labels.R

@@ -271,6 +271,15 @@ get_formats_from_stats <- function(stats,
   }
   checkmate::assert_list(levels_per_stats, null.ok = TRUE)
 
+  # If unnamed formats given as formats_in and same number of stats, use one format per stat
+  if (
+    !is.null(formats_in) && length(formats_in) == length(stats) &&
+      is.null(names(formats_in)) && is.null(levels_per_stats)
+  ) {
+    out <- as.list(formats_in) %>% setNames(stats)
+    return(out)
+  }
+
   # If levels_per_stats not given, assume one row per statistic
   if (is.null(levels_per_stats)) levels_per_stats <- as.list(stats) %>% setNames(stats)
 
@@ -318,6 +327,15 @@ get_labels_from_stats <- function(stats,
   }
   checkmate::assert_list(levels_per_stats, null.ok = TRUE)
 
+  # If unnamed labels given as labels_in and same number of stats, use one label per stat
+  if (
+    !is.null(labels_in) && length(labels_in) == length(stats) &&
+      is.null(names(labels_in)) && is.null(levels_per_stats)
+  ) {
+    out <- as.list(labels_in) %>% setNames(stats)
+    return(out)
+  }
+
   # If levels_per_stats not given, assume one row per statistic
   if (is.null(levels_per_stats)) levels_per_stats <- as.list(stats) %>% setNames(stats)
 

tests/testthat/_snaps/count_occurrences_by_grade.md

@@ -602,17 +602,17 @@
     Code
       res
     Output
-                     A: Drug X   B: Placebo   C: Combination   Risk Difference (%) (95% CI)
-                      (N=202)     (N=177)        (N=162)                 (N=379)           
-      —————————————————————————————————————————————————————————————————————————————————————
-      F                                                                                    
-          -Any-      20 (9.9%)   19 (10.7%)     19 (11.7%)          -0.8 (-7.0 - 5.3)      
-          MILD       2 (1.0%)     2 (1.1%)          0               -0.1 (-2.2 - 1.9)      
-          MODERATE   4 (2.0%)     3 (1.7%)       3 (1.9%)            0.3 (-2.4 - 3.0)      
-          SEVERE     14 (6.9%)   14 (7.9%)      16 (9.9%)           -1.0 (-6.3 - 4.3)      
-      M                                                                                    
-          -Any-      14 (6.9%)   21 (11.9%)     17 (10.5%)          -4.9 (-10.8 - 1.0)     
-          MILD       1 (0.5%)        0           1 (0.6%)            0.5 (-0.5 - 1.5)      
-          MODERATE   4 (2.0%)     7 (4.0%)       5 (3.1%)           -2.0 (-5.4 - 1.5)      
-          SEVERE     9 (4.5%)    14 (7.9%)      11 (6.8%)           -3.5 (-8.3 - 1.4)      
+                   A: Drug X   B: Placebo   C: Combination   Risk Difference (%) (95% CI)
+                    (N=202)     (N=177)        (N=162)                 (N=379)           
+      ———————————————————————————————————————————————————————————————————————————————————
+      F                                                                                  
+        -Any-      20 (9.9%)   19 (10.7%)     19 (11.7%)          -0.8 (-7.0 - 5.3)      
+        MILD       2 (1.0%)     2 (1.1%)          0               -0.1 (-2.2 - 1.9)      
+        MODERATE   4 (2.0%)     3 (1.7%)       3 (1.9%)            0.3 (-2.4 - 3.0)      
+        SEVERE     14 (6.9%)   14 (7.9%)      16 (9.9%)           -1.0 (-6.3 - 4.3)      
+      M                                                                                  
+        -Any-      14 (6.9%)   21 (11.9%)     17 (10.5%)          -4.9 (-10.8 - 1.0)     
+        MILD       1 (0.5%)        0           1 (0.6%)            0.5 (-0.5 - 1.5)      
+        MODERATE   4 (2.0%)     7 (4.0%)       5 (3.1%)           -2.0 (-5.4 - 1.5)      
+        SEVERE     9 (4.5%)    14 (7.9%)      11 (6.8%)           -3.5 (-8.3 - 1.4)      
 

tests/testthat/_snaps/summarize_num_patients.md

@@ -304,6 +304,16 @@
       Number of events                                 4           3    
       (n)                                              3           3    
 
+# summarize_num_patients works with single unnamed .labels/.formats values
+
+    Code
+      res
+    Output
+                      A       B  
+                    (N=5)   (N=4)
+      ———————————————————————————
+      - Overall -   3.00    3.00 
+
 # analyze_num_patients works well for pagination
 
     Code

tests/testthat/test-count_occurrences_by_grade.R

@@ -483,7 +483,6 @@ testthat::test_that("summarize_occurrences works as expected with risk differenc
     summarize_occurrences_by_grade(
       var = "AESEV",
       riskdiff = TRUE,
-      .indent_mods = 1L,
       grade_groups = grade_groups,
       id = "SITEID"
     ) %>%

tests/testthat/test-summarize_num_patients.R

@@ -209,6 +209,22 @@ testthat::test_that(
     testthat::expect_snapshot(res)
   }
 )
+testthat::test_that("summarize_num_patients works with single unnamed .labels/.formats values", {
+  df <- data.frame(
+    USUBJID = as.character(c(1, 2, 1, 4, NA, 6, 6, 8, 9)),
+    ARM = c("A", "A", "A", "A", "A", "B", "B", "B", "B"),
+    AGE = c(10, 15, 10, 17, 8, 11, 11, 19, 17)
+  )
+
+  result <- basic_table() %>%
+    split_cols_by("ARM") %>%
+    add_colcounts() %>%
+    summarize_num_patients("USUBJID", .stats = "unique_count", .labels = "- Overall -", .formats = "xx.xx") %>%
+    build_table(df)
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+})
 
 testthat::test_that("analyze_num_patients works well for pagination", {
   set.seed(1)