如何在ComplexHeatmap中添加气泡图作为行注释？

问题 #

自学使用Phenograph进行聚类分析，并用R语言ComplexHeatmap包绘制细胞表型热图，同时添加种群百分比作为行注释。目前已成功用条形图作为行注释展示频率，但导师要求替换为气泡图。已用mtcars数据集复现现有结果，也编写了气泡图代码，但无法像条形图那样将气泡图整合到ComplexHeatmap的rowAnnotation中，求解决方向。

现有实现代码（条形图注释） #

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

# 加载数据
data(mtcars)
CSV <- mtcars[3:7]

# 归一化函数
minMax <- function(x) {
  (x - min(x)) / (max(x) - min(x))
}
normalisedMydata <- as.data.frame(lapply(CSV, minMax))

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

# 转换为矩阵并命名行
normalisedMydata <- as.matrix(normalisedMydata)
rownames(normalisedMydata) = paste0("Cluster ", 1:nrow(normalisedMydata))

# 准备注释数据
annotation_file <- mtcars[8:11]
annotation_file <- as.vector(annotation_file)

# 创建条形图行注释
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 = "Populations")

# 绘制热图
Heatmap(normalisedMydata, cluster_columns = TRUE, right_annotation = ha, 
        show_heatmap_legend = TRUE, border = TRUE,
        heatmap_legend_param = list(title = "Scaled Expression") 
)

# 添加注释图例
draw(lgd2, x = unit(.9, "npc"), y = unit(0.28, "npc"))

单独气泡图代码 #

library(ggballoonplot)

# 加载数据
data(mtcars)
annotation_file <- mtcars[8:11]

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

解决方法：用anno_custom实现气泡图行注释 #

ComplexHeatmap没有内置的气泡图注释函数，但可以通过anno_custom()自定义绘图逻辑，直接在注释区域绘制气泡。核心思路是利用grid绘图系统，在每个行对应的注释区域，按类别绘制不同大小的气泡。

完整实现代码 #

library(ComplexHeatmap)
library(circlize)
library(grid)
library(reshape2)

# 加载并处理数据
data(mtcars)
CSV <- mtcars[3:7]

# 归一化处理
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
normalisedMydata <- as.matrix(normalisedMydata)
rownames(normalisedMydata) = paste0("Cluster ", 1:nrow(normalisedMydata))

# 整理注释数据：转换为长格式，方便按集群和种群遍历绘图
anno_df <- mtcars[8:11]
anno_df$Cluster <- rownames(anno_df)
anno_long <- melt(anno_df, id.vars = "Cluster", variable.name = "Population", value.name = "Percentage")

# 定义气泡图注释的绘图函数
bubble_anno_fun <- function(index) {
  # 获取当前行对应的注释数据
  current_data <- anno_long[anno_long$Cluster == rownames(normalisedMydata)[index], ]
  
  # 设置绘图区域的坐标范围
  pushViewport(viewport(xscale = c(0.5, ncol(anno_df)+0.5), yscale = c(0, 1)))
  
  # 遍历每个种群，绘制气泡
  for(i in 1:nrow(current_data)) {
    val <- current_data$Percentage[i]
    # 气泡大小与数值成正比，可自行调整缩放系数（这里除以10适配注释区域）
    bubble_size <- val / 10
    # 绘制气泡
    grid.circle(x = i, y = 0.5, r = bubble_size, gp = gpar(fill = "lightblue", col = "black"))
    # 绘制种群名称（可选，按需调整位置和字号）
    grid.text(current_data$Population[i], x = i, y = 0.1, gp = gpar(fontsize = 8))
  }
  
  popViewport()
}

# 创建自定义行注释
ha <- rowAnnotation(
  "Population Percentage" = anno_custom(
    fun = bubble_anno_fun,
    width = unit(3, "cm"),  # 调整注释区域宽度，适配气泡和文字
    height = unit(1, "npc")
  )
)

# 准备气泡大小的图例
lgd_bubble <- Legend(
  title = "Percentage",
  type = "points",
  pch = 19,
  size = c(0.5, 1.5, 2.5),  # 对应不同百分比的气泡大小
  labels = c("5", "15", "25"),
  gp = gpar(fill = "lightblue")
)

# 绘制热图
ht <- Heatmap(
  normalisedMydata,
  cluster_columns = TRUE,
  right_annotation = ha,
  show_heatmap_legend = TRUE,
  border = TRUE,
  heatmap_legend_param = list(title = "Scaled Expression")
)

# 组合热图和图例
draw(ht, annotation_legend_list = list(lgd_bubble))

关键说明 #

1. 数据整理：将宽格式的注释数据转换为长格式，方便按集群和种群遍历绘图
2. 自定义绘图函数：利用grid.circle()绘制气泡，通过数值控制气泡半径，可根据需求调整缩放系数和颜色
3. anno_custom：将自定义绘图函数传入anno_custom()，指定注释区域的宽度和高度
4. 图例制作：用Legend()手动创建气泡大小对应的图例，通过annotation_legend_list参数添加到热图中

内容的提问来源于stack exchange，提问作者Cooper James