r - 如何在 R 热图中为连续颜色条设置特定颜色？

Question

这是我的热图的可重现示例，它显示了 R 中多个样本的差异表达基因:

colMax <- function(data) sapply(data, max, na.rm = TRUE)
colMin <- function(data) sapply(data, min, na.rm = TRUE)
test <- structure(list(`#Log2FC_00e41e6a` = c(0, 0, 0, 0, 0, 0), `#Log2FC_0730216b` = c(0, 
0, 0, 2.85798206145049, 0, 0), `#Log2FC_07ccb4e9` = c(-2.92159741497064, 
0, -2.32475763591175, 0, 0, 0), `#Log2FC_1426b4bf` = c(0, 0, 
0, -2.95962954629017, 0, 0), `#Log2FC_181c6d37` = c(0, 0, 0, 
0, 0, 0), `#Log2FC_1d7ffbe7` = c(0, 0, 0, 0, 0, 0)), .Names = c("#Log2FC_00e41e6a", 
"#Log2FC_0730216b", "#Log2FC_07ccb4e9", "#Log2FC_1426b4bf", "#Log2FC_181c6d37", 
"#Log2FC_1d7ffbe7"), row.names = c("A1BG-AS1", "A1CF", "A2M", 
"A2ML1", "A4GALT", "AADAC"), class = "data.frame")

这是使用 plotly 生成 R 热图的代码:

f1 <- list(
    family = "Arial, sans-serif",
    size = 5,
    color = "lightgrey")

f2 <- list(
    family = "Old Standard TT, serif",
    size = 10,
    color = "black")

a <- list(
  title = "",
  titlefont = f1,
  showticklabels = TRUE,
  tickangle = 45,
  tickfont = f2,
  exponentformat = "E")

plot_ly(z = as.matrix(test),
        zmin=round(min(colMin(test))),
        zmax=round(max(colMax(test))),
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colors = c("red", "green") ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))

产生:

问题:如何将colorbar的0值设为黑色？

如果我这样做:

plot_ly(z = as.matrix(test),
        zmin=round(min(colMin(test))),
        zmax=round(max(colMax(test))),
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colors = c("red", "black", "green") ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))

然后这个产生:

但可重现示例的问题是我整个数据的一小部分。将它应用于我的数据会给出不同的比例，其中 0 的颜色与黑色不同。这Stackoverflow question是一个类似的问题，但与我的不同，我只需要特定颜色的特定值。

编辑 1:另外，来 self 的 previous question 的回答，@MarcoSandri 说通过定义一个colorscale数组，我们可以将这些值传递给plotly。我试过了:

colorScale <- data.frame(z=c(zmin=round(min(colMin(big_data))),
                             0,
                             zmax=round(max(colMax(big_data)))),
                         col=c("#ff0000", "#000000", "#00ff00"))
colorScale$col <- as.character(colorScale$col)

plot_ly(z = as.matrix(test),
        zmin=round(min(colMin(test))),
        zmax=round(max(colMax(test))),
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colorscale = colorScale ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))

和:

如您所见，这有两个问题，首先，颜色与我在数组中给出的值不对应，其次，与前一个类似，不适用于我的整个数据。

提前致谢!

Answer 1

您的色标定义不正确。 colorScale 的 z 列应介于 0 和 1 之间，而不应介于 zmin 和 zmax 之间。请参阅下面的可能解决方案:

ncols <- 7   # Number of colors in the color scale
mypalette <- colorRampPalette(c("#ff0000","#000000","#00ff00"))
cols <- mypalette(ncols)

zseq <- seq(0,1,length.out=ncols+1)
colorScale <- data.frame(
     z = c(0,rep(zseq[-c(1,length(zseq))],each=2),1),
     col=rep(cols,each=2)
)   
colorScale$col <- as.character(colorScale$col)

zmx <- round(max(test))
zmn <- round(min(test))
plot_ly(z = as.matrix(test),
        zmin=zmn,
        zmax=zmx,
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colorscale = colorScale,
        colorbar=list(ypad = 30, tick0=-zmn, dtick=1) ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))

编辑
当比例尺不以零为中心时，此解决方案应该会更好。

mypal1 <- colorRampPalette(c("#ff0000","#000000"))
mypal2 <- colorRampPalette(c("#000000","#00ff00"))
x <- pretty(c(min(test),max(test)))
dltx <- diff(x)[1]
x <- sort(c(x,-dltx/16,dltx/16))
x <- x[x!=0]
x.resc <- (x-min(x))/(max(x)-min(x))
cols <- unique(c(mypal1(sum(x<=0)),mypal2(sum(x>0))))
colorScale <- data.frame(
     z = c(0,rep(x.resc[2:(length(x.resc)-1)],each=2),1),
     col=rep(cols,each=2)
)  

plot_ly(z = as.matrix(test),
        zmin=x[1],
        zmax=x[length(x)],
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colorscale = colorScale,
        colorbar=list(ypad = 30, tick0=x[1], dtick=dltx)  ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))