R/ggcorrmat.R

In ggstatsplot: 'ggplot2' Based Plots with Statistical Details

#' @title Visualization of a correlation matrix
#' @name ggcorrmat
#'
#' @description
#' Correlation matrix containing results from pairwise correlation tests.
#' If you want a data frame of (grouped) correlation matrix, use
#' [`correlation::correlation()`] instead. It can also do grouped analysis when
#' used with output from [`dplyr::group_by()`].
#'
#' @section Summary of graphics:
#'
#' ```{r child="man/rmd-fragments/ggcorrmat_graphics.Rmd"}
#' ```
#'
#' @param ... Currently ignored.
#' @param data A data frame from which variables specified are to be taken.
#' @param cor.vars Variables for which the correlation matrix is to be computed
#'   and visualized, specified using `{tidyselect}` syntax (e.g.,
#'   `c(var1, var2)` or `starts_with("Sepal")`). If `NULL` (default), all
#'   numeric variables from `data` will be used.
#' @param cor.vars.names Optional list of names to be used for `cor.vars`. The
#'   names should be entered in the same order.
#' @param partial Can be `TRUE` for partial correlations. For Bayesian partial
#'   correlations, "full" instead of pseudo-Bayesian partial correlations (i.e.,
#'   Bayesian correlation based on frequentist partialization) are returned.
#' @param matrix.type Character, `"upper"` (default), `"lower"`, or `"full"`,
#'   to display the upper triangular, lower triangular, or full matrix,
#'   respectively.
#' @param sig.level Significance level (Default: `0.05`). If the (adjusted; see
#'   `p.adjust.method`) *p*-value is bigger than `sig.level`, then the
#'   corresponding correlation coefficient is regarded as insignificant and
#'   flagged as such in the plot. Ignored for `type = "bayes"`.
#' @param pch Decides the point shape to be used for insignificant correlation
#'   coefficients. Default: `pch = "cross"`. The caption explaining the
#'   insignificance marker is added only for `pch = "cross"` (or `4`).
#' @param colors A character vector of exactly three colors for the gradient:
#'   low (negative correlations), mid (zero), and high (positive correlations).
#'   Must be a **diverging** palette so that the sign of the correlation is
#'   visually obvious.
#'   Default: `c("#EA4335", "white", "#4285F4")` (red–white–blue).
#' @param ggcorrplot.args A list of additional (mostly aesthetic) arguments that
#'   will be passed to [`ggcorrplot::ggcorrplot()`] function. The list should
#'   avoid any of the following arguments since they are already internally
#'   being used: `corr`, `p.mat`, `sig.level`, `ggtheme`, `colors`, `type`,
#'   `lab`, `pch`, `legend.title`, `digits`.
#' @param subtitle The text for the plot subtitle.
#' @param caption The text for the plot caption. If the insignificance marker
#'   caption is shown (see `pch`), this text is displayed above it.
#' @inheritParams statsExpressions::corr_test
#' @inheritParams ggbetweenstats
#' @inheritParams ggcorrplot::ggcorrplot
#' @inheritParams ggscatterstats
#'
#' @inheritSection statsExpressions::corr_test Correlation analyses
#'
#' @autoglobal
#'
#' @returns A `ggplot` object, which can be further modified with `{ggplot2}`
#'   functions. Note that [`extract_stats()`] does not return statistical
#'   details for this plot; use [`correlation::correlation()`] instead.
#'
#' @seealso \code{\link{grouped_ggcorrmat}} \code{\link{ggscatterstats}}
#'   \code{\link{grouped_ggscatterstats}}
#'
#' @details Missing values are handled using pairwise deletion (each
#'   correlation uses all complete pairs of observations), in which case the
#'   legend shows the minimum, mode, and maximum sample size across pairs.
#'   Partial correlations use only complete cases.
#'
#' For details, see:
#' <https://www.indrapatil.com/ggstatsplot/articles/web_only/ggcorrmat.html>
#'
#' @examples
#' set.seed(123)
#' ggcorrmat(iris)
#'
#' # with data containing NAs (uses pairwise complete observations)
#' ggcorrmat(airquality)
#'
#' # selecting specific variables
#' ggcorrmat(iris, cor.vars = c(Sepal.Length, Petal.Length, Petal.Width))
#' @export
ggcorrmat <- function(
  data,
  cor.vars = NULL,
  cor.vars.names = NULL,
  matrix.type = "upper",
  type = "parametric",
  tr = 0.2,
  partial = FALSE,
  digits = 2L,
  sig.level = 0.05,
  conf.level = 0.95,
  bf.prior = 0.707,
  p.adjust.method = "holm",
  colors = c("#EA4335", "white", "#4285F4"),
  pch = "cross",
  ggcorrplot.args = list(
    method = "square",
    outline.color = "black",
    pch.cex = 14
  ),
  ggtheme = ggstatsplot::theme_ggstatsplot(),
  ggplot.component = NULL,
  title = NULL,
  subtitle = NULL,
  caption = NULL,
  ...
) {
  type <- extract_stats_type(type)
  if (!missing(cor.vars)) {
    data <- select(data, {{ cor.vars }})
  }

  # statistical analysis ------------------------------------------

  mpc_df <- correlation::correlation(
    data = data,
    rename = cor.vars.names,
    method = if (type == "nonparametric") "spearman" else "pearson",
    p_adjust = p.adjust.method,
    ci = conf.level,
    bayesian = type == "bayes",
    bayesian_prior = bf.prior,
    tr = tr,
    partial = partial,
    partial_bayesian = type == "bayes" && partial,
    winsorize = if (type == "robust") tr else FALSE
  )

  # type of correlation and if it is a partial correlation
  r.method.text <- gsub(" correlation", "", unique(mpc_df$Method), fixed = TRUE)
  r.type <- if (partial) "correlation (partial):" else "correlation:"
  r.label <- bquote(atop(scriptstyle(bold(.(r.type))), .(r.method.text)))

  # plot ------------------------------------------

  # legend title with information about correlation type and sample size
  if (!anyNA(data) || partial) {
    n.label <- bquote(atop(
      scriptstyle(bold("sample sizes:")),
      italic(n) ~ "=" ~ .(.prettyNum(mpc_df$n_Obs[[1L]]))
    ))
  } else {
    n.label <- bquote(atop(
      atop(
        scriptstyle(bold("sample sizes:")),
        italic(n)[min] ~ "=" ~ .(.prettyNum(min(mpc_df$n_Obs)))
      ),
      atop(
        italic(n)[mode] ~ "=" ~ .(.prettyNum(datawizard::distribution_mode(
          mpc_df$n_Obs
        ))),
        italic(n)[max] ~ "=" ~ .(.prettyNum(max(mpc_df$n_Obs)))
      )
    ))
  }
  legend.title <- bquote(atop(.(n.label), .(r.label)))

  plot_corr <- .eval_f(
    ggcorrplot::ggcorrplot,
    corr = as.matrix(select(mpc_df, matches("^parameter|^r"))),
    p.mat = as.matrix(select(mpc_df, matches("^parameter|^p"))),
    sig.level = if (type == "bayes") Inf else sig.level,
    ggtheme = ggtheme,
    colors = colors,
    type = matrix.type,
    lab = TRUE,
    pch = pch,
    legend.title = legend.title,
    digits = digits,
    !!!ggcorrplot.args
  )

  # p-value adjustment message ------------------------------------------

  if ((pch == "cross" || pch == 4L) && type != "bayes") {
    p_label <- if (p.adjust.method == "none") {
      # nocov start
      substitute(
        italic(p)[unadj.] ~ "< " ~ sig.level,
        list(sig.level = sig.level)
      )
      # nocov end
    } else {
      substitute(
        italic(p)[adj.text - adj.] ~ "< " ~ sig.level,
        list(sig.level = sig.level, adj.text = .p_adjust_text(p.adjust.method))
      )
    }

    caption <- substitute(
      atop(
        displaystyle(top.text),
        expr = bold("X") ~ "= non-significant at" ~ p_label
      ),
      env = list(p_label = p_label, top.text = caption)
    )
  }

  # annotations ------------------------------------------

  plot_corr +
    theme(
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      legend.title = element_text(size = 15)
    ) +
    labs(
      title = title,
      subtitle = subtitle,
      caption = caption,
      x = NULL,
      y = NULL
    ) +
    ggplot.component
}


