在绘图热图中使用离散自定义颜色

Question

我正在尝试生成plotly heatmap，我希望通过离散比例指定颜色。

这就是我的意思：

使用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图中的图例类似？

现在假设我想要facet群集。在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来实现这个方面？

Answer 1

让我们得到一个离散的色阶

ArrayList<Product> products = new ArrayList<>();

通过设置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)

Answer 2

我最初想的是同样的事情，即对渐变进行下采样，但强制进行更严格的过渡似乎至少可以使颜色变得更加明显。

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

Answer 3

结合@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刻度标签准确显示在colorbar
中每个框的中间

Answer 4

question 59516054中提供了一种创建离散色彩中断的好方法 。 给定提供的Z_Breaks函数，您可以使用以下函数将colorbar刻度标签置于每个框的中间：

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

，然后将其分配给tickval的{​​{1}}参数：

colorbar