R/plot_factor_scores.R

In ahnjedid/MetaConIdentifier: Metadata Confounding Identifier

#' @title plot_factor_scores
#'
#' @description Plot the matrix of factor scores as an interactive heatmap.
#' The user will be able to identify which groups of observations strongly
#' influence a particular factor. If that group of observations share a
#' common variable value, this may indicate potential confounding of the
#' differential expression study.
#'
#' @param fi_mat Full matrix of factor scores for the observations.
#' @param num_factors An optional parameter specifying the topmost number
#' of factors to subset for visualization.
#'
#' @examples
#' # Using tcga_metadata from package.
#' library(MetaConIdentifier)
#' ca_info <- run_ca(tcga_meta_clean)
#'
#' # Plot the matrix of factor scores as a heatmap to visualize which
#' # groups of observations are contributing the most to each factor.
#'
#' # Example 1: Plot all factors.
#' plot_factor_scores(ca_info$fi_mat)
#'
#' # Example 2: Plot a subset of factors by using the return value from
#' # identify_elbow().
#' num_factors <- identify_elbow(ca_info$fi_var)
#' plot_factor_scores(ca_info$fi_mat, num_factors)
#'
#'
#' @export
#' @importFrom heatmaply heatmaply
#' @importFrom grDevices colorRampPalette
#' @importFrom RColorBrewer brewer.pal
#'
plot_factor_scores <- function(fi_mat, num_factors = NULL){
  if (!is.matrix(fi_mat)){
    stop("Factor scores are not in a matrix.")
  }

  if (!is.null(num_factors)){
    factor_scores <- as.data.frame(fi_mat[ , 1:num_factors])
  } else{
    factor_scores <- as.data.frame(fi_mat)
  }

  # Regular heatmap.
  # pheatmap::pheatmap(as.data.frame(fi_mat),
  #                    cluster_rows = FALSE, cluster_cols = FALSE,
  #                    show_rownames = FALSE, show_colnames = TRUE,
  #                    main = "Contribution of each observation (row) to
  #                    each factor (column)")

  # Interactive heatmap.
  heatmap <- heatmaply::heatmaply(
    factor_scores,
    color = grDevices::colorRampPalette(
      rev(RColorBrewer::brewer.pal(n = 7, name = "RdYlBu")))(100),
    Rowv = FALSE, Colv = FALSE, showticklabels = c(TRUE, FALSE),
    xlab = "Factors", ylab = "Observations",
    main = "Contribution of each observation to each factor")
  print(heatmap)

  return (invisible(NULL))
}

# [END]