R/sjPlotPearsonsChi2Test.R

In sjPlot: Data Visualization for Statistics in Social Science

#' @title Plot Pearson's Chi2-Test of multiple contingency tables
#' @name sjp.chi2
#'
#' @description Plot p-values of Pearson's Chi2-tests for multiple contingency tables as ellipses or tiles.
#'                Requires a data frame with dichotomous (dummy) variables.
#'                Calculation of Chi2-matrix taken from
#'                \href{https://talesofr.wordpress.com/2013/05/05/ridiculously-photogenic-factors-heatmap-with-p-values/}{Tales of R}.
#'
#' @param df A data frame with (dichotomous) factor variables.
#'
#' @return A ggplot-object.
#'
#' @inheritParams plot_grpfrq
#'
#' @examples
#' # create data frame with 5 dichotomous (dummy) variables
#' mydf <- data.frame(as.factor(sample(1:2, 100, replace=TRUE)),
#'                    as.factor(sample(1:2, 100, replace=TRUE)),
#'                    as.factor(sample(1:2, 100, replace=TRUE)),
#'                    as.factor(sample(1:2, 100, replace=TRUE)),
#'                    as.factor(sample(1:2, 100, replace=TRUE)))
#' # create variable labels
#' items <- list(c("Item 1", "Item 2", "Item 3", "Item 4", "Item 5"))
#'
#' # plot Chi2-contingency-table
#' sjp.chi2(mydf, axis.labels = items)
#'
#' @export
sjp.chi2 <- function(
  df,
  title = "Pearson's Chi2-Test of Independence",
  axis.labels = NULL,
  wrap.title = 50,
  wrap.labels = 20,
  show.legend = FALSE,
  legend.title = NULL
) {
  # --------------------------------------------------------
  # try to automatically set labels is not passed as parameter
  # --------------------------------------------------------
  if (is.null(axis.labels)) {
    axis.labels <- sjlabelled::get_label(df, def.value = colnames(df))
  }
  # ----------------------------------------------------------------
  # Calculation of Chi2-matrix taken from following blog-posting:
  # http://talesofr.wordpress.com/2013/05/05/ridiculously-photogenic-factors-heatmap-with-p-values/
  # ----------------------------------------------------------------
  combos <- expand.grid(rep(list(seq_len(ncol(df))), 2)) # combinations with repetitions
  combos <- as.matrix(combos)
  combos <- t(combos) # transpose matrix
  # ----------------------------------------------------------------
  # when 2 variables are *not* significant, they are independent
  # ----------------------------------------------------------------
  m <- data.frame()
  for (i in seq_len(ncol(combos))) {
    test <- stats::chisq.test(df[, combos[1, i]], df[, combos[2, i]])
    out <- data.frame(
      Row = colnames(df)[combos[1, i]],
      Column = colnames(df)[combos[2, i]],
      Chi.Square = round(test$statistic, 4),
      df = test$parameter,
      p.value = round(test$p.value, 4),
      stringsAsFactors = FALSE
    )
    m <- suppressWarnings(dplyr::bind_rows(m, out))
  }
  # ----------------------------
  # check if user defined labels have been supplied
  # if not, use variable names from data frame
  # ----------------------------
  if (is.null(axis.labels)) {
    axis.labels <- row.names(m)
  }
  # --------------------------------------------------------
  # unlist labels
  # --------------------------------------------------------
  if (!is.null(axis.labels) && is.list(axis.labels)) {
    axis.labels <- unlistlabels(axis.labels)
  }
  # ----------------------------
  # Prepare length of title and labels
  # ----------------------------
  # check length of diagram title and split longer string at into new lines
  if (!is.null(title)) {
    title <- sjmisc::word_wrap(title, wrap.title)
  }
  # check length of x-axis-labels and split longer strings at into new lines
  if (!is.null(axis.labels)) {
    axis.labels <- sjmisc::word_wrap(axis.labels, wrap.labels)
  }
  # --------------------------------------------------------
  # start with base plot object here
  # --------------------------------------------------------
  chiPlot <- ggplot2::ggplot(
    data = m,
    ggplot2::aes(
      x = .data$Row,
      y = .data$Column,
      fill = .data$p.value,
      label = .data$p.value
    )
  ) +
    ggplot2::geom_tile() +
    ggplot2::scale_x_discrete(labels = axis.labels) +
    ggplot2::scale_y_discrete(labels = axis.labels) +
    ggplot2::scale_fill_gradient2(
      low = grDevices::rgb(128, 205, 193, maxColorValue = 255),
      mid = "white",
      high = grDevices::rgb(5, 113, 176, maxColorValue = 255),
      midpoint = 0.05
    ) +
    ggplot2::geom_text(label = sprintf("%.3f", m$p.value)) +
    ggplot2::labs(title = title, x = NULL, y = NULL, fill = legend.title)
  # ---------------------------------------------------------
  # hide legend?
  # ---------------------------------------------------------
  if (!show.legend) {
    chiPlot <- chiPlot + ggplot2::guides(fill = "none")
  }

  chiPlot
}