efg’s R Notes: gplots: heatmap.2
Earl F Glynn
library(gplots)##
## Attaching package: 'gplots'
##
## The following object is masked from 'package:stats':
##
## lowessdata(mtcars)
x <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)demonstrate the effect of row and column dendrogram options
heatmap.2(x) ## default - dendrogram plotted and reordering done.
heatmap.2(x, dendrogram="none") ## no dendrogram plotted, but reordering done.
heatmap.2(x, dendrogram="row") ## row dendrogram plotted and row reordering done.
heatmap.2(x, dendrogram="col") ## col dendrogram plotted and col reordering done.
heatmap.2(x, keysize=2) ## default - dendrogram plotted and reordering done.
heatmap.2(x, Rowv=FALSE, dendrogram="both") ## generate warning!## Warning in heatmap.2(x, Rowv = FALSE, dendrogram = "both"): Discrepancy:
## Rowv is FALSE, while dendrogram is `column'. Omitting row dendogram.
heatmap.2(x, Rowv=NULL, dendrogram="both") ## generate warning!## Warning in heatmap.2(x, Rowv = NULL, dendrogram = "both"): Discrepancy:
## Rowv is FALSE, while dendrogram is `column'. Omitting row dendogram.heatmap.2(x, Colv=FALSE, dendrogram="both") ## generate warning!## Warning in heatmap.2(x, Colv = FALSE, dendrogram = "both"): Discrepancy:
## Colv is FALSE, while dendrogram is `row'. Omitting column dendogram.
## Reorder dendrogram by branch means rather than sums
heatmap.2(x, reorderfun=function(d, w) reorder(d, w, agglo.FUN = mean) )
## Show effect of row and column label rotation
heatmap.2(x, srtCol=NULL)
heatmap.2(x, srtCol=0, adjCol = c(0.5,1) )
heatmap.2(x, srtCol=45, adjCol = c(1,1) )
heatmap.2(x, srtCol=135, adjCol = c(1,0) )
heatmap.2(x, srtCol=180, adjCol = c(0.5,0) )
heatmap.2(x, srtCol=225, adjCol = c(0,0) ) ## not very useful
heatmap.2(x, srtCol=270, adjCol = c(0,0.5) )
heatmap.2(x, srtCol=315, adjCol = c(0,1) )
heatmap.2(x, srtCol=360, adjCol = c(0.5,1) )
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) )
Show effect of offsetRow/offsetCol (only works when srtRow/srtCol is
not also present)
heatmap.2(x, offsetRow=0, offsetCol=0)
heatmap.2(x, offsetRow=1, offsetCol=1)
heatmap.2(x, offsetRow=2, offsetCol=2)
heatmap.2(x, offsetRow=-1, offsetCol=-1)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=0, offsetCol=0)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=1, offsetCol=1)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=2, offsetCol=2)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=-1, offsetCol=-1)
Show how to use ‘extrafun’ to replace the ‘key’ with a scatterplot
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, extrafun=myplot)
show how to customize the color key
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)]))
))
})
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))
})
Show effect of z-score scaling within columns, blue-red color scale
hv <- heatmap.2(x, col=bluered, scale="column", tracecol="#303030")
Look at the return values
names(hv)## [1] "rowInd" "colInd" "call" "colMeans"
## [5] "colSDs" "carpet" "rowDendrogram" "colDendrogram"
## [9] "breaks" "col" "vline" "colorTable"## Show the mapping of z-score values to color bins
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## Extract the range associated with white
hv$colorTable[hv$colorTable[,"color"]=="#FFFFFF",]## low high color
## 8 -0.2141118 0.2141118 #FFFFFF## Determine the original data values that map to white
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
## [1,] 5.805113 0.2994102 0.3295842 2.466667 3.007751 3.482081 3.529527
## [2,] 6.569887 0.5130898 0.5454158 3.158333 3.426749 3.711044 3.845473
## qsec mpg hp disp
## [1,] 17.46614 18.80018 132.0074 204.1851
## [2,] 18.23136 21.38107 161.3676 257.2586##
## A more decorative heatmap, with z-score scaling along columns
##
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")
## Note that the breakpoints are now symmetric about 0
data(attitude)
round(Ca <- cor(attitude), 2)## rating complaints privileges learning raises critical advance
## rating 1.00 0.83 0.43 0.62 0.59 0.16 0.16
## complaints 0.83 1.00 0.56 0.60 0.67 0.19 0.22
## privileges 0.43 0.56 1.00 0.49 0.45 0.15 0.34
## learning 0.62 0.60 0.49 1.00 0.64 0.12 0.53
## raises 0.59 0.67 0.45 0.64 1.00 0.38 0.57
## critical 0.16 0.19 0.15 0.12 0.38 1.00 0.28
## advance 0.16 0.22 0.34 0.53 0.57 0.28 1.00symnum(Ca) # simple graphic## rt cm p l rs cr a
## rating 1
## complaints + 1
## privileges . . 1
## learning , . . 1
## raises . , . , 1
## critical . 1
## advance . . . 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1# with reorder
heatmap.2(Ca, symm=TRUE, margin=c(6, 6), trace="none" )
# without reorder
heatmap.2(Ca, Rowv=FALSE, symm=TRUE, margin=c(6, 6), trace="none" )## Warning in heatmap.2(Ca, Rowv = FALSE, symm = TRUE, margin = c(6, 6),
## trace = "none"): Discrepancy: Rowv is FALSE, while dendrogram is `none'.
## Omitting row dendogram.
## Place the color key below the image plot
heatmap.2(x, lmat=rbind( c(0, 3), c(2,1), c(0,4) ), lhei=c(1.5, 4, 2 ) )
## Place the color key to the top right of the image plot
heatmap.2(x, lmat=rbind( c(0, 3, 4), c(2,1,0 ) ), lwid=c(1.5, 4, 2 ) )
## For variable clustering, rather use distance based on cor():
data(USJudgeRatings)
symnum( cU <- cor(USJudgeRatings) )## CO I DM DI CF DE PR F O W PH R
## CONT 1
## INTG 1
## DMNR B 1
## DILG + + 1
## CFMG + + B 1
## DECI + + B B 1
## PREP + + B B B 1
## FAMI + + B * * B 1
## ORAL * * B B * B B 1
## WRIT * + B * * B B B 1
## PHYS , , + + + + + + + 1
## RTEN * * * * * B * B B * 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1hU <- heatmap.2(cU, Rowv=FALSE, symm=TRUE, col=topo.colors(16),
distfun=function(c) as.dist(1 - c), trace="none")## Warning in heatmap.2(cU, Rowv = FALSE, symm = TRUE, col = topo.colors(16),
## : Discrepancy: Rowv is FALSE, while dendrogram is `none'. Omitting row
## dendogram.
## The Correlation matrix with same reordering:
hM <- format(round(cU, 2))
hM## CONT INTG DMNR DILG CFMG DECI PREP FAMI
## CONT " 1.00" "-0.13" "-0.15" " 0.01" " 0.14" " 0.09" " 0.01" "-0.03"
## INTG "-0.13" " 1.00" " 0.96" " 0.87" " 0.81" " 0.80" " 0.88" " 0.87"
## DMNR "-0.15" " 0.96" " 1.00" " 0.84" " 0.81" " 0.80" " 0.86" " 0.84"
## DILG " 0.01" " 0.87" " 0.84" " 1.00" " 0.96" " 0.96" " 0.98" " 0.96"
## CFMG " 0.14" " 0.81" " 0.81" " 0.96" " 1.00" " 0.98" " 0.96" " 0.94"
## DECI " 0.09" " 0.80" " 0.80" " 0.96" " 0.98" " 1.00" " 0.96" " 0.94"
## PREP " 0.01" " 0.88" " 0.86" " 0.98" " 0.96" " 0.96" " 1.00" " 0.99"
## FAMI "-0.03" " 0.87" " 0.84" " 0.96" " 0.94" " 0.94" " 0.99" " 1.00"
## ORAL "-0.01" " 0.91" " 0.91" " 0.95" " 0.95" " 0.95" " 0.98" " 0.98"
## WRIT "-0.04" " 0.91" " 0.89" " 0.96" " 0.94" " 0.95" " 0.99" " 0.99"
## PHYS " 0.05" " 0.74" " 0.79" " 0.81" " 0.88" " 0.87" " 0.85" " 0.84"
## RTEN "-0.03" " 0.94" " 0.94" " 0.93" " 0.93" " 0.92" " 0.95" " 0.94"
## ORAL WRIT PHYS RTEN
## CONT "-0.01" "-0.04" " 0.05" "-0.03"
## INTG " 0.91" " 0.91" " 0.74" " 0.94"
## DMNR " 0.91" " 0.89" " 0.79" " 0.94"
## DILG " 0.95" " 0.96" " 0.81" " 0.93"
## CFMG " 0.95" " 0.94" " 0.88" " 0.93"
## DECI " 0.95" " 0.95" " 0.87" " 0.92"
## PREP " 0.98" " 0.99" " 0.85" " 0.95"
## FAMI " 0.98" " 0.99" " 0.84" " 0.94"
## ORAL " 1.00" " 0.99" " 0.89" " 0.98"
## WRIT " 0.99" " 1.00" " 0.86" " 0.97"
## PHYS " 0.89" " 0.86" " 1.00" " 0.91"
## RTEN " 0.98" " 0.97" " 0.91" " 1.00"# now with the correlation matrix on the plot itself
heatmap.2(cU, Rowv=FALSE, symm=TRUE, col=rev(heat.colors(16)),
distfun=function(c) as.dist(1 - c), trace="none",
cellnote=hM)## Warning in heatmap.2(cU, Rowv = FALSE, symm = TRUE, col =
## rev(heat.colors(16)), : Discrepancy: Rowv is FALSE, while dendrogram is
## `none'. Omitting row dendogram.
packageVersion("gplots")## [1] '2.16.0'efg
2015-03-08 1356