在 Plotly 热力图中使用离散的自定义颜色

Question

我将尝试生成一个plotly热图，其中我希望使用离散比例来指定颜色。

这是我的意思：

生成包含2个聚类的数据并对它们进行层次聚类：

require(permute)
set.seed(1)
mat <- rbind(cbind(matrix(rnorm(2500,2,1),nrow=25,ncol=500),matrix(rnorm(2500,-2,1),nrow=25,ncol=500)),
             cbind(matrix(rnorm(2500,-2,1),nrow=25,ncol=500),matrix(rnorm(2500,2,1),nrow=25,ncol=500)))
rownames(mat) <- paste("g",1:50,sep=".")
colnames(mat) <- paste("s",1:1000,sep=".")
hc.col <- hclust(dist(t(mat)))
dd.col <- as.dendrogram(hc.col)
col.order <- order.dendrogram(dd.col)
hc.row <- hclust(dist(mat))
dd.row <- as.dendrogram(hc.row)
row.order <- order.dendrogram(dd.row)
mat <- mat[row.order,col.order]

将mat中的值分成区间，并为每个区间设置颜色：

require(RColorBrewer)
mat.intervals <- cut(mat,breaks=6)
interval.mat <- matrix(mat.intervals,nrow=50,ncol=1000,dimnames=list(rownames(mat),colnames(mat)))
interval.cols <- brewer.pal(6,"Set2")
names(interval.cols) <- levels(mat.intervals)

使用ggplot2，我这样绘制了这个 heatmap（同时让legend指定离散颜色和相应范围）:

require(reshape2)
interval.df <- reshape2::melt(interval.mat,varnames=c("gene","sample"),value.name="expr")
require(ggplot2)
ggplot(interval.df,aes(x=sample,y=gene,fill=expr))+
  geom_tile(color=NA)+theme_bw()+
  theme(strip.text.x=element_text(angle=90,vjust=1,hjust=0.5,size=6),panel.spacing=unit(0.025,"cm"),legend.key=element_blank(),plot.margin=unit(c(1,1,1,1),"cm"),legend.key.size=unit(0.25,"cm"),panel.border=element_blank(),strip.background=element_blank(),axis.ticks.y=element_line(size=0.25))+
  scale_color_manual(drop=FALSE,values=interval.cols,labels=names(interval.cols),name="expr")+
  scale_fill_manual(drop=FALSE,values=interval.cols,labels=names(interval.cols),name="expr")

这里是使用plotly生成的尝试结果：

plot_ly(z=mat,x=colnames(mat),y=rownames(mat),type="heatmap",colors=interval.cols)

这将得到：

这些图形并不完全相同。在 ggplot2 图中，与 plotly 图相比，聚类更加明显。

有没有办法对 plotly 命令进行参数化，以得到更接近 ggplot2 图的效果？

此外，是否可以使 plotly 图例离散化-类似于 ggplot2 图中的图例？

现在假设我想要对聚类进行分面显示。在 ggplot2 中，我会这样做：

require(dplyr)
facet.df <- data.frame(sample=c(paste("s",1:500,sep="."),paste("s",501:1000,sep=".")),facet=c(rep("f1",500),rep("f2",500)),stringsAsFactors=F)
interval.df <- left_join(interval.df,facet.df,by=c("sample"="sample"))
interval.df$facet <- factor(interval.df$facet,levels=c("f1","f2"))

接着绘制：

ggplot(interval.df,aes(x=sample,y=gene,fill=expr))+facet_grid(~facet,scales="free",space="free",switch="both")+
  geom_tile(color=NA)+labs(x="facet",y="gene")+theme_bw()+
  theme(strip.text.x=element_text(angle=90,vjust=1,hjust=0.5,size=6),panel.spacing=unit(0.05,"cm"),plot.margin=unit(c(1,1,1,1),"cm"),legend.key.size=unit(0.25,"cm"),panel.border=element_blank(),strip.background=element_blank(),axis.ticks.y=element_line(size=0.25))+
  scale_color_manual(drop=FALSE,values=interval.cols,labels=names(interval.cols),name="expr")+
  scale_fill_manual(drop=FALSE,values=interval.cols,labels=names(interval.cols),name="expr")

这将会得到：

因此，这些聚类是由panel.spacing分隔开的，并且看起来更加显著。是否有任何方法可以使用plotly实现这种细分？

- dan

---

使用 ggplotly 怎么样？ - Axeman

对于这些维度，使用ggplotly将ggplot转换为plotly需要很长时间（多达几分钟），不太实用。 - dan

Answer 1

让我们使用离散的颜色刻度

df_colors = data.frame(range=c(0:11), colors=c(0:11))
color_s <- setNames(data.frame(df_colors$range, df_colors$colors), NULL)
for (i in 1:12) {
  color_s[[2]][[i]] <- interval.cols[[(i + 1) / 2]]
  color_s[[1]][[i]] <-  i / 12 - (i %% 2) / 12
}

通过设置ticktext并压缩它（len=0.2），可以得到漂亮的色条。

