From a321c9be2441b4a0be615d3b37b377331696189e Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 19:43:13 -0500 Subject: [PATCH 01/41] Clean up other functions --- R/count_values.R | 40 ++++++++++---------------- R/summarize_change.R | 68 ++++++++++++++++++-------------------------- 2 files changed, 43 insertions(+), 65 deletions(-) diff --git a/R/count_values.R b/R/count_values.R index 0a74b60b7a..ce37a2f45a 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -114,23 +114,15 @@ a_count_values <- function(x, .formats = NULL, .labels = NULL, .indent_mods = NULL) { + # Check for additional parameters to the statistics function 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) - ) + 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, + custom_stat_fnc_list = NULL, args_list = c( x = list(x), extra_afun_params, @@ -139,10 +131,7 @@ a_count_values <- function(x, ) # Fill in formatting defaults - .stats <- c( - get_stats("analyze_vars_counts", stats_in = .stats), - names(custom_stat_functions) # Additional stats from custom functions - ) + .stats <- get_stats("analyze_vars_counts", stats_in = .stats) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) @@ -150,14 +139,9 @@ a_count_values <- function(x, x_stats <- x_stats[.stats] # Auto format handling - .formats <- apply_auto_formatting( - .formats, - x_stats, - extra_afun_params$.df_row, - extra_afun_params$.var - ) + .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) - # Get and check statistic names from defaults + # Get and check statistical names .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( @@ -199,14 +183,20 @@ count_values <- function(lyt, .formats = c(count_fraction = "xx (xx.xx%)", count = "xx"), .labels = c(count_fraction = paste(values, collapse = ", ")), .indent_mods = NULL) { - # Process extra args - extra_args <- list("na_rm" = na_rm, "values" = values, ...) - if (!is.null(.stats)) extra_args[[".stats"]] <- .stats + # 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, + 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"]]) diff --git a/R/summarize_change.R b/R/summarize_change.R index 83c6025284..bfc0827647 100644 --- a/R/summarize_change.R +++ b/R/summarize_change.R @@ -60,23 +60,19 @@ s_change_from_baseline <- function(df, ...) { a_change_from_baseline <- function(df, ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL) { + # Check for additional parameters to the statistics function dots_extra_args <- list(...) - - # Check if there are user-defined functions + extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters)) + dots_extra_args$.additional_fun_parameters <- NULL 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 stats calculations + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_change_from_baseline, custom_stat_fnc_list = custom_stat_functions, @@ -88,26 +84,24 @@ a_change_from_baseline <- function(df, ) # Fill in with formatting defaults if needed - .stats <- c( - get_stats("analyze_vars_numeric", stats_in = .stats), - names(custom_stat_functions) # Additional stats from custom functions - ) + .stats <- c(get_stats("analyze_vars_numeric", stats_in = .stats), names(custom_stat_functions)) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) + x_stats <- x_stats[.stats] + # Auto format handling - .formats <- apply_auto_formatting( - .formats, - x_stats, - extra_afun_params$.df_row, - extra_afun_params$.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[.stats], + .list = x_stats, .formats = .formats, .names = names(.labels), + .stat_names = .stat_names, .labels = .labels %>% .unlist_keep_nulls(), .indent_mods = .indent_mods %>% .unlist_keep_nulls() ) @@ -164,51 +158,45 @@ summarize_change <- function(lyt, section_div = NA_character_, ..., .stats = c("n", "mean_sd", "median", "range"), + .stat_names = NULL, .formats = c( - n = "xx", mean_sd = "xx.xx (xx.xx)", mean_se = "xx.xx (xx.xx)", median = "xx.xx", range = "xx.xx - xx.xx", - mean_ci = "(xx.xx, xx.xx)", - median_ci = "(xx.xx, xx.xx)", mean_pval = "xx.xx" ), - .labels = c( - mean_sd = "Mean (SD)", - mean_se = "Mean (SE)", - median = "Median", - range = "Min - Max" - ), + .labels = NULL, .indent_mods = NULL) { - # Extra args must contain .stats, .formats, .labels, .indent_mods - sent to the analysis level + # 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 - # Adding additional arguments to the analysis function (depends on the specific call) - extra_args <- c(extra_args, "na_rm" = na_rm, "variables" = list(variables), ...) + # Process additional arguments to the statistic function + extra_args <- c( + extra_args, + variables = list(variables), + ... + ) - # Adding all additional information from layout to analysis functions (see ?rtables::additional_fun_params) + # Append additional info from layout to the analysis function extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) - formals(a_change_from_baseline) <- c( - formals(a_change_from_baseline), - extra_args[[".additional_fun_parameters"]] - ) + formals(a_change_from_baseline) <- c(formals(a_change_from_baseline), extra_args[[".additional_fun_parameters"]]) - # Main analysis call - Nothing with .* -> these should be dedicated to the analysis function analyze( lyt = lyt, vars = vars, - var_labels = var_labels, afun = a_change_from_baseline, na_str = na_str, nested = nested, extra_args = extra_args, - inclNAs = na_rm, + var_labels = var_labels, show_labels = show_labels, table_names = table_names, + inclNAs = na_rm, section_div = section_div ) } From 4cfa3ca23b0337b9ae4147a3be93d6f3185f25d9 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 19:43:50 -0500 Subject: [PATCH 02/41] Update count_patients_with_flags --- R/count_patients_with_flags.R | 94 ++++++++++++++++++++--------------- 1 file changed, 54 insertions(+), 40 deletions(-) diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 260750de01..e1232976c1 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -55,10 +55,11 @@ NULL #' @export s_count_patients_with_flags <- function(df, .var, - flag_variables, - flag_labels = NULL, .N_col = ncol(df), # nolint .N_row = nrow(df), # nolint + ..., + flag_variables, + flag_labels = NULL, denom = c("n", "N_col", "N_row")) { checkmate::assert_character(flag_variables) if (!is.null(flag_labels)) { @@ -72,8 +73,8 @@ s_count_patients_with_flags <- function(df, flag_variables <- names(flag_variables) } } - checkmate::assert_subset(flag_variables, colnames(df)) + temp <- sapply(flag_variables, function(x) { tmp <- Map(function(y) which(df[[y]]), x) position_satisfy_flags <- Reduce(intersect, tmp) @@ -113,39 +114,42 @@ s_count_patients_with_flags <- function(df, #' @export a_count_patients_with_flags <- function(df, labelstr = "", - flag_variables, - flag_labels = NULL, - denom = c("n", "N_col", "N_row"), - .N_col = ncol(df), # nolint - .N_row = nrow(df), # nolint - .df_row, - .var = NULL, + ..., .stats = NULL, .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str()) { - x_stats <- s_count_patients_with_flags( - df = df, .var = .var, flag_variables = flag_variables, flag_labels = flag_labels, - .N_col = .N_col, .N_row = .N_row, denom = denom - ) + .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 + flag_variables <- dots_extra_args[["flag_variables"]] + flag_labels <- dots_extra_args[["flag_labels"]] + if (is.null(names(flag_variables))) flag_variables <- formatters::var_labels(df, fill = TRUE)[flag_variables] if (is.null(flag_labels)) flag_labels <- flag_variables - if (is.null(unlist(x_stats))) { - return(NULL) - } + # Apply statistics function + x_stats <- .apply_stat_functions( + default_stat_fnc = s_count_patients_with_flags, + custom_stat_fnc_list = NULL, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) + ) - # Fill in with formatting defaults if needed + # Fill in formatting defaults .stats <- get_stats("count_patients_with_flags", stats_in = .stats) levels_per_stats <- rep(list(names(flag_variables)), length(.stats)) %>% setNames(.stats) .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) - .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) .labels <- get_labels_from_stats( .stats, .labels, levels_per_stats, - flag_labels %>% setNames(names(flag_variables)) + tern_defaults = flag_labels %>% setNames(names(flag_variables)) ) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) x_stats <- x_stats[.stats] @@ -155,9 +159,9 @@ a_count_patients_with_flags <- function(df, setNames(names(.formats)) # 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 from defaults + # Get and check statistical names .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( @@ -166,8 +170,7 @@ a_count_patients_with_flags <- function(df, .names = names(.labels), .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() ) } @@ -222,33 +225,44 @@ count_patients_with_flags <- function(lyt, .indent_mods = NULL, .labels = NULL) { checkmate::assert_flag(riskdiff) - extra_args <- list( - .stats = .stats, .stat_names = .stat_names, .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, + flag_variables = list(flag_variables), flag_labels = list(flag_labels), + ... ) - s_args <- list(flag_variables = flag_variables, flag_labels = flag_labels, ...) if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) + afun <- a_count_patients_with_flags } else { + afun <- afun_riskdiff extra_args <- c( extra_args, - list( - afun = list("s_count_patients_with_flags" = a_count_patients_with_flags), - s_args = s_args - ) + list(afun = list("s_count_patients_with_flags" = a_count_patients_with_flags)) ) } + # 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 = var, - afun = ifelse(isFALSE(riskdiff), a_count_patients_with_flags, 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 ) } From 92740541d8784deeb6ccdaf8210235e5927357ee Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 19:44:08 -0500 Subject: [PATCH 03/41] Update afun_riskdiff function --- R/riskdiff.R | 38 ++++++++----------- .../testthat/test-count_patients_with_flags.R | 10 +++-- 2 files changed, 22 insertions(+), 26 deletions(-) diff --git a/R/riskdiff.R b/R/riskdiff.R index 0bea490e30..834736248e 100644 --- a/R/riskdiff.R +++ b/R/riskdiff.R @@ -85,19 +85,13 @@ add_riskdiff <- function(arm_x, #' @keywords internal afun_riskdiff <- function(df, labelstr = "", - .var, - .N_col, # nolint - .N_row, # nolint - .df_row, - .spl_context, - .all_col_counts, - .stats, + afun, + ..., + .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str(), - afun, - s_args = list()) { + .indent_mods = NULL) { if (!any(grepl("riskdiff", names(.spl_context)))) { stop( "Please set up levels to use in risk difference calculations using the `add_riskdiff` ", @@ -106,17 +100,18 @@ afun_riskdiff <- function(df, } checkmate::assert_list(afun, len = 1, types = "function") checkmate::assert_named(afun) - afun_args <- list( - .var = .var, .df_row = .df_row, .N_row = .N_row, denom = "N_col", labelstr = labelstr, - .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str - ) - afun_args <- afun_args[intersect(names(afun_args), names(as.list(args(afun[[1]]))))] - if ("denom" %in% names(s_args)) afun_args[["denom"]] <- NULL + sfun <- names(afun) + dots_extra_args <- list(...)[intersect(names(list(...)), names(formals(sfun)))] + extra_args <- list( + .var = .var, .df_row = .df_row, .N_col = .N_col, .N_row = .N_row, .stats = .stats, .formats = .formats, + .labels = .labels, .indent_mods = .indent_mods + ) cur_split <- tail(.spl_context$cur_col_split_val[[1]], 1) + if (!grepl("^riskdiff", cur_split)) { # Apply basic afun (no risk difference) in all other columns - do.call(afun[[1]], args = c(list(df = df, .N_col = .N_col), afun_args, s_args)) + do.call(afun[[1]], args = c(list(df = df, labelstr = labelstr), extra_args, dots_extra_args)) } else { arm_x <- strsplit(cur_split, "_")[[1]][2] arm_y <- strsplit(cur_split, "_")[[1]][3] @@ -127,15 +122,14 @@ afun_riskdiff <- function(df, arm_spl_x <- arm_x arm_spl_y <- arm_y } - N_col_x <- .all_col_counts[[arm_spl_x]] # nolint N_col_y <- .all_col_counts[[arm_spl_y]] # nolint cur_var <- tail(.spl_context$cur_col_split[[1]], 1) # Apply statistics function to arm X and arm Y data - s_args <- c(s_args, afun_args[intersect(names(afun_args), names(as.list(args(names(afun)))))]) - s_x <- do.call(names(afun), args = c(list(df = df[df[[cur_var]] == arm_x, ], .N_col = N_col_x), s_args)) - s_y <- do.call(names(afun), args = c(list(df = df[df[[cur_var]] == arm_y, ], .N_col = N_col_y), s_args)) + s_args <- c(dots_extra_args, extra_args[intersect(setdiff(names(extra_args), ".N_col"), names(formals(sfun)))]) + s_x <- do.call(sfun, args = c(list(df = df[df[[cur_var]] == arm_x, ], .N_col = N_col_x), s_args)) + s_y <- do.call(sfun, args = c(list(df = df[df[[cur_var]] == arm_y, ], .N_col = N_col_y), s_args)) # Get statistic name and row names stat <- ifelse("count_fraction" %in% names(s_x), "count_fraction", "unique") diff --git a/tests/testthat/test-count_patients_with_flags.R b/tests/testthat/test-count_patients_with_flags.R index 60f8744201..f7bfd6162f 100644 --- a/tests/testthat/test-count_patients_with_flags.R +++ b/tests/testthat/test-count_patients_with_flags.R @@ -117,7 +117,7 @@ testthat::test_that("a_count_patients_with_flags works with healthy input.", { adae_local, .var = "USUBJID", flag_variables = aesi_vars, flag_labels = labels, - .N_col = 10, .N_row = 10, .df_row = raw_data, + .N_col = 10, .N_row = 10, .df_row = adae_local, .stats = get_stats("count_patients_with_flags") ) @@ -142,7 +142,7 @@ testthat::test_that("a_count_patients_with_flags works with custom input.", { adae_local, .var = "USUBJID", flag_variables = aesi_vars, flag_labels = labels, - .N_col = 10, .N_row = 10, .df_row = raw_data, + .N_col = 10, .N_row = 10, .df_row = adae_local, .stats = "count_fraction", .formats = c(count_fraction = "xx (xx.xx%)"), .labels = list("count_fraction.SER" = "New label"), @@ -377,7 +377,8 @@ testthat::test_that("count_patients_with_flags works as expected with risk diffe count_patients_with_flags( var = "USUBJID", flag_variables = c("SER", "SERFATAL"), - riskdiff = TRUE + riskdiff = TRUE, + denom = "N_col" ) %>% build_table(adae, alt_counts_df = tern_ex_adsl) @@ -391,7 +392,8 @@ testthat::test_that("count_patients_with_flags works as expected with risk diffe var = "USUBJID", flag_variables = c("SER", "SERFATAL"), .stats = c("count", "count_fraction"), - riskdiff = TRUE + riskdiff = TRUE, + denom = "N_col" ) %>% build_table(adae) From 0baeea835c4be257e99d864902b9e974007bddcf Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 20:02:26 -0500 Subject: [PATCH 04/41] Update count_occurrences --- R/count_occurrences.R | 118 ++++++++++++++++++++-------------- R/count_patients_with_flags.R | 10 +-- 2 files changed, 76 insertions(+), 52 deletions(-) diff --git a/R/count_occurrences.R b/R/count_occurrences.R index bbac47fb02..23803c564e 100644 --- a/R/count_occurrences.R +++ b/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,27 +154,29 @@ 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 + .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 + + # Apply statistics function + x_stats <- .apply_stat_functions( + default_stat_fnc = s_count_occurrences, + custom_stat_fnc_list = NULL, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) ) - if (is.null(unlist(x_stats))) { - return(NULL) - } - # Fill in with formatting defaults if needed + # Fill in formatting defaults .stats <- get_stats("count_occurrences", stats_in = .stats) x_stats <- x_stats[.stats] levels_per_stats <- lapply(x_stats, names) @@ -181,19 +184,16 @@ a_count_occurrences <- function(df, .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) 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 +233,50 @@ 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) - 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, + ... ) - s_args <- list(id = id, drop = drop, ...) if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) + afun <- a_count_occurrences } else { + afun <- afun_riskdiff extra_args <- c( extra_args, - list( - afun = list("s_count_occurrences" = a_count_occurrences), - s_args = s_args - ) + list(afun = list("s_count_occurrences" = a_count_occurrences)) ) } + # 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 +309,44 @@ 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) - 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, + ... ) - s_args <- list(id = id, drop = drop, ...) if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) + afun <- a_count_occurrences } else { + afun <- afun_riskdiff extra_args <- c( extra_args, - list( - afun = list("s_count_occurrences" = a_count_occurrences), - s_args = s_args - ) + list(afun = list("s_count_occurrences" = a_count_occurrences)) ) } + # 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 ) diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index e1232976c1..52e72dd9ea 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -153,17 +153,17 @@ a_count_patients_with_flags <- function(df, x_stats <- x_stats[.stats] - # Unlist stats - x_stats <- x_stats %>% - .unlist_keep_nulls() %>% - setNames(names(.formats)) - # Auto format handling .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) + # Unlist stats + x_stats <- x_stats %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) + in_rows( .list = x_stats, .formats = .formats, From 9f86f269df31a46af90266111d9553eac5f42a9d Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 20:12:58 -0500 Subject: [PATCH 05/41] Clean up --- R/count_occurrences.R | 24 ++++-------------------- R/count_patients_with_flags.R | 12 ++---------- 2 files changed, 6 insertions(+), 30 deletions(-) diff --git a/R/count_occurrences.R b/R/count_occurrences.R index 23803c564e..c0fa06f2ce 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -238,6 +238,7 @@ count_occurrences <- function(lyt, .labels = NULL, .indent_mods = NULL) { checkmate::assert_flag(riskdiff) + afun <- if (isFALSE(riskdiff)) a_count_occurrences else afun_riskdiff # Process standard extra arguments extra_args <- list(".stats" = .stats) @@ -250,19 +251,10 @@ count_occurrences <- function(lyt, extra_args <- c( extra_args, id = id, drop = drop, + if (!isFALSE(riskdiff)) list(afun = list("s_count_occurrences" = a_count_occurrences)), ... ) - if (isFALSE(riskdiff)) { - afun <- a_count_occurrences - } else { - afun <- afun_riskdiff - extra_args <- c( - extra_args, - list(afun = list("s_count_occurrences" = a_count_occurrences)) - ) - } - # 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"]]) @@ -314,6 +306,7 @@ summarize_occurrences <- function(lyt, .indent_mods = NULL, .labels = NULL) { checkmate::assert_flag(riskdiff) + afun <- if (isFALSE(riskdiff)) a_count_occurrences else afun_riskdiff # Process standard extra arguments extra_args <- list(".stats" = .stats) @@ -326,19 +319,10 @@ summarize_occurrences <- function(lyt, extra_args <- c( extra_args, id = id, drop = drop, + if (!isFALSE(riskdiff)) list(afun = list("s_count_occurrences" = a_count_occurrences)), ... ) - if (isFALSE(riskdiff)) { - afun <- a_count_occurrences - } else { - afun <- afun_riskdiff - extra_args <- c( - extra_args, - list(afun = list("s_count_occurrences" = a_count_occurrences)) - ) - } - # 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"]]) diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 52e72dd9ea..2f638c4bbb 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -225,6 +225,7 @@ count_patients_with_flags <- function(lyt, .indent_mods = NULL, .labels = NULL) { checkmate::assert_flag(riskdiff) + afun <- if (isFALSE(riskdiff)) a_count_patients_with_flags else afun_riskdiff # Process standard extra arguments extra_args <- list(".stats" = .stats) @@ -237,19 +238,10 @@ count_patients_with_flags <- function(lyt, extra_args <- c( extra_args, flag_variables = list(flag_variables), flag_labels = list(flag_labels), + if (!isFALSE(riskdiff)) list(afun = list("s_count_patients_with_flags" = a_count_patients_with_flags)), ... ) - if (isFALSE(riskdiff)) { - afun <- a_count_patients_with_flags - } else { - afun <- afun_riskdiff - extra_args <- c( - extra_args, - list(afun = list("s_count_patients_with_flags" = a_count_patients_with_flags)) - ) - } - # 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"]]) From 3e1ab3f2b67d37336637e4791029e11ccf5d4ee7 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 20:21:08 -0500 Subject: [PATCH 06/41] Update count_occurrences_by_grade --- R/count_occurrences_by_grade.R | 134 +++++++++++++++++---------------- 1 file changed, 68 insertions(+), 66 deletions(-) diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index 98697b77f0..886b3b2239 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -149,15 +149,16 @@ h_append_grade_groups <- function(grade_groups, refs, remove_single = TRUE, only #' #' @export s_count_occurrences_by_grade <- function(df, + labelstr = "", .var, .N_row, # nolint .N_col, # nolint + ..., id = "USUBJID", grade_groups = list(), remove_single = TRUE, only_grade_groups = FALSE, - denom = c("N_col", "n", "N_row"), - labelstr = "") { + denom = c("N_col", "n", "N_row")) { assert_valid_factor(df[[.var]]) assert_df_with_variables(df, list(grade = .var, id = id)) @@ -248,31 +249,29 @@ s_count_occurrences_by_grade <- function(df, #' @export a_count_occurrences_by_grade <- function(df, labelstr = "", - id = "USUBJID", - grade_groups = list(), - remove_single = TRUE, - only_grade_groups = FALSE, - denom = c("N_col", "n", "N_row"), - .N_col, # nolint - .N_row, # nolint - .df_row, - .var = NULL, + ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str()) { - x_stats <- s_count_occurrences_by_grade( - df = df, .var = .var, .N_row = .N_row, .N_col = .N_col, id = id, - grade_groups = grade_groups, remove_single = remove_single, only_grade_groups = only_grade_groups, - denom = denom, labelstr = labelstr + .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 + + # Apply statistics function + x_stats <- .apply_stat_functions( + default_stat_fnc = s_count_occurrences_by_grade, + custom_stat_fnc_list = NULL, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) ) - if (is.null(unlist(x_stats))) { - return(NULL) - } - - # Fill in with formatting defaults if needed + # Fill in formatting defaults .stats <- get_stats("count_occurrences_by_grade", stats_in = .stats) x_stats <- x_stats[.stats] levels_per_stats <- lapply(x_stats, names) @@ -280,19 +279,16 @@ a_count_occurrences_by_grade <- function(df, .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) 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() ) } @@ -365,39 +361,42 @@ count_occurrences_by_grade <- function(lyt, ..., table_names = var, .stats = "count_fraction", + .stat_names = NULL, .formats = list(count_fraction = format_count_fraction_fixed_dp), .indent_mods = NULL, .labels = NULL) { checkmate::assert_flag(riskdiff) - extra_args <- list( - .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str - ) - s_args <- list( - id = id, grade_groups = grade_groups, remove_single = remove_single, only_grade_groups = only_grade_groups, ... + afun <- if (isFALSE(riskdiff)) a_count_occurrences_by_grade else afun_riskdiff + + # 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, grade_groups = list(grade_groups), remove_single = remove_single, only_grade_groups = only_grade_groups, + if (!isFALSE(riskdiff)) list(afun = list("s_count_occurrences_by_grade" = a_count_occurrences_by_grade)), + ... ) - if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) - } else { - extra_args <- c( - extra_args, - list( - afun = list("s_count_occurrences_by_grade" = a_count_occurrences_by_grade), - 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 = var, - afun = ifelse(isFALSE(riskdiff), a_count_occurrences_by_grade, 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 ) } @@ -441,33 +440,36 @@ summarize_occurrences_by_grade <- function(lyt, na_str = default_na_str(), ..., .stats = "count_fraction", + .stat_names = NULL, .formats = list(count_fraction = format_count_fraction_fixed_dp), .indent_mods = NULL, .labels = NULL) { checkmate::assert_flag(riskdiff) - extra_args <- list( - .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str - ) - s_args <- list( - id = id, grade_groups = grade_groups, remove_single = remove_single, only_grade_groups = only_grade_groups, ... + afun <- if (isFALSE(riskdiff)) a_count_occurrences_by_grade else afun_riskdiff + + # 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, grade_groups = list(grade_groups), remove_single = remove_single, only_grade_groups = only_grade_groups, + if (!isFALSE(riskdiff)) list(afun = list("s_count_occurrences_by_grade" = a_count_occurrences_by_grade)), + ... ) - if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) - } else { - extra_args <- c( - extra_args, - list( - afun = list("s_count_occurrences_by_grade" = a_count_occurrences_by_grade), - 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_by_grade, afun_riskdiff), + cfun = afun, na_str = na_str, extra_args = extra_args ) From ff02a76cad763a920c00d072a81f3576f9da08f4 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 20:50:47 -0500 Subject: [PATCH 07/41] Update count_patients_with_event --- R/count_patients_with_event.R | 81 ++++++++++--------- .../testthat/test-count_patients_with_event.R | 6 +- 2 files changed, 49 insertions(+), 38 deletions(-) diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index 520f09478d..f76a23a20c 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -60,9 +60,10 @@ NULL #' @export s_count_patients_with_event <- function(df, .var, - filters, .N_col = ncol(df), # nolint .N_row = nrow(df), # nolint + ..., + filters, denom = c("n", "N_col", "N_row")) { col_names <- names(filters) filter_values <- filters @@ -104,26 +105,29 @@ s_count_patients_with_event <- function(df, #' @export a_count_patients_with_event <- function(df, labelstr = "", - filters, - .N_col, # nolint - .N_row, # nolint - denom = c("n", "N_col", "N_row"), - .df_row, - .var = NULL, + ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str()) { - x_stats <- s_count_patients_with_event( - df = df, .var = .var, filters = filters, .N_col, .N_row, denom = denom - ) + .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 - if (is.null(unlist(x_stats))) { - return(NULL) - } + # Apply statistics function + x_stats <- .apply_stat_functions( + default_stat_fnc = s_count_patients_with_event, + custom_stat_fnc_list = NULL, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) + ) - # Fill in with formatting defaults if needed + # Fill in formatting defaults .stats <- get_stats("count_patients_with_event", stats_in = .stats) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) @@ -138,9 +142,9 @@ a_count_patients_with_event <- function(df, .list = x_stats, .formats = .formats, .names = names(.labels), + .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() ) } @@ -195,35 +199,40 @@ count_patients_with_event <- function(lyt, ..., table_names = vars, .stats = "count_fraction", + .stat_names = NULL, .formats = list(count_fraction = format_count_fraction_fixed_dp), .labels = NULL, .indent_mods = NULL) { checkmate::assert_flag(riskdiff) - extra_args <- list( - .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str + afun <- if (isFALSE(riskdiff)) a_count_patients_with_event else afun_riskdiff + + # 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, + filters = list(filters), + if (!isFALSE(riskdiff)) list(afun = list("s_count_patients_with_event" = a_count_patients_with_event)), + ... ) - s_args <- list(filters = filters, ...) - if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) - } else { - extra_args <- c( - extra_args, - list( - afun = list("s_count_patients_with_event" = a_count_patients_with_event), - 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_patients_with_event, afun_riskdiff), - show_labels = ifelse(length(vars) > 1, "visible", "hidden"), - table_names = table_names, + afun = afun, na_str = na_str, nested = nested, - extra_args = extra_args + extra_args = extra_args, + show_labels = ifelse(length(vars) > 1, "visible", "hidden"), + table_names = table_names ) } diff --git a/tests/testthat/test-count_patients_with_event.R b/tests/testthat/test-count_patients_with_event.R index 1f9a9ea12d..d452cdc67d 100644 --- a/tests/testthat/test-count_patients_with_event.R +++ b/tests/testthat/test-count_patients_with_event.R @@ -180,7 +180,8 @@ testthat::test_that("count_patients_with_flags works as expected with risk diffe vars = "USUBJID", filters = c("TRTEMFL" = "Y"), .labels = c(count_fraction = "Total number of patients with at least one adverse event"), - riskdiff = TRUE + riskdiff = TRUE, + denom = "N_col" ) %>% build_table(tern_ex_adae, alt_counts_df = tern_ex_adsl) @@ -194,7 +195,8 @@ testthat::test_that("count_patients_with_flags works as expected with risk diffe vars = "USUBJID", filters = c("TRTEMFL" = "Y"), .stats = c("count", "count_fraction"), - riskdiff = TRUE + riskdiff = TRUE, + denom = "N_col" ) %>% build_table(tern_ex_adae) From c46798a71c09f7590b10f388a1720d97fefbfade Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 21:11:21 -0500 Subject: [PATCH 08/41] Update incidence_rate --- R/incidence_rate.R | 103 ++++++++++++++---------- R/utils_default_stats_formats_labels.R | 6 +- tests/testthat/_snaps/incidence_rate.md | 14 ++-- 3 files changed, 71 insertions(+), 52 deletions(-) diff --git a/R/incidence_rate.R b/R/incidence_rate.R index c517c35e8c..30d756d03f 100644 --- a/R/incidence_rate.R +++ b/R/incidence_rate.R @@ -59,6 +59,7 @@ NULL #' @keywords internal s_incidence_rate <- function(df, .var, + ..., n_events, is_event = lifecycle::deprecated(), id_var = "USUBJID", @@ -125,56 +126,56 @@ s_incidence_rate <- function(df, #' @export a_incidence_rate <- function(df, labelstr = "", - .var, - .df_row, - n_events, - id_var = "USUBJID", - control = control_incidence_rate(), + label_fmt = "%s - %.labels", + ..., .stats = NULL, - .formats = c( - "person_years" = "xx.x", - "n_events" = "xx", - "rate" = "xx.xx", - "rate_ci" = "(xx.xx, xx.xx)", - "n_unique" = "xx", - "n_rate" = "xx (xx.x)" - ), + .stat_names = NULL, + .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str(), - label_fmt = "%s - %.labels") { + .indent_mods = NULL) { checkmate::assert_string(label_fmt) - x_stats <- s_incidence_rate( - df = df, .var = .var, n_events = n_events, id_var = id_var, control = control + # 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 + + # Main statistic calculations + x_stats <- .apply_stat_functions( + default_stat_fnc = s_incidence_rate, + custom_stat_fnc_list = NULL, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) ) - if (is.null(unlist(x_stats))) { - return(NULL) - } - # Fill in with defaults - formats_def <- formals()$.formats %>% eval() - .formats <- c(.formats, formats_def)[!duplicated(names(c(.formats, formats_def)))] - labels_def <- sapply(x_stats, \(x) attributes(x)$label) - .labels <- c(.labels, labels_def)[!duplicated(names(c(.labels, labels_def)))] + # Fill in formatting defaults + .stats <- get_stats("estimate_incidence_rate", stats_in = .stats) + x_stats <- x_stats[.stats] + .formats <- get_formats_from_stats(.stats, .formats) + .labels <- get_labels_from_stats(.stats, .labels, tern_defaults = lapply(x_stats, attr, "label")) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods) + + # Apply label format if (nzchar(labelstr) > 0) { .labels <- sapply(.labels, \(x) gsub("%.labels", x, gsub("%s", labelstr, label_fmt))) } - # Fill in with formatting defaults if needed - .stats <- get_stats("estimate_incidence_rate", stats_in = .stats) - .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) - x_stats <- x_stats[.stats] + # Get and check statistical names + .stat_names <- get_stat_names(x_stats, .stat_names) 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(), - .format_na_strs = na_str + .indent_mods = .indent_mods %>% .unlist_keep_nulls() ) } @@ -227,29 +228,43 @@ estimate_incidence_rate <- function(lyt, show_labels = "hidden", table_names = vars, .stats = c("person_years", "n_events", "rate", "rate_ci"), - .formats = NULL, + .stat_names = NULL, + .formats = list(rate = "xx.xx", rate_ci = "(xx.xx, xx.xx)"), .labels = NULL, .indent_mods = NULL) { + # 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( - list(.stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str), - list(n_events = n_events, id_var = id_var, control = control, label_fmt = label_fmt, ...) + extra_args, + n_events = n_events, id_var = id_var, control = list(control), label_fmt = label_fmt, + ... ) + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_incidence_rate) <- c(formals(a_incidence_rate), extra_args[[".additional_fun_parameters"]]) + if (!summarize) { analyze( - lyt, - vars, - show_labels = show_labels, - table_names = table_names, + lyt = lyt, + vars = vars, afun = a_incidence_rate, na_str = na_str, nested = nested, - extra_args = extra_args + extra_args = extra_args, + show_labels = show_labels, + table_names = table_names ) } else { summarize_row_groups( - lyt, - vars, + lyt = lyt, + var = vars, cfun = a_incidence_rate, na_str = na_str, extra_args = extra_args diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 84dba5b9ac..8c2b2b0d53 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -590,7 +590,11 @@ tern_default_formats <- c( rate = "xx.xxxx", rate_ci = "(xx.xxxx, xx.xxxx)", rate_ratio = "xx.xxxx", - rate_ratio_ci = "(xx.xxxx, xx.xxxx)" + rate_ratio_ci = "(xx.xxxx, xx.xxxx)", + person_years = "xx.x", + n_events = "xx", + n_unique = "xx", + n_rate = "xx (xx.x)" ) # tern_default_labels ---------------------------------------------------------- diff --git a/tests/testthat/_snaps/incidence_rate.md b/tests/testthat/_snaps/incidence_rate.md index 44854523b7..ba47eb39db 100644 --- a/tests/testthat/_snaps/incidence_rate.md +++ b/tests/testthat/_snaps/incidence_rate.md @@ -59,13 +59,13 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod - 1 person_years 108.7 0 - 2 n_events 4 0 - 3 rate 3.68 0 - 4 rate_ci (0.07, 7.29) 0 - 5 n_unique 4 0 - 6 n_rate 4 (3.7) 0 + row_name formatted_cell indent_mod + 1 person_years 108.7 0 + 2 n_events 4 0 + 3 rate 3.6799 0 + 4 rate_ci (0.0737, 7.2860) 0 + 5 n_unique 4 0 + 6 n_rate 4 (3.7) 0 row_label 1 Total patient-years at risk 2 Number of adverse events observed From 0c73885857bf934fa9b68c401ea477bc5986a7c2 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 22:26:31 -0500 Subject: [PATCH 09/41] Update summarize_patients_exposure_in_cols --- R/summarize_patients_exposure_in_cols.R | 180 +++++++++++------- R/utils_default_stats_formats_labels.R | 4 +- ...test-summarize_patients_exposure_in_cols.R | 3 +- 3 files changed, 120 insertions(+), 67 deletions(-) diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index cce40b6c44..b7ef42b4f0 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -39,11 +39,12 @@ NULL #' #' @keywords internal s_count_patients_sum_exposure <- function(df, - ex_var = "AVAL", - id = "USUBJID", labelstr = "", .stats = c("n_patients", "sum_exposure"), .N_col, # nolint + ..., + ex_var = "AVAL", + id = "USUBJID", custom_label = NULL) { assert_df_with_variables(df, list(ex_var = ex_var, id = id)) checkmate::assert_string(id) @@ -87,69 +88,80 @@ s_count_patients_sum_exposure <- function(df, #' @return #' * `a_count_patients_sum_exposure()` returns formatted [rtables::CellValue()]. #' -#' @examples -#' a_count_patients_sum_exposure( -#' df = df, -#' var = "SEX", -#' .N_col = nrow(df), -#' .stats = "n_patients" -#' ) -#' -#' @export +#' @keywords internal a_count_patients_sum_exposure <- function(df, - var = NULL, - ex_var = "AVAL", - id = "USUBJID", - add_total_level = FALSE, - custom_label = NULL, labelstr = "", - .N_col, # nolint - .stats, - .formats = list(n_patients = "xx (xx.x%)", sum_exposure = "xx")) { + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL) { + checkmate::assert_character(.stats, len = 1) + + # 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 + + add_total_level <- dots_extra_args$add_total_level checkmate::assert_flag(add_total_level) + var <- dots_extra_args$var if (!is.null(var)) { assert_df_with_variables(df, list(var = var)) df[[var]] <- as.factor(df[[var]]) } - y <- list() - if (is.null(var)) { - y[[.stats]] <- list(Total = s_count_patients_sum_exposure( - df = df, - ex_var = ex_var, - id = id, - labelstr = labelstr, - .N_col = .N_col, - .stats = .stats, - custom_label = custom_label - )[[.stats]]) - } else { + x_stats <- list() + if (!is.null(var)) { for (lvl in levels(df[[var]])) { - y[[.stats]][[lvl]] <- s_count_patients_sum_exposure( - df = subset(df, get(var) == lvl), - ex_var = ex_var, - id = id, - labelstr = labelstr, - .N_col = .N_col, - .stats = .stats, - custom_label = lvl - )[[.stats]] - } - if (add_total_level) { - y[[.stats]][["Total"]] <- s_count_patients_sum_exposure( - df = df, - ex_var = ex_var, - id = id, - labelstr = labelstr, - .N_col = .N_col, - .stats = .stats, - custom_label = custom_label - )[[.stats]] + x_stats_i <- .apply_stat_functions( + default_stat_fnc = s_count_patients_sum_exposure, + custom_stat_fnc_list = NULL, + args_list = c( + df = list(subset(df, get(var) == lvl)), + extra_afun_params, + dots_extra_args + ) + ) + x_stats[[.stats]][[lvl]] <- x_stats_i[[.stats]] } } - in_rows(.list = y[[.stats]], .formats = .formats[[.stats]]) + if (add_total_level) { + x_stats_total <- .apply_stat_functions( + default_stat_fnc = s_count_patients_sum_exposure, + custom_stat_fnc_list = NULL, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) + ) + x_stats[[.stats]][["Total"]] <- x_stats_total[[.stats]] + } + + # Fill in formatting defaults + .stats <- get_stats("analyze_patients_exposure_in_cols", stats_in = .stats) + 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) + + # Auto format handling + .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var) + + # browser() + in_rows( + .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() + ) } #' @describeIn summarize_patients_exposure_in_cols Layout-creating function which can take statistics @@ -177,7 +189,7 @@ a_count_patients_sum_exposure <- function(df, #' #' @export #' @order 3 -summarize_patients_exposure_in_cols <- function(lyt, # nolint +summarize_patients_exposure_in_cols <- function(lyt, var, ex_var = "AVAL", id = "USUBJID", @@ -187,15 +199,35 @@ summarize_patients_exposure_in_cols <- function(lyt, # nolint na_str = default_na_str(), ..., .stats = c("n_patients", "sum_exposure"), - .labels = c(n_patients = "Patients", sum_exposure = "Person time"), + .stat_names = NULL, + .formats = list(n_patients = "xx (xx.x%)", sum_exposure = "xx"), + .labels = list(n_patients = "Patients", sum_exposure = "Person time"), .indent_mods = NULL) { - extra_args <- list(ex_var = ex_var, id = id, add_total_level = add_total_level, custom_label = custom_label, ...) + # Process standard extra arguments + extra_args <- list() + 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, + ex_var = ex_var, id = id, add_total_level = add_total_level, custom_label = custom_label, + ... + ) + + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_count_patients_sum_exposure) <- c( + formals(a_count_patients_sum_exposure), extra_args[[".additional_fun_parameters"]] + ) if (col_split) { lyt <- split_cols_by_multivar( lyt = lyt, vars = rep(var, length(.stats)), - varlabels = .labels[.stats], + varlabels = unlist(.labels[.stats]), extra_args = list(.stats = .stats) ) } @@ -280,7 +312,7 @@ summarize_patients_exposure_in_cols <- function(lyt, # nolint #' #' @export #' @order 2 -analyze_patients_exposure_in_cols <- function(lyt, # nolint +analyze_patients_exposure_in_cols <- function(lyt, var = NULL, ex_var = "AVAL", id = "USUBJID", @@ -289,26 +321,44 @@ analyze_patients_exposure_in_cols <- function(lyt, # nolint col_split = TRUE, na_str = default_na_str(), .stats = c("n_patients", "sum_exposure"), - .labels = c(n_patients = "Patients", sum_exposure = "Person time"), - .indent_mods = 0L, + .stat_names = NULL, + .formats = list(n_patients = "xx (xx.x%)", sum_exposure = "xx"), + .labels = list(n_patients = "Patients", sum_exposure = "Person time"), + .indent_mods = NULL, ...) { - extra_args <- list( - var = var, ex_var = ex_var, id = id, add_total_level = add_total_level, custom_label = custom_label, ... + # Process standard extra arguments + extra_args <- list() + 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, + var = var, ex_var = ex_var, id = id, add_total_level = add_total_level, custom_label = custom_label, + ... + ) + + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_count_patients_sum_exposure) <- c( + formals(a_count_patients_sum_exposure), extra_args[[".additional_fun_parameters"]] ) if (col_split) { lyt <- split_cols_by_multivar( lyt = lyt, vars = rep(ex_var, length(.stats)), - varlabels = .labels[.stats], + varlabels = unlist(.labels[.stats]), extra_args = list(.stats = .stats) ) } - lyt <- lyt %>% analyze_colvars( + + analyze_colvars( + lyt = lyt, afun = a_count_patients_sum_exposure, - indent_mod = .indent_mods, na_str = na_str, extra_args = extra_args ) - lyt } diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 8c2b2b0d53..d66d4633ca 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -594,7 +594,9 @@ tern_default_formats <- c( person_years = "xx.x", n_events = "xx", n_unique = "xx", - n_rate = "xx (xx.x)" + n_rate = "xx (xx.x)", + n_patients = "xx (xx.x%)", + sum_exposure = "xx" ) # tern_default_labels ---------------------------------------------------------- diff --git a/tests/testthat/test-summarize_patients_exposure_in_cols.R b/tests/testthat/test-summarize_patients_exposure_in_cols.R index 05c03615d4..26bfd49507 100644 --- a/tests/testthat/test-summarize_patients_exposure_in_cols.R +++ b/tests/testthat/test-summarize_patients_exposure_in_cols.R @@ -28,7 +28,8 @@ testthat::test_that("a_count_patients_sum_exposure works as expected", { df = anl_local, var = "SEX", .N_col = nrow(adsl_local), - .stats = "n_patients" + .stats = "n_patients", + add_total_level = FALSE ) res <- testthat::expect_silent(result) From 777949a11950be5efc7e695be59f3ec6e4a969aa Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 20 Feb 2025 23:09:07 -0500 Subject: [PATCH 10/41] Update summarize_num_patients --- R/count_occurrences_by_grade.R | 1 + R/summarize_num_patients.R | 172 +++++++++++------- R/summarize_patients_exposure_in_cols.R | 2 + .../testthat/_snaps/summarize_num_patients.md | 12 +- tests/testthat/test-summarize_num_patients.R | 6 +- 5 files changed, 124 insertions(+), 69 deletions(-) diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index 886b3b2239..b1fb0ca77c 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -266,6 +266,7 @@ a_count_occurrences_by_grade <- function(df, custom_stat_fnc_list = NULL, args_list = c( df = list(df), + labelstr = list(labelstr), extra_afun_params, dots_extra_args ) diff --git a/R/summarize_num_patients.R b/R/summarize_num_patients.R index e9b8bdefc8..4c179deeea 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -50,7 +50,12 @@ NULL #' ) #' #' @export -s_num_patients <- function(x, labelstr, .N_col, count_by = NULL, unique_count_suffix = TRUE) { # nolint +s_num_patients <- function(x, + labelstr, + .N_col, # nolint + ..., + count_by = NULL, + unique_count_suffix = TRUE) { checkmate::assert_string(labelstr) checkmate::assert_count(.N_col) @@ -103,6 +108,7 @@ s_num_patients_content <- function(df, labelstr = "", .N_col, # nolint .var, + ..., required = NULL, count_by = NULL, unique_count_suffix = TRUE) { @@ -131,11 +137,61 @@ s_num_patients_content <- function(df, ) } -c_num_patients <- make_afun( - s_num_patients_content, - .stats = c("unique", "nonunique", "unique_count"), - .formats = c(unique = format_count_fraction_fixed_dp, nonunique = "xx", unique_count = "xx") -) +#' @describeIn summarize_num_patients Formatted analysis function which is used as `afun` +#' in `analyze_num_patients()` and as `cfun` in `summarize_num_patients()`. +#' +#' @return +#' * `a_num_patients()` returns the corresponding list with formatted [rtables::CellValue()]. +#' +#' @keywords internal +a_num_patients <- function(df, + labelstr = "", + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = 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 + + # Apply statistics function + x_stats <- .apply_stat_functions( + default_stat_fnc = s_num_patients_content, + custom_stat_fnc_list = NULL, + args_list = c( + df = list(df), + labelstr = list(labelstr), + extra_afun_params, + dots_extra_args + ) + ) + + # Fill in formatting defaults + .stats <- get_stats("summarize_num_patients", stats_in = .stats) + .formats <- get_formats_from_stats(.stats, .formats) + .labels <- get_labels_from_stats( + .stats, .labels, + tern_defaults = c(lapply(x_stats, attr, "label")[nchar(lapply(x_stats, attr, "label")) > 0], tern_default_labels) + ) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods) + + x_stats <- x_stats[.stats] + + # Auto format handling + .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var) + + in_rows( + .list = x_stats, + .formats = .formats, + .names = .labels %>% .unlist_keep_nulls(), + .stat_names = .stat_names, + .labels = .labels %>% .unlist_keep_nulls(), + .indent_mods = .indent_mods %>% .unlist_keep_nulls() + ) +} #' @describeIn summarize_num_patients Layout-creating function which can take statistics function arguments #' and additional format arguments. This function is a wrapper for [rtables::summarize_row_groups()]. @@ -163,47 +219,44 @@ summarize_num_patients <- function(lyt, count_by = NULL, unique_count_suffix = TRUE, na_str = default_na_str(), - .stats = NULL, + riskdiff = FALSE, + ..., + .stats = c("unique", "nonunique", "unique_count"), + .stat_names = NULL, .formats = NULL, - .labels = c( + .labels = list( unique = "Number of patients with at least one event", nonunique = "Number of events" ), - .indent_mods = 0L, - riskdiff = FALSE, - ...) { + .indent_mods = NULL) { checkmate::assert_flag(riskdiff) + afun <- if (isFALSE(riskdiff)) a_num_patients else afun_riskdiff - if (is.null(.stats)) .stats <- c("unique", "nonunique", "unique_count") - if (length(.labels) > length(.stats)) .labels <- .labels[names(.labels) %in% .stats] + # 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 - s_args <- list(required = required, count_by = count_by, unique_count_suffix = unique_count_suffix, ...) - - cfun <- make_afun( - c_num_patients, - .stats = .stats, - .formats = .formats, - .labels = .labels + # Process additional arguments to the statistic function + extra_args <- c( + extra_args, + required = required, count_by = count_by, unique_count_suffix = unique_count_suffix, + if (!isFALSE(riskdiff)) list(afun = list("s_num_patients_content" = a_num_patients)), + ... ) - extra_args <- if (isFALSE(riskdiff)) { - s_args - } else { - list( - afun = list("s_num_patients_content" = cfun), - .stats = .stats, - .indent_mods = .indent_mods, - 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), cfun, afun_riskdiff), + cfun = afun, na_str = na_str, - extra_args = extra_args, - indent_mod = .indent_mods + extra_args = extra_args ) } @@ -250,49 +303,46 @@ analyze_num_patients <- function(lyt, unique_count_suffix = TRUE, na_str = default_na_str(), nested = TRUE, - .stats = NULL, + show_labels = c("default", "visible", "hidden"), + riskdiff = FALSE, + ..., + .stats = c("unique", "nonunique", "unique_count"), + .stat_names = NULL, .formats = NULL, - .labels = c( + .labels = list( unique = "Number of patients with at least one event", nonunique = "Number of events" ), - show_labels = c("default", "visible", "hidden"), - .indent_mods = 0L, - riskdiff = FALSE, - ...) { + .indent_mods = NULL) { checkmate::assert_flag(riskdiff) + afun <- if (isFALSE(riskdiff)) a_num_patients else afun_riskdiff - if (is.null(.stats)) .stats <- c("unique", "nonunique", "unique_count") - if (length(.labels) > length(.stats)) .labels <- .labels[names(.labels) %in% .stats] + # 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 - s_args <- list(required = required, count_by = count_by, unique_count_suffix = unique_count_suffix, ...) - - afun <- make_afun( - c_num_patients, - .stats = .stats, - .formats = .formats, - .labels = .labels + # Process additional arguments to the statistic function + extra_args <- c( + extra_args, + required = required, count_by = count_by, unique_count_suffix = unique_count_suffix, + if (!isFALSE(riskdiff)) list(afun = list("s_num_patients_content" = a_num_patients)), + ... ) - extra_args <- if (isFALSE(riskdiff)) { - s_args - } else { - list( - afun = list("s_num_patients_content" = afun), - .stats = .stats, - .indent_mods = .indent_mods, - 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( - afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), lyt = lyt, vars = vars, + afun = afun, na_str = na_str, nested = nested, extra_args = extra_args, - show_labels = show_labels, - indent_mod = .indent_mods + show_labels = show_labels ) } diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index b7ef42b4f0..db9ef5a97c 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -121,6 +121,7 @@ a_count_patients_sum_exposure <- function(df, custom_stat_fnc_list = NULL, args_list = c( df = list(subset(df, get(var) == lvl)), + labelstr = list(labelstr), extra_afun_params, dots_extra_args ) @@ -135,6 +136,7 @@ a_count_patients_sum_exposure <- function(df, custom_stat_fnc_list = NULL, args_list = c( df = list(df), + labelstr = list(labelstr), extra_afun_params, dots_extra_args ) diff --git a/tests/testthat/_snaps/summarize_num_patients.md b/tests/testthat/_snaps/summarize_num_patients.md index fb4b2d2276..2a3cc0c5a8 100644 --- a/tests/testthat/_snaps/summarize_num_patients.md +++ b/tests/testthat/_snaps/summarize_num_patients.md @@ -384,10 +384,10 @@ Code res Output - A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) - (N=202) (N=177) (N=162) (N=379) - ————————————————————————————————————————————————————————————————————————————————— - Any SAE 59 (29.2%) 57 (32.2%) 48 (29.6%) -3.0 (-12.3 - 6.3) - 202 177 162 -3.0 (-12.3 - 6.3) - (n) 59 57 48 -3.0 (-12.3 - 6.3) + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + —————————————————————————————————————————————————————————————————————————————————————————— + Any SAE 59 (29.2%) 57 (32.2%) 48 (29.6%) -3.0 (-12.3 - 6.3) + Number of events 202 177 162 -3.0 (-12.3 - 6.3) + (n) 59 57 48 -3.0 (-12.3 - 6.3) diff --git a/tests/testthat/test-summarize_num_patients.R b/tests/testthat/test-summarize_num_patients.R index 3af6119549..f0360224ba 100644 --- a/tests/testthat/test-summarize_num_patients.R +++ b/tests/testthat/test-summarize_num_patients.R @@ -294,7 +294,8 @@ testthat::test_that("analyze_num_patients works as expected with risk difference vars = "USUBJID", .stats = "unique", .labels = c(unique = "Any SAE"), - riskdiff = TRUE + riskdiff = TRUE, + denom = "N_col" ) %>% build_table(tern_ex_adae) @@ -307,7 +308,8 @@ testthat::test_that("analyze_num_patients works as expected with risk difference analyze_num_patients( vars = "USUBJID", .labels = c(unique = "Any SAE"), - riskdiff = TRUE + riskdiff = TRUE, + denom = "N_col" ) %>% build_table(tern_ex_adae) From b1a6e846ee71f6b358112279ed56d0614ae4df8d Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 21 Feb 2025 00:05:23 -0500 Subject: [PATCH 11/41] Fix labels --- R/summarize_patients_exposure_in_cols.R | 28 +++++++++++++++++-------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index db9ef5a97c..a77d46345d 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -45,6 +45,7 @@ s_count_patients_sum_exposure <- function(df, ..., ex_var = "AVAL", id = "USUBJID", + var_level = NULL, custom_label = NULL) { assert_df_with_variables(df, list(ex_var = ex_var, id = id)) checkmate::assert_string(id) @@ -55,6 +56,8 @@ s_count_patients_sum_exposure <- function(df, row_label <- if (labelstr != "") { labelstr + } else if (!is.null(var_level)) { + var_level } else if (!is.null(custom_label)) { custom_label } else { @@ -122,6 +125,7 @@ a_count_patients_sum_exposure <- function(df, args_list = c( df = list(subset(df, get(var) == lvl)), labelstr = list(labelstr), + var_level = lvl, extra_afun_params, dots_extra_args ) @@ -130,7 +134,7 @@ a_count_patients_sum_exposure <- function(df, } } - if (add_total_level) { + if (add_total_level || is.null(var)) { x_stats_total <- .apply_stat_functions( default_stat_fnc = s_count_patients_sum_exposure, custom_stat_fnc_list = NULL, @@ -149,13 +153,15 @@ a_count_patients_sum_exposure <- function(df, 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) + .labels <- get_labels_from_stats( + .stats, .labels, levels_per_stats, + tern_defaults = c(lapply(x_stats[[1]], attr, "label"), tern_default_labels) + ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var) - # browser() in_rows( .list = x_stats %>% .unlist_keep_nulls(), .formats = .formats, @@ -202,13 +208,15 @@ summarize_patients_exposure_in_cols <- function(lyt, ..., .stats = c("n_patients", "sum_exposure"), .stat_names = NULL, - .formats = list(n_patients = "xx (xx.x%)", sum_exposure = "xx"), - .labels = list(n_patients = "Patients", sum_exposure = "Person time"), + .formats = NULL, + .labels = c(n_patients = "Patients", sum_exposure = "Person time"), .indent_mods = NULL) { # Process standard extra arguments extra_args <- list() if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names if (!is.null(.formats)) extra_args[[".formats"]] <- .formats + col_labels <- unlist(.labels[.stats]) + .labels <- .labels[!names(.labels) %in% c("n_patients", "sum_exposure")] if (!is.null(.labels)) extra_args[[".labels"]] <- .labels if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods @@ -229,7 +237,7 @@ summarize_patients_exposure_in_cols <- function(lyt, lyt <- split_cols_by_multivar( lyt = lyt, vars = rep(var, length(.stats)), - varlabels = unlist(.labels[.stats]), + varlabels = col_labels, extra_args = list(.stats = .stats) ) } @@ -324,14 +332,16 @@ analyze_patients_exposure_in_cols <- function(lyt, na_str = default_na_str(), .stats = c("n_patients", "sum_exposure"), .stat_names = NULL, - .formats = list(n_patients = "xx (xx.x%)", sum_exposure = "xx"), - .labels = list(n_patients = "Patients", sum_exposure = "Person time"), + .formats = NULL, + .labels = c(n_patients = "Patients", sum_exposure = "Person time"), .indent_mods = NULL, ...) { # Process standard extra arguments extra_args <- list() if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names if (!is.null(.formats)) extra_args[[".formats"]] <- .formats + col_labels <- unlist(.labels[.stats]) + .labels <- .labels[!names(.labels) %in% c("n_patients", "sum_exposure")] if (!is.null(.labels)) extra_args[[".labels"]] <- .labels if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods @@ -352,7 +362,7 @@ analyze_patients_exposure_in_cols <- function(lyt, lyt <- split_cols_by_multivar( lyt = lyt, vars = rep(ex_var, length(.stats)), - varlabels = unlist(.labels[.stats]), + varlabels = col_labels, extra_args = list(.stats = .stats) ) } From f7549e7619a8c52046c292650b831dfa21c5fdc7 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 15:14:16 -0500 Subject: [PATCH 12/41] Order --- R/summarize_patients_exposure_in_cols.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index a77d46345d..e7854ee1d8 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -45,8 +45,8 @@ s_count_patients_sum_exposure <- function(df, ..., ex_var = "AVAL", id = "USUBJID", - var_level = NULL, - custom_label = NULL) { + custom_label = NULL, + var_level = NULL) { assert_df_with_variables(df, list(ex_var = ex_var, id = id)) checkmate::assert_string(id) checkmate::assert_string(labelstr) From 7a876ac32160fdfb5287359c64e398793c680c01 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 16:04:17 -0500 Subject: [PATCH 13/41] Re-add missing custom stat fun options --- R/abnormal.R | 9 +++++++-- R/abnormal_by_baseline.R | 9 +++++++-- R/abnormal_by_marked.R | 9 +++++++-- R/abnormal_by_worst_grade.R | 9 +++++++-- R/abnormal_lab_worsen_by_baseline.R | 13 +++++++++++-- R/count_occurrences.R | 9 +++++++-- R/count_occurrences_by_grade.R | 9 +++++++-- R/count_patients_with_event.R | 9 +++++++-- R/count_patients_with_flags.R | 9 +++++++-- R/count_values.R | 9 +++++++-- R/incidence_rate.R | 9 +++++++-- R/summarize_num_patients.R | 9 +++++++-- R/summarize_patients_exposure_in_cols.R | 15 ++++++++++++--- 13 files changed, 100 insertions(+), 27 deletions(-) diff --git a/R/abnormal.R b/R/abnormal.R index dab670140a..f09275681e 100644 --- a/R/abnormal.R +++ b/R/abnormal.R @@ -109,10 +109,15 @@ a_count_abnormal <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -121,7 +126,7 @@ a_count_abnormal <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal", stats_in = .stats) + .stats <- get_stats("abnormal", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) 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) diff --git a/R/abnormal_by_baseline.R b/R/abnormal_by_baseline.R index 0262cf6465..de9802a62d 100644 --- a/R/abnormal_by_baseline.R +++ b/R/abnormal_by_baseline.R @@ -136,10 +136,15 @@ a_count_abnormal_by_baseline <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal_by_baseline, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -148,7 +153,7 @@ a_count_abnormal_by_baseline <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal_by_baseline", stats_in = .stats) + .stats <- get_stats("abnormal_by_baseline", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) levels_per_stats <- lapply(x_stats, names) .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) .labels <- get_labels_from_stats( diff --git a/R/abnormal_by_marked.R b/R/abnormal_by_marked.R index faf959120d..717f0c2b72 100644 --- a/R/abnormal_by_marked.R +++ b/R/abnormal_by_marked.R @@ -120,10 +120,15 @@ a_count_abnormal_by_marked <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal_by_marked, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -132,7 +137,7 @@ a_count_abnormal_by_marked <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal_by_marked", stats_in = .stats) + .stats <- get_stats("abnormal_by_marked", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) 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) diff --git a/R/abnormal_by_worst_grade.R b/R/abnormal_by_worst_grade.R index 6470f3655b..a07407e879 100644 --- a/R/abnormal_by_worst_grade.R +++ b/R/abnormal_by_worst_grade.R @@ -107,10 +107,15 @@ a_count_abnormal_by_worst_grade <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal_by_worst_grade, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -119,7 +124,7 @@ a_count_abnormal_by_worst_grade <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal_by_worst_grade", stats_in = .stats) + .stats <- get_stats("abnormal_by_worst_grade", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) 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) diff --git a/R/abnormal_lab_worsen_by_baseline.R b/R/abnormal_lab_worsen_by_baseline.R index 45567526e9..a44e0188be 100644 --- a/R/abnormal_lab_worsen_by_baseline.R +++ b/R/abnormal_lab_worsen_by_baseline.R @@ -88,10 +88,15 @@ a_count_abnormal_lab_worsen_by_baseline <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal_lab_worsen_by_baseline, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -100,7 +105,11 @@ a_count_abnormal_lab_worsen_by_baseline <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal_lab_worsen_by_baseline", stats_in = .stats) + .stats <- get_stats( + "abnormal_lab_worsen_by_baseline", + stats_in = .stats, + custom_stats_in = names(custom_stat_functions) + ) 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) diff --git a/R/count_occurrences.R b/R/count_occurrences.R index c0fa06f2ce..99b1305626 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -165,10 +165,15 @@ a_count_occurrences <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_occurrences, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -177,7 +182,7 @@ a_count_occurrences <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("count_occurrences", stats_in = .stats) + .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) diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index b1fb0ca77c..f748340937 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -260,10 +260,15 @@ a_count_occurrences_by_grade <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_occurrences_by_grade, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), labelstr = list(labelstr), @@ -273,7 +278,7 @@ a_count_occurrences_by_grade <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("count_occurrences_by_grade", stats_in = .stats) + .stats <- get_stats("count_occurrences_by_grade", 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) diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index f76a23a20c..439b63f5d8 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -116,10 +116,15 @@ a_count_patients_with_event <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_patients_with_event, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -128,7 +133,7 @@ a_count_patients_with_event <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("count_patients_with_event", stats_in = .stats) + .stats <- get_stats("count_patients_with_event", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 2f638c4bbb..7fa1461eb6 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -130,10 +130,15 @@ a_count_patients_with_flags <- function(df, if (is.null(names(flag_variables))) flag_variables <- formatters::var_labels(df, fill = TRUE)[flag_variables] if (is.null(flag_labels)) flag_labels <- flag_variables + # 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_patients_with_flags, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -142,7 +147,7 @@ a_count_patients_with_flags <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("count_patients_with_flags", stats_in = .stats) + .stats <- get_stats("count_patients_with_flags", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) levels_per_stats <- rep(list(names(flag_variables)), length(.stats)) %>% setNames(.stats) .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) .labels <- get_labels_from_stats( diff --git a/R/count_values.R b/R/count_values.R index ce37a2f45a..de84aed3c0 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -119,10 +119,15 @@ a_count_values <- function(x, 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 + # Main statistic calculations x_stats <- .apply_stat_functions( default_stat_fnc = s_count_values, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( x = list(x), extra_afun_params, @@ -131,7 +136,7 @@ a_count_values <- function(x, ) # Fill in formatting defaults - .stats <- get_stats("analyze_vars_counts", stats_in = .stats) + .stats <- get_stats("analyze_vars_counts", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) diff --git a/R/incidence_rate.R b/R/incidence_rate.R index 30d756d03f..0a4317017c 100644 --- a/R/incidence_rate.R +++ b/R/incidence_rate.R @@ -140,10 +140,15 @@ a_incidence_rate <- function(df, 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 + # Main statistic calculations x_stats <- .apply_stat_functions( default_stat_fnc = s_incidence_rate, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, @@ -152,7 +157,7 @@ a_incidence_rate <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("estimate_incidence_rate", stats_in = .stats) + .stats <- get_stats("estimate_incidence_rate", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) x_stats <- x_stats[.stats] .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels, tern_defaults = lapply(x_stats, attr, "label")) diff --git a/R/summarize_num_patients.R b/R/summarize_num_patients.R index 4c179deeea..1e30271960 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -157,10 +157,15 @@ a_num_patients <- function(df, 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 + # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_num_patients_content, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), labelstr = list(labelstr), @@ -170,7 +175,7 @@ a_num_patients <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("summarize_num_patients", stats_in = .stats) + .stats <- get_stats("summarize_num_patients", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats( .stats, .labels, diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index e7854ee1d8..bc10904e79 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -116,12 +116,17 @@ a_count_patients_sum_exposure <- function(df, df[[var]] <- as.factor(df[[var]]) } + # 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 + x_stats <- list() if (!is.null(var)) { for (lvl in levels(df[[var]])) { x_stats_i <- .apply_stat_functions( default_stat_fnc = s_count_patients_sum_exposure, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(subset(df, get(var) == lvl)), labelstr = list(labelstr), @@ -137,7 +142,7 @@ a_count_patients_sum_exposure <- function(df, if (add_total_level || is.null(var)) { x_stats_total <- .apply_stat_functions( default_stat_fnc = s_count_patients_sum_exposure, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), labelstr = list(labelstr), @@ -149,7 +154,11 @@ a_count_patients_sum_exposure <- function(df, } # Fill in formatting defaults - .stats <- get_stats("analyze_patients_exposure_in_cols", stats_in = .stats) + .stats <- get_stats( + "analyze_patients_exposure_in_cols", + 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) From 9b2ad21b5e4b25a9acee717855cb794ba5cfa5a3 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 16:22:22 -0500 Subject: [PATCH 14/41] Organize default lists (alphabetically) --- R/utils_default_stats_formats_labels.R | 125 +++++++++++++------------ 1 file changed, 63 insertions(+), 62 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 2ce501e6d0..e3b5d3d37c 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -555,62 +555,63 @@ tern_default_stats <- list( #' #' @export tern_default_formats <- c( - fraction = format_fraction_fixed_dp, - unique = format_count_fraction_fixed_dp, - nonunique = "xx", - unique_count = "xx", - n = "xx.", count = "xx.", count_fraction = format_count_fraction, count_fraction_fixed_dp = format_count_fraction_fixed_dp, - n_blq = "xx.", - sum = "xx.x", + cv = "xx.x", + fraction = format_fraction_fixed_dp, + geom_cv = "xx.x", + geom_mean = "xx.x", + geom_mean_ci = "(xx.xx, xx.xx)", + geom_mean_ci_3d = "xx.xx (xx.xx - xx.xx)", + geom_mean_sd = "xx.x (xx.x)", + geom_sd = "xx.x", + iqr = "xx.x", + lsmean = "xx.xx", + lsmean_diff = "xx.xx", + lsmean_diff_ci = "(xx.xx, xx.xx)", + mad = "xx.x", + max = "xx.x", mean = "xx.x", - sd = "xx.x", - se = "xx.x", + mean_ci = "(xx.xx, xx.xx)", + mean_ci_3d = "xx.xx (xx.xx - xx.xx)", + mean_pval = "x.xxxx | (<0.0001)", mean_sd = "xx.x (xx.x)", + mean_sdi = "(xx.xx, xx.xx)", mean_se = "xx.x (xx.x)", - mean_ci = "(xx.xx, xx.xx)", mean_sei = "(xx.xx, xx.xx)", - mean_sdi = "(xx.xx, xx.xx)", - mean_pval = "x.xxxx | (<0.0001)", - mean_ci_3d = "xx.xx (xx.xx - xx.xx)", median = "xx.x", - mad = "xx.x", median_ci = "(xx.xx, xx.xx)", median_ci_3d = "xx.xx (xx.xx - xx.xx)", + median_range = "xx.x (xx.x - xx.x)", + min = "xx.x", + n = "xx.", + n_blq = "xx.", + n_events = "xx", + n_rate = "xx (xx.x)", + n_rsp = "xx", + n_unique = "xx", + n_patients = "xx (xx.x%)", + nonunique = "xx", + person_years = "xx.x", + pval = "x.xxxx | (<0.0001)", + pval_counts = "x.xxxx | (<0.0001)", quantiles = "xx.x - xx.x", quantiles_lower = "xx.xx (xx.xx - xx.xx)", quantiles_upper = "xx.xx (xx.xx - xx.xx)", - iqr = "xx.x", range = "xx.x - xx.x", - min = "xx.x", - max = "xx.x", - median_range = "xx.x (xx.x - xx.x)", - cv = "xx.x", - geom_mean = "xx.x", - geom_sd = "xx.x", - geom_mean_sd = "xx.x (xx.x)", - geom_mean_ci = "(xx.xx, xx.xx)", - geom_mean_ci_3d = "xx.xx (xx.xx - xx.xx)", - geom_cv = "xx.x", - pval = "x.xxxx | (<0.0001)", - pval_counts = "x.xxxx | (<0.0001)", range_censor = "xx.x to xx.x", range_event = "xx.x to xx.x", rate = "xx.xxxx", rate_ci = "(xx.xxxx, xx.xxxx)", rate_ratio = "xx.xxxx", rate_ratio_ci = "(xx.xxxx, xx.xxxx)", - lsmean = "xx.xx", - lsmean_diff = "xx.xx", - lsmean_diff_ci = "(xx.xx, xx.xx)" - person_years = "xx.x", - n_events = "xx", - n_unique = "xx", - n_rate = "xx (xx.x)", - n_patients = "xx (xx.x%)", - sum_exposure = "xx" + sd = "xx.x", + se = "xx.x", + sum = "xx.x", + sum_exposure = "xx", + unique = format_count_fraction_fixed_dp, + unique_count = "xx" ) # tern_default_labels ---------------------------------------------------------- @@ -622,44 +623,44 @@ tern_default_formats <- c( #' #' @export tern_default_labels <- c( - unique = "Number of patients with at least one event", - nonunique = "Number of events", - n = "n", - n_blq = "n_blq", - sum = "Sum", + cv = "CV (%)", + iqr = "IQR", + geom_cv = "CV % Geometric Mean", + geom_mean = "Geometric Mean", + geom_mean_sd = "Geometric Mean (SD)", + geom_mean_ci = "Geometric Mean 95% CI", + geom_mean_ci_3d = "Geometric Mean (95% CI)", + geom_sd = "Geometric SD", + mad = "Median Absolute Deviation", + max = "Maximum", mean = "Mean", - sd = "SD", - se = "SE", + mean_ci = "Mean 95% CI", + mean_ci_3d = "Mean (95% CI)", + mean_pval = "Mean p-value (H0: mean = 0)", mean_sd = "Mean (SD)", + mean_sdi = "Mean -/+ 1xSD", mean_se = "Mean (SE)", - mean_ci = "Mean 95% CI", mean_sei = "Mean -/+ 1xSE", - mean_sdi = "Mean -/+ 1xSD", - mean_pval = "Mean p-value (H0: mean = 0)", - mean_ci_3d = "Mean (95% CI)", median = "Median", - mad = "Median Absolute Deviation", median_ci = "Median 95% CI", median_ci_3d = "Median (95% CI)", + median_range = "Median (Min - Max)", + min = "Minimum", + n = "n", + n_blq = "n_blq", + nonunique = "Number of events", + pval = "p-value (t-test)", # Default for numeric + pval_counts = "p-value (chi-squared test)", # Default for counts quantiles = "25% and 75%-ile", quantiles_lower = "25%-ile (95% CI)", quantiles_upper = "75%-ile (95% CI)", - iqr = "IQR", range = "Min - Max", - min = "Minimum", - max = "Maximum", - median_range = "Median (Min - Max)", - cv = "CV (%)", - geom_mean = "Geometric Mean", - geom_sd = "Geometric SD", - geom_mean_sd = "Geometric Mean (SD)", - geom_mean_ci = "Geometric Mean 95% CI", - geom_mean_ci_3d = "Geometric Mean (95% CI)", - geom_cv = "CV % Geometric Mean", - pval = "p-value (t-test)", # Default for numeric - pval_counts = "p-value (chi-squared test)", # Default for counts rate = "Adjusted Rate", - rate_ratio = "Adjusted Rate Ratio" + rate_ratio = "Adjusted Rate Ratio", + sd = "SD", + se = "SE", + sum = "Sum", + unique = "Number of patients with at least one event" ) #' @describeIn default_stats_formats_labels Quick function to retrieve default formats for summary statistics: From edab9741bd2bf10d5ce71106478b456ca5046253 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 16:52:50 -0500 Subject: [PATCH 15/41] Fix auto formatting --- R/count_occurrences.R | 2 +- R/count_occurrences_by_grade.R | 2 +- R/count_patients_with_event.R | 2 +- R/summarize_num_patients.R | 2 +- R/summarize_patients_exposure_in_cols.R | 2 +- R/survival_time.R | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/count_occurrences.R b/R/count_occurrences.R index 99b1305626..29fa49f078 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -190,7 +190,7 @@ a_count_occurrences <- function(df, .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) # 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) in_rows( .list = x_stats %>% .unlist_keep_nulls(), diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index f748340937..e87acea345 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -286,7 +286,7 @@ a_count_occurrences_by_grade <- function(df, .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) # 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) in_rows( .list = x_stats %>% .unlist_keep_nulls(), diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index 439b63f5d8..48e2e824bb 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -141,7 +141,7 @@ a_count_patients_with_event <- function(df, x_stats <- x_stats[.stats] # 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) in_rows( .list = x_stats, diff --git a/R/summarize_num_patients.R b/R/summarize_num_patients.R index 1e30271960..c113254651 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -186,7 +186,7 @@ a_num_patients <- function(df, x_stats <- x_stats[.stats] # 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) in_rows( .list = x_stats, diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index bc10904e79..ac87b288bb 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -169,7 +169,7 @@ a_count_patients_sum_exposure <- function(df, .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) # 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) in_rows( .list = x_stats %>% .unlist_keep_nulls(), diff --git a/R/survival_time.R b/R/survival_time.R index 147375115a..1c1953f406 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -176,7 +176,7 @@ a_surv_time <- function(df, x_stats <- x_stats[.stats] # 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) cell_fns <- setNames(vector("list", length = length(x_stats)), .labels) if ("range" %in% names(x_stats) && ref_fn_censor) { From 20430900e1edeb810184c9a5037314ffc13dbbd5 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 17:35:06 -0500 Subject: [PATCH 16/41] Update response_subgroups --- R/response_subgroups.R | 113 ++++++++++++-------- R/utils_default_stats_formats_labels.R | 9 +- tests/testthat/_snaps/response_subgroups.md | 11 +- tests/testthat/test-response_subgroups.R | 13 +-- 4 files changed, 91 insertions(+), 55 deletions(-) diff --git a/R/response_subgroups.R b/R/response_subgroups.R index 7185faf393..4c994fe89c 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -129,40 +129,54 @@ extract_rsp_subgroups <- function(variables, #' * `a_response_subgroups()` returns the corresponding list with formatted [rtables::CellValue()]. #' #' @keywords internal -a_response_subgroups <- function(.formats = list( - n = "xx", # nolint start - n_rsp = "xx", - prop = "xx.x%", - n_tot = "xx", - or = list(format_extreme_values(2L)), - ci = list(format_extreme_values_ci(2L)), - pval = "x.xxxx | (<0.0001)", - riskdiff = "xx.x (xx.x - xx.x)" # nolint end - ), - na_str = default_na_str()) { - checkmate::assert_list(.formats) - checkmate::assert_subset( - names(.formats), - c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval", "riskdiff") - ) +a_response_subgroups <- function(df, + labelstr = "", + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = 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 + cur_stat <- extra_afun_params$.var %||% .stats + var_lvls <- as.character(df$subgroup) - afun_lst <- Map( - function(stat, fmt, na_str) { - function(df, labelstr = "", ...) { - in_rows( - .list = as.list(df[[stat]]), - .labels = as.character(df$subgroup), - .formats = fmt, - .format_na_strs = na_str - ) - } - }, - stat = names(.formats), - fmt = .formats, - na_str = na_str + # Main statistics taken from df + x_stats <- as.list(df) + + # Fill in formatting defaults + .stats <- get_stats("tabulate_rsp_subgroups", stats_in = cur_stat) + levels_per_stats <- rep(list(var_lvls), length(.stats)) %>% setNames(.stats) + .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) + .labels <- get_labels_from_stats( + .stats, .labels, levels_per_stats, + tern_defaults = as.list(var_lvls) %>% setNames(var_lvls) ) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) + + x_stats <- lapply( + .stats, + function(x) x_stats[[x]] %>% stats::setNames(var_lvls) + ) %>% + stats::setNames(.stats) - afun_lst + # Auto format handling + .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 %>% .unlist_keep_nulls(), + .formats = .formats, + .names = names(.labels), + .stat_names = .stat_names, + .labels = .labels %>% .unlist_keep_nulls(), + .indent_mods = .indent_mods %>% .unlist_keep_nulls() + ) } #' @describeIn response_subgroups Table-creating function which creates a table @@ -218,11 +232,11 @@ tabulate_rsp_subgroups <- function(lyt, label_all = "All Patients", riskdiff = NULL, na_str = default_na_str(), - .formats = c( - n = "xx", n_rsp = "xx", prop = "xx.x%", n_tot = "xx", - or = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), - pval = "x.xxxx | (<0.0001)" - )) { + ..., + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL) { checkmate::assert_list(riskdiff, null.ok = TRUE) checkmate::assert_true(all(c("n_tot", "or", "ci") %in% vars)) if ("pval" %in% vars && !"pval" %in% names(df$or)) { @@ -234,6 +248,13 @@ tabulate_rsp_subgroups <- function(lyt, ) } + # Process standard extra arguments + extra_args <- list(".stats" = vars) + 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 + # Create "ci" column from "lcl" and "ucl" df$or$ci <- combine_vectors(df$or$lcl, df$or$ucl) @@ -250,10 +271,16 @@ tabulate_rsp_subgroups <- function(lyt, colvars_prop <- list(vars = prop_vars, labels = colvars$labels[prop_vars]) colvars_or <- list(vars = or_vars, labels = colvars$labels[or_vars]) - extra_args <- list(groups_lists = groups_lists, conf_level = conf_level, method = method, label_all = label_all) + # Process additional arguments to the statistic function + extra_args <- c( + extra_args, + groups_lists = list(groups_lists), conf_level = conf_level, method = method, label_all = label_all, + ... + ) - # Get analysis function for each statistic - afun_lst <- a_response_subgroups(.formats = c(.formats, riskdiff = riskdiff$format), na_str = na_str) + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_response_subgroups) <- c(formals(a_response_subgroups), extra_args[[".additional_fun_parameters"]]) # Add risk difference column if (!is.null(riskdiff)) { @@ -308,7 +335,7 @@ tabulate_rsp_subgroups <- function(lyt, ) lyt_prop <- analyze_colvars( lyt = lyt_prop, - afun = afun_lst[names(colvars_prop$labels)], + afun = a_response_subgroups, na_str = na_str, extra_args = extra_args ) @@ -325,7 +352,7 @@ tabulate_rsp_subgroups <- function(lyt, lyt_prop <- split_rows_by(lyt = lyt_prop, var = "var_label", nested = TRUE) lyt_prop <- analyze_colvars( lyt = lyt_prop, - afun = afun_lst[names(colvars_prop$labels)], + afun = a_response_subgroups, na_str = na_str, inclNAs = TRUE, extra_args = extra_args @@ -355,7 +382,7 @@ tabulate_rsp_subgroups <- function(lyt, ) lyt_or <- analyze_colvars( lyt = lyt_or, - afun = afun_lst[names(colvars_or$labels)], + afun = a_response_subgroups, na_str = na_str, extra_args = extra_args ) %>% @@ -373,7 +400,7 @@ tabulate_rsp_subgroups <- function(lyt, lyt_or <- split_rows_by(lyt = lyt_or, var = "var_label", nested = TRUE) lyt_or <- analyze_colvars( lyt = lyt_or, - afun = afun_lst[names(colvars_or$labels)], + afun = a_response_subgroups, na_str = na_str, inclNAs = TRUE, extra_args = extra_args diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index e3b5d3d37c..3ec3f37330 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -540,7 +540,7 @@ tern_default_stats <- list( "event_free_rate_3d" ), tabulate_rsp_biomarkers = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"), - tabulate_rsp_subgroups = c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval"), + tabulate_rsp_subgroups = c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval", "riskdiff"), tabulate_survival_biomarkers = c("n_tot", "n_tot_events", "median", "hr", "ci", "pval"), tabulate_survival_subgroups = c("n_tot_events", "n_events", "n_tot", "n", "median", "hr", "ci", "pval"), test_proportion_diff = c("pval") @@ -555,6 +555,7 @@ tern_default_stats <- list( #' #' @export tern_default_formats <- c( + ci = list(format_extreme_values_ci(2L)), count = "xx.", count_fraction = format_count_fraction, count_fraction_fixed_dp = format_count_fraction_fixed_dp, @@ -588,12 +589,15 @@ tern_default_formats <- c( n = "xx.", n_blq = "xx.", n_events = "xx", + n_patients = "xx (xx.x%)", n_rate = "xx (xx.x)", n_rsp = "xx", + n_tot = "xx", n_unique = "xx", - n_patients = "xx (xx.x%)", nonunique = "xx", + or = list(format_extreme_values(2L)), person_years = "xx.x", + prop = "xx.x%", pval = "x.xxxx | (<0.0001)", pval_counts = "x.xxxx | (<0.0001)", quantiles = "xx.x - xx.x", @@ -606,6 +610,7 @@ tern_default_formats <- c( rate_ci = "(xx.xxxx, xx.xxxx)", rate_ratio = "xx.xxxx", rate_ratio_ci = "(xx.xxxx, xx.xxxx)", + riskdiff = "xx.x (xx.x - xx.x)", sd = "xx.x", se = "xx.x", sum = "xx.x", diff --git a/tests/testthat/_snaps/response_subgroups.md b/tests/testthat/_snaps/response_subgroups.md index 5b019e9718..a4cd49993a 100644 --- a/tests/testthat/_snaps/response_subgroups.md +++ b/tests/testthat/_snaps/response_subgroups.md @@ -129,10 +129,13 @@ Code res Output - prop pval - —————————————————— - M 0.12 <0.0001 - F 0.57 0.9838 + RowsVerticalSection (in_rows) object print method: + ---------------------------- + row_name formatted_cell indent_mod row_label + 1 prop.M 0.12 2 M - proportion + 2 prop.F 0.57 3 Female + 3 pval.M <0.0001 2 Male + 4 pval.F 0.9838 3 Female # tabulate_rsp_subgroups functions as expected with valid input diff --git a/tests/testthat/test-response_subgroups.R b/tests/testthat/test-response_subgroups.R index 268d966e54..d8860a6dea 100644 --- a/tests/testthat/test-response_subgroups.R +++ b/tests/testthat/test-response_subgroups.R @@ -93,12 +93,13 @@ testthat::test_that("a_response_subgroups functions as expected with valid input stringsAsFactors = FALSE ) - afun <- a_response_subgroups(.formats = list(prop = "xx.xx", pval = "x.xxxx | (<0.0001)")) - - result <- basic_table() %>% - split_cols_by_multivar(c("prop", "pval")) %>% - analyze_colvars(afun) %>% - build_table(df) + result <- a_response_subgroups( + df, + .stats = c("prop", "pval"), + .formats = list(prop = "xx.xx", pval = "x.xxxx | (<0.0001)"), + .labels = list(prop.M = "M - proportion", "M" = "Male", "F" = "Female"), + .indent_mods = c("M" = 2L, "F" = 3L) + ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) From 8ac94bd824db8489d75c5f41a78c00c14de06707 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 17:36:04 -0500 Subject: [PATCH 17/41] Prefix --- R/count_patients_with_flags.R | 6 +++--- R/survival_time.R | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 7fa1461eb6..06d8cf1145 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -148,11 +148,11 @@ a_count_patients_with_flags <- function(df, # Fill in formatting defaults .stats <- get_stats("count_patients_with_flags", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) - levels_per_stats <- rep(list(names(flag_variables)), length(.stats)) %>% setNames(.stats) + levels_per_stats <- rep(list(names(flag_variables)), length(.stats)) %>% stats::setNames(.stats) .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) .labels <- get_labels_from_stats( .stats, .labels, levels_per_stats, - tern_defaults = flag_labels %>% setNames(names(flag_variables)) + tern_defaults = flag_labels %>% stats::setNames(names(flag_variables)) ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) @@ -167,7 +167,7 @@ a_count_patients_with_flags <- function(df, # Unlist stats x_stats <- x_stats %>% .unlist_keep_nulls() %>% - setNames(names(.formats)) + stats::setNames(names(.formats)) in_rows( .list = x_stats, diff --git a/R/survival_time.R b/R/survival_time.R index 1c1953f406..a80f17d1af 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -178,7 +178,7 @@ a_surv_time <- function(df, # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) - cell_fns <- setNames(vector("list", length = length(x_stats)), .labels) + cell_fns <- stats::setNames(vector("list", length = length(x_stats)), .labels) if ("range" %in% names(x_stats) && ref_fn_censor) { if (identical(x_stats[["range"]][1], rng_censor_lwr) && identical(x_stats[["range"]][2], rng_censor_upr)) { cell_fns[[.labels[["range"]]]] <- "Censored observations: range minimum & maximum" From 3eb1190c8c50632b5f931a952b75f2b7b1450f6d Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 17:46:10 -0500 Subject: [PATCH 18/41] Deprecate last instance of label_all --- NEWS.md | 1 + R/response_subgroups.R | 12 ++++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4897dbf4c2..f00a2bdef2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -13,6 +13,7 @@ * Removed internal function `ungroup_stats()` and replaced its usage with the `get_*_from_stats()` functions. * Began deprecation of the unused `table_names` argument to `count_abnormal_lab_worsen_by_baseline()`. * Added warnings for `geom_mean` statistical output. +* Began deprecation of the unused `label_all` parameter to `tabulate_rsp_subgroups()`, with redirection to the same parameter in `extract_rsp_subgroups()`. # tern 0.9.7 diff --git a/R/response_subgroups.R b/R/response_subgroups.R index 4c994fe89c..5c7b5b50de 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -229,7 +229,7 @@ tabulate_rsp_subgroups <- function(lyt, df, vars = c("n_tot", "n", "prop", "or", "ci"), groups_lists = list(), - label_all = "All Patients", + label_all = lifecycle::deprecated(), riskdiff = NULL, na_str = default_na_str(), ..., @@ -248,6 +248,14 @@ tabulate_rsp_subgroups <- function(lyt, ) } + if (lifecycle::is_present(label_all)) { + lifecycle::deprecate_warn( + "0.9.8", "tabulate_rsp_subgroups(label_all)", + details = + "Please assign the `label_all` parameter within the `extract_rsp_subgroups()` function when creating `df`." + ) + } + # Process standard extra arguments extra_args <- list(".stats" = vars) if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names @@ -274,7 +282,7 @@ tabulate_rsp_subgroups <- function(lyt, # Process additional arguments to the statistic function extra_args <- c( extra_args, - groups_lists = list(groups_lists), conf_level = conf_level, method = method, label_all = label_all, + groups_lists = list(groups_lists), conf_level = conf_level, method = method, ... ) From f7af7091a378789ec8f1c59e7730bf7f0d2f5489 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 18:24:07 -0500 Subject: [PATCH 19/41] Update survival_duration_subgroups --- R/response_subgroups.R | 4 - R/survival_duration_subgroups.R | 167 +++++++++++------- R/utils_default_stats_formats_labels.R | 4 +- .../_snaps/survival_duration_subgroups.md | 11 +- .../test-survival_duration_subgroups.R | 13 +- 5 files changed, 117 insertions(+), 82 deletions(-) diff --git a/R/response_subgroups.R b/R/response_subgroups.R index 5c7b5b50de..fe67eb2071 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -266,10 +266,6 @@ tabulate_rsp_subgroups <- function(lyt, # Create "ci" column from "lcl" and "ucl" df$or$ci <- combine_vectors(df$or$lcl, df$or$ucl) - # Fill in missing formats with defaults - default_fmts <- eval(formals(tabulate_rsp_subgroups)$.formats) - .formats <- c(.formats, default_fmts[vars[!vars %in% names(.formats)]]) - # Extract additional parameters from df conf_level <- df$or$conf_level[1] method <- if ("pval_label" %in% names(df$or)) df$or$pval_label[1] else NULL diff --git a/R/survival_duration_subgroups.R b/R/survival_duration_subgroups.R index ba6a99e9a7..76c520360d 100644 --- a/R/survival_duration_subgroups.R +++ b/R/survival_duration_subgroups.R @@ -153,40 +153,54 @@ extract_survival_subgroups <- function(variables, #' * `a_survival_subgroups()` returns the corresponding list with formatted [rtables::CellValue()]. #' #' @keywords internal -a_survival_subgroups <- function(.formats = list( # nolint start - n = "xx", - n_events = "xx", - n_tot_events = "xx", - median = "xx.x", - n_tot = "xx", - hr = list(format_extreme_values(2L)), - ci = list(format_extreme_values_ci(2L)), - pval = "x.xxxx | (<0.0001)" - ), - na_str = default_na_str()) { # nolint end - checkmate::assert_list(.formats) - checkmate::assert_subset( - names(.formats), - c("n", "n_events", "median", "n_tot", "n_tot_events", "hr", "ci", "pval", "riskdiff") - ) +a_survival_subgroups <- function(df, + labelstr = "", + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = 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 + cur_stat <- extra_afun_params$.var %||% .stats + var_lvls <- as.character(df$subgroup) - afun_lst <- Map( - function(stat, fmt, na_str) { - function(df, labelstr = "", ...) { - in_rows( - .list = as.list(df[[stat]]), - .labels = as.character(df$subgroup), - .formats = fmt, - .format_na_strs = na_str - ) - } - }, - stat = names(.formats), - fmt = .formats, - na_str = na_str + # Main statistics taken from df + x_stats <- as.list(df) + + # Fill in formatting defaults + .stats <- get_stats("tabulate_survival_subgroups", stats_in = cur_stat) + levels_per_stats <- rep(list(var_lvls), length(.stats)) %>% setNames(.stats) + .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) + .labels <- get_labels_from_stats( + .stats, .labels, levels_per_stats, + tern_defaults = as.list(var_lvls) %>% setNames(var_lvls) ) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) + + x_stats <- lapply( + .stats, + function(x) x_stats[[x]] %>% stats::setNames(var_lvls) + ) %>% + stats::setNames(.stats) - afun_lst + # Auto format handling + .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 %>% .unlist_keep_nulls(), + .formats = .formats, + .names = names(.labels), + .stat_names = .stat_names, + .labels = .labels %>% .unlist_keep_nulls(), + .indent_mods = .indent_mods %>% .unlist_keep_nulls() + ) } #' @describeIn survival_duration_subgroups Table-creating function which creates a table @@ -225,14 +239,22 @@ tabulate_survival_subgroups <- function(lyt, time_unit = NULL, riskdiff = NULL, na_str = default_na_str(), - .formats = c( - n = "xx", n_events = "xx", n_tot_events = "xx", median = "xx.x", n_tot = "xx", - hr = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), - pval = "x.xxxx | (<0.0001)" - )) { + ..., + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL) { checkmate::assert_list(riskdiff, null.ok = TRUE) checkmate::assert_true(any(c("n_tot", "n_tot_events") %in% vars)) checkmate::assert_true(all(c("hr", "ci") %in% vars)) + if ("pval" %in% vars && !"pval" %in% names(df$hr)) { + warning( + 'The "pval" statistic has been selected but is not present in "df" so it will not be included in the output ', + 'table. To include the "pval" statistic, please specify a p-value test when generating "df" via ', + 'the "method" argument to `extract_survival_subgroups()`. If method = "cmh", strata must also be specified via ', + 'the "variables" argument to `extract_survival_subgroups()`.' + ) + } if (lifecycle::is_present(label_all)) { lifecycle::deprecate_warn( @@ -242,26 +264,35 @@ tabulate_survival_subgroups <- function(lyt, ) } + # Process standard extra arguments + extra_args <- list(".stats" = vars) + 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 + # Create "ci" column from "lcl" and "ucl" df$hr$ci <- combine_vectors(df$hr$lcl, df$hr$ucl) - # Fill in missing formats with defaults - default_fmts <- eval(formals(tabulate_survival_subgroups)$.formats) - .formats <- c(.formats, default_fmts[vars[!vars %in% names(.formats)]]) - # Extract additional parameters from df conf_level <- df$hr$conf_level[1] - method <- df$hr$pval_label[1] + method <- if ("pval_label" %in% names(df$hr)) df$hr$pval_label[1] else NULL colvars <- d_survival_subgroups_colvars(vars, conf_level = conf_level, method = method, time_unit = time_unit) survtime_vars <- intersect(colvars$vars, c("n", "n_events", "median")) hr_vars <- intersect(names(colvars$labels), c("n_tot", "n_tot_events", "hr", "ci", "pval")) colvars_survtime <- list(vars = survtime_vars, labels = colvars$labels[survtime_vars]) colvars_hr <- list(vars = hr_vars, labels = colvars$labels[hr_vars]) - extra_args <- list(groups_lists = groups_lists, conf_level = conf_level, method = method) + # Process additional arguments to the statistic function + extra_args <- c( + extra_args, + groups_lists = list(groups_lists), conf_level = conf_level, method = method, + ... + ) - # Get analysis function for each statistic - afun_lst <- a_survival_subgroups(.formats = c(.formats, riskdiff = riskdiff$format), na_str = na_str) + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_survival_subgroups) <- c(formals(a_survival_subgroups), extra_args[[".additional_fun_parameters"]]) # Add risk difference column if (!is.null(riskdiff)) { @@ -300,26 +331,26 @@ tabulate_survival_subgroups <- function(lyt, # Add columns from table_survtime (optional) if (length(colvars_survtime$vars) > 0) { lyt_survtime <- split_cols_by(lyt = lyt, var = "arm") + lyt_survtime <- split_cols_by_multivar( + lyt = lyt_survtime, + vars = colvars_survtime$vars, + varlabels = colvars_survtime$labels + ) + + # Add "All Patients" row lyt_survtime <- split_rows_by( lyt = lyt_survtime, var = "row_type", split_fun = keep_split_levels("content"), - nested = FALSE + nested = FALSE, + child_labels = "hidden" ) - - # Add "All Patients" row - lyt_survtime <- summarize_row_groups( + lyt_survtime <- analyze_colvars( lyt = lyt_survtime, - var = "var_label", - cfun = afun_lst[names(colvars_survtime$labels)], + afun = a_survival_subgroups, na_str = na_str, extra_args = extra_args ) - lyt_survtime <- split_cols_by_multivar( - lyt = lyt_survtime, - vars = colvars_survtime$vars, - varlabels = colvars_survtime$labels - ) # Add analysis rows if ("analysis" %in% df$survtime$row_type) { @@ -333,7 +364,7 @@ tabulate_survival_subgroups <- function(lyt, lyt_survtime <- split_rows_by(lyt = lyt_survtime, var = "var_label", nested = TRUE) lyt_survtime <- analyze_colvars( lyt = lyt_survtime, - afun = afun_lst[names(colvars_survtime$labels)], + afun = a_survival_subgroups, na_str = na_str, inclNAs = TRUE, extra_args = extra_args @@ -345,25 +376,27 @@ tabulate_survival_subgroups <- function(lyt, table_survtime <- NULL } - # Add columns from table_hr ("n_tot_events" or "n_tot", "or" and "ci" required) + # Add columns from table_hr ("n_tot_events" or "n_tot", "hr" and "ci" required) lyt_hr <- split_cols_by(lyt = lyt, var = "arm") + lyt_hr <- split_cols_by_multivar( + lyt = lyt_hr, + vars = colvars_hr$vars, + varlabels = colvars_hr$labels + ) + + # Add "All Patients" row lyt_hr <- split_rows_by( lyt = lyt_hr, var = "row_type", split_fun = keep_split_levels("content"), - nested = FALSE + nested = FALSE, + child_labels = "hidden" ) - lyt_hr <- summarize_row_groups( + lyt_hr <- analyze_colvars( lyt = lyt_hr, - var = "var_label", - cfun = afun_lst[names(colvars_hr$labels)], + afun = a_survival_subgroups, na_str = na_str, extra_args = extra_args - ) - lyt_hr <- split_cols_by_multivar( - lyt = lyt_hr, - vars = colvars_hr$vars, - varlabels = colvars_hr$labels ) %>% append_topleft("Baseline Risk Factors") @@ -379,7 +412,7 @@ tabulate_survival_subgroups <- function(lyt, lyt_hr <- split_rows_by(lyt = lyt_hr, var = "var_label", nested = TRUE) lyt_hr <- analyze_colvars( lyt = lyt_hr, - afun = afun_lst[names(colvars_hr$labels)], + afun = a_survival_subgroups, na_str = na_str, inclNAs = TRUE, extra_args = extra_args diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 3ec3f37330..fb11f5ab9f 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -542,7 +542,7 @@ tern_default_stats <- list( tabulate_rsp_biomarkers = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"), tabulate_rsp_subgroups = c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval", "riskdiff"), tabulate_survival_biomarkers = c("n_tot", "n_tot_events", "median", "hr", "ci", "pval"), - tabulate_survival_subgroups = c("n_tot_events", "n_events", "n_tot", "n", "median", "hr", "ci", "pval"), + tabulate_survival_subgroups = c("n_tot_events", "n_events", "n_tot", "n", "median", "hr", "ci", "pval", "riskdiff"), test_proportion_diff = c("pval") ) @@ -567,6 +567,7 @@ tern_default_formats <- c( geom_mean_ci_3d = "xx.xx (xx.xx - xx.xx)", geom_mean_sd = "xx.x (xx.x)", geom_sd = "xx.x", + hr = list(format_extreme_values(2L)), iqr = "xx.x", lsmean = "xx.xx", lsmean_diff = "xx.xx", @@ -593,6 +594,7 @@ tern_default_formats <- c( n_rate = "xx (xx.x)", n_rsp = "xx", n_tot = "xx", + n_tot_events = "xx", n_unique = "xx", nonunique = "xx", or = list(format_extreme_values(2L)), diff --git a/tests/testthat/_snaps/survival_duration_subgroups.md b/tests/testthat/_snaps/survival_duration_subgroups.md index 8bdd934c88..418326fea9 100644 --- a/tests/testthat/_snaps/survival_duration_subgroups.md +++ b/tests/testthat/_snaps/survival_duration_subgroups.md @@ -85,10 +85,13 @@ Code res Output - hr pval - —————————————————— - M 0.12 <0.0001 - F 0.57 1.3023 + RowsVerticalSection (in_rows) object print method: + ---------------------------- + row_name formatted_cell indent_mod row_label + 1 hr.M 0.12 2 M - HR + 2 hr.F 0.57 3 Female + 3 pval.M <0.0001 2 Male + 4 pval.F 1.3023 3 Female # tabulate_survival_subgroups functions as expected with valid input diff --git a/tests/testthat/test-survival_duration_subgroups.R b/tests/testthat/test-survival_duration_subgroups.R index 7c63ea6f1a..7ca2b8c555 100644 --- a/tests/testthat/test-survival_duration_subgroups.R +++ b/tests/testthat/test-survival_duration_subgroups.R @@ -76,12 +76,13 @@ testthat::test_that("a_survival_subgroups functions as expected with valid input stringsAsFactors = FALSE ) - afun <- a_survival_subgroups(.formats = list("hr" = "xx.xx", pval = "x.xxxx | (<0.0001)")) - - result <- basic_table() %>% - split_cols_by_multivar(c("hr", "pval")) %>% - analyze_colvars(afun) %>% - build_table(df) + result <- a_survival_subgroups( + df, + .stats = c("hr", "pval"), + .formats = list(hr = "xx.xx", pval = "x.xxxx | (<0.0001)"), + .labels = list(hr.M = "M - HR", "M" = "Male", "F" = "Female"), + .indent_mods = c("M" = 2L, "F" = 3L) + ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) From 212b92103d362233125eae776bf51cbb61955325 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 18:26:37 -0500 Subject: [PATCH 20/41] Update docs --- R/summarize_patients_exposure_in_cols.R | 2 +- man/afun_riskdiff.Rd | 44 ++++----------- man/count_occurrences.Rd | 40 ++++++------- man/count_occurrences_by_grade.Rd | 34 +++++------ man/count_patients_with_event.Rd | 20 +++---- man/count_patients_with_flags.Rd | 18 ++---- man/incidence_rate.Rd | 24 ++++---- man/response_subgroups.Rd | 38 ++++++++++--- man/summarize_change.Rd | 13 +++-- man/summarize_num_patients.Rd | 65 +++++++++++++++------- man/summarize_patients_exposure_in_cols.Rd | 44 +++++++-------- man/survival_duration_subgroups.Rd | 36 +++++++++--- 12 files changed, 208 insertions(+), 170 deletions(-) diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index ac87b288bb..22d4ae7cdf 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -91,7 +91,7 @@ s_count_patients_sum_exposure <- function(df, #' @return #' * `a_count_patients_sum_exposure()` returns formatted [rtables::CellValue()]. #' -#' @keywords internal +#' @export a_count_patients_sum_exposure <- function(df, labelstr = "", ..., diff --git a/man/afun_riskdiff.Rd b/man/afun_riskdiff.Rd index 6d94682695..42544a7538 100644 --- a/man/afun_riskdiff.Rd +++ b/man/afun_riskdiff.Rd @@ -7,19 +7,13 @@ afun_riskdiff( df, labelstr = "", - .var, - .N_col, - .N_row, - .df_row, - .spl_context, - .all_col_counts, - .stats, + afun, + ..., + .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str(), - afun, - s_args = list() + .indent_mods = NULL ) } \arguments{ @@ -29,25 +23,17 @@ afun_riskdiff( (must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} for more information.} -\item{.var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested -by a statistics function.} - -\item{.N_col}{(\code{integer(1)})\cr column-wise N (column count) for the full column being analyzed that is typically -passed by \code{rtables}.} - -\item{.N_row}{(\code{integer(1)})\cr row-wise N (row group count) for the group of observations being analyzed -(i.e. with no column-based subsetting) that is typically passed by \code{rtables}.} - -\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} - -\item{.spl_context}{(\code{data.frame})\cr gives information about ancestor split states -that is passed by \code{rtables}.} +\item{afun}{(named \code{list})\cr a named list containing one name-value pair where the name corresponds to +the name of the statistics function that should be used in calculations and the value is the corresponding +analysis function.} -\item{.all_col_counts}{(\code{integer})\cr vector where each value represents a global count for a column. Values are -taken from \code{alt_counts_df} if specified (see \code{\link[rtables:build_table]{rtables::build_table()}}).} +\item{...}{additional arguments for the lower level functions.} \item{.stats}{(\code{character})\cr statistics to select for the table.} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} @@ -56,12 +42,6 @@ information on the \code{"auto"} setting.} \item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the unmodified default behavior. Can be negative.} -\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} - -\item{afun}{(named \code{list})\cr a named list containing one name-value pair where the name corresponds to -the name of the statistics function that should be used in calculations and the value is the corresponding -analysis function.} - \item{s_args}{(named \code{list})\cr additional arguments to be passed to the statistics function and analysis function supplied in \code{afun}.} } diff --git a/man/count_occurrences.Rd b/man/count_occurrences.Rd index b7b7320aed..75c1ce7695 100644 --- a/man/count_occurrences.Rd +++ b/man/count_occurrences.Rd @@ -20,6 +20,7 @@ count_occurrences( ..., table_names = vars, .stats = "count_fraction_fixed_dp", + .stat_names = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL @@ -34,6 +35,7 @@ summarize_occurrences( na_str = default_na_str(), ..., .stats = "count_fraction_fixed_dp", + .stat_names = NULL, .formats = NULL, .indent_mods = NULL, .labels = NULL @@ -41,30 +43,25 @@ summarize_occurrences( s_count_occurrences( df, - denom = c("N_col", "n", "N_row"), + .var = "MHDECOD", .N_col, .N_row, .df_row, + ..., drop = TRUE, - .var = "MHDECOD", - id = "USUBJID" + id = "USUBJID", + denom = c("N_col", "n", "N_row") ) a_count_occurrences( df, labelstr = "", - id = "USUBJID", - denom = c("N_col", "n", "N_row"), - drop = TRUE, - .N_col, - .N_row, - .var = NULL, - .df_row = NULL, + ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str() + .indent_mods = NULL ) } \arguments{ @@ -100,6 +97,9 @@ times, to avoid warnings from \code{rtables}.} Options are: \verb{'count', 'count_fraction', 'count_fraction_fixed_dp', 'fraction'}} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} @@ -110,12 +110,8 @@ unmodified default behavior. Can be negative.} \item{df}{(\code{data.frame})\cr data set containing all analysis variables.} -\item{denom}{(\code{string})\cr choice of denominator for proportion. Options are: -\itemize{ -\item \code{N_col}: total number of patients in this column across rows. -\item \code{n}: number of patients with any occurrences. -\item \code{N_row}: total number of patients in this row across columns. -}} +\item{.var, var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested +by a statistics function.} \item{.N_col}{(\code{integer(1)})\cr column-wise N (column count) for the full column being analyzed that is typically passed by \code{rtables}.} @@ -125,8 +121,12 @@ passed by \code{rtables}.} \item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} -\item{.var, var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested -by a statistics function.} +\item{denom}{(\code{string})\cr choice of denominator for proportion. Options are: +\itemize{ +\item \code{N_col}: total number of patients in this column across rows. +\item \code{n}: number of patients with any occurrences. +\item \code{N_row}: total number of patients in this row across columns. +}} \item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized (must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} diff --git a/man/count_occurrences_by_grade.Rd b/man/count_occurrences_by_grade.Rd index 5c6df5f444..ebde413fbc 100644 --- a/man/count_occurrences_by_grade.Rd +++ b/man/count_occurrences_by_grade.Rd @@ -22,6 +22,7 @@ count_occurrences_by_grade( ..., table_names = var, .stats = "count_fraction", + .stat_names = NULL, .formats = list(count_fraction = format_count_fraction_fixed_dp), .indent_mods = NULL, .labels = NULL @@ -38,6 +39,7 @@ summarize_occurrences_by_grade( na_str = default_na_str(), ..., .stats = "count_fraction", + .stat_names = NULL, .formats = list(count_fraction = format_count_fraction_fixed_dp), .indent_mods = NULL, .labels = NULL @@ -45,34 +47,27 @@ summarize_occurrences_by_grade( s_count_occurrences_by_grade( df, + labelstr = "", .var, .N_row, .N_col, + ..., id = "USUBJID", grade_groups = list(), remove_single = TRUE, only_grade_groups = FALSE, - denom = c("N_col", "n", "N_row"), - labelstr = "" + denom = c("N_col", "n", "N_row") ) a_count_occurrences_by_grade( df, labelstr = "", - id = "USUBJID", - grade_groups = list(), - remove_single = TRUE, - only_grade_groups = FALSE, - denom = c("N_col", "n", "N_row"), - .N_col, - .N_row, - .df_row, - .var = NULL, + ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str() + .indent_mods = NULL ) } \arguments{ @@ -113,6 +108,9 @@ times, to avoid warnings from \code{rtables}.} Options are: \verb{'count_fraction', 'count_fraction_fixed_dp'}} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} @@ -123,6 +121,10 @@ unmodified default behavior. Can be negative.} \item{df}{(\code{data.frame})\cr data set containing all analysis variables.} +\item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized +(must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} +for more information.} + \item{.var, var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested by a statistics function.} @@ -138,12 +140,6 @@ passed by \code{rtables}.} \item \code{n}: number of patients with any occurrences. \item \code{N_row}: total number of patients in this row across columns. }} - -\item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized -(must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} -for more information.} - -\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} } \value{ \itemize{ diff --git a/man/count_patients_with_event.Rd b/man/count_patients_with_event.Rd index cc0e7dacd1..801eb0e20e 100644 --- a/man/count_patients_with_event.Rd +++ b/man/count_patients_with_event.Rd @@ -16,6 +16,7 @@ count_patients_with_event( ..., table_names = vars, .stats = "count_fraction", + .stat_names = NULL, .formats = list(count_fraction = format_count_fraction_fixed_dp), .labels = NULL, .indent_mods = NULL @@ -24,26 +25,22 @@ count_patients_with_event( s_count_patients_with_event( df, .var, - filters, .N_col = ncol(df), .N_row = nrow(df), + ..., + filters, denom = c("n", "N_col", "N_row") ) a_count_patients_with_event( df, labelstr = "", - filters, - .N_col, - .N_row, - denom = c("n", "N_col", "N_row"), - .df_row, - .var = NULL, + ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str() + .indent_mods = NULL ) } \arguments{ @@ -76,6 +73,9 @@ times, to avoid warnings from \code{rtables}.} Options are: \verb{'n', 'count', 'count_fraction', 'count_fraction_fixed_dp', 'n_blq'}} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} @@ -104,8 +104,6 @@ passed by \code{rtables}.} \item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized (must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} for more information.} - -\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} } \value{ \itemize{ diff --git a/man/count_patients_with_flags.Rd b/man/count_patients_with_flags.Rd index e53e8f95f3..8118ab348d 100644 --- a/man/count_patients_with_flags.Rd +++ b/man/count_patients_with_flags.Rd @@ -28,29 +28,23 @@ count_patients_with_flags( s_count_patients_with_flags( df, .var, - flag_variables, - flag_labels = NULL, .N_col = ncol(df), .N_row = nrow(df), + ..., + flag_variables, + flag_labels = NULL, denom = c("n", "N_col", "N_row") ) a_count_patients_with_flags( df, labelstr = "", - flag_variables, - flag_labels = NULL, - denom = c("n", "N_col", "N_row"), - .N_col = ncol(df), - .N_row = nrow(df), - .df_row, - .var = NULL, + ..., .stats = NULL, .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str() + .indent_mods = NULL ) } \arguments{ @@ -119,8 +113,6 @@ passed by \code{rtables}.} \item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized (must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} for more information.} - -\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} } \value{ \itemize{ diff --git a/man/incidence_rate.Rd b/man/incidence_rate.Rd index 960119f8d9..aea5f81649 100644 --- a/man/incidence_rate.Rd +++ b/man/incidence_rate.Rd @@ -21,7 +21,8 @@ estimate_incidence_rate( show_labels = "hidden", table_names = vars, .stats = c("person_years", "n_events", "rate", "rate_ci"), - .formats = NULL, + .stat_names = NULL, + .formats = list(rate = "xx.xx", rate_ci = "(xx.xx, xx.xx)"), .labels = NULL, .indent_mods = NULL ) @@ -29,6 +30,7 @@ estimate_incidence_rate( s_incidence_rate( df, .var, + ..., n_events, is_event = lifecycle::deprecated(), id_var = "USUBJID", @@ -38,18 +40,13 @@ s_incidence_rate( a_incidence_rate( df, labelstr = "", - .var, - .df_row, - n_events, - id_var = "USUBJID", - control = control_incidence_rate(), + label_fmt = "\%s - \%.labels", + ..., .stats = NULL, - .formats = c(person_years = "xx.x", n_events = "xx", rate = "xx.xx", rate_ci = - "(xx.xx, xx.xx)", n_unique = "xx", n_rate = "xx (xx.x)"), + .stat_names = NULL, + .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str(), - label_fmt = "\%s - \%.labels" + .indent_mods = NULL ) } \arguments{ @@ -97,6 +94,9 @@ times, to avoid warnings from \code{rtables}.} Options are: \verb{'person_years', 'n_events', 'rate', 'rate_ci', 'n_unique', 'n_rate'}} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} @@ -115,8 +115,6 @@ by a statistics function.} \item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized (must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} for more information.} - -\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} } \value{ \itemize{ diff --git a/man/response_subgroups.Rd b/man/response_subgroups.Rd index dc208e9491..dfc2334621 100644 --- a/man/response_subgroups.Rd +++ b/man/response_subgroups.Rd @@ -11,19 +11,25 @@ tabulate_rsp_subgroups( df, vars = c("n_tot", "n", "prop", "or", "ci"), groups_lists = list(), - label_all = "All Patients", + label_all = lifecycle::deprecated(), riskdiff = NULL, na_str = default_na_str(), - .formats = c(n = "xx", n_rsp = "xx", prop = "xx.x\%", n_tot = "xx", or = - list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), pval = - "x.xxxx | (<0.0001)") + ..., + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL ) a_response_subgroups( - .formats = list(n = "xx", n_rsp = "xx", prop = "xx.x\%", n_tot = "xx", or = - list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), pval = - "x.xxxx | (<0.0001)", riskdiff = "xx.x (xx.x - xx.x)"), - na_str = default_na_str() + df, + labelstr = "", + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL ) } \arguments{ @@ -57,8 +63,24 @@ the second level as \code{arm_y}.} \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{...}{additional arguments for the lower level functions.} + +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} + +\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} + +\item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the +unmodified default behavior. Can be negative.} + +\item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized +(must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} +for more information.} + +\item{.stats}{(\code{character})\cr statistics to select for the table.} } \value{ An \code{rtables} table summarizing binary response by subgroup. diff --git a/man/summarize_change.Rd b/man/summarize_change.Rd index 96410a730c..ce88502745 100644 --- a/man/summarize_change.Rd +++ b/man/summarize_change.Rd @@ -19,11 +19,10 @@ summarize_change( section_div = NA_character_, ..., .stats = c("n", "mean_sd", "median", "range"), - .formats = c(n = "xx", mean_sd = "xx.xx (xx.xx)", mean_se = "xx.xx (xx.xx)", median = - "xx.xx", range = "xx.xx - xx.xx", mean_ci = "(xx.xx, xx.xx)", median_ci = - "(xx.xx, xx.xx)", mean_pval = "xx.xx"), - .labels = c(mean_sd = "Mean (SD)", mean_se = "Mean (SE)", median = "Median", range = - "Min - Max"), + .stat_names = NULL, + .formats = c(mean_sd = "xx.xx (xx.xx)", mean_se = "xx.xx (xx.xx)", median = "xx.xx", + range = "xx.xx - xx.xx", mean_pval = "xx.xx"), + .labels = NULL, .indent_mods = NULL ) @@ -33,6 +32,7 @@ a_change_from_baseline( df, ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL @@ -69,6 +69,9 @@ defined by this split instruction, or \code{NA_character_} (the default) for no Options are: \verb{'n', 'sum', 'mean', 'sd', 'se', 'mean_sd', 'mean_se', 'mean_ci', 'mean_sei', 'mean_sdi', 'mean_pval', 'median', 'mad', 'median_ci', 'quantiles', 'iqr', 'range', 'min', 'max', 'median_range', 'cv', 'geom_mean', 'geom_sd', 'geom_mean_sd', 'geom_mean_ci', 'geom_cv', 'median_ci_3d', 'mean_ci_3d', 'geom_mean_ci_3d'}} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} diff --git a/man/summarize_num_patients.Rd b/man/summarize_num_patients.Rd index 1f0cfa1d3a..a9f9201f50 100644 --- a/man/summarize_num_patients.Rd +++ b/man/summarize_num_patients.Rd @@ -5,6 +5,7 @@ \alias{analyze_num_patients} \alias{s_num_patients} \alias{s_num_patients_content} +\alias{a_num_patients} \title{Count number of patients} \usage{ analyze_num_patients( @@ -15,14 +16,15 @@ analyze_num_patients( unique_count_suffix = TRUE, na_str = default_na_str(), nested = TRUE, - .stats = NULL, - .formats = NULL, - .labels = c(unique = "Number of patients with at least one event", nonunique = - "Number of events"), show_labels = c("default", "visible", "hidden"), - .indent_mods = 0L, riskdiff = FALSE, - ... + ..., + .stats = c("unique", "nonunique", "unique_count"), + .stat_names = NULL, + .formats = NULL, + .labels = list(unique = "Number of patients with at least one event", nonunique = + "Number of events"), + .indent_mods = NULL ) summarize_num_patients( @@ -32,19 +34,21 @@ summarize_num_patients( count_by = NULL, unique_count_suffix = TRUE, na_str = default_na_str(), - .stats = NULL, + riskdiff = FALSE, + ..., + .stats = c("unique", "nonunique", "unique_count"), + .stat_names = NULL, .formats = NULL, - .labels = c(unique = "Number of patients with at least one event", nonunique = + .labels = list(unique = "Number of patients with at least one event", nonunique = "Number of events"), - .indent_mods = 0L, - riskdiff = FALSE, - ... + .indent_mods = NULL ) s_num_patients( x, labelstr, .N_col, + ..., count_by = NULL, unique_count_suffix = TRUE ) @@ -54,10 +58,22 @@ s_num_patients_content( labelstr = "", .N_col, .var, + ..., required = NULL, count_by = NULL, unique_count_suffix = TRUE ) + +a_num_patients( + df, + labelstr = "", + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL +) } \arguments{ \item{lyt}{(\code{PreDataTableLayouts})\cr layout that analyses will be added to.} @@ -78,26 +94,29 @@ Defaults to \code{TRUE}.} possible (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} +\item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} + +\item{riskdiff}{(\code{flag})\cr whether a risk difference column is present. When set to \code{TRUE}, \code{\link[=add_riskdiff]{add_riskdiff()}} must be +used as \code{split_fun} in the prior column split of the table layout, specifying which columns should be compared. +See \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk difference calculation.} + +\item{...}{additional arguments for the lower level functions.} + \item{.stats}{(\code{character})\cr statistics to select for the table. Options are: \verb{'unique', 'nonunique', 'unique_count'}} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} \item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} -\item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} - \item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the unmodified default behavior. Can be negative.} -\item{riskdiff}{(\code{flag})\cr whether a risk difference column is present. When set to \code{TRUE}, \code{\link[=add_riskdiff]{add_riskdiff()}} must be -used as \code{split_fun} in the prior column split of the table layout, specifying which columns should be compared. -See \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk difference calculation.} - -\item{...}{additional arguments for the lower level functions.} - \item{x}{(\code{character} or \code{factor})\cr vector of patient IDs.} \item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized @@ -137,6 +156,10 @@ the statistics from \code{s_num_patients_content()} to the table layout. \itemize{ \item \code{s_num_patients_content()} returns the same values as \code{s_num_patients()}. } + +\itemize{ +\item \code{a_num_patients()} returns the corresponding list with formatted \code{\link[rtables:CellValue]{rtables::CellValue()}}. +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} @@ -176,6 +199,9 @@ total number of patients, and the number of non-unique patients. in a column (variable), the corresponding percentage taken with respect to the total number of patients, and the number of non-unique patients in the column. +\item \code{a_num_patients()}: Formatted analysis function which is used as \code{afun} +in \code{analyze_num_patients()} and as \code{cfun} in \code{summarize_num_patients()}. + }} \note{ As opposed to \code{\link[=summarize_num_patients]{summarize_num_patients()}}, this function does not repeat the produced rows. @@ -230,3 +256,4 @@ df_by_event <- data.frame( s_num_patients_content(df_by_event, .N_col = 5, .var = "USUBJID", count_by = "EVENT") } +\keyword{internal} diff --git a/man/summarize_patients_exposure_in_cols.Rd b/man/summarize_patients_exposure_in_cols.Rd index 8dcdf6218d..e3fca7c369 100644 --- a/man/summarize_patients_exposure_in_cols.Rd +++ b/man/summarize_patients_exposure_in_cols.Rd @@ -17,8 +17,10 @@ analyze_patients_exposure_in_cols( col_split = TRUE, na_str = default_na_str(), .stats = c("n_patients", "sum_exposure"), + .stat_names = NULL, + .formats = NULL, .labels = c(n_patients = "Patients", sum_exposure = "Person time"), - .indent_mods = 0L, + .indent_mods = NULL, ... ) @@ -33,31 +35,33 @@ summarize_patients_exposure_in_cols( na_str = default_na_str(), ..., .stats = c("n_patients", "sum_exposure"), + .stat_names = NULL, + .formats = NULL, .labels = c(n_patients = "Patients", sum_exposure = "Person time"), .indent_mods = NULL ) s_count_patients_sum_exposure( df, - ex_var = "AVAL", - id = "USUBJID", labelstr = "", .stats = c("n_patients", "sum_exposure"), .N_col, - custom_label = NULL + ..., + ex_var = "AVAL", + id = "USUBJID", + custom_label = NULL, + var_level = NULL ) a_count_patients_sum_exposure( df, - var = NULL, - ex_var = "AVAL", - id = "USUBJID", - add_total_level = FALSE, - custom_label = NULL, labelstr = "", - .N_col, - .stats, - .formats = list(n_patients = "xx (xx.x\%)", sum_exposure = "xx") + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL ) } \arguments{ @@ -84,6 +88,12 @@ column split has been done already earlier in the layout pipe.} Options are: \verb{'n_patients', 'sum_exposure'}} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + +\item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more +information on the \code{"auto"} setting.} + \item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} \item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the @@ -99,9 +109,6 @@ for more information.} \item{.N_col}{(\code{integer(1)})\cr column-wise N (column count) for the full column being analyzed that is typically passed by \code{rtables}.} - -\item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more -information on the \code{"auto"} setting.} } \value{ \itemize{ @@ -237,12 +244,5 @@ lyt6 <- basic_table() \%>\% result6 <- build_table(lyt6, df = df, alt_counts_df = adsl) result6 -a_count_patients_sum_exposure( - df = df, - var = "SEX", - .N_col = nrow(df), - .stats = "n_patients" -) - } \keyword{internal} diff --git a/man/survival_duration_subgroups.Rd b/man/survival_duration_subgroups.Rd index 9bd2e96c28..50313eef12 100644 --- a/man/survival_duration_subgroups.Rd +++ b/man/survival_duration_subgroups.Rd @@ -15,16 +15,22 @@ tabulate_survival_subgroups( time_unit = NULL, riskdiff = NULL, na_str = default_na_str(), - .formats = c(n = "xx", n_events = "xx", n_tot_events = "xx", median = "xx.x", n_tot = - "xx", hr = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), - pval = "x.xxxx | (<0.0001)") + ..., + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL ) a_survival_subgroups( - .formats = list(n = "xx", n_events = "xx", n_tot_events = "xx", median = "xx.x", n_tot - = "xx", hr = list(format_extreme_values(2L)), ci = - list(format_extreme_values_ci(2L)), pval = "x.xxxx | (<0.0001)"), - na_str = default_na_str() + df, + labelstr = "", + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL ) } \arguments{ @@ -63,8 +69,24 @@ and the second level as \code{arm_y}.} \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{...}{additional arguments for the lower level functions.} + +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} + +\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} + +\item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the +unmodified default behavior. Can be negative.} + +\item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized +(must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} +for more information.} + +\item{.stats}{(\code{character})\cr statistics to select for the table.} } \value{ An \code{rtables} table summarizing survival by subgroup. From 6f7ecbfd7c02b1da5b5fdcdf50432eefd2d764f8 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 18:33:47 -0500 Subject: [PATCH 21/41] Miscellaneous documentation --- _pkgdown.yml | 5 ++--- vignettes/tables.Rmd | 26 +++----------------------- 2 files changed, 5 insertions(+), 26 deletions(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index b66d1c54bb..2f7f2bdf10 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -45,9 +45,8 @@ reference: from formatting, they do not take care of `rcell` type formatting themselves. - - **Formatted analysis functions** (denoted by `a_` prefix) have the - same arguments as the corresponding statistics functions, and can - be further customized by calling `rtables::make_afun()` on them. + - **Formatted analysis functions** (denoted by `a_` prefix) apply + formatting to results from their corresponding statistics functions. They are used as `afun` in `rtables::analyze()`. contents: diff --git a/vignettes/tables.Rmd b/vignettes/tables.Rmd index b62e21de4c..9699dd6422 100644 --- a/vignettes/tables.Rmd +++ b/vignettes/tables.Rmd @@ -72,11 +72,10 @@ The descriptions for each function type: - statistics function `s_*`. Statistics functions should do the computation of the numbers that are tabulated later. In order to separate computation from formatting, they should not take care of `rcell` type formatting themselves. - formatted analysis functions `a_*`. -These have the same arguments as the corresponding statistics functions, and can be further customized by calling `rtables::make_afun()` on them. +These apply formatting to results from their corresponding statistics functions. They are used as `afun` in `rtables::analyze()`. -- **analyze functions `rtables::analyze(..., afun = make_afun(tern::a_*))`. -Analyze functions are used in combination with the `rtables` layout functions, in the pipeline which creates the table. -They are the last element of the chain.** +- analyze functions `rtables::analyze(..., afun = tern::a_*)`. +Analyze functions are used in combination with the `rtables` layout functions, in the pipeline which creates the table. They are the last element of the chain. We will use the native `rtables::analyze` function with the `tern` formatted analysis functions as a `afun` parameter. @@ -89,25 +88,6 @@ l <- basic_table() %>% build_table(l, df = adrs) ``` -The `rtables::make_afun` function is helpful when somebody wants to attach some format to the formatted analysis function. - -``` -afun <- make_afun( - a_summary, - .stats = NULL, - .formats = c(median = "xx."), - .labels = c(median = "My median"), - .indent_mods = c(median = 1L) -) - -l2 <- basic_table() %>% - split_cols_by(var = "ARM") %>% - split_rows_by(var = "AVISIT") %>% - analyze(vars = "AVAL", afun = afun) - -build_table(l2, df = adrs) -``` - ## Tabulation Examples We are going to create 3 different tables using `tern` analyze functions and the `rtables` interface. From 2e98f3cf69fe68d6d04a1192d3297e17419a00f5 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 18:45:20 -0500 Subject: [PATCH 22/41] Update NEWS --- NEWS.md | 4 +++- R/summarize_num_patients.R | 1 - 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index f00a2bdef2..cc393089c5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,9 @@ # tern 0.9.7.9008 ### Enhancements -* Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, `count_abnormal_lab_worsen_by_baseline()`, `summarize_ancova()`, and `summarize_glm_count()` 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()`, `summarize_ancova()`, `summarize_glm_count()`, and `summarize_num_patients()` to work without `make_afun()`. * Added `geom_sd` and `geom_mean_sd` to `s_summary()` default available statistics. +* Refactored `afun_riskdiff()`, `count_occurrences()`, `count_occurrences_by_grade()`, `count_patients_with_event()`, `count_patients_with_flags()`, `count_values()`, `estimate_incidence_rate()`, `summarize_change()`, `summarize_patients_exposure_in_cols()`, `tabulate_rsp_subgroups()`, and `tabulate_survival_subgroups()` 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. @@ -14,6 +15,7 @@ * Began deprecation of the unused `table_names` argument to `count_abnormal_lab_worsen_by_baseline()`. * Added warnings for `geom_mean` statistical output. * Began deprecation of the unused `label_all` parameter to `tabulate_rsp_subgroups()`, with redirection to the same parameter in `extract_rsp_subgroups()`. +* Updated documentation to remove suggestions to use `make_afun()`. # tern 0.9.7 diff --git a/R/summarize_num_patients.R b/R/summarize_num_patients.R index c113254651..43903cce8a 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -56,7 +56,6 @@ s_num_patients <- function(x, ..., count_by = NULL, unique_count_suffix = TRUE) { - checkmate::assert_string(labelstr) checkmate::assert_count(.N_col) checkmate::assert_multi_class(x, classes = c("factor", "character")) From 2ced232deba4ca9e7828bb51b9a87102d86518af Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 20:41:49 -0500 Subject: [PATCH 23/41] Update response_biomarkers_subgroups --- R/response_biomarkers_subgroups.R | 101 +++++++++++++++++--- R/response_subgroups.R | 26 +++-- tests/testthat/_snaps/response_subgroups.md | 2 +- 3 files changed, 107 insertions(+), 22 deletions(-) diff --git a/R/response_biomarkers_subgroups.R b/R/response_biomarkers_subgroups.R index b18ad598ae..690e71c45c 100644 --- a/R/response_biomarkers_subgroups.R +++ b/R/response_biomarkers_subgroups.R @@ -73,28 +73,103 @@ tabulate_rsp_biomarkers <- function(df, vars = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"), na_str = default_na_str(), - .indent_mods = 0L) { + ..., + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL) { checkmate::assert_data_frame(df) checkmate::assert_character(df$biomarker) checkmate::assert_character(df$biomarker_label) checkmate::assert_subset(vars, get_stats("tabulate_rsp_biomarkers")) + # Process standard extra arguments + extra_args <- list(".stats" = vars) + 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 + # Create "ci" column from "lcl" and "ucl" df$ci <- combine_vectors(df$lcl, df$ucl) + afuns <- a_response_subgroups + colvars <- d_rsp_subgroups_colvars( + vars, + conf_level = df$conf_level[1], + method = df$pval_label[1] + ) + + # Process additional arguments to the statistic function + extra_args <- c(extra_args, biomarker = TRUE, ...) + + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_response_subgroups) <- c(formals(a_response_subgroups), extra_args[[".additional_fun_parameters"]]) + df_subs <- split(df, f = df$biomarker) - tabs <- lapply(df_subs, FUN = function(df_sub) { - tab_sub <- h_tab_rsp_one_biomarker( - df = df_sub, - vars = vars, - na_str = na_str, - .indent_mods = .indent_mods - ) - # Insert label row as first row in table. - label_at_path(tab_sub, path = row_paths(tab_sub)[[1]][1]) <- df_sub$biomarker_label[1] - tab_sub - }) - result <- do.call(rbind, tabs) + tbls <- lapply( + df_subs, + function(df) { + lyt <- basic_table() + + # Split cols by the multiple variables to populate into columns. + lyt <- split_cols_by_multivar( + lyt = lyt, + vars = colvars$vars, + varlabels = colvars$labels + ) + + # Row split by biomarker + lyt <- split_rows_by( + lyt = lyt, + var = "biomarker_label", + nested = FALSE + ) + + # Add "All Patients" row + lyt <- split_rows_by( + lyt = lyt, + var = "row_type", + split_fun = keep_split_levels("content"), + nested = TRUE, + child_labels = "hidden" + ) + lyt <- analyze_colvars( + lyt = lyt, + afun = a_response_subgroups, + na_str = na_str, + extra_args = c(extra_args, overall = TRUE) + ) + + # Add analysis rows + if ("analysis" %in% df$row_type) { + lyt <- split_rows_by( + lyt = lyt, + var = "row_type", + split_fun = keep_split_levels("analysis"), + nested = TRUE, + child_labels = "hidden" + ) + lyt <- split_rows_by( + lyt = lyt, + var = "var_label", + nested = TRUE, + indent_mod = 1L + ) + lyt <- analyze_colvars( + lyt = lyt, + afun = a_response_subgroups, + na_str = na_str, + inclNAs = TRUE, + extra_args = extra_args + ) + } + build_table(lyt, df = df) + } + ) + + result <- do.call(rbind, tbls) n_id <- grep("n_tot", vars) or_id <- match("or", vars) diff --git a/R/response_subgroups.R b/R/response_subgroups.R index fe67eb2071..262808db31 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -142,7 +142,20 @@ a_response_subgroups <- function(df, extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters)) dots_extra_args$.additional_fun_parameters <- NULL cur_stat <- extra_afun_params$.var %||% .stats - var_lvls <- as.character(df$subgroup) + var_lvls <- if ("biomarker" %in% names(dots_extra_args)) { + if ("overall" %in% names(dots_extra_args)) { + as.character(df$biomarker) + } else { + paste(as.character(df$biomarker), as.character(df$subgroup), sep = ".") + } + } else { + as.character(df$subgroup) + } + + # if empty, return NA + if (nrow(df) == 0) { + return(in_rows(.list = list(NA) %>% stats::setNames(cur_stat))) + } # Main statistics taken from df x_stats <- as.list(df) @@ -153,7 +166,7 @@ a_response_subgroups <- function(df, .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) .labels <- get_labels_from_stats( .stats, .labels, levels_per_stats, - tern_defaults = as.list(var_lvls) %>% setNames(var_lvls) + tern_defaults = as.list(as.character(df$subgroup)) %>% setNames(var_lvls) ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) @@ -163,6 +176,8 @@ a_response_subgroups <- function(df, ) %>% stats::setNames(.stats) + .nms <- if ("biomarker" %in% names(dots_extra_args)) var_lvls else names(.labels) + # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -172,7 +187,7 @@ a_response_subgroups <- function(df, in_rows( .list = x_stats %>% .unlist_keep_nulls(), .formats = .formats, - .names = names(.labels), + .names = .nms, .stat_names = .stat_names, .labels = .labels %>% .unlist_keep_nulls(), .indent_mods = .indent_mods %>% .unlist_keep_nulls() @@ -472,11 +487,6 @@ d_rsp_subgroups_colvars <- function(vars, varlabels, ci = paste0(100 * conf_level, "% CI") ) - - # The `lcl`` variable is just a placeholder available in the analysis data, - # it is not acutally used in the tabulation. - # Variables used in the tabulation are lcl and ucl, see `a_response_subgroups` for details. - colvars[colvars == "ci"] <- "lcl" } if ("pval" %in% colvars) { diff --git a/tests/testthat/_snaps/response_subgroups.md b/tests/testthat/_snaps/response_subgroups.md index a4cd49993a..853098f6e8 100644 --- a/tests/testthat/_snaps/response_subgroups.md +++ b/tests/testthat/_snaps/response_subgroups.md @@ -229,7 +229,7 @@ res Output $vars - [1] "n" "n_rsp" "prop" "n_tot" "or" "lcl" "pval" + [1] "n" "n_rsp" "prop" "n_tot" "or" "ci" "pval" $labels n n_rsp From f4b991ca9a364d1969aeb1e455b0d07d395c5a42 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 21:49:56 -0500 Subject: [PATCH 24/41] Edge cases --- R/count_occurrences.R | 5 +++++ R/response_biomarkers_subgroups.R | 7 +++---- R/response_subgroups.R | 4 ++-- R/survival_duration_subgroups.R | 5 ----- tests/testthat/_snaps/survival_duration_subgroups.md | 2 +- 5 files changed, 11 insertions(+), 12 deletions(-) diff --git a/R/count_occurrences.R b/R/count_occurrences.R index 29fa49f078..e9544b4200 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -170,6 +170,11 @@ 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, diff --git a/R/response_biomarkers_subgroups.R b/R/response_biomarkers_subgroups.R index 690e71c45c..b2f7d09c1d 100644 --- a/R/response_biomarkers_subgroups.R +++ b/R/response_biomarkers_subgroups.R @@ -90,10 +90,6 @@ tabulate_rsp_biomarkers <- function(df, if (!is.null(.labels)) extra_args[[".labels"]] <- .labels if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods - # Create "ci" column from "lcl" and "ucl" - df$ci <- combine_vectors(df$lcl, df$ucl) - - afuns <- a_response_subgroups colvars <- d_rsp_subgroups_colvars( vars, conf_level = df$conf_level[1], @@ -107,6 +103,9 @@ tabulate_rsp_biomarkers <- function(df, extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) formals(a_response_subgroups) <- c(formals(a_response_subgroups), extra_args[[".additional_fun_parameters"]]) + # Create "ci" column from "lcl" and "ucl" + df$ci <- combine_vectors(df$lcl, df$ucl) + df_subs <- split(df, f = df$biomarker) tbls <- lapply( df_subs, diff --git a/R/response_subgroups.R b/R/response_subgroups.R index 262808db31..dc26923910 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -142,14 +142,14 @@ a_response_subgroups <- function(df, extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters)) dots_extra_args$.additional_fun_parameters <- NULL cur_stat <- extra_afun_params$.var %||% .stats - var_lvls <- if ("biomarker" %in% names(dots_extra_args)) { + var_lvls <- if ("biomarker" %in% names(dots_extra_args) && "biomarker" %in% names(df)) { if ("overall" %in% names(dots_extra_args)) { as.character(df$biomarker) } else { paste(as.character(df$biomarker), as.character(df$subgroup), sep = ".") } } else { - as.character(df$subgroup) + make.unique(as.character(df$subgroup)) } # if empty, return NA diff --git a/R/survival_duration_subgroups.R b/R/survival_duration_subgroups.R index 76c520360d..216625894d 100644 --- a/R/survival_duration_subgroups.R +++ b/R/survival_duration_subgroups.R @@ -489,11 +489,6 @@ d_survival_subgroups_colvars <- function(vars, colvars <- vars - # The `lcl` variable is just a placeholder available in the analysis data, - # it is not acutally used in the tabulation. - # Variables used in the tabulation are lcl and ucl, see `a_survival_subgroups` for details. - colvars[colvars == "ci"] <- "lcl" - list( vars = colvars, labels = varlabels[vars] diff --git a/tests/testthat/_snaps/survival_duration_subgroups.md b/tests/testthat/_snaps/survival_duration_subgroups.md index 418326fea9..61f7a355ac 100644 --- a/tests/testthat/_snaps/survival_duration_subgroups.md +++ b/tests/testthat/_snaps/survival_duration_subgroups.md @@ -198,7 +198,7 @@ Output $vars [1] "n" "n_events" "median" "n_tot_events" "hr" - [6] "lcl" "pval" + [6] "ci" "pval" $labels n n_events median From 6b792733b28975e651d981b3e72430edbd9f7a20 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 24 Feb 2025 22:00:14 -0500 Subject: [PATCH 25/41] Update h_tab_one_bmrkr, h_tab_rsp_one_bmrkr, h_tab_surv_one_bmrkr --- R/h_biomarkers_subgroups.R | 76 ++++++++++++++++------------- R/h_response_biomarkers_subgroups.R | 10 ++-- R/h_survival_biomarkers_subgroups.R | 4 +- R/survival_duration_subgroups.R | 17 ++++++- 4 files changed, 66 insertions(+), 41 deletions(-) diff --git a/R/h_biomarkers_subgroups.R b/R/h_biomarkers_subgroups.R index ebbb3e94f4..5f6fd007d6 100644 --- a/R/h_biomarkers_subgroups.R +++ b/R/h_biomarkers_subgroups.R @@ -17,69 +17,79 @@ h_tab_one_biomarker <- function(df, afuns, colvars, na_str = default_na_str(), - .indent_mods = 0L, - ...) { - extra_args <- list(...) + ..., + .stats = NULL, + .stat_names = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL) { + # 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, biomarker = TRUE, ...) + + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(afuns) <- c(formals(afuns), extra_args[[".additional_fun_parameters"]]) # Create "ci" column from "lcl" and "ucl" df$ci <- combine_vectors(df$lcl, df$ucl) + colvars$vars <- intersect(colvars$vars, names(df)) + colvars$labels <- colvars$labels[colvars$vars] + lyt <- basic_table() - # Row split by row type - only keep the content rows here. + # Split cols by the multiple variables to populate into columns. + lyt <- split_cols_by_multivar( + lyt = lyt, + vars = colvars$vars, + varlabels = colvars$labels + ) + + # Add "All Patients" row lyt <- split_rows_by( lyt = lyt, var = "row_type", split_fun = keep_split_levels("content"), - nested = FALSE + nested = TRUE, + child_labels = "hidden" ) - - # Summarize rows with all patients. - lyt <- summarize_row_groups( + lyt <- analyze_colvars( lyt = lyt, - var = "var_label", - cfun = afuns, + afun = afuns, na_str = na_str, - indent_mod = .indent_mods, - extra_args = extra_args + extra_args = c(extra_args) ) - # Split cols by the multiple variables to populate into columns. - lyt <- split_cols_by_multivar( - lyt = lyt, - vars = colvars$vars, - varlabels = colvars$labels - ) - - # If there is any subgroup variables, we extend the layout accordingly. + # Add analysis rows if ("analysis" %in% df$row_type) { - # Now only continue with the subgroup rows. lyt <- split_rows_by( lyt = lyt, var = "row_type", split_fun = keep_split_levels("analysis"), - nested = FALSE, + nested = TRUE, child_labels = "hidden" ) - - # Split by the subgroup variable. lyt <- split_rows_by( lyt = lyt, - var = "var", - labels_var = "var_label", + var = "var_label", nested = TRUE, - child_labels = "visible", - indent_mod = .indent_mods * 2 + indent_mod = 1L ) - - # Then analyze colvars for each subgroup. - lyt <- summarize_row_groups( + lyt <- analyze_colvars( lyt = lyt, - cfun = afuns, - var = "subgroup", + afun = afuns, na_str = na_str, + inclNAs = TRUE, extra_args = extra_args ) } + build_table(lyt, df = df) } diff --git a/R/h_response_biomarkers_subgroups.R b/R/h_response_biomarkers_subgroups.R index 706bf247c0..38db27f810 100644 --- a/R/h_response_biomarkers_subgroups.R +++ b/R/h_response_biomarkers_subgroups.R @@ -202,18 +202,20 @@ h_logistic_mult_cont_df <- function(variables, h_tab_rsp_one_biomarker <- function(df, vars, na_str = default_na_str(), - .indent_mods = 0L) { - afuns <- a_response_subgroups(na_str = na_str)[vars] + .indent_mods = 0L, + ...) { colvars <- d_rsp_subgroups_colvars( vars, conf_level = df$conf_level[1], method = df$pval_label[1] ) + h_tab_one_biomarker( df = df, - afuns = afuns, + afuns = a_response_subgroups, colvars = colvars, na_str = na_str, - .indent_mods = .indent_mods + .indent_mods = .indent_mods, + ... ) } diff --git a/R/h_survival_biomarkers_subgroups.R b/R/h_survival_biomarkers_subgroups.R index cb5519b0c9..2179bee78b 100644 --- a/R/h_survival_biomarkers_subgroups.R +++ b/R/h_survival_biomarkers_subgroups.R @@ -209,16 +209,16 @@ h_tab_surv_one_biomarker <- function(df, na_str = default_na_str(), .indent_mods = 0L, ...) { - afuns <- a_survival_subgroups(na_str = na_str)[vars] colvars <- d_survival_subgroups_colvars( vars, conf_level = df$conf_level[1], method = df$pval_label[1], time_unit = time_unit ) + h_tab_one_biomarker( df = df, - afuns = afuns, + afuns = a_survival_subgroups, colvars = colvars, na_str = na_str, .indent_mods = .indent_mods, diff --git a/R/survival_duration_subgroups.R b/R/survival_duration_subgroups.R index 216625894d..4cccecb03e 100644 --- a/R/survival_duration_subgroups.R +++ b/R/survival_duration_subgroups.R @@ -166,7 +166,20 @@ a_survival_subgroups <- function(df, extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters)) dots_extra_args$.additional_fun_parameters <- NULL cur_stat <- extra_afun_params$.var %||% .stats - var_lvls <- as.character(df$subgroup) + var_lvls <- if ("biomarker" %in% names(dots_extra_args) && "biomarker" %in% names(df)) { + if ("overall" %in% names(dots_extra_args)) { + as.character(df$biomarker) + } else { + paste(as.character(df$biomarker), as.character(df$subgroup), sep = ".") + } + } else { + make.unique(as.character(df$subgroup)) + } + + # if empty, return NA + if (nrow(df) == 0) { + return(in_rows(.list = list(NA) %>% stats::setNames(cur_stat))) + } # Main statistics taken from df x_stats <- as.list(df) @@ -177,7 +190,7 @@ a_survival_subgroups <- function(df, .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) .labels <- get_labels_from_stats( .stats, .labels, levels_per_stats, - tern_defaults = as.list(var_lvls) %>% setNames(var_lvls) + tern_defaults = as.list(as.character(df$subgroup)) %>% setNames(var_lvls) ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) From f88ccfd65865699cf42a76f5a1695d2b4187ec7d Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 12:39:54 -0500 Subject: [PATCH 26/41] Update survival_time --- NEWS.md | 2 +- R/survival_time.R | 99 ++++++++++++++++---------- R/utils_default_stats_formats_labels.R | 2 + tests/testthat/_snaps/survival_time.md | 52 +++++++------- tests/testthat/test-survival_time.R | 29 ++++++-- 5 files changed, 114 insertions(+), 70 deletions(-) diff --git a/NEWS.md b/NEWS.md index cc393089c5..58d1f88f22 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,7 +3,7 @@ ### Enhancements * Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, `count_abnormal_lab_worsen_by_baseline()`, `summarize_ancova()`, `summarize_glm_count()`, and `summarize_num_patients()` to work without `make_afun()`. * Added `geom_sd` and `geom_mean_sd` to `s_summary()` default available statistics. -* Refactored `afun_riskdiff()`, `count_occurrences()`, `count_occurrences_by_grade()`, `count_patients_with_event()`, `count_patients_with_flags()`, `count_values()`, `estimate_incidence_rate()`, `summarize_change()`, `summarize_patients_exposure_in_cols()`, `tabulate_rsp_subgroups()`, and `tabulate_survival_subgroups()` 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()`, `summarize_change()`, `summarize_patients_exposure_in_cols()`, `survival_time()`, `tabulate_rsp_subgroups()`, and `tabulate_survival_subgroups()` 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. diff --git a/R/survival_time.R b/R/survival_time.R index a80f17d1af..b3f42d556a 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -55,6 +55,7 @@ NULL #' @keywords internal s_surv_time <- function(df, .var, + ..., is_event, control = control_surv_time()) { checkmate::assert_string(.var) @@ -135,42 +136,41 @@ s_surv_time <- function(df, #' @export a_surv_time <- function(df, labelstr = "", - .var = NULL, - .df_row = NULL, - is_event, - control = control_surv_time(), - ref_fn_censor = TRUE, + ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str()) { - x_stats <- s_surv_time( - df = df, .var = .var, is_event = is_event, control = control + .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 + + # Main statistic calculations + x_stats <- .apply_stat_functions( + default_stat_fnc = s_surv_time, + custom_stat_fnc_list = custom_stat_functions, + args_list = c( + df = list(df), + labelstr = list(labelstr), + extra_afun_params, + dots_extra_args + ) ) + rng_censor_lwr <- x_stats[["range_censor"]][1] rng_censor_upr <- x_stats[["range_censor"]][2] - # Use method-specific defaults - fmts <- c( - median_ci = "(xx.x, xx.x)", quantiles = "xx.x, xx.x", range = "xx.x to xx.x", - median_ci_3d = "xx.x (xx.x - xx.x)", - quantiles_lower = "xx.x (xx.x - xx.x)", quantiles_upper = "xx.x (xx.x - xx.x)" - ) - lbls <- c( - median_ci = "95% CI", range = "Range", range_censor = "Range (censored)", range_event = "Range (event)", - median_ci_3d = "Median (95% CI)", - quantiles_lower = "25%-ile (95% CI)", - quantiles_upper = "75%-ile (95% CI)" - ) - lbls_custom <- .labels - .formats <- c(.formats, fmts[setdiff(names(fmts), names(.formats))]) - .labels <- c(.labels, lbls[setdiff(names(lbls), names(lbls_custom))]) - - # Fill in with formatting defaults if needed - .stats <- get_stats("surv_time", stats_in = .stats) + # Fill in formatting defaults + .stats <- get_stats("surv_time", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) .formats <- get_formats_from_stats(.stats, .formats) - .labels <- get_labels_from_stats(.stats, .labels) %>% labels_use_control(control, lbls_custom) + .labels <- get_labels_from_stats(.stats, .labels) %>% labels_use_control(dots_extra_args$control) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) x_stats <- x_stats[.stats] @@ -178,8 +178,12 @@ a_surv_time <- function(df, # Auto format handling .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) + + # Get cell footnotes cell_fns <- stats::setNames(vector("list", length = length(x_stats)), .labels) - if ("range" %in% names(x_stats) && ref_fn_censor) { + if ("range" %in% names(x_stats) && dots_extra_args$ref_fn_censor) { if (identical(x_stats[["range"]][1], rng_censor_lwr) && identical(x_stats[["range"]][2], rng_censor_upr)) { cell_fns[[.labels[["range"]]]] <- "Censored observations: range minimum & maximum" } else if (identical(x_stats[["range"]][1], rng_censor_lwr)) { @@ -192,9 +196,10 @@ a_surv_time <- function(df, in_rows( .list = x_stats, .formats = .formats, - .names = .labels, - .labels = .labels, - .indent_mods = .indent_mods, + .names = names(.labels), + .stat_names = .stat_names, + .labels = .labels %>% .unlist_keep_nulls(), + .indent_mods = .indent_mods %>% .unlist_keep_nulls(), .cell_footnotes = cell_fns ) } @@ -233,14 +238,32 @@ surv_time <- function(lyt, show_labels = "visible", table_names = vars, .stats = c("median", "median_ci", "quantiles", "range"), - .formats = NULL, - .labels = NULL, - .indent_mods = c(median_ci = 1L)) { - extra_args <- list( - .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, - is_event = is_event, control = control, ref_fn_censor = ref_fn_censor, ... + .stat_names = NULL, + .formats = list( + median_ci = "(xx.x, xx.x)", quantiles = "xx.x, xx.x", range = "xx.x to xx.x", + quantiles_lower = "xx.x (xx.x - xx.x)", quantiles_upper = "xx.x (xx.x - xx.x)", + median_ci_3d = "xx.x (xx.x - xx.x)" + ), + .labels = list(median_ci = "95% CI", range = "Range"), + .indent_mods = list(median_ci = 1L)) { + # 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, + is_event = is_event, control = list(control), ref_fn_censor = ref_fn_censor, + ... ) + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_surv_time) <- c(formals(a_surv_time), extra_args[[".additional_fun_parameters"]]) + analyze( lyt = lyt, vars = vars, diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index fb11f5ab9f..ce785b1253 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -662,6 +662,8 @@ tern_default_labels <- c( quantiles_lower = "25%-ile (95% CI)", quantiles_upper = "75%-ile (95% CI)", range = "Min - Max", + range_censor = "Range (censored)", + range_event = "Range (event)", rate = "Adjusted Rate", rate_ratio = "Adjusted Rate Ratio", sd = "SD", diff --git a/tests/testthat/_snaps/survival_time.md b/tests/testthat/_snaps/survival_time.md index 10d0453dce..e0325a1c54 100644 --- a/tests/testthat/_snaps/survival_time.md +++ b/tests/testthat/_snaps/survival_time.md @@ -107,16 +107,16 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 Median 24.8 0 Median - 2 95% CI (21.1, 31.3) 0 95% CI - 3 Median (95% CI) 24.8 (21.1 - 31.3) 0 Median (95% CI) - 4 25% and 75%-ile 10.8, 47.6 0 25% and 75%-ile - 5 25%-ile (95% CI) 10.8 (6.6 - 13.4) 0 25%-ile (95% CI) - 6 75%-ile (95% CI) 47.6 (39.3 - 57.8) 0 75%-ile (95% CI) - 7 Range (censored) 0.8 to 78.9 0 Range (censored) - 8 Range (event) 0.1 to 155.5 0 Range (event) - 9 Range 0.1 to 155.5 0 Range + row_name formatted_cell indent_mod row_label + 1 median 24.8 0 Median + 2 median_ci (21.10, 31.35) 0 Median 95% CI + 3 median_ci_3d 24.76 (21.10 - 31.35) 0 Median (95% CI) + 4 quantiles 10.8 - 47.6 0 25% and 75%-ile + 5 quantiles_lower 10.81 (6.65 - 13.43) 0 25%-ile (95% CI) + 6 quantiles_upper 47.60 (39.27 - 57.82) 0 75%-ile (95% CI) + 7 range_censor 0.8 to 78.9 0 Range (censored) + 8 range_event 0.1 to 155.5 0 Range (event) + 9 range 0.1 - 155.5 0 Min - Max # a_surv_time works with customized arguments @@ -125,10 +125,10 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 median conf int (13.591239860, 37.970548966) 3 median conf int - 2 20% and 80%-ile 6.65 / 51.09 0 20% and 80%-ile - 3 Range 0.1 to 154.1 0 Range + row_name formatted_cell indent_mod row_label + 1 median_ci 13.59 / 37.97 3 median conf int + 2 quantiles 6.65 / 51.09 0 20% and 80%-ile + 3 range 0.1 - 154.1 0 Min - Max # surv_time works with default arguments @@ -148,18 +148,18 @@ Code res Output - ARM A ARM B ARM C - ————————————————————————————————————————————————————————————————————————————————————— - Survival Time (Months) - Median 32.0 23.9 20.8 - 90% CI (25.6, 49.3) (18.9, 32.1) (13.0, 26.0) - Median (90% CI) 32.0 (25.6 - 49.3) 23.9 (18.9 - 32.1) 20.8 (13.0 - 26.0) - 40% and 60%-ile 25.6, 46.5 18.3, 29.2 13.0, 25.7 - 40%-ile (90% CI) 25.6 (20.7 - 33.4) 18.3 (12.8 - 23.9) 13.0 (10.1 - 24.8) - 60%-ile (90% CI) 46.5 (32.0 - 57.8) 29.2 (23.9 - 41.3) 25.7 (20.8 - 37.1) - Range (censored) 0.8 to 63.5 6.2 to 78.9 3.4 to 52.4 - Range (event) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 - Range 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 + ARM A ARM B ARM C + ——————————————————————————————————————————————————————————————————————————————————————————————————————————————————— + Survival Time (Months) + Median 32.0 23.9 20.8 + 90% CI (25.557055515, 49.309164814) (18.861684287, 32.147869886) (12.954083786, 26.023348062) + Median (90% CI) 32.02 (25.56 - 49.31) 23.91 (18.86 - 32.15) 20.77 (12.95 - 26.02) + 40% and 60%-ile 25.6 - 46.5 18.3 - 29.2 13.0 - 25.7 + 40%-ile (90% CI) 25.56 (20.73 - 33.39) 18.26 (12.77 - 23.91) 12.95 (10.10 - 24.76) + 60%-ile (90% CI) 46.51 (32.02 - 57.82) 29.19 (23.91 - 41.30) 25.75 (20.77 - 37.10) + Range (censored) 0.8 to 63.5 6.2 to 78.9 3.4 to 52.4 + Range (event) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 + Range 0.3 - 155.5 0.1 - 154.1 0.6 - 80.7 # surv_time works with referential footnotes diff --git a/tests/testthat/test-survival_time.R b/tests/testthat/test-survival_time.R index 4ee7c16de6..e2d3635889 100644 --- a/tests/testthat/test-survival_time.R +++ b/tests/testthat/test-survival_time.R @@ -49,7 +49,9 @@ testthat::test_that("a_surv_time works with default arguments", { adtte_f, .df_row = df, .var = "AVAL", - is_event = "is_event" + is_event = "is_event", + control = control_surv_time(), + ref_fn_censor = TRUE ) res <- testthat::expect_silent(result) @@ -72,9 +74,9 @@ testthat::test_that("a_surv_time works with customized arguments", { control = control_surv_time( conf_level = 0.99, conf_type = "log-log", quantiles = c(0.2, 0.8) ), - .df_row = adtte_f, + ref_fn_censor = TRUE, .stats = c("median_ci", "quantiles", "range"), - .formats = c(median_ci = "auto", quantiles = "xx.xx / xx.xx"), + .formats = c(median_ci = "xx.xx / xx.xx", quantiles = "xx.xx / xx.xx"), .labels = c(median_ci = "median conf int"), .indent_mods = c(median_ci = 3L) ) @@ -121,6 +123,7 @@ testthat::test_that("surv_time works with customized arguments", { var_labels = "Survival Time (Months)", is_event = "is_event", .stats = get_stats("surv_time"), + .formats = list(median_ci = "auto"), control = control_surv_time(conf_level = 0.9, conf_type = "log", quantiles = c(0.4, 0.6)) ) %>% build_table(df = adtte_f) @@ -162,7 +165,15 @@ testthat::test_that("a_surv_time works when `is_event` only has TRUE observation ) testthat::expect_silent( - tern::a_surv_time(anl, .var = "AVAL", is_event = "is_event") + tern::a_surv_time( + anl, + .var = "AVAL", + is_event = "is_event", + control = control_surv_time( + conf_level = 0.99, conf_type = "log-log", quantiles = c(0.2, 0.8) + ), + ref_fn_censor = TRUE + ) ) }) @@ -174,6 +185,14 @@ testthat::test_that("a_surv_time works when `is_event` only has FALSE observatio ) testthat::expect_silent( - tern::a_surv_time(anl, .var = "AVAL", is_event = "is_event") + tern::a_surv_time( + anl, + .var = "AVAL", + is_event = "is_event", + control = control_surv_time( + conf_level = 0.99, conf_type = "log-log", quantiles = c(0.2, 0.8) + ), + ref_fn_censor = TRUE + ) ) }) From e62247e0baa0c65b9db0edad3febe898febfe380 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 14:13:51 -0500 Subject: [PATCH 27/41] Revert tabulate stuff --- NEWS.md | 1 - R/h_biomarkers_subgroups.R | 76 ++++--- R/h_response_biomarkers_subgroups.R | 10 +- R/h_survival_biomarkers_subgroups.R | 4 +- R/response_biomarkers_subgroups.R | 7 +- R/response_subgroups.R | 20 +- R/survival_duration_subgroups.R | 185 +++++++----------- R/utils_default_stats_formats_labels.R | 4 +- .../_snaps/survival_duration_subgroups.md | 13 +- .../test-survival_duration_subgroups.R | 13 +- 10 files changed, 135 insertions(+), 198 deletions(-) diff --git a/NEWS.md b/NEWS.md index 58d1f88f22..f04a9f68fc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,7 +14,6 @@ * Removed internal function `ungroup_stats()` and replaced its usage with the `get_*_from_stats()` functions. * Began deprecation of the unused `table_names` argument to `count_abnormal_lab_worsen_by_baseline()`. * Added warnings for `geom_mean` statistical output. -* Began deprecation of the unused `label_all` parameter to `tabulate_rsp_subgroups()`, with redirection to the same parameter in `extract_rsp_subgroups()`. * Updated documentation to remove suggestions to use `make_afun()`. # tern 0.9.7 diff --git a/R/h_biomarkers_subgroups.R b/R/h_biomarkers_subgroups.R index 5f6fd007d6..ebbb3e94f4 100644 --- a/R/h_biomarkers_subgroups.R +++ b/R/h_biomarkers_subgroups.R @@ -17,79 +17,69 @@ h_tab_one_biomarker <- function(df, afuns, colvars, na_str = default_na_str(), - ..., - .stats = NULL, - .stat_names = NULL, - .formats = NULL, - .labels = NULL, - .indent_mods = NULL) { - # 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, biomarker = TRUE, ...) - - # Adding additional info from layout to analysis function - extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) - formals(afuns) <- c(formals(afuns), extra_args[[".additional_fun_parameters"]]) + .indent_mods = 0L, + ...) { + extra_args <- list(...) # Create "ci" column from "lcl" and "ucl" df$ci <- combine_vectors(df$lcl, df$ucl) - colvars$vars <- intersect(colvars$vars, names(df)) - colvars$labels <- colvars$labels[colvars$vars] - lyt <- basic_table() - # Split cols by the multiple variables to populate into columns. - lyt <- split_cols_by_multivar( - lyt = lyt, - vars = colvars$vars, - varlabels = colvars$labels - ) - - # Add "All Patients" row + # Row split by row type - only keep the content rows here. lyt <- split_rows_by( lyt = lyt, var = "row_type", split_fun = keep_split_levels("content"), - nested = TRUE, - child_labels = "hidden" + nested = FALSE ) - lyt <- analyze_colvars( + + # Summarize rows with all patients. + lyt <- summarize_row_groups( lyt = lyt, - afun = afuns, + var = "var_label", + cfun = afuns, na_str = na_str, - extra_args = c(extra_args) + indent_mod = .indent_mods, + extra_args = extra_args ) - # Add analysis rows + # Split cols by the multiple variables to populate into columns. + lyt <- split_cols_by_multivar( + lyt = lyt, + vars = colvars$vars, + varlabels = colvars$labels + ) + + # If there is any subgroup variables, we extend the layout accordingly. if ("analysis" %in% df$row_type) { + # Now only continue with the subgroup rows. lyt <- split_rows_by( lyt = lyt, var = "row_type", split_fun = keep_split_levels("analysis"), - nested = TRUE, + nested = FALSE, child_labels = "hidden" ) + + # Split by the subgroup variable. lyt <- split_rows_by( lyt = lyt, - var = "var_label", + var = "var", + labels_var = "var_label", nested = TRUE, - indent_mod = 1L + child_labels = "visible", + indent_mod = .indent_mods * 2 ) - lyt <- analyze_colvars( + + # Then analyze colvars for each subgroup. + lyt <- summarize_row_groups( lyt = lyt, - afun = afuns, + cfun = afuns, + var = "subgroup", na_str = na_str, - inclNAs = TRUE, extra_args = extra_args ) } - build_table(lyt, df = df) } diff --git a/R/h_response_biomarkers_subgroups.R b/R/h_response_biomarkers_subgroups.R index 38db27f810..706bf247c0 100644 --- a/R/h_response_biomarkers_subgroups.R +++ b/R/h_response_biomarkers_subgroups.R @@ -202,20 +202,18 @@ h_logistic_mult_cont_df <- function(variables, h_tab_rsp_one_biomarker <- function(df, vars, na_str = default_na_str(), - .indent_mods = 0L, - ...) { + .indent_mods = 0L) { + afuns <- a_response_subgroups(na_str = na_str)[vars] colvars <- d_rsp_subgroups_colvars( vars, conf_level = df$conf_level[1], method = df$pval_label[1] ) - h_tab_one_biomarker( df = df, - afuns = a_response_subgroups, + afuns = afuns, colvars = colvars, na_str = na_str, - .indent_mods = .indent_mods, - ... + .indent_mods = .indent_mods ) } diff --git a/R/h_survival_biomarkers_subgroups.R b/R/h_survival_biomarkers_subgroups.R index 2179bee78b..cb5519b0c9 100644 --- a/R/h_survival_biomarkers_subgroups.R +++ b/R/h_survival_biomarkers_subgroups.R @@ -209,16 +209,16 @@ h_tab_surv_one_biomarker <- function(df, na_str = default_na_str(), .indent_mods = 0L, ...) { + afuns <- a_survival_subgroups(na_str = na_str)[vars] colvars <- d_survival_subgroups_colvars( vars, conf_level = df$conf_level[1], method = df$pval_label[1], time_unit = time_unit ) - h_tab_one_biomarker( df = df, - afuns = a_survival_subgroups, + afuns = afuns, colvars = colvars, na_str = na_str, .indent_mods = .indent_mods, diff --git a/R/response_biomarkers_subgroups.R b/R/response_biomarkers_subgroups.R index b2f7d09c1d..690e71c45c 100644 --- a/R/response_biomarkers_subgroups.R +++ b/R/response_biomarkers_subgroups.R @@ -90,6 +90,10 @@ tabulate_rsp_biomarkers <- function(df, if (!is.null(.labels)) extra_args[[".labels"]] <- .labels if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods + # Create "ci" column from "lcl" and "ucl" + df$ci <- combine_vectors(df$lcl, df$ucl) + + afuns <- a_response_subgroups colvars <- d_rsp_subgroups_colvars( vars, conf_level = df$conf_level[1], @@ -103,9 +107,6 @@ tabulate_rsp_biomarkers <- function(df, extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) formals(a_response_subgroups) <- c(formals(a_response_subgroups), extra_args[[".additional_fun_parameters"]]) - # Create "ci" column from "lcl" and "ucl" - df$ci <- combine_vectors(df$lcl, df$ucl) - df_subs <- split(df, f = df$biomarker) tbls <- lapply( df_subs, diff --git a/R/response_subgroups.R b/R/response_subgroups.R index dc26923910..0826198589 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -142,14 +142,14 @@ a_response_subgroups <- function(df, extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters)) dots_extra_args$.additional_fun_parameters <- NULL cur_stat <- extra_afun_params$.var %||% .stats - var_lvls <- if ("biomarker" %in% names(dots_extra_args) && "biomarker" %in% names(df)) { + var_lvls <- if ("biomarker" %in% names(dots_extra_args)) { if ("overall" %in% names(dots_extra_args)) { as.character(df$biomarker) } else { paste(as.character(df$biomarker), as.character(df$subgroup), sep = ".") } } else { - make.unique(as.character(df$subgroup)) + as.character(df$subgroup) } # if empty, return NA @@ -244,7 +244,7 @@ tabulate_rsp_subgroups <- function(lyt, df, vars = c("n_tot", "n", "prop", "or", "ci"), groups_lists = list(), - label_all = lifecycle::deprecated(), + label_all = "All Patients", riskdiff = NULL, na_str = default_na_str(), ..., @@ -263,14 +263,6 @@ tabulate_rsp_subgroups <- function(lyt, ) } - if (lifecycle::is_present(label_all)) { - lifecycle::deprecate_warn( - "0.9.8", "tabulate_rsp_subgroups(label_all)", - details = - "Please assign the `label_all` parameter within the `extract_rsp_subgroups()` function when creating `df`." - ) - } - # Process standard extra arguments extra_args <- list(".stats" = vars) if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names @@ -281,6 +273,10 @@ tabulate_rsp_subgroups <- function(lyt, # Create "ci" column from "lcl" and "ucl" df$or$ci <- combine_vectors(df$or$lcl, df$or$ucl) + # Fill in missing formats with defaults + default_fmts <- eval(formals(tabulate_rsp_subgroups)$.formats) + .formats <- c(.formats, default_fmts[vars[!vars %in% names(.formats)]]) + # Extract additional parameters from df conf_level <- df$or$conf_level[1] method <- if ("pval_label" %in% names(df$or)) df$or$pval_label[1] else NULL @@ -293,7 +289,7 @@ tabulate_rsp_subgroups <- function(lyt, # Process additional arguments to the statistic function extra_args <- c( extra_args, - groups_lists = list(groups_lists), conf_level = conf_level, method = method, + groups_lists = list(groups_lists), conf_level = conf_level, method = method, label_all = label_all, ... ) diff --git a/R/survival_duration_subgroups.R b/R/survival_duration_subgroups.R index 4cccecb03e..ba6a99e9a7 100644 --- a/R/survival_duration_subgroups.R +++ b/R/survival_duration_subgroups.R @@ -153,67 +153,40 @@ extract_survival_subgroups <- function(variables, #' * `a_survival_subgroups()` returns the corresponding list with formatted [rtables::CellValue()]. #' #' @keywords internal -a_survival_subgroups <- function(df, - labelstr = "", - ..., - .stats = NULL, - .stat_names = NULL, - .formats = NULL, - .labels = 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 - cur_stat <- extra_afun_params$.var %||% .stats - var_lvls <- if ("biomarker" %in% names(dots_extra_args) && "biomarker" %in% names(df)) { - if ("overall" %in% names(dots_extra_args)) { - as.character(df$biomarker) - } else { - paste(as.character(df$biomarker), as.character(df$subgroup), sep = ".") - } - } else { - make.unique(as.character(df$subgroup)) - } - - # if empty, return NA - if (nrow(df) == 0) { - return(in_rows(.list = list(NA) %>% stats::setNames(cur_stat))) - } - - # Main statistics taken from df - x_stats <- as.list(df) - - # Fill in formatting defaults - .stats <- get_stats("tabulate_survival_subgroups", stats_in = cur_stat) - levels_per_stats <- rep(list(var_lvls), length(.stats)) %>% setNames(.stats) - .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) - .labels <- get_labels_from_stats( - .stats, .labels, levels_per_stats, - tern_defaults = as.list(as.character(df$subgroup)) %>% setNames(var_lvls) +a_survival_subgroups <- function(.formats = list( # nolint start + n = "xx", + n_events = "xx", + n_tot_events = "xx", + median = "xx.x", + n_tot = "xx", + hr = list(format_extreme_values(2L)), + ci = list(format_extreme_values_ci(2L)), + pval = "x.xxxx | (<0.0001)" + ), + na_str = default_na_str()) { # nolint end + checkmate::assert_list(.formats) + checkmate::assert_subset( + names(.formats), + c("n", "n_events", "median", "n_tot", "n_tot_events", "hr", "ci", "pval", "riskdiff") ) - .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - - x_stats <- lapply( - .stats, - function(x) x_stats[[x]] %>% stats::setNames(var_lvls) - ) %>% - stats::setNames(.stats) - - # Auto format handling - .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 %>% .unlist_keep_nulls(), - .formats = .formats, - .names = names(.labels), - .stat_names = .stat_names, - .labels = .labels %>% .unlist_keep_nulls(), - .indent_mods = .indent_mods %>% .unlist_keep_nulls() + afun_lst <- Map( + function(stat, fmt, na_str) { + function(df, labelstr = "", ...) { + in_rows( + .list = as.list(df[[stat]]), + .labels = as.character(df$subgroup), + .formats = fmt, + .format_na_strs = na_str + ) + } + }, + stat = names(.formats), + fmt = .formats, + na_str = na_str ) + + afun_lst } #' @describeIn survival_duration_subgroups Table-creating function which creates a table @@ -252,22 +225,14 @@ tabulate_survival_subgroups <- function(lyt, time_unit = NULL, riskdiff = NULL, na_str = default_na_str(), - ..., - .stat_names = NULL, - .formats = NULL, - .labels = NULL, - .indent_mods = NULL) { + .formats = c( + n = "xx", n_events = "xx", n_tot_events = "xx", median = "xx.x", n_tot = "xx", + hr = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), + pval = "x.xxxx | (<0.0001)" + )) { checkmate::assert_list(riskdiff, null.ok = TRUE) checkmate::assert_true(any(c("n_tot", "n_tot_events") %in% vars)) checkmate::assert_true(all(c("hr", "ci") %in% vars)) - if ("pval" %in% vars && !"pval" %in% names(df$hr)) { - warning( - 'The "pval" statistic has been selected but is not present in "df" so it will not be included in the output ', - 'table. To include the "pval" statistic, please specify a p-value test when generating "df" via ', - 'the "method" argument to `extract_survival_subgroups()`. If method = "cmh", strata must also be specified via ', - 'the "variables" argument to `extract_survival_subgroups()`.' - ) - } if (lifecycle::is_present(label_all)) { lifecycle::deprecate_warn( @@ -277,35 +242,26 @@ tabulate_survival_subgroups <- function(lyt, ) } - # Process standard extra arguments - extra_args <- list(".stats" = vars) - 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 - # Create "ci" column from "lcl" and "ucl" df$hr$ci <- combine_vectors(df$hr$lcl, df$hr$ucl) + # Fill in missing formats with defaults + default_fmts <- eval(formals(tabulate_survival_subgroups)$.formats) + .formats <- c(.formats, default_fmts[vars[!vars %in% names(.formats)]]) + # Extract additional parameters from df conf_level <- df$hr$conf_level[1] - method <- if ("pval_label" %in% names(df$hr)) df$hr$pval_label[1] else NULL + method <- df$hr$pval_label[1] colvars <- d_survival_subgroups_colvars(vars, conf_level = conf_level, method = method, time_unit = time_unit) survtime_vars <- intersect(colvars$vars, c("n", "n_events", "median")) hr_vars <- intersect(names(colvars$labels), c("n_tot", "n_tot_events", "hr", "ci", "pval")) colvars_survtime <- list(vars = survtime_vars, labels = colvars$labels[survtime_vars]) colvars_hr <- list(vars = hr_vars, labels = colvars$labels[hr_vars]) - # Process additional arguments to the statistic function - extra_args <- c( - extra_args, - groups_lists = list(groups_lists), conf_level = conf_level, method = method, - ... - ) + extra_args <- list(groups_lists = groups_lists, conf_level = conf_level, method = method) - # Adding additional info from layout to analysis function - extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) - formals(a_survival_subgroups) <- c(formals(a_survival_subgroups), extra_args[[".additional_fun_parameters"]]) + # Get analysis function for each statistic + afun_lst <- a_survival_subgroups(.formats = c(.formats, riskdiff = riskdiff$format), na_str = na_str) # Add risk difference column if (!is.null(riskdiff)) { @@ -344,26 +300,26 @@ tabulate_survival_subgroups <- function(lyt, # Add columns from table_survtime (optional) if (length(colvars_survtime$vars) > 0) { lyt_survtime <- split_cols_by(lyt = lyt, var = "arm") - lyt_survtime <- split_cols_by_multivar( - lyt = lyt_survtime, - vars = colvars_survtime$vars, - varlabels = colvars_survtime$labels - ) - - # Add "All Patients" row lyt_survtime <- split_rows_by( lyt = lyt_survtime, var = "row_type", split_fun = keep_split_levels("content"), - nested = FALSE, - child_labels = "hidden" + nested = FALSE ) - lyt_survtime <- analyze_colvars( + + # Add "All Patients" row + lyt_survtime <- summarize_row_groups( lyt = lyt_survtime, - afun = a_survival_subgroups, + var = "var_label", + cfun = afun_lst[names(colvars_survtime$labels)], na_str = na_str, extra_args = extra_args ) + lyt_survtime <- split_cols_by_multivar( + lyt = lyt_survtime, + vars = colvars_survtime$vars, + varlabels = colvars_survtime$labels + ) # Add analysis rows if ("analysis" %in% df$survtime$row_type) { @@ -377,7 +333,7 @@ tabulate_survival_subgroups <- function(lyt, lyt_survtime <- split_rows_by(lyt = lyt_survtime, var = "var_label", nested = TRUE) lyt_survtime <- analyze_colvars( lyt = lyt_survtime, - afun = a_survival_subgroups, + afun = afun_lst[names(colvars_survtime$labels)], na_str = na_str, inclNAs = TRUE, extra_args = extra_args @@ -389,27 +345,25 @@ tabulate_survival_subgroups <- function(lyt, table_survtime <- NULL } - # Add columns from table_hr ("n_tot_events" or "n_tot", "hr" and "ci" required) + # Add columns from table_hr ("n_tot_events" or "n_tot", "or" and "ci" required) lyt_hr <- split_cols_by(lyt = lyt, var = "arm") - lyt_hr <- split_cols_by_multivar( - lyt = lyt_hr, - vars = colvars_hr$vars, - varlabels = colvars_hr$labels - ) - - # Add "All Patients" row lyt_hr <- split_rows_by( lyt = lyt_hr, var = "row_type", split_fun = keep_split_levels("content"), - nested = FALSE, - child_labels = "hidden" + nested = FALSE ) - lyt_hr <- analyze_colvars( + lyt_hr <- summarize_row_groups( lyt = lyt_hr, - afun = a_survival_subgroups, + var = "var_label", + cfun = afun_lst[names(colvars_hr$labels)], na_str = na_str, extra_args = extra_args + ) + lyt_hr <- split_cols_by_multivar( + lyt = lyt_hr, + vars = colvars_hr$vars, + varlabels = colvars_hr$labels ) %>% append_topleft("Baseline Risk Factors") @@ -425,7 +379,7 @@ tabulate_survival_subgroups <- function(lyt, lyt_hr <- split_rows_by(lyt = lyt_hr, var = "var_label", nested = TRUE) lyt_hr <- analyze_colvars( lyt = lyt_hr, - afun = a_survival_subgroups, + afun = afun_lst[names(colvars_hr$labels)], na_str = na_str, inclNAs = TRUE, extra_args = extra_args @@ -502,6 +456,11 @@ d_survival_subgroups_colvars <- function(vars, colvars <- vars + # The `lcl` variable is just a placeholder available in the analysis data, + # it is not acutally used in the tabulation. + # Variables used in the tabulation are lcl and ucl, see `a_survival_subgroups` for details. + colvars[colvars == "ci"] <- "lcl" + list( vars = colvars, labels = varlabels[vars] diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index ce785b1253..3ae94d7244 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -542,7 +542,7 @@ tern_default_stats <- list( tabulate_rsp_biomarkers = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"), tabulate_rsp_subgroups = c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval", "riskdiff"), tabulate_survival_biomarkers = c("n_tot", "n_tot_events", "median", "hr", "ci", "pval"), - tabulate_survival_subgroups = c("n_tot_events", "n_events", "n_tot", "n", "median", "hr", "ci", "pval", "riskdiff"), + tabulate_survival_subgroups = c("n_tot_events", "n_events", "n_tot", "n", "median", "hr", "ci", "pval"), test_proportion_diff = c("pval") ) @@ -567,7 +567,6 @@ tern_default_formats <- c( geom_mean_ci_3d = "xx.xx (xx.xx - xx.xx)", geom_mean_sd = "xx.x (xx.x)", geom_sd = "xx.x", - hr = list(format_extreme_values(2L)), iqr = "xx.x", lsmean = "xx.xx", lsmean_diff = "xx.xx", @@ -594,7 +593,6 @@ tern_default_formats <- c( n_rate = "xx (xx.x)", n_rsp = "xx", n_tot = "xx", - n_tot_events = "xx", n_unique = "xx", nonunique = "xx", or = list(format_extreme_values(2L)), diff --git a/tests/testthat/_snaps/survival_duration_subgroups.md b/tests/testthat/_snaps/survival_duration_subgroups.md index 61f7a355ac..8bdd934c88 100644 --- a/tests/testthat/_snaps/survival_duration_subgroups.md +++ b/tests/testthat/_snaps/survival_duration_subgroups.md @@ -85,13 +85,10 @@ Code res Output - RowsVerticalSection (in_rows) object print method: - ---------------------------- - row_name formatted_cell indent_mod row_label - 1 hr.M 0.12 2 M - HR - 2 hr.F 0.57 3 Female - 3 pval.M <0.0001 2 Male - 4 pval.F 1.3023 3 Female + hr pval + —————————————————— + M 0.12 <0.0001 + F 0.57 1.3023 # tabulate_survival_subgroups functions as expected with valid input @@ -198,7 +195,7 @@ Output $vars [1] "n" "n_events" "median" "n_tot_events" "hr" - [6] "ci" "pval" + [6] "lcl" "pval" $labels n n_events median diff --git a/tests/testthat/test-survival_duration_subgroups.R b/tests/testthat/test-survival_duration_subgroups.R index 7ca2b8c555..7c63ea6f1a 100644 --- a/tests/testthat/test-survival_duration_subgroups.R +++ b/tests/testthat/test-survival_duration_subgroups.R @@ -76,13 +76,12 @@ testthat::test_that("a_survival_subgroups functions as expected with valid input stringsAsFactors = FALSE ) - result <- a_survival_subgroups( - df, - .stats = c("hr", "pval"), - .formats = list(hr = "xx.xx", pval = "x.xxxx | (<0.0001)"), - .labels = list(hr.M = "M - HR", "M" = "Male", "F" = "Female"), - .indent_mods = c("M" = 2L, "F" = 3L) - ) + afun <- a_survival_subgroups(.formats = list("hr" = "xx.xx", pval = "x.xxxx | (<0.0001)")) + + result <- basic_table() %>% + split_cols_by_multivar(c("hr", "pval")) %>% + analyze_colvars(afun) %>% + build_table(df) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) From 5c48d6f105b45ef61f2b8b2b6cefecd9b6728ae4 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 14:15:00 -0500 Subject: [PATCH 28/41] Revert more tabulate stuff --- R/response_biomarkers_subgroups.R | 101 +++----------------- R/response_subgroups.R | 26 ++--- tests/testthat/_snaps/response_subgroups.md | 2 +- 3 files changed, 22 insertions(+), 107 deletions(-) diff --git a/R/response_biomarkers_subgroups.R b/R/response_biomarkers_subgroups.R index 690e71c45c..b18ad598ae 100644 --- a/R/response_biomarkers_subgroups.R +++ b/R/response_biomarkers_subgroups.R @@ -73,103 +73,28 @@ tabulate_rsp_biomarkers <- function(df, vars = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"), na_str = default_na_str(), - ..., - .stat_names = NULL, - .formats = NULL, - .labels = NULL, - .indent_mods = NULL) { + .indent_mods = 0L) { checkmate::assert_data_frame(df) checkmate::assert_character(df$biomarker) checkmate::assert_character(df$biomarker_label) checkmate::assert_subset(vars, get_stats("tabulate_rsp_biomarkers")) - # Process standard extra arguments - extra_args <- list(".stats" = vars) - 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 - # Create "ci" column from "lcl" and "ucl" df$ci <- combine_vectors(df$lcl, df$ucl) - afuns <- a_response_subgroups - colvars <- d_rsp_subgroups_colvars( - vars, - conf_level = df$conf_level[1], - method = df$pval_label[1] - ) - - # Process additional arguments to the statistic function - extra_args <- c(extra_args, biomarker = TRUE, ...) - - # Adding additional info from layout to analysis function - extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) - formals(a_response_subgroups) <- c(formals(a_response_subgroups), extra_args[[".additional_fun_parameters"]]) - df_subs <- split(df, f = df$biomarker) - tbls <- lapply( - df_subs, - function(df) { - lyt <- basic_table() - - # Split cols by the multiple variables to populate into columns. - lyt <- split_cols_by_multivar( - lyt = lyt, - vars = colvars$vars, - varlabels = colvars$labels - ) - - # Row split by biomarker - lyt <- split_rows_by( - lyt = lyt, - var = "biomarker_label", - nested = FALSE - ) - - # Add "All Patients" row - lyt <- split_rows_by( - lyt = lyt, - var = "row_type", - split_fun = keep_split_levels("content"), - nested = TRUE, - child_labels = "hidden" - ) - lyt <- analyze_colvars( - lyt = lyt, - afun = a_response_subgroups, - na_str = na_str, - extra_args = c(extra_args, overall = TRUE) - ) - - # Add analysis rows - if ("analysis" %in% df$row_type) { - lyt <- split_rows_by( - lyt = lyt, - var = "row_type", - split_fun = keep_split_levels("analysis"), - nested = TRUE, - child_labels = "hidden" - ) - lyt <- split_rows_by( - lyt = lyt, - var = "var_label", - nested = TRUE, - indent_mod = 1L - ) - lyt <- analyze_colvars( - lyt = lyt, - afun = a_response_subgroups, - na_str = na_str, - inclNAs = TRUE, - extra_args = extra_args - ) - } - build_table(lyt, df = df) - } - ) - - result <- do.call(rbind, tbls) + tabs <- lapply(df_subs, FUN = function(df_sub) { + tab_sub <- h_tab_rsp_one_biomarker( + df = df_sub, + vars = vars, + na_str = na_str, + .indent_mods = .indent_mods + ) + # Insert label row as first row in table. + label_at_path(tab_sub, path = row_paths(tab_sub)[[1]][1]) <- df_sub$biomarker_label[1] + tab_sub + }) + result <- do.call(rbind, tabs) n_id <- grep("n_tot", vars) or_id <- match("or", vars) diff --git a/R/response_subgroups.R b/R/response_subgroups.R index 0826198589..4c994fe89c 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -142,20 +142,7 @@ a_response_subgroups <- function(df, extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters)) dots_extra_args$.additional_fun_parameters <- NULL cur_stat <- extra_afun_params$.var %||% .stats - var_lvls <- if ("biomarker" %in% names(dots_extra_args)) { - if ("overall" %in% names(dots_extra_args)) { - as.character(df$biomarker) - } else { - paste(as.character(df$biomarker), as.character(df$subgroup), sep = ".") - } - } else { - as.character(df$subgroup) - } - - # if empty, return NA - if (nrow(df) == 0) { - return(in_rows(.list = list(NA) %>% stats::setNames(cur_stat))) - } + var_lvls <- as.character(df$subgroup) # Main statistics taken from df x_stats <- as.list(df) @@ -166,7 +153,7 @@ a_response_subgroups <- function(df, .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) .labels <- get_labels_from_stats( .stats, .labels, levels_per_stats, - tern_defaults = as.list(as.character(df$subgroup)) %>% setNames(var_lvls) + tern_defaults = as.list(var_lvls) %>% setNames(var_lvls) ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) @@ -176,8 +163,6 @@ a_response_subgroups <- function(df, ) %>% stats::setNames(.stats) - .nms <- if ("biomarker" %in% names(dots_extra_args)) var_lvls else names(.labels) - # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -187,7 +172,7 @@ a_response_subgroups <- function(df, in_rows( .list = x_stats %>% .unlist_keep_nulls(), .formats = .formats, - .names = .nms, + .names = names(.labels), .stat_names = .stat_names, .labels = .labels %>% .unlist_keep_nulls(), .indent_mods = .indent_mods %>% .unlist_keep_nulls() @@ -483,6 +468,11 @@ d_rsp_subgroups_colvars <- function(vars, varlabels, ci = paste0(100 * conf_level, "% CI") ) + + # The `lcl`` variable is just a placeholder available in the analysis data, + # it is not acutally used in the tabulation. + # Variables used in the tabulation are lcl and ucl, see `a_response_subgroups` for details. + colvars[colvars == "ci"] <- "lcl" } if ("pval" %in% colvars) { diff --git a/tests/testthat/_snaps/response_subgroups.md b/tests/testthat/_snaps/response_subgroups.md index 853098f6e8..a4cd49993a 100644 --- a/tests/testthat/_snaps/response_subgroups.md +++ b/tests/testthat/_snaps/response_subgroups.md @@ -229,7 +229,7 @@ res Output $vars - [1] "n" "n_rsp" "prop" "n_tot" "or" "ci" "pval" + [1] "n" "n_rsp" "prop" "n_tot" "or" "lcl" "pval" $labels n n_rsp From 86b9f5872e958ba0fad184fc7b1042f85d197cf0 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 14:16:46 -0500 Subject: [PATCH 29/41] Revert more tabulate stuff --- R/response_subgroups.R | 113 ++++++++------------ tests/testthat/_snaps/response_subgroups.md | 11 +- tests/testthat/test-response_subgroups.R | 13 ++- 3 files changed, 53 insertions(+), 84 deletions(-) diff --git a/R/response_subgroups.R b/R/response_subgroups.R index 4c994fe89c..7185faf393 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -129,54 +129,40 @@ extract_rsp_subgroups <- function(variables, #' * `a_response_subgroups()` returns the corresponding list with formatted [rtables::CellValue()]. #' #' @keywords internal -a_response_subgroups <- function(df, - labelstr = "", - ..., - .stats = NULL, - .stat_names = NULL, - .formats = NULL, - .labels = 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 - cur_stat <- extra_afun_params$.var %||% .stats - var_lvls <- as.character(df$subgroup) - - # Main statistics taken from df - x_stats <- as.list(df) - - # Fill in formatting defaults - .stats <- get_stats("tabulate_rsp_subgroups", stats_in = cur_stat) - levels_per_stats <- rep(list(var_lvls), length(.stats)) %>% setNames(.stats) - .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) - .labels <- get_labels_from_stats( - .stats, .labels, levels_per_stats, - tern_defaults = as.list(var_lvls) %>% setNames(var_lvls) +a_response_subgroups <- function(.formats = list( + n = "xx", # nolint start + n_rsp = "xx", + prop = "xx.x%", + n_tot = "xx", + or = list(format_extreme_values(2L)), + ci = list(format_extreme_values_ci(2L)), + pval = "x.xxxx | (<0.0001)", + riskdiff = "xx.x (xx.x - xx.x)" # nolint end + ), + na_str = default_na_str()) { + checkmate::assert_list(.formats) + checkmate::assert_subset( + names(.formats), + c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval", "riskdiff") ) - .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - - x_stats <- lapply( - .stats, - function(x) x_stats[[x]] %>% stats::setNames(var_lvls) - ) %>% - stats::setNames(.stats) - - # Auto format handling - .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 %>% .unlist_keep_nulls(), - .formats = .formats, - .names = names(.labels), - .stat_names = .stat_names, - .labels = .labels %>% .unlist_keep_nulls(), - .indent_mods = .indent_mods %>% .unlist_keep_nulls() + afun_lst <- Map( + function(stat, fmt, na_str) { + function(df, labelstr = "", ...) { + in_rows( + .list = as.list(df[[stat]]), + .labels = as.character(df$subgroup), + .formats = fmt, + .format_na_strs = na_str + ) + } + }, + stat = names(.formats), + fmt = .formats, + na_str = na_str ) + + afun_lst } #' @describeIn response_subgroups Table-creating function which creates a table @@ -232,11 +218,11 @@ tabulate_rsp_subgroups <- function(lyt, label_all = "All Patients", riskdiff = NULL, na_str = default_na_str(), - ..., - .stat_names = NULL, - .formats = NULL, - .labels = NULL, - .indent_mods = NULL) { + .formats = c( + n = "xx", n_rsp = "xx", prop = "xx.x%", n_tot = "xx", + or = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), + pval = "x.xxxx | (<0.0001)" + )) { checkmate::assert_list(riskdiff, null.ok = TRUE) checkmate::assert_true(all(c("n_tot", "or", "ci") %in% vars)) if ("pval" %in% vars && !"pval" %in% names(df$or)) { @@ -248,13 +234,6 @@ tabulate_rsp_subgroups <- function(lyt, ) } - # Process standard extra arguments - extra_args <- list(".stats" = vars) - 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 - # Create "ci" column from "lcl" and "ucl" df$or$ci <- combine_vectors(df$or$lcl, df$or$ucl) @@ -271,16 +250,10 @@ tabulate_rsp_subgroups <- function(lyt, colvars_prop <- list(vars = prop_vars, labels = colvars$labels[prop_vars]) colvars_or <- list(vars = or_vars, labels = colvars$labels[or_vars]) - # Process additional arguments to the statistic function - extra_args <- c( - extra_args, - groups_lists = list(groups_lists), conf_level = conf_level, method = method, label_all = label_all, - ... - ) + extra_args <- list(groups_lists = groups_lists, conf_level = conf_level, method = method, label_all = label_all) - # Adding additional info from layout to analysis function - extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) - formals(a_response_subgroups) <- c(formals(a_response_subgroups), extra_args[[".additional_fun_parameters"]]) + # Get analysis function for each statistic + afun_lst <- a_response_subgroups(.formats = c(.formats, riskdiff = riskdiff$format), na_str = na_str) # Add risk difference column if (!is.null(riskdiff)) { @@ -335,7 +308,7 @@ tabulate_rsp_subgroups <- function(lyt, ) lyt_prop <- analyze_colvars( lyt = lyt_prop, - afun = a_response_subgroups, + afun = afun_lst[names(colvars_prop$labels)], na_str = na_str, extra_args = extra_args ) @@ -352,7 +325,7 @@ tabulate_rsp_subgroups <- function(lyt, lyt_prop <- split_rows_by(lyt = lyt_prop, var = "var_label", nested = TRUE) lyt_prop <- analyze_colvars( lyt = lyt_prop, - afun = a_response_subgroups, + afun = afun_lst[names(colvars_prop$labels)], na_str = na_str, inclNAs = TRUE, extra_args = extra_args @@ -382,7 +355,7 @@ tabulate_rsp_subgroups <- function(lyt, ) lyt_or <- analyze_colvars( lyt = lyt_or, - afun = a_response_subgroups, + afun = afun_lst[names(colvars_or$labels)], na_str = na_str, extra_args = extra_args ) %>% @@ -400,7 +373,7 @@ tabulate_rsp_subgroups <- function(lyt, lyt_or <- split_rows_by(lyt = lyt_or, var = "var_label", nested = TRUE) lyt_or <- analyze_colvars( lyt = lyt_or, - afun = a_response_subgroups, + afun = afun_lst[names(colvars_or$labels)], na_str = na_str, inclNAs = TRUE, extra_args = extra_args diff --git a/tests/testthat/_snaps/response_subgroups.md b/tests/testthat/_snaps/response_subgroups.md index a4cd49993a..5b019e9718 100644 --- a/tests/testthat/_snaps/response_subgroups.md +++ b/tests/testthat/_snaps/response_subgroups.md @@ -129,13 +129,10 @@ Code res Output - RowsVerticalSection (in_rows) object print method: - ---------------------------- - row_name formatted_cell indent_mod row_label - 1 prop.M 0.12 2 M - proportion - 2 prop.F 0.57 3 Female - 3 pval.M <0.0001 2 Male - 4 pval.F 0.9838 3 Female + prop pval + —————————————————— + M 0.12 <0.0001 + F 0.57 0.9838 # tabulate_rsp_subgroups functions as expected with valid input diff --git a/tests/testthat/test-response_subgroups.R b/tests/testthat/test-response_subgroups.R index d8860a6dea..268d966e54 100644 --- a/tests/testthat/test-response_subgroups.R +++ b/tests/testthat/test-response_subgroups.R @@ -93,13 +93,12 @@ testthat::test_that("a_response_subgroups functions as expected with valid input stringsAsFactors = FALSE ) - result <- a_response_subgroups( - df, - .stats = c("prop", "pval"), - .formats = list(prop = "xx.xx", pval = "x.xxxx | (<0.0001)"), - .labels = list(prop.M = "M - proportion", "M" = "Male", "F" = "Female"), - .indent_mods = c("M" = 2L, "F" = 3L) - ) + afun <- a_response_subgroups(.formats = list(prop = "xx.xx", pval = "x.xxxx | (<0.0001)")) + + result <- basic_table() %>% + split_cols_by_multivar(c("prop", "pval")) %>% + analyze_colvars(afun) %>% + build_table(df) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) From dbfc7388d35695818da2ae95b3c9a22d9805caf8 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 14:19:13 -0500 Subject: [PATCH 30/41] Revert more tabulate stuff --- NEWS.md | 2 +- man/response_subgroups.Rd | 38 +++++++----------------------- man/survival_duration_subgroups.Rd | 36 ++++++---------------------- man/survival_time.Rd | 26 ++++++++++---------- 4 files changed, 29 insertions(+), 73 deletions(-) diff --git a/NEWS.md b/NEWS.md index f04a9f68fc..28e10a454d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,7 +3,7 @@ ### Enhancements * Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, `count_abnormal_lab_worsen_by_baseline()`, `summarize_ancova()`, `summarize_glm_count()`, and `summarize_num_patients()` to work without `make_afun()`. * Added `geom_sd` and `geom_mean_sd` to `s_summary()` default available statistics. -* Refactored `afun_riskdiff()`, `count_occurrences()`, `count_occurrences_by_grade()`, `count_patients_with_event()`, `count_patients_with_flags()`, `count_values()`, `estimate_incidence_rate()`, `summarize_change()`, `summarize_patients_exposure_in_cols()`, `survival_time()`, `tabulate_rsp_subgroups()`, and `tabulate_survival_subgroups()` 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()`, `summarize_change()`, `summarize_patients_exposure_in_cols()`, and `survival_time()`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. diff --git a/man/response_subgroups.Rd b/man/response_subgroups.Rd index dfc2334621..dc208e9491 100644 --- a/man/response_subgroups.Rd +++ b/man/response_subgroups.Rd @@ -11,25 +11,19 @@ tabulate_rsp_subgroups( df, vars = c("n_tot", "n", "prop", "or", "ci"), groups_lists = list(), - label_all = lifecycle::deprecated(), + label_all = "All Patients", riskdiff = NULL, na_str = default_na_str(), - ..., - .stat_names = NULL, - .formats = NULL, - .labels = NULL, - .indent_mods = NULL + .formats = c(n = "xx", n_rsp = "xx", prop = "xx.x\%", n_tot = "xx", or = + list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), pval = + "x.xxxx | (<0.0001)") ) a_response_subgroups( - df, - labelstr = "", - ..., - .stats = NULL, - .stat_names = NULL, - .formats = NULL, - .labels = NULL, - .indent_mods = NULL + .formats = list(n = "xx", n_rsp = "xx", prop = "xx.x\%", n_tot = "xx", or = + list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), pval = + "x.xxxx | (<0.0001)", riskdiff = "xx.x (xx.x - xx.x)"), + na_str = default_na_str() ) } \arguments{ @@ -63,24 +57,8 @@ the second level as \code{arm_y}.} \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} -\item{...}{additional arguments for the lower level functions.} - -\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics -(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} - \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} - -\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} - -\item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the -unmodified default behavior. Can be negative.} - -\item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized -(must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} -for more information.} - -\item{.stats}{(\code{character})\cr statistics to select for the table.} } \value{ An \code{rtables} table summarizing binary response by subgroup. diff --git a/man/survival_duration_subgroups.Rd b/man/survival_duration_subgroups.Rd index 50313eef12..9bd2e96c28 100644 --- a/man/survival_duration_subgroups.Rd +++ b/man/survival_duration_subgroups.Rd @@ -15,22 +15,16 @@ tabulate_survival_subgroups( time_unit = NULL, riskdiff = NULL, na_str = default_na_str(), - ..., - .stat_names = NULL, - .formats = NULL, - .labels = NULL, - .indent_mods = NULL + .formats = c(n = "xx", n_events = "xx", n_tot_events = "xx", median = "xx.x", n_tot = + "xx", hr = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), + pval = "x.xxxx | (<0.0001)") ) a_survival_subgroups( - df, - labelstr = "", - ..., - .stats = NULL, - .stat_names = NULL, - .formats = NULL, - .labels = NULL, - .indent_mods = NULL + .formats = list(n = "xx", n_events = "xx", n_tot_events = "xx", median = "xx.x", n_tot + = "xx", hr = list(format_extreme_values(2L)), ci = + list(format_extreme_values_ci(2L)), pval = "x.xxxx | (<0.0001)"), + na_str = default_na_str() ) } \arguments{ @@ -69,24 +63,8 @@ and the second level as \code{arm_y}.} \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} -\item{...}{additional arguments for the lower level functions.} - -\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics -(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} - \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} - -\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} - -\item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the -unmodified default behavior. Can be negative.} - -\item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized -(must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} -for more information.} - -\item{.stats}{(\code{character})\cr statistics to select for the table.} } \value{ An \code{rtables} table summarizing survival by subgroup. diff --git a/man/survival_time.Rd b/man/survival_time.Rd index 3961d4e1e3..15602f0978 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -20,26 +20,25 @@ surv_time( show_labels = "visible", table_names = vars, .stats = c("median", "median_ci", "quantiles", "range"), - .formats = NULL, - .labels = NULL, - .indent_mods = c(median_ci = 1L) + .stat_names = NULL, + .formats = list(median_ci = "(xx.x, xx.x)", quantiles = "xx.x, xx.x", range = + "xx.x to xx.x", quantiles_lower = "xx.x (xx.x - xx.x)", quantiles_upper = + "xx.x (xx.x - xx.x)", median_ci_3d = "xx.x (xx.x - xx.x)"), + .labels = list(median_ci = "95\% CI", range = "Range"), + .indent_mods = list(median_ci = 1L) ) -s_surv_time(df, .var, is_event, control = control_surv_time()) +s_surv_time(df, .var, ..., is_event, control = control_surv_time()) a_surv_time( df, labelstr = "", - .var = NULL, - .df_row = NULL, - is_event, - control = control_surv_time(), - ref_fn_censor = TRUE, + ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str() + .indent_mods = NULL ) } \arguments{ @@ -80,6 +79,9 @@ times, to avoid warnings from \code{rtables}.} Options are: \verb{'median', 'median_ci', 'median_ci_3d', 'quantiles', 'quantiles_lower', 'quantiles_upper', 'range_censor', 'range_event', 'range'}} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} @@ -97,8 +99,6 @@ by a statistics function.} \item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized (must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} for more information.} - -\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} } \value{ \itemize{ From aa7e6afa2389aa74155cc0bda31936990f0f1fed Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 14:37:33 -0500 Subject: [PATCH 31/41] Move custom_stats stuff to different PR --- R/abnormal.R | 9 ++----- R/abnormal_by_baseline.R | 9 ++----- R/abnormal_by_marked.R | 9 ++----- R/abnormal_by_worst_grade.R | 9 ++----- R/abnormal_lab_worsen_by_baseline.R | 13 ++-------- R/count_values.R | 38 +++++++++++++++++------------ 6 files changed, 32 insertions(+), 55 deletions(-) diff --git a/R/abnormal.R b/R/abnormal.R index f09275681e..dab670140a 100644 --- a/R/abnormal.R +++ b/R/abnormal.R @@ -109,15 +109,10 @@ a_count_abnormal <- function(df, 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 - # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal, - custom_stat_fnc_list = custom_stat_functions, + custom_stat_fnc_list = NULL, args_list = c( df = list(df), extra_afun_params, @@ -126,7 +121,7 @@ a_count_abnormal <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) + .stats <- get_stats("abnormal", stats_in = .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) diff --git a/R/abnormal_by_baseline.R b/R/abnormal_by_baseline.R index de9802a62d..0262cf6465 100644 --- a/R/abnormal_by_baseline.R +++ b/R/abnormal_by_baseline.R @@ -136,15 +136,10 @@ a_count_abnormal_by_baseline <- function(df, 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 - # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal_by_baseline, - custom_stat_fnc_list = custom_stat_functions, + custom_stat_fnc_list = NULL, args_list = c( df = list(df), extra_afun_params, @@ -153,7 +148,7 @@ a_count_abnormal_by_baseline <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal_by_baseline", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) + .stats <- get_stats("abnormal_by_baseline", stats_in = .stats) levels_per_stats <- lapply(x_stats, names) .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) .labels <- get_labels_from_stats( diff --git a/R/abnormal_by_marked.R b/R/abnormal_by_marked.R index 717f0c2b72..faf959120d 100644 --- a/R/abnormal_by_marked.R +++ b/R/abnormal_by_marked.R @@ -120,15 +120,10 @@ a_count_abnormal_by_marked <- function(df, 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 - # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal_by_marked, - custom_stat_fnc_list = custom_stat_functions, + custom_stat_fnc_list = NULL, args_list = c( df = list(df), extra_afun_params, @@ -137,7 +132,7 @@ a_count_abnormal_by_marked <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal_by_marked", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) + .stats <- get_stats("abnormal_by_marked", stats_in = .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) diff --git a/R/abnormal_by_worst_grade.R b/R/abnormal_by_worst_grade.R index a07407e879..6470f3655b 100644 --- a/R/abnormal_by_worst_grade.R +++ b/R/abnormal_by_worst_grade.R @@ -107,15 +107,10 @@ a_count_abnormal_by_worst_grade <- function(df, 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 - # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal_by_worst_grade, - custom_stat_fnc_list = custom_stat_functions, + custom_stat_fnc_list = NULL, args_list = c( df = list(df), extra_afun_params, @@ -124,7 +119,7 @@ a_count_abnormal_by_worst_grade <- function(df, ) # Fill in formatting defaults - .stats <- get_stats("abnormal_by_worst_grade", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) + .stats <- get_stats("abnormal_by_worst_grade", stats_in = .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) diff --git a/R/abnormal_lab_worsen_by_baseline.R b/R/abnormal_lab_worsen_by_baseline.R index a44e0188be..45567526e9 100644 --- a/R/abnormal_lab_worsen_by_baseline.R +++ b/R/abnormal_lab_worsen_by_baseline.R @@ -88,15 +88,10 @@ a_count_abnormal_lab_worsen_by_baseline <- function(df, 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 - # Apply statistics function x_stats <- .apply_stat_functions( default_stat_fnc = s_count_abnormal_lab_worsen_by_baseline, - custom_stat_fnc_list = custom_stat_functions, + custom_stat_fnc_list = NULL, args_list = c( df = list(df), extra_afun_params, @@ -105,11 +100,7 @@ a_count_abnormal_lab_worsen_by_baseline <- function(df, ) # Fill in formatting defaults - .stats <- get_stats( - "abnormal_lab_worsen_by_baseline", - stats_in = .stats, - custom_stats_in = names(custom_stat_functions) - ) + .stats <- get_stats("abnormal_lab_worsen_by_baseline", stats_in = .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) diff --git a/R/count_values.R b/R/count_values.R index de84aed3c0..c5fc88ba69 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -114,16 +114,19 @@ a_count_values <- function(x, .formats = NULL, .labels = 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 + .stats <- default_and_custom_stats_list$all_stats # just the labels of 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, @@ -136,7 +139,11 @@ a_count_values <- function(x, ) # Fill in formatting defaults - .stats <- get_stats("analyze_vars_counts", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) + .stats <- get_stats( + "analyze_vars_counts", + stats_in = .stats, + custom_stats_in = names(custom_stat_functions), + ) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) @@ -144,9 +151,14 @@ a_count_values <- function(x, x_stats <- x_stats[.stats] # Auto format handling - .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) + .formats <- apply_auto_formatting( + .formats, + x_stats, + extra_afun_params$.df_row, + extra_afun_params$.var + ) - # Get and check statistical names + # Get and check statistic names from defaults .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( @@ -188,20 +200,14 @@ count_values <- function(lyt, .formats = c(count_fraction = "xx (xx.xx%)", count = "xx"), .labels = c(count_fraction = paste(values, collapse = ", ")), .indent_mods = NULL) { - # Process standard extra arguments - extra_args <- list(".stats" = .stats) + # Process extra args + extra_args <- list("na_rm" = na_rm, "values" = values, ...) + 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 - # Process additional arguments to the statistic 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"]]) From b1166a7c2999a911e1d99cceef74f1c6c88fc8cb Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 14:38:41 -0500 Subject: [PATCH 32/41] Keep count_values stuff --- R/count_values.R | 41 +++++++++++++++-------------------------- 1 file changed, 15 insertions(+), 26 deletions(-) diff --git a/R/count_values.R b/R/count_values.R index c5fc88ba69..ce37a2f45a 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -114,23 +114,15 @@ a_count_values <- function(x, .formats = NULL, .labels = NULL, .indent_mods = NULL) { + # Check for additional parameters to the statistics function 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$all_stats # just the labels of 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) - ) + 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, + custom_stat_fnc_list = NULL, args_list = c( x = list(x), extra_afun_params, @@ -139,11 +131,7 @@ a_count_values <- function(x, ) # Fill in formatting defaults - .stats <- get_stats( - "analyze_vars_counts", - stats_in = .stats, - custom_stats_in = names(custom_stat_functions), - ) + .stats <- get_stats("analyze_vars_counts", stats_in = .stats) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) @@ -151,14 +139,9 @@ a_count_values <- function(x, x_stats <- x_stats[.stats] # Auto format handling - .formats <- apply_auto_formatting( - .formats, - x_stats, - extra_afun_params$.df_row, - extra_afun_params$.var - ) + .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) - # Get and check statistic names from defaults + # Get and check statistical names .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( @@ -200,14 +183,20 @@ count_values <- function(lyt, .formats = c(count_fraction = "xx (xx.xx%)", count = "xx"), .labels = c(count_fraction = paste(values, collapse = ", ")), .indent_mods = NULL) { - # Process extra args - extra_args <- list("na_rm" = na_rm, "values" = values, ...) - if (!is.null(.stats)) extra_args[[".stats"]] <- .stats + # 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, + 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"]]) From 9255adc7f8444266262c625140c15f40c2b45a2f Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 14:45:23 -0500 Subject: [PATCH 33/41] Revert count_values --- R/count_values.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/count_values.R b/R/count_values.R index ce37a2f45a..de84aed3c0 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -119,10 +119,15 @@ a_count_values <- function(x, 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 + # Main statistic calculations x_stats <- .apply_stat_functions( default_stat_fnc = s_count_values, - custom_stat_fnc_list = NULL, + custom_stat_fnc_list = custom_stat_functions, args_list = c( x = list(x), extra_afun_params, @@ -131,7 +136,7 @@ a_count_values <- function(x, ) # Fill in formatting defaults - .stats <- get_stats("analyze_vars_counts", stats_in = .stats) + .stats <- get_stats("analyze_vars_counts", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) From 57f61db4059b3538a641e2a5606d32633d6c915c Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 17:58:21 -0500 Subject: [PATCH 34/41] Add some missing .stat_name stuff --- R/count_occurrences.R | 3 +++ R/count_occurrences_by_grade.R | 3 +++ R/count_patients_with_event.R | 3 +++ R/summarize_change.R | 10 ++++++---- R/summarize_num_patients.R | 3 +++ R/summarize_patients_exposure_in_cols.R | 3 +++ 6 files changed, 21 insertions(+), 4 deletions(-) diff --git a/R/count_occurrences.R b/R/count_occurrences.R index e9544b4200..0803f21d89 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -197,6 +197,9 @@ a_count_occurrences <- function(df, # Auto format handling .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 %>% .unlist_keep_nulls(), .formats = .formats, diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index e87acea345..ce6c718067 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -288,6 +288,9 @@ a_count_occurrences_by_grade <- function(df, # Auto format handling .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 %>% .unlist_keep_nulls(), .formats = .formats, diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index 48e2e824bb..150ded7532 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -143,6 +143,9 @@ a_count_patients_with_event <- function(df, # Auto format handling .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, .formats = .formats, diff --git a/R/summarize_change.R b/R/summarize_change.R index 371392b0e9..7cc73614a2 100644 --- a/R/summarize_change.R +++ b/R/summarize_change.R @@ -68,8 +68,10 @@ a_change_from_baseline <- function(df, 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 # just the labels of stats + .stats <- default_and_custom_stats_list$all_stats custom_stat_functions <- default_and_custom_stats_list$custom_stats # Apply statistics function @@ -83,8 +85,8 @@ a_change_from_baseline <- function(df, ) ) - # Fill in with formatting defaults if needed - .stats <- c(get_stats("analyze_vars_numeric", stats_in = .stats), names(custom_stat_functions)) + # Fill in with formatting defaults + .stats <- get_stats("analyze_vars_numeric", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) @@ -196,7 +198,7 @@ summarize_change <- function(lyt, var_labels = var_labels, show_labels = show_labels, table_names = table_names, - inclNAs = na_rm, + inclNAs = !na_rm, section_div = section_div ) } diff --git a/R/summarize_num_patients.R b/R/summarize_num_patients.R index 43903cce8a..5d8b48ef20 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -187,6 +187,9 @@ a_num_patients <- function(df, # Auto format handling .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, .formats = .formats, diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index 22d4ae7cdf..c608fdd67b 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -171,6 +171,9 @@ a_count_patients_sum_exposure <- function(df, # Auto format handling .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 %>% .unlist_keep_nulls(), .formats = .formats, From f79b4ffcdea088512112476271ba3dee1d619f69 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 18:19:39 -0500 Subject: [PATCH 35/41] Fix example --- R/survival_time.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/survival_time.R b/R/survival_time.R index b3f42d556a..ba7b1e6b28 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -183,7 +183,7 @@ a_surv_time <- function(df, # Get cell footnotes cell_fns <- stats::setNames(vector("list", length = length(x_stats)), .labels) - if ("range" %in% names(x_stats) && dots_extra_args$ref_fn_censor) { + if ("range" %in% names(x_stats) && "ref_fn_censor" %in% names(dots_extra_args) && dots_extra_args$ref_fn_censor) { if (identical(x_stats[["range"]][1], rng_censor_lwr) && identical(x_stats[["range"]][2], rng_censor_upr)) { cell_fns[[.labels[["range"]]]] <- "Censored observations: range minimum & maximum" } else if (identical(x_stats[["range"]][1], rng_censor_lwr)) { From 21d661e0fd826f4bac75dad543a1bba2576842c9 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 25 Feb 2025 18:29:16 -0500 Subject: [PATCH 36/41] Fix checks --- R/package.R | 6 ++++++ R/riskdiff.R | 2 -- man/afun_riskdiff.Rd | 3 --- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/package.R b/R/package.R index 7dd06b6320..42ee429591 100644 --- a/R/package.R +++ b/R/package.R @@ -19,6 +19,12 @@ NULL # Resolve missing global definitions: utils::globalVariables(c( ".", + ".all_col_counts", + ".df_row", + ".N_col", + ".N_row", + ".spl_context", + ".var", "x", "average", "difference", diff --git a/R/riskdiff.R b/R/riskdiff.R index 834736248e..dd1ed567b1 100644 --- a/R/riskdiff.R +++ b/R/riskdiff.R @@ -71,8 +71,6 @@ add_riskdiff <- function(arm_x, #' @param afun (named `list`)\cr a named list containing one name-value pair where the name corresponds to #' the name of the statistics function that should be used in calculations and the value is the corresponding #' analysis function. -#' @param s_args (named `list`)\cr additional arguments to be passed to the statistics function and analysis -#' function supplied in `afun`. #' #' @return A list of formatted [rtables::CellValue()]. #' diff --git a/man/afun_riskdiff.Rd b/man/afun_riskdiff.Rd index 42544a7538..4fae781302 100644 --- a/man/afun_riskdiff.Rd +++ b/man/afun_riskdiff.Rd @@ -41,9 +41,6 @@ information on the \code{"auto"} setting.} \item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the unmodified default behavior. Can be negative.} - -\item{s_args}{(named \code{list})\cr additional arguments to be passed to the statistics function and analysis -function supplied in \code{afun}.} } \value{ A list of formatted \code{\link[rtables:CellValue]{rtables::CellValue()}}. From c8b197b0970239775ad48a2aeb2ffd1e1345daf5 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 26 Feb 2025 15:16:49 -0500 Subject: [PATCH 37/41] Update summarize_colvars --- NEWS.md | 2 +- R/summarize_colvars.R | 11 +++++++++-- man/summarize_colvars.Rd | 10 +++++++--- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/NEWS.md b/NEWS.md index 5f050fb9e5..a44b799f08 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,7 +3,7 @@ ### Enhancements * Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, `count_abnormal_lab_worsen_by_baseline()`, `summarize_ancova()`, `summarize_glm_count()`, and `summarize_num_patients()` to work without `make_afun()`. * Added `geom_sd` and `geom_mean_sd` to `s_summary()` default available statistics. -* Refactored `afun_riskdiff()`, `count_occurrences()`, `count_occurrences_by_grade()`, `count_patients_with_event()`, `count_patients_with_flags()`, `count_values()`, `estimate_incidence_rate()`, `summarize_change()`, `summarize_patients_exposure_in_cols()`, and `survival_time()`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()`, `summarize_change()`, `summarize_colvars()`, `summarize_patients_exposure_in_cols()`, and `survival_time()`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. diff --git a/R/summarize_colvars.R b/R/summarize_colvars.R index 3c4f182d38..eb3bc5be66 100644 --- a/R/summarize_colvars.R +++ b/R/summarize_colvars.R @@ -63,17 +63,24 @@ #' #' @export summarize_colvars <- function(lyt, - ..., na_str = default_na_str(), + ..., .stats = c("n", "mean_sd", "median", "range", "count_fraction"), + .stat_names = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL) { - extra_args <- list(.stats = .stats, 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 + # Adding additional info from layout to analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_summary) <- c(formals(a_summary), extra_args[[".additional_fun_parameters"]]) + analyze_colvars( lyt, afun = a_summary, diff --git a/man/summarize_colvars.Rd b/man/summarize_colvars.Rd index 704cb0f52a..a4156bcab1 100644 --- a/man/summarize_colvars.Rd +++ b/man/summarize_colvars.Rd @@ -6,9 +6,10 @@ \usage{ summarize_colvars( lyt, - ..., na_str = default_na_str(), + ..., .stats = c("n", "mean_sd", "median", "range", "count_fraction"), + .stat_names = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL @@ -17,12 +18,15 @@ summarize_colvars( \arguments{ \item{lyt}{(\code{PreDataTableLayouts})\cr layout that analyses will be added to.} -\item{...}{arguments passed to \code{\link[=s_summary]{s_summary()}}.} - \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{...}{arguments passed to \code{\link[=s_summary]{s_summary()}}.} + \item{.stats}{(\code{character})\cr statistics to select for the table.} +\item{.stat_names}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} From 043a09c77a0a4e38625de520791b899297fded96 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 27 Feb 2025 11:20:18 -0500 Subject: [PATCH 38/41] Clean up after merging main --- R/utils_default_stats_formats_labels.R | 31 +++++++++++++------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index f327954991..b46d5f14cd 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -558,6 +558,7 @@ tern_default_formats <- c( count_fraction = format_count_fraction, count_fraction_fixed_dp = format_count_fraction_fixed_dp, cv = "xx.x", + event_free_rate = "xx.xx", fraction = format_fraction_fixed_dp, geom_cv = "xx.x", geom_mean = "xx.x", @@ -565,6 +566,9 @@ tern_default_formats <- c( geom_mean_ci_3d = "xx.xx (xx.xx - xx.xx)", geom_mean_sd = "xx.x (xx.x)", geom_sd = "xx.x", + hr = "xx.xx", + hr_ci = "(xx.xx, xx.xx)", + hr_ci_3d = "xx.xx (xx.xx - xx.xx)", iqr = "xx.x", lsmean = "xx.xx", lsmean_diff = "xx.xx", @@ -588,15 +592,21 @@ tern_default_formats <- c( n_blq = "xx.", n_events = "xx", n_patients = "xx (xx.x%)", + n_prop = "xx (xx.x%)", n_rate = "xx (xx.x)", n_rsp = "xx", n_tot = "xx", + n_tot_events = "xx.xx", n_unique = "xx", nonunique = "xx", or = list(format_extreme_values(2L)), + or_ci = "xx.xx (xx.xx - xx.xx)", person_years = "xx.x", prop = "xx.x%", + prop_ci = "(xx.x, xx.x)", + pt_at_risk = "xx", pval = "x.xxxx | (<0.0001)", + pvalue = "x.xxxx | (<0.0001)", pval_counts = "x.xxxx | (<0.0001)", quantiles = "xx.x - xx.x", quantiles_lower = "xx.xx (xx.xx - xx.xx)", @@ -606,29 +616,20 @@ tern_default_formats <- c( range_event = "xx.x to xx.x", rate = "xx.xxxx", rate_ci = "(xx.xxxx, xx.xxxx)", + rate_diff = "xx.xx", + rate_diff_ci = "(xx.xx, xx.xx)", + rate_diff_ci_3d = format_xx("xx.xx (xx.xx, xx.xx)"), rate_ratio = "xx.xxxx", rate_ratio_ci = "(xx.xxxx, xx.xxxx)", + rate_se = "xx.xx", riskdiff = "xx.x (xx.x - xx.x)", sd = "xx.x", se = "xx.x", sum = "xx.x", sum_exposure = "xx", unique = format_count_fraction_fixed_dp, - unique_count = "xx" - rate_diff = "xx.xx", - rate_diff_ci = "(xx.xx, xx.xx)", - rate_diff_ci_3d = format_xx("xx.xx (xx.xx, xx.xx)"), - ztest_pval = "x.xxxx | (<0.0001)", - hr = "xx.xx", - hr_ci = "(xx.xx, xx.xx)", - hr_ci_3d = "xx.xx (xx.xx - xx.xx)", - n_tot_events = "xx.xx", - or_ci = "xx.xx (xx.xx - xx.xx)", - n_prop = "xx (xx.x%)", - prop_ci = "(xx.x, xx.x)", - pt_at_risk = "xx", - event_free_rate = "xx.xx", - rate_se = "xx.xx" + unique_count = "xx", + ztest_pval = "x.xxxx | (<0.0001)" ) # tern_default_labels ---------------------------------------------------------- From baced1d8f83e6cd906012b45c17b0d2e334687ff Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 4 Mar 2025 19:23:41 -0500 Subject: [PATCH 39/41] Expose show_labels argument in count_patients_with_event --- R/count_patients_with_event.R | 3 ++- man/count_patients_with_event.Rd | 3 +++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index 150ded7532..76fd1b867b 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -204,6 +204,7 @@ count_patients_with_event <- function(lyt, riskdiff = FALSE, na_str = default_na_str(), nested = TRUE, + show_labels = ifelse(length(vars) > 1, "visible", "hidden"), ..., table_names = vars, .stats = "count_fraction", @@ -240,7 +241,7 @@ count_patients_with_event <- function(lyt, na_str = na_str, nested = nested, extra_args = extra_args, - show_labels = ifelse(length(vars) > 1, "visible", "hidden"), + show_labels = show_labels, table_names = table_names ) } diff --git a/man/count_patients_with_event.Rd b/man/count_patients_with_event.Rd index 801eb0e20e..8f5bd7224e 100644 --- a/man/count_patients_with_event.Rd +++ b/man/count_patients_with_event.Rd @@ -13,6 +13,7 @@ count_patients_with_event( riskdiff = FALSE, na_str = default_na_str(), nested = TRUE, + show_labels = ifelse(length(vars) > 1, "visible", "hidden"), ..., table_names = vars, .stats = "count_fraction", @@ -64,6 +65,8 @@ See \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk diff possible (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} +\item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} + \item{...}{additional arguments for the lower level functions.} \item{table_names}{(\code{character})\cr this can be customized in the case that the same \code{vars} are analyzed multiple From fb65fe8c170b8d03d992d6e09dd4f605ce85f312 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 4 Mar 2025 19:29:34 -0500 Subject: [PATCH 40/41] Unlist x_stats prior to auto formatting & get_stat_names call --- R/abnormal.R | 4 ++-- R/abnormal_by_baseline.R | 4 ++-- R/abnormal_by_marked.R | 4 ++-- R/abnormal_by_worst_grade.R | 4 ++-- R/abnormal_lab_worsen_by_baseline.R | 4 ++-- R/count_occurrences.R | 4 +++- R/count_occurrences_by_grade.R | 4 +++- R/count_patients_with_flags.R | 7 +------ R/estimate_multinomial_rsp.R | 1 - R/response_subgroups.R | 5 +++-- R/summarize_patients_exposure_in_cols.R | 4 +++- R/survival_coxph_pairwise.R | 1 - R/survival_duration_subgroups.R | 5 +++-- 13 files changed, 26 insertions(+), 25 deletions(-) diff --git a/R/abnormal.R b/R/abnormal.R index f09275681e..65d0d67891 100644 --- a/R/abnormal.R +++ b/R/abnormal.R @@ -132,7 +132,7 @@ a_count_abnormal <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] + x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -141,7 +141,7 @@ a_count_abnormal <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .labels %>% .unlist_keep_nulls(), .stat_names = .stat_names, diff --git a/R/abnormal_by_baseline.R b/R/abnormal_by_baseline.R index de9802a62d..b04b890d07 100644 --- a/R/abnormal_by_baseline.R +++ b/R/abnormal_by_baseline.R @@ -161,7 +161,7 @@ a_count_abnormal_by_baseline <- function(df, ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] + x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -170,7 +170,7 @@ a_count_abnormal_by_baseline <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .labels %>% .unlist_keep_nulls(), .stat_names = .stat_names, diff --git a/R/abnormal_by_marked.R b/R/abnormal_by_marked.R index 717f0c2b72..001a49342e 100644 --- a/R/abnormal_by_marked.R +++ b/R/abnormal_by_marked.R @@ -143,7 +143,7 @@ a_count_abnormal_by_marked <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] + x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -152,7 +152,7 @@ a_count_abnormal_by_marked <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .labels %>% .unlist_keep_nulls(), .stat_names = .stat_names, diff --git a/R/abnormal_by_worst_grade.R b/R/abnormal_by_worst_grade.R index a07407e879..ea5b9a152b 100644 --- a/R/abnormal_by_worst_grade.R +++ b/R/abnormal_by_worst_grade.R @@ -130,7 +130,7 @@ a_count_abnormal_by_worst_grade <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] + x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -139,7 +139,7 @@ a_count_abnormal_by_worst_grade <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .labels %>% .unlist_keep_nulls(), .stat_names = .stat_names, diff --git a/R/abnormal_lab_worsen_by_baseline.R b/R/abnormal_lab_worsen_by_baseline.R index a44e0188be..6008ba6a49 100644 --- a/R/abnormal_lab_worsen_by_baseline.R +++ b/R/abnormal_lab_worsen_by_baseline.R @@ -115,7 +115,7 @@ a_count_abnormal_lab_worsen_by_baseline <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] + x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -124,7 +124,7 @@ a_count_abnormal_lab_worsen_by_baseline <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .labels %>% .unlist_keep_nulls(), .stat_names = .stat_names, diff --git a/R/count_occurrences.R b/R/count_occurrences.R index 0803f21d89..0095badad6 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -194,6 +194,8 @@ a_count_occurrences <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) + x_stats <- x_stats %>% .unlist_keep_nulls() + # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -201,7 +203,7 @@ a_count_occurrences <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .labels %>% .unlist_keep_nulls(), .stat_names = .stat_names, diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index ce6c718067..216d62cf6a 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -285,6 +285,8 @@ a_count_occurrences_by_grade <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) + x_stats <- x_stats %>% .unlist_keep_nulls() + # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -292,7 +294,7 @@ a_count_occurrences_by_grade <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .labels %>% .unlist_keep_nulls(), .stat_names = .stat_names, diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 06d8cf1145..04ba879db0 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -156,7 +156,7 @@ a_count_patients_with_flags <- function(df, ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] + x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -164,11 +164,6 @@ a_count_patients_with_flags <- function(df, # Get and check statistical names .stat_names <- get_stat_names(x_stats, .stat_names) - # Unlist stats - x_stats <- x_stats %>% - .unlist_keep_nulls() %>% - stats::setNames(names(.formats)) - in_rows( .list = x_stats, .formats = .formats, diff --git a/R/estimate_multinomial_rsp.R b/R/estimate_multinomial_rsp.R index 74bdbf6e5d..cd1ab24bba 100644 --- a/R/estimate_multinomial_rsp.R +++ b/R/estimate_multinomial_rsp.R @@ -145,7 +145,6 @@ a_length_proportion <- function(x, ) .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) diff --git a/R/response_subgroups.R b/R/response_subgroups.R index 8d5ba0ab38..600ce155d2 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -177,7 +177,8 @@ a_response_subgroups <- function(df, .stats, function(x) x_stats[[x]] %>% stats::setNames(var_lvls) ) %>% - stats::setNames(.stats) + stats::setNames(.stats) %>% + .unlist_keep_nulls() .nms <- if ("biomarker" %in% names(dots_extra_args)) var_lvls else names(.labels) @@ -188,7 +189,7 @@ a_response_subgroups <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .nms, .stat_names = .stat_names, diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index c608fdd67b..1022626c4f 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -168,6 +168,8 @@ a_count_patients_sum_exposure <- function(df, ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) + x_stats <- x_stats %>% .unlist_keep_nulls() + # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -175,7 +177,7 @@ a_count_patients_sum_exposure <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = .labels %>% .unlist_keep_nulls(), .stat_names = .stat_names, diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index af52638d05..742700ec9b 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -170,7 +170,6 @@ a_coxph_pairwise <- function(df, ) .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) diff --git a/R/survival_duration_subgroups.R b/R/survival_duration_subgroups.R index 587d623fac..4606e03c7f 100644 --- a/R/survival_duration_subgroups.R +++ b/R/survival_duration_subgroups.R @@ -201,7 +201,8 @@ a_survival_subgroups <- function(df, .stats, function(x) x_stats[[x]] %>% stats::setNames(var_lvls) ) %>% - stats::setNames(.stats) + stats::setNames(.stats) %>% + .unlist_keep_nulls() # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) @@ -210,7 +211,7 @@ a_survival_subgroups <- function(df, .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( - .list = x_stats %>% .unlist_keep_nulls(), + .list = x_stats, .formats = .formats, .names = names(.labels), .stat_names = .stat_names, From 6b5313ca7abf00faf24cacbcbffa86756f621238 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 4 Mar 2025 19:37:20 -0500 Subject: [PATCH 41/41] Set x_stats names --- R/abnormal.R | 4 +++- R/abnormal_by_baseline.R | 4 +++- R/abnormal_by_marked.R | 4 +++- R/abnormal_by_worst_grade.R | 4 +++- R/abnormal_lab_worsen_by_baseline.R | 4 +++- R/analyze_variables.R | 2 +- R/count_occurrences.R | 4 +++- R/count_occurrences_by_grade.R | 4 +++- R/count_patients_with_flags.R | 4 +++- R/summarize_patients_exposure_in_cols.R | 4 +++- 10 files changed, 28 insertions(+), 10 deletions(-) diff --git a/R/abnormal.R b/R/abnormal.R index 65d0d67891..141fc1155f 100644 --- a/R/abnormal.R +++ b/R/abnormal.R @@ -132,7 +132,9 @@ a_count_abnormal <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) diff --git a/R/abnormal_by_baseline.R b/R/abnormal_by_baseline.R index b04b890d07..13c8cd2cf6 100644 --- a/R/abnormal_by_baseline.R +++ b/R/abnormal_by_baseline.R @@ -161,7 +161,9 @@ a_count_abnormal_by_baseline <- function(df, ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) diff --git a/R/abnormal_by_marked.R b/R/abnormal_by_marked.R index 001a49342e..7089a16ad5 100644 --- a/R/abnormal_by_marked.R +++ b/R/abnormal_by_marked.R @@ -143,7 +143,9 @@ a_count_abnormal_by_marked <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) diff --git a/R/abnormal_by_worst_grade.R b/R/abnormal_by_worst_grade.R index ea5b9a152b..dacaf4f2b7 100644 --- a/R/abnormal_by_worst_grade.R +++ b/R/abnormal_by_worst_grade.R @@ -130,7 +130,9 @@ a_count_abnormal_by_worst_grade <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) diff --git a/R/abnormal_lab_worsen_by_baseline.R b/R/abnormal_lab_worsen_by_baseline.R index 6008ba6a49..21a2d41545 100644 --- a/R/abnormal_lab_worsen_by_baseline.R +++ b/R/abnormal_lab_worsen_by_baseline.R @@ -115,7 +115,9 @@ a_count_abnormal_lab_worsen_by_baseline <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) diff --git a/R/analyze_variables.R b/R/analyze_variables.R index b35e49063e..842c147c8a 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -654,7 +654,7 @@ a_summary <- function(x, ) # Get and check statistical names from defaults - .stat_names <- get_stat_names(x_stats, .stat_names) # note is x_stats + .stat_names <- get_stat_names(x_stats, .stat_names) in_rows( .list = x_stats, diff --git a/R/count_occurrences.R b/R/count_occurrences.R index 0095badad6..4a03604c26 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -194,7 +194,9 @@ a_count_occurrences <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index 216d62cf6a..a006e1a958 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -285,7 +285,9 @@ a_count_occurrences_by_grade <- function(df, .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 04ba879db0..c4f2db3d13 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -156,7 +156,9 @@ a_count_patients_with_flags <- function(df, ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index 1022626c4f..8d361e7733 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -168,7 +168,9 @@ a_count_patients_sum_exposure <- function(df, ) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + setNames(names(.formats)) # Auto format handling .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var)