|
| 1 | +#' ARD Cochran-Mantel-Haenszel Chi-Squared Test |
| 2 | +#' |
| 3 | +#' @description |
| 4 | +#' Analysis results data for Cochran-Mantel-Haenszel Chi-Squared Test for count data. |
| 5 | +#' Calculated with `mantelhaen.test(x = data[[variables]], y = data[[by]], z = data[[strata]], ...)`. |
| 6 | +#' |
| 7 | +#' @param data (`data.frame`)\cr |
| 8 | +#' a data frame. |
| 9 | +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr |
| 10 | +#' column name to compare by. |
| 11 | +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr |
| 12 | +#' column names to be compared. Independent tests will be computed for each variable. |
| 13 | +#' @param strata ([`tidy-select`][dplyr::dplyr_tidy_select])\cr |
| 14 | +#' column name to stratify by. |
| 15 | +#' @param ... additional arguments passed to `stats::mantelhaen.test(...)` |
| 16 | +#' |
| 17 | +#' @return ARD data frame |
| 18 | +#' @name ard_stats_mantelhaen_test |
| 19 | +#' @export |
| 20 | +#' |
| 21 | +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom")) |
| 22 | +#' cards::ADSL |> |
| 23 | +#' ard_stats_mantelhaen_test(by = "ARM", variables = "AGEGR1", strata = "SEX") |
| 24 | +ard_stats_mantelhaen_test <- function(data, by, variables, strata, ...) { |
| 25 | + set_cli_abort_call() |
| 26 | + |
| 27 | + # check installed packages --------------------------------------------------- |
| 28 | + check_pkg_installed("broom") |
| 29 | + |
| 30 | + # check/process inputs ------------------------------------------------------- |
| 31 | + check_not_missing(data) |
| 32 | + check_not_missing(variables) |
| 33 | + check_not_missing(by) |
| 34 | + check_not_missing(strata) |
| 35 | + cards::process_selectors(data, by = {{ by }}, variables = {{ variables }}, strata = {{ strata }}) |
| 36 | + check_class(variables, "character") |
| 37 | + check_scalar(by) |
| 38 | + check_scalar(strata) |
| 39 | + check_class(data[[variables]], c("character", "factor")) |
| 40 | + check_class(data[[by]], c("character", "factor")) |
| 41 | + check_class(data[[strata]], c("character", "factor")) |
| 42 | + |
| 43 | + # return empty ARD if no variables selected ---------------------------------- |
| 44 | + if (is_empty(variables)) { |
| 45 | + return(dplyr::tibble() |> cards::as_card()) |
| 46 | + } |
| 47 | + |
| 48 | + dots <- dots_list(...) |
| 49 | + formals_cmh <- formals(asNamespace("stats")[["mantelhaen.test"]])[-c(1:3)] |
| 50 | + if (!"alternative" %in% names(dots)) formals_cmh$alternative <- "two.sided" |
| 51 | + mantelhaen.args <- c(dots, formals_cmh[setdiff(names(formals_cmh), names(dots))]) |
| 52 | + |
| 53 | + # build ARD ------------------------------------------------------------------ |
| 54 | + cards::ard_complex( |
| 55 | + data = data, |
| 56 | + variables = all_of(variables), |
| 57 | + statistic = all_of(variables) ~ list( |
| 58 | + stats_mantelhaen_test = .calc_mantelhaen_test(data, by, variables, strata, mantelhaen.args) |
| 59 | + ) |
| 60 | + ) |> |
| 61 | + dplyr::select(-"stat_label") |> |
| 62 | + dplyr::left_join( |
| 63 | + .df_mantelhaentest_stat_labels(exact = mantelhaen.args$exact), |
| 64 | + by = "stat_name" |
| 65 | + ) |> |
| 66 | + dplyr::mutate( |
| 67 | + group1 = by, |
| 68 | + group2 = strata, |
| 69 | + stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name), |
| 70 | + context = "stats_mantelhaen_test", |
| 71 | + ) |> |
| 72 | + cards::as_card() |> |
| 73 | + cards::tidy_ard_column_order() |> |
| 74 | + cards::tidy_ard_row_order() |
| 75 | +} |
| 76 | + |
| 77 | +.calc_mantelhaen_test <- function(data, by, variables, strata, mantelhaen.args) { |
| 78 | + cards::as_cards_fn( |
| 79 | + \(x, data, variables, ...) { |
| 80 | + stats::mantelhaen.test( |
| 81 | + x = x, |
| 82 | + y = data[[by]], |
| 83 | + z = data[[strata]], |
| 84 | + mantelhaen.args |
| 85 | + ) |> |
| 86 | + broom::tidy() |> |
| 87 | + dplyr::bind_cols(mantelhaen.args) |
| 88 | + }, |
| 89 | + stat_names = c( |
| 90 | + "estimate", "statistic", "p.value", "parameter", "correct", "exact", "conf.level", "conf.low", "conf.high" |
| 91 | + ) |
| 92 | + ) |
| 93 | +} |
| 94 | + |
| 95 | +.df_mantelhaentest_stat_labels <- function(exact = FALSE) { |
| 96 | + dplyr::tribble( |
| 97 | + ~stat_name, ~stat_label, |
| 98 | + "estimate", ifelse(exact, "Mantel-Haenszel Odds Ratio Estimate", "Conditional Maximum Likelihood Odds Ratio Estimate"), |
| 99 | + "statistic", ifelse(exact, "Mantel-Haenszel X-squared Statistic", "Generalized Cochran-Mantel-Haenszel Statistic"), |
| 100 | + "p.value", "p-value", |
| 101 | + "parameter", "Degrees of Freedom", |
| 102 | + "correct", "Continuity Correction", |
| 103 | + "exact", "Exact Conditional Test", |
| 104 | + "conf.level", "CI Confidence Level", |
| 105 | + "conf.low", "CI Lower Bound", |
| 106 | + "conf.high", "CI Upper Bound" |
| 107 | + ) |
| 108 | +} |
0 commit comments