|
- #' 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
- }
- }
- }
|