热图5：ggplot2画热图及个性化修饰

这节我们讲下ggplot做的热图。实际上，之前heatmap已经足够了，但是ggplot2画图可以进行一些特殊的个性化修饰，一些比较特殊的热图也是通过ggplot做的。

• ggplot2与pheatmap热图对比

读取文件和一些需要的包：

setwd("D:/生物信息学")
A <- read.csv("行列注释.csv",header = T,row.names = 1)#数据行为基因，列为样本
library (ggplot2)
library (reshape2)#数据转换
require(scales)#数据缩放
library(ggtree)#聚类
library(aplot)#拼图

转换数据，转化为ggplot画图需要的长格式，这里转置的目的是为了通过行缩放，与pheatmap一致，也可以不转置，以列缩放。

B <- A
B <- t(B)
B %>% scale() %>% as.data.frame()#缩放数据
C <- B %>% scale(center = T) %>% as.data.frame()#以行缩放
C <- C%>% mutate(B=row.names(.)) %>% melt()#转化为ggplot画图需要的长列表

ggplot画的图是这样的：

p1<-ggplot(C,aes(x=B,y=variable,fill=value)) #热图绘制
p2 <- p1+geom_raster()+scale_fill_gradient2(low="#003366", high="#990033", mid="white")

pheatmap画的是这样的：

pheatmap::pheatmap(A,cluster_rows = F,cluster_cols = F,scale = "row",
                   color = colorRampPalette(c("navy","white","firebrick3"))(100),
                   border_color = "NA")

两者之间还是很一致的。

• ggplot2热图个性化修饰

和之前一样，添加样本分组，不过ggplot2稍微复杂一点。先要画分组的条形图然后再与热图主体组合。

 

group <- colnames(A) %>% as.data.frame() %>% 
  mutate(group=c(rep("ST",3),rep("TZ",3),rep("TL",5),rep("TS",4),rep("TQ",3))) %>%
  mutate(p="group") %>%
  ggplot(aes(.,y=p,fill=group))+
  geom_tile() + 
  scale_y_discrete(position="right") +
  theme_minimal()+xlab(NULL) + ylab(NULL) +
  theme(axis.text.x = element_blank())+
  labs(fill = "Group")

Pathway <- rownames(A) %>% as.data.frame() %>%
  mutate(group=rep(c("Wnt","TNF","HIF"),
                   times=c(16,17,13))) %>%
  mutate(p="")%>%
  ggplot(aes(p,.,fill=group))+
  geom_tile() + 
  scale_y_discrete(position="right") +
  theme_minimal()+xlab(NULL) + ylab(NULL) +
  theme(axis.text.y = element_blank(),
        axis.text.x =element_text(
          angle =90,hjust =0.5,vjust = 0.5))+
  labs(fill = "Pathway")

#然后用ggtree做聚类。

p <- A %>% scale(center = T) %>% as.data.frame()
phr <- hclust(dist(p)) %>% 
  ggtree(layout="rectangular",branch.length="none")
phc <- hclust(dist(t(p))) %>% 
  ggtree() + layout_dendrogram()

#画热图并将以上信息添加进去：

p1<-ggplot(C,aes(x=B,y=variable,fill=value)) #热图绘制
p2 <- p1+geom_raster()+scale_fill_gradient2(low="#003366", high="#990033", mid="white")+
  geom_tile()+theme_minimal()+
  theme(axis.text.x =element_text(angle =90,hjust =0.5,vjust = 0.5))+
  xlab(NULL) + ylab(NULL)
 p2 %>%
  insert_top(group, height = .05)%>%
  insert_left(Pathway, width = .05)%>%
  insert_left(phr,width=.2)

最后，我们还可以对特定的区域进行划线，框选等等操作。

p2 <- p1+geom_raster()+scale_fill_gradient2(low="#003366", high="#990033", mid="white")+
  geom_tile()+theme_minimal()+
  theme(axis.text.x =element_text(angle =90,hjust =0.5,vjust = 0.5))+
  xlab(NULL) + ylab(NULL)+
  theme(panel.border = element_rect(fill=NA,color="black", size=1, linetype="solid"))+
  geom_vline(xintercept=c(-3,3.5,8.5,11.5,15.5),size=.8)

 

还可以将热图的方块转化为⭕，来一个不一样的热图，给人新意：

 

p1<-ggplot(C,aes(x=B,y=variable)) #热图绘制
p2 <- p1+scale_color_gradientn(values = seq(0,1,0.2),colours = c('#6699CC','#FFFF99','#CC3333'))+
  theme_bw()+
  geom_point(aes(size=`value`,
                 color=`value`))+
  theme(panel.grid = element_blank(),axis.text.x =element_text(angle =90,hjust =0.5,vjust = 0.5))+
  xlab(NULL) + ylab(NULL)+
  theme(panel.border = element_rect(fill=NA,color="black", size=1, linetype="solid"))+
  geom_vline(xintercept=c(-3,3.5,8.5,11.5,15.5),size=.8)

其实，还有很多的修饰，在文献中，看到不一样的图可以用自己的数据尝试做一下。或者自己探究下不同的功能，会有意想不到的效果。