1490: additional stats

NAMESPACE

@@ -252,14 +252,18 @@ export(month2day)
 export(or_clogit)
 export(or_glm)
 export(prop_agresti_coull)
+export(prop_chisq)
 export(prop_clopper_pearson)
+export(prop_cmh)
 export(prop_diff_cmh)
 export(prop_diff_ha)
 export(prop_diff_nc)
 export(prop_diff_strat_nc)
 export(prop_diff_uncond_exact)
 export(prop_diff_wald)
+export(prop_fisher)
 export(prop_jeffreys)
+export(prop_schouten)
 export(prop_strat_wilson)
 export(prop_wald)
 export(prop_wilson)

NEWS.md

@@ -16,7 +16,9 @@
 * Added `range_with_cens_info` statistic to `s_surv_time()`.
 * Added `lsmean_se`, `lsmean_ci`, and `lsmean_diffci` statistics to `s_ancova()`.
 * Added `s_ancova()` to exported functions.
+* In `estimate_proportion_diff` now also the standard error is available for selected methods in the `se_diff` statistic.
 * Exported `h_incidence_rate()` to allow to reuse the incidence rate estimation logic.
+* Exported `prop_chisq()`, `prop_cmh()`, `prop_fisher()`, and `prop_schouten()` for standalone proportion difference testing.
 
 ### Bug Fixes
 * Fixed bug in `prop_diff_cmh()` which previously failed when strata combinations had 0 observations.

R/prop_diff.R

@@ -47,6 +47,8 @@ NULL
 #'
 #' @return
 #' * `s_proportion_diff()` returns a named list of elements `diff` and `diff_ci`.
+#'   Depending on the method used, also the standard error of the difference `se_diff` is
+#'   returned.
 #'
 #' @note When performing an unstratified analysis, methods `"cmh"`, `"cmh_sato"`, `"strat_newcombe"`,
 #'   and `"strat_newcombecc"` are not permitted. For stratified analysis, method
@@ -138,6 +140,7 @@ s_proportion_diff <- function(df,
       weights_method <- "cmh"
     }
 
+    y_stats_from_cmh <- c("diff", "diff_ci", "se_diff")
     y <- switch(method,
       "wald" = prop_diff_wald(rsp, grp, conf_level, correct = FALSE),
       "waldcc" = prop_diff_wald(rsp, grp, conf_level, correct = TRUE),
@@ -158,21 +161,27 @@ s_proportion_diff <- function(df,
         conf_level,
         correct = TRUE
       ),
-      "cmh" = prop_diff_cmh(rsp, grp, strata, conf_level, diff_se = "standard")[c("diff", "diff_ci")],
-      "cmh_sato" = prop_diff_cmh(rsp, grp, strata, conf_level, diff_se = "sato")[c("diff", "diff_ci")],
-      "cmh_mn" = prop_diff_cmh(rsp, grp, strata, conf_level, diff_se = "miettinen_nurminen")[c("diff", "diff_ci")],
+      "cmh" = prop_diff_cmh(rsp, grp, strata, conf_level, diff_se = "standard")[y_stats_from_cmh],
+      "cmh_sato" = prop_diff_cmh(rsp, grp, strata, conf_level, diff_se = "sato")[y_stats_from_cmh],
+      "cmh_mn" = prop_diff_cmh(rsp, grp, strata, conf_level, diff_se = "miettinen_nurminen")[y_stats_from_cmh],
       "uncond_exact_diff" = prop_diff_uncond_exact(rsp, grp, conf_level)
     )
 
     y$diff <- setNames(y$diff * 100, paste0("diff_", method))
     y$diff_ci <- setNames(y$diff_ci * 100, paste0("diff_ci_", method, c("_l", "_u")))
+    if (!is.null(y$se_diff)) {
+      y$se_diff <- setNames(y$se_diff * 100, paste0("se_diff_", method))
+    }
   }
 
   attr(y$diff, "label") <- "Difference in Response rate (%)"
   attr(y$diff_ci, "label") <- d_proportion_diff(
     conf_level, method,
     long = FALSE
   )
+  if (!is.null(y$se_diff)) {
+    attr(y$se_diff, "label") <- paste0("Standard Error of Difference in Response rate (%)")
+  }
 
   y
 }
