R/04_Visual_CompositionMaps.R

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

#' Create cluster composition map
#'
#' Creates a plot showing the composition of each cluster in terms of manually annotated populations.
#' You need to specify a sub-pipeline and *n*-parameter iteration(s) by index.
#' If multiple *n*-parameter iterations are chosen, a list of plots is returned.
#'
#' @param benchmark an object of class \code{Benchmark}, as generated by the constructor \code{Benchmark} and evaluated using \code{Evaluate}
#' @param idx.subpipeline integer value: index of sub-pipeline that includes a clustering step
#' @param idcs.n_param integer or vector of integers: indices of *n*-parameter iteration(s) of interest. Default value is \code{NULL} (all of them, or *n*-parameter was not used)
#' 
#' @returns list of plots, one per each n-parameter iteration
#'
#' @export
PlotCompositionMap <- function(
  benchmark,
  idx.subpipeline,
  idcs.n_param = NULL
) {
  
  .PlotClustering.ValidityChecks(environment())
  
  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
  }
  
  gates <- GetAnnotation(benchmark, concatenate = TRUE)
  
  Cluster <- Count <- RelativeCount <- PopulationLabel <- TextPosition <- NULL # avoid build check warning
  
  res <- purrr::map(
    idcs.n_param,
    function(idx.n_param) {
      
      if (no_npar)
        idx.n_param <- NULL
      
      clusters <- as.factor(GetClustering(benchmark, idx.subpipeline, idx.n_param))
      name <- GetNParameterIterationName(benchmark, idx.subpipeline, idx.n_param)
      
      m <- levels(clusters)
      pop_labels <- c(letters[1:(nlevels(gates))])
      levels(gates) <- paste0('(', pop_labels, ') ', levels(gates))
      clus_comp <-
        dplyr::tibble(
          'Cluster'         = factor(m, levels = m) %>% rep(each = nlevels(gates)),
          'Population'      = as.factor(levels(gates)) %>% rep(times = nlevels(clusters)),
          'Count'           = purrr::map(m, function(x) table(gates[clusters == x]) %>% as.vector) %>% unlist,
          'PopulationLabel' = pop_labels %>% rep(times = nlevels(clusters)),
          'RelativeCount'   = NA,
          'TextPosition'    = NA
        ) %>% 
        dplyr::group_by(Cluster) %>% 
        dplyr::mutate(
          RelativeCount = Count / sum(Count), 
          TextPosition = 1 - cumsum(RelativeCount) + RelativeCount / 2
        ) %>% 
        dplyr::ungroup()
      clus_comp$TextPosition[clus_comp$RelativeCount < 0.005] <- NA # de-clutter
      p.clus_comp <-
        ggplot(clus_comp, aes(Cluster, RelativeCount, fill = Population)) +
        geom_bar(stat = 'identity', colour = 'black', size = 0.1) +
        coord_flip() +
        scale_fill_manual(values = c(RColorBrewer::brewer.pal(8, 'Dark2')[-8], RColorBrewer::brewer.pal(12, 'Paired')[-6], RColorBrewer::brewer.pal(8, 'Accent'), RColorBrewer::brewer.pal(9, 'Pastel1'))) +
        geom_text(aes(Cluster, TextPosition, label = PopulationLabel), size = 4) +
        labs(x = 'Cluster', y = 'Relative population count') +
        scale_x_discrete(position = 'top') +
        guides(fill = guide_legend(title = 'Gates')) +
        ggtitle(paste0(name, ' composition map')) +
        theme_minimal() +
        theme(plot.margin = unit(c(0.6, 0.6, 0.6, 0.6), 'cm'))
      p.clus_comp
    }
  )
  
  if (length(idcs.n_param) == 1) res[[1]] else res
}