使用离散自定义颜色在一个简单的热图。-Usingdiscretecustomcolorinaplotlyheatmap

I'm trying to generate a plotly heatmap, where I'd like the colors to be specified by a discrete scale.

我想要生成一个简单的热图，在这里我想要用离散的尺度来指定颜色。

Here's what I mean:

我的意思:

Generate data with 2 clusters and hierarchically cluster them:

生成具有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]

Brake the values in mat to intervals and set a color for each interval:

每隔一段时间，在垫子上踩刹车，并为每间隔设置一个颜色:

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)

Using ggplot2 I draw this heatmap this way (also having the legend specify the discrete colors and respective ranges):

使用ggplot2我以这种方式绘制这个热图(也有图例指定离散的颜色和相应的范围):

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")

which gives:

这使:

This is my attempt to generate it with plotly:

这是我的尝试:

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

which gives:

这使:

The figures are not identical. In the ggplot2 figure the clusters are much more pronounced in contrast to the plotly figure.

这些数字并不相同。在ggplot2的数据中，集群的显著性要明显得多。

Is there any way to parametrize the plotly command to give something more similar to the ggplot2 figure?

是否有方法可以参数化这个简单的命令来提供更类似于ggplot2图形的东西?

Also, is it possible to make the plotly legend discrete - similar to that in the ggplot2 figure?

还有，是否有可能使这个故事的传说不连续——类似于ggplot2的数字?

Now suppose I want to facet the clusters. In the ggplot2 case I'd do:

现在假设我要对集群进行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"))

And then plot:

然后情节:

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")

Which gives:

这使:

So the clusters are separated by the panel.spacing and look even more pronounced. Is there any way to achieve this faceting with plotly?

因此，集群由面板分开。间距，看起来更明显。有什么方法可以很简单地实现这个faceting ?

3 个解决方案

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

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
}

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))

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",borderwhite"))