@@ -314,9 +323,9 @@ estimate_proportion_diff <- function(lyt,
                                      na_rm = TRUE,
                                      .stats = c("diff", "diff_ci"),
                                      .stat_names = NULL,
-                                     .formats = c(diff = "xx.x", diff_ci = "(xx.x, xx.x)"),
+                                     .formats = c(diff = "xx.x", diff_ci = "(xx.x, xx.x)", se_diff = "xx.x"),
                                      .labels = NULL,
-                                     .indent_mods = c(diff = 0L, diff_ci = 1L)) {
+                                     .indent_mods = c(diff = 0L, diff_ci = 1L, se_diff = 1L)) {
   # Depending on main functions
   extra_args <- list(
     "na_rm" = na_rm,

R/prop_diff_test.R

@@ -308,7 +308,18 @@ NULL
 
 #' @describeIn h_prop_diff_test Performs Chi-Squared test. Internally calls [stats::prop.test()].
 #'
-#' @keywords internal
+#' @examples
+#' # Chi-Squared test
+#' tbl <- matrix(
+#'   c(13, 7, 8, 12),
+#'   nrow = 2,
+#'   byrow = TRUE,
+#'   dimnames = list(group = c("A", "B"), response = c("TRUE", "FALSE"))
+#' )
+#'
+#' prop_chisq(tbl)
+#'
+#' @export
 prop_chisq <- function(tbl, alternative = c("two.sided", "less", "greater")) {
   checkmate::assert_integer(c(ncol(tbl), nrow(tbl)), lower = 2, upper = 2)
   tbl <- tbl[, c("TRUE", "FALSE")]
@@ -329,7 +340,21 @@ prop_chisq <- function(tbl, alternative = c("two.sided", "less", "greater")) {
 #' @param transform (`string`)\cr either `none` or `wilson_hilferty`; specifies whether to apply
 #'   the Wilson-Hilferty transformation of the chi-squared statistic.
 #'
-#' @keywords internal
+#' @examples
+#' # Cochran-Mantel-Haenszel test with two strata
+#' ary <- array(
+#'   c(12, 8, 8, 12, 10, 10, 6, 14),
+#'   dim = c(2, 2, 2),
+#'   dimnames = list(
+#'     group = c("A", "B"),
+#'     response = c("TRUE", "FALSE"),
+#'     strata = c("Low", "High")
+#'   )
+#' )
+#'
+#' prop_cmh(ary)
+#'
+#' @export
 prop_cmh <- function(ary,
                      alternative = c("two.sided", "less", "greater"),
                      diff_se = c("standard", "sato"),
@@ -375,18 +400,34 @@ prop_cmh <- function(ary,
     z_stat <- num / denom * sign(z_stat) # Preserve the direction of effect.
   }
 
-  if (alternative == "two.sided") {
+  pval <- if (alternative == "two.sided") {
     2 * stats::pnorm(-abs(z_stat))
   } else {
     stats::pnorm(z_stat, lower.tail = (alternative == "greater"))
   }
+
+  structure(
+    pval,
+    z_stat = z_stat
+  )
 }
 
 #' @describeIn h_prop_diff_test Performs the Chi-Squared test with Schouten correction.
 #'
 #' @seealso Schouten correction is based upon \insertCite{Schouten1980-kd;textual}{tern}.
 #'
-#' @keywords internal
+#' @examples
+#' # Chi-Squared test with Schouten correction
+#' tbl <- matrix(
+#'   c(13, 7, 8, 12),
+#'   nrow = 2,
+#'   byrow = TRUE,
+#'   dimnames = list(group = c("A", "B"), response = c("TRUE", "FALSE"))
+#' )
+#'
+#' prop_schouten(tbl)
+#'
+#' @export
 prop_schouten <- function(tbl, alternative = c("two.sided", "less", "greater")) {
   checkmate::assert_integer(c(ncol(tbl), nrow(tbl)), lower = 2, upper = 2)
   alternative <- match.arg(alternative)
@@ -422,7 +463,18 @@ prop_schouten <- function(tbl, alternative = c("two.sided", "less", "greater"))
 
 #' @describeIn h_prop_diff_test Performs the Fisher's exact test. Internally calls [stats::fisher.test()].
 #'
-#' @keywords internal
+#' @examples
+#' # Fisher's exact test
+#' tbl <- matrix(
+#'   c(13, 7, 8, 12),
+#'   nrow = 2,
+#'   byrow = TRUE,
+#'   dimnames = list(group = c("A", "B"), response = c("TRUE", "FALSE"))
+#' )
+#'
+#' prop_fisher(tbl)
+#'
+#' @export
 prop_fisher <- function(tbl, alternative = c("two.sided", "less", "greater")) {
   checkmate::assert_integer(c(ncol(tbl), nrow(tbl)), lower = 2, upper = 2)
   alternative <- match.arg(alternative) # Is needed here, because stats::fisher.test does not handle defaults.

tests/testthat/_snaps/prop_diff.md

@@ -348,6 +348,12 @@
       attr(,"label")
       [1] "90% CI (CMH, without correction)"
 
+      $se_diff
+      se_diff_cmh 
+         8.978092 
+      attr(,"label")
+      [1] "Standard Error of Difference in Response rate (%)"
+
 
 # s_proportion_diff works with CMH Sato method
 
@@ -366,10 +372,17 @@
       attr(,"label")
       [1] "90% CI (CMH, Sato variance estimator)"
 
+      $se_diff
+      se_diff_cmh_sato 
+              10.80533 
+      attr(,"label")
+      [1] "Standard Error of Difference in Response rate (%)"
+
 
 # s_proportion_diff works with CMH Miettinen and Nurminen method
 
     list(diff = structure(c(diff_cmh_mn = 13.7686601988347), label = "Difference in Response rate (%)"), 
         diff_ci = structure(c(diff_ci_cmh_mn_l = -3.45069418895496, 
-        diff_ci_cmh_mn_u = 30.2144371774115), label = "90% CI (CMH, Miettinen and Nurminen)"))
+        diff_ci_cmh_mn_u = 30.2144371774115), label = "90% CI (CMH, Miettinen and Nurminen)"), 
+        se_diff = structure(c(se_diff_cmh_mn = 10.4103330371023), label = "Standard Error of Difference in Response rate (%)"))