Merge branch 'main' into 37-ard-for-moods-test

Signed-off-by: Zelos Zhu <[email protected]>
insightsengineering · Feb 19, 2024 · 444c5fa · 444c5fa
2 parents dcd8136 + 8d5fbc3
commit 444c5fa
Show file tree

Hide file tree

Showing 12 changed files with 191 additions and 8 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: cardx
 Title: Extra Analysis Results Data Utilities
-Version: 0.0.0.9033
+Version: 0.0.0.9036
 Authors@R: c(
     person("Daniel", "Sjoberg", , "[email protected]", role = c("aut", "cre")),
     person("F. Hoffmann-La Roche AG", role = c("cph", "fnd"))
@@ -10,9 +10,9 @@ License: Apache License 2.0
 URL: https://github.com/insightsengineering/cardx
 BugReports: https://github.com/insightsengineering/cardx/issues
 Depends:
-    R (>= 4.0)
+    R (>= 4.1)
 Imports:
-    cards (>= 0.0.0.9035),
+    cards (>= 0.0.0.9039),
     cli (>= 3.6.1),
     dplyr (>= 1.1.2),
     glue (>= 1.6.2),

diff --git a/NAMESPACE b/NAMESPACE
@@ -6,6 +6,7 @@ export(all_of)
 export(any_of)
 export(ard_chisqtest)
 export(ard_fishertest)
+export(ard_kruskaltest)
 export(ard_moodtest)
 export(ard_paired_ttest)
 export(ard_paired_wilcoxtest)

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# cardx 0.0.0.9033
+# cardx 0.0.0.9036
 
 ### New Features
 * New package!
diff --git a/R/ard_kruskaltest.R b/R/ard_kruskaltest.R
@@ -0,0 +1,54 @@
+#' ARD Kruskal-Wallis Test
+#'
+#' @description
+#' Analysis results data for Kruskal-Wallis Rank Sum Test.
+#'
+#' Calculated with `kruskal.test(data[[variable]], data[[by]], ...)`
+#'
+#' @param data (`data.frame`)\cr
+#'   a data frame.
+#' @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
+#'
+#' @return ARD data frame
+#' @export
+#'
+#' @examples
+#' cards::ADSL |>
+#'   ard_kruskaltest(by = "ARM", variable = "AGE")
+ard_kruskaltest <- 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::kruskal.test(x = data[[variable]], g = data[[by]]) |>
+          broom::tidy()
+      ),
+    tidy_result_names = c("statistic", "p.value", "parameter", "method"),
+    lst_ard_columns = list(group1 = by, variable = variable, context = "kruskaltest")
+  ) |>
+    dplyr::mutate(
+      .after = "stat_name",
+      stat_label =
+        dplyr::case_when(
+          .data$stat_name %in% "statistic" ~ "Kruskal-Wallis chi-squared Statistic",
+          .data$stat_name %in% "p.value" ~ "p-value",
+          .data$stat_name %in% "parameter" ~ "Degrees of Freedom",
+          TRUE ~ .data$stat_name,
+        )
+    )
+}
diff --git a/R/ard_proportion_ci.R b/R/ard_proportion_ci.R
@@ -48,7 +48,7 @@ ard_proportion_ci <- function(data, variables, by = dplyr::group_vars(data),
     data = data,
     variables = {{ variables }},
     by = {{ by }},
-    statistics =
+    statistic =
       ~ list(
         prop_ci =
           switch(method,

diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -26,6 +26,7 @@ reference:
   - contents:
       - ard_chisqtest
       - ard_fishertest
+      - ard_kruskaltest
       - ard_ttest
       - ard_wilcoxtest
 

diff --git a/man/ard_kruskaltest.Rd b/man/ard_kruskaltest.Rd
diff --git a/tests/testthat/_snaps/ard_kruskaltest.md b/tests/testthat/_snaps/ard_kruskaltest.md
@@ -0,0 +1,16 @@
+# ard_kurskaltest() works
+
+    Code
+      as.data.frame(ard_kruskaltest(cards::ADSL, by = "ARM", variable = "AGE"))
+    Output
+        group1 variable     context stat_name                           stat_label
+      1    ARM      AGE kruskaltest statistic Kruskal-Wallis chi-squared Statistic
+      2    ARM      AGE kruskaltest   p.value                              p-value
+      3    ARM      AGE kruskaltest parameter                   Degrees of Freedom
+      4    ARM      AGE kruskaltest    method                               method
+                           statistic statistic_fmt_fn warning error
+      1                      1.63473                1    NULL  NULL
+      2                    0.4415937                1    NULL  NULL
+      3                            2                1    NULL  NULL
+      4 Kruskal-Wallis rank sum test             NULL    NULL  NULL
+
diff --git a/tests/testthat/_snaps/ard_proportion_ci.md b/tests/testthat/_snaps/ard_proportion_ci.md
@@ -11,7 +11,7 @@
       3      rsp proporti…   conf.low   conf.low     0.487                1
       4      rsp proporti…  conf.high  conf.high     0.719                1
       5      rsp proporti… conf.level  conf.lev…      0.95                1
-      6      rsp proporti…     method     method Stratifi…                1
+      6      rsp proporti…     method     method Stratifi…             <fn>
     Message
       i 2 more variables: warning, error
 
@@ -28,7 +28,7 @@
       3      rsp proporti…   conf.low   conf.low     0.448                1
       4      rsp proporti…  conf.high  conf.high     0.753                1
       5      rsp proporti… conf.level  conf.lev…      0.95                1
-      6      rsp proporti…     method     method Stratifi…                1
+      6      rsp proporti…     method     method Stratifi…             <fn>
     Message
       i 2 more variables: warning, error
 
diff --git a/tests/testthat/_snaps/ard_regression.md b/tests/testthat/_snaps/ard_regression.md
@@ -0,0 +1,56 @@
+# ard_regression() works
+
+    Code
+      print(dplyr::mutate(ard_regression(lm(AGE ~ ARM, data = cards::ADSL),
+      add_estimate_to_reference_rows = TRUE), statistic = lapply(statistic, function(
+        x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf)
+    Message
+      {cards} data frame: 43 x 7
+    Output
+         variable variable_level   context      stat_name stat_label statistic
+      1       ARM        Placebo regressi…           term       term ARMPlace…
+      2       ARM        Placebo regressi…      var_label      Label Descript…
+      3       ARM        Placebo regressi…      var_class      Class character
+      4       ARM        Placebo regressi…       var_type       Type categori…
+      5       ARM        Placebo regressi…    var_nlevels   N Levels         3
+      6       ARM        Placebo regressi…      contrasts  contrasts contr.tr…
+      7       ARM        Placebo regressi… contrasts_type  Contrast… treatment
+      8       ARM        Placebo regressi…  reference_row  referenc…      TRUE
+      9       ARM        Placebo regressi…          label  Level La…   Placebo
+      10      ARM        Placebo regressi…          n_obs     N Obs.        86
+      11      ARM        Placebo regressi…       estimate  Coeffici…         0
+      12      ARM      Xanomeli… regressi…           term       term ARMXanom…
+      13      ARM      Xanomeli… regressi…      var_label      Label Descript…
+      14      ARM      Xanomeli… regressi…      var_class      Class character
+      15      ARM      Xanomeli… regressi…       var_type       Type categori…
+      16      ARM      Xanomeli… regressi…    var_nlevels   N Levels         3
+      17      ARM      Xanomeli… regressi…      contrasts  contrasts contr.tr…
+      18      ARM      Xanomeli… regressi… contrasts_type  Contrast… treatment
+      19      ARM      Xanomeli… regressi…  reference_row  referenc…     FALSE
+      20      ARM      Xanomeli… regressi…          label  Level La… Xanomeli…
+      21      ARM      Xanomeli… regressi…          n_obs     N Obs.        84
+      22      ARM      Xanomeli… regressi…       estimate  Coeffici…    -0.828
+      23      ARM      Xanomeli… regressi…      std.error  Standard…     1.267
+      24      ARM      Xanomeli… regressi…      statistic  statistic    -0.654
+      25      ARM      Xanomeli… regressi…        p.value    p-value     0.514
+      26      ARM      Xanomeli… regressi…       conf.low  CI Lower…    -3.324
+      27      ARM      Xanomeli… regressi…      conf.high  CI Upper…     1.668
+      28      ARM      Xanomeli… regressi…           term       term ARMXanom…
+      29      ARM      Xanomeli… regressi…      var_label      Label Descript…
+      30      ARM      Xanomeli… regressi…      var_class      Class character
+      31      ARM      Xanomeli… regressi…       var_type       Type categori…
+      32      ARM      Xanomeli… regressi…    var_nlevels   N Levels         3
+      33      ARM      Xanomeli… regressi…      contrasts  contrasts contr.tr…
+      34      ARM      Xanomeli… regressi… contrasts_type  Contrast… treatment
+      35      ARM      Xanomeli… regressi…  reference_row  referenc…     FALSE
+      36      ARM      Xanomeli… regressi…          label  Level La… Xanomeli…
+      37      ARM      Xanomeli… regressi…          n_obs     N Obs.        84
+      38      ARM      Xanomeli… regressi…       estimate  Coeffici…     0.457
+      39      ARM      Xanomeli… regressi…      std.error  Standard…     1.267
+      40      ARM      Xanomeli… regressi…      statistic  statistic     0.361
+      41      ARM      Xanomeli… regressi…        p.value    p-value     0.719
+      42      ARM      Xanomeli… regressi…       conf.low  CI Lower…    -2.039
+      43      ARM      Xanomeli… regressi…      conf.high  CI Upper…     2.953
+    Message
+      i 1 more variable: statistic_fmt_fn
+
diff --git a/tests/testthat/test-ard_kruskaltest.R b/tests/testthat/test-ard_kruskaltest.R
@@ -0,0 +1,25 @@
+test_that("ard_kurskaltest() works", {
+  expect_error(
+    ard_kruskaltest <-
+      cards::ADSL |>
+      ard_kruskaltest(by = ARM, variable = AGE),
+    NA
+  )
+
+  expect_equal(
+    ard_kruskaltest |>
+      cards::get_ard_statistics(stat_name %in% c("statistic", "p.value")),
+    with(cards::ADSL, kruskal.test(AGE, ARM)) |>
+      broom::tidy() |>
+      dplyr::select(statistic, p.value) |>
+      unclass(),
+    ignore_attr = TRUE
+  )
+
+  # errors are properly handled
+  expect_snapshot(
+    cards::ADSL |>
+      ard_kruskaltest(by = "ARM", variable = "AGE") |>
+      as.data.frame()
+  )
+})
diff --git a/tests/testthat/test-ard_regression.R b/tests/testthat/test-ard_regression.R
@@ -5,6 +5,6 @@ test_that("ard_regression() works", {
       dplyr::mutate(
         statistic = lapply(statistic, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))
       ) |>
-      as.data.frame()
+      print(n = Inf)
   )
 })