inst/extras/display_heatmap.R

In GeneSelectR: 'GeneSelectR' - Comprehensive Feature Selection Workflow for Bulk RNAseq Datasets

#' Display a heatmap for GO terms or GO clusters
#' old ViSEAGO asset
#' @param heatmap_object An object of class "GOTermsHeatmap" or "GOClustersHeatmap" generated by the visualize_results function.
#' @param heatmap_type A character string specifying the type of heatmap to display. Must be either "GOterms" or "GOclusters".
#' @param save_plot A logical value indicating whether to save the heatmap as a PNG image. If set to FALSE (default), the interactive heatmap is displayed.
#' @param output_file A character string specifying the file path for the output PNG image when save_plot is set to TRUE. If save_plot is FALSE, this parameter is ignored.
#' @return If save_plot is FALSE, displays the interactive heatmap. If save_plot is TRUE, saves the heatmap as a static PNG image at the specified output_file path.
#' @importFrom plotly plotly_IMAGE
#' @importFrom graphics layout
#' @examples
#' \dontrun{
#' results <- # Load results from a previous step
#' visualized_results <- visualize_results(results)
#' display_heatmap(visualized_results$GO_terms_heatmap, "GOterms")
#' display_heatmap(visualized_results$GO_clusters_heatmap, "GOclusters", save_plot = TRUE, output_file = "GOclusters_heatmap.png")
#' }
#' @keywords hidden internal
display_heatmap <- function(heatmap_object, heatmap_type, save_plot=FALSE, output_file=NULL) {
  # Check that the heatmap type is valid
  if (!heatmap_type %in% c("GOterms", "GOclusters")) {
    stop("Invalid heatmap_type. Must be 'GO_terms_heatmap' or 'GO_clusters_heatmap'.")
  }

  # if (!inherits(heatmap_object, "GO_clusters")) {
  #   stop("heatmap_object must be of class 'GO_clusters'")
  # }

  # Extract the heatmap data based on the heatmap_type
  # Initialize variable
  heatmap_data <- NULL

  # Check the value of heatmap_type
  if (heatmap_type == "GOterms") {

    # If heatmap_type is "GOterms", assign the corresponding data to heatmap_data
    heatmap_data <- heatmap_object$GO_terms_heatmap@heatmap$GOterms

  } else if (heatmap_type == "GOclusters") {

    # If heatmap_type is "GOclusters", assign the corresponding data to heatmap_data
    heatmap_data <- heatmap_object$GO_clusters_heatmap@heatmap$GOclusters

  } else {

    # If heatmap_type is anything else, return an error
    stop(sprintf("Invalid heatmap_type. Must be 'GOterms' or 'GOclusters', not '%s'.", heatmap_type))

  }

  if (!save_plot) {
    # Display the interactive heatmap
    heatmap_data
  } else {
    if (is.null(output_file)) {
      stop("output_file must be specified when save_plot is set to TRUE.")
    }

    if (heatmap_type == "GOterms") {
      # Number of rows
      rowlen <- nrow(heatmap_object@enrich_GOs@data)

      # Adjust minimum size
      if (rowlen < 10) { rowlen <- 10 }

      # Compute height
      rowlen <- rowlen^(1.70 + 1.70 * exp(-rowlen / 20))

      # Max height limit
      if (rowlen > 10000) { rowlen <- 10000 }

      # Adjust heatmap size
      heatmap_data <- graphics::layout(heatmap_data, height = rowlen)
    }

    # Save the heatmap as a static PNG image
    plotly::plotly_IMAGE(heatmap_data, format = "png", out_file = output_file, width = NULL, height = NULL, scale = 1)
  }
}