#' 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 testify <- function(x, f, group) { # Extract the name of the function f %>% deparse() %>% Reduce(f = paste0) %>% substring(2) -> fun # Try the function f <- eval(f[[2]]) 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) } #' Functions to choose a statistical test #' #' These functions take a variable and a grouping variable as arguments, and return a statistcal test to use, expressed as a single-term formula. #' #' Currently, only \code{tests_auto} is defined, and picks between t test, wilcoxon, anova, kruskal-wallis and fisher depending on the number of groups, the type of the variable, the normality and homoskedasticity of the distributions. #' #' @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 { all_normal <- all(tapply(var, grp, is.normal)) if (nlevels(grp) == 2) { if (all_normal) { if (tryCatch(stats::var.test(var ~ grp)$p.value > .1, warning = function(e) F, error = function(e) F)) ~. %>% t.test(var.equal = T) else ~. %>% t.test(var.equal = F) } else ~wilcox.test } else { if (all_normal) { if (tryCatch(stats::bartlett.test(var ~ grp)$p.value > .1, warning = function(e) F, error = function(e) F)) ~. %>% oneway.test(var.equal = T) else ~. %>% oneway.test(var.equal = F) } else ~kruskal.test } } }