R/wrap.chi.R

In michaelkardas/behavioralwrappers: Wrappers and other functions for the behavioral sciences

#' Chi-square tests
#'
#' @description Performs one-way goodness-of-fit and two-way contingency tests. The
#' function delegates the primary operations to \code{\link[stats]{chisq.test}}.
#'
#' @param dv1 Column vector containing the categorical dependent variable
#' @param iv1 Column vector containing the categorical independent variable (contingency tests, only)
#' @param p A vector of probabilities representing expected cell frequencies (goodness-of-fit tests, only). By default, the function assumes equal expected cell frequencies for all levels of the dependent variable.
#' @param correct A logical argument: If FALSE, the function does not apply Yates's correction for 2×2 contingency tables; if TRUE, the function applies Yates's correction for 2×2 contingency tables.
#'
#' @seealso \code{\link[stats]{chisq.test}}
#'
#' @examples
#' ## One-way goodness-of-fit test
#' wrap.chi(dv1 = bdata$DV9)
#'
#' ## Two-way contingency test
#' wrap.chi(dv1 = bdata$DV9, iv1 = bdata$IV2)
#'
#' @import stringr stats
#' @export
wrap.chi <- function(dv1,iv1=NULL,p=rep(1/nlevels(factor(dv1)),nlevels(factor(dv1))),correct=F) {
  options(scipen=999)

  # Error checks
  if(is.null(dv1)) {return(paste("Cannot find the column vector inputted to parameter dv1."))}
  if(is.null(substitute(iv1))==F&is.null(iv1)==T) {return(paste("Cannot find the column vector inputted to parameter iv1."))}
  if(is.factor(dv1)==F) {return("Must enter a factor variable for dv1.")}
  if(is.null(iv1)==F) {
    if(is.factor(iv1)==F) {return("Must enter a factor variable for iv1.")}
  }

  n <- sum(dv1!=""&is.na(dv1)==F&is.null(dv1)==F)
  dv1 <- factor(dv1); if(is.null(iv1)==F) {iv1 <- factor(iv1)}
  nlevels_dv1 <- nlevels(dv1)

  # Two-way contingency tests
  if(is.null(iv1)==F) {
    df <- data.frame(dv1,iv1)

    string <- "matrix <- aggregate(dv1 ~ iv1, data = df, function(x) c("
    for (i in 1:(nlevels(dv1)-1)) {
      string <- paste(string,"dv1",i," = sum(x==levels(dv1)[",i,"]), ",sep="")
    }
    for (i in (nlevels(dv1)):(nlevels(dv1))) {
      string <- paste(string,"dv1",i," = sum(x==levels(dv1)[",i,"])))",sep="")
    }
    eval(parse(text=string))
    b <- chisq.test(matrix[[2]],correct=correct)
    if(nrow(matrix[[2]])==2&ncol(matrix[[2]])==2) {
      if(correct==F) {print("Note that the function has NOT applied Yates's correction.")}
      if(correct==T) {print("Note that the function HAS applied Yates's correction.")}
    }
  }

  # One-way goodness of fit tests
  if(is.null(iv1)==T) {
    df <- dv1
    matrix <- matrix(data=NA,nrow=nlevels_dv1)

    for (i in 1:nlevels_dv1) {
      matrix[i] <- sum(dv1==levels(dv1)[i])
    }
    b <- chisq.test(matrix,correct=correct,p=p)
    print("ASSUMPTIONS: This function assumes equal expected cell frequencies for all levels of the dependent variable.")
  }

  if(b$p.value < .001) {
    wrap.writeClipboard(paste("# X2(",b$parameter,", N = ",n,") = ",wrap.rd0(b$statistic,2),", p < .001",sep=""))
    return(cat("\n","# X2(",b$parameter,", N = ",n,") = ",wrap.rd0(b$statistic,2),", p < .001",sep=""))
  }

  else {
    wrap.writeClipboard(paste("# X2(",b$parameter,", N = ",n,") = ",wrap.rd0(b$statistic,2),", p = ",wrap.rd(b$p.value,3),sep=""))
    return(cat("\n","# X2(",b$parameter,", N = ",n,") = ",wrap.rd0(b$statistic,2),", p = ",wrap.rd(b$p.value,3),sep=""))
  }
}