Verwenden von diskreten benutzerdefinierten Farbe in einer Plotly Heatmap

Question

Ich versuche, eine plotlyheatmap zu generieren, wo ich möchte, dass die Farben durch eine diskrete Skala angegeben werden.

Hier ist, was ich meine:

Generieren von Daten mit zwei Clustern und sie hierarchisch gruppieren:

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] 

Brems die Werte in mat zu Intervallen und eine Farbe für jedes Intervall eingestellt:

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) 

Mit ggplot2 zeichne ich diese heatmap auf diese Weise (auch mit der legend spezifizieren die diskrete Farben und entsprechende Bereiche):

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

die gibt:

Dies ist mein Versuch, es mit plotly zu generieren:

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

die gibt:

Die Figuren sind nicht identisch. In der Figur ggplot2 sind die Cluster im Gegensatz zur plotly Figur deutlich ausgeprägter.

Gibt es eine Möglichkeit, den plotly Befehl zu parametrisieren, um etwas ähnlicheres an die ggplot2 Zahl zu geben?

Ist es auch möglich, die plotly Legende diskret zu machen - ähnlich wie in der ggplot2 Abbildung?

Nun nehme ich an facet die Cluster. Im ggplot2 Fall würde ich tun:

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

Und dann Grundstück:

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

Welche gibt:

So werden die Cluster durch die panel.spacing getrennt sind, und suchen noch ausgeprägter. Gibt es eine Möglichkeit, diese Facettierung mit plotly zu erreichen?

Answer 1

Ich dachte anfangs das Gleiche, nämlich den Gradienten herunterzuspielen, aber stattdessen härtere Übergänge zu erzwingen scheint zumindest den Trick zu machen, die Farben deutlicher zu machen.

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

Answer 2

Lassen sie eine diskrete Farbkarte

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 
} 

erhalten und einen schönen colorbar erhalten, indem ticktext Einstellung und drückt sie (len=0.2)

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

---

Der gesamte Code, der

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

Die Kombination der Antworten von @Maximilian Peters und @RS zu Ihrem Beispiel hinzugefügt werden muss:

Daten:

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] 

Farben:

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 ting:

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

Es wäre toll, wenn jemand hinzufügen:

1. Wie eine schmale Grenze zwischen den Facetten Facette oder zu erstellen.
2. Wie die colorbar Strichbeschriftungen bekommen genau in der Mitte jeder Box in der colorbar