I would like to plot a heatmap like this
I know how to do a normal heatmap
Here's another solution using persp
to generate a 3d perspective and then drawing rectangles to generate bars. A lot of lines, but pretty flexible. You need to provide a data matrix (data
) and a color matrix ( colmat
).
# generate data, random + linear trend in x + linear trend in y
data = matrix(data = runif(n = 100, min = 0, max = 1), nrow=10, ncol = 10, dimnames=list(paste0('x',1:10),paste0('y',1:10)))
data = sweep(x = data, MARGIN = 1, 10:1, FUN = '+')
data = sweep(x = data, MARGIN = 2, 1:10, FUN = '+')
# generate 'empty' persp plot
pmat = persp(x=c(0,10), y=c(0,10), z=matrix(c(0,.1,0,.1), nrow=2),
xlim=c(0,10), ylim=c(0,10), zlim=c(0,20),
xlab='x', ylab='y', zlab='z',
theta=60, phi=20, d=2, box=F)
# define color ramp
my_cols = heat.colors(10)
# generate color matrix (values between 1 and 10, corresponding to 10 values my_cols
colmat = matrix(data = 1, ncol = 10, nrow = 10)
colmat[1,1:10] <- 5
colmat[5,2:4] <- 8
colmat[6,8] <- 3
# draw each bar: from left to right ...
for (i in 1:nrow(data)){
# ... and back to front
for (j in ncol(data):1){
xy = which(data == data[i,j], arr.ind=TRUE)
# side facing y
x = rep(xy[1],4)
y = c(xy[2]-1,xy[2],xy[2],xy[2]-1)
z = c(0,0,data[i,j],data[i,j])
polygon(trans3d(x, y, z, pmat), col=my_cols[colmat[i,j]], border=1)
# side facing x
x = c(xy[1]-1,xy[1],xy[1],xy[1]-1)
y = rep(xy[2]-1,4)
z = c(0,0,data[i,j],data[i,j])
polygon(trans3d(x, y, z, pmat), col=my_cols[colmat[i,j]], border=1)
# top side
x = c(xy[1]-1,xy[1],xy[1],xy[1]-1)
y = c(xy[2]-1,xy[2]-1,xy[2],xy[2])
z = rep(data[i,j],4)
polygon(trans3d(x, y, z, pmat), col=my_cols[colmat[i,j]], border=1)
}
}
# define axis ranges etc
x.axis <- 1:ncol(data) - 0.5
min.x <- 0
max.x <- 10
y.axis <- 1:nrow(data) - 0.5
min.y <- 0
max.y <- 10
z.axis <- seq(0, 10, by=10)
min.z <- 0
max.z <- 10
# add some distance between tick labels and the axis
xoffset = 1
yoffset = 0.5
zoffset = 0.5
ticklength = 0.2
# x axis ticks
tick.start <- trans3d(x.axis, min.y, min.z, pmat)
tick.end <- trans3d(x.axis, (min.y - ticklength), min.z, pmat)
segments(tick.start$x, tick.start$y, tick.end$x, tick.end$y)
# y axis ticks
tick.start <- trans3d(max.x, y.axis, min.z, pmat)
tick.end <- trans3d(max.x + ticklength, y.axis, min.z, pmat)
segments(tick.start$x, tick.start$y, tick.end$x, tick.end$y)
# z axis ticks
tick.start <- trans3d(min.x, min.y, z.axis, pmat)
tick.end <- trans3d(min.x, (min.y - ticklength), z.axis, pmat)
segments(tick.start$x, tick.start$y, tick.end$x, tick.end$y)
# x labels
labels <- rownames(data)
label.pos <- trans3d(x.axis, (min.y - xoffset), min.z, pmat)
text(label.pos$x, label.pos$y, labels=labels, adj=c(0, NA), srt=0, cex=0.6)
# y labels
labels <- colnames(data)
label.pos <- trans3d((max.x + yoffset), y.axis, min.z, pmat)
text(label.pos$x, label.pos$y, labels=labels, adj=c(0, NA), srt=0, cex=0.6)
# z labels
labels <- as.character(z.axis)
label.pos <- trans3d(min.x, (min.y - zoffset), z.axis, pmat)
text(label.pos$x, label.pos$y, labels=labels, adj=c(1, NA), srt=0, cex=0.6)