熱圖（heatmap）用不同的顏色和顏色的深淺來(lái)展示數(shù)據(jù)之間的差異，直觀、美麗、大方，深受科研工作者的喜愛(ài)，尤其是轉(zhuǎn)錄組類(lèi)的文章里，幾乎必有一幅熱圖用來(lái)展示差異表達(dá)基因。很多工具都可以完成熱圖的制作，比如我們最常使用的excel；還有一款比較好用的制作熱圖的工具是CJ大神開(kāi)發(fā)的工具TBtools，在公眾號(hào)生信札記有比較詳細(xì)的教程，感興趣的可以自行搜索相關(guān)教程；今天這篇文章主要介紹利用R語(yǔ)言的 pheatmap 包和 ggplot2 包制作熱圖的簡(jiǎn)單小例子。pheatmap是R語(yǔ)言中專(zhuān)門(mén)用來(lái)制作熱圖的工具包；ggplot2是R語(yǔ)言中最常用的可視化工具包。R語(yǔ)言中還有一個(gè)專(zhuān)門(mén)用來(lái)繪制熱圖的工具包ComplexHeatmap，功能比pheatmap強(qiáng)大，幫助文檔非常詳細(xì)，感興趣的可以自行查閱幫助文檔，在這篇文章中就不做過(guò)多介紹。

1、利用pheatmap制作熱圖

這部分內(nèi)容主要來(lái)自教程 https:///2010/01/21/how-to-make-a-heatmap-a-quick-and-easy-solution/。原文用到的數(shù)據(jù)集：NBA basketball statistics from last season?？墒腔仡^再看這篇教程的寫(xiě)作時(shí)間已經(jīng)是2010年了?！吧弦粋€(gè)賽季（last season）”那豈不是要追溯到2008-2009賽季了？那個(gè)時(shí)候科比還在，卡特未老，麥迪雖已巔峰不在，干拔跳投卻依舊銷(xiāo)魂；艾弗森雖然遠(yuǎn)赴掘金，但那份桀驁與堅(jiān)持依舊感動(dòng)著無(wú)數(shù)球迷；那時(shí)候納什還在太陽(yáng)，小斯還是勁爆的小霸王，再加上防守悍將馬里昂，即使是與擁有GDP的馬刺也能大戰(zhàn)上六場(chǎng)；那時(shí)的姚明帶領(lǐng)火箭闖進(jìn)了季后賽第二輪，并與當(dāng)年的總冠軍湖人隊(duì)大戰(zhàn)了7場(chǎng) ，同時(shí)還上演了王者歸來(lái)的震撼表演；那時(shí)的隆多還在綠軍，風(fēng)城之子才剛剛在芝加哥聯(lián)合中心球館綻放...... 那是最好的時(shí)代 -- It was the best of times.

哈哈哈……好像有點(diǎn)扯遠(yuǎn)了，今天的主題是學(xué)習(xí)R語(yǔ)言制作熱圖的，不是來(lái)懷舊的哈！

1.1 讀入數(shù)據(jù)、查看數(shù)據(jù)維度、查看變量名稱(chēng)

nba <- read.csv("http://datasets./ppg2008.csv", sep=",")

dim(nba)

colnames(nba)

數(shù)據(jù)集包括21個(gè)變量，總共50個(gè)樣本，各個(gè)變量的含義如圖二

接下來(lái)通過(guò)散點(diǎn)圖添加標(biāo)簽的方式看一下數(shù)據(jù)集里都包括哪些人

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="")

韋德、科比、諾維斯基。。。 滿眼都是青春的樣子呀！

小知識(shí)點(diǎn)

gsub()函數(shù)用來(lái)將球員名字中的空格替換為換行符，第一個(gè)位置是要被替換的字符；第二個(gè)位置是替換為的字符；第三個(gè)位置是要替換的內(nèi)容。

1.2熱圖制作

1.2.1數(shù)據(jù)格式轉(zhuǎn)換

首先對(duì)數(shù)據(jù)簡(jiǎn)單處理，包括將數(shù)據(jù)按照?qǐng)鼍梅种匦屡判?；行名改為球員的名字；去掉數(shù)據(jù)中的第一列；然后把最初讀入的數(shù)據(jù)框轉(zhuǎn)化為pheatmap()函數(shù)要求的矩陣格式

nba <- nba[order(nba$PTS),]

row.names(nba) <- nba$Name

nba <- nba[,2:20]

nba_matrix <- data.matrix(nba)

1.2.2熱圖制作

單一函數(shù)出圖

library(pheatmap)

pheatmap(nba_matrix)

接下來(lái)通過(guò)參數(shù)調(diào)整細(xì)節(jié)，包括去掉行和列的聚類(lèi)（因?yàn)檫@組數(shù)據(jù)里沒(méi)有沒(méi)有太大的意義，轉(zhuǎn)錄組數(shù)據(jù)的如圖聚類(lèi)通常保留）、對(duì)數(shù)據(jù)按照列進(jìn)行標(biāo)準(zhǔn)化、去掉圖例、改變配色等，還有其他參數(shù)調(diào)節(jié)可以通過(guò)help(package=”pheatmap”)函數(shù)查閱幫助文檔

pheatmap(nba_matrix,cluster_cols = F, cluster_rows = F, col=cm.colors(256), scale="column",

         legend = F)

這里遇到的問(wèn)題：原教程中輸出的圖片是按照?qǐng)鼍梅謴拇蟮叫∮缮贤乱来闻帕械?，自己重?fù)出來(lái)的是由小到大排列，如何更改順序暫時(shí)還不知道如何實(shí)現(xiàn)。

2、基于ggplot2繪制熱圖（數(shù)據(jù)集同上）

ggplot2繪制熱圖使用到的函數(shù)是geom_tile()函數(shù)，簡(jiǎn)單理解就是根據(jù)位置坐標(biāo)添加色塊

2.1 geom_tile()函數(shù)簡(jiǎn)單小例子

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"))

2.2 繪圖

這部分內(nèi)容主要來(lái)自教程 https://www./ggplot2-quick-heatmap-plotting/

代碼

library(plyr)

library(reshape)

library(ggplot2)

nba <- read.csv("http://datasets./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()函數(shù)來(lái)自reshape包

ddply()函數(shù)來(lái)自plyr包

這三個(gè)函數(shù)的用法自己還不是非常明白；印象里這兩個(gè)包已經(jīng)比較老了，應(yīng)該是已經(jīng)有新的包替代了

相對(duì)于原教程改動(dòng)的地方

原文rescaler()函數(shù)少了一個(gè)字母r

theme_blank()和theme_text()函數(shù)已經(jīng)不再使用，相應(yīng)的替換為 element_blank() 和element_text()

小知識(shí)點(diǎn)

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")

如果希望柱形圖貼著x軸，可以使用scale_y_continuous()或者scale_y_discrete()函數(shù)

ggplot(data=df,aes(x=B,y=A))+

  geom_bar(stat="identity")+

  scale_y_continuous(expand=c(0,0))

好啦，今天就到這了啦！祝大家生活愉快，試驗(yàn)順利！

轉(zhuǎn)自生信草堂公眾號(hào)，已授權(quán)

生信草堂

浙大生信博士團(tuán)隊(duì)傾力打造的一個(gè)科研人員學(xué)習(xí)交流的公眾微信平臺(tái)。我們致力于科研社區(qū)服務(wù)，分享前沿的科技進(jìn)展，提供生信分析方法，解讀經(jīng)典分析案例，公眾數(shù)據(jù)庫(kù)的挖掘和臨床數(shù)據(jù)統(tǒng)計(jì)分析。在此我們歡迎各位的加入！

加微信bioinformatics88拉您進(jìn)生信交流群