R/04_Visual_Heatmaps.R

In davnovak/SingleBench: Framework for benchmarking and optimising dimension-reduction and clustering pipelines in expression data analysis

#' Create a heatmap of expression value medians per population
#'
#' Creates a heatmap showing expression value medians per each marker per each labelled population.
#'
#' @param benchmark object of type \code{Benchmark}, as generated by the constructor \code{Benchmark}
#'
#' @export
PlotPopulationHeatmap <- function(
  benchmark
) {
  
  .PlotClustering.ValidityChecks(environment())
  
  mfis <- .h5readLabelMedians(benchmark)
  
  ph <- pheatmap::pheatmap(
    mfis,
    scale = 'column',
    cluster_col = FALSE,
    cluster_row = FALSE,
    main = paste0('Scaled medians per population'),
    silent = TRUE
  )
  
  cowplot::plot_grid(
    NULL,
    ph[[4]],
    nrow = 2, rel_heights = c(1, 60)
  )
}

#' Create a heatmap of expression value medians per cluster
#'
#' Creates a heatmap showing expression value medians per each cluster, taking clusters from a chosen subpipeline (and *n*-parameter iteration(s)).
#' If multiple *n*-parameter iterations are chosen, a list of plots is generated.
#'
#' @param benchmark object of type \code{Benchmark}, as generated by the constructor \code{Benchmark} and evaluated using \code{Evaluate}
#' @param idx.subpipeline integer value: index of subpipeline that includes a clustering step
#' @param idcs.n_param integer or vector of integers: indices of *n*-parameter(s) iterations of interest. Default value is \code{NULL}, which translates to all *n*-parameter iterations of the given sub-pipeline (or none if *n*-parameters were not used)
#'
#' @export
PlotClusterHeatmap <- function(
  benchmark,
  idx.subpipeline,
  idcs.n_param = NULL
) {
  
  if (class(benchmark) != 'Benchmark') stop('benchmark is not of class "Benchmark"')
  
  if (is.null(idcs.n_param))
    idcs.n_param <- seq_len(GetNParameterIterationsCount(benchmark, idx.subpipeline))
  
  no_npar <- FALSE
  if (length(idcs.n_param) == 0) {
    no_npar <- TRUE
    idcs.n_param <- 1
  }
  
  res <- purrr::map(
    idcs.n_param, function(idx.n_param) {
      
      if (no_npar)
        idx.n_param <- NULL
      
      mfis <- .h5readClusterMedians(benchmark, idx.subpipeline, idx.n_param)
      name <- GetNParameterIterationName(benchmark, idx.subpipeline, idx.n_param)
      ph <- pheatmap::pheatmap(
        mfis, scale = 'column', cluster_col = FALSE, cluster_row = FALSE, main = paste0('Scaled medians per cluster: ', name), silent = TRUE
      )
      cowplot::plot_grid(
        NULL,
        ph[[4]],
        nrow = 2, rel_heights = c(1, 60)
      )
    }
  )
  
  if (length(idcs.n_param) == 1) res[[1]] else res
}