Refactor remaining analysis functions

NEWS.md

@@ -1,9 +1,9 @@
 # tern 0.9.7.9011
 
 ### Enhancements
-* Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, `count_abnormal_lab_worsen_by_baseline()`, `coxph_pairwise()`, `estimate_multinomial_rsp()`, `estimate_proportion()`, `estimate_odds_ratio()`, `summarize_ancova()`, `summarize_glm_count()`, and `surv_timepoint()` to work without `make_afun()`.
+* Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, `count_abnormal_lab_worsen_by_baseline()`, `coxph_pairwise()`, `estimate_multinomial_rsp()`, `estimate_proportion()`, `estimate_odds_ratio()`, `summarize_ancova()`, `summarize_glm_count()`, `summarize_num_patients()`, and `surv_timepoint()` to work without `make_afun()`.
 * Added `geom_sd` and `geom_mean_sd` to `s_summary()` default available statistics.
-* Refactored `h_tab_one_biomarker()`, `tabulate_rsp_subgroups()`, `tabulate_survival_subgroups()`, `tabulate_rsp_biomarkers()`, and `tabulate_survival_biomarkers()` to align with new analysis function style.
+* Refactored `afun_riskdiff()`, `count_occurrences()`, `count_occurrences_by_grade()`, `count_patients_with_event()`, `count_patients_with_flags()`, `count_values()`, `estimate_incidence_rate()`, `h_tab_one_biomarker()`, `summarize_change()`, `summarize_colvars()`, `summarize_patients_exposure_in_cols()`, `survival_time()`, `tabulate_rsp_subgroups()`, `tabulate_survival_subgroups()`, `tabulate_rsp_biomarkers()`, and `tabulate_survival_biomarkers()` to align with new analysis function style.
 
 ### Bug Fixes
 * Fixed bug in `a_count_patients_with_flags()` preventing select custom label and indentation specification formats from being applied.
@@ -18,6 +18,7 @@
 * Began deprecation of the unused `label_all` parameter to `tabulate_rsp_subgroups()`, with redirection to the same parameter in `extract_rsp_subgroups()`.
 * Began deprecation of the no longer used helper functions `h_tab_one_biomarker()`, `h_tab_rsp_one_biomarker()`, and `h_tab_surv_one_biomarker()`.
 * Moved helper functions `h_tab_rsp_one_biomarker()` and `h_tab_surv_one_biomarker()` into `h_biomarkers_subgroups.R`.
+* Updated documentation to remove suggestions to use `make_afun()`.
 
 # tern 0.9.7
 

R/count_occurrences.R

@@ -75,13 +75,14 @@ NULL
 #'
 #' @export
 s_count_occurrences <- function(df,
-                                denom = c("N_col", "n", "N_row"),
+                                .var = "MHDECOD",
                                 .N_col, # nolint
                                 .N_row, # nolint
                                 .df_row,
+                                ...,
                                 drop = TRUE,
-                                .var = "MHDECOD",
-                                id = "USUBJID") {
+                                id = "USUBJID",
+                                denom = c("N_col", "n", "N_row")) {
   checkmate::assert_flag(drop)
   assert_df_with_variables(df, list(range = .var, id = id))
   checkmate::assert_count(.N_col)
@@ -153,47 +154,59 @@ s_count_occurrences <- function(df,
 #' @export
 a_count_occurrences <- function(df,
                                 labelstr = "",
-                                id = "USUBJID",
-                                denom = c("N_col", "n", "N_row"),
-                                drop = TRUE,
-                                .N_col, # nolint
-                                .N_row, # nolint
-                                .var = NULL,
-                                .df_row = NULL,
+                                ...,
                                 .stats = NULL,
+                                .stat_names = NULL,
                                 .formats = NULL,
                                 .labels = NULL,
-                                .indent_mods = NULL,
-                                na_str = default_na_str()) {
-  denom <- match.arg(denom)
-  x_stats <- s_count_occurrences(
-    df = df, denom = denom, .N_col = .N_col, .N_row = .N_row, .df_row = .df_row, drop = drop, .var = .var, id = id
-  )
-  if (is.null(unlist(x_stats))) {
-    return(NULL)
+                                .indent_mods = NULL) {
+  # Check for additional parameters to the statistics function
+  dots_extra_args <- list(...)
+  extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters))
+  dots_extra_args$.additional_fun_parameters <- NULL
+
+  # Check for user-defined functions
+  default_and_custom_stats_list <- .split_std_from_custom_stats(.stats)
+  .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)))
   }
 
