Adding ard_survival_survdiff()

.github/PULL_REQUEST_TEMPLATE.md

@@ -13,6 +13,8 @@ Pre-review Checklist (if item does not apply, mark is as complete)
 - [ ] PR branch has pulled the most recent updates from master branch: `usethis::pr_merge_main()`
 - [ ] If a bug was fixed, a unit test was added.
 - [ ] If a new `ard_*()` function was added, it passes the ARD structural checks from `cards::check_ard_structure()`.
+- [ ] If a new `ard_*()` function was added, `set_cli_abort_call()` has been set.
+- [ ] If a new `ard_*()` function was added and it depends on another package (such as, `broom`), `is_pkg_installed("broom", reference_pkg = "cardx")` has been set in the function call and the following added to the roxygen comments: `@examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom"", reference_pkg = "cardx"))`
 - [ ] Code coverage is suitable for any new functions/features (generally, 100% coverage for new code): `devtools::test_coverage()`
 
 Reviewer Checklist (if item does not apply, mark is as complete)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cardx
 Title: Extra Analysis Results Data Utilities
-Version: 0.1.0.9019
+Version: 0.1.0.9018
 Authors@R: c(
     person("Daniel", "Sjoberg", , "[email protected]", role = c("aut", "cre")),
     person("Abinaya", "Yogasekaram", , "[email protected]", role = "aut"),
@@ -31,6 +31,7 @@ Suggests:
     car (>= 3.0-11),
     effectsize (>= 0.6.0),
     geepack (>= 1.3.2),
+    ggsurvfit (>= 1.0.0),
     lme4 (>= 1.1-31),
     parameters (>= 0.20.2),
     smd (>= 0.6.6),

NAMESPACE

@@ -34,6 +34,7 @@ export(ard_survey_svychisq)
 export(ard_survey_svycontinuous)
 export(ard_survey_svyranktest)
 export(ard_survey_svyttest)
+export(ard_survival_survdiff)
 export(ard_survival_survfit)
 export(contains)
 export(ends_with)

NEWS.md

@@ -1,4 +1,4 @@
-# cardx 0.1.0.9019
+# cardx 0.1.0.9018
 
 ### Breaking Changes
 
@@ -39,8 +39,9 @@ ard_moodtest()          -> ard_stats_mood_test()
 
 * 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)
+* Imported cli call environment functions from `https://github.com/ddsjoberg/standalone/blob/main/R/standalone-cli_call_env.R` and implemented `set_cli_abort_call` in user-facing functions. (#111)
 
+* Added `ard_survival_survdiff()` for creating results from `survival::survdiff()`. (#113)
 
 # cardx 0.1.0
 

R/ard_survival_survdiff.R

@@ -0,0 +1,146 @@
+#' ARD for Difference in Survival
+#'
+#' @description
+#' Analysis results data for comparison of survival using [survival::survdiff()].
+#'
+#' @param formula (`formula`)\cr
+#'   a formula
+#' @param data (`data.frame`)\cr
+#'  a data frame
+#' @param rho (`scalar numeric`)\cr
+#'   numeric scalar passed to `survival::survdiff(rho)`. Default is `rho=0`.
+#' @param ... additional arguments passed to `survival::survdiff()`
+#'
+#' @return an ARD data frame of class 'card'
+#' @export
+#'
+#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom", "ggsurvfit"), reference_pkg = "cardx"))
+#' library(survival)
+#' library(ggsurvfit)
+#'
+#' ard_survival_survdiff(Surv_CNSR(AVAL, CNSR) ~ TRTA, data = cards::ADTTE)
+ard_survival_survdiff <- function(formula, data, rho = 0, ...) {
+  set_cli_abort_call()
+
+  # check installed packages ---------------------------------------------------
+  check_pkg_installed(c("survival", "broom"), reference_pkg = "cardx")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(formula)
+  check_class(formula, cls = "formula")
+  if (!missing(data)) check_class(data, cls = "data.frame")
+  check_scalar(rho)
+  check_class(rho, cls = "numeric")
+
+  # assign method
+  method <- dplyr::case_when(
+    rho == 0 ~ "Log-rank test",
+    rho == 1.5 ~ "Tarone-Ware test",
+    rho == 1 ~ "Peto & Peto modification of Gehan-Wilcoxon test",
+    .default = glue::glue("G-rho test (\U03C1 = {rho})")
+  ) |>
+    as.character()
+
+  # calculate survdiff() results -----------------------------------------------
+  lst_glance <-
+    cards::eval_capture_conditions(
+      survival::survdiff(formula = formula, data = data, rho = rho, ...) |>
+        broom::glance() |>
+        dplyr::mutate(method = .env$method)
+    )
+
+  # tidy results up in an ARD format -------------------------------------------
+  # extract variable names from formula
+  variables <- stats::terms(formula) |>
+    attr("term.labels") |>
+    .strip_backticks()
+
+  # if there was an error, return results early
+  if (is.null(lst_glance[["result"]])) {
+    # if no variables in formula, then return an error
+    # otherwise, if we do have variable names, then we can construct an empty ARD which will be done below
+    if (is_empty(variables)) {
+      cli::cli_abort(
+        message =
+          c("There was an error in {.fun survival::survdiff}. See below:",
+            "x" = lst_glance[["error"]]
+          ),
+        call = get_cli_abort_call()
+      )
+    }
+  }
+
+  .variables_to_survdiff_ard(
+    variables = variables,
+    method = method,
+    # styler: off
+    stat_names =
+      if (!is.null(lst_glance[["result"]])) names(lst_glance[["result"]])
+      else c("statistic", "df", "p.value", "method"),
+    stats =
+      if (!is.null(lst_glance[["result"]])) unname(as.list(lst_glance[["result"]]))
+      else rep_along(c("statistic", "df", "p.value"), list(NULL)) |> c(list(method = method))
+    # styler: on
+  ) |>
+    .add_survdiff_stat_labels() |>
+    dplyr::mutate(
+      context = "survival_survdiff",
+      warning = lst_glance["warning"],
+      error = lst_glance["error"],
+      fmt_fn = map(
+        .data$stat,
+        function(x) {
+          if (is.numeric(x)) return(1L) # styler: off
+          NULL
+        }
+      )
+    ) |>
+    cards::tidy_ard_column_order() %>%
+    {structure(., class = c("card", class(.)))} # styler: off
+}
+
+.variables_to_survdiff_ard <- function(variables,
+                                       method,
+                                       stat_names,
+                                       stats) {
+  len <- length(variables)
+
+  df_vars <- dplyr::tibble(!!!rev(variables)) |>
+    set_names(
+      ifelse(
+        len > 1L,
+        c(paste0("group_", rev(seq_len(len - 1L))), "variable"),
+        "variable"
+      )
+    )
+
+  dplyr::bind_cols(
+    df_vars,
+    dplyr::tibble(
+      stat_name = .env$stat_names,
+      stat = .env$stats
+    )
+  )
+}
+
+.add_survdiff_stat_labels <- function(x) {
+  x |>
+    dplyr::left_join(
+      dplyr::tribble(
+        ~stat_name, ~stat_label,
+        "statistic", "X^2 Statistic",
+        "df", "Degrees of Freedom",
+        "p.value", "p-value"
+      ),
+      by = "stat_name"
+    ) |>
+    dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name))
+}
+
+.strip_backticks <- function(x) {
+  ifelse(
+    str_detect(x, "^`.*`$"),
+    substr(x, 2, nchar(x) - 1),
+    x
+  )
+}

