diff --git a/NEWS.md b/NEWS.md index 646edba5da..199b2e556c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,9 @@ # tern 0.9.7.9011 ### Enhancements -* Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, `count_abnormal_lab_worsen_by_baseline()`, `coxph_pairwise()`, `estimate_multinomial_rsp()`, `estimate_proportion()`, `estimate_odds_ratio()`, `summarize_ancova()`, `summarize_glm_count()`, and `surv_timepoint()` to work without `make_afun()`. +* Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, `count_abnormal_lab_worsen_by_baseline()`, `coxph_pairwise()`, `estimate_multinomial_rsp()`, `estimate_proportion()`, `estimate_odds_ratio()`, `summarize_ancova()`, `summarize_glm_count()`, `summarize_num_patients()`, and `surv_timepoint()` to work without `make_afun()`. * Added `geom_sd` and `geom_mean_sd` to `s_summary()` default available statistics. -* Refactored `h_tab_one_biomarker()`, `tabulate_rsp_subgroups()`, `tabulate_survival_subgroups()`, `tabulate_rsp_biomarkers()`, and `tabulate_survival_biomarkers()` to align with new analysis function style. +* Refactored `afun_riskdiff()`, `count_occurrences()`, `count_occurrences_by_grade()`, `count_patients_with_event()`, `count_patients_with_flags()`, `count_values()`, `estimate_incidence_rate()`, `h_tab_one_biomarker()`, `summarize_change()`, `summarize_colvars()`, `summarize_patients_exposure_in_cols()`, `survival_time()`, `tabulate_rsp_subgroups()`, `tabulate_survival_subgroups()`, `tabulate_rsp_biomarkers()`, and `tabulate_survival_biomarkers()` to align with new analysis function style. ### Bug Fixes * Fixed bug in `a_count_patients_with_flags()` preventing select custom label and indentation specification formats from being applied. @@ -18,6 +18,7 @@ * Began deprecation of the unused `label_all` parameter to `tabulate_rsp_subgroups()`, with redirection to the same parameter in `extract_rsp_subgroups()`. * Began deprecation of the no longer used helper functions `h_tab_one_biomarker()`, `h_tab_rsp_one_biomarker()`, and `h_tab_surv_one_biomarker()`. * Moved helper functions `h_tab_rsp_one_biomarker()` and `h_tab_surv_one_biomarker()` into `h_biomarkers_subgroups.R`. +* Updated documentation to remove suggestions to use `make_afun()`. # tern 0.9.7 diff --git a/R/abnormal.R b/R/abnormal.R index f09275681e..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] + 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) @@ -141,7 +143,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..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] + 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) @@ -170,7 +172,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..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] + 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) @@ -152,7 +154,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..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] + 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) @@ -139,7 +141,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..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] + 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) @@ -124,7 +126,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/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 bbac47fb02..4a03604c26 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,47 +154,63 @@ s_count_occurrences <- function(df, #' @export a_count_occurrences <- function(df, labelstr = "", - id = "USUBJID", - denom = c("N_col", "n", "N_row"), - drop = TRUE, - .N_col, # nolint - .N_row, # nolint - .var = NULL, - .df_row = NULL, + ..., .stats = NULL, + .stat_names = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na_str = default_na_str()) { - denom <- match.arg(denom) - x_stats <- s_count_occurrences( - df = df, denom = denom, .N_col = .N_col, .N_row = .N_row, .df_row = .df_row, drop = drop, .var = .var, id = id - ) - if (is.null(unlist(x_stats))) { - return(NULL) + .indent_mods = NULL) { + # Check for additional parameters to the statistics function + dots_extra_args <- list(...) + extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters)) + dots_extra_args$.additional_fun_parameters <- NULL + + # Check for user-defined functions + default_and_custom_stats_list <- .split_std_from_custom_stats(.stats) + .stats <- default_and_custom_stats_list$all_stats + custom_stat_functions <- default_and_custom_stats_list$custom_stats + + # if empty, return NA + if (nrow(df) == 0) { + return(in_rows(.list = as.list(rep(NA, length(.stats))) %>% stats::setNames(.stats))) } - # Fill in with formatting defaults if needed - .stats <- get_stats("count_occurrences", stats_in = .stats) + # Apply statistics function + x_stats <- .apply_stat_functions( + default_stat_fnc = s_count_occurrences, + custom_stat_fnc_list = custom_stat_functions, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) + ) + + # Fill in formatting defaults + .stats <- get_stats("count_occurrences", stats_in = .stats, custom_stats_in = names(custom_stat_functions)) x_stats <- x_stats[.stats] levels_per_stats <- lapply(x_stats, names) .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats) .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - # Unlist stats - x_stats <- x_stats %>% .unlist_keep_nulls() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + 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 + .stat_names <- get_stat_names(x_stats, .stat_names) 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(), - .format_na_strs = na_str + .indent_mods = .indent_mods %>% .unlist_keep_nulls() ) } @@ -233,38 +250,42 @@ count_occurrences <- function(lyt, ..., table_names = vars, .stats = "count_fraction_fixed_dp", + .stat_names = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL) { checkmate::assert_flag(riskdiff) + afun <- if (isFALSE(riskdiff)) a_count_occurrences else afun_riskdiff + + # 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 - extra_args <- list( - .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str + # Process additional arguments to the statistic function + extra_args <- c( + extra_args, + id = id, drop = drop, + if (!isFALSE(riskdiff)) list(afun = list("s_count_occurrences" = a_count_occurrences)), + ... ) - s_args <- list(id = id, drop = drop, ...) - if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) - } else { - extra_args <- c( - extra_args, - list( - afun = list("s_count_occurrences" = a_count_occurrences), - s_args = s_args - ) - ) - } + # Append additional info from layout to the analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(afun) <- c(formals(afun), extra_args[[".additional_fun_parameters"]]) analyze( lyt = lyt, vars = vars, - afun = ifelse(isFALSE(riskdiff), a_count_occurrences, afun_riskdiff), - var_labels = var_labels, - show_labels = show_labels, - table_names = table_names, + afun = afun, na_str = na_str, nested = nested, - extra_args = extra_args + extra_args = extra_args, + var_labels = var_labels, + show_labels = show_labels, + table_names = table_names ) } @@ -297,32 +318,36 @@ summarize_occurrences <- function(lyt, na_str = default_na_str(), ..., .stats = "count_fraction_fixed_dp", + .stat_names = NULL, .formats = NULL, .indent_mods = NULL, .labels = NULL) { checkmate::assert_flag(riskdiff) + afun <- if (isFALSE(riskdiff)) a_count_occurrences else afun_riskdiff - extra_args <- list( - .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str + # Process standard extra arguments + extra_args <- list(".stats" = .stats) + if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names + if (!is.null(.formats)) extra_args[[".formats"]] <- .formats + if (!is.null(.labels)) extra_args[[".labels"]] <- .labels + if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods + + # Process additional arguments to the statistic function + extra_args <- c( + extra_args, + id = id, drop = drop, + if (!isFALSE(riskdiff)) list(afun = list("s_count_occurrences" = a_count_occurrences)), + ... ) - s_args <- list(id = id, drop = drop, ...) - if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) - } else { - extra_args <- c( - extra_args, - list( - afun = list("s_count_occurrences" = a_count_occurrences), - s_args = s_args - ) - ) - } + # Append additional info from layout to the analysis function + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(afun) <- c(formals(afun), extra_args[[".additional_fun_parameters"]]) summarize_row_groups( lyt = lyt, var = var, - cfun = ifelse(isFALSE(riskdiff), a_count_occurrences, afun_riskdiff), + cfun = afun, na_str = na_str, extra_args = extra_args ) diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index 98697b77f0..a006e1a958 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,51 +249,59 @@ 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 + + # 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 = custom_stat_functions, + args_list = c( + df = list(df), + labelstr = list(labelstr), + extra_afun_params, + dots_extra_args + ) ) - if (is.null(unlist(x_stats))) { - return(NULL) - } - - # Fill in with formatting defaults if needed - .stats <- get_stats("count_occurrences_by_grade", stats_in = .stats) + # Fill in formatting defaults + .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) .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() + x_stats <- x_stats[.stats] %>% + .unlist_keep_nulls() %>% + 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 + .stat_names <- get_stat_names(x_stats, .stat_names) 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(), - .format_na_strs = na_str + .indent_mods = .indent_mods %>% .unlist_keep_nulls() ) } @@ -365,39 +374,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 +453,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 ) diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index 520f09478d..76fd1b867b 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,27 +105,35 @@ 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 + + # Check for user-defined functions + default_and_custom_stats_list <- .split_std_from_custom_stats(.stats) + .stats <- default_and_custom_stats_list$all_stats + custom_stat_functions <- default_and_custom_stats_list$custom_stats - if (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 = custom_stat_functions, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) + ) - # Fill in with formatting defaults if needed - .stats <- get_stats("count_patients_with_event", stats_in = .stats) + # Fill in formatting defaults + .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) @@ -132,15 +141,18 @@ 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) + + # 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() ) } @@ -192,38 +204,44 @@ 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", + .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 = show_labels, + table_names = table_names ) } diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 260750de01..c4f2db3d13 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,51 +114,56 @@ 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) - } + # 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 = custom_stat_functions, + args_list = c( + df = list(df), + extra_afun_params, + dots_extra_args + ) + ) - # Fill in with formatting defaults if needed - .stats <- get_stats("count_patients_with_flags", stats_in = .stats) - levels_per_stats <- rep(list(names(flag_variables)), length(.stats)) %>% setNames(.stats) + # 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)) %>% 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 %>% stats::setNames(names(flag_variables)) ) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) - x_stats <- x_stats[.stats] - - # Unlist stats - x_stats <- x_stats %>% + x_stats <- x_stats[.stats] %>% .unlist_keep_nulls() %>% 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 +172,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 +227,36 @@ 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 + afun <- if (isFALSE(riskdiff)) a_count_patients_with_flags 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, + 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)), + ... ) - s_args <- list(flag_variables = flag_variables, flag_labels = flag_labels, ...) - if (isFALSE(riskdiff)) { - extra_args <- c(extra_args, s_args) - } else { - extra_args <- c( - extra_args, - list( - afun = list("s_count_patients_with_flags" = a_count_patients_with_flags), - 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_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 ) } diff --git a/R/count_values.R b/R/count_values.R index c5fc88ba69..de84aed3c0 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -114,19 +114,16 @@ 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 # just the labels of stats + .stats <- default_and_custom_stats_list$all_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, @@ -139,11 +136,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, 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) @@ -151,14 +144,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 +188,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/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/incidence_rate.R b/R/incidence_rate.R index c517c35e8c..0a4317017c 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,61 @@ 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 + + # 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 = custom_stat_functions, + 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, 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")) + .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 +233,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/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/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/riskdiff.R b/R/riskdiff.R index 0bea490e30..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()]. #' @@ -85,19 +83,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 +98,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 +120,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/R/summarize_change.R b/R/summarize_change.R index f2f962e5a9..7cc73614a2 100644 --- a/R/summarize_change.R +++ b/R/summarize_change.R @@ -60,23 +60,21 @@ 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(...) + extra_afun_params <- retrieve_extra_afun_params(names(dots_extra_args$.additional_fun_parameters)) + dots_extra_args$.additional_fun_parameters <- NULL - # Check if there are user-defined functions + # 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 - # 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, @@ -87,24 +85,25 @@ a_change_from_baseline <- function(df, ) ) - # Fill in with formatting defaults if needed + # 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) + 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() ) @@ -161,51 +160,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 ) } 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/R/summarize_num_patients.R b/R/summarize_num_patients.R index e9b8bdefc8..5d8b48ef20 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -50,8 +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) checkmate::assert_multi_class(x, classes = c("factor", "character")) @@ -103,6 +107,7 @@ s_num_patients_content <- function(df, labelstr = "", .N_col, # nolint .var, + ..., required = NULL, count_by = NULL, unique_count_suffix = TRUE) { @@ -131,11 +136,69 @@ 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 + + # 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 = custom_stat_functions, + 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, custom_stats_in = names(custom_stat_functions)) + .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, 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, + .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 +226,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] - - s_args <- list(required = required, count_by = count_by, unique_count_suffix = unique_count_suffix, ...) + # 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 - 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 +310,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] - - s_args <- list(required = required, count_by = count_by, unique_count_suffix = unique_count_suffix, ...) + # 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 - 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 cce40b6c44..8d361e7733 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -39,12 +39,14 @@ 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 - custom_label = NULL) { + ..., + ex_var = "AVAL", + id = "USUBJID", + 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) @@ -54,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 { @@ -87,69 +91,101 @@ 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 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 { + # 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]])) { - 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 = custom_stat_functions, + args_list = c( + df = list(subset(df, get(var) == lvl)), + labelstr = list(labelstr), + var_level = 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 || is.null(var)) { + x_stats_total <- .apply_stat_functions( + default_stat_fnc = s_count_patients_sum_exposure, + custom_stat_fnc_list = custom_stat_functions, + args_list = c( + df = list(df), + labelstr = list(labelstr), + 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, + custom_stats_in = names(custom_stat_functions) + ) + x_stats <- x_stats[.stats] + levels_per_stats <- lapply(x_stats, names) + .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats) + .labels <- get_labels_from_stats( + .stats, .labels, levels_per_stats, + tern_defaults = c(lapply(x_stats[[1]], attr, "label"), tern_default_labels) + ) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats) + + 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) + + # Get and check statistical names + .stat_names <- get_stat_names(x_stats, .stat_names) + + 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_patients_exposure_in_cols Layout-creating function which can take statistics @@ -177,7 +213,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 +223,37 @@ summarize_patients_exposure_in_cols <- function(lyt, # nolint 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) { - 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 + 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 + + # 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 = col_labels, extra_args = list(.stats = .stats) ) } @@ -280,7 +338,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 +347,46 @@ analyze_patients_exposure_in_cols <- function(lyt, # nolint 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, ...) { - 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 + 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 + + # 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 = col_labels, 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/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, diff --git a/R/survival_time.R b/R/survival_time.R index 147375115a..ba7b1e6b28 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,51 +136,54 @@ 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] # Auto format handling - .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var) + .formats <- apply_auto_formatting(.formats, x_stats, extra_afun_params$.df_row, extra_afun_params$.var) + + # Get and check statistical names + .stat_names <- get_stat_names(x_stats, .stat_names) - cell_fns <- setNames(vector("list", length = length(x_stats)), .labels) - if ("range" %in% names(x_stats) && ref_fn_censor) { + # Get cell footnotes + cell_fns <- stats::setNames(vector("list", length = length(x_stats)), .labels) + 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)) { @@ -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/_pkgdown.yml b/_pkgdown.yml index 564c3b97b1..71ccb839f2 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/man/afun_riskdiff.Rd b/man/afun_riskdiff.Rd index 6d94682695..4fae781302 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.} @@ -55,15 +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{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}.} } \value{ A list of formatted \code{\link[rtables:CellValue]{rtables::CellValue()}}. 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..8f5bd7224e 100644 --- a/man/count_patients_with_event.Rd +++ b/man/count_patients_with_event.Rd @@ -13,9 +13,11 @@ 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", + .stat_names = NULL, .formats = list(count_fraction = format_count_fraction_fixed_dp), .labels = NULL, .indent_mods = NULL @@ -24,26 +26,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{ @@ -67,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 @@ -76,6 +76,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 +107,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/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_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.} 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_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{ 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 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/_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-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) 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) 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) 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) 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 + ) ) }) 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.