-  # Fill in with formatting defaults if needed
-  .stats <- get_stats("count_occurrences", stats_in = .stats)
+  # Apply statistics function
+  x_stats <- .apply_stat_functions(
+    default_stat_fnc = s_count_occurrences,
+    custom_stat_fnc_list = custom_stat_functions,
+    args_list = c(
+      df = list(df),
+      extra_afun_params,
+      dots_extra_args
+    )
+  )
+
+  # Fill in formatting defaults
+  .stats <- get_stats("count_occurrences", stats_in = .stats, custom_stats_in = names(custom_stat_functions))
   x_stats <- x_stats[.stats]
   levels_per_stats <- lapply(x_stats, names)
   .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats)
   .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats)
   .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats)
 
-  # Unlist stats
-  x_stats <- x_stats %>% .unlist_keep_nulls()
-
   # Auto format handling
-  .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var)
+  .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var)
+
+  # Get and check statistical names
+  .stat_names <- get_stat_names(x_stats, .stat_names)
 
   in_rows(
-    .list = x_stats,
+    .list = x_stats %>% .unlist_keep_nulls(),
     .formats = .formats,
     .names = .labels %>% .unlist_keep_nulls(),
+    .stat_names = .stat_names,
     .labels = .labels %>% .unlist_keep_nulls(),
-    .indent_mods = .indent_mods %>% .unlist_keep_nulls(),
-    .format_na_strs = na_str
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls()
   )
 }
 
@@ -233,38 +246,42 @@ count_occurrences <- function(lyt,
                               ...,
                               table_names = vars,
                               .stats = "count_fraction_fixed_dp",
+                              .stat_names = NULL,
                               .formats = NULL,
                               .labels = NULL,
                               .indent_mods = NULL) {
   checkmate::assert_flag(riskdiff)
+  afun <- if (isFALSE(riskdiff)) a_count_occurrences else afun_riskdiff
 
-  extra_args <- list(
-    .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str
+  # Process standard extra arguments
+  extra_args <- list(".stats" = .stats)
+  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
+
+  # Process additional arguments to the statistic function
+  extra_args <- c(
+    extra_args,
+    id = id, drop = drop,
+    if (!isFALSE(riskdiff)) list(afun = list("s_count_occurrences" = a_count_occurrences)),
+    ...
   )
-  s_args <- list(id = id, drop = drop, ...)
 
-  if (isFALSE(riskdiff)) {
-    extra_args <- c(extra_args, s_args)
-  } else {
-    extra_args <- c(
-      extra_args,
-      list(
-        afun = list("s_count_occurrences" = a_count_occurrences),
-        s_args = s_args
-      )
-    )
-  }
+  # Append additional info from layout to the analysis function
+  extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE)
+  formals(afun) <- c(formals(afun), extra_args[[".additional_fun_parameters"]])
 
   analyze(
     lyt = lyt,
     vars = vars,
-    afun = ifelse(isFALSE(riskdiff), a_count_occurrences, afun_riskdiff),
-    var_labels = var_labels,
-    show_labels = show_labels,
-    table_names = table_names,
+    afun = afun,
     na_str = na_str,
     nested = nested,
-    extra_args = extra_args
+    extra_args = extra_args,
+    var_labels = var_labels,
+    show_labels = show_labels,
+    table_names = table_names
   )
 }
 
@@ -297,32 +314,36 @@ summarize_occurrences <- function(lyt,
                                   na_str = default_na_str(),
                                   ...,
                                   .stats = "count_fraction_fixed_dp",
+                                  .stat_names = NULL,
                                   .formats = NULL,
                                   .indent_mods = NULL,
                                   .labels = NULL) {
   checkmate::assert_flag(riskdiff)
+  afun <- if (isFALSE(riskdiff)) a_count_occurrences else afun_riskdiff
 
-  extra_args <- list(
-    .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str
+  # Process standard extra arguments
+  extra_args <- list(".stats" = .stats)
+  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
+
+  # Process additional arguments to the statistic function
+  extra_args <- c(
+    extra_args,
+    id = id, drop = drop,
+    if (!isFALSE(riskdiff)) list(afun = list("s_count_occurrences" = a_count_occurrences)),
+    ...
   )
-  s_args <- list(id = id, drop = drop, ...)
 
-  if (isFALSE(riskdiff)) {
-    extra_args <- c(extra_args, s_args)
-  } else {
-    extra_args <- c(
-      extra_args,
-      list(
-        afun = list("s_count_occurrences" = a_count_occurrences),
-        s_args = s_args
-      )
-    )
-  }
+  # Append additional info from layout to the analysis function
+  extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE)
+  formals(afun) <- c(formals(afun), extra_args[[".additional_fun_parameters"]])
 
   summarize_row_groups(
     lyt = lyt,
     var = var,
-    cfun = ifelse(isFALSE(riskdiff), a_count_occurrences, afun_riskdiff),
+    cfun = afun,
     na_str = na_str,
     extra_args = extra_args
   )