R functions to format correlation matrices into upper, lower, or upperLower format for printing

correlation_matrix_format.R

#' Format the lower triangle of a matrix for printing
#'
#' @param x A matrix (e.g., a correlation matrix).
#' @param diag Either a logical value indicating whether to print the diagonal of the matrix (`TRUE`) or not (`FALSE`) or a vector of values to place on the diagonal (e.g., variable reliabilities).
#' @param format_num Logical. Should the `format_num()` function from the `psychmeta` package be used to format numbers?
#' @param ... Arguments passed to `psychmeta::format_num()`.
#'
#' @return
#' @export
#'
#' @examples
#' lower_mat(cor(iris[,1:4]))
#' lower_mat(cor(iris[,1:4]), format_num = TRUE, digits = 3)
lower_mat <- function(x, diag = FALSE, format_num = FALSE, ...) {
  x <- as.matrix(x)
  if (length(diag) > 1) {
    diag(x) <- diag
    diag <- TRUE
  } else if (!is.logical(diag)) {
    diag(x) <- diag
    diag <- TRUE
  }
  if (format_num) {
    if (!requireNamespace("psychmeta")) {
      stop("Package 'psychmeta' is required if `format_num = TRUE`.")
    }
    x[lower.tri(x, diag = diag)] <- psychmeta::format_num(x[lower.tri(x, diag = diag)])
  }
  x[upper.tri(x, diag = !diag)] <- ""
  x <- as.data.frame(x)
  return(x)
}

#' Format the upper triangle of a matrix for printing
#'
#' @param x A matrix (e.g., a correlation matrix).
#' @param diag Either a logical value indicating whether to print the diagonal of the matrix (`TRUE`) or not (`FALSE`) or a vector of values to place on the diagonal (e.g., variable reliabilities).
#' @param format_num Logical. Should the `format_num()` function from the `psychmeta` package be used to format numbers?
#' @param ... Arguments passed to `psychmeta::format_num()`.
#'
#' @return
#' @export
#'
#' @examples
#' upper_mat(cor(iris[,1:4]))
#' upper_mat(cor(iris[,1:4]), format_num = TRUE, digits = 3)
upper_mat <- function(x, diag = FALSE, format_num = FALSE, ...) {
  x <- as.matrix(x)
  if (length(diag) > 1) {
    diag(x) <- diag
    diag <- TRUE
  } else if (!is.logical(diag)) {
    diag(x) <- diag
    diag <- TRUE
  }
  if (format_num) {
    if (!requireNamespace("psychmeta")) {
      stop("Package 'psychmeta' is required if `format_num = TRUE`.")
    }
    x[lower.tri(x, diag = diag)] <- psychmeta::format_num(x[lower.tri(x, diag = diag)])
  }
  x[upper.tri(x, diag = !diag)] <- ""
  x <- as.data.frame(x)
  return(x)
}

#' Fill the lower and uppoer triangles of a matrix with different values and format for printing
#'
#' @param lower A square matrix (e.g., a correlation matrix). The lower triangle values are used to fill the lower triangle of the resulting matrix.
#' @param upper A square matrix (e.g., a correlation matrix). The lower triangle values are used to fill the upper triangle of the resulting matrix.
#' @param diag Either `FALSE` to omit the diagonal of the matrix, `"lower"` to print the diagonal of `lower`, `"upper"` to print the diagonal of `upper`, or a vector of values to place on the diagonal (e.g., variable reliabilities).
#' @param diff Logical. Should the upper triangle be the difference between `lower` and `upper`?
#' @param format_num Logical. Should the `format_num()` function from the `psychmeta` package be used to format numbers?
#' @param ... Arguments passed to `psychmeta::format_num()`.
#'
#' @return
#' @export
#'
#' @examples
#' upper_mat(cor(iris[,1:4]))
#' upper_mat(cor(iris[,1:4]), format_num = TRUE, digits = 3)
lower_upper_mat <- function(lower, upper, diag = FALSE, diff = FALSE, format_num = FALSE, ...) {
  if (nrow(lower) != ncol(lower)) {
    stop("`lower` matrix must be square.")
  }
  if (nrow(upper) != ncol(upper)) {
    stop("`upper` matrix must be square.")
  }
  if (nrow(lower) != ncol(upper)) {
    stop("`lower` and `upper` matrices must have the same dimensions.")
  }
  out <- lower <- as.matrix(lower)
  upper <- as.matrix(upper)
  colnames(out) <- colnames(upper)
  rownames(out) <- rownames(lower)
  if (diff == TRUE) {
    upper <- lower - upper
  }
  out[lower.tri(out)] <- upper[lower.tri(upper)]
  out <- t(out)
  out[lower.tri(out, diag = TRUE)] <- lower[lower.tri(lower, diag = TRUE)]
  if (length(diag) > 1) {
    diag(out) <- diag
    diag <- TRUE
  } else if (diag == TRUE) {
    stop("`diag` must be one of: FALSE, 'lower', 'upper', or a vector of values to place on the diagonal.")
  } else if (diag == "upper") {
    diag(out) <- diag(upper)
    diag <- TRUE
  } else if (diag == "lower") {
    diag <- TRUE
  } else if (!is.logical(diag)) {
    diag(out) <- diag
    diag <- TRUE
  }
  if (format_num) {
    if (!requireNamespace("psychmeta")) {
      stop("Package 'psychmeta' is required if `format_num = TRUE`.")
    }
    out[lower.tri(out)] <- psychmeta::format_num(out[lower.tri(out)])
    out[upper.tri(out)] <- psychmeta::format_num(out[upper.tri(out)])
    diag(out) <- psychmeta::format_num(diag(out))
  }
  if (!diag) {
    diag(out) <- ""
  }
  out <- as.data.frame(out)
  return(out)
}