Batch 1 make_afun retirement

R/prop_diff.R

@@ -64,7 +64,8 @@ s_proportion_diff <- function(df,
                                 "ha", "newcombe", "newcombecc",
                                 "strat_newcombe", "strat_newcombecc"
                               ),
-                              weights_method = "cmh") {
+                              weights_method = "cmh",
+                              ...) {
   method <- match.arg(method)
   if (is.null(variables$strata) && checkmate::test_subset(method, c("cmh", "strat_newcombe", "strat_newcombecc"))) {
     stop(paste(
@@ -151,6 +152,7 @@ s_proportion_diff <- function(df,
 #' @examples
 #' a_proportion_diff(
 #'   df = subset(dta, grp == "A"),
+#'   .stats = c("diff"),
 #'   .var = "rsp",
 #'   .ref_group = subset(dta, grp == "B"),
 #'   .in_ref_col = FALSE,
@@ -159,11 +161,73 @@ s_proportion_diff <- function(df,
 #' )
 #'
 #' @export
-a_proportion_diff <- make_afun(
-  s_proportion_diff,
-  .formats = c(diff = "xx.x", diff_ci = "(xx.x, xx.x)"),
-  .indent_mods = c(diff = 0L, diff_ci = 1L)
-)
+a_proportion_diff <- function(df,
+                              ...,
+                              .stats = NULL,
+                              .stat_names = NULL,
+                              .formats = NULL,
+                              .labels = NULL,
+                              .indent_mods = NULL) {
+  dots_extra_args <- list(...)
+
+  # Check if there are 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
+
+  # Adding automatically extra parameters to the statistic function (see ?rtables::additional_fun_params)
+  extra_afun_params <- retrieve_extra_afun_params(
+    names(dots_extra_args$.additional_fun_parameters)
+  )
+  dots_extra_args$.additional_fun_parameters <- NULL # After extraction we do not need them anymore
+
+  # Main statistical functions application
+  x_stats <- .apply_stat_functions(
+    default_stat_fnc = s_proportion_diff,
+    custom_stat_fnc_list = custom_stat_functions,
+    args_list = c(
+      df = list(df),
+      extra_afun_params,
+      dots_extra_args
+    )
+  )
+
+  # Fill in with stats defaults if needed
+  met_grp <- get_stats("estimate_proportion_diff", stats_in = .stats)
+
+  x_stats <- x_stats[.stats]
+
+  # Fill in formats/indents/labels with custom input and defaults
+  .formats <- get_formats_from_stats(.stats, .formats)
+  .indent_mods <- get_indents_from_stats(.stats, .indent_mods)
+  if (is.null(.labels)) {
+    .labels <- sapply(x_stats, attr, "label")
+  }
+  .labels <- get_labels_from_stats(.stats, .labels)
+
+  # Auto format handling
+  .formats <- apply_auto_formatting(
+    .formats,
+    x_stats,
+    extra_afun_params$.df_row,
+    extra_afun_params$.var
+  )
+
+  # Get and check statistical names from defaults
+  .stat_names <- get_stat_names(x_stats, .stat_names) # note is x_stats
+
+  # Empty result when no statistics are calculated (reference group)
+  x_stats <- lapply(x_stats, function(xi) if(!nzchar(xi)) NULL else xi)
+
+  in_rows(
+    .list = x_stats,
+    .formats = .formats,
+    .names = names(.labels),
+    .stat_names = .stat_names,
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls()
+  )
+}
 
 #' @describeIn prop_diff Layout-creating function which can take statistics function arguments
 #'   and additional format arguments. This function is a wrapper for [rtables::analyze()].
@@ -198,6 +262,14 @@ a_proportion_diff <- make_afun(
 #' @order 2
 estimate_proportion_diff <- function(lyt,
                                      vars,
+                                     var_labels = vars,
+                                     na_str = default_na_str(),
+                                     nested = TRUE,
+                                     show_labels = "default",
+                                     table_names = vars,
+                                     section_div = NA_character_,
+                                     ...,
+                                     na_rm = TRUE,
                                      variables = list(strata = NULL),
                                      conf_level = 0.95,
                                      method = c(
@@ -206,38 +278,48 @@ estimate_proportion_diff <- function(lyt,
                                        "strat_newcombe", "strat_newcombecc"
                                      ),
                                      weights_method = "cmh",
-                                     na_str = default_na_str(),
-                                     nested = TRUE,
-                                     ...,
-                                     var_labels = vars,
-                                     show_labels = "hidden",
-                                     table_names = vars,
-                                     .stats = NULL,
-                                     .formats = NULL,
+                                     .stats = c("diff", "diff_ci"),
+                                     .stat_names = NULL,
+                                     .formats = c(diff = "xx.x", diff_ci = "(xx.x, xx.x)"),
                                      .labels = NULL,
-                                     .indent_mods = NULL) {
+                                     .indent_mods = c(diff = 0L, diff_ci = 1L)) {
+  # Depending on main functions
   extra_args <- list(
-    variables = variables, conf_level = conf_level, method = method, weights_method = weights_method, ...
+    "na_rm" = na_rm,
+    "variables" = variables,
+    "conf_level" = conf_level,
+    "method" = method,
+    "weights_method" = weights_method,
+    ...
   )
 
-  afun <- make_afun(
-    a_proportion_diff,
-    .stats = .stats,
-    .formats = .formats,
-    .labels = .labels,
-    .indent_mods = .indent_mods
+  # Needed defaults
+  if (!is.null(.stats)) extra_args[[".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
+
+  # Adding all additional information from layout to analysis functions (see ?rtables::additional_fun_params)
+  extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE)
+  formals(a_proportion_diff) <- c(
+    formals(a_proportion_diff),
+    extra_args[[".additional_fun_parameters"]]
   )
 
+  # Main {rtables} structural call
   analyze(
-    lyt,
-    vars,
-    afun = afun,
+    lyt = lyt,
+    vars = vars,
     var_labels = var_labels,
+    afun = a_proportion_diff,
     na_str = na_str,
+    inclNAs = !na_rm,
     nested = nested,
     extra_args = extra_args,
     show_labels = show_labels,
-    table_names = table_names
+    table_names = table_names,
+    section_div = section_div
   )
 }