写在前面

对于pheatmap可以通过display_numbers参数来进行设置。但是pheatmap本身只能显示画热图的数据框，如果是类似加*号这个的就没办法了
对于ComplexHeatmap而言如果则不存在这种问题，因为自定义的col_fun可以输入一个新的数据框。

具体操作

加载数据前设置

options(stringsAsFactors = F)
library(ComplexHeatmap)
library(circlize)
library(tidyverse)

## ── Attaching packages ──────────────────────── tidyverse 1.2.1 ──

## ✔ ggplot2 3.2.1     ✔ purrr   0.3.2
## ✔ tibble  2.1.3     ✔ dplyr   0.8.3
## ✔ tidyr   1.0.0     ✔ stringr 1.4.0
## ✔ readr   1.3.1     ✔ forcats 0.4.0

## ── Conflicts ─────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

加载数据

这里我们使用FigureYa97correlation当中得到的相关分析的数据。

dat <- read.csv("correlation.csv")
head(dat)

##   gene    immune_cells         cor      p.value
## 1 SCOC             aDC  0.16959516 1.512476e-05
## 2 SCOC         B.cells -0.08246782 3.641187e-02
## 3 SCOC     CD8.T.cells  0.09887621 1.205683e-02
## 4 SCOC Cytotoxic.cells  0.28252253 2.772141e-13
## 5 SCOC              DC  0.07901581 4.502340e-02
## 6 SCOC     Eosinophils -0.09773162 1.309135e-02

数据转换

目前加载的数据是一个长数据，我们需要转换成宽数据来进行绘图,另外把P值转换为*。

## 转换相关系数的数据
datCor <- dat %>% select(gene:cor) %>% 
    spread(key = immune_cells, value = cor) %>% 
    column_to_rownames(var = "gene")
datCor[1:3,1:3]

##                  aDC     B.cells CD8.T.cells
## ARHGAP31 -0.02823886  0.06134676  0.03516623
## FAM198B  -0.04582778 -0.04315052 -0.07920987
## GRAP2    -0.13982829 -0.07948684  0.04822977

## 转换P值的数据
datP <- dat %>% mutate(p = cut(x = p.value, 
                               breaks = c(-Inf, 0.001, 0.01, 0.05, Inf),
                               labels = c("***", "**","*", ""))) %>% 
    select(gene, immune_cells, p) %>% spread(key = immune_cells, value = p) %>% 
    column_to_rownames(var = "gene")
datP[1:3,1:3]

##          aDC B.cells CD8.T.cells
## ARHGAP31                        
## FAM198B                        *
## GRAP2    ***       *

自定义颜色

col_fun <- colorRamp2(breaks = c(min(datCor), 0, max(datCor)), 
                      colors = c("#2b8cbe", "white", "#e41a1c"))

定义添加文本的函数

定义一个自定义函数。函数定义了如果都是数值的话，保留三位小数，如果不是的话，则全部显示。

TextFunc <- function(dat, col = "black", fontsize = 6, numdat = TRUE,
                     digit = 2){
    if(numdat == TRUE){
        function(j, i, x, y, width, height, fill){
                grid.text(round(dat, digit)[i, j], x, y, gp = gpar(fontsize = fontsize, col  = col))
            }
    }else{
    function(j, i, x, y, width, height, fill){
                grid.text(dat[i, j], x, y, gp = gpar(fontsize = fontsize, col  = col))
            }
}}

绘制添加数字的热图

## 添加数字的热图
Heatmap(datCor, name = "R2", col = col_fun,
            rect_gp = gpar(col = "white", lwd = 1), cell_fun = TextFunc(datCor))

## Warning: The input is a data frame, convert it to the matrix.

image.png

绘制添加P值的热图

基本绘制的时候和上面的热图是一样的，只不过如果要绘制文字的话，需要添加一个图例。这个需要单独的绘制

## 基本绘图
p1 <- Heatmap(datCor, name = "R2", col = col_fun,
            rect_gp = gpar(col = "white", lwd = 1), cell_fun = TextFunc(datP, numdat = F))

## Warning: The input is a data frame, convert it to the matrix.

textLeg <- Legend(labels = c("P < 0.05", "P < 0.01", "P < 0.001"), title = "Adj.P.value", type = "points", 
             pch = c("*", "**", "***"), legend_gp = gpar(col = "black"), background = "white")
draw(p1, merge_legend = TRUE, heatmap_legend_side = "right", 
     annotation_legend_side = "right", annotation_legend_list = textLeg)

image.png