首页 文章

自定义曲线轴刻度

提问于
浏览
1

这是this post的一个相关问题:

我有基因表达数据,我想在图中生成热图 .

数据:

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

情节剧情:

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

给出了:
enter image description here

现在我正在尝试自定义x轴刻度 . 假设 interval.df$sample[1:500] 对应于群集"A"和 interval.df$sample[501:1000] 对应群集"B" . 我想要有2个x轴刻度位于250和750(每个簇的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") ,但在所需的位置:

enter image description here

1 回答

  • 1

    我认为 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))
    

    给:
    enter image description here

相关问题