rggplot2cluster-analysiscomplexheatmap

Adding a Bubble Plot as a Complex Heatmap Annotation


I am in the process of teaching myself cluster analysis using Phenograph and generating a heatmap to show cell phenotypes along with the population percentages as an annotation using complex heatmap in R. I currently have figured out how to add a row annotation to show frequencies as a row_annotation, but I would really like to use a bubble plot (this is what my PI wants anyway). I have recreated the output using mtcars after someone suggested I use minimal data in a previous post and decided to repost since quite a bit of time has passed.

Here is the plot I am able to generate: The plot I am able to generate

Here is the code (reworked and somewhat inefficient I know):

library(ComplexHeatmap)
library(caret)
library(circlize)

#Load Data
data(mtcars)
CSV <- mtcars[3:7]

#Normalize your columns if you want column scaled expression of markers

#normalisedMydata <- scale(CSV)
#normalisedMydata[is.nan(normalisedMydata)] <- 0

minMax <- function(x) {
  (x - min(x)) / (max(x) - min(x))
}
normalisedMydata <- as.data.frame(lapply(CSV, minMax))

is.nan.data.frame <- function(x)
  do.call(cbind, lapply(x, is.nan))
normalisedMydata[is.nan.data.frame(normalisedMydata)] <- 0

head(normalisedMydata)
# convert data to a matrix (the program likes this more)
normalisedMydata <- as.matrix(normalisedMydata)

# label your rows, all that needs to be edited here is 1:X where X is the total number of clusters you have
rownames(normalisedMydata) = paste0("Cluster ", 1:2)

#load annotation file which would just be expression of your two populations
annotation_file <- (mtcars[8:11])
annotation_file <- as.vector(annotation_file)

#Make your annotation and legend, Color can be customized using fill = X but mus be changed for both lgd2 and ha
ha <- rowAnnotation("Label" = anno_barplot(annotation_file, gp = gpar(fill = 1:4), beside = TRUE, attach = TRUE, width = unit(2.0, "cm")))
lgd2 = Legend(labels = c("vs", "am", "gear", "carb"), legend_gp = gpar(fill = 1:4), title = "label")

# lots of modifications can be made here, I am documenting each below but the basic command is Heatmap(normalisedMydata)
## cluster_columns = F eliminates the clustering of the markers that are expressed together
Heatmap(normalisedMydata, cluster_columns = T, right_annotation = ha, show_heatmap_legend = T, border = TRUE, col_fun, 
        heatmap_legend_param = list(title = "Scaled Expression") 
)


# Add the legend for your annotation, these values may need to be adjusted
draw(lgd2, x = unit(.9, "npc"), y = unit(0.28, "npc"))

and finally the plot I would like to generate, effectively I would replace the barplot with a bubble plot at the using rowAnnotation, but this doesn't seem possible with Complex Heatmap's built in features.

The plot I want to generate

Anything even pointing me in the right direction would be greatly appreciated

I wrote code for generating the balloon plot but can't link it to the heatmap in the same way that I can link a barplot


library(ggballoonplot)

# load data
data(mtcars)

annotation_file <- mtcars[8:11]

ggballoonplot(annotation_file,
              fill = "lightblue",
              x = "Cluster",
              size.range = c(1,5)
              )

Solution

  • To use ggplot2 in the heamtap annotation, you can use ggalign, which is a ggplot2 extension. It can be used to draw complex heamtap.

    library(ggalign)
    #> Loading required package: ggplot2
    
    ggheatmap(mtcars[3:7]) +
        scale_fill_viridis_c() +
        # add left annotations
        hmanno("l", size = 0.5) +
        # in the left annoation, we add a dendrogram
        # we split by the dendrogram and color the branches
        align_dendro(aes(color = branch), k = 3L) +
        scale_color_brewer(palette = "Dark2") +
        # add right annotations
        hmanno("r", size = 0.5) +
        # add a ggplot object
        ggalign(aes(.column_names, .y), data = as.matrix(mtcars[8:11])) +
        geom_point(aes(size = value, fill = .column_names),
            shape = 21
        ) +
        xlab(NULL) +
        scale_fill_brewer(palette = "Dark2", guide = "none")
    #> → heatmap built by `geom_tile()`
    

    Created on 2024-10-14 with reprex v2.1.0 ~
    ~
    enter image description here