面对一个情节热图答案

【问题标题】：Faceting a plotly heatmap面对一个情节热图
【发布时间】：2017-03-06 04:14:37
【问题描述】：

我希望能够分面R plotly heatmap。

这就是我的意思：我有一个分层聚类的基因表达数据集：

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]

然后我将其离散化为特定的表达式范围，因为这恰好有助于我的情况下的颜色分辨率。我还在创建其他结构来帮助我按照我想要的方式绘制colorbar：

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

他们生成数据的方式我知道样本 1-500 是一个集群，样本 501:1000 是另一个集群，所以我标记了它们：

  interval.df$cluster <- NA
  interval.df$cluster[which(interval.df$sample %in% paste("s",1:500,sep="."))] <- "A"
  interval.df$cluster[which(interval.df$sample %in% paste("s",501:1000,sep="."))] <- "B"

我认为添加一个没有颜色和间隔的样本会在heatmap 图中创建一个看起来像分面边框的白色列：

divider.df <- data.frame(gene=unique(interval.df$gene),sample=NA,expr=NA,cluster=NA)
interval.df <- rbind(dplyr::filter(interval.df,cluster == "A"),divider.df,dplyr::filter(interval.df,cluster == "B"))

现在我尝试绘图：

#add ticks for each cluster
tick.vals <- c("s.158","s.617")
tick.text <- c("A","B")

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

但我没有看到集群之间有任何分离：

知道如何在两个集群之间实现这样的分面边界吗？

【问题讨论】：

您是否尝试过使用plotly::subplot？我还注意到您的 y 轴没有排序，您打算如何解释您的热图？
这只是一个例子，所以我没有费心在这篇文章的代码中对 y 轴进行排序。实际上，它会经过一个聚类部分。我还没有尝试过 subplot 选项。会尝试

标签： r plotly

【解决方案1】：

您的示例涉及很多，因此我将其简化为一个最小示例，以专注于您在热图的象限中寻找的差距。

根据 plotly 网站上的示例修改，here。

library(plotly)

m <- matrix(rnorm(9), nrow = 3, ncol = 3)

p <- plot_ly(
  x = c("a", "b", "c"), y = c("d", "e", "f"),
  z = m, type = "heatmap"
)

subplot(p, p, p, p, shareX = TRUE, shareY = TRUE, nrows = 2)

如果你为每个象限创建一个 plotly 对象，然后使用subplot，你会得到类似这样的结果：

注意我已经剪掉了图例，因为它在构面中是重复的，您可以将它们合并为一个。

【讨论】：