R/CA_plot_consensus_clusters.R

In FanqianYin/omicstoolkits: Integrated bioinformatics toolkits for quantitative omics data analysis

#' plot_consensus_cluster
#'
#' Visualization of consensus result
#'
#' plot_consensus_cluster
#'
#'
#' @aliases plot_consensus_cluster.heatmap
#' @aliases plot_consensus_cluster.pca
#'
#' @param res.con Result of Consensus_Cluster_Analysis().
#' @param clustering_method_columns Hierarchical clustering method used for clustering differnt clusters result of multi-clustering algorithm, pass to \code{\link[stats]{hclust}}.
#' @param clustering_method_rows Default as same as consensus.method used in \code{Consensus_Cluster_Analysis()}, pass to \code{\link[stats]{hclust}}.
#' @param method clustering method list in \code{clustering.methods()}.
#' @param col_title_prefix Prefix for colum subclass name.
#' @param top_annotation A HeatmapAnnotation-class generated by \code{\link[ComplexHeatmap]{HeatmapAnnotation}}, annotation information of column(here is sample).
#' @param right_annotation A HeatmapAnnotation-class generated by \code{\link[ComplexHeatmap]{HeatmapAnnotation}}, annotation information of row(here is variable).
#' @param main Title of plot.
#' @examples
#' plot_consensus_cluster.heatmap(res.con)
#' plot_consensus_cluster.pca(res.con)
#'
#' plot_cluster_algorithms.pca(res.con)
#' plot_cluster.pca(res.con, "kmeans")
#'
#' #Use consensus cluster result for column subclass on heatmap.
#' plot_exp_heatmap(res.con)
#' #Use specific method result like kmeans for column subclass on heatmap
#' plot_exp_heatmap(res.con, "kmeans")
#' @name plot_consensus_cluster
NULL


#' @rdname plot_consensus_cluster
#' @export
plot_consensus_cluster.heatmap <- function(res.con, main = "clutering algorithms", clustering_method_columns = "ward.D2", clustering_method_rows = NULL){
  #consenesus cluster heatmap
  if(is.null(clustering_method_rows)) clustering_method_rows <- res.con[["par"]][["consensus.method"]]
  if (res.con$k <= 9) { #k <=9, use RColorBrewer::brewer.pal
    Heatmap(res.con[["cluster_matrix"]],
            col = structure(RColorBrewer::brewer.pal(n = res.con$k, name = "Set1"), names = as.character(1:res.con$k)),
            cluster_rows = T, cluster_columns = T,
            clustering_method_columns = clustering_method_columns,
            clustering_method_rows = clustering_method_rows, name="clusters", row_title = "samples", column_title = main,
            row_split = res.con$k)+
      Heatmap(as.character(res.con$consensus_cluster), name = "Consensus cluster", col = structure(RColorBrewer::brewer.pal(n = res.con$k, name = "Set1"), names = as.character(1:res.con$k)))
  }else {#k > 9, use random colors()
    Heatmap(res.con[["cluster_matrix"]],
            col = 1:res.con$k,
            cluster_rows = T, cluster_columns = T,
            clustering_method_columns = "ward.D2",
            clustering_method_rows = "average", name="clusters", row_title = "samples", column_title = main,
            row_split = res.con$k)+
      rowAnnotation(df = data.frame("Consensus_cluster" = as.character(res.con$consensus_cluster)))
  }

}
#rowAnnotation(df = data.frame("consensus_cluster" = as.character(res.con$consensus_cluster)), col = list(consensus_cluster = structure(RColorBrewer::brewer.pal(n = res.con$k, name = "Set1"), names = as.character(1:res.con$k))))
#rowAnnotation(df = data.frame("consensus_cluster" = as.character(res.con$consensus_cluster)), col = list(consensus_cluster = structure(RColorBrewer::brewer.pal(n = res.con$k, name = "Set1"), names = as.character(1:res.con$k))))

#' @rdname plot_consensus_cluster
#' @export
plot_consensus_cluster.pca <- function(res.con, main = "Consensus cluster"){
  #pca plot
  fviz_cluster(list(data = res.con$d, cluster = res.con$consensus_cluster),geom = "point",
               palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
               ellipse.type = "convex", # Concentration ellipse
               repel = TRUE, # Avoid label overplotting (slow)
               show.clust.cent = FALSE, ggtheme = theme_minimal(),main = main)
}

#' @rdname plot_consensus_cluster
#' @export

plot_cluster_algorithms.pca <- function(res.con){
  #pca plot
  fviz_cluster(list(data = res.con$cluster_matrix, cluster = res.con$consensus_cluster),geom = "point",
               palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
               ellipse.type = "convex", # Concentration ellipse
               repel = TRUE, # Avoid label overplotting (slow)
               show.clust.cent = FALSE, ggtheme = theme_minimal(),main = "consistency of clustering algorithms")
}

#to be developed functions:
#plot_all_clusters.cpa
#' @rdname plot_consensus_cluster
#' @export
#plot_cluster.pca
#plot pca of single clustering algorithm result
plot_cluster.pca <- function(res.con, method){
  fviz_cluster(list(data = res.con$d, cluster = as.data.frame(res.con$cluster_matrix)[[method]]),geom = "point",
               palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
               ellipse.type = "convex", # Concentration ellipse
               repel = TRUE, # Avoid label overplotting (slow)
               show.clust.cent = FALSE, ggtheme = theme_minimal(),main = method)
}

#' @rdname plot_consensus_cluster
#' @export
#plot_exp_heatmap
#'
plot_exp_heatmap <- function(res.con, method = "ALL",
                             clustering_method_columns = "complete", clustering_method_rows = "complete",col_title_prefix = "Subclass",
                             top_annotation = NULL, right_annotation = NULL){
  if (method == "ALL") {
    Heatmap(t(res.con$d), name = "Value",
            clustering_method_columns = clustering_method_columns, clustering_method_rows = clustering_method_rows,
            column_split = res.con$consensus_cluster, column_title = paste0(col_title_prefix," %s"),
            top_annotation = top_annotation, right_annotation = right_annotation
    )
  }else {
    Heatmap(t(res.con$d), name = "Value",
            clustering_method_columns = clustering_method_columns, clustering_method_rows = clustering_method_rows,
            column_split = as.data.frame(res.con$cluster_matrix)[[method]], column_title = paste0(col_title_prefix," %s"),
            top_annotation = top_annotation, right_annotation = right_annotation
            )
  }
}