R/math.equal.var.R

In feranpre/feR: Basic functions that I use all the time

#' @param x
#'
#' @param y
#' @param x.name
#' @param y.name
#' @param digits
#' @param p.sig
#' @param p.sig.small
#' @param p.sig.very.small
#' @param stop.on.error
#' @param show.error
#' @param DEBUG
#'
#' @example
#'
#' test.equal.var(feRdata$age, feRdata$sex)
#'
#' @importFrom car leveneTest
#' @export
test.equal.var <- function(x, y, x.name="x", y.name="y", digits = 2,
                           p.sig = 0.05, p.sig.small = 0.01, p.sig.very.small = 0.001,
                           stop.on.error = TRUE, show.error = TRUE, DEBUG = FALSE) {


  d <- data.frame(x=x, y=y)
  # names(d) <- c(x.name, y.name)

  d <- na.omit(d)
  if(!is.factor(d$y)) d$y <- factor(d$y)

  if(nrow(d) < length(levels(factor(d$y)))) {
    e <- "Not enough observations"
    if(stop.on.error) stop(e)
    else {
      message(e)
      return(NA)
    }
  }

  if (length(levels(factor(d$y))) < 2) {
    e <- "Not enough groups"
    if(stop.on.error) stop(e)
    else {
      message(e)
      return(NA)
    }
  }

  if(is.normal(d$x,d$y, p.sig = p.sig, stop.on.error=stop.on.error)) {
    if(length(levels(d$y)) == 2) do.test = "BARTLETT"
    else do.test = "LEVENE"
  } else do.test = "LEVENE"

  if(do.test == "BARTLETT") {
    r.temp <- bartlett.test(d$x ~ d$y)
    names(r.temp) <- c("statistic", "df", "p.value", "data.name", "method")
    result <- data.frame(method="Bartlett's test")
    result$df <- r.temp$df
    result$stat.name <- "K squared"


  } else if (do.test == "LEVENE") {
    r.temp <- car::leveneTest(d$x ~ d$y)
    names(r.temp) <- c("df","statistic","p.value")
    result <- data.frame(method = "Levene's test")
    result$df <- paste0("(",r.temp$df,")",collapse = "-")
    result$stat.name <- "F value"
  }

  result$statistic <- r.temp$statistic[1]
  result$p.value <- r.temp$p.value[1]

  # result <- result[,c("test","df","stat.name","statistic","p.value")]
  result
}


#' @export
are.var.equal <- function(x, y, p.sig=0.05, stop.on.error = TRUE) {

  r.temp <- test.equal.var(x=x,y=y,p.sig = p.sig, stop.on.error = stop.on.error)

  if(r.temp$p.value < p.sig) return(FALSE)

  return(TRUE)
}