colorbar=list(tickmode='array', tickvals=c(1:6), ticktext=levels(mat.intervals), len=0.2)

---

需要添加到你的示例中的所有代码

df_colors = data.frame(range=c(0:11), colors=c(0:11))
color_s <- setNames(data.frame(df_colors$range, df_colors$colors), NULL)

for (i in 1:12) {
  color_s[[2]][[i]] <- interval.cols[[(i + 1) / 2]]
  color_s[[1]][[i]] <-  i / 12 - (i %% 2) / 12
}


plot_ly(z=c(interval.df$expr), x=interval.df$sample, y=interval.df$gene, colorscale = color_s, type = "heatmap", hoverinfo = "x+y+z", colorbar=list(tickmode='array', tickvals=c(1:6), ticktext=levels(mat.intervals), len=0.2))

- Maximilian Peters

Answer 2

一开始我也考虑过对渐变进行降采样，但是强制更严格的过渡似乎能够使颜色更加突出。

interval.cols2 <- rep(interval.cols, each=1000)
plot_ly(z=mat,x=colnames(mat),y=rownames(mat),type="heatmap",colors=interval.cols2)

- Djork

---

非常感谢 @R.S.。有什么关于分面的想法吗？ - dan

嗯，我对plot_ly热图不太熟悉，但是在heatmap.2中，你可以添加虚拟的NA列或行向量，并将NA值的颜色分配设置为白色以引入分隔符。假设在plot_ly中有类似的选项，如果这是聚类的结果，则需要找出切割点，或者如果列顺序事先已知，则只需在两个组之间添加NA向量（或矩阵）。您还需要引入""列名。 - Djork

Answer 3

在问题 59516054中提供了一种创建离散颜色区间的好方法。 使用提供的Z_Breaks函数，您可以通过使用以下函数将colorbar刻度标签居中于每个框中：

tickpos <- function(nFactor) {
    pos <- unique((head(Z_Breaks(nFactor), -1)) + head(Z_Breaks(nFactor))[2] / 2) * (nFactor - 1)
}

然后将其分配给colorbar的tickval参数：

colorbar <- list(tickvals = tickpos(nFactor), ticktext = names(colours))

- Masch

Answer 4

结合 @Maximilian Peters 和 @R.S. 的回答：

数据：

require(permute)
set.seed(1)
mat <- rbind(cbind(matrix(rnorm(2500,2,1),nrow=25,ncol=500),matrix(rnorm(2500,-2,1),nrow=25,ncol=500)),
             cbind(matrix(rnorm(2500,-2,1),nrow=25,ncol=500),matrix(rnorm(2500,2,1),nrow=25,ncol=500)))
rownames(mat) <- paste("g",1:50,sep=".")
colnames(mat) <- paste("s",1:1000,sep=".")
hc.col <- hclust(dist(t(mat)))
dd.col <- as.dendrogram(hc.col)
col.order <- order.dendrogram(dd.col)
hc.row <- hclust(dist(mat))
dd.row <- as.dendrogram(hc.row)
row.order <- order.dendrogram(dd.row)
mat <- mat[row.order,col.order]

颜色：

require(RColorBrewer)
mat.intervals <- cut(mat,breaks=6)
interval.mat <- matrix(mat.intervals,nrow=50,ncol=1000,dimnames=list(rownames(mat),colnames(mat)))
require(reshape2)
interval.df <- reshape2::melt(interval.mat,varnames=c("gene","sample"),value.name="expr")
interval.cols <- brewer.pal(6,"Set2")
names(interval.cols) <- levels(mat.intervals)
interval.cols2 <- rep(interval.cols, each=ncol(mat))
color.df <- data.frame(range=c(0:(2*length(interval.cols)-1)),colors=c(0:(2*length(interval.cols)-1)))
color.df <- setNames(data.frame(color.df$range,color.df$colors),NULL)
for (i in 1:(2*length(interval.cols))) {
  color.df[[2]][[i]] <- interval.cols[[(i + 1) / 2]]
  color.df[[1]][[i]] <-  i/(2*length(interval.cols))-(i %% 2)/(2*length(interval.cols))
}

绘图：

plot_ly(z=c(interval.df$expr),x=interval.df$sample,y=interval.df$gene,colors=interval.cols2,type="heatmap",colorscale=color.df,
        colorbar=list(tickmode='array',tickvals=c(1:6),ticktext=names(interval.cols),len=0.2,outlinecolor="white",bordercolor="white",borderwidth=5,bgcolor="white"))

如果有人能够添加以下内容，那就太好了：

1. 如何对数据进行分面或创建窄边框。
2. 如何使colorbar的刻度标签正好出现在每个框的中间。

- dan

---

关于（2），现在@MaximilianPeters向我们展示了如何破解colorbar，你能否检查从tickmode到其他参数，阅读似乎暗示可以通过将tickmode设置为“linear”并使用0tick和dtick来实现，尽管我还没有尝试过。https://plot.ly/r/reference/#scatter-marker-colorbar-tickmode - Djork

我尝试了一下，但失败了。因此，我的帖子是针对有经验的人。如果我成功了，我会更新我的答案。 - dan