plot a heatmap with a third dimension

后端 未结 2 564
心在旅途
心在旅途 2021-02-14 18:23

I would like to plot a heatmap like this

\"enter

I know how to do a normal heatmap

2条回答
  •  情歌与酒
    2021-02-14 18:43

    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) 
    

    enter image description here

提交回复
热议问题