R/ard_survival_survfit.R

@@ -34,11 +34,12 @@
 #'
 #' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom"), reference_pkg = "cardx"))
 #' library(survival)
+#' library(ggsurvfit)
 #'
-#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |>
+#' survfit(Surv_CNSR(AVAL, CNSR) ~ TRTA, cards::ADTTE) |>
 #'   ard_survival_survfit(times = c(60, 180))
 #'
-#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |>
+#' survfit(Surv_CNSR(AVAL, CNSR) ~ TRTA, cards::ADTTE) |>
 #'   ard_survival_survfit(probs = c(0.25, 0.5, 0.75))
 #'
 #' # Competing Risks Example ---------------------------

_pkgdown.yml

@@ -22,9 +22,10 @@ authors:
 
 reference:
   - title: "ARD Creation"
-
-  - subtitle: "{stats} package"
+  - subtitle: "Inference"
   - contents:
+      - ard_aod_wald_test
+      - ard_car_anova
       - ard_stats_anova
       - ard_stats_aov
       - ard_stats_chisq_test
@@ -36,41 +37,22 @@ reference:
       - ard_stats_prop_test
       - ard_stats_t_test
       - ard_stats_wilcox_test
-
-  - subtitle: "{aod} package"
-  - contents:
-      - ard_aod_wald_test
-
-  - subtitle: "{car} package"
-  - contents:
-      - ard_car_anova
-      - ard_car_vif
-
-  - subtitle: "{effectsize} package"
-  - contents:
-      - ard_effectsize_cohens_d
-      - ard_effectsize_hedges_g
-
-  - subtitle: "{smd} package"
-  - contents:
-      - ard_smd_smd
-
-  - subtitle: "{survey} package"
-  - contents:
       - ard_survey_svychisq
-      - ard_survey_svycontinuous
       - ard_survey_svyranktest
       - ard_survey_svyttest
+      - ard_survival_survdiff
 
-  - subtitle: "{survival} package"
-  - contents:
-    - ard_survival_survfit
-
-  - subtitle: "Other ARD functions"
+  - subtitle: "Estimation"
   - contents:
+      - ard_car_vif
+      - ard_effectsize_cohens_d
+      - ard_effectsize_hedges_g
       - ard_proportion_ci
       - ard_regression
       - ard_regression_basic
+      - ard_smd_smd
+      - ard_survival_survfit
+      - ard_survey_svycontinuous
 
   - title: "Helpers"
   - contents:

tests/testthat/test-ard_stats_anova.R

@@ -129,3 +129,14 @@ test_that("ard_stats_anova.data.frame() works", {
     ard_anova_geeglm
   )
 })
+
+test_that("ard_stats_anova.data.frame() error messaging", {
+  expect_error(
+    ard_stats_anova(
+      x = mtcars,
+      formulas = list(mpg ~ am, mpg ~ am + hp),
+      fn = "base::lm"
+    ),
+    "cannot be namespaced"
+  )
+})