|
| 1 | +#' ARD ANOVA |
| 2 | +#' |
| 3 | +#' Prepare ANOVA results from the `stats::anova()` function. |
| 4 | +#' Users may pass a pre-calculated `stats::anova()` object or a list of |
| 5 | +#' formulas. In the latter case, the models will be constructed using the |
| 6 | +#' information passed and models will be passed to `stats::anova()`. |
| 7 | +#' |
| 8 | +#' @param x (`anova` or `data.frame`)\cr |
| 9 | +#' an object of class `'anova'` created with `stats::anova()` or |
| 10 | +#' a data frame |
| 11 | +#' @param formulas (`list`)\cr |
| 12 | +#' a list of formulas |
| 13 | +#' @param fn (`string`)\cr |
| 14 | +#' string naming the function to be called, e.g. `"glm"`. |
| 15 | +#' If function belongs to a library that is not attached, the package name |
| 16 | +#' must be specified in the `package` argument. |
| 17 | +#' @param fn.args (named `list`)\cr |
| 18 | +#' named list of arguments that will be passed to `fn`. |
| 19 | +#' @param package (`string`)\cr |
| 20 | +#' string of package name that will be temporarily loaded when function |
| 21 | +#' specified in `method` is executed. |
| 22 | +#' @param method (`string`)\cr |
| 23 | +#' string of the method used. Default is `"ANOVA results from `stats::anova()`"`. |
| 24 | +#' We provide the option to change this as `stats::anova()` can produce |
| 25 | +#' results from many types of models that may warrant a more precise |
| 26 | +#' description. |
| 27 | +#' @inheritParams rlang::args_dots_empty |
| 28 | +#' |
| 29 | +#' @details |
| 30 | +#' When a list of formulas is supplied to `ard_stats_anova()`, these formulas |
| 31 | +#' along with information from other arguments, are used to construct models |
| 32 | +#' and pass those models to `stats::anova()`. |
| 33 | +#' |
| 34 | +#' The models are constructed using `rlang::exec()`, which is similar to `do.call()`. |
| 35 | +#' |
| 36 | +#' ```r |
| 37 | +#' rlang::exec(.fn = fn, formula = formula, data = data, !!!fn.args) |
| 38 | +#' ``` |
| 39 | +#' |
| 40 | +#' The above function is executed in `withr::with_namespace(package)`, which |
| 41 | +#' allows for the use of `ard_stats_anova(fn)` from packages, |
| 42 | +#' e.g. `package = 'lme4'` must be specified when `fn = 'glmer'`. |
| 43 | +#' See example below. |
| 44 | +#' |
| 45 | +#' @return ARD data frame |
| 46 | +#' @name ard_stats_anova |
| 47 | +#' |
| 48 | +#' @examplesIf cards::is_pkg_installed(c("broom", "withr", "lme4"), reference_pkg = "cardx") |
| 49 | +#' anova( |
| 50 | +#' lm(mpg ~ am, mtcars), |
| 51 | +#' lm(mpg ~ am + hp, mtcars) |
| 52 | +#' ) |> |
| 53 | +#' ard_stats_anova() |
| 54 | +#' |
| 55 | +#' ard_stats_anova( |
| 56 | +#' x = mtcars, |
| 57 | +#' formulas = list(am ~ mpg, am ~ mpg + hp), |
| 58 | +#' fn = "glm", |
| 59 | +#' fn.args = list(family = binomial) |
| 60 | +#' ) |
| 61 | +#' |
| 62 | +#' ard_stats_anova( |
| 63 | +#' x = mtcars, |
| 64 | +#' formulas = list(am ~ 1 + (1 | vs), am ~ mpg + (1 | vs)), |
| 65 | +#' fn = "glmer", |
| 66 | +#' fn.args = list(family = binomial), |
| 67 | +#' package = "lme4" |
| 68 | +#' ) |
| 69 | +NULL |
| 70 | + |
| 71 | +#' @rdname ard_stats_anova |
| 72 | +#' @export |
| 73 | +ard_stats_anova <- function(x, ...) { |
| 74 | + UseMethod("ard_stats_anova") |
| 75 | +} |
| 76 | + |
| 77 | +#' @rdname ard_stats_anova |
| 78 | +#' @export |
| 79 | +ard_stats_anova.anova <- function(x, method = "ANOVA results from `stats::anova()`", ...) { |
| 80 | + # check inputs --------------------------------------------------------------- |
| 81 | + check_dots_empty() |
| 82 | + cards::check_pkg_installed("broom", reference_pkg = "cardx") |
| 83 | + check_string(method, message = "Argument {.arg method} must be a string of a function name.") |
| 84 | + |
| 85 | + # return df in cards formats ------------------------------------------------- |
| 86 | + lst_results <- |
| 87 | + cards::eval_capture_conditions( |
| 88 | + .anova_tidy_and_reshape(x, method = method) |
| 89 | + ) |
| 90 | + |
| 91 | + # final tidying up of cards data frame --------------------------------------- |
| 92 | + .anova_final_ard_prep(lst_results, method = method) |
| 93 | +} |
| 94 | + |
| 95 | + |
| 96 | +#' @rdname ard_stats_anova |
| 97 | +#' @export |
| 98 | +ard_stats_anova.data.frame <- function(x, |
| 99 | + formulas, |
| 100 | + fn, |
| 101 | + fn.args = list(), |
| 102 | + package = "base", |
| 103 | + method = "ANOVA results from `stats::anova()`", |
| 104 | + ...) { |
| 105 | + # check inputs --------------------------------------------------------------- |
| 106 | + check_dots_empty() |
| 107 | + check_string(package) |
| 108 | + cards::check_pkg_installed(c("broom", "withr", package), reference_pkg = "cardx") |
| 109 | + check_not_missing(formulas) |
| 110 | + check_not_missing(x) |
| 111 | + check_not_missing(fn) |
| 112 | + check_string(method, message = "Argument {.arg method} must be a string of a function name.") |
| 113 | + check_data_frame(x) |
| 114 | + check_string(fn) |
| 115 | + if (str_detect(fn, "::")) { |
| 116 | + cli::cli_abort(c( |
| 117 | + "Argument {.arg fn} cannot be namespaced.", |
| 118 | + i = "Put the package name in the {.arg package} argument." |
| 119 | + )) |
| 120 | + } |
| 121 | + |
| 122 | + # calculate results and return df in cards formats --------------------------- |
| 123 | + # process fn.args argument |
| 124 | + fn.args <- rlang::call_args(rlang::enexpr(fn.args)) |
| 125 | + |
| 126 | + # create models |
| 127 | + lst_results <- |
| 128 | + cards::eval_capture_conditions({ |
| 129 | + # first build the models |
| 130 | + models <- |
| 131 | + lapply( |
| 132 | + formulas, |
| 133 | + function(formula) { |
| 134 | + withr::with_namespace( |
| 135 | + package = package, |
| 136 | + call2(.fn = fn, formula = formula, data = x, !!!fn.args) |> |
| 137 | + eval_tidy() |
| 138 | + ) |
| 139 | + } |
| 140 | + ) |
| 141 | + |
| 142 | + # now calculate `stats::anova()` and reshape results |
| 143 | + rlang::inject(stats::anova(!!!models)) |> |
| 144 | + .anova_tidy_and_reshape(method = method) |
| 145 | + }) |
| 146 | + |
| 147 | + # final tidying up of cards data frame --------------------------------------- |
| 148 | + .anova_final_ard_prep(lst_results, method = method) |
| 149 | +} |
| 150 | + |
| 151 | +.anova_tidy_and_reshape <- function(x, method) { |
| 152 | + broom::tidy(x) |> |
| 153 | + dplyr::mutate( |
| 154 | + across(everything(), as.list), |
| 155 | + variable = paste0("model_", dplyr::row_number()) |
| 156 | + ) |> |
| 157 | + tidyr::pivot_longer( |
| 158 | + cols = -"variable", |
| 159 | + names_to = "stat_name", |
| 160 | + values_to = "stat" |
| 161 | + ) |> |
| 162 | + dplyr::filter(!is.na(.data$stat)) %>% |
| 163 | + # add one more row with the method |
| 164 | + { |
| 165 | + dplyr::bind_rows( |
| 166 | + ., |
| 167 | + dplyr::filter(., dplyr::n() == dplyr::row_number()) |> |
| 168 | + dplyr::mutate( |
| 169 | + stat_name = "method", |
| 170 | + stat = list(.env$method) |
| 171 | + ) |
| 172 | + ) |
| 173 | + } |
| 174 | +} |
| 175 | + |
| 176 | +.anova_final_ard_prep <- function(lst_results, method) { |
| 177 | + # saving the results in data frame ------------------------------------------- |
| 178 | + df_card <- |
| 179 | + if (!is.null(lst_results[["result"]])) { |
| 180 | + lst_results[["result"]] |
| 181 | + } else { # if there was an error return a shell of an ARD data frame |
| 182 | + dplyr::tibble( |
| 183 | + variable = "model_1", |
| 184 | + stat_name = c("p.value", "method"), |
| 185 | + stat = list(NULL, method) |
| 186 | + ) |
| 187 | + } |
| 188 | + |
| 189 | + # final tidying up of cards data frame --------------------------------------- |
| 190 | + df_card |> |
| 191 | + dplyr::mutate( |
| 192 | + warning = lst_results["warning"], |
| 193 | + error = lst_results["error"], |
| 194 | + context = "stats_anova", |
| 195 | + fmt_fn = lapply( |
| 196 | + .data$stat, |
| 197 | + function(x) { |
| 198 | + switch(is.integer(x), |
| 199 | + 0L |
| 200 | + ) %||% switch(is.numeric(x), |
| 201 | + 1L |
| 202 | + ) |
| 203 | + } |
| 204 | + ), |
| 205 | + stat_label = |
| 206 | + dplyr::case_when( |
| 207 | + .data$stat_name %in% "p.value" ~ "p-value", |
| 208 | + .data$stat_name %in% "sumsq" ~ "Sum of Squares", |
| 209 | + .data$stat_name %in% "rss" ~ "Residual Sum of Squares", |
| 210 | + .data$stat_name %in% "df" ~ "Degrees of Freedom", |
| 211 | + .data$stat_name %in% "df.residual" ~ "df for residuals", |
| 212 | + .default = .data$stat_name |
| 213 | + ) |
| 214 | + ) |> |
| 215 | + cards::tidy_ard_column_order() %>% |
| 216 | + {structure(., class = c("card", class(.)))} # styler: off |
| 217 | +} |
0 commit comments