# Call the gplots::heatmap.2 function in a 'simple' way
PlotHeatmap.2<-function(d, col='default', key=FALSE, trace='none', sepwidth=c(0,0), ...) {
if (identical(col, 'default')) {
col<-gplots::colorpanel(128, 'blue', 'white', 'red');
}
gplots::heatmap.2(d, col=col, key=key, trace=trace, sepwidth=sepwidth, ...);
}
# More advanced heatmap plotting
PlotHeatmap<-function(d, reorder=TRUE, size.max=10, size.block=0.2, col.max='#FF0000', col.min='#00FF00', col.na='#EEEEEE', col.num=128, fn='', plot.new=TRUE) {
if (is.null(colnames(d))) msize.right<-0; # if row or column names are not available, remove margin
if (is.null(rownames(d))) msize.up<-0;
# reorder matrix to emphasize pattern
if(reorder & nrow(d)>1 & ncol(d)>1) {
r1<-cor(d, use='pair');
r1[is.na(r1)]<-1;
hc1<-hclust(as.dist(1-r1));
r2<-cor(t(d), use='pair');
r2[is.na(r2)]<-1;
hc2<-hclust(as.dist(1-r2));
d<-d[hc2$order, hc1$order];
}
# width of plot, cannot be more than given max size
w<-ncol(d)*size.block;
if (w>size.max) {
w<-size.max;
block.width<-w/ncol(d);
} else block.width<-size.block;
msize.up<-max(nchar(colnames(d)))*block.width/4;
# height of plot, cannot be more than given max size
h<-nrow(d)*size.block;
if(h>size.max) {
h<-size.max;
block.height<-h/nrow(d);
} else block.height<-size.block;
msize.right<-max(nchar(rownames(d)))*block.height/3;
if (plot.new) {
if (fn=='' | is.na(fn[1])) {
quartz(w=0.1+w+msize.right, h=0.1+h+msize.up);
} else pdf (paste(fn[1], '.pdf', sep=''), w=0.1+w+msize.right, h=0.1+h+msize.up);
} else {
w0<-dev.size()[1];
wl<-max(nchar(rownames(d)));
msize.right<-max(w0/5, w0*wl/(wl+4*ncol(d)));
block.width<-(w0-msize.right)/ncol(d);
h0<-dev.size()[2];
hl<-max(nchar(colnames(d)));
msize.up<-max(h0/5, h0*hl/(hl+3*nrow(d)));
block.height<-(h0-msize.up)/nrow(d);
}
library(gplots);
col<-colorpanel(col.num+1, col.min, col.max);
par(mai=c(0.1,0.1,msize.up,msize.right), omi=c(0,0,0,0));
plot(0, type='n', ylab='', xlab='', yaxs='i', xaxs='i', yaxt='n', xaxt='n', ylim=c(0, nrow(d)), xlim=c(0, ncol(d)));
# plot blocks in color
mx<-max(d);
mn<-min(d);
c<-round(col.num*(d-mn)/(mx-mn))+1;
c<-apply(c, 2, function(c) col[c]);
c[is.na(c)]<-col.na;
c<-as.vector(c);
if (mx==mn) c[1:length(c)]<-col[length(col)];
x1<-rep(1:ncol(d), each=nrow(d));
y0<-nrow(d)-rep(1:nrow(d), ncol(d));
rect(x1-1, y0, x1, y0+1, col=c, border=NA);
abline(v=0:ncol(d), h=0:nrow(d), col='#88888888', lwd=0.25);
box();
# Plot row names
rnm<-rownames(d);
ch<-0.5*block.height/max(strheight(rnm, units='inch'));
if (fn=='' | is.na(fn[1])) cw<-0.9*msize.right/max(strwidth(rnm, units='inch')) else cw<-0.85*msize.right/max(strwidth(rnm, units='inch'))
text(ncol(d), nrow(d):1-0.5, label=rnm, cex=min(ch, cw), xpd=TRUE, pos=4);
# Plot column names
cnm<-colnames(d);
ch<-0.4*block.width/max(strheight(cnm, units='inch'));
cw<-1.75*msize.up/max(strwidth(cnm, units='inch'));
text(1:ncol(d)-1, nrow(d)+0.1*msize.up*nrow(d)/h, label=cnm, cex=min(ch, cw), srt=30, pos=4, xpd=TRUE);
if (plot.new & fn!='' & !is.na(fn[1])) dev.off();
list(width=0.1+w+msize.right, height=0.1+0.667*h+msize.up);
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.