ggplot2优雅的绘制高端热图

本节来介绍如何通过ggplot2绘制复杂热图

加载R包

library(ComplexHeatmap)
library(circlize)
library(tidyverse)
library(ggtree)
library(aplot)
library(ggh4x)

加载数据

expr = readRDS(system.file(package="ComplexHeatmap","extdata","gene_expression.rds"))

数据清洗

df <- expr %>% select(matches("s.+cell")) %>% 
  scale() %>% as.data.frame()

绘制热图

heatmap <- df %>% rownames_to_column("gene") %>% 
  pivot_longer(-gene) %>% 
  ggplot(aes(name,gene,fill=value))+
  geom_tile()+
  scale_fill_gradient2(mid="white",low="blue",high="red")+
  guides(fill=guide_colorbar(direction = "vertical",
                              reverse = F,barwidth = unit(.6, "cm"),
                              barheight = unit(3,"cm")))+
  scale_y_dendrogram(labels = NULL,expand=c(0,0))+
  scale_x_discrete(expand=c(0,0))+
  theme_test()+
  theme(axis.text.x=element_blank(),
        axis.ticks=element_blank(),
        axis.title=element_blank(),
        legend.position="non")

image

ggtree绘制聚类树

phr <- hclust(dist(df)) %>% 
  ggtree(layout="rectangular",branch.length="none")+
  theme_void()

phc <- hclust(dist(t(df))) %>% ggtree() + 
  layout_dendrogram()+
  theme_void()

绘制样本分类色条

cell_type <- df %>% colnames() %>% as.data.frame() %>%
  dplyr::rename(sample=".") %>% 
  mutate(type=sample,
         across("type",str_replace,"s.*_",""),
         group="type") %>% 
  ggplot(aes(sample,group,fill=type))+
  geom_tile()+
  scale_fill_manual(values = c("#3B9AB2","#78B7C5","#00A08A"))+
  guides(fill=guide_legend(title="cell_type"))+
  theme(axis.title = element_blank(),
        axis.text=element_blank(),
        axis.ticks = element_blank(),
        panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),
        panel.background = element_blank(),
        legend.key=element_blank(),  
        legend.title=element_text(color="black",size=9),
        legend.text = element_text(color="black",size=8), 
        legend.spacing.x=unit(0.1,'cm'), 
        legend.key.width=unit(0.4,'cm'), 
        legend.key.height=unit(0.4,'cm'), 
        legend.background=element_blank())

基因长度信息可视化

length <- expr %>% select(length) %>% 
  mutate(length=length/1000) %>% 
  rownames_to_column("gene") %>%
  mutate(type = case_when(
    length < 200 ~ "<200kb",
    length > 200 & length < 400 ~ ">200kb",
    length > 400 & length < 600 ~ ">400kb",
    length > 600 ~ ">600kb")) %>% 
  ggplot(aes(length,gene,color=type))+
  geom_point(size=1)+
  scale_color_manual(values=c("#E64B35FF","#4DBBD5FF","#00A087FF","#3C5488FF"))+
  theme_test()+
  theme(axis.title = element_blank(),
        axis.ticks.y=element_blank(),
        axis.text.y=element_blank(),
        axis.text.x=element_text(angle=90,color="black",vjust=0.5,hjust=1),
        legend.position="non")

基因平均表达量可视化

# highlight <- c("gene1","gene30","gene60")

base_mean <- expr %>% select(matches("s.+cell")) %>% 
  mutate(mean = rowMeans(across(where(is.numeric)))) %>%
  rownames_to_column("gene") %>%
  select(gene,mean) %>% mutate(type="base mean") %>% 
  ggplot(aes(type,gene,fill=mean))+
  geom_tile()+
#  geom_raster() +
#  guides(y.sec = guide_axis_manual(breaks = highlight,
#                                     labels = highlight,color="black"))+
  scale_fill_gradient2(mid="white",low="green",high="blue")+
  scale_y_discrete(expand=c(0,0))+
  scale_x_discrete(expand=c(0,0))+
  theme_test()+
  theme(axis.title = element_blank(),
        axis.ticks.y=element_blank(),
        axis.text.y=element_blank(),
        legend.position="non",
        axis.text.x=element_text(angle=90,color="black",vjust=0.5,hjust=1))

展示关注的重点基因

gene <- expr %>% select(matches("s.+cell")) %>% 
  mutate(mean = rowMeans(across(where(is.numeric)))) %>%
  rownames_to_column("gene") %>%
  select(gene,mean) %>%
  mutate(group="base_mean",
  type=case_when(gene=="gene10"~"gene10",gene=="gene30"~"gene30",
                 gene=="gene25"~"gene25",gene=="gene50"~"gene50")) %>%
  ggplot(.,aes(group,gene))+
  geom_text(aes(x=group,y=gene,label=type),size=3,colour="black")+
  scale_x_discrete(expand=c(0,0)) +
  scale_y_discrete(expand=c(0,0))+
  theme(axis.title = element_blank(),
        axis.text=element_blank(),
        axis.ticks = element_blank(),
        panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),
        panel.background = element_blank())

绘制基因分类色条

gene_type <- expr %>% select(type) %>%
  rownames_to_column("gene") %>% 
  mutate(group="gene type") %>% 
  ggplot(aes(group,gene,fill=type))+
  geom_tile()+
  scale_x_discrete(expand=c(0,0)) +
  scale_y_discrete(expand=c(0,0))+
  scale_fill_manual(values=c("#E64B35FF","#4DBBD5FF","#00A087FF","#3C5488FF"))+
  guides(fill=guide_legend(title="gene_type"))+
  theme(axis.title = element_blank(),
        axis.text=element_blank(),
        axis.ticks = element_blank(),
        panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),
        panel.background = element_blank(),
        legend.key=element_blank(),  
        legend.title=element_text(color="black",size=9),
        legend.text = element_text(color="black",size=8), 
        legend.spacing.x=unit(0.1,'cm'), 
        legend.key.width=unit(0.4,'cm'), 
        legend.key.height=unit(0.4,'cm'), 
        legend.background=element_blank())

aplot拼图

heatmap %>%
  insert_top(cell_type,height=0.05) %>% 
  insert_top(phc,height=0.1) %>% 
  insert_left(gene_type,width = 0.06) %>%
  insert_left(phr,width = 0.2) %>% 
  insert_right(length,width = 0.3) %>% 
  insert_right(base_mean,width = 0.2) %>%
  insert_right(gene,width = 0.15)

绘制热图图例

此处没有结合具体数据，只是做了示例

col_fun1 = colorRamp2(c(-1,0,0.5,1),
                      c("#3B9AB2","#78B7C5","#EBCC2A","#E1AF00"))
col_fun2 = colorRamp2(c(-1,0,1),
                      c("#3B9AB2","#78B7C5","#EBCC2A","#E1AF00"))

lgd1 = Legend(col_fun = col_fun1,title="expression",at =c(-2,-1,0,1,2))
draw(lgd1,x = unit(0.94,"npc"), y = unit(0.9,"npc"),just = c("right","top"))

lgd2 = Legend(col_fun = col_fun2,title="group2",at =c(-2,0,6,8,10))
draw(lgd2,x = unit(0.94,"npc"), y = unit(0.4,"npc"),just = c("right","top"))

喜欢的小伙伴欢迎关注我的公众号

R语言数据分析指南，持续分享数据可视化的经典案例及一些生信知识，希望对大家有所帮助