R/04_Visual_NParamMap.R

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

#' Plot an *n*-parameter map for clustering
#'
#' Creates plots showing values of clustering evaluation metrics and how they change with different DR or clustering *n*-parameters.
#' If you choose a sub-pipeline where one *n*-parameter (for instance, latent-space projection dimensionality or target cluster count) varies, a line plot is produced for each metrics.
#' If you choose one where both *n*-parameters (for the projection step and the clustering step) vary, a heatmap is produced instead.
#' If neither *n*-parameter varies, this function returns \code{NULL}.
#'
#' @param benchmark an object of class \code{Benchmark}, as generated by the constructor \code{Benchmark} and evaluated using \code{Evaluate.Benchmark}
#' @param idx.subpipeline integer value: index of subpipeline that includes a clustering step
#'
#' @export
PlotNParameterMap_Clustering <- function(
  benchmark,
  idx.subpipeline
) {
  
  .PlotClustering.ValidityChecks(environment())
  
  vals <- GetClusteringScoringTable(benchmark, idx.subpipeline)
  n_param_names  <- GetNParameterNames(benchmark, idx.subpipeline)
  npar_proj <- n_param_names$projection
  npar_clus <- n_param_names$clustering
  
  npar_proj_variable <- !is.null(npar_proj) && length(unique(vals[[npar_proj]])) > 1
  npar_clus_variable <- !is.null(npar_clus) && length(unique(vals[[npar_clus]])) > 1
  
  single_run <- 'Value' %in% colnames(vals)
  
  suppressWarnings({
    if (npar_proj_variable && npar_clus_variable) {
      if (single_run) {
        ymin <- min(vals$Value)
        ymax <- max(vals$Value)
      } else {
        ymin <- min(vals$`Mean Value`)
        ymax <- max(vals$`Mean Value`)
      }
      
      offset <- (ymax - ymin) / 8
      ymin <- ymin - offset
      ymax <- ymax + offset
      
      p <-
        purrr::map(
          levels(vals$`Evaluation Metric`),
          function(m) {
            d <- vals[vals$`Evaluation Metric` == m, ]
            ggplot(d, aes(
              x = as.factor(d[[npar_proj]]), y = as.factor(d[[npar_clus]]),
              fill = if (single_run) d[['Value']] else d[['Mean Value']]
            )) + scale_fill_gradient(low = 'yellow', high = 'darkred') + geom_tile(colour = 'black', size = 0.2) +
              geom_text(aes(label = round(if (single_run) d[['Value']] else d[['Mean Value']], 3))) + theme(plot.margin = unit(c(0.1, 0.1, 0.1, 0.1), 'cm')) +
              labs(title = m) + theme_dark() + xlab(npar_proj) + ylab(npar_clus) +
              ggtitle(m) + theme(legend.position = 'none')
          }
        )
      
      p <- do.call(cowplot::plot_grid, c(p, ncol = 5))
      
    } else if (npar_clus_variable) {
      
      if (single_run) {
        ymin <- min(vals$Value)
        ymax <- max(vals$Value)
        offset <- (ymax - ymin) / 8
        ymin <- ymin - offset
        ymax <- ymax + offset
        p <-
          ggplot(vals, aes(
            x = as.factor(vals[[npar_clus]]), y = vals[['Value']],
            group = vals[['Evaluation Metric']], col = vals[['Evaluation Metric']]
          )) + geom_point(size = 1.8) + geom_line(size = 1.2, alpha = 0.6) +
          theme_dark() + theme(plot.margin = unit(c(0.1, 0.1, 0.1, 0.1), 'cm'), legend.position = 'none') +
          xlab(npar_clus) + ylab('Evaluation metric value') +
          facet_wrap(~ vals[['Evaluation Metric']], scales = 'free')
      } else {
        ymin <- min(vals[['Mean Value']])
        ymax <- max(vals[['Mean Value']])
        offset <- (ymax - ymin) / 8
        ymin <- ymin - offset
        ymax <- ymax + offset
        p <-
          ggplot(vals, aes(
            x = as.factor(vals[[npar_clus]]), y = vals[['Mean Value']],
            group = vals[['Evaluation Metric']], col = vals[['Evaluation Metric']]
          )) + geom_point(size = 1.8) + geom_line(size = 1.2, alpha = 0.6) +
          geom_errorbar(
            aes(ymin = vals[['Mean Value']] - vals[['Standard Deviation']], ymax = vals[['Mean Value']] + vals[['Standard Deviation']]),
            width = .1
          ) + theme_dark() + theme(plot.margin = unit(c(0.1, 0.1, 0.1, 0.1), 'cm'), legend.position = 'none') +
          xlab(npar_clus) + ylab('Evaluation metric value') +
          facet_wrap(~ vals$`Evaluation Metric`, scales = 'free')
      }
    } else if (npar_proj_variable) {
      
      if (single_run) {
        ymin <- min(vals[['Value']])
        ymax <- max(vals[['Value']])
        offset <- (ymax - ymin) / 8
        ymin <- ymin - offset
        ymax <- ymax + offset
        p <-
          ggplot(vals, aes(
            x = as.factor(vals[[npar_proj]]), y = vals[['Value']],
            group = vals[['Evaluation Metric']], col = vals[['Evaluation Metric']]
          )) + geom_point(size = 1.8) + geom_line(size = 1.2, alpha = 0.6) +
          theme_dark() + theme(plot.margin = unit(c(0.1, 0.1, 0.1, 0.1), 'cm'), legend.position = 'none') +
          xlab(npar_proj) + ylab('Evaluation metric value') +
          facet_wrap(~ vals[['Evaluation Metric']], scales = 'free')
      } else {
        ymin <- min(vals[['Mean Value']])
        ymax <- max(vals[['Mean Value']])
        offset <- (ymax - ymin) / 8
        ymin <- ymin - offset
        ymax <- ymax + offset
        p <-
          ggplot(vals, aes(
            x = as.factor(vals[[npar_proj]]), y = vals[['Mean Value']],
            group = vals[['Evaluation Metric']], col = vals[['Evaluation Metric']]
          )) + geom_point(size = 1.8) + geom_line(size = 1.2, alpha = 0.6) +
          geom_errorbar(
            aes(ymin = vals[['Mean Value']] - vals[['Standard Deviation']], ymax = vals[['Mean Value']] + vals[['Standard Deviation']]),
            width = .1
          ) + theme_dark() + theme(plot.margin = unit(c(0.1, 0.1, 0.1, 0.1), 'cm'), legend.position = 'none') +
          xlab(npar_proj) + ylab('Evaluation metric value') +
          facet_wrap(~ vals[['Evaluation Metric']], scales = 'free')
      }
    } else {
      return(NULL)
    }  
  })
  
  .msg('Plotting n-parameter map for subpipeline ')
  .msg_alt(GetSubpipelineName(benchmark, idx.subpipeline), '\n')
  p
}