#' Transform any test function into a valid test function for the table
#'
#' Transform a function into a valid test function for the table
#' Applying the function on a numerical vector should return one value
#' Applying the function on a factor should return nlevels + 1 value, or one value per factor level
#' @param x A vector
#' @param f The function to try to apply, or a formula combining two functions
#' @param group Grouping factor
#' @return The results for the function applied on the vector, compatible with the format of the result table
#' @keywords internal
testify <- function(x, f, group) {
# Extract the name of the function
f %>%
deparse() %>%
Reduce(f = paste0) %>%
substring(2) -> fun
# If eval(f[[2]]) throws an error, then we may be in an rlang-formula
tryCatch(f <- eval(f[[2]]),
error = function(e) {f <<- rlang::as_function(f)})
# Try the function
p <- tryCatch(f(x ~ group)$p.value[1],
error = function(e) {message(e);NaN})
# Return the correct number of rows depending on the variable type
if (is.factor(x)) data.frame(p = c(p, rep(NA, nlevels(x))),
test = c(fun, rep(NA, nlevels(x))),
row.names = NULL, check.names = F, stringsAsFactors = F)
else data.frame(p = p,
test = fun,
row.names = NULL, check.names = F, stringsAsFactors = F)
}
#' Function to choose a statistical test
#'
#' This function takes a variable and a grouping variable as arguments, and returns a statistcal test to use, expressed as a single-term formula.
#'
#' This function uses appropriate non-parametric tests depending on the number of levels (wilcoxon.test for two levels
#' and kruskal.test for more), and fisher.test with fallback on chisq.test on error for factors.
#'
#' @param var The variable to test
#' @param grp The variable for the groups
#' @return A statistical test function
#' @export
tests_auto <- function(var, grp) {
grp <- factor(grp)
if (nlevels(grp) < 2)
~no.test
else if (is.factor(var)) {
if (tryCatch(is.numeric(fisher.test(var ~ grp)$p.value), error = function(e) F))
~fisher.test
else
~chisq.test
} else if (nlevels(grp) == 2)
~wilcox.test
else
~kruskal.test
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.