Use cli call env functions (#112)

**What changes are proposed in this pull request?** * Import cli call environment functions from the `standalone` repo and implement `set_cli_abort_call` in user-facing functions. (#111, @edelarua) Closes #111 -------------------------------------------------------------------------------- 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] If a new `ard_*()` function was added, it passes the ARD structural checks from `cards::check_ard_structure()`. - [x] Code coverage is suitable for any new functions/features (generally, 100% coverage for new code): `devtools::test_coverage()` - [x] Request a reviewer Reviewer Checklist (if item does not apply, mark is as complete) - [x] If a bug was fixed, a unit test was added. - [x] Run `pkgdown::build_site()`. Check the R console for errors, and review the rendered website. - [x] Code coverage is suitable for any new functions/features: `devtools::test_coverage()` When the branch is ready to be merged: - [x] 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). - [x] **All** GitHub Action workflows pass with a ✅ - [x] Approve Pull Request - [x] Merge the PR. Please use "Squash and merge" or "Rebase and merge". --------- Signed-off-by: Daniel Sjoberg <[email protected]> Signed-off-by: Abinaya Yogasekaram <[email protected]> Co-authored-by: Daniel Sjoberg <[email protected]> Co-authored-by: Abinaya Yogasekaram <[email protected]> Co-authored-by: ddsjoberg <[email protected]>
insightsengineering · Apr 15, 2024 · b667d8d · b667d8d
1 parent c633acb
commit b667d8d
Show file tree

Hide file tree

Showing 99 changed files with 613 additions and 397 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -8,7 +8,6 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
 
 name: R-CMD-check
 

diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml
@@ -8,8 +8,6 @@ on:
       - synchronize
       - reopened
       - ready_for_review
-    branches:
-      - main
   push:
     branches:
       - main

diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
@@ -4,7 +4,6 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
 
 name: test-coverage
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -18,7 +18,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues
 Depends:
     R (>= 4.1)
 Imports:
-    cards (>= 0.1.0.9002),
+    cards (>= 0.1.0.9014),
     cli (>= 3.6.1),
     dplyr (>= 1.1.2),
     glue (>= 1.6.2),

diff --git a/NEWS.md b/NEWS.md
@@ -23,22 +23,25 @@ ard_moodtest()          -> ard_stats_mood_test()
   - `ard_stats_anova()` for calculating ANOVA results using `stats::anova()`. (#12) 
   - `ard_aod_wald_test()` for calculating Wald Tests for regression models using `aod::wald.test()`. (#84)
   - `ard_car_anova()` for calculating ANOVA results using `car::Anova()`. (#3)
-  - `ard_onewaytest()` for calculating ANOVA results using `stats::oneway.test()`. (#3)
-  - `ard_cohens_d()`, `ard_paired_cohens_d()`, `ard_hedges_g()`, and `ard_paired_hedges_g()` for standardized differences using `effectsize::cohens_d()` and `effectsize::hedges_g()`. (#50)
-  - `ard_proptest()` for tests of proportions using `stats::prop.test()`. (#64)
+  - `ard_stats_oneway_test()` for calculating ANOVA results using `stats::oneway.test()`. (#3)
+  - `ard_effectsize_cohens_d()`, `ard_effectsize_paired_cohens_d()`, `ard_effectsize_hedges_g()`, and `ard_effectsize_paired_hedges_g()` for standardized differences using `effectsize::cohens_d()` and `effectsize::hedges_g()`. (#50)
+  - `ard_stats_prop_test()` for tests of proportions using `stats::prop.test()`. (#64)
   - `ard_regression_basic()` for basic regression models. The function focuses on matching terms to underlying variables names. (#46)
-  - `ard_smd()` for calculating standardized mean differences using `smd::smd()`. (#4)
-  - `ard_survfit()` for survival analyses using `survival::survfit()`. (#43)
-  - `ard_svycontinuous()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68)
-  - `ard_svychisq()` for weighted/survey chi-squared test using `survey::svychisq()`. (#72)
-  - `ard_svyttest()` for weighted/survey t-tests using `survey::svyttest()`. (#70)
-  - `ard_svyranktest()` for weighted/survey rank tests using `survey::svyranktest()`. (#71)
-  - `ard_vif()` for calculating the variance inflation factor using `car::vif()`. (#10)
+  - `ard_smd_smd()` for calculating standardized mean differences using `smd::smd()`. (#4)
+  - `ard_survival_survfit()` for survival analyses using `survival::survfit()`. (#43)
+  - `ard_survey_svycontinuous()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68)
+  - `ard_survey_svychisq()` for weighted/survey chi-squared test using `survey::svychisq()`. (#72)
+  - `ard_survey_svyttest()` for weighted/survey t-tests using `survey::svyttest()`. (#70)
+  - `ard_survey_svyranktest()` for weighted/survey rank tests using `survey::svyranktest()`. (#71)
+  - `ard_car_vif()` for calculating the variance inflation factor using `car::vif()`. (#10)
 
 * Updated functions `ard_stats_t_test()`, `ard_stats_paired_t_test()`, `ard_stats_wilcox_test()`, `ard_stats_paired_wilcox_test()`, `ard_stats_chisq_test()`, `ard_stats_fisher_test()`, `ard_stats_kruskal_test()`, `ard_stats_mcnemar_test()`, and `ard_stats_mood_test()` to accept multiple variables at once. Independent tests are calculated for each variable. The `variable` argument is renamed to `variables`. (#77)
 
 * Updated `ard_stats_t_test()` and `ard_stats_wilcox_test()` to no longer require the `by` argument, which yields central estimates with their confidence intervals. (#82)
 
+* Import cli call environment functions from `https://github.com/ddsjoberg/standalone/blob/main/R/standalone-cli_call_env.R` and implement `set_cli_abort_call` in user-facing functions. (#111, @edelarua)
+
+
 # cardx 0.1.0
 
 * Initial release.
diff --git a/R/ard_aod_wald_test.R b/R/ard_aod_wald_test.R
@@ -10,12 +10,13 @@
 #' @return data frame
 #' @export
 #'
-#' @examplesIf cards::is_pkg_installed(c("aod"), reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "aod", reference_pkg = "cardx"))
 #' lm(AGE ~ ARM, data = cards::ADSL) |>
 #'   ard_aod_wald_test()
 ard_aod_wald_test <- function(x, ...) {
+  set_cli_abort_call()
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed("aod", reference_pkg = "cardx")
+  check_pkg_installed("aod", reference_pkg = "cardx")
 
   # check inputs ---------------------------------------------------------------
   check_not_missing(x)
@@ -32,10 +33,12 @@ ard_aod_wald_test <- function(x, ...) {
   )
 
   if (!is.null(reg_model[["error"]])) {
-    cli::cli_abort(c(
-      "Unable to identify underlying variable names in regression model.",
-      i = "Is this model type supported by {.fun broom.helpers::tidy_plus_plus}, which is the function used to identify variable names?"
-    ))
+    cli::cli_abort(
+      c("Unable to identify underlying variable names in regression model.",
+        i = "Is this model type supported by {.fun broom.helpers::tidy_plus_plus}, which is the function used to identify variable names?"
+      ),
+      call = get_cli_abort_call()
+    )
   }
   aod <-
     reg_model[["result"]] %>%

diff --git a/R/ard_car_anova.R b/R/ard_car_anova.R
@@ -8,15 +8,17 @@
 #' @return data frame
 #' @export
 #'
-#' @examplesIf cards::is_pkg_installed(c("broom.helpers", "car"), reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom.helpers", "car"), reference_pkg = "cardx"))
 #' lm(AGE ~ ARM, data = cards::ADSL) |>
 #'   ard_car_anova()
 #'
 #' glm(vs ~ factor(cyl) + factor(am), data = mtcars, family = binomial) |>
 #'   ard_car_anova(test.statistic = "Wald")
 ard_car_anova <- function(x, ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed(c("broom.helpers", "car"), reference_pkg = "cardx")
+  check_pkg_installed(pkg = c("broom.helpers", "car"), reference_pkg = "cardx")
 
   # check inputs ---------------------------------------------------------------
   check_not_missing(x)
@@ -25,10 +27,13 @@ ard_car_anova <- function(x, ...) {
   car_anova <- cards::eval_capture_conditions(car::Anova(x, ...))
 
   if (!is.null(car_anova[["error"]])) {
-    cli::cli_abort(c(
-      "There was an error running {.fun car::Anova}. See error message below.",
-      x = car_anova[["error"]]
-    ))
+    cli::cli_abort(
+      c(
+        "There was an error running {.fun car::Anova}. See error message below.",
+        x = car_anova[["error"]]
+      ),
+      call = get_cli_abort_call()
+    )
   }
 
   car_anova[["result"]] |>

diff --git a/R/ard_car_vif.R b/R/ard_car_vif.R
@@ -14,10 +14,15 @@
 #' @rdname ard_car_vif
 #' @export
 #'
-#' @examples
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "car", reference_pkg = "cardx"))
 #' lm(AGE ~ ARM + SEX, data = cards::ADSL) |>
 #'   ard_car_vif()
 ard_car_vif <- function(x, ...) {
+  set_cli_abort_call()
+
+  # check installed packages ---------------------------------------------------
+  check_pkg_installed("car", reference_pkg = "cardx")
+
   # check inputs ---------------------------------------------------------------
   check_not_missing(x)
 
@@ -30,7 +35,8 @@ ard_car_vif <- function(x, ...) {
     # we cannot get variable names, error out
     if (!is.null(lst_terms[["error"]])) {
       cli::cli_abort(
-        c("There was an error running {.fun car::vif}. See below.", x = vif[["error"]])
+        c("There was an error running {.fun car::vif}. See below.", x = vif[["error"]]),
+        call = get_cli_abort_call()
       )
     }
     vif$result <- dplyr::tibble(

diff --git a/R/ard_effectsize_cohens_d.R b/R/ard_effectsize_cohens_d.R
@@ -28,7 +28,7 @@
 #' The data are then passed as
 #' `effectsize::cohens_d(x = data_wide[[<by level 1>]], y = data_wide[[<by level 2>]], paired = TRUE, ...)`.
 #'
-#' @examplesIf cards::is_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters"), reference_pkg = "cardx"))
 #' cards::ADSL |>
 #'   dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
 #'   ard_effectsize_cohens_d(by = ARM, variables = AGE)
@@ -47,8 +47,10 @@ NULL
 #' @rdname ard_effectsize_cohens_d
 #' @export
 ard_effectsize_cohens_d <- function(data, by, variables, ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")
+  check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")
 
   # check/process inputs -------------------------------------------------------
   check_not_missing(data)
@@ -88,9 +90,11 @@ ard_effectsize_cohens_d <- function(data, by, variables, ...) {
 #' @rdname ard_effectsize_cohens_d
 #' @export
 ard_effectsize_paired_cohens_d <- function(data, by, variables, id, ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed("effectsize", reference_pkg = "cardx")
-  cards::check_pkg_installed("parameters", reference_pkg = "cardx")
+  check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")
+
   # check/process inputs -------------------------------------------------------
   check_not_missing(data)
   check_not_missing(variables)

diff --git a/R/ard_effectsize_hedges_g.R b/R/ard_effectsize_hedges_g.R
@@ -28,7 +28,7 @@
 #' The data are then passed as
 #' `effectsize::hedges_g(x = data_wide[[<by level 1>]], y = data_wide[[<by level 2>]], paired = TRUE, ...)`.
 #'
-#' @examplesIf cards::is_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters", "withr"), reference_pkg = "cardx"))
 #' cards::ADSL |>
 #'   dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
 #'   ard_effectsize_hedges_g(by = ARM, variables = AGE)
@@ -47,8 +47,10 @@ NULL
 #' @rdname ard_effectsize_hedges_g
 #' @export
 ard_effectsize_hedges_g <- function(data, by, variables, ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx")
+  check_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx")
 
   # check/process inputs -------------------------------------------------------
   check_not_missing(data)
@@ -92,9 +94,10 @@ ard_effectsize_hedges_g <- function(data, by, variables, ...) {
 #' @rdname ard_effectsize_hedges_g
 #' @export
 ard_effectsize_paired_hedges_g <- function(data, by, variables, id, ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed("effectsize", reference_pkg = "cardx")
-  cards::check_pkg_installed("parameters", reference_pkg = "cardx")
+  check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")
 
   # check/process inputs -------------------------------------------------------
   check_not_missing(data)

diff --git a/R/ard_proportion_ci.R b/R/ard_proportion_ci.R
@@ -22,7 +22,7 @@
 #' @return an ARD data frame
 #' @export
 #'
-#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))
 #' 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,
@@ -35,6 +35,11 @@ ard_proportion_ci <- function(data, variables, by = dplyr::group_vars(data),
                                 "strat_wilson", "strat_wilsoncc",
                                 "agresti-coull", "jeffreys"
                               )) {
+  set_cli_abort_call()
+
+  # check installed packages ---------------------------------------------------
+  check_pkg_installed(pkg = "broom", reference_pkg = "cardx")
+
   # process inputs -------------------------------------------------------------
   cards::process_selectors(data, variables = {{ variables }}, by = {{ by }})
   method <- arg_match(method)

diff --git a/R/ard_regression.R b/R/ard_regression.R
@@ -11,7 +11,7 @@
 #' @return data frame
 #' @name ard_regression
 #'
-#' @examplesIf cards::is_pkg_installed("broom.helpers", reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))
 #' lm(AGE ~ ARM, data = cards::ADSL) |>
 #'   ard_regression(add_estimate_to_reference_rows = TRUE)
 NULL
@@ -25,8 +25,10 @@ ard_regression <- function(x, ...) {
 #' @rdname ard_regression
 #' @export
 ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed("broom.helpers", reference_pkg = "cardx")
+  check_pkg_installed(pkg = "broom.helpers", reference_pkg = "cardx")
 
   # check inputs ---------------------------------------------------------------
   check_not_missing(x)

diff --git a/R/ard_regression_basic.R b/R/ard_regression_basic.R
@@ -26,7 +26,7 @@
 #' @name ard_regression_basic
 #' @export
 #'
-#' @examplesIf cards::is_pkg_installed("broom.helpers", reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))
 #' lm(AGE ~ ARM, data = cards::ADSL) |>
 #'   ard_regression_basic()
 ard_regression_basic <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or_parameters,
@@ -35,8 +35,10 @@ ard_regression_basic <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or
                                    "label", "contrasts_type", "contrasts", "var_nlevels"
                                  ),
                                  ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed("broom.helpers", reference_pkg = "cardx")
+  check_pkg_installed(pkg = "broom.helpers", reference_pkg = "cardx")
 
   # check inputs ---------------------------------------------------------------
   check_not_missing(x)

diff --git a/R/ard_smd_smd.R b/R/ard_smd_smd.R
@@ -16,12 +16,14 @@
 #' @return ARD data frame
 #' @export
 #'
-#' @examplesIf cards::is_pkg_installed("smd", reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "smd", reference_pkg = "cardx"))
 #' ard_smd_smd(cards::ADSL, by = ARM, variables = AGE, std.error = TRUE)
 #' ard_smd_smd(cards::ADSL, by = ARM, variables = AGEGR1, std.error = TRUE)
 ard_smd_smd <- function(data, by, variables, ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed("smd", reference_pkg = "cardx")
+  check_pkg_installed("smd", reference_pkg = "cardx")
 
   # check/process inputs -------------------------------------------------------
   check_not_missing(data)

diff --git a/R/ard_stats_anova.R b/R/ard_stats_anova.R
@@ -45,7 +45,7 @@
 #' @return ARD data frame
 #' @name ard_stats_anova
 #'
-#' @examplesIf cards::is_pkg_installed(c("broom", "withr", "lme4"), reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom", "withr", "lme4"), reference_pkg = "cardx"))
 #' anova(
 #'   lm(mpg ~ am, mtcars),
 #'   lm(mpg ~ am + hp, mtcars)
@@ -77,9 +77,11 @@ ard_stats_anova <- function(x, ...) {
 #' @rdname ard_stats_anova
 #' @export
 ard_stats_anova.anova <- function(x, method = "ANOVA results from `stats::anova()`", ...) {
+  set_cli_abort_call()
+
   # check inputs ---------------------------------------------------------------
   check_dots_empty()
-  cards::check_pkg_installed("broom", reference_pkg = "cardx")
+  check_pkg_installed("broom", reference_pkg = "cardx")
   check_string(method, message = "Argument {.arg method} must be a string of a function name.")
 
   # return df in cards formats -------------------------------------------------
@@ -102,21 +104,26 @@ ard_stats_anova.data.frame <- function(x,
                                        package = "base",
                                        method = "ANOVA results from `stats::anova()`",
                                        ...) {
+  set_cli_abort_call()
+
   # check inputs ---------------------------------------------------------------
   check_dots_empty()
   check_string(package)
-  cards::check_pkg_installed(c("broom", "withr", package), reference_pkg = "cardx")
+  check_pkg_installed(c("broom", "withr", package), reference_pkg = "cardx")
   check_not_missing(formulas)
   check_not_missing(x)
   check_not_missing(fn)
   check_string(method, message = "Argument {.arg method} must be a string of a function name.")
   check_data_frame(x)
   check_string(fn)
   if (str_detect(fn, "::")) {
-    cli::cli_abort(c(
-      "Argument {.arg fn} cannot be namespaced.",
-      i = "Put the package name in the {.arg package} argument."
-    ))
+    cli::cli_abort(
+      c(
+        "Argument {.arg fn} cannot be namespaced.",
+        i = "Put the package name in the {.arg package} argument."
+      ),
+      call = get_cli_abort_call()
+    )
   }
 
   # calculate results and return df in cards formats ---------------------------

diff --git a/R/ard_stats_aov.R b/R/ard_stats_aov.R
@@ -10,11 +10,13 @@
 #' @return ARD data frame
 #' @export
 #'
-#' @examplesIf cards::is_pkg_installed(c("broom.helpers"), reference_pkg = "cardx")
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))
 #' ard_stats_aov(AGE ~ ARM, data = cards::ADSL)
 ard_stats_aov <- function(formula, data, ...) {
+  set_cli_abort_call()
+
   # check installed packages ---------------------------------------------------
-  cards::check_pkg_installed(c("broom.helpers"), reference_pkg = "cardx")
+  check_pkg_installed(c("broom.helpers"), reference_pkg = "cardx")
 
   # check/process inputs -------------------------------------------------------
   check_not_missing(formula)