今天給大家介紹一個(gè)很強(qiáng)大的包，這個(gè)包我也是只是學(xué)了冰山一角，更多的功能還是需要多查一些資料。
想必大家看文章經(jīng)?？匆娺@種比較漂亮的圖片吧

QQ圖片20220429191012.jpg

哦豁，這怎么畫呀，還有斜線......嗯，高級(jí)高級(jí)，所以來吧

首先加載包

#加載包，清空
library(Seurat)
library(tidyverse)
library(ggplot2)
library(infercnv)
library(ComplexHeatmap)
library(ggpubr)
rm(list=ls())
#加載數(shù)據(jù)
scRNA_harmony <- readRDS("scRNAsub.rds")

我們看再細(xì)看這個(gè)熱圖 發(fā)現(xiàn)列是細(xì)胞 行是gene，并且細(xì)胞按照細(xì)胞類型排列，基因按照細(xì)胞的marker gene排列 所以我們最終要做到事情就是獲取表達(dá)矩陣并進(jìn)行排列處理，分成三步走

#第一步先獲得每一個(gè)celltype的marker基因
if(T){
  Idents(scRNA_harmony) <- "celltype"  #先ident
  ##提取各個(gè)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   #可根據(jù)需要調(diào)整
  TopMarkers_noRibo = ClusterMarker_noRibo %>% group_by(cluster) %>% top_n(n = top, wt = avg_log2FC)
  #獲取celltype的marker基因  TopMarkers_noRibo的gene那一列  
}

#第二步獲取表達(dá)矩陣，并用log2來擴(kuò)大差異
if(T){
  dat <- GetAssayData(scRNA_harmony,assay = "RNA",slot = "counts")
  dat <- as.data.frame(dat)
  dat <- log2(dat+1)
}    #因此得到log了的表達(dá)矩陣


#第三步，將表達(dá)矩陣進(jìn)行排序
celltype_info <- sort(scRNA_harmony$celltype)  #獲得按照細(xì)胞類型排序時(shí)細(xì)胞的名字
dat <- as.matrix(dat[TopMarkers_noRibo$gene, names(celltype_info)])  #進(jìn)行行列排列

開始畫圖

#給列加上顏色和注釋
library("BuenColors")
col <- jdb_color_maps[1:25]    #選取了25個(gè)顏色
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)

#升級(jí)版
#只用文字描述可能不夠好看，最好是帶有顏色的分塊圖，
#其中里面的顏色和t-SNE或UMAP聚類顏色一致，才能更好的展示信息。
#為了增加聚類注釋，我們需要用到HeatmapAnnotation函數(shù)，它對(duì)細(xì)胞的列進(jìn)行注釋，
#而rowAnnotation函數(shù)可以對(duì)行進(jìn)行注釋。這兩個(gè)函數(shù)能夠增加各種類型的注釋，
#包括條形圖，點(diǎn)圖，折線圖，箱線圖，密度圖等等，這些函數(shù)的特征是anno_xxx，
#例如anno_block就用來繪制區(qū)塊圖。
top_anno <- HeatmapAnnotation(
  cluster = anno_block(gp = gpar(fill = col), # 設(shè)置填充色
                       labels = levels(celltype_info), 
                       labels_gp = gpar(cex = 0.5, col = "white"))) # 設(shè)置字體

#其中anno_block中的gp參數(shù)用于設(shè)置各類圖形參數(shù)，labels設(shè)置標(biāo)簽，
#labels_gp設(shè)置和標(biāo)簽相關(guān)的圖形參數(shù)?？梢杂?gp來了解有哪些圖形參數(shù)。
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 ) # 不需要列標(biāo)題

#突出重要基因+改顏色
#由于基因很多直接展示出來，根本看不清，我們可以強(qiáng)調(diào)幾個(gè)標(biāo)記基因。
#用到兩個(gè)函數(shù)是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。
#在這之間的值以線性內(nèi)插的方式獲取到相應(yīng)的值，如果值超出了 [-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)

#調(diào)增圖例位置
#目前的熱圖還有一個(gè)問題，也就是表示表達(dá)量范圍的圖例太占位置了，有兩種解決方法

#方法一   
#參數(shù)設(shè)置show_heatmap_legend=FALSE直接刪掉
#利用heatmap_legend_param參數(shù)更改樣式
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圖例的位置
        ))


#方法二
#因?yàn)镃omplextHeatmap是基于Grid圖形系統(tǒng)，因此可以先繪制熱圖，然后再用grid::draw繪制圖例，
#從而實(shí)現(xiàn)將條形圖的位置移動(dòng)到圖中的任意位置。

#先獲取繪制熱圖的對(duì)象
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
)
#根據(jù)p@matrix_color_mapping獲取圖例的顏色的設(shè)置，然后用Legend構(gòu)建圖例
p@matrix_color_mapping
col_fun  <- circlize::colorRamp2(c(0, 1, 2 ,3, 4),
                                 c("#0000FFFF", "#C3A5F7FF", "#D8C6F3FF", "#FFB8A4FF", "#FF1D0BFF"))
#用legend構(gòu)建圖例
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"),