[BioC] heatmap

Liaw, Andy andy_liaw@merck.com
Fri, 21 Feb 2003 18:44:12 -0500


This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.

------_=_NextPart_000_01C2DA03.22F84C10
Content-Type: text/plain; 
 charset=us-ascii
Content-Transfer-Encoding: 7bit

I probably should have given more detail on my attempt.  The help file looks
like the following:

==================
Heatmap of a data matrix

Description:

     Given a data matrix and clustering of its rows and columns, draw a
     heatmap along with dendrograms in the margins.

Usage:

     heatmap(x, r.hc, c.hc, add.expr, ...)

Arguments:

       x: The data matrix.

    r.hc: An `hclust' object representing clustering of rows.

    c.hc: An `hclust' object representing clustering of columns.

add.expr: An expression used to add graphics to the color image.

     ...: Arguments to be passed to `image', which draws the heatmap.

Details:

     `layout' is used to partition the plots.

     If `x' has row and column names, they will be used to label the
     heatmap.  Otherwise the row and column indices are used.

Value:

     `NULL'

Author(s):

     Andy Liaw

See Also:

     `image', `hclust'

Examples:

     set.seed(132)
     x <- matrix(runif(1000), 50, 20)
     row.hc <- hclust(dist(x))
     col.hc <- hclust(dist(t(x)))
     heatmap(x, row.hc, col.hc, add.expr=abline(h=20.5, col="blue", lwd=2))
===============================

(The output of the example code is attached.)

So, the clustering is done *before* the function is called.  It basically
rely on the plot(as.dendrogram(hclust.object)) to draw the dendrograms (thus
requires the "mva" package be loaded).  Also, I have not figured out a good
way to scale the size of the row and column labels.  If anyone can suggest a
good way to do that, I'll be very grateful.

The function is rather simple, so I'll show it below.  Any
comments/fixes/improvements etc. welcomed.

Cheers,
Andy
==============================================================
heatmap <- function (x, r.hc, c.hc, add.expr, ...) 
{
    op <- par(no.readonly = TRUE)
    on.exit(par(op))
    r.cex <- 0.2 + 1/log10(nrow(x))
    c.cex <- 0.2 + 1/log10(ncol(x))
    x <- x[r.hc$order, c.hc$order]
    layout(matrix(c(0, 3, 2, 1), 2, 2, byrow = TRUE), widths = c(1, 
        4), heights = c(1, 4), respect = TRUE)
    par(mar = c(5, 0, 0, 5))
    image(1:ncol(x), 1:nrow(x), t(x), axes = FALSE, xlim = c(0.5, 
        ncol(x) + 0.5), ylim = c(0.5, nrow(x) + 0.5), xlab = "", 
        ylab = "", ...)
    axis(1, 1:ncol(x), las = 2, line = -0.5, tick = 0, labels = if
(is.null(colnames(x))) 
        (1:ncol(x))[c.hc$order]
    else colnames(x), cex.axis = c.cex)
    axis(4, 1:nrow(x), las = 2, line = -0.5, tick = 0, labels = if
(is.null(rownames(x))) 
        (1:nrow(x))[r.hc$order]
    else rownames(x), cex.axis = r.cex)
    if (!missing(add.expr)) 
        eval(substitute(add.expr))
    par(mar = c(5, 3, 0, 0))
    plot(as.dendrogram(r.hc), horiz = TRUE, axes = FALSE, yaxs = "i")
    par(mar = c(0, 0, 3, 5))
    plot(as.dendrogram(c.hc), axes = FALSE, xaxs = "i")
    invisible(NULL)
}


> -----Original Message-----
> From: rossini@blindglobe.net [mailto:rossini@blindglobe.net]
> Sent: Friday, February 21, 2003 5:03 PM
> To: Liaw, Andy
> Cc: 'bioconductor@stat.math.ethz.ch'
> Subject: Re: [BioC] heatmap
> 
> 
> "Liaw, Andy" <andy_liaw@merck.com> writes:
> 
> 
> > The wisdom of looking at such a thing aside, has anyone implemented
> > `heatmap' in R?  (That's the one where the data matrix is 
> shown in a color
> > image, with dendrograms on the top and left sides of it 
> indicating the
> > clustering of rows and columns.)  
> >
> > I tried looking for it on the BioConductor website but 
> didn't see any, so I
> > went ahead and whipped up a heatmap function to do it.  If anyone is
> > interested, let me know.
> 
> I'm interested...  ideally, you'd have the 2-way heat map (i.e. gene
> and experiment clusters) but that is another story... (gosh, and I'd
> be asking for alot, eh?)
> 
> best,
> -tony
> 
> -- 
> A.J. Rossini				Rsrch. Asst. Prof. of 
> Biostatistics
> U. of Washington Biostatistics		
> rossini@u.washington.edu	
> FHCRC/SCHARP/HIV Vaccine Trials Net	rossini@scharp.org
> -------------- http://software.biostat.washington.edu/ 
> ----------------
> FHCRC: M: 206-667-7025 (fax=4812)|Voicemail is pretty 
> sketchy/use Email
> UW:   Th: 206-543-1044 (fax=3286)|Change last 4 digits of phone to FAX
> (my tuesday/wednesday/friday locations are completely unpredictable.)
> 



------------------------------------------------------------------------------


==============================================================================

------_=_NextPart_000_01C2DA03.22F84C10
Content-Type: application/octet-stream; 
 name=heatmap.png
Content-Transfer-Encoding: base64
Content-Disposition: attachment; 
 filename=heatmap.png

iVBORw0KGgoAAAANSUhEUgAAAeAAAAHgCAMAAABKCk6nAAAALVBMVEUAAAAAAP//AAD/IAD/QAD/
YAD/gAD/nwD/vwD/3wD//wD//yr//4D//9X///+uUG5BAAAWIklEQVR4nO3d65qrOA6FYWa6e049
nfu/3HlmJxDyGZAFshxcSz/2LgpsjF5zMJDU9FAMHVPvBijahoAHDwEPHgIePAQ8eAh48BDw4CHg
wUPAg4eABw8BDx4CHjwEPHgIePAQ8OAh4MFDwIOHgAcPAQ8eAh48BDx4CHjwEPDgIeDBQ8CDh4AH
DwEPHgIePAQ8eAh48BDw4CHgwUPAg4eABw8BDx4CHjwEPHgIePDoCjzdIXomKCD6AvdceWXcoY1H
MTZw771/jtbbeZSCjutOAG69groQ8G1XUBcCvu0Kttb5XUft2wN/3Ymxrl4BN68jG7jT/pzXkxrt
WPcBPlEmIL7uUBENnH7sFjB+fzHdl+dHmwvY14De8+sXMpYVMH5v7ES1O9nXAjc6Q9Q2Jzy8QFen
rd+b86PPGVENdkY/4MbT1u/N+dEVCjh4+uohPPyccrH+kzEusDFt/T79nNLoXPxjgc18dm8gG3Qu
fi6wMd29AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJu
O929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929
AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJu
O929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AQJuO929AXcDVlyL1/fEuL9+
R8D3iOn5z7T87CqouEdMH/+5yrSLvyP+hfgT8Rvid8S/Ef9F/AfB8pz/TwTX/xtXwAJs0B+IfyBY
ngnh8iWWgIcEfp18v+4cLOD778G7X7w7CXgM4KOZAo4Bfu0w7q8pFfA9gPsMk2q++NZKMLeP+WH+
mH8LjPWx/F8ItrfoUayAG8D5bAB7NDsQl1/n+uH/ouFrwBV1CDgG+Jno7D24og4BRwIn36qcgY+u
ogUcBjw9Ou3BhyHgGODVRbSABwSenvtv2h5c/3cjeNXPfHH7LHDWx3yxvOXF9dPnN67Q6lGczwZw
3MjYGwc/coGrCws4BHhaDZNOSLlDwNl78DPfU9bDBgF3AP51keU1CwE+GiYJOAp4se0AfLCkgIOA
JwEPDTx1Aa542sD2E4QJZz44TmX+mV/Wx/mWR5FwNog9iBUSiA1mj2Wwvscq1Xm3KqeDqc8QcAjw
aSoBC7goUhwmPK/sCPj7gV3FBBwKnPGwQcBdgCf/FfSpAl5gbi/bz/wRiMMY5p/5Y4fg+unD5Tm/
WIA9lMENJCAbzPLc4CXrAh4a2Jv3dakTRQTcCThjHAzg/Rd2Nu9FC/jyHpx8kWXUIOBIYL+ZgO8D
XHPrf1PLGQLuB5x3iP480R4EQbj9zCdBuP2sj8vTw3r4Y3kWFVgDbauB1tMmrv8DOOVhw3Q4yRBw
EPB07l6lgAVsFDGGSQKOAZ5OWUUAGyHgUOCshw31IeAQ4OWNjrZaJ4qwvcwPRw2cT2DWx1EF88Vg
fq31Fw0kKJcnKHsQh02uYVJ7YPdluoCDgKdzp2E3sPbgrsDNx8EbwMdX0QKOAZ7euW96kbUFfFhA
wEHAU869aAH3AV7fFRbwgMC/Ep3x+eBP4IqnDQRxj0MRBGI+OQwlsFU/22cGK+AKuYHsMNY4eZ3t
hIcNALarEHAQsFd2TeRbXsCd9uBTN6MjgF3DJAHfA7jqYf//Q8D3PAdPtaUFHAL8tE28ij4NzO3h
KIPbZ4FwlGGNaph/rt/do6xhFXucBc4GzolPvtEh4GTg1RsdAh4ZOPkcbISA4w7Rj7w92PXMSsCh
5+Dmr+y4e5GAQ4Bfe1XKVbSvnDdf3F4G6yMg79Uzv+wQbA/nFwtYPYIr5HwCc3k+jFjlXsDjA2fc
6PCVE3AQ8OulSgGPCvx48nrNTgNXhYCjgd1mZ4GrQ8AxwK+r6LRhUnUIOAT4tet+4R7MhDO84JzP
/FgdhPnl+pnfP7gAx6lcng20EmDFnPjnrvt9e7CAY4BXyRewgM+DbS9/cBUt4DDgM75RwPsFBBwF
fMpXwLcBnqb1fxfB6pd/H4t3gvlhcFRCEA6DOEqxgNgBWB+jaCATTmCCMtgg9jDWz4QsiV+PlM6D
eZc33+wQcAjw/LgwfZgk4KQ9uNc5WMA/A3h/mCTg2wLXnQ8EHAqc9sB/WaFVQMBBwPOjYOd1tHeH
dwOz/Xy4QjALhPOt/Frl6VUAW+NeroANsDoM62OClmxP+KFSzLOwgPsBr1ItYAFDybF4AWy9siPg
aOCmF1kFsBkCDjoHTymfbHhXXrseAYcAz5fP7i/qOA9cWZTDHm4/t4/gzB+33+oQXL/VQVh/8Vkb
NpjBFVo9mvVz/opqOvHChYBvBdz8YYOA+wE/HgkfXSmBratoAYcBz0fo3D3YqkDAUcDJ42AB5wKv
js0CHhD49agh9xBddUnHhyPcXms+h6F8GMP5zBeHoZzP8hymmm8FMtiDWJ8Fugf8zHXmRVZdBQIO
AT6DdaaMgH8esDFMEnAY8Bnf68BWCDgGePWwwSfmWlrA3S6yVm/rtL+K9twwY3uZUA5rGMyX9UoT
PdiBLB/Wb36PFYdJbDB7LBPC+dygFdSZ9yrPATsKCjgEeD0kFfCAwAtWyjmYwEdX0QIOA867VVkA
H5QQcBTwe2DqEvMsLOCOwMsZOBXYvh/N9nuBCEAw7zCM9bM9hThBCUhgq8FsIHs0yy9Qr6wnA5uV
CDgEOPdhg4Dz9+B3rgU8MvDkJYsBPhgmCXgA4KMQcBjw9HlDq1LMs7CAuwMvBtVinoU/gCs7E9vP
BDM/TDiD5dlBmB/Wz/IclhYrZAUcFzPYAIKyg3wrcG1xAQcBvz+5IuCxgTvswUdX0QKOAV50M77C
oQA+KCHgKODEzwcLOB34dUTMPweb19JsP8N6ukRAjjrowfIWoDWs+pMgVg/lCq1xmrUHLFBJV9Fb
oAJuD/y+0dF2D94sJOAU4EfGHrxZSMBZwO2vojcLeYZJAr4E7DYLAT4KAYcBpzxscBcScCiwm6w5
MIeJBGVw+6xhJ5dnMN/sMAQueiCB2GA2iD3I26M4/537+UbHCTHn4gLuAFz7lQqbYs7FBfxzgHcv
oOerAQHHAJ96VhgBbJUQcDBw9h5slRBwCPB8RPReY10Arnxnhw9HuD3MDwE4CrEe1lj1cz7r5/qL
l8S4QlbAFbCHWT2K5d+5f46R8oDrygs4CHj+7IqAhwZOvIo23taZj98CjgGeqnepWGAzBCxgAdvA
7yvatFuVAk7dgxfZbwPmMLAYZyKscTLD6gDML/PH+jj/T4ITiD2IDbDKWz36nXsBDw188k+AnwN2
PHYW8A2BN0vuDJMEHAP8ftrfDBi7bQG8XUrAUcDNX9nB6yICzgR+yXYCPlotgbn93B6CW/kjIOtj
PjnqYX3F059CHMEKuAICsjw3gOWXdJ/6qsog4IOaBBwDnDBMEnBnYLeYc3ELuO4qWsDXgBu+smMA
74SAg87ByxsdaYfozz1VwI2Bn/kHQkvgykoEPDiwBWSBMgjIfHFca3Uoq77ioyaczwosMKs8Pyqz
pFjAQwO/TsFOMwHfBvj5Ty/gg3eyBBwC/OgKfBQCjgHOvxddGQIe4BB9FATi9nMUYT7dMYLDImvU
w/lsT/F0hyuwgKzy3OC778ECPgf8FNAe/AOAs/fg3Uvo7atoAZ8Gfuq2+xqlPeDjUgKOAV6dewU8
IPD768DzgCseJT3KP23HBDOf1iiD+WF9HBZ5yxO8+AvULMBxHoHYAIJzfTvA76fBWY8LK/uTgIOA
l+fBHl4B3wbYT1vFw0UF3PMQfUY4APh4mCTgoD24G7ARAg7ag5fr2eyLLCMEHLwHp710V1nUejpE
YOaL2898EZTBDuMd5v5l9RgLiMENZP2sb872vAcLeEzgt0AWcGVPEvAAwJ6HDQI+DfwC6AF8UErA
UcCvM3DiJxuqKhFwEPD7L9slPWx4r+dwjQRlQgnA7ePyDObbGpYxv5zP+gpAVsDlLVDOt8aFS/bn
/At4RODXrivgUYEfPc/Brld2BHwF2H9LOgT4qJSA7wu83lEF3Bj49bzffafjAnBdHQIOAX7J/vqu
ne8C5jCPQEwwg+NWa5zL8tbDIPoVDSAIeywBrR5p9XDOX6V5yrnIKg7MAk4BPvfU/wwwSwp4dOCj
YZKAw4Anr1gU8GEIOAq4+V8fFXBX4Lxhkg+YQEw4H95w+ywglme+uH6W5/LF0yQCskJrHMj57KEc
FnH9S/YFPDLw+2GDgIcEnofBTrMI4P1r6F+XAwKOOkR3Az4uJWABC9hzDm7/wN8H/DfFtVglf74b
nQRc87BQwJdjBZD1sMFVA49APOTyCMb5POLxkMr6rSMej7A8YnJ+cUxnAd4psTbAOqTzlFAICHhM
4Neu2wH4eJgk4NA9eHKRhQAbIeAw4E7nYCMEHAU8ZX1XpQ/Yuz0WAPNteXD9fDhED3agYmBsrZAb
yOXZIbg8N3hJfs442H2IEHAI8PutyrbAziIPAUcBP6ZlD3Pl/yrw0TV01ScbBFy5B+fciy6BrVIC
jgJO+fvBRREB5wCvHjbk7cFVvYnDFiac228FQSxwejGf9CvGWVaDCEYg1scGs8ftDJOWV3YaAa8s
38A15QUcA/y+z9HmImva2oNrygs4DPjx3I8FPDKw+07TZWBrmCTg2D04G9gMAccAv+5kNRsmCbgv
8PS8lZW5B1f2JGscSwArn+wgXmB2EGtc/DuBrHEsG2j1cDaA9a8IWj5N2gCuKyvgKOBH9h4s4FTg
qfGNjj1g6ypawDffg60KBBwD3PpetID7Ak+OlMcB11zS8aqf+WN+rPwyHwRlfjif5ZlvdsjiE+sc
V3E+V2D1QG7w7jApH7iqAgHHAE/vOx0e31PA03rXFXAKsF/2DVe73FT8pqYCAUceov1xHdgYJgn4
5sBWCDgMOOsc7Csp4CjgtHGwryS3n9vHfFkgHNcyf8wP57M9Vgcsgj2IwQZyPjeYG8gePad7452p
Srja5QTcE3h171/AAnYzbQFXhIDjDtHVA9Mo4MoQcBDwfA52Mgj4HsDLEdGr0ByY28d8cVTC+QRi
/qwOwvqZTwIXYfVQgrBBVgI4TuP8t9N0BkHAtwJOeSfLFwIO3YPdcRXYvIoWcAjw+z5WNrBVUMAx
wB4sF9B7OQH3PES7T761QO/lBNz7HFyL6gJ6L1cuWtOp2H7mj/MJYA0TmU/mx8ov57M9v3EB9jir
h7E+dhjOZ/2OXO/A1S63AVxRXsAxwGdHMQIW8L7lVDFMEnAQ8Dnfy8BmCDgGeL4VnffKTmVhAYcA
vx40ZL6yU1mYCbWGRQRkPrj9XJ7zOaxi/s1hEitggzjfaiATwPqYkFWuBSzgU0av5T4Wrb6zIuAY
4EfyORhdaf8qWsBBwI/kPRjAuwUFHHSInqamf5xSwH2BX/meHt6nhteBjbMxhznWsInbx+3nqIWj
FOaTweVZvxnsIQS2GsTlCc74BJ7y92DjtCDgEOD5a0g7XGQJOAV4+V4y5y1LAd8F2E71HlztcofA
u8MkAd8ZuOJuh4BjgF/DJPebO37gCSsRcAbw+mDp8T0DjHJGDQRlcPsJyODyXg/OZwcsVmj1SI57
veNgBpef0zzvVQIeE3hJdfNzsID7AKcNkwpg3ys7Ar62Bzt9A4CNEHAMcOJVtKucgGOA59Mvh6s1
cLXLnQNmPhjcPqsDEIT55DCLyxOY6y+A2CBWyGERg/WxPBvMWGVdwOMCLw8b8i+yjBBwDPCSdAEP
C3zG9zxwVQg4EPjUMPg0cHUIOAh4vlGZdKuyOgQcAzy93pr1CjQH5vYyXxaQ1SEsUM4nMOcXwFYP
4AZy4M3y1vIch7+yvlxFC3hI4HXimwHzSXBVCDgWuOE5eKNExVW0gG+zB28B2wUFHAO8OngKeEjg
9D248nzM7SOw9UqTBWqBeTsU6ys+oM0C1gZYwyqrAyxpXy6gs4DrSgs4BHgexbS80YGfBJwK7B+/
EK52uQ9g+ypawFF7sP8+9HXgihBwzDnYg7UNV7ucgHsBt/50IX4ScCbw0zb9KroiOMxjvqzt57DQ
GoZa78zRj8sz3+Yn8FkBwVkfH49xg7i+Od3LswZfCPgmwI/J/8Kdg0nA3wLc6xy8O0wScNAh+nUe
dpjFAu8VFHDoOdh9w+ME8OZzYQG3BX6lPOMquvjNca/i9rP9zAe3l+X5dIn54nx2IAbbU7w0xh5C
MPZgVsiweijXv8p4L+DDegQcCpxwiC5+I+Ak4EfXPXjvKlrAcXtwzvPgbeDdEHAMcN5V9Po3FesT
cAjw+otmM4HtKgQctAc/vhSYABxGWg9nrA7AfLA+grLDcD49i8ddXKHVIHYAa+C+swe/xsHZh2gB
JwE/nxa+zovVuqbO0XICzgV+fD4Uro0I4MN3sgQcCuwxuwpcdzYQcAzwtBonVetuwnmWE3DaRdbz
H/9bHc2BuT0MJtgaRhGQ+bOArWFVMayxANhAroAdhgngBjDmVC97cKVYPdHBcgJOA36mO+OVHWdp
AQcBnzsFXwU2QsAt9uDEi6yKEHD0OTjzKroiBBwCPF9Fuy2aA3N7mT9uL/PB7SWY1UGsfDOKCvlw
gfO9FbKBXJ4dZpV/AY8L/L2HaAHHAK9GwAIeEnhB+LJhkoCDgb/tTpaAo4Cn1+PCL7sXLeAQ4PlP
By8PaWujGnj3GGwEH7YwXwQgqNUBmD/mh2ENa4uwHj9ZDWB5bgA3kAlZAbR8q/J0aQHHAFe/QuMn
ulZawLcGtq+iBXxn4IoQsIAFfGdgRVQIePBY3lH2l1KMGwIePAQ8eAh48BDw4NEceOtDTY+PN/SX
H9fPs6fPBcp77Nb8oyZ9rNBuoLW+eXnU9PkCxmq+sbx/g46iPfDGdqz+wMRj9ZHXFfA69dOq5FIj
KlhPmy36XKHdQGt9OwPUD2Bu0MHyGz9ciIw9+CODm5TrhG2lkmWngwr4NLOY5vIVDTxaX9ngjRXu
9I2jBuLHs5FziF4fn95r/dicyQNs9pCiBeXk9FGf0UAPMI88FvDW8ttNPxM5wL9+mI7yNR8WA4AN
Ya6wqoEu4MfnnmgCbyy/2fJTkQe8+kVxDn7+8MrXtKb+WGCnwPzP7nule8LsQJUN5Pqm9S/fiy6t
2dqgg+U3frgQ+cDlVXT5w+erR8VV66qeef7mmqwmbQPvNXB/fVtXvR8f9TQ2iMvf6ir6x4b7k9pt
KAQ8eNwBGHdCFJ64Qc7e1zM3aOzXRfeccZhv35gwbmSYKzDmW8v7tyh4vrM116uIbsG0PbkMJI4H
QRUrMOZfTkl0gy5Ff2BLeDVa2TkVSziprrNRLVx3I6NiBcb8kYS/AdiK0Ds7Py2Us8FDwIOHgAcP
AQ8eAh48BDx4CHjwEPDgIeDBQ8CDh4AHDwEPHgIePAQ8eAh48BDw4CHgwUPAg4eABw8BDx4CHjwE
PHgIePAQ8OAh4MFDwIOHgAcPAQ8eAh48BDx4CHjwEPDgIeDBQ8CDh4AHDwEPHgIePAQ8eAh48BDw
4PE/Ukmmfls6BzwAAAAASUVORK5CYII=

------_=_NextPart_000_01C2DA03.22F84C10--