R/crossTab.R

In ufs: A Collection of Utilities

crossTab <- function(x, y=NULL, conf.level=.95,
                     digits=2, pValueDigits=3, ...) {

  res <- list(input = as.list(environment()),
              intermediate = list(),
              output = list());

  if (is.null(y)) {
    if (!is.table(x) && !is.matrix(x)) {
      stop("If argument 'y' is empty, argument 'x' must be a matrix or a ",
           "table! Instead, it has class ", class(x), ".");
    } else {
      res$intermediate$n <- sum(x);
      res$intermediate$table <- x;
      res$intermediate$confIntV <- confIntV(res$intermediate$table,
                                            conf.level=conf.level, ...);
    }
  } else {
    if (length(x) != length(y)) {
      stop("The length of arguments 'x' and 'y' is not the same; are you ",
           "sure they're both vectors of equal length?");
    }

    res$intermediate$table <- table(x, y);
    res$intermediate$n <- sum(res$intermediate$table);
    res$intermediate$varNames <- c(deparse(substitute(x)), deparse(substitute(y)));
    res$intermediate$validForBoth <- stats::complete.cases(cbind(x, y));

    if (length(unique(x[res$intermediate$validForBoth])) < 2) {
      stop("The variable specified as 'x' ('", res$intermediate$varNames[1],
           "') has less than two unique ",
           "values!");
    }
    if (length(unique(y[res$intermediate$validForBoth])) < 2) {
      stop("The variable specified as 'y' ('", res$intermediate$varNames[2],
           "') has less than two unique ",
           "values!");
    }
    res$intermediate$confIntV <- confIntV(x, y, conf.level=conf.level, ...);
  }

  names(attributes(res$intermediate$table)$dimnames) <- c(NULL, NULL);

  res$output <- res$intermediate$confIntV$output;
  res$output$chisq <- list(statistic =
                             res$intermediate$confIntV$intermediate$cramersV$intermediate$chisq.test$statistic,
                           parameter =
                             res$intermediate$confIntV$intermediate$cramersV$intermediate$chisq.test$parameter,
                           p.value =
                             res$intermediate$confIntV$intermediate$cramersV$intermediate$chisq.test$p.value);

  class(res) <- 'crossTab';
  return(res);

}

#' @export
print.crossTab <- function(x, digits=x$input$digits,
                           pValueDigits=x$input$pValueDigits, ...) {
  print(x$intermediate$table);
  cat("\n");
  print(x$intermediate$confIntV, digits=digits);
  cat("\nChi-square[", x$output$chisq$parameter, "] = ",
      round(x$output$chisq$statistic, digits), ", ",
      formatPvalue(x$output$chisq$p.value, pValueDigits), sep="");
}

#' @export
pander.crossTab <- function(x, digits=x$input$digits,
                           pValueDigits=x$input$pValueDigits, ...) {
  cat("\n");
  pander(x$intermediate$table);
  cat("\n");
  print(x$intermediate$confIntV, digits=digits);
  cat("  \nChi-square[", x$output$chisq$parameter, "] = ",
      round(x$output$chisq$statistic, digits), ", ",
      formatPvalue(x$output$chisq$p.value, pValueDigits), sep="");
}