R语言-制作热图
热图(heatmap)用不同的颜色和颜色的深浅来展示数据之间的差异,直观、美丽、大方,深受科研工作者的喜爱,尤其是转录组类的文章里,几乎必有一幅热图用来展示差异表达基因。很多工具都可以完成热图的制作,比如我们最常使用的excel;还有一款比较好用的制作热图的工具是CJ大神开发的工具TBtools,在公众号生信札记有比较详细的教程,感兴趣的可以自行搜索相关教程;今天这篇文章主要介绍利用R语言的 pheatmap 包和ggplot2 包制作热图的简单小例子。pheatmap是R语言中专门用来制作热图的工具包;ggplot2是R语言中最常用的可视化工具包。R语言中还有一个专门用来绘制热图的工具包ComplexHeatmap,功能比pheatmap强大,帮助文档非常详细,感兴趣的可以自行查阅帮助文档,在这篇文章中就不做过多介绍。
利用pheatmap制作热图
这部分内容主要来自教程 https://flowingdata.com/2010/01/21/how-to-make-a-heatmap-a-quick-and-easy-solution/。原文用到的数据集:NBA basketball statistics from last season。可是回头再看这篇教程的写作时间已经是2010年了。“上一个赛季(lastseason)”那岂不是要追溯到2008-2009赛季了?那个时候科比还在,卡特未老,麦迪虽已巅峰不在,干拔跳投却依旧销魂;艾弗森虽然远赴掘金,但那份桀骜与坚持依旧感动着无数球迷;那时候纳什还在太阳,小斯还是劲爆的小霸王,再加上防守悍将马里昂,即使是与拥有GDP的马刺也能大战上六场;那时的姚明带领火箭闯进了季后赛第二轮,并与当年的总冠军湖人队大战了7场 ,同时还上演了王者归来的震撼表演;那时的隆多还在绿军,风城之子才刚刚在芝加哥联合中心球馆绽放…… 那是最好的时代 — It was the best of times.
哈哈哈……好像有点扯远了,今天的主题是学习R语言制作热图的,不是来怀旧的哈!

读入数据、查看数据维度、查看变量名称
nba<- read.csv("http://datasets.flowingdata.com/ppg2008.csv",sep=",")
dim(nba)
colnames(nba)
数据集包括21个变量,总共50个样本,各个变量的含义如图二

接下来通过散点图添加标签的方式看一下数据集里都包括哪些人
Name<-gsub("","\n",nba$Name)
df<-data.frame(A=sort(rep(1:10,5)),B=rep(1:10,5),Name=Name)
head(df)
library(ggplot2)
ggplot(data=df,aes(x=A,y=B))+geom_point()+
geom_text(aes(label=Name),vjust=1.1)+
xlim(0,11)+ylim(0,10)+theme_bw()+
labs(x="",y="")

韦德、科比、诺维斯基。。。满眼都是青春的样子呀!
小知识点
gsub()函数用来将球员名字中的空格替换为换行符,第一个位置是要被替换的字符;第二个位置是替换为的字符;第三个位置是要替换的内容。
热图制作
数据格式转换
首先对数据简单处理,包括将数据按照场均得分重新排序;行名改为球员的名字;去掉数据中的第一列;然后把最初读入的数据框转化为pheatmap()函数要求的矩阵格式
nba<- nba[order(nba$PTS),]
row.names(nba)<- nba$Name
nba<- nba[,2:20]
nba_matrix<- data.matrix(nba)
热图制作
单一函数出图
library(pheatmap)
pheatmap(nba_matrix)

接下来通过参数调整细节,包括去掉行和列的聚类(因为这组数据里没有没有太大的意义,转录组数据的如图聚类通常保留)、对数据按照列进行标准化、去掉图例、改变配色等,还有其他参数调节可以通过help(package=”pheatmap”)函数查阅帮助文档
pheatmap(nba_matrix,cluster_cols= F, cluster_rows = F, col=cm.colors(256), scale="column", legend = F)

这里遇到的问题:原教程中输出的图片是按照场均得分从大到小由上往下依次排列的,自己重复出来的是由小到大排列,如何更改顺序暂时还不知道如何实现。
基于ggplot2绘制热图(数据集同上)
ggplot2绘制热图使用到的函数是geom_tile()函数,简单理解就是根据位置坐标添加色块
geom_tile()函数简单小例子
library(ggplot2)
library(ggpubr)
p1<-ggplot(data=df,aes(x=A,y=B))+
geom_point()+ggtitle("geom_point()")
p2<-ggplot(data=df,aes(x=A,y=B))+
geom_tile()+ggtitle("geom_tile()")
ggarrange(p1,p2,ncol=2,labels=c("A","B"))

绘图
这部分内容主要来自教程 https://www.r-bloggers.com/ggplot2-quick-heatmap-plotting/
代码
library(plyr)
library(reshape)
library(ggplot2)
nba<- read.csv("http://datasets.flowingdata.com/ppg2008.csv",sep=",")
nba$Name<- with(nba, reorder(Name, PTS))
nba.m<- melt(nba)
nba.m<- ddply(nba.m, .(variable), transform,rescale = rescaler(value))
p<-ggplot(nba.m,aes(variable, Name)) +
geom_tile(aes(fill = rescale), colour ="white") +
scale_fill_gradient(low = "white",high = "steelblue")+
theme_grey(base_size = 9) +
labs(x = "", y = "") +
scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
theme(legend.position ="none",axis.ticks = element_blank(),
axis.text.x = element_text(size =base_size *0.8, angle = 330, hjust = 0,
colour ="grey50"))

melt()、rescaler()函数来自reshape包
ddply()函数来自plyr包
这三个函数的用法自己还不是非常明白;印象里这两个包已经比较老了,应该是已经有新的包替代了
相对于原教程改动的地方
原文rescaler()函数少了一个字母r
theme_blank()和theme_text()函数已经不再使用,相应的替换为element_blank() 和element_text()
小知识点
ggplot作图底部通常不贴着x轴,比如柱形图
df<-data.frame(A=sample(1:10,5),
B=LETTERS[1:5])
ggplot(data=df,aes(x=B,y=A))+geom_bar(stat="identity")

请关注“恒诺新知”微信公众号,感谢“R语言“,”数据那些事儿“,”老俊俊的生信笔记“,”冷🈚️思“,“珞珈R”,“生信星球”的支持!