Merge branch 'main' into 46_ard_basic

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cardx
 Title: Extra Analysis Results Data Utilities
-Version: 0.0.0.9038
+Version: 0.0.0.9043
 Authors@R: c(
     person("Daniel", "Sjoberg", , "[email protected]", role = c("aut", "cre")),
     person("F. Hoffmann-La Roche AG", role = c("cph", "fnd"))
@@ -14,7 +14,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues
 Depends:
     R (>= 4.1)
 Imports:
-    cards (>= 0.0.0.9044),
+    cards (>= 0.0.0.9049),
     cli (>= 3.6.1),
     dplyr (>= 1.1.2),
     glue (>= 1.6.2),

NAMESPACE

@@ -7,6 +7,8 @@ export(any_of)
 export(ard_chisqtest)
 export(ard_fishertest)
 export(ard_kruskaltest)
+export(ard_mcnemartest)
+export(ard_moodtest)
 export(ard_paired_ttest)
 export(ard_paired_wilcoxtest)
 export(ard_proportion_ci)

NEWS.md

@@ -1,4 +1,4 @@
-# cardx 0.0.0.9038
+# cardx 0.0.0.9043
 
 ### New Features
 * New package!

R/ard_chisqtest.R

@@ -25,7 +25,7 @@ ard_chisqtest <- function(data, by, variable, ...) {
   check_not_missing(data)
   check_not_missing(variable)
   check_not_missing(by)
-  check_class_data_frame(x = data)
+  check_data_frame(data)
   cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
   check_scalar(by)
   check_scalar(variable)

R/ard_fishertest.R

@@ -25,7 +25,7 @@ ard_fishertest <- function(data, by, variable, ...) {
   check_not_missing(data)
   check_not_missing(variable)
   check_not_missing(by)
-  check_class_data_frame(x = data)
+  check_data_frame(data)
   cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
   check_scalar(by)
   check_scalar(variable)

R/ard_kruskaltest.R

@@ -26,7 +26,7 @@ ard_kruskaltest <- function(data, by, variable) {
   check_not_missing(data)
   check_not_missing(variable)
   check_not_missing(by)
-  check_class_data_frame(x = data)
+  check_data_frame(data)
   cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
   check_scalar(by)
   check_scalar(variable)

R/ard_mcnemartest.R

@@ -0,0 +1,108 @@
+#' ARD McNemar's Test
+#'
+#' @description
+#' Analysis results data for McNemar's statistical test.
+#'
+#' @param data (`data.frame`)\cr
+#'   a data frame. See below for details.
+#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column name to compare by.
+#' @param variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column name to be compared.
+#' @param ... arguments passed to `stats::mcnemar.test(...)`
+#'
+#' @return ARD data frame
+#' @name ard_mcnemartest
+#'
+#' @details
+#' For the `ard_mcnemartest()` function, the data is expected to be one row per subject.
+#' The data is passed as `stats::mcnemar.test(x = data[[variable]], y = data[[by]], ...)`.
+#' Please use `table(x = data[[variable]], y = data[[by]])` to check the contingency table.
+#'
+#' @examples
+#' cards::ADSL |>
+#'   ard_mcnemartest(by = "SEX", variable = "EFFFL")
+#'
+NULL
+
+#' @rdname ard_mcnemartest
+#' @export
+ard_mcnemartest <- function(data, by, variable, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("broom", reference_pkg = "cardx")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(data)
+  check_not_missing(variable)
+  check_not_missing(by)
+  check_data_frame(data)
+  data <- dplyr::ungroup(data)
+  cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
+  check_scalar(by)
+  check_scalar(variable)
+
+  # build ARD ------------------------------------------------------------------
+  .format_mcnemartest_results(
+    by = by,
+    variable = variable,
+    lst_tidy =
+      cards::eval_capture_conditions(
+        stats::mcnemar.test(x = data[[variable]], y = data[[by]], ...) |>
+          broom::tidy()
+      ),
+    ...
+  )
+}
+
+#' Convert McNemar's test to ARD
+#'
+#' @inheritParams cards::tidy_as_ard
+#' @inheritParams stats::mcnemar.test
+#' @param by (`string`)\cr by column name
+#' @param variable (`string`)\cr variable column name
+#' @param ... passed to `stats::mcnemar.test(...)`
+#'
+#' @return ARD data frame
+#'
+#' @examples
+#' cardx:::.format_mcnemartest_results(
+#'   by = "ARM",
+#'   variable = "AGE",
+#'   lst_tidy =
+#'     cards::eval_capture_conditions(
+#'       stats::mcnemar.test(cards::ADSL[["SEX"]], cards::ADSL[["EFFFL"]]) |>
+#'         broom::tidy()
+#'     )
+#' )
+#'
+#' @keywords internal
+.format_mcnemartest_results <- function(by, variable, lst_tidy, ...) {
+  # build ARD ------------------------------------------------------------------
+  ret <-
+    cards::tidy_as_ard(
+      lst_tidy = lst_tidy,
+      tidy_result_names = c("statistic", "p.value", "method"),
+      fun_args_to_record = c("correct"),
+      formals = formals(asNamespace("stats")[["mcnemar.test"]]),
+      passed_args = dots_list(...),
+      lst_ard_columns = list(group1 = by, variable = variable, context = "mcnemartest")
+    )
+
+  # add the stat label ---------------------------------------------------------
+  ret |>
+    dplyr::left_join(
+      .df_mcnemar_stat_labels(),
+      by = "stat_name"
+    ) |>
+    dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
+    cards::tidy_ard_column_order()
+}
+
+.df_mcnemar_stat_labels <- function() {
+  dplyr::tribble(
+    ~stat_name, ~stat_label,
+    "statistic", "X-squared Statistic",
+    "parameter", "Degrees of Freedom",
+    "p.value", "p-value",
+  )
+}

R/ard_moodtest.R

@@ -0,0 +1,101 @@
+#' ARD Mood Test
+#'
+#' @description
+#' Analysis results data for Mood two sample test of scale. Note this not to be confused with
+#' the Brown-Mood test of medians.
+#'
+#' @param data (`data.frame`)\cr
+#'   a data frame. See below for details.
+#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column name to compare by.
+#' @param variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column name to be compared.
+#' @param ... arguments passed to `mood.test(...)`
+#'
+#' @return ARD data frame
+#' @name ard_moodtest
+#'
+#' @details
+#' For the `ard_moodtest()` function, the data is expected to be one row per subject.
+#' The data is passed as `mood.test(data[[variable]] ~ data[[by]], ...)`.
+#' @rdname ard_moodtest
+#' @export
+#'
+#' @examples
+#' cards::ADSL |>
+#'   ard_moodtest(by = "SEX", variable = "AGE")
+ard_moodtest <- function(data, by, variable, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("broom", reference_pkg = "cardx")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(data)
+  check_not_missing(variable)
+  check_not_missing(by)
+  check_data_frame(data)
+  data <- dplyr::ungroup(data)
+  cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
+  check_scalar(by)
+  check_scalar(variable)
+
+  # build ARD ------------------------------------------------------------------
+  .format_moodtest_results(
+    by = by,
+    variable = variable,
+    lst_tidy =
+      cards::eval_capture_conditions(
+        stats::mood.test(data[[variable]] ~ data[[by]], ...) |>
+          broom::tidy()
+      ),
+    ...
+  )
+}
+#' Convert mood test results to ARD
+#'
+#' @inheritParams cards::tidy_as_ard
+#' @inheritParams stats::mood.test
+#' @param by (`string`)\cr by column name
+#' @param variable (`string`)\cr variable column name
+#' @param ... passed to `mood.test(...)`
+#'
+#' @return ARD data frame
+#' @keywords internal
+#' @examples
+#' cardx:::.format_moodtest_results(
+#'   by = "SEX",
+#'   variable = "AGE",
+#'   lst_tidy =
+#'     cards::eval_capture_conditions(
+#'       stats::mood.test(ADSL[["AGE"]] ~ ADSL[["SEX"]]) |>
+#'         broom::tidy()
+#'     )
+#' )
+.format_moodtest_results <- function(by, variable, lst_tidy, ...) {
+  # build ARD ------------------------------------------------------------------
+  ret <-
+    cards::tidy_as_ard(
+      lst_tidy = lst_tidy,
+      tidy_result_names = c("statistic", "p.value", "method", "alternative"),
+      formals = formals(asNamespace("stats")[["mood.test.default"]]),
+      passed_args = c(dots_list(...)),
+      lst_ard_columns = list(group1 = by, variable = variable, context = "moodtest")
+    )
+
+  # add the stat label ---------------------------------------------------------
+  ret |>
+    dplyr::left_join(
+      .df_moodtest_stat_labels(),
+      by = "stat_name"
+    ) |>
+    dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
+    cards::tidy_ard_column_order()
+}
+
+.df_moodtest_stat_labels <- function() {
+  dplyr::tribble(
+    ~stat_name, ~stat_label,
+    "statistic", "Z-Statistic",
+    "p.value", "p-value",
+    "alternative", "Alternative Hypothesis"
+  )
+}

R/ard_regression.R

@@ -44,13 +44,13 @@ ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_
     tidyr::pivot_longer(
       cols = -c("variable", "variable_level"),
       names_to = "stat_name",
-      values_to = "statistic"
+      values_to = "stat"
     ) |>
-    dplyr::filter(map_lgl(.data$statistic, Negate(is.na))) |>
+    dplyr::filter(map_lgl(.data$stat, Negate(is.na))) |>
     dplyr::mutate(
-      statistic_fmt_fn =
+      fmt_fn =
         lapply(
-          .data$statistic,
+          .data$stat,
           function(x) {
             switch(is.integer(x), 0L) %||% # styler: off
               switch(is.numeric(x), 1L) # styler: off

R/ard_ttest.R

@@ -50,7 +50,7 @@ ard_ttest <- function(data, by, variable, ...) {
   check_not_missing(data)
   check_not_missing(variable)
   check_not_missing(by)
-  check_class_data_frame(x = data)
+  check_data_frame(data)
   data <- dplyr::ungroup(data)
   cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
   check_scalar(by)
@@ -81,7 +81,7 @@ ard_paired_ttest <- function(data, by, variable, id, ...) {
   check_not_missing(variable)
   check_not_missing(by)
   check_not_missing(id)
-  check_class_data_frame(x = data)
+  check_data_frame(data)
   data <- dplyr::ungroup(data)
   cards::process_selectors(data, by = {{ by }}, variable = {{ variable }}, id = {{ id }})
   check_scalar(by)

R/ard_wilcoxtest.R

@@ -50,7 +50,7 @@ ard_wilcoxtest <- function(data, by, variable, ...) {
   check_not_missing(data)
   check_not_missing(variable)
   check_not_missing(by)
-  check_class_data_frame(x = data)
+  check_data_frame(data)
   data <- dplyr::ungroup(data)
   cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
   check_scalar(by)
@@ -81,7 +81,7 @@ ard_paired_wilcoxtest <- function(data, by, variable, id, ...) {
   check_not_missing(variable)
   check_not_missing(by)
   check_not_missing(id)
-  check_class_data_frame(x = data)
+  check_data_frame(data)
   data <- dplyr::ungroup(data)
   cards::process_selectors(data, by = {{ by }}, variable = {{ variable }}, id = {{ id }})
   check_scalar(by)
@@ -105,17 +105,23 @@ ard_paired_wilcoxtest <- function(data, by, variable, id, ...) {
   )
 }
 
+
 #' Convert Wilcoxon test to ARD
 #'
 #' @inheritParams cards::tidy_as_ard
 #' @inheritParams stats::wilcox.test
 #' @param by (`string`)\cr by column name
 #' @param variable (`string`)\cr variable column name
-#' @param ... passed to `wilcox.test(...)`
+#' @param ... passed to `stats::wilcox.test(...)`
 #'
 #' @return ARD data frame
-#' @keywords internal
+#'
 #' @examples
+#' # Pre-processing ADSL to have grouping factor (ARM here) with 2 levels
+#' ADSL <- cards::ADSL |>
+#'   dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
+#'   ard_wilcoxtest(by = "ARM", variable = "AGE")
+#'
 #' cardx:::.format_wilcoxtest_results(
 #'   by = "ARM",
 #'   variable = "AGE",
@@ -126,6 +132,8 @@ ard_paired_wilcoxtest <- function(data, by, variable, id, ...) {
 #'         broom::tidy()
 #'     )
 #' )
+#'
+#' @keywords internal
 .format_wilcoxtest_results <- function(by, variable, lst_tidy, paired, ...) {
   # build ARD ------------------------------------------------------------------
   ret <-