Add median test. Close #327

NEWS.md

@@ -1,3 +1,7 @@
+# arsenal v3.6.2.9000
+
+* Added `medtest()` to `tableby()` for a median test. (#327)
+
 # arsenal v3.6.2
 
 * Fixed one URL

R/tableby.R

@@ -58,6 +58,9 @@
 #'     \code{wt}: An explicit Wilcoxon test.
 #'   }
 #'   \item{
+#'     \code{medtest}: A median test.
+#'   }
+#'   \item{
 #'     \code{chisq}: chi-square goodness of fit test for equal counts of a
 #'     categorical variable across categories; the default for categorical
 #'     or factor variables
@@ -130,7 +133,7 @@ tableby <- function(formula, data, na.action, subset=NULL, weights=NULL, strata,
   indx <- match(c("formula", "data", "subset", "weights", "na.action", "strata"), names(Call), nomatch = 0)
   if(indx[1] == 0) stop("A formula argument is required")
 
-  special <- c("anova", "kwt", "wt", "chisq", "fe", "logrank", "trend", "notest")
+  special <- c("anova", "kwt", "wt", "medtest", "chisq", "fe", "logrank", "trend", "notest")
 
   out.tables <- list()
   formula.list <- as_list_formula(formula)

R/tableby.control.R

@@ -18,7 +18,7 @@
 #' @param numeric.simplify,date.simplify logical, tell \code{tableby} whether to condense numeric/date output to a single line.
 #'   NOTE: this only simplifies to one line if there is only one statistic reported, such as \code{meansd}.
 #'   In particular, if \code{Nmiss} is specified and there are missings, then the output is not simplified.
-#' @param numeric.test name of test for numeric RHS variables in \code{tableby}: anova, kwt (Kruskal-Wallis).
+#' @param numeric.test name of test for numeric RHS variables in \code{tableby}: anova, kwt (Kruskal-Wallis), medtest (median test).
 #'   If no LHS variable exists, then a mean is required for a univariate test.
 #' @param numeric.stats,cat.stats,ordered.stats,surv.stats,date.stats,selectall.stats summary statistics to include for the respective class of RHS variables
 #'  within the levels of the group LHS variable.

R/tableby.stat.tests.R

@@ -43,6 +43,24 @@ wt <- function(x, x.by, ..., wilcox.correct = FALSE, wilcox.exact = NULL, test.a
   stats::wilcox.test(x ~ as.factor(x.by), correct = wilcox.correct, exact = wilcox.exact)
 }
 
+## median test
+medtest <- function(x, x.by, ..., test.always = FALSE) {
+  if(!requireNamespace("coin", quietly = TRUE))
+  {
+    warning("The \"coin\" package is required to run a median test.", call. = FALSE)
+    return(notest(x, x.by, ...))
+  }
+
+  tab <- table(is.na(x), x.by)
+  if(!test.always && (any(tab[1, ] == 0) || any(colSums(tab) == 0))) {
+    return(list(p.value=NA_real_, method = "Median test"))
+  }
+  ## should be taken care of with coin::
+  check_pkg("coin")
+  mtest <- coin::median_test(x~as.factor(x.by), teststat="quad")
+  list(p.value=coin::pvalue(mtest), method="Median test", statistic=mtest@statistic@teststatistic)
+}
+
 ## two tests for categorical,
 ## 1. chisq goodness of fit, equal proportions across table cells
 chisq <- function(x, x.by, ..., chisq.correct=FALSE, simulate.p.value=FALSE, B=2000, test.always = FALSE) {

tests/testthat/test_tableby.R

@@ -1705,3 +1705,17 @@ test_that("wt (#321)", {
     )
   )
 })
+
+
+test_that("wt (#327)", {
+  expect_identical(
+    capture.kable(summary(tableby(sex ~ medtest(age), data = mockstudy), text = TRUE)),
+    c("|             |  Male (N=916)   | Female (N=583)  | Total (N=1499)  | p value|",
+      "|:------------|:---------------:|:---------------:|:---------------:|-------:|",
+      "|Age in Years |                 |                 |                 |   0.018|",
+      "|-  Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) |        |",
+      "|-  Range     | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 |        |"
+    )
+  )
+})
+

vignettes/tableby.Rmd

@@ -912,6 +912,8 @@ The following tests are accepted:
 
 * `wt`: An explicit Wilcoxcon test.
 
+* `medtest`: Median test test, optional test for continuous variables.
+
 * `chisq`: chi-square goodness of fit test for equal counts of a
     categorical variable across categories; the default for categorical
     or factor variables