diff --git a/DESCRIPTION b/DESCRIPTION index 01d597156f..3598ecd928 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: tern Title: Create Common TLGs Used in Clinical Trials -Version: 0.8.5.9019 -Date: 2023-08-31 +Version: 0.9.0.9000 +Date: 2023-09-01 Authors@R: c( person("Joe", "Zhu", , "joe.zhu@roche.com", role = c("aut", "cre")), person("Daniel", "Sabanés Bové", , "daniel.sabanes_bove@roche.com", role = "aut"), @@ -135,6 +135,7 @@ Collate: 'prune_occurrences.R' 'response_biomarkers_subgroups.R' 'response_subgroups.R' + 'riskdiff.R' 'rtables_access.R' 'score_occurrences.R' 'split_cols_by_groups.R' diff --git a/NAMESPACE b/NAMESPACE index fc451faea8..026707e077 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ export(a_odds_ratio) export(a_proportion) export(a_proportion_diff) export(a_summary) +export(add_riskdiff) export(add_rowcounts) export(aesi_label) export(analyze_num_patients) @@ -255,6 +256,7 @@ export(stack_grobs) export(stat_mean_ci) export(stat_mean_pval) export(stat_median_ci) +export(stat_propdiff_ci) export(strata_normal_quantile) export(summarize_ancova) export(summarize_change) diff --git a/NEWS.md b/NEWS.md index ea874776b1..19725f5140 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,13 @@ -# tern 0.8.5.9019 +# tern 0.9.0.9000 + +# tern 0.9.0 +### New Features +* Added `stat_propdiff_ci` function to calculate proportion/risk difference and CI. +* Added risk difference column functionality via the `riskdiff` argument to functions `count_occurrences`, `count_occurrences_by_grade`, `count_patients_with_event`, `count_patients_with_flags`, `analyze_num_patients`, and `summarize_num_patients`. ### Enhancements -* Refactored `a_summary` to no longer use helper function `create_afun_summary`. -* Refactored `summarize_vars` and `compare_vars` to use refactored `a_summary`. +* Refactored the function `a_summary` to no longer use the helper function `create_afun_summary`. +* Refactored functions `summarize_vars` and `compare_vars` to use the refactored `a_summary` function. * Created new internal helper functions `ungroup_stats` to ungroup statistics calculated for factor variables, and `a_summary_internal` to perform calculations for `a_summary`. * Added `imputation_rule` function to apply imputation rule to data. * Updated `analyze_vars_in_cols` to use caching, allow implementation of imputation rule via the `imp_rule` argument, and allow user to specify cell alignment via the `.aligns` argument. diff --git a/R/argument_convention.R b/R/argument_convention.R index e64af13831..1f36def62c 100644 --- a/R/argument_convention.R +++ b/R/argument_convention.R @@ -6,6 +6,8 @@ #' @param ... additional arguments for the lower level functions. #' @param .aligns (`character`)\cr alignment for table contents (not including labels). When `NULL`, `"center"` #' is applied. See [formatters::list_valid_aligns()] for a list of all currently supported alignments. +#' @param .all_col_counts (`vector` of `integer`)\cr each value represents a global count for a column. Values are +#' taken from `alt_counts_df` if specified (see [rtables::build_table()]). #' @param .df_row (`data.frame`)\cr data frame across all of the columns for the given row split. #' @param .in_ref_col (`logical`)\cr `TRUE` when working with the reference level, `FALSE` otherwise. #' @param .N_col (`integer`)\cr column-wise N (column count) for the full column being analyzed that is typically @@ -52,6 +54,9 @@ #' @param newpage (`flag`)\cr whether the plot should be drawn on a new page. #' Only considered if `draw = TRUE` is used. #' @param prune_zero_rows (`flag`)\cr whether to prune all zero rows. +#' @param riskdiff (`flag`)\cr whether a risk difference column is present. When set to `TRUE`, [add_riskdiff()] must be +#' used as `split_fun` in the prior column split of the table layout, specifying which columns should be compared. +#' See [stat_propdiff_ci()] for details on risk difference calculation. #' @param rsp (`logical`)\cr whether each subject is a responder or not. #' @param show_labels (`string`)\cr label visibility: one of "default", "visible" and "hidden". #' @param section_div (`string`)\cr string which should be repeated as a section divider after each group diff --git a/R/count_occurrences.R b/R/count_occurrences.R index e5f10013c7..41dc9ce71c 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -169,6 +169,7 @@ count_occurrences <- function(lyt, vars, var_labels = vars, show_labels = "hidden", + riskdiff = FALSE, nested = TRUE, ..., table_names = vars, @@ -176,6 +177,8 @@ count_occurrences <- function(lyt, .formats = NULL, .labels = NULL, .indent_mods = NULL) { + checkmate::assert_flag(riskdiff) + afun <- make_afun( a_count_occurrences, .stats = .stats, @@ -185,14 +188,25 @@ count_occurrences <- function(lyt, .ungroup_stats = .stats ) + extra_args <- if (isFALSE(riskdiff)) { + list(...) + } else { + list( + afun = list("s_count_occurrences" = afun), + .stats = .stats, + .indent_mods = .indent_mods, + s_args = list(...) + ) + } + analyze( lyt = lyt, vars = vars, - afun = afun, + afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), var_labels = var_labels, show_labels = show_labels, table_names = table_names, nested = nested, - extra_args = list(...) + extra_args = extra_args ) } diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index 66aae21e6d..1f83f703c7 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -268,6 +268,7 @@ count_occurrences_by_grade <- function(lyt, var, var_labels = var, show_labels = "default", + riskdiff = FALSE, nested = TRUE, ..., table_names = var, @@ -275,6 +276,8 @@ count_occurrences_by_grade <- function(lyt, .formats = NULL, .indent_mods = NULL, .labels = NULL) { + checkmate::assert_flag(riskdiff) + afun <- make_afun( a_count_occurrences_by_grade, .stats = .stats, @@ -283,15 +286,26 @@ count_occurrences_by_grade <- function(lyt, .ungroup_stats = "count_fraction" ) + extra_args <- if (isFALSE(riskdiff)) { + list(...) + } else { + list( + afun = list("s_count_occurrences_by_grade" = afun), + .stats = .stats, + .indent_mods = .indent_mods, + s_args = list(...) + ) + } + analyze( lyt = lyt, vars = var, var_labels = var_labels, show_labels = show_labels, - afun = afun, + afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), table_names = table_names, nested = nested, - extra_args = list(...) + extra_args = extra_args ) } diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index 4e3a0df2cb..359c8c2302 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -144,6 +144,7 @@ a_count_patients_with_event <- make_afun( #' @export count_patients_with_event <- function(lyt, vars, + riskdiff = FALSE, nested = TRUE, ..., table_names = vars, @@ -151,6 +152,8 @@ count_patients_with_event <- function(lyt, .formats = NULL, .labels = NULL, .indent_mods = NULL) { + checkmate::assert_flag(riskdiff) + afun <- make_afun( a_count_patients_with_event, .stats = .stats, @@ -159,12 +162,23 @@ count_patients_with_event <- function(lyt, .indent_mods = .indent_mods ) + extra_args <- if (isFALSE(riskdiff)) { + list(...) + } else { + list( + afun = list("s_count_patients_with_event" = afun), + .stats = .stats, + .indent_mods = .indent_mods, + s_args = list(...) + ) + } + analyze( lyt, vars, - afun = afun, + afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), nested = nested, - extra_args = list(...), + extra_args = extra_args, show_labels = ifelse(length(vars) > 1, "visible", "hidden"), table_names = table_names ) diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 3891973228..1b3e6cf396 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -157,12 +157,15 @@ count_patients_with_flags <- function(lyt, var, var_labels = var, show_labels = "hidden", + riskdiff = FALSE, nested = TRUE, ..., table_names = paste0("tbl_flags_", var), .stats = "count_fraction", .formats = NULL, .indent_mods = NULL) { + checkmate::assert_flag(riskdiff) + afun <- make_afun( a_count_patients_with_flags, .stats = .stats, @@ -171,15 +174,26 @@ count_patients_with_flags <- function(lyt, .ungroup_stats = .stats ) + extra_args <- if (isFALSE(riskdiff)) { + list(...) + } else { + list( + afun = list("s_count_patients_with_flags" = afun), + .stats = .stats, + .indent_mods = .indent_mods, + s_args = list(...) + ) + } + lyt <- analyze( lyt = lyt, vars = var, var_labels = var_labels, show_labels = show_labels, - afun = afun, + afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), table_names = table_names, nested = nested, - extra_args = list(...) + extra_args = extra_args ) lyt diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index 4a18f392a2..80cb1e17a2 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -212,8 +212,7 @@ prop_cmh <- function(ary) { #' @describeIn h_prop_diff_test performs the Chi-Squared test with Schouten correction. #' -#' @seealso For information on the Schouten correction (Schouten, 1980), -#' visit \url{https://onlinelibrary.wiley.com/doi/abs/10.1002/bimj.4710220305}. +#' @seealso Schouten correction is based upon \insertCite{Schouten1980-kd;textual}{tern}. #' #' #' @keywords internal diff --git a/R/riskdiff.R b/R/riskdiff.R new file mode 100644 index 0000000000..b908f45c67 --- /dev/null +++ b/R/riskdiff.R @@ -0,0 +1,142 @@ +#' Split Function to Configure Risk Difference Column +#' +#' @description `r lifecycle::badge("stable")` +#' +#' Wrapper function for [rtables::add_combo_levels()] which configures settings for the risk difference +#' column to be added to an `rtables` object. To add a risk difference column to a table, this function +#' should be used as `split_fun` in calls to [rtables::split_cols_by()], followed by setting argument +#' `riskdiff` to `TRUE` in all following analyze function calls. +#' +#' @param arm_x (`character`)\cr Name of reference arm to use in risk difference calculations. +#' @param arm_y (`character`)\cr Name of arm to compare to reference arm in risk difference calculations. +#' @param col_label (`character`)\cr Label to use when rendering the risk difference column within the table. +#' @param pct (`flag`)\cr whether output should be returned as percentages. Defaults to `TRUE`. +#' +#' @return A closure suitable for use as a split function (`split_fun`) within [rtables::split_cols_by()] +#' when creating a table layout. +#' +#' @seealso [stat_propdiff_ci()] for details on risk difference calculation. +#' +#' @examples +#' adae <- tern_ex_adae +#' adae$AESEV <- factor(adae$AESEV) +#' +#' lyt <- basic_table() %>% +#' split_cols_by("ARMCD", split_fun = add_riskdiff(arm_x = "ARM A", arm_y = "ARM B")) %>% +#' count_occurrences_by_grade( +#' var = "AESEV", +#' riskdiff = TRUE +#' ) +#' +#' tbl <- build_table(lyt, df = adae) +#' tbl +#' +#' @export +add_riskdiff <- function(arm_x, + arm_y, + col_label = "Risk Difference (%) (95% CI)", + pct = TRUE) { + sapply(c(arm_x, arm_y, col_label), checkmate::assert_character, len = 1) + combodf <- tibble::tribble( + ~valname, ~label, ~levelcombo, ~exargs, + paste("riskdiff", arm_x, arm_y, sep = "_"), col_label, c(arm_x, arm_y), list() + ) + if (pct) combodf$valname <- paste0(combodf$valname, "_pct") + add_combo_levels(combodf) +} + +#' Analysis Function to Calculate Risk Difference Column Values +#' +#' In the risk difference column, this function uses the statistics function associated with `afun` to +#' calculates risk difference values from arm X (reference group) and arm Y. These arms are specified +#' when configuring the risk difference column which is done using the [add_riskdiff()] split function in +#' the previous call to [rtables::split_cols_by()]. For all other columns, applies `afun` as usual. This +#' function utilizes the [stat_propdiff_ci()] function to perform risk difference calculations. +#' +#' @inheritParams argument_convention +#' @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()]. +#' +#' @seealso +#' * [stat_propdiff_ci()] for details on risk difference calculation. +#' * Split function [add_riskdiff()] which, when used as `split_fun` within [rtables::split_cols_by()] with +#' `riskdiff` argument set to `TRUE` in subsequent analyze functions calls, adds a risk difference column +#' to a table layout. +#' +#' @keywords internal +afun_riskdiff <- function(df, + labelstr = "", + .var, + .N_col, # nolint + .N_row, # nolint + .df_row, + .spl_context, + .all_col_counts, + .stats, + .indent_mods, + afun, + s_args = list()) { + if (!any(grepl("riskdiff", names(.spl_context)))) { + stop( + "Please set up levels to use in risk difference calculations using the `add_riskdiff` ", + "split function within `split_cols_by`. See ?add_riskdiff for details." + ) + } + 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) + afun_args <- afun_args[intersect(names(afun_args), names(as.list(args(afun[[1]]))))] + if ("denom" %in% names(s_args)) afun_args[["denom"]] <- NULL + + 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)) + } else { + arm_x <- strsplit(cur_split, "_")[[1]][2] + arm_y <- strsplit(cur_split, "_")[[1]][3] + if (length(.spl_context$cur_col_split[[1]]) > 1) { # Different split name for nested column splits + arm_spl_x <- gsub("riskdiff", "", paste0(strsplit(.spl_context$cur_col_id[1], "_")[[1]][c(1, 2)], collapse = "")) + arm_spl_y <- gsub("riskdiff", "", paste0(strsplit(.spl_context$cur_col_id[1], "_")[[1]][c(1, 3)], collapse = "")) + } else { + 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_x <- do.call(names(afun), args = c(list(df = df[df[[cur_var]] == arm_x, ], .N_col = N_col_x), afun_args, s_args)) + s_y <- do.call(names(afun), args = c(list(df = df[df[[cur_var]] == arm_y, ], .N_col = N_col_y), afun_args, s_args)) + + # Get statistic name and row names + stat <- ifelse("count_fraction" %in% names(s_x), "count_fraction", "unique") + if ("flag_variables" %in% names(s_args)) { + var_nms <- s_args$flag_variables + } else if (!is.null(names(s_x[[stat]]))) { + var_nms <- names(s_x[[stat]]) + } else { + var_nms <- "" + s_x[[stat]] <- list(s_x[[stat]]) + s_y[[stat]] <- list(s_y[[stat]]) + } + + # Calculate risk difference for each row, repeated if multiple statistics in table + pct <- tail(strsplit(cur_split, "_")[[1]], 1) == "pct" + rd_ci <- rep(stat_propdiff_ci( + lapply(s_x[[stat]], `[`, 1), lapply(s_y[[stat]], `[`, 1), + N_col_x, N_col_y, + list_names = var_nms, + pct = pct + ), max(1, length(.stats))) + + in_rows(.list = rd_ci, .formats = "xx.x (xx.x - xx.x)", .indent_mods = .indent_mods) + } +} diff --git a/R/stat.R b/R/stat.R index c55bf358bb..afc910227e 100644 --- a/R/stat.R +++ b/R/stat.R @@ -174,3 +174,58 @@ stat_mean_pval <- function(x, return(pv) } + +#' Proportion Difference and Confidence Interval +#' +#' @description `r lifecycle::badge("stable")` +#' +#' Function for calculating the proportion (or risk) difference and confidence interval between arm +#' X (reference group) and arm Y. Risk difference is calculated by subtracting cumulative incidence +#' in arm Y from cumulative incidence in arm X. +#' +#' @inheritParams argument_convention +#' @param x (`list` of `integer`)\cr list of number of occurrences in arm X (reference group). +#' @param y (`list` of `integer`)\cr list of number of occurrences in arm Y. Must be of equal length to `x`. +#' @param N_x (`numeric`)\cr total number of records in arm X. +#' @param N_y (`numeric`)\cr total number of records in arm Y. +#' @param list_names (`character`)\cr names of each variable/level corresponding to pair of proportions in +#' `x` and `y`. Must be of equal length to `x` and `y`. +#' @param pct (`flag`)\cr whether output should be returned as percentages. Defaults to `TRUE`. +#' +#' @return List of proportion differences and CIs corresponding to each pair of number of occurrences in `x` and +#' `y`. Each list element consists of 3 statistics: proportion difference, CI lower bound, and CI upper bound. +#' +#' @seealso Split function [add_riskdiff()] which, when used as `split_fun` within [rtables::split_cols_by()] +#' with `riskdiff` argument is set to `TRUE` in subsequent analyze functions, adds a column containing +#' proportion (risk) difference to an `rtables` layout. +#' +#' @examples +#' stat_propdiff_ci( +#' x = list(0.375), y = list(0.01), N_x = 5, N_y = 5, list_names = "x", conf_level = 0.9 +#' ) +#' +#' stat_propdiff_ci( +#' x = list(0.5, 0.75, 1), y = list(0.25, 0.05, 0.5), N_x = 10, N_y = 20, pct = FALSE +#' ) +#' +#' @export +stat_propdiff_ci <- function(x, + y, + N_x, # nolint + N_y, # nolint + list_names = NULL, + conf_level = 0.95, + pct = TRUE) { + checkmate::assert_list(x, types = "numeric") + checkmate::assert_list(y, types = "numeric", len = length(x)) + checkmate::assert_character(list_names, len = length(x), null.ok = TRUE) + rd_list <- lapply(seq_along(x), function(i) { + p_x <- x[[i]] / N_x + p_y <- y[[i]] / N_y + rd_ci <- p_x - p_y + c(-1, 1) * stats::qnorm((1 + conf_level) / 2) * + sqrt(p_x * (1 - p_x) / N_x + p_y * (1 - p_y) / N_y) + c(p_x - p_y, rd_ci) * ifelse(pct, 100, 1) + }) + names(rd_list) <- list_names + rd_list +} diff --git a/R/summarize_glm_count.R b/R/summarize_glm_count.R index 45fb7415ed..b8f6489a61 100644 --- a/R/summarize_glm_count.R +++ b/R/summarize_glm_count.R @@ -169,7 +169,7 @@ h_glm_count <- function(.var, #' @param .df_row (`data.frame`)\cr data set that includes all the variables that are called in `.var` and `variables`. #' @param conf_level (`numeric`)\cr value used to derive the confidence interval for the rate. #' @param obj (`glm.fit`)\cr fitted model object used to derive the mean rate estimates in each treatment arm. -#' @param `arm` (`string`)\cr group variable, for which the covariate adjusted means of multiple groups will be +#' @param arm (`string`)\cr group variable, for which the covariate adjusted means of multiple groups will be #' summarized. Specifically, the first level of `arm` variable is taken as the reference group. #' #' @return diff --git a/R/summarize_num_patients.R b/R/summarize_num_patients.R index 83207eb48a..8367b5241d 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -145,7 +145,10 @@ summarize_num_patients <- function(lyt, ), indent_mod = lifecycle::deprecated(), .indent_mods = 0L, + riskdiff = FALSE, ...) { + checkmate::assert_flag(riskdiff) + if (lifecycle::is_present(indent_mod)) { lifecycle::deprecate_warn("0.8.2", "summarize_num_patients(indent_mod)", "summarize_num_patients(.indent_mods)") .indent_mods <- indent_mod @@ -161,11 +164,22 @@ summarize_num_patients <- function(lyt, .labels = .labels ) + extra_args <- if (isFALSE(riskdiff)) { + list(...) + } else { + list( + afun = list("s_num_patients_content" = cfun), + .stats = .stats, + .indent_mods = .indent_mods, + s_args = list(...) + ) + } + summarize_row_groups( lyt = lyt, var = var, - cfun = cfun, - extra_args = list(...), + cfun = ifelse(isFALSE(riskdiff), cfun, afun_riskdiff), + extra_args = extra_args, indent_mod = .indent_mods ) } @@ -213,7 +227,10 @@ analyze_num_patients <- function(lyt, show_labels = c("default", "visible", "hidden"), indent_mod = lifecycle::deprecated(), .indent_mods = 0L, + riskdiff = FALSE, ...) { + checkmate::assert_flag(riskdiff) + if (lifecycle::is_present(indent_mod)) { lifecycle::deprecate_warn("0.8.2", "analyze_num_patients(indent_mod)", "analyze_num_patients(.indent_mods)") .indent_mods <- indent_mod @@ -229,12 +246,23 @@ analyze_num_patients <- function(lyt, .labels = .labels ) + extra_args <- if (isFALSE(riskdiff)) { + list(...) + } else { + list( + afun = list("s_num_patients_content" = afun), + .stats = .stats, + .indent_mods = .indent_mods, + s_args = list(...) + ) + } + analyze( - afun = afun, + afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), lyt = lyt, vars = vars, nested = nested, - extra_args = list(...), + extra_args = extra_args, show_labels = show_labels, indent_mod = .indent_mods ) diff --git a/R/utils_checkmate.R b/R/utils_checkmate.R index 8b3abcff26..c01af2aca6 100644 --- a/R/utils_checkmate.R +++ b/R/utils_checkmate.R @@ -11,7 +11,6 @@ #' @param na_level (`character`)\cr the string you have been using to represent NA or #' missing data. For `NA` values please consider using directly [is.na()] or #' similar approaches. -#' @param ... a collection of objects to test. #' #' @return Nothing if assertion passes, otherwise prints the error message. #' diff --git a/_pkgdown.yml b/_pkgdown.yml index 95869b630d..e1022acbee 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -12,10 +12,10 @@ navbar: reports: text: Reports menu: - - text: Coverage report - href: coverage-report/ - - text: Unit test report - href: unit-test-report/ + - text: Coverage report + href: coverage-report/ + - text: Unit test report + href: unit-test-report/ github: icon: fa-github href: https://github.com/insightsengineering/tern @@ -102,6 +102,7 @@ reference: desc: These functions help to work with the `rtables` package and may be moved there later. contents: + - add_riskdiff - add_rowcounts - append_varlabels - starts_with("as.rtable") diff --git a/inst/REFERENCES.bib b/inst/REFERENCES.bib index 88527d563b..879f39c540 100644 --- a/inst/REFERENCES.bib +++ b/inst/REFERENCES.bib @@ -25,3 +25,29 @@ @ARTICLE{Yan2010-jt month = aug, year = 2010 } + + +% The entry below contains non-ASCII chars that could not be converted +% to a LaTeX equivalent. +@ARTICLE{Schouten1980-kd, + title = "Comparing two independent binomial proportions by a modified chi + square test", + author = "Schouten, H J A and Molenaar, I W and Van Strik, R and Boomsma, + A", + abstract = "When using the chi square test to compare the proportions of + successes in two independent binomial samples, a new continuity + correction is proposed, which equals half the size of the + smaller sample. Exact computations of unconditional + tail‐probabilities, together with a theoretical argument, show + that this correction is more appropriate than the YATES + correction. This version of the chi square test is still + conservative, but less so, and as a consequence more powerful, + than the YATES corrected test.", + journal = "Biom. J.", + publisher = "Wiley", + volume = 22, + number = 3, + pages = "241--248", + year = 1980, + language = "en" +} diff --git a/man/add_riskdiff.Rd b/man/add_riskdiff.Rd new file mode 100644 index 0000000000..2bdfaead68 --- /dev/null +++ b/man/add_riskdiff.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/riskdiff.R +\name{add_riskdiff} +\alias{add_riskdiff} +\title{Split Function to Configure Risk Difference Column} +\usage{ +add_riskdiff( + arm_x, + arm_y, + col_label = "Risk Difference (\%) (95\% CI)", + pct = TRUE +) +} +\arguments{ +\item{arm_x}{(\code{character})\cr Name of reference arm to use in risk difference calculations.} + +\item{arm_y}{(\code{character})\cr Name of arm to compare to reference arm in risk difference calculations.} + +\item{col_label}{(\code{character})\cr Label to use when rendering the risk difference column within the table.} + +\item{pct}{(\code{flag})\cr whether output should be returned as percentages. Defaults to \code{TRUE}.} +} +\value{ +A closure suitable for use as a split function (\code{split_fun}) within \code{\link[rtables:split_cols_by]{rtables::split_cols_by()}} +when creating a table layout. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +Wrapper function for \code{\link[rtables:add_combo_levels]{rtables::add_combo_levels()}} which configures settings for the risk difference +column to be added to an \code{rtables} object. To add a risk difference column to a table, this function +should be used as \code{split_fun} in calls to \code{\link[rtables:split_cols_by]{rtables::split_cols_by()}}, followed by setting argument +\code{riskdiff} to \code{TRUE} in all following analyze function calls. +} +\examples{ +adae <- tern_ex_adae +adae$AESEV <- factor(adae$AESEV) + +lyt <- basic_table() \%>\% + split_cols_by("ARMCD", split_fun = add_riskdiff(arm_x = "ARM A", arm_y = "ARM B")) \%>\% + count_occurrences_by_grade( + var = "AESEV", + riskdiff = TRUE + ) + +tbl <- build_table(lyt, df = adae) +tbl + +} +\seealso{ +\code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk difference calculation. +} diff --git a/man/afun_riskdiff.Rd b/man/afun_riskdiff.Rd new file mode 100644 index 0000000000..5b69b18e9b --- /dev/null +++ b/man/afun_riskdiff.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/riskdiff.R +\name{afun_riskdiff} +\alias{afun_riskdiff} +\title{Analysis Function to Calculate Risk Difference Column Values} +\usage{ +afun_riskdiff( + df, + labelstr = "", + .var, + .N_col, + .N_row, + .df_row, + .spl_context, + .all_col_counts, + .stats, + .indent_mods, + afun, + s_args = list() +) +} +\arguments{ +\item{df}{(\code{data.frame})\cr data set containing all analysis variables.} + +\item{labelstr}{(\code{character})\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}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested +by a statistics function.} + +\item{.N_col}{(\code{integer})\cr column-wise N (column count) for the full column being analyzed that is typically +passed by \code{rtables}.} + +\item{.N_row}{(\code{integer})\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{.all_col_counts}{(\code{vector} of \code{integer})\cr 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{.stats}{(\code{character})\cr statistics to select for the table.} + +\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{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()}}. +} +\description{ +In the risk difference column, this function uses the statistics function associated with \code{afun} to +calculates risk difference values from arm X (reference group) and arm Y. These arms are specified +when configuring the risk difference column which is done using the \code{\link[=add_riskdiff]{add_riskdiff()}} split function in +the previous call to \code{\link[rtables:split_cols_by]{rtables::split_cols_by()}}. For all other columns, applies \code{afun} as usual. This +function utilizes the \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} function to perform risk difference calculations. +} +\seealso{ +\itemize{ +\item \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk difference calculation. +\item Split function \code{\link[=add_riskdiff]{add_riskdiff()}} which, when used as \code{split_fun} within \code{\link[rtables:split_cols_by]{rtables::split_cols_by()}} with +\code{riskdiff} argument set to \code{TRUE} in subsequent analyze functions calls, adds a risk difference column +to a table layout. +} +} +\keyword{internal} diff --git a/man/argument_convention.Rd b/man/argument_convention.Rd index 29cc3c4e97..9b1584d30e 100644 --- a/man/argument_convention.Rd +++ b/man/argument_convention.Rd @@ -9,6 +9,9 @@ \item{.aligns}{(\code{character})\cr alignment for table contents (not including labels). When \code{NULL}, \code{"center"} is applied. See \code{\link[formatters:list_formats]{formatters::list_valid_aligns()}} for a list of all currently supported alignments.} +\item{.all_col_counts}{(\code{vector} of \code{integer})\cr 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{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} \item{.in_ref_col}{(\code{logical})\cr \code{TRUE} when working with the reference level, \code{FALSE} otherwise.} @@ -86,6 +89,10 @@ Only considered if \code{draw = TRUE} is used.} \item{prune_zero_rows}{(\code{flag})\cr whether to prune all zero rows.} +\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{rsp}{(\code{logical})\cr whether each subject is a responder or not.} \item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} diff --git a/man/assertions.Rd b/man/assertions.Rd index 4be1d5379d..62d59e7564 100644 --- a/man/assertions.Rd +++ b/man/assertions.Rd @@ -86,8 +86,6 @@ Exact expected length of \code{x}.} \item{include_boundaries}{(\code{logical})\cr whether to include boundaries when testing for proportions.} - -\item{...}{a collection of objects to test.} } \value{ Nothing if assertion passes, otherwise prints the error message. diff --git a/man/count_occurrences.Rd b/man/count_occurrences.Rd index 364c0b6542..ee5386efe4 100644 --- a/man/count_occurrences.Rd +++ b/man/count_occurrences.Rd @@ -31,6 +31,7 @@ count_occurrences( vars, var_labels = vars, show_labels = "hidden", + riskdiff = FALSE, nested = TRUE, ..., table_names = vars, @@ -70,6 +71,10 @@ by a statistics function.} \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{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if 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.} diff --git a/man/count_occurrences_by_grade.Rd b/man/count_occurrences_by_grade.Rd index 786f78f67f..9f872ca742 100644 --- a/man/count_occurrences_by_grade.Rd +++ b/man/count_occurrences_by_grade.Rd @@ -32,6 +32,7 @@ count_occurrences_by_grade( var, var_labels = var, show_labels = "default", + riskdiff = FALSE, nested = TRUE, ..., table_names = var, @@ -77,6 +78,10 @@ for more information.} \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{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if 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.} diff --git a/man/count_patients_with_event.Rd b/man/count_patients_with_event.Rd index a33416b263..80d154854b 100644 --- a/man/count_patients_with_event.Rd +++ b/man/count_patients_with_event.Rd @@ -27,6 +27,7 @@ a_count_patients_with_event( count_patients_with_event( lyt, vars, + riskdiff = FALSE, nested = TRUE, ..., table_names = vars, @@ -64,6 +65,10 @@ passed by \code{rtables}.} \item{vars}{(\code{character})\cr variable names for the primary analysis variable to be iterated over.} +\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{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if 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.} diff --git a/man/count_patients_with_flags.Rd b/man/count_patients_with_flags.Rd index 8909b3113a..555fbceed7 100644 --- a/man/count_patients_with_flags.Rd +++ b/man/count_patients_with_flags.Rd @@ -31,6 +31,7 @@ count_patients_with_flags( var, var_labels = var, show_labels = "hidden", + riskdiff = FALSE, nested = TRUE, ..., table_names = paste0("tbl_flags_", var), @@ -71,6 +72,10 @@ by a statistics function.} \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{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if 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.} diff --git a/man/h_glm_count.Rd b/man/h_glm_count.Rd index daafc82a5e..0f38d0331d 100644 --- a/man/h_glm_count.Rd +++ b/man/h_glm_count.Rd @@ -41,10 +41,10 @@ used in the regression (poisson, quasipoisson).} \item{obj}{(\code{glm.fit})\cr fitted model object used to derive the mean rate estimates in each treatment arm.} -\item{conf_level}{(\code{numeric})\cr value used to derive the confidence interval for the rate.} - -\item{`arm`}{(\code{string})\cr group variable, for which the covariate adjusted means of multiple groups will be +\item{arm}{(\code{string})\cr group variable, for which the covariate adjusted means of multiple groups will be summarized. Specifically, the first level of \code{arm} variable is taken as the reference group.} + +\item{conf_level}{(\code{numeric})\cr value used to derive the confidence interval for the rate.} } \value{ \itemize{ diff --git a/man/h_prop_diff_test.Rd b/man/h_prop_diff_test.Rd index 8f7ef0882a..50938a4bef 100644 --- a/man/h_prop_diff_test.Rd +++ b/man/h_prop_diff_test.Rd @@ -43,7 +43,6 @@ Helper functions to implement various tests on the difference between two propor \seealso{ \code{\link[=prop_diff_test]{prop_diff_test()}} for implementation of these helper functions. -For information on the Schouten correction (Schouten, 1980), -visit \url{https://onlinelibrary.wiley.com/doi/abs/10.1002/bimj.4710220305}. +Schouten correction is based upon \insertCite{Schouten1980-kd;textual}{tern}. } \keyword{internal} diff --git a/man/stat_propdiff_ci.Rd b/man/stat_propdiff_ci.Rd new file mode 100644 index 0000000000..53fa66b57e --- /dev/null +++ b/man/stat_propdiff_ci.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/stat.R +\name{stat_propdiff_ci} +\alias{stat_propdiff_ci} +\title{Proportion Difference and Confidence Interval} +\usage{ +stat_propdiff_ci( + x, + y, + N_x, + N_y, + list_names = NULL, + conf_level = 0.95, + pct = TRUE +) +} +\arguments{ +\item{x}{(\code{list} of \code{integer})\cr list of number of occurrences in arm X (reference group).} + +\item{y}{(\code{list} of \code{integer})\cr list of number of occurrences in arm Y. Must be of equal length to \code{x}.} + +\item{N_x}{(\code{numeric})\cr total number of records in arm X.} + +\item{N_y}{(\code{numeric})\cr total number of records in arm Y.} + +\item{list_names}{(\code{character})\cr names of each variable/level corresponding to pair of proportions in +\code{x} and \code{y}. Must be of equal length to \code{x} and \code{y}.} + +\item{conf_level}{(\code{proportion})\cr confidence level of the interval.} + +\item{pct}{(\code{flag})\cr whether output should be returned as percentages. Defaults to \code{TRUE}.} +} +\value{ +List of proportion differences and CIs corresponding to each pair of number of occurrences in \code{x} and +\code{y}. Each list element consists of 3 statistics: proportion difference, CI lower bound, and CI upper bound. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +Function for calculating the proportion (or risk) difference and confidence interval between arm +X (reference group) and arm Y. Risk difference is calculated by subtracting cumulative incidence +in arm Y from cumulative incidence in arm X. +} +\examples{ +stat_propdiff_ci( + x = list(0.375), y = list(0.01), N_x = 5, N_y = 5, list_names = "x", conf_level = 0.9 +) + +stat_propdiff_ci( + x = list(0.5, 0.75, 1), y = list(0.25, 0.05, 0.5), N_x = 10, N_y = 20, pct = FALSE +) + +} +\seealso{ +Split function \code{\link[=add_riskdiff]{add_riskdiff()}} which, when used as \code{split_fun} within \code{\link[rtables:split_cols_by]{rtables::split_cols_by()}} +with \code{riskdiff} argument is set to \code{TRUE} in subsequent analyze functions, adds a column containing +proportion (risk) difference to an \code{rtables} layout. +} diff --git a/man/summarize_num_patients.Rd b/man/summarize_num_patients.Rd index 5959c9bf46..bd0845ae51 100644 --- a/man/summarize_num_patients.Rd +++ b/man/summarize_num_patients.Rd @@ -34,6 +34,7 @@ summarize_num_patients( "Number of events"), indent_mod = lifecycle::deprecated(), .indent_mods = 0L, + riskdiff = FALSE, ... ) @@ -48,6 +49,7 @@ analyze_num_patients( show_labels = c("default", "visible", "hidden"), indent_mod = lifecycle::deprecated(), .indent_mods = 0L, + riskdiff = FALSE, ... ) } @@ -87,6 +89,10 @@ by a statistics function.} \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{vars}{(\code{character})\cr variable names for the primary analysis variable to be iterated over.} diff --git a/tests/testthat/_snaps/count_occurrences.md b/tests/testthat/_snaps/count_occurrences.md index fc83109a30..aae53d747c 100644 --- a/tests/testthat/_snaps/count_occurrences.md +++ b/tests/testthat/_snaps/count_occurrences.md @@ -106,3 +106,81 @@ MH1 4 (44.4%) MH2 3 (33.3%) +# count_occurrences works as expected with risk difference column + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + ——————————————————————————————————————————————————————————————————————————————————————— + dcd A.1.1.1.1 17 (8.4%) 17 (9.6%) 14 (8.6%) -1.2 (-7.0 - 4.6) + dcd A.1.1.1.2 17 (8.4%) 14 (7.9%) 17 (10.5%) 0.5 (-5.0 - 6.0) + dcd B.1.1.1.1 15 (7.4%) 19 (10.7%) 15 (9.3%) -3.3 (-9.1 - 2.5) + dcd B.2.1.2.1 17 (8.4%) 16 (9.0%) 13 (8.0%) -0.6 (-6.3 - 5.1) + dcd B.2.2.3.1 17 (8.4%) 15 (8.5%) 16 (9.9%) -0.1 (-5.7 - 5.6) + dcd C.1.1.1.3 15 (7.4%) 13 (7.3%) 18 (11.1%) 0.1 (-5.2 - 5.4) + dcd C.2.1.2.1 20 (9.9%) 14 (7.9%) 10 (6.2%) 2.0 (-3.7 - 7.7) + dcd D.1.1.1.1 17 (8.4%) 18 (10.2%) 7 (4.3%) -1.8 (-7.6 - 4.1) + dcd D.1.1.4.2 16 (7.9%) 13 (7.3%) 16 (9.9%) 0.6 (-4.8 - 5.9) + dcd D.2.1.5.3 21 (10.4%) 20 (11.3%) 12 (7.4%) -0.9 (-7.2 - 5.4) + +--- + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + ————————————————————————————————————————————————————————————————————————————————————————————— + dcd A.1.1.1.1 8 11 11 -2.3 (-6.7 - 2.2) + dcd A.1.1.1.2 11 10 13 -0.2 (-4.8 - 4.4) + dcd B.1.1.1.1 12 14 11 -2.0 (-7.1 - 3.2) + dcd B.2.1.2.1 11 12 9 -1.3 (-6.2 - 3.5) + dcd B.2.2.3.1 7 9 15 -1.6 (-5.7 - 2.5) + dcd C.1.1.1.3 10 10 16 -0.7 (-5.2 - 3.8) + dcd C.2.1.2.1 13 12 7 -0.3 (-5.4 - 4.7) + dcd D.1.1.1.1 12 13 6 -1.4 (-6.4 - 3.6) + dcd D.1.1.4.2 12 8 15 1.4 (-3.1 - 5.9) + dcd D.2.1.5.3 14 16 10 -2.1 (-7.6 - 3.4) + dcd A.1.1.1.1 8 (4.0%) 11 (6.2%) 11 (6.8%) -2.3 (-6.7 - 2.2) + dcd A.1.1.1.2 11 (5.4%) 10 (5.6%) 13 (8.0%) -0.2 (-4.8 - 4.4) + dcd B.1.1.1.1 12 (5.9%) 14 (7.9%) 11 (6.8%) -2.0 (-7.1 - 3.2) + dcd B.2.1.2.1 11 (5.4%) 12 (6.8%) 9 (5.6%) -1.3 (-6.2 - 3.5) + dcd B.2.2.3.1 7 (3.5%) 9 (5.1%) 15 (9.3%) -1.6 (-5.7 - 2.5) + dcd C.1.1.1.3 10 (5.0%) 10 (5.6%) 16 (9.9%) -0.7 (-5.2 - 3.8) + dcd C.2.1.2.1 13 (6.4%) 12 (6.8%) 7 (4.3%) -0.3 (-5.4 - 4.7) + dcd D.1.1.1.1 12 (5.9%) 13 (7.3%) 6 (3.7%) -1.4 (-6.4 - 3.6) + dcd D.1.1.4.2 12 (5.9%) 8 (4.5%) 15 (9.3%) 1.4 (-3.1 - 5.9) + dcd D.2.1.5.3 14 (6.9%) 16 (9.0%) 10 (6.2%) -2.1 (-7.6 - 3.4) + dcd A.1.1.1.1 8/202 (4.0%) 11/177 (6.2%) 11/162 (6.8%) -2.3 (-6.7 - 2.2) + dcd A.1.1.1.2 11/202 (5.4%) 10/177 (5.6%) 13/162 (8.0%) -0.2 (-4.8 - 4.4) + dcd B.1.1.1.1 12/202 (5.9%) 14/177 (7.9%) 11/162 (6.8%) -2.0 (-7.1 - 3.2) + dcd B.2.1.2.1 11/202 (5.4%) 12/177 (6.8%) 9/162 (5.6%) -1.3 (-6.2 - 3.5) + dcd B.2.2.3.1 7/202 (3.5%) 9/177 (5.1%) 15/162 (9.3%) -1.6 (-5.7 - 2.5) + dcd C.1.1.1.3 10/202 (5.0%) 10/177 (5.6%) 16/162 (9.9%) -0.7 (-5.2 - 3.8) + dcd C.2.1.2.1 13/202 (6.4%) 12/177 (6.8%) 7/162 (4.3%) -0.3 (-5.4 - 4.7) + dcd D.1.1.1.1 12/202 (5.9%) 13/177 (7.3%) 6/162 (3.7%) -1.4 (-6.4 - 3.6) + dcd D.1.1.4.2 12/202 (5.9%) 8/177 (4.5%) 15/162 (9.3%) 1.4 (-3.1 - 5.9) + dcd D.2.1.5.3 14/202 (6.9%) 16/177 (9.0%) 10/162 (6.2%) -2.1 (-7.6 - 3.4) + +--- + + Code + res + Output + F M + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=122) (N=97) (N=98) (N=219) (N=80) (N=80) (N=64) (N=160) + ————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————— + dcd A.1.1.1.1 9 (7.4%) 10 (10.3%) 8 (8.2%) -2.9 (-10.6 - 4.7) 8 (10.0%) 7 (8.8%) 6 (9.4%) 1.3 (-7.8 - 10.3) + dcd A.1.1.1.2 6 (4.9%) 9 (9.3%) 12 (12.2%) -4.4 (-11.3 - 2.6) 11 (13.8%) 5 (6.2%) 5 (7.8%) 7.5 (-1.7 - 16.7) + dcd B.1.1.1.1 11 (9.0%) 10 (10.3%) 7 (7.1%) -1.3 (-9.2 - 6.6) 4 (5.0%) 9 (11.2%) 8 (12.5%) -6.2 (-14.7 - 2.2) + dcd B.2.1.2.1 10 (8.2%) 7 (7.2%) 10 (10.2%) 1.0 (-6.1 - 8.1) 7 (8.8%) 9 (11.2%) 3 (4.7%) -2.5 (-11.8 - 6.8) + dcd B.2.2.3.1 10 (8.2%) 11 (11.3%) 10 (10.2%) -3.1 (-11.1 - 4.8) 7 (8.8%) 4 (5.0%) 6 (9.4%) 3.7 (-4.1 - 11.6) + dcd C.1.1.1.3 10 (8.2%) 8 (8.2%) 12 (12.2%) -0.1 (-7.4 - 7.3) 5 (6.2%) 5 (6.2%) 6 (9.4%) 0.0 (-7.5 - 7.5) + dcd C.2.1.2.1 13 (10.7%) 6 (6.2%) 6 (6.1%) 4.5 (-2.8 - 11.7) 7 (8.8%) 8 (10.0%) 4 (6.2%) -1.3 (-10.3 - 7.8) + dcd D.1.1.1.1 10 (8.2%) 12 (12.4%) 4 (4.1%) -4.2 (-12.3 - 4.0) 7 (8.8%) 6 (7.5%) 3 (4.7%) 1.2 (-7.2 - 9.7) + dcd D.1.1.4.2 10 (8.2%) 5 (5.2%) 7 (7.1%) 3.0 (-3.5 - 9.6) 6 (7.5%) 8 (10.0%) 9 (14.1%) -2.5 (-11.2 - 6.2) + dcd D.2.1.5.3 12 (9.8%) 10 (10.3%) 9 (9.2%) -0.5 (-8.5 - 7.6) 9 (11.2%) 10 (12.5%) 3 (4.7%) -1.2 (-11.3 - 8.8) + diff --git a/tests/testthat/_snaps/count_occurrences_by_grade.md b/tests/testthat/_snaps/count_occurrences_by_grade.md index 646bc81f26..83270aa5f8 100644 --- a/tests/testthat/_snaps/count_occurrences_by_grade.md +++ b/tests/testthat/_snaps/count_occurrences_by_grade.md @@ -346,3 +346,28 @@ 1 10 (66.7%) 0 2 5 (33.3%) 15 (100%) +# count_occurrences_by_grade works as expected with risk difference column + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + —————————————————————————————————————————————————————————————————————————————————— + MILD 6 (3.0%) 4 (2.3%) 2 (1.2%) 0.7 (-2.5 - 3.9) + MODERATE 19 (9.4%) 15 (8.5%) 14 (8.6%) 0.9 (-4.8 - 6.7) + SEVERE 34 (16.8%) 38 (21.5%) 32 (19.8%) -4.6 (-12.6 - 3.3) + +--- + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + ———————————————————————————————————————————————————————————————————————————————————— + -Any- 25 (12.4%) 34 (19.2%) 28 (17.3%) -6.8 (-14.2 - 0.5) + MILD 1 (0.5%) 2 (1.1%) 0 -0.6 (-2.5 - 1.2) + MODERATE 7 (3.5%) 9 (5.1%) 6 (3.7%) -1.6 (-5.7 - 2.5) + SEVERE 17 (8.4%) 23 (13.0%) 22 (13.6%) -4.6 (-10.8 - 1.7) + diff --git a/tests/testthat/_snaps/count_patients_with_event.md b/tests/testthat/_snaps/count_patients_with_event.md index 36f5d902d4..ea259c7b9f 100644 --- a/tests/testthat/_snaps/count_patients_with_event.md +++ b/tests/testthat/_snaps/count_patients_with_event.md @@ -74,3 +74,24 @@ [1] 0 +# count_patients_with_flags works as expected with risk difference column + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=69) (N=73) (N=58) (N=142) + —————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————— + Total number of patients with at least one adverse event 59 (85.5%) 57 (78.1%) 48 (82.8%) 7.4 (-5.2 - 20.0) + +--- + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + ———————————————————————————————————————————————————————————————————————————————————————— + count 59 57 48 -3.0 (-12.3 - 6.3) + count_fraction 59 (29.2%) 57 (32.2%) 48 (29.6%) -3.0 (-12.3 - 6.3) + diff --git a/tests/testthat/_snaps/count_patients_with_flags.md b/tests/testthat/_snaps/count_patients_with_flags.md index 625419c757..4cfcbb9503 100644 --- a/tests/testthat/_snaps/count_patients_with_flags.md +++ b/tests/testthat/_snaps/count_patients_with_flags.md @@ -401,3 +401,27 @@ Grade 3-5 AE 47 (68.1%) 46 (63.0%) 41 (70.7%) Grade 4/5 AE 34 (49.3%) 38 (52.1%) 32 (55.2%) +# count_patients_with_flags works as expected with risk difference column + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=69) (N=73) (N=58) (N=142) + ———————————————————————————————————————————————————————————————————————————————————————————————— + SAE 53 (76.8%) 49 (67.1%) 39 (67.2%) 9.7 (-5.0 - 24.4) + SAE with fatal outcome 50 (72.5%) 47 (64.4%) 42 (72.4%) 8.1 (-7.1 - 23.3) + +--- + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + ———————————————————————————————————————————————————————————————————————————————————————————————— + SAE 53 49 39 -1.4 (-10.4 - 7.5) + SAE with fatal outcome 50 47 42 -1.8 (-10.6 - 7.0) + SAE 53 (26.2%) 49 (27.7%) 39 (24.1%) -1.4 (-10.4 - 7.5) + SAE with fatal outcome 50 (24.8%) 47 (26.6%) 42 (25.9%) -1.8 (-10.6 - 7.0) + diff --git a/tests/testthat/_snaps/stat.md b/tests/testthat/_snaps/stat.md index ff8b0dcb81..a0ffcbf3b2 100644 --- a/tests/testthat/_snaps/stat.md +++ b/tests/testthat/_snaps/stat.md @@ -328,3 +328,27 @@ attr(,"conf_level") [1] NA +# stat_propdiff_ci works with names and multiple values in x and y) + + Code + res + Output + $A + [1] 25.0000 -11.3387 61.3387 + + $B + [1] 70.00000 41.51302 98.48698 + + $C + [1] 50.00000 28.08694 71.91306 + + +# stat_propdiff_ci works with custom arguments) + + Code + res + Output + [[1]] + [1] 0.38000000 0.01382145 0.74617855 + + diff --git a/tests/testthat/_snaps/summarize_num_patients.md b/tests/testthat/_snaps/summarize_num_patients.md index 19167bd752..b18211cbfb 100644 --- a/tests/testthat/_snaps/summarize_num_patients.md +++ b/tests/testthat/_snaps/summarize_num_patients.md @@ -327,3 +327,67 @@ 17 0 1 (25.0%) 1 (11.1%) 15 1 (20.0%) 0 1 (11.1%) +# summarize_num_patients works as expected with risk difference column + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + —————————————————————————————————————————————————————————————————————————————————————————————————————————————————————— + cl D + Number of patients with at least one event 40 (19.8%) 40 (22.6%) 29 (17.9%) -2.8 (-11.1 - 5.5) + cl C + Number of patients with at least one event 31 (15.3%) 23 (13.0%) 25 (15.4%) 2.4 (-4.7 - 9.4) + cl B + Number of patients with at least one event 39 (19.3%) 36 (20.3%) 31 (19.1%) -1.0 (-9.1 - 7.0) + cl A + Number of patients with at least one event 31 (15.3%) 24 (13.6%) 27 (16.7%) 1.8 (-5.3 - 8.9) + +--- + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + —————————————————————————————————————————————————————————————————————————————————————————————————————————————————————— + cl D + Number of patients with at least one event 40 (19.8%) 40 (22.6%) 29 (17.9%) -2.8 (-11.1 - 5.5) + Number of events 66 57 43 -2.8 (-11.1 - 5.5) + cl D (n) 40 40 29 -2.8 (-11.1 - 5.5) + cl C + Number of patients with at least one event 31 (15.3%) 23 (13.0%) 25 (15.4%) 2.4 (-4.7 - 9.4) + Number of events 38 30 33 2.4 (-4.7 - 9.4) + cl C (n) 31 23 25 2.4 (-4.7 - 9.4) + cl B + Number of patients with at least one event 39 (19.3%) 36 (20.3%) 31 (19.1%) -1.0 (-9.1 - 7.0) + Number of events 59 57 51 -1.0 (-9.1 - 7.0) + cl B (n) 39 36 31 -1.0 (-9.1 - 7.0) + cl A + Number of patients with at least one event 31 (15.3%) 24 (13.6%) 27 (16.7%) 1.8 (-5.3 - 8.9) + Number of events 39 33 35 1.8 (-5.3 - 8.9) + cl A (n) 31 24 27 1.8 (-5.3 - 8.9) + +# analyze_num_patients works as expected with risk difference column + + 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) + +--- + + 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) + diff --git a/tests/testthat/test-count_occurrences.R b/tests/testthat/test-count_occurrences.R index 4b7ec4d507..46677852a8 100644 --- a/tests/testthat/test-count_occurrences.R +++ b/tests/testthat/test-count_occurrences.R @@ -116,3 +116,44 @@ testthat::test_that("count_occurrences functions as expected with label row spec res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) + +testthat::test_that("count_occurrences works as expected with risk difference column", { + # One statistic + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_occurrences( + vars = "AEDECOD", + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) + + # Multiple statistics, different id var + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_occurrences( + vars = "AEDECOD", + riskdiff = TRUE, + .stats = c("count", "count_fraction", "fraction"), + id = "SITEID" + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) + + # Nested column splits + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("SEX") %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_occurrences( + vars = "AEDECOD", + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) diff --git a/tests/testthat/test-count_occurrences_by_grade.R b/tests/testthat/test-count_occurrences_by_grade.R index 20f8dbdd79..a5c045267e 100644 --- a/tests/testthat/test-count_occurrences_by_grade.R +++ b/tests/testthat/test-count_occurrences_by_grade.R @@ -346,3 +346,37 @@ testthat::test_that("summarize_ and count_occurrences_by_grade works with pagina ) testthat::expect_identical(to_string_matrix(pag_result[[2]])[3, 1], "A") }) + +testthat::test_that("count_occurrences_by_grade works as expected with risk difference column", { + tern_ex_adae$AESEV <- factor(tern_ex_adae$AESEV) + + # Default parameters + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_occurrences_by_grade( + var = "AESEV", + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) + + # Grade groups, custom id var + grade_groups <- list("-Any-" = levels(tern_ex_adae$AESEV)) + + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_occurrences_by_grade( + var = "AESEV", + riskdiff = TRUE, + show_labels = "hidden", + .indent_mods = 1L, + grade_groups = grade_groups, + id = "SITEID" + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) diff --git a/tests/testthat/test-count_patients_with_event.R b/tests/testthat/test-count_patients_with_event.R index 56fea1aa1b..349f415ddd 100644 --- a/tests/testthat/test-count_patients_with_event.R +++ b/tests/testthat/test-count_patients_with_event.R @@ -120,3 +120,33 @@ testthat::test_that("s_count_patients_with_event works with factor filters", { res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) + +testthat::test_that("count_patients_with_flags works as expected with risk difference column", { + # One statistic + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_patients_with_event( + vars = "USUBJID", + filters = c("TRTEMFL" = "Y"), + .labels = c(count_fraction = "Total number of patients with at least one adverse event"), + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae, alt_counts_df = tern_ex_adsl) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) + + # Multiple statistics + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_patients_with_event( + vars = "USUBJID", + filters = c("TRTEMFL" = "Y"), + .stats = c("count", "count_fraction"), + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) diff --git a/tests/testthat/test-count_patients_with_flags.R b/tests/testthat/test-count_patients_with_flags.R index f60b5b934e..47b8a226f1 100644 --- a/tests/testthat/test-count_patients_with_flags.R +++ b/tests/testthat/test-count_patients_with_flags.R @@ -293,3 +293,43 @@ testthat::test_that("count_patients_with_flags custom variable label behaviour w res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) + +testthat::test_that("count_patients_with_flags works as expected with risk difference column", { + set.seed(1) + adae <- tern_ex_adae %>% + mutate( + SER = sample(c(TRUE, FALSE), nrow(.), replace = TRUE), + SERFATAL = sample(c(TRUE, FALSE), nrow(.), replace = TRUE) + ) %>% + var_relabel( + SER = "SAE", + SERFATAL = "SAE with fatal outcome" + ) + + # One statistic + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_patients_with_flags( + var = "USUBJID", + flag_variables = c("SER", "SERFATAL"), + riskdiff = TRUE + ) %>% + build_table(adae, alt_counts_df = tern_ex_adsl) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) + + # Multiple statistics + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + count_patients_with_flags( + var = "USUBJID", + flag_variables = c("SER", "SERFATAL"), + .stats = c("count", "count_fraction"), + riskdiff = TRUE + ) %>% + build_table(adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) diff --git a/tests/testthat/test-stat.R b/tests/testthat/test-stat.R index f1481f7673..3b02bcde98 100644 --- a/tests/testthat/test-stat.R +++ b/tests/testthat/test-stat.R @@ -275,3 +275,24 @@ testthat::test_that("stat_median_ci works for named numeric values when name is res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) + +testthat::test_that("stat_propdiff_ci works with names and multiple values in x and y)", { + x <- list(5, 7.5, 10) + y <- list(5, 1, 10) + list_names <- c("A", "B", "C") + + result <- stat_propdiff_ci(x = x, y = y, N_x = 10, N_y = 20, list_names = list_names) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) + +testthat::test_that("stat_propdiff_ci works with custom arguments)", { + x <- integer(0) + attr(x, "names") <- character(0) + + result <- stat_propdiff_ci(x = list(1.95), y = list(0.05), N_x = 5, N_y = 5, conf_level = 0.9, pct = FALSE) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) diff --git a/tests/testthat/test-summarize_num_patients.R b/tests/testthat/test-summarize_num_patients.R index 40fa9ddff4..4afed9e40b 100644 --- a/tests/testthat/test-summarize_num_patients.R +++ b/tests/testthat/test-summarize_num_patients.R @@ -253,3 +253,61 @@ testthat::test_that("analyze_num_patients works well for pagination", { ) testthat::expect_identical(to_string_matrix(pag_result[[3]])[6, 1], "17") }) + +testthat::test_that("summarize_num_patients works as expected with risk difference column", { + # One statistic + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + split_rows_by("AESOC", child_labels = "visible") %>% + summarize_num_patients( + "USUBJID", + .stats = "unique", + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) + + # Multiple statistics + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + split_rows_by("AESOC", child_labels = "visible") %>% + summarize_num_patients( + "USUBJID", + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) + +testthat::test_that("analyze_num_patients works as expected with risk difference column", { + # One statistic + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + analyze_num_patients( + vars = "USUBJID", + .stats = "unique", + .labels = c(unique = "Any SAE"), + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) + + # Multiple statistics + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + analyze_num_patients( + vars = "USUBJID", + .labels = c(unique = "Any SAE"), + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +})