Merge commit '8b4f7cfdceedb0add3be9c523e12ab36a7ecb505'

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cardx
 Title: Extra Analysis Results Data Utilities
-Version: 0.0.0.9027
+Version: 0.0.0.9031
 Authors@R: c(
     person("Daniel", "Sjoberg", , "[email protected]", role = c("aut", "cre")),
     person("F. Hoffmann-La Roche AG", role = c("cph", "fnd"))
@@ -15,12 +15,15 @@ Imports:
     cards (>= 0.0.0.9024),
     cli (>= 3.6.1),
     dplyr (>= 1.1.2),
+    glue (>= 1.6.2),
     rlang (>= 1.1.1),
     tidyr (>= 1.3.0)
 Suggests:
     broom (>= 1.0.5),
+    broom.helpers (>= 1.13.0),
     spelling,
-    testthat (>= 3.2.0)
+    testthat (>= 3.2.0),
+    withr
 Remotes: 
     insightsengineering/cards
 Config/Needs/website: insightsengineering/nesttemplate

NAMESPACE

@@ -1,12 +1,17 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(ard_regression,default)
 export("%>%")
 export(all_of)
 export(any_of)
 export(ard_aov)
+export(ard_chisqtest)
+export(ard_fishertest)
 export(ard_onewaytest)
 export(ard_paired_ttest)
 export(ard_paired_wilcoxtest)
+export(ard_proportion_ci)
+export(ard_regression)
 export(ard_ttest)
 export(ard_wilcoxtest)
 export(contains)
@@ -16,6 +21,12 @@ export(last_col)
 export(matches)
 export(num_range)
 export(one_of)
+export(proportion_ci_agresti_coull)
+export(proportion_ci_clopper_pearson)
+export(proportion_ci_jeffreys)
+export(proportion_ci_strat_wilson)
+export(proportion_ci_wald)
+export(proportion_ci_wilson)
 export(starts_with)
 export(where)
 import(rlang)

NEWS.md

@@ -1,4 +1,4 @@
-# cardx 0.0.0.9027
+# cardx 0.0.0.9031
 
 ### New Features
 * New package!

R/ard_chisqtest.R

@@ -0,0 +1,57 @@
+#' ARD Chi-squared Test
+#'
+#' @description
+#' Analysis results data for Pearson's Chi-squared Test.
+#' Calculated with `chisq.test(x = data[[variable]], y = data[[by]], ...)`
+#'
+#'
+#' @param data (`data.frame`)\cr
+#'   a data frame.
+#' @param by,variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column names to compare
+#' @param ... additional arguments passed to `fisher.test(...)`
+#'
+#' @return ARD data frame
+#' @export
+#'
+#' @examples
+#' cards::ADSL |>
+#'   ard_chisqtest(by = "ARM", variable = "AGEGR1")
+ard_chisqtest <- function(data, by, variable, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("broom.helpers", reference_pkg = "cards")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(data)
+  check_not_missing(variable)
+  check_not_missing(by)
+  check_class_data_frame(x = data)
+  cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
+  check_scalar(by)
+  check_scalar(variable)
+
+  # build ARD ------------------------------------------------------------------
+  cards::tidy_as_ard(
+    lst_tidy =
+      cards::eval_capture_conditions(
+        stats::chisq.test(x = data[[variable]], y = data[[by]], ...) |>
+          broom::tidy()
+      ),
+    tidy_result_names = c("statistic", "p.value", "parameter", "method"),
+    fun_args_to_record =
+      c("correct", "p", "rescale.p", "simulate.p.value", "B"),
+    formals = formals(stats::chisq.test),
+    passed_args = dots_list(...),
+    lst_ard_columns = list(group1 = by, variable = variable, context = "chisqtest")
+  ) |>
+    dplyr::mutate(
+      .after = "stat_name",
+      stat_label =
+        dplyr::case_when(
+          .data$stat_name %in% "statistic" ~ "X-squared Statistic",
+          .data$stat_name %in% "p.value" ~ "p-value",
+          .data$stat_name %in% "parameter" ~ "Degrees of Freedom",
+          TRUE ~ .data$stat_name,
+        )
+    )
+}

R/ard_fishertest.R

@@ -0,0 +1,59 @@
+#' ARD Fisher's Exact Test
+#'
+#' @description
+#' Analysis results data for Fisher's Exact Test.
+#' Calculated with `fisher.test(x = data[[variable]], y = data[[by]], ...)`
+#'
+#'
+#' @param data (`data.frame`)\cr
+#'   a data frame.
+#' @param by,variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column names to compare
+#' @param ... additional arguments passed to `fisher.test(...)`
+#'
+#' @return ARD data frame
+#' @export
+#'
+#' @examples
+#' cards::ADSL[1:30, ] |>
+#'   ard_fishertest(by = "ARM", variable = "AGEGR1")
+ard_fishertest <- function(data, by, variable, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("broom.helpers", reference_pkg = "cardx")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(data)
+  check_not_missing(variable)
+  check_not_missing(by)
+  check_class_data_frame(x = data)
+  cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
+  check_scalar(by)
+  check_scalar(variable)
+
+  # build ARD ------------------------------------------------------------------
+  cards::tidy_as_ard(
+    lst_tidy =
+      cards::eval_capture_conditions(
+        stats::fisher.test(x = data[[variable]], y = data[[by]], ...) |>
+          broom::tidy()
+      ),
+    tidy_result_names =
+      c("estimate", "p.value", "conf.low", "conf.high", "method", "alternative"),
+    fun_args_to_record =
+      c(
+        "workspace", "hybrid", "hybridPars", "control", "or",
+        "conf.int", "conf.level", "simulate.p.value", "B"
+      ),
+    formals = formals(stats::fisher.test),
+    passed_args = dots_list(...),
+    lst_ard_columns = list(group1 = by, variable = variable, context = "fishertest")
+  ) |>
+    dplyr::mutate(
+      .after = "stat_name",
+      stat_label =
+        dplyr::case_when(
+          .data$stat_name %in% "p.value" ~ "p-value",
+          TRUE ~ .data$stat_name,
+        )
+    )
+}

R/ard_proportion_ci.R

@@ -0,0 +1,82 @@
+#' ARD Proportion Confidence Intervals
+#'
+#' `r lifecycle::badge('experimental')`\cr
+#' Calculate confidence intervals for proportions.
+#'
+#' @inheritParams cards::ard_categorical
+#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   columns to include in summaries. Columns must be class `<logical>`
+#'   or `<numeric>` values coded as `c(0, 1)`.
+#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   columns to stratify calculations by
+#' @param conf.level (`numeric`)\cr
+#'   a scalar in `(0, 1)` indicating the confidence level.
+#'   Default is `0.95`
+#' @param method (`string`)\cr
+#'   string indicating the type of confidence interval to calculate.
+#'   Must be one of `r formals(ard_proportion_ci)[["method"]] |> eval() |> shQuote()`.
+#'   See `?proportion_ci` for details.
+#' @param strata,weights,max.iterations arguments passed to `proportion_ci_strat_wilson()`,
+#'   when `method='strat_wilson'`
+#'
+#' @return an ARD data frame
+#' @export
+#'
+#' @examples
+#' ard_proportion_ci(mtcars, variables = c(vs, am), method = "wilson")
+ard_proportion_ci <- function(data, variables, by = dplyr::group_vars(data),
+                              conf.level = 0.95,
+                              strata,
+                              weights = NULL,
+                              max.iterations = 10,
+                              method = c(
+                                "waldcc", "wald", "clopper-pearson",
+                                "wilson", "wilsoncc",
+                                "strat_wilson", "strat_wilsoncc",
+                                "agresti-coull", "jeffreys"
+                              )) {
+  # process inputs -------------------------------------------------------------
+  cards::process_selectors(data, variables = {{ variables }}, by = {{ by }})
+  method <- arg_match(method)
+  if (method %in% c("strat_wilson", "strat_wilsoncc")) {
+    cards::process_selectors(data, strata = strata)
+    check_scalar(strata)
+  }
+
+  # calculate confidence intervals ---------------------------------------------
+  cards::ard_complex(
+    data = data,
+    variables = {{ variables }},
+    by = {{ by }},
+    statistics =
+      ~ list(
+        prop_ci =
+          switch(method,
+            "waldcc" = \(x, ...) proportion_ci_wald(x, conf.level = conf.level, correct = TRUE),
+            "wald" = \(x, ...) proportion_ci_wald(x, conf.level = conf.level, correct = FALSE),
+            "wilsoncc" = \(x, ...) proportion_ci_wilson(x, conf.level = conf.level, correct = TRUE),
+            "wilson" = \(x, ...) proportion_ci_wilson(x, conf.level = conf.level, correct = FALSE),
+            "clopper-pearson" = \(x, ...) proportion_ci_clopper_pearson(x, conf.level = conf.level),
+            "agresti-coull" = \(x, ...) proportion_ci_agresti_coull(x, conf.level = conf.level),
+            "jeffreys" = \(x, ...) proportion_ci_jeffreys(x, conf.level = conf.level),
+            "strat_wilsoncc" = \(x, data, ...) {
+              proportion_ci_strat_wilson(x,
+                strata = data[[strata]], weights = weights,
+                max.iterations = max.iterations,
+                conf.level = conf.level, correct = TRUE
+              )
+            },
+            "strat_wilson" = \(x, data, ...) {
+              proportion_ci_strat_wilson(x,
+                strata = data[[strata]], weights = weights,
+                max.iterations = max.iterations,
+                conf.level = conf.level, correct = FALSE
+              )
+            }
+          )
+      )
+  ) |>
+    dplyr::mutate(
+      context = "proportion_ci"
+    )
+}

R/ard_regression.R

@@ -0,0 +1,81 @@
+#' Regression ARD
+#'
+#' Function takes a regression model object and converts it to a ARD
+#' structure using the `broom.helpers` package.
+#'
+#' @param x regression model object
+#' @param tidy_fun (`function`)\cr
+#'   a tidier. Default is [`broom.helpers::tidy_with_broom_or_parameters`]
+#' @param ... Arguments passed to `broom.helpers::tidy_plus_plus()`
+#'
+#' @return data frame
+#' @name ard_regression
+#'
+#' @examples
+#' lm(AGE ~ ARM, data = cards::ADSL) |>
+#'   ard_regression(add_estimate_to_reference_rows = TRUE)
+NULL
+
+#' @rdname ard_regression
+#' @export
+ard_regression <- function(x, ...) {
+  UseMethod("ard_regression")
+}
+
+#' @rdname ard_regression
+#' @export
+ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("broom.helpers", reference_pkg = "cards")
+
+  # check inputs ---------------------------------------------------------------
+  check_not_missing(x, "model")
+
+  # summarize model ------------------------------------------------------------
+  broom.helpers::tidy_plus_plus(
+    model = x,
+    tidy_fun = tidy_fun,
+    ...
+  ) |>
+    dplyr::mutate(
+      variable_level = dplyr::if_else(.data$var_type %in% "continuous", NA_character_, .data$label),
+      dplyr::across(-c("variable", "variable_level"), .fns = as.list)
+    ) |>
+    tidyr::pivot_longer(
+      cols = -c("variable", "variable_level"),
+      names_to = "stat_name",
+      values_to = "statistic"
+    ) |>
+    dplyr::filter(map_lgl(.data$statistic, Negate(is.na))) |>
+    dplyr::mutate(
+      statistic_fmt_fn =
+        lapply(
+          .data$statistic,
+          function(x) {
+            switch(is.integer(x), 0L) %||% # styler: off
+              switch(is.numeric(x), 1L) # styler: off
+          }
+        ),
+      context = "regression",
+      stat_label =
+        dplyr::case_when(
+          .data$stat_name %in% "var_label" ~ "Label",
+          .data$stat_name %in% "var_class" ~ "Class",
+          .data$stat_name %in% "var_type" ~ "Type",
+          .data$stat_name %in% "var_nlevels" ~ "N Levels",
+          .data$stat_name %in% "contrasts_type" ~ "Contrast Type",
+          .data$stat_name %in% "label" ~ "Level Label",
+          .data$stat_name %in% "n_obs" ~ "N Obs.",
+          .data$stat_name %in% "n_event" ~ "N Events",
+          .data$stat_name %in% "exposure" ~ "Exposure Time",
+          .data$stat_name %in% "estimate" ~ "Coefficient",
+          .data$stat_name %in% "std.error" ~ "Standard Error",
+          .data$stat_name %in% "p.value" ~ "p-value",
+          .data$stat_name %in% "conf.low" ~ "CI Lower Bound",
+          .data$stat_name %in% "conf.high" ~ "CI Upper Bound",
+          TRUE ~ .data$stat_name
+        )
+    ) |>
+    cards::tidy_ard_column_order() %>%
+    {structure(., class = c("card", class(.)))} # styler: off
+}

R/cardx-package.R

@@ -5,3 +5,5 @@
 ## usethis namespace: start
 ## usethis namespace: end
 NULL
+
+utils::globalVariables(c("."))