R语言绘制热图(二)：heatmap.2函数画热图
2018-09-20 本文已影响1536人
Biofantasy
heatmap.2（）函数属于R语言gplots程序包。我们根据说明书所给测试例子运行代码，一步一步认识heatmap.2，了解各参数的设置和热图显示效果。其中第一部分较为实用，因为下文命令几乎每一行都可以生成一个热图，为了文章的整体性，有些图没有附。建议学习者自己复制运行，实践不同命令的产生的图形变化。
## 生成测试数据
rm(list = ls())
data(mtcars)
x <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)
## 软件安装
install.packages("gplots")
library("gplots")
第一部分
#1对颜色进行优化
col=bluered
heatmap.2(x,col=redgreen)
heatmap.2(x,col=cm.colors(255))
#2对所有数据进行标准化（scale=（”none“，"row","column"））,主要是为了防止单个数据过大（过小），导致冷热色分布不明显的现象。
heatmap.2(x,
col=redgreen,
scale = "column")
#3热图左上角的图称为Key
heatmap.2(x,
col=redgreen,
scale="row",
key=T,keysize=2)
#4 需要基准线时输入"both","row" 或者"column"
heatmap.2(x,
col=redgreen,
scale="row",
key=T,keysize=2,
trace = "both")
#5 定义xlab和ylab的字符大小
heatmap.2(x,
col=redgreen,
scale="row",
key=T,keysize=2,
trace = "row",
cexCol=0.5,cexRow=0.5,)
第二部分
## 1 默认无名称，可以增加和修改
heatmao.2(x,xlab="Relative Concentration", ylab="Probeset",main = "main")
## 2 演示行和列树图选项的效果
heatmap.2(x) ## 默认显示树图
heatmap.2(x, dendrogram="none") ## 没有绘制树图，只是重新排序
heatmap.2(x, dendrogram="row") ## 在行方向显示树突和排序
heatmap.2(x, dendrogram="col") ## 在列方向显示树突和排序
## 3 通过分支而不是累加的方法重新排列树图
heatmap.2(x, reorderfun=function(d, w) reorder(d, w, agglo.FUN = mean) )
## 4 使用与完整热图相同的颜色编码绘制子集群
full <- heatmap.2(x)
heatmap.2(x, Colv=full$colDendrogram[[2]], breaks=full$breaks) # column subset
heatmap.2(x, Rowv=full$rowDendrogram[[1]], breaks=full$breaks) # row subset
heatmap.2(x, Colv=full$colDendrogram[[2]],
Rowv=full$rowDendrogram[[1]], breaks=full$breaks) # both
## 5 显示行和列标签旋转的效果
# srtCol设置列旋转角度，adjCol设置列字体与坐标轴的距离
heatmap.2(x, srtCol=NULL)
heatmap.2(x, srtCol=0, adjCol = c(0.5,1) )
heatmap.2(x, srtCol=45, adjCol = c(1,1) ) #45度常用
heatmap.2(x, srtCol=45, adjCol = c(1.5,1) )
heatmap.2(x, srtCol=45, adjCol = c(1,0) )
heatmap.2(x, srtCol=45, adjCol = c(0.5,0) )
heatmap.2(x, srtCol=45, adjCol = c(0,0) )
heatmap.2(x, srtCol=270, adjCol = c(0,0.5) )
# 同理设置行的相关参数
heatmap.2(x, srtRow=45, adjRow=c(0, 1) )
heatmap.2(x, srtRow=45, adjRow=c(0, 1), srtCol=45, adjCol=c(1,1) )
heatmap.2(x, srtRow=45, adjRow=c(0, 1), srtCol=270, adjCol=c(0,0.5) )
第二部分
第三部分
## 1 演示如何使用“extrafun”将“key”替换为散点图
# 测试数据
lmat <- rbind( c(5,3,4), c(2,1,4) )
lhei <- c(1.5, 4)
lwid <- c(1.5, 4, 0.75)
myplot <- function() {
oldpar <- par("mar")
par(mar=c(5.1, 4.1, 0.5, 0.5))
plot(mpg ~ hp, data=x)
}
heatmap.2(x,
lmat=lmat,
lhei=lhei,
lwid=lwid,
key=FALSE, # 不显示key图
extrafun=myplot) # 显示散点图
## 2 演示如何自定义颜色
# (1)
heatmap.2(x,
key.title=NA, # no title
key.xlab=NA, # no xlab
key.par=list(mgp=c(1.5, 0.5, 0),
mar=c(2.5, 2.5, 1, 0)),
key.xtickfun=function() {
breaks <- parent.frame()$breaks
return(list(
at=parent.frame()$scale01(c(breaks[1],
breaks[length(breaks)])),
labels=c(as.character(breaks[1]),
as.character(breaks[length(breaks)]))
))
})
(1)
# (2)
heatmap.2(x,
breaks=256,
key.title=NA,
key.xlab=NA,
key.par=list(mgp=c(1.5, 0.5, 0),
mar=c(1, 2.5, 1, 0)),
key.xtickfun=function() {
cex <- par("cex")*par("cex.axis")
side <- 1
line <- 0
col <- par("col.axis")
font <- par("font.axis")
mtext("low", side=side, at=0, adj=0,
line=line, cex=cex, col=col, font=font)
mtext("high", side=side, at=1, adj=1,
line=line, cex=cex, col=col, font=font)
return(list(labels=FALSE, tick=FALSE))
})
(2)
第四部分
# 1 显示在列内z分数缩放的效果，蓝红颜色缩放
hv <- heatmap.2(x, col=bluered, scale="column", tracecol="#303030")
image.png
> names(hv) # 查看返回值
[1] "rowInd" "colInd" "call" "colMeans"
[5] "colSDs" "carpet" "rowDendrogram" "colDendrogram"
[9] "breaks" "col" "vline" "colorTable"
[13] "layout"
## 显示值的范围与颜色对照表
> hv$colorTable
low high color
1 -3.2116766 -2.7834531 #0000FF
2 -2.7834531 -2.3552295 #2424FF
3 -2.3552295 -1.9270060 #4949FF
4 -1.9270060 -1.4987824 #6D6DFF
5 -1.4987824 -1.0705589 #9292FF
6 -1.0705589 -0.6423353 #B6B6FF
7 -0.6423353 -0.2141118 #DBDBFF
8 -0.2141118 0.2141118 #FFFFFF
9 0.2141118 0.6423353 #FFDBDB
10 0.6423353 1.0705589 #FFB6B6
11 1.0705589 1.4987824 #FF9292
12 1.4987824 1.9270060 #FF6D6D
13 1.9270060 2.3552295 #FF4949
14 2.3552295 2.7834531 #FF2424
15 2.7834531 3.2116766 #FF0000
> ## 查看白色对应值的范围
> hv$colorTable[hv$colorTable[,"color"]=="#FFFFFF",]
low high color
8 -0.2141118 0.2141118 #FFFFFF
> ## 确定映射到白色的原始数据值
> whiteBin <- unlist(hv$colorTable[hv$colorTable[,"color"]=="#FFFFFF",1:2])
> rbind(whiteBin[1] * hv$colSDs + hv$colMeans,
+ whiteBin[2] * hv$colSDs + hv$colMeans )
cyl am vs carb wt drat gear qsec
[1,] 5.805113 0.2994102 0.3295842 2.466667 3.007751 3.482081 3.529527 17.46614
[2,] 6.569887 0.5130898 0.5454158 3.158333 3.426749 3.711044 3.845473 18.23136
mpg hp disp
[1,] 18.80018 132.0074 204.1851
[2,] 21.38107 161.3676 257.2586
## 一个更具装饰性的热图，z-score沿柱缩放
##
hv <- heatmap.2(x, col=cm.colors(255), scale="column",
RowSideColors=rc, ColSideColors=cc, margin=c(5, 10),
xlab="specification variables", ylab= "Car Models",
main="heatmap(<Mtcars data>, ..., scale=\"column\")",
tracecol="green", density="density")
一个更具装饰性的热图，z-score沿柱缩放
## 注意，断点现在是关于0对称的
## 给标签涂上颜色，使其与颜色一致
hv <- heatmap.2(x, col=cm.colors(255), scale="column",
RowSideColors=rc, ColSideColors=cc, margin=c(5, 10),
xlab="specification variables", ylab= "Car Models",
main="heatmap(<Mtcars data>, ..., scale=\"column\")",
tracecol="green", density="density", colRow=rc, colCol=cc,
srtCol=45, adjCol=c(0.5,1))
给标签涂上颜色，使其与颜色一致
第五部分
# 测试数据
data(attitude)
round(Ca <- cor(attitude), 2)
symnum(Ca) # 简单图形
# 重新排序
heatmap.2(Ca, symm=TRUE, margin=c(6, 6), trace="none" )
# 不排序
heatmap.2(Ca, Rowv=FALSE, symm=TRUE, margin=c(6, 6), trace="none" )
## 把彩色的key放在图像下方
heatmap.2(x, lmat=rbind( c(0, 3), c(2,1), c(0,4) ), lhei=c(1.5, 4, 2 ) )
## 把彩色的key放右上角
heatmap.2(x, lmat=rbind( c(0, 3, 4), c(2,1,0 ) ), lwid=c(1.5, 4, 2 ) )
把彩色的key放右上角
## 对于变量聚类，使用基于cor()的距离:
data(USJudgeRatings)
symnum( cU <- cor(USJudgeRatings) )
hU <- heatmap.2(cU, Rowv=FALSE, symm=TRUE, col=topo.colors(16),
distfun=function(c) as.dist(1 - c), trace="none")
对于变量聚类，使用基于cor()的距离
## 相同重排序的相关矩阵:
hM <- format(round(cU, 2))
hM
# 现在用图上的相关矩阵
heatmap.2(cU, Rowv=FALSE, symm=TRUE, col=rev(heat.colors(16)),
distfun=function(c) as.dist(1 - c), trace="none",
cellnote=hM)
image.png
## genechip数据例子
# 有兴趣的可以尝试以下：
# library(affy)
# data(SpikeIn)
# pms <- SpikeIn@pm
#
# # just the data, scaled across rows
# heatmap.2(pms, col=rev(heat.colors(16)), main="SpikeIn@pm",
# xlab="Relative Concentration", ylab="Probeset",
# scale="row")
#
# # fold change vs "12.50" sample
# data <- pms / pms[, "12.50"]
# data <- ifelse(data>1, data, -1/data)
# heatmap.2(data, breaks=16, col=redgreen, tracecol="blue",
# main="SpikeIn@pm Fold Changes\nrelative to 12.50 sample",
# xlab="Relative Concentration", ylab="Probeset")
# ## End(Not run)