#' @title Visualization of a correlogram (or correlation matrix) for all
#'   levels of a grouping variable
#' @name grouped_ggcorrmat
#'
#' @description
#'
#' Helper function for `ggstatsplot::ggcorrmat()` to apply this function across
#' multiple levels of a given factor and combining the resulting plots using
#' `ggstatsplot::combine_plots()`.
#'
#' @inheritParams ggcorrmat
#' @inheritParams grouped_ggbetweenstats
#' @inheritDotParams ggcorrmat -title
#'
#' @autoglobal
#'
#' @seealso \code{\link{ggcorrmat}}, \code{\link{ggscatterstats}},
#'   \code{\link{grouped_ggscatterstats}}
#'
#' @inherit ggcorrmat references details
#'
#' @returns A `patchwork` object combining one plot per level of
#'   `grouping.var` (see [`combine_plots()`]).
#'
#' @examples
#' set.seed(123)
#'
#' grouped_ggcorrmat(
#'   data = iris,
#'   grouping.var = Species,
#'   type = "robust",
#'   colors = c("#0072B2", "white", "#D55E00"),
#'   p.adjust.method = "holm",
#'   plotgrid.args = list(ncol = 1L),
#'   annotation.args = list(tag_levels = "i")
#' )
#' @export
grouped_ggcorrmat <- .make_grouped_fn(ggcorrmat, guides = "keep")