R语言ComplexHeatmap包批量绘制多文件带注释热图方法

核心解决逻辑为两层匹配规则：第一层通过文件名ID关联表达矩阵与对应元数据，第二层通过样本ID对齐矩阵列与元数据行，从根源避免错配。

前置规则 #

• 统一文件命名：Model_hmap目录下的表达文件、Model_hmap_meta目录下的元数据文件需共享唯一匹配ID，例如表达文件命名为[ID].txt/[ID]_expr.txt，对应元数据命名为[ID].txt/[ID]_meta.txt即可
• 单文件内的命名规则保持一致：表达矩阵的列名为样本ID，对应元数据的行名为相同的样本ID，元数据需包含FAB、Risk_Cyto两列注释信息

可直接运行的封装代码 #

library(ComplexHeatmap)
library(circlize)

# 固定注释配色，可根据实际分类值调整
ANNOT_COLORS <- list(
  FAB = c("M0"="#1f77b4", "M1"="#ff7f0e", "M2"="#2ca02c", "M3"="#d62728", "M4"="#9467bd", "M5"="#8c564b", "M6"="#e377c2"),
  Risk_Cyto = c("Good"="#2ca02c", "Intermediate"="#ff7f0e", "Poor"="#d62728")
)

batch_plot_complexheatmap <- function(
    expr_path = "Model_hmap/",
    meta_path = "Model_hmap_meta/",
    output_path = "heatmap_output/",
    target_genes = NULL, # 传入需要提取的目标基因向量，不传入则用全基因集
    row_zscore = TRUE
){
  # 创建输出目录
  if(!dir.exists(output_path)) dir.create(output_path, recursive = TRUE)
  
  # 批量读取表达矩阵，提取匹配ID
  expr_files <- list.files(expr_path, pattern = "\\.txt$", full.names = FALSE)
  match_ids <- gsub("_expr\\.txt$|\\.txt$", "", expr_files)
  expr_list <- lapply(file.path(expr_path, expr_files), function(f){
    mat <- read.table(f, header = TRUE, row.names = 1, sep = "\t", check.names = FALSE)
    # 提取目标基因子集
    if(!is.null(target_genes)){
      mat <- mat[intersect(rownames(mat), target_genes), ]
    }
    # 行Z-score标准化
    if(row_zscore){
      mat <- t(scale(t(mat)))
      mat <- na.omit(mat) # 移除所有样本表达无差异、标准化后为NA的基因
    }
    return(mat)
  })
  names(expr_list) <- match_ids

  # 批量读取元数据，按相同ID排序匹配
  meta_files <- list.files(meta_path, pattern = "\\.txt$", full.names = FALSE)
  meta_ids <- gsub("_meta\\.txt$|\\.txt$", "", meta_files)
  meta_list <- lapply(file.path(meta_path, meta_files), function(f){
    meta <- read.table(f, header = TRUE, row.names = 1, sep = "\t", check.names = FALSE, stringsAsFactors = FALSE)
    meta <- meta[, c("FAB", "Risk_Cyto")] # 仅保留需要的注释列
    return(meta)
  })
  names(meta_list) <- meta_ids

  # 校验匹配关系，过滤无对应元数据的表达文件
  valid_ids <- intersect(match_ids, meta_ids)
  if(length(valid_ids) < length(match_ids)){
    warning(paste0("无匹配元数据，已跳过文件ID：", paste(setdiff(match_ids, valid_ids), collapse = ", ")))
  }
  expr_list <- expr_list[valid_ids]
  meta_list <- meta_list[valid_ids]

  # 循环绘制每个独立热图
  for(id in valid_ids){
    current_mat <- expr_list[[id]]
    current_meta <- meta_list[[id]]

    # 对齐矩阵列与元数据行的样本顺序，避免样本错配
    common_samples <- intersect(colnames(current_mat), rownames(current_meta))
    current_mat <- current_mat[, common_samples]
    current_meta <- current_meta[common_samples, ]

    # 构建列注释
    col_annot <- HeatmapAnnotation(df = current_meta, col = ANNOT_COLORS)

    # 输出热图，此处参数可直接替换为单文件场景下调优的配置
    pdf(file.path(output_path, paste0(id, "_annotated_heatmap.pdf")), width = 10, height = 8)
    hm <- Heatmap(current_mat,
                  name = "Row Z-score",
                  top_annotation = col_annot,
                  cluster_rows = TRUE,
                  cluster_columns = TRUE,
                  show_row_names = TRUE,
                  show_column_names = FALSE,
                  col = colorRamp2(c(-2, 0, 2), c("#313695", "white", "#a50026")))
    draw(hm)
    dev.off()
    message(paste0("完成绘制：", id))
  }
}

调用方式 #

# 示例：传入目标基因集绘制
gene_set <- c("HOXA9", "MEIS1", "RUNX1", "FLT3", "NPM1")
batch_plot_complexheatmap(target_genes = gene_set)

注意事项 #

• 若文件命名规则与示例不同，仅需修改代码中gsub()部分的正则表达式，保证提取的match_ids和meta_ids可一一对应即可
• 热图的聚类方式、颜色梯度、文字显示等参数，直接替换Heatmap()函数内的对应参数即可，完全兼容单文件场景下已经调优的配置
• 代码内置了双重校验逻辑：文件层面自动过滤无匹配元数据的表达矩阵，样本层面自动对齐矩阵与元数据的样本顺序，不会出现注释错位问题

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