在繪製熱圖中使用離散自定義顏色

Question

我試圖生成plotlyheatmap，其中我希望顏色由離散比例指定。

這是我的意思是：

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

我最初想的是同樣的事情，這是下采樣的漸變，但相反迫使更嚴厲的過渡似乎做了伎倆，至少使顏色更明顯。

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

Answer 2

讓我們離散colorscale

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

Answer 3

結合@Maximilian彼得斯的答案和@RS代碼：

數據：

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婷：

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