Adding ard_smd() (#65)

**What changes are proposed in this pull request?**
* Adding `ard_smd()`

**Reference GitHub issue associated with pull request.** _e.g., 'closes
#<issue number>'_
closes #4 


--------------------------------------------------------------------------------

Pre-review Checklist (if item does not apply, mark is as complete)
- [x] **All** GitHub Action workflows pass with a ✅
- [x] PR branch has pulled the most recent updates from master branch:
`usethis::pr_merge_main()`
- [x] If a bug was fixed, a unit test was added.
- [x] Code coverage is suitable for any new functions/features
(generally, 100% coverage for new code): `devtools::test_coverage()`
- [ ] Request a reviewer

Reviewer Checklist (if item does not apply, mark is as complete)

- [ ] If a bug was fixed, a unit test was added.
- [ ] Run `pkgdown::build_site()`. Check the R console for errors, and
review the rendered website.
- [ ] Code coverage is suitable for any new functions/features:
`devtools::test_coverage()`

When the branch is ready to be merged:
- [ ] Update `NEWS.md` with the changes from this pull request under the
heading "`# cards (development version)`". If there is an issue
associated with the pull request, reference it in parentheses at the end
update (see `NEWS.md` for examples).
- [ ] **All** GitHub Action workflows pass with a ✅
- [ ] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge".

Author: ddsjoberg

DESCRIPTION

@@ -15,7 +15,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues
 Depends:
     R (>= 4.1)
 Imports:
-    cards (>= 0.0.0.9049),
+    cards (>= 0.1.0.9002),
     cli (>= 3.6.1),
     dplyr (>= 1.1.2),
     glue (>= 1.6.2),
@@ -27,6 +27,7 @@ Suggests:
     effectsize (>= 0.6.0),
     parameters (>= 0.20.2),
     spelling,
+    smd (>= 0.6.6),
     testthat (>= 3.2.0),
     withr
 Remotes: 

NAMESPACE

@@ -19,6 +19,7 @@ export(ard_proportion_ci)
 export(ard_proptest)
 export(ard_regression)
 export(ard_regression_basic)
+export(ard_smd)
 export(ard_ttest)
 export(ard_wilcoxtest)
 export(contains)

R/ard_smd.R

@@ -0,0 +1,74 @@
+#' ARD Standardized Mean Difference
+#'
+#' @description
+#' Standardized mean difference calculated via [`smd::smd()`] with `na.rm = TRUE`.
+#'
+#' @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.
+#' @inheritDotParams smd::smd -x -g -w -na.rm
+#'
+#' @return ARD data frame
+#' @export
+#'
+#' @examplesIf cards::is_pkg_installed("smd", reference_pkg = "cardx")
+#' ard_smd(cards::ADSL, by = ARM, variable = AGE, std.error = TRUE)
+#' ard_smd(cards::ADSL, by = ARM, variable = AGEGR1, std.error = TRUE)
+ard_smd <- function(data, by, variable, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("smd", 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_smd_results(
+    by = by,
+    variable = variable,
+    lst_tidy =
+      cards::eval_capture_conditions(
+        smd::smd(x = data[[variable]], g = data[[by]], na.rm = TRUE, ...) |>
+          dplyr::select(-any_of("term"))
+      ),
+    ...
+  )
+}
+
+
+.format_smd_results <- function(by, variable, lst_tidy, ...) {
+  # build ARD ------------------------------------------------------------------
+  ret <-
+    cards::tidy_as_ard(
+      lst_tidy = lst_tidy,
+      tidy_result_names = c("estimate", "std.error"),
+      fun_args_to_record = "gref",
+      formals = formals(smd::smd)["gref"],
+      # removing the `std.error` ARGUMENT (not the result)
+      passed_args = dots_list(...) |> utils::modifyList(list(std.error = NULL)),
+      lst_ard_columns = list(group1 = by, variable = variable, context = "smd")
+    )
+
+  # add the stat label ---------------------------------------------------------
+  ret |>
+    dplyr::left_join(
+      dplyr::tribble(
+        ~stat_name, ~stat_label,
+        "estimate", "Standardized Mean Difference",
+        "std.error", "Standard Error",
+        "gref", "Integer Reference Group Level"
+      ),
+      by = "stat_name"
+    ) |>
+    dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
+    cards::tidy_ard_column_order()
+}

_pkgdown.yml

@@ -40,6 +40,7 @@ reference:
       - ard_proportion_ci
       - ard_regression
       - ard_regression_basic
+      - ard_smd
 
   - title: "Helpers"
   - contents:

man/ard_smd.Rd

@@ -0,0 +1,37 @@
+skip_if_not(cards::is_pkg_installed("smd", reference_pkg = "cardx"))
+
+test_that("ard_smd() works", {
+  expect_error(
+    ard_smd <-
+      mtcars |>
+      ard_smd(by = vs, variable = am, std.error = TRUE),
+    NA
+  )
+
+  expect_equal(
+    ard_smd |>
+      cards::get_ard_statistics(stat_name %in% c("estimate", "std.error")),
+    smd::smd(x = mtcars$am, g = mtcars$vs, std.error = TRUE) |>
+      dplyr::select(-term) |>
+      unclass(),
+    ignore_attr = TRUE
+  )
+})
+
+test_that("ard_proptest() error messaging", {
+  # mis-specify the gref argument
+  expect_error(
+    bad_gref <-
+      ard_smd(cards::ADSL, by = ARM, variable = AGE, std.error = TRUE, gref = 0) |>
+      as.data.frame(),
+    NA
+  )
+  # check all the stats still appear despite the errors
+  expect_equal(nrow(bad_gref), 3L)
+  expect_setequal(bad_gref$stat_name, c("estimate", "std.error", "gref"))
+  # check the error message it the one we expect
+  expect_equal(
+    bad_gref$error |> unique() |> cli::ansi_strip(),
+    "gref must be an integer within 3"
+  )
+})