定製plotly軸蜱

我有我想爲其在plotly以產生熱圖的基因表達數據。

數據：

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))) 
interval.cols <- brewer.pal(6,"Set2") 
names(interval.cols) <- levels(mat.intervals) 
require(reshape2) 
interval.df <- reshape2::melt(interval.mat,varnames=c("gene","sample"),value.name="expr") 
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)) 
}

劇情與plotly：

require(ggplotly) 

heatmap.plotly <- 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(title="score",tickmode='array',tickvals=c(1:6),ticktext=names(interval.cols),len=0.2,outlinecolor="white",bordercolor="white",borderwidth=5,bgcolor="white"))

其中給出：

現在我正在嘗試自定義x軸刻度。假設interval.df$sample[1:500]對應於羣集「A」並且interval.df$sample[501:1000]對羣集「B」。我希望在250和750（每個羣集的x軸範圍的中間）有2個x軸刻度，並且刻度文本分別爲「A」和「B」。

根據該文件，我想這會做到這一點：

heatmap.plotly <- 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(title="score",tickmode='array',tickvals=c(1:6),ticktext=names(interval.cols),len=0.2,outlinecolor="white",bordercolor="white",borderwidth=5,bgcolor="white")) %>% 
    layout(xaxis=list(title="Cluster",tickmode="array",tickvals=c(250,750),ticktext=c("A","B")))

但我看到在x軸上沒有刻度。

此：

heatmap.plotly <- 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(title="score",tickmode='array',tickvals=c(1:6),ticktext=names(interval.cols),len=0.2,outlinecolor="white",bordercolor="white",borderwidth=5,bgcolor="white")) %>% 
     layout(xaxis=list(title="Cluster",tick0=250,dtick=500,nticks=2,ticktext=c("A","B")))

打印interval.df$sample[c(250,750)]而非c("A","B")，雖然在所希望的位置：

來源

2017-03-02 dan

我認爲tickvals參數需要對應於現有的x軸刻度標記標籤而不是他們的勾號位置，因爲這似乎解決了我的問題：

tick.vals <- c(unique(dplyr::select(dplyr::filter(interval.df,cluster=="A"),sample))$sample[floor(nrow(unique(dplyr::select(dplyr::filter(interval.df,cluster=="A"),sample)))/2)], 
       unique(dplyr::select(dplyr::filter(interval.df,cluster=="B"),sample))$sample[floor(nrow(unique(dplyr::select(dplyr::filter(interval.df,cluster=="B"),sample)))/2)]) 
tick.text <- c("A","B") 

> tick.vals 
[1] "s.158" "s.655"

然後：

heatmap.plotly <- 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(title="score",tickmode="array",tickvals=c(1:6),ticktext=names(interval.cols),len=0.2,outlinecolor="white",bordercolor="white",borderwidth=5,bgcolor="white")) %>% 
    layout(xaxis = list(title = 'Cluster',tickmode = 'array',tickvals = tick.vals,ticktext = tick.text))

給出：

來源

2017-03-03 00:25:21 dan

定製plotly軸蜱

回答

相關問題