使用第三维数据制作热力图

Question

使用第三维数据制作热力图

rplotheatmap

9

我想绘制一个像这样的热图。

enter image description here

我知道如何在R中制作普通的热图，但不确定如何引入3D组件。我考虑过使用3D条形图，但是我不确定如何有条件地设置条形颜色。有人可以推荐一个工具来做这样的事情吗？另一个例子是here，但它没有按照热图颜色着色。

这也可以称为3D直方图。有没有办法在R中生成这样的图形（其中箱子的高度由一个变量给出，颜色格式由另一个变量指示）, 像here？

我的问题是JTT解决方案需要能够独立地为3D条形图着色，而不是VA死亡变量。我有一个2D热图（已经为每个3D条形图设置了颜色）。然后条形的高度由另一个变量设置。这意味着颜色与高度无关。

- user3419669

3

你真的想要那个吗？这个情节很糟糕，你把一些数据藏在了更高的柱子后面，而且在这种视角下几乎不可能比较高度。 - baptiste

2

虽然我同意你的观点，但我想知道是否有一种在R中实现的方法。在我的数据集中，除了中间几个柱子会非常高之外，大多数柱子都会很低。因此，我认为这不会太糟糕。 - user3419669

1

@baptiste：这绝对不是一个可怕的情节，因为这个想法不是为了获得准确的数值比较，而是为了了解多维数据集的拓扑结构。这种数据集的工作流程不可避免地涉及到首先了解有趣的部分，然后通过切片和投影回到2D来进行更精确的绘图，只有在后期我们才需要视觉上的准确性。首先，我们需要弄清楚高“不准确”级别发生了什么。如果我们不执行这个至关重要的第一步，我们将会在大海捞针。 - Thomas Browne

1

@baptiste 是的，最终我们是在一个二维媒介（屏幕）上工作，所以三维图是对二维的投影，从数学上讲，无法传达比颜色映射更多的信息。然而，人脑对高度信息比颜色信息更敏感，因此我的经验是可旋转的三维条形图是一个有用的工具，因为它具有更直观的大小映射。这在任务是向非科学家传达信息时尤其如此，这是工业和商业中经常需要的。颜色比大小更为抽象。 - Thomas Browne

1

@baptiste......你会同意，例如，当我们谈论一个二维数据集时，我们从不使用颜色映射而不是距离映射。我们总是使用二维距离图表。这证明了距离在可能的情况下更好。因此，我认为你对OP的图表的评价“糟糕”是不公平的。 - Thomas Browne

显示剩余4条评论

2个回答

5

这里是另一种解决方法，使用persp生成3D透视图，然后绘制矩形来生成栏。虽然需要很多行代码，但非常灵活。您需要提供一个数据矩阵（data）和一个颜色矩阵（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

- koekenbakker

是否有可能使用数据矩阵的行和列名称（x和y）标记轴，并使用类似于0到1的比例尺标记z轴？ - user3419669

你说的offsets是什么意思？当我复制你的代码时，我发现盒形图中的标签带有刻度线，以及与盒形图的x、y和z轴平行的额外线条。http://www.pic-upload.de/view-24082805/Rplot05.png.html 是否有办法去掉大盒子（就像你上面展示的例子一样）？我只是重新输入了你的代码。 - user3419669

在 x 轴上，有没有一种方法可以使 x 轴标签不倾斜，而是直接从 x 轴上延伸出来？这样它们就不会互相重叠了。 - user3419669

抱歉，我的错误，我匆忙进行了编辑。现在轴标签应该没问题了，而且框也消失了。角度可以通过调整srt参数（字符串旋转）来改变。我更新了这些值，所以它们现在都是水平的。您可以将它们更改为介于0和360之间的任何值，以查看哪个最好。 - koekenbakker

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- user2357031 · Accepted Answer

三维柱状图可能是可行的方法。在latticeExtra包中有panel.3dbars()函数，你可以尝试使用它。请查看该函数的帮助页面以获取更多示例，但这里是根据帮助页面上一个示例修改的一个示例：

library(latticeExtra)
# A function generating colors
cols<-function(n) {
   colorRampPalette(c("#FFC0CB", "#CC0000"))(20)                                 # 20 distinct colors
}
# The plot
cloud(VADeaths, panel.3d.cloud = panel.3dbars, col="white",                      # white borders for bars
  xbase = 1, ybase = 1, zlim = c(0, max(VADeaths)),                              # No space around the bars
  scales = list(arrows = FALSE, just = "right"), xlab = NULL, ylab = NULL,
  col.facet = level.colors(VADeaths, at = do.breaks(range(VADeaths), 20),        
                           col.regions = cols,                                   # color ramp for filling the bars
                           colors = TRUE),
  colorkey = list(col = cols, at = do.breaks(range(VADeaths), 20)),
  screen = list(z = 65, x = -65))                                                # Adjust tilting

最终结果类似于：

enter image description here

请注意，要绘制的数据需要转化为矩阵才能使用此方法。如果您有来自X * Y网格的Z强度测量数据，则这应该相对容易实现。这里的函数（例如level.colors()）会自动根据数据范围决定颜色，但您也可以在绘图之前自己生成颜色。