如何创建热图说明网格差异控制发散调色板的中心颜色的位置? [英] How to create heatmap illustraing mesh differences controlling the position of center color for divergence color palette?

问题描述

我有两个人脸 3D 网格，我希望使用热图来说明差异.我想使用红蓝发散色标.

我的数据可以在

我希望通过使用红蓝发散色标来更好地控制热图.更具体地说，我希望使用来自 RColorBrewer 包中 RdBu 颜色调色板的 100 种颜色将正/负值着色为蓝色/红色.为此，我首先将 pd 值的范围切割成 99 个等长的间隔.然后我确定每个 pd 值位于 99 个区间中的哪一个.代码如下:

nlevel <- 99中断 <- NULLfor (i in 1:(nlevel - 1)) {中断[i] <- min(pd) + ((max(pd) - min(pd))/99) * i}休息 <- c(min(pd), 休息, max(pd))pd_cut <- cut(pd，break = break，include.lowest = TRUE)dat_col <- data.frame(pd = pd, pd_cut = pd_cut, group = as.numeric(pd_cut))

pd_cut是每个pd对应的区间，group是每个pd的区间成员.然后根据 group 中的值使用以下代码为每个 pd 分配颜色:

dat_col <- dat_col %>%变异(颜色= colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)[dat_col$group])

最终的热图如下:

open3d()shade3d(mesh1smooth，col=dat_col$color，specular =#202020"，polygon_offset = 1)

因为我有99个音程，中间的音程是第50个，(-3.53e-05,-1.34e-05].然而，它是第51个音程，(-1.34e-05,8.47e-06]，包含 0 点.

按照我的颜色分配方式 (colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)[dat_col$group])，中心颜色(第 50从 colorRampPalette) 估算的颜色被赋予属于第 50 个区间的 pds.但是，我希望 pd 属于第 51 个区间，即包含 0 的区间，被分配中心颜色.

我知道就我而言，我的问题不会对热图的外观产生太大影响.但我相信这不是一个小问题，当包含 0 的区间远离中间区间时，会显着影响热图.当比较的两个网格非常不同时，可能会发生这种情况.对我来说，将中心颜色分配给包含 0 的区间而不是位于所有区间中间的区间更有意义.

当然，我可以手动将第 50 个估算颜色的十六进制代码替换为所需的中心颜色，如下所示:

color <- colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)color2 <- 颜色color2[50] <- "#ffffff" #assume white 是预期的中心颜色

但是上述方法影响了颜色渐变的平滑度，因为最初由某个平滑函数估算的颜色被某种任意颜色替换.但是如何将中心颜色分配给位于越过 0 的区间内的 pds，同时又不影响估算颜色的平滑度?

解决方案

为了获得您想要的效果，需要解决一些问题.

首先是颜色.您根据此代码设置颜色:

color <- colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)

您可以查看该计算的结果，您会发现其中没有白色.中间颜色是 color[50] 其计算结果为 "#F7F6F6"，即略带红色的浅灰色.如果您查看原始 RdBu 调色板，中间颜色是 "#F7F7F7"，因此此更改由 colorRampPalette() 完成.对我来说，它看起来像是该函数中的一个小错误:它会截断颜色值而不是四舍五入，因此值

[50,] 247.00000 247.00000 247.00000

转换为 "#F7F6F6"，即红色 247、绿色 246、蓝色 246.您可以通过在调色板中选择其他一些颜色来避免这种情况.我看到 "F7F7F7" 作为中间颜色，有 97 和 101 种颜色.但是被一个人淘汰可能没什么大不了的，所以我不会担心这个.

第二个问题是您对 pd 值范围的离散化.你想在中间箱中为零.如果您希望所有 bin 的大小相同，则它需要是对称的:因此，您可以从 min(pd) 运行到 max(pd)，而不是运行使用此计算:

limit <- max(abs(pd))中断 <- -limit + (0:nlevel)*2*limit/nlevel

这会将零准确地放在中间 bin 的中间，但一端或另一端的一些 bin 可能不会被使用.如果您不在乎 bin 的大小是否相同，则可以通过将它们分开来获得与正数一样多的负数.我更喜欢上面的解决方案.

编辑添加:对于第一个问题，更好的解决方案是使用

color <- hcl.colors(99, "RdBu")

使用 R 3.6.0 中的新功能.这确实将浅灰色作为中间色.

I have two 3D meshes of human faces and I wish to use heatmap to illustrate differences. I want to use red-blue divergent color scale.

My data can be found here. In my data, "vb1.xlsx" and "vb2.xlsx" contain 3D coordinates of the two meshes. "it.xlsx" is the face information. The "dat_col.xlsx" contains pointwise distances between the two meshes based on which heatmap could be produced. I used the following code to generate the two meshes based on vertex and face information. I then used the meshDist function in Morpho package to calculate distances between each pair of vertex on the two meshes.

library(Morpho)
library(xlsx)
library(rgl)
library(RColorBrewer)
library(tidyverse)


mshape1 <- read.xlsx("...\vb1.xlsx", sheetIndex = 1, header = F)
mshape2 <- read.xlsx("...\vb2.xlsx", sheetIndex = 1, header = F)

it <- read.xlsx("...\it.xlsx", sheetIndex = 1, header = F)

