R语言绘制热图(二)：heatmap.2函数画热图

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)

THE END

参考：
heatmap.2
heatmap.2绘制热图