ComplexHeatmap：在热图上把基因标记出来

作者: 汪汪队队长_莱德 | 来源:发表于2022-04-29 19:26 被阅读0次

ComplexHeatmap：在热图上把基因标记出来
在火山图上标记基因
ComplexHeatmap热图绘制 | 指定基因在热图中标记
给火山图上标记基因名字
R 数据可视化 —— 聚类热图 ComplexHeatmap(三
2020-08-11热图绘制包tidyHeatmap
1 初识Complexheatmap
标记基因，报告基因傻傻分不清?
把想去的地方，标记在地图上
热图

今天给大家介绍一个很强大的包，这个包我也是只是学了冰山一角，更多的功能还是需要多查一些资料。
想必大家看文章经常看见这种比较漂亮的图片吧

QQ图片20220429191012.jpg

哦豁，这怎么画呀，还有斜线......嗯，高级高级，所以来吧

首先加载包

#加载包，清空
library(Seurat)
library(tidyverse)
library(ggplot2)
library(infercnv)
library(ComplexHeatmap)
library(ggpubr)
rm(list=ls())
#加载数据
scRNA_harmony <- readRDS("scRNAsub.rds")

我们看再细看这个热图发现列是细胞行是gene，并且细胞按照细胞类型排列，基因按照细胞的marker gene排列所以我们最终要做到事情就是获取表达矩阵并进行排列处理，分成三步走

#第一步先获得每一个celltype的marker基因
if(T){
  Idents(scRNA_harmony) <- "celltype"  #先ident
  ##提取各个celltype的marker genes
  ClusterMarker <- FindAllMarkers(scRNA_harmony, assay = "RNA", slot = "data", only.pos = T,
                                  logfc.threshold = 0.25, min.pct = 0.1)
  ClusterMarker <- ClusterMarker[,c(7,1:6)]
  ##提取没有核糖体的Markers
  ClusterMarker_noRibo <- ClusterMarker[!grepl("^RP[SL]", 
                                               ClusterMarker$gene, ignore.case = F),]
  #取top
  top = 15   #可根据需要调整
  TopMarkers_noRibo = ClusterMarker_noRibo %>% group_by(cluster) %>% top_n(n = top, wt = avg_log2FC)
  #获取celltype的marker基因  TopMarkers_noRibo的gene那一列  
}

#第二步获取表达矩阵，并用log2来扩大差异
if(T){
  dat <- GetAssayData(scRNA_harmony,assay = "RNA",slot = "counts")
  dat <- as.data.frame(dat)
  dat <- log2(dat+1)
}    #因此得到log了的表达矩阵


#第三步，将表达矩阵进行排序
celltype_info <- sort(scRNA_harmony$celltype)  #获得按照细胞类型排序时细胞的名字
dat <- as.matrix(dat[TopMarkers_noRibo$gene, names(celltype_info)])  #进行行列排列

开始画图

#给列加上颜色和注释
library("BuenColors")
col <- jdb_color_maps[1:25]    #选取了25个颜色
names(col) <- levels(celltype_info)

#画图
Heatmap(dat,
        cluster_rows = FALSE,
        cluster_columns = FALSE,
        show_column_names = FALSE,
        show_row_names = FALSE,
        column_split = celltype_info)

#升级版
#只用文字描述可能不够好看，最好是带有颜色的分块图，
#其中里面的颜色和t-SNE或UMAP聚类颜色一致，才能更好的展示信息。
#为了增加聚类注释，我们需要用到HeatmapAnnotation函数，它对细胞的列进行注释，
#而rowAnnotation函数可以对行进行注释。这两个函数能够增加各种类型的注释，
#包括条形图，点图，折线图，箱线图，密度图等等，这些函数的特征是anno_xxx，
#例如anno_block就用来绘制区块图。
top_anno <- HeatmapAnnotation(
  cluster = anno_block(gp = gpar(fill = col), # 设置填充色
                       labels = levels(celltype_info), 
                       labels_gp = gpar(cex = 0.5, col = "white"))) # 设置字体

#其中anno_block中的gp参数用于设置各类图形参数，labels设置标签，
#labels_gp设置和标签相关的图形参数。可以用?gp来了解有哪些图形参数。
Heatmap(dat,
        cluster_rows = FALSE,
        cluster_columns = FALSE,
        show_column_names = FALSE,
        show_row_names = FALSE,
        column_split = celltype_info,
        top_annotation = top_anno, # 在热图上边增加注释
        column_title = NULL ) # 不需要列标题

#突出重要基因+改颜色
#由于基因很多直接展示出来，根本看不清，我们可以强调几个标记基因。
#用到两个函数是rowAnnotation和anno_mark
#将不同类群的marker基因记下（想展示的基因）
#我们需要给anno_mark提供基因所在行即可。
mark_gene <- c("FCER1G","AIF1","LY2","S100A2","GSTA","MFAP5","CD3E","CCL5","DARC","CXCR4","SFN","COL1A2","CD3D","VWF","CD83","CNN1")
gene_pos <- which(rownames(dat) %in% mark_gene)
row_anno <-  rowAnnotation(mark_gene = anno_mark(at = gene_pos, 
                                                 labels = mark_gene))

#修改颜色
library(circlize)
col_fun = colorRamp2(c(0, 2, 4), c("green", "white", "red"))
#我们限定值为 0 映射为 green，2 映射为 white，4 映射为 red。
#在这之间的值以线性内插的方式获取到相应的值，如果值超出了 [-2,2] 范围

Heatmap(dat,
        col = col_fun,
        cluster_rows = FALSE,
        cluster_columns = FALSE,
        show_column_names = FALSE,
        show_row_names = FALSE,
        column_split = celltype_info,
        top_annotation = top_anno,
        right_annotation = row_anno,
        column_title = NULL)

#调增图例位置
#目前的热图还有一个问题，也就是表示表达量范围的图例太占位置了，有两种解决方法

#方法一   
#参数设置show_heatmap_legend=FALSE直接删掉
#利用heatmap_legend_param参数更改样式
Heatmap(dat,
        cluster_rows = FALSE,
        cluster_columns = FALSE,
        show_column_names = FALSE,
        show_row_names = FALSE,
        column_split = celltype_info,
        top_annotation = top_anno,
        right_annotation = row_anno,
        column_title = NULL,
        heatmap_legend_param = list(
          title = "log2(count+1)",
          title_position = "leftcenter-rot"    #这里可以change图例的位置
        ))


#方法二
#因为ComplextHeatmap是基于Grid图形系统，因此可以先绘制热图，然后再用grid::draw绘制图例，
#从而实现将条形图的位置移动到图中的任意位置。

#先获取绘制热图的对象
p <- Heatmap(dat,
             cluster_rows = FALSE,
             cluster_columns = FALSE,
             show_column_names = FALSE,
             show_row_names = FALSE,
             column_split = celltype_info,
             top_annotation = top_anno,
             right_annotation = row_anno,
             column_title = NULL,
             show_heatmap_legend = FALSE
)
#根据p@matrix_color_mapping获取图例的颜色的设置，然后用Legend构建图例
p@matrix_color_mapping
col_fun  <- circlize::colorRamp2(c(0, 1, 2 ,3, 4),
                                 c("#0000FFFF", "#C3A5F7FF", "#D8C6F3FF", "#FFB8A4FF", "#FF1D0BFF"))
#用legend构建图例
lgd <-  Legend(col_fun = col_fun, 
               title = "log2(count+1)", 
               title_gp = gpar(col="white", cex = 0.75),
               title_position = "leftcenter-rot",
               #direction = "horizontal"
               at = c(0, 1, 4), 
               labels = c("low", "median", "high"),
               labels_gp = gpar(col="white")
)


#绘制图形
grid.newpage() #新建画布
draw(p) # 绘制热图
draw(lgd, x = unit(0.05, "npc"), 
     y = unit(0.05, "npc"),