# Preparation for use in tmesh3d
vb_mat_mshape1 <- t(mshape1)
vb_mat_mshape1 <- rbind(vb_mat_mshape1, 1)
rownames(vb_mat_mshape1) <- c("xpts", "ypts", "zpts", "")

vb_mat_mshape2 <- t(mshape2)
vb_mat_mshape2 <- rbind(vb_mat_mshape2, 1)
rownames(vb_mat_mshape2) <- c("xpts", "ypts", "zpts", "")

it_mat <- t(as.matrix(it))
rownames(it_mat) <- NULL

vertices1 <- c(vb_mat_mshape1)
vertices2 <- c(vb_mat_mshape2)

indices <- c(it_mat)

mesh1 <- tmesh3d(vertices = vertices1, indices = indices, homogeneous = TRUE, 
               material = NULL, normals = NULL, texcoords = NULL)
mesh2 <- tmesh3d(vertices = vertices2, indices = indices, homogeneous = TRUE, 
               material = NULL, normals = NULL, texcoords = NULL)

mesh1smooth <- addNormals(mesh1)
mesh2smooth <- addNormals(mesh2)

# Calculate mesh distance using meshDist function in Morpho package
mD <- meshDist(mesh1smooth, mesh2smooth)
pd <- mD$dists

The pd, containing information on pointwise distances between the two meshes, can be found in the first column of the "dat_col.xlsx" file.

A heatmap is generated from the meshDist function as follows:

I wish to have better control of the heatmap by using red-blue divergent color scale. More specifically, I want positive/negative values to be colored blue/red using 100 colors from the RdBu color pallete in the RColorBrewer package. To do so, I first cut the range of pd values into 99 intervals of equal lengths. I then determined which of the 99 intervals does each pd value lie in. The code is as below:

nlevel <- 99

breaks <- NULL
for (i in 1:(nlevel - 1)) {
    breaks[i] <- min(pd) + ((max(pd) - min(pd))/99) * i
}

breaks <- c(min(pd), breaks, max(pd))

pd_cut <- cut(pd, breaks = breaks, include.lowest = TRUE)

dat_col <- data.frame(pd = pd, pd_cut = pd_cut, group = as.numeric(pd_cut))

The pd_cut is the inteval corresponding to each pd and group is the interval membership of each pd. Color is then assgined to each pd according to the value in group with the following code:

dat_col <- dat_col %>%
           mutate(color = colorRampPalette(
                            brewer.pal(n = 9, name = "RdBu"))(99)[dat_col$group])

The final heatmap is as follows:

open3d()    
shade3d(mesh1smooth, col=dat_col$color, specular = "#202020", polygon_offset = 1)

Since I have 99 intervals, the middle interval is the 50th, (-3.53e-05,-1.34e-05]. However, it is the 51th interval, (-1.34e-05,8.47e-06], that contains the 0 point.

Following my way of color assignment (colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)[dat_col$group]), the center color (the 50th color imputed from colorRampPalette) is given to pds belonging to the 50th interval. However, I want pds that belong to the 51th interval, the interval that harbors 0, to be assgned the center color.

I understand that in my case, my issue won't affect the appearance of heatmap too much. But I believe this is not a trivial issue and can significantly affect the heatmap when the interval that contains 0 is far from the middle interval. This could happen when the two meshes under comparison is very different. It makes more sense to me to assign center color to the interval that contains 0 rather than the one(s) that lie in the middle of all intervals.

Of course I can manually replace hex code of the 50th imputed color to the desired center color as follows:

color <- colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)
color2 <- color
color2[50] <- "#ffffff" #assume white is the intended center color

But the above approach affected the smoothness of color gradient since the color that was originally imputed by some smooth function is replaced by some arbitrary color. But how could I assign center color to pds that lie in the interval that transgresses 0 while at the same time not affecting the smoothness of the imputed color?

解决方案

There are a couple of things to fix to get what you want.

First, the colours. You base the colours on this code:

color <- colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)

You can look at the result of that calculation, and you'll see that there is no white in it. The middle color is color[50] which evaluates to "#F7F6F6", i.e. a slightly reddish light gray colour. If you look at the original RdBu palette, the middle colour was "#F7F7F7", so this change was done by colorRampPalette(). To me it looks like a minor bug in that function: it truncates the colour values instead of rounding them, so the values

[50,] 247.00000 247.00000 247.00000

convert to "#F7F6F6", i.e. red 247, green 246, blue 246. You can avoid this by choosing some other number of colours in your palette. I see "F7F7F7" as the middle colour with both 97 and 101 colours. But being off by one probably doesn't matter much, so I wouldn't worry about this.

The second problem is your discretization of the range of the pd values. You want zero in the middle bin. If you want the bins all to be of equal size, then it needs to be symmetric: so instead of running from min(pd) to max(pd), you could use this calculation:

limit <- max(abs(pd))
breaks <- -limit + (0:nlevel)*2*limit/nlevel

This will put zero exactly in the middle of the middle bin, but some of the bins at one end or the other might not be used. If you don't care if the bins are of equal size, you could get just as many negatives as positives by dividing them up separately. I like the above solution better.

Edited to add: For the first problem, a better solution is to use

color <- hcl.colors(99, "RdBu")

with the new function in R 3.6.0. This does give a light gray as the middle color.

这篇关于如何创建热图说明网格差异控制发散调色板的中心颜色的位置?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！