R 热图中z分数和相应p值的共享图例

我有一个z分数

矩阵

：

set.seed(1)
z.score.mat <- matrix(rnorm(1000),nrow=100,ncol=10)

我正在绘制一个z分数的分层聚类热图，如下所示：

hc.col <- hclust(dist(z.score.mat))
dd.col <- as.dendrogram(hc.col)
col.ord <- order.dendrogram(dd.col)
hc.row <- hclust(dist(t(z.score.mat)))
dd.row <- as.dendrogram(hc.row)
row.ord <- order.dendrogram(dd.row)
clustered.mat <- z.score.mat[col.ord,row.ord]
clustered.mat.names <- attr(clustered.mat,"dimnames")
clustered.mat.df <- as.data.frame(clustered.mat)
colnames(clustered.mat.df) <- clustered.mat.names[[2]]
clustered.mat.df[,"process"] <- clustered.mat.names[[1]]
clustered.mat.df[,"process"] <- with(clustered.mat.df,factor(clustered.mat.df[,"process"],levels=clustered.mat.df[,"process"],ordered=TRUE))

require(reshape2)
clustered.mat.df <- reshape2::melt(clustered.mat.df,id.vars="process")
colnames(clustered.mat.df)[2:3] <- c("condition","z.score")
clustered.mat.df$p.value <- sapply(1:nrow(clustered.mat.df),function(x) p.val.mat[which(rownames(p.val.mat) == clustered.mat.df$process[x]),which(colnames(p.val.mat) == clustered.mat.df$condition[x])])
lab.legend <- colnames(clustered.mat.df)[3]
lab.row <- colnames(clustered.mat.df)[1]
lab.col <- colnames(clustered.mat.df)[2]

require(ggplot2)
ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score))+
  scale_fill_gradient2(lab.legend,high="darkred",low="darkblue")+
  theme_bw()+
  theme(legend.key=element_blank(),
        legend.position="right",
        panel.border=element_blank(),
        strip.background=element_blank(),
        axis.text.x=element_text(angle=45,vjust=0.5)
  )

---

hc.col与您描述的不完全一样，但是您可以将p值和z值放在图例一侧的相同标签中：

z.breaks = c(-2,0,2)
p.breaks = pnorm(abs(z.breaks),lower.tail = F)

ggplot(clustered.mat.df,aes(x=condition,y=process)) +
  geom_tile(aes(fill = z.score)) +
  scale_fill_gradient2("z score (p value)", high="darkred",low="darkblue", 
                       breaks = z.breaks, 
                       labels = paste0(z.breaks, ' (p = ', round(p.breaks,2), ')')  ) +
  theme_bw() +
  theme(legend.key = element_blank(),
        legend.position = 'right',
        panel.border = element_blank(),
        strip.background = element_blank(),
        axis.text.x=element_text(angle=45,vjust=0.5))

当打印尺寸发生变化时，这是非常微妙的，但您确实得到了所需的结果：

br <- seq(-3, 3, 1)
lab <- round(pnorm(abs(br),lower.tail = F), 3)

p <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score), show.legend = FALSE)+
  scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br)

p1 <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score))+
  scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br) +
  guides(fill = guide_colorbar(title = '', label.position = 'right', barheight = 10))

p2 <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score))+
  scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br, labels = lab) +
  guides(fill = guide_colorbar('', label.position = 'left', barheight = 10))

library(cowplot)
l1 <- get_legend(p1)
l2 <- get_legend(p2)

ggdraw() + 
  draw_plot(p, width = 0.85) +
  draw_grob(l1, 0.89, 0, 0.1, 1) +
  draw_grob(l2, 0.85, 0, 0.1, 1) +
  draw_label('p         z', 0.88, 0.675, hjust = 0)

br此方法使用
gtable
和
grid
函数。它从绘图中获取图例，编辑图例，使p值显示在左侧，然后将编辑的图例放回绘图中

# Your data
set.seed(1)
z.score.mat <- matrix(rnorm(1000),nrow=100,ncol=10)
# which are the result of some biological experimental data, and a corresponding p-value matrix:

p.val.mat <- pnorm(abs(z.score.mat),lower.tail = F)

rownames(z.score.mat) <- paste("p",1:100,sep="")
colnames(z.score.mat) <- paste("c",1:10,sep="")
rownames(p.val.mat) <- paste("p",1:100,sep="")
colnames(p.val.mat) <- paste("c",1:10,sep="")

hc.col <- hclust(dist(z.score.mat))
dd.col <- as.dendrogram(hc.col)
col.ord <- order.dendrogram(dd.col)
hc.row <- hclust(dist(t(z.score.mat)))
dd.row <- as.dendrogram(hc.row)
row.ord <- order.dendrogram(dd.row)
clustered.mat <- z.score.mat[col.ord,row.ord]
clustered.mat.names <- attr(clustered.mat,"dimnames")
clustered.mat.df <- as.data.frame(clustered.mat)
colnames(clustered.mat.df) <- clustered.mat.names[[2]]
clustered.mat.df[,"process"] <- clustered.mat.names[[1]]
clustered.mat.df[,"process"] <- with(clustered.mat.df,factor(clustered.mat.df[,"process"],levels=clustered.mat.df[,"process"],ordered=TRUE))

require(reshape2)
clustered.mat.df <- reshape2::melt(clustered.mat.df,id.vars="process")
colnames(clustered.mat.df)[2:3] <- c("condition","z.score")
clustered.mat.df$p.value <- sapply(1:nrow(clustered.mat.df),function(x) p.val.mat[which(rownames(p.val.mat) == clustered.mat.df$process[x]),which(colnames(p.val.mat) == clustered.mat.df$condition[x])])
lab.legend <- colnames(clustered.mat.df)[3]
lab.row <- colnames(clustered.mat.df)[1]
lab.col <- colnames(clustered.mat.df)[2]

# Your plot
require(ggplot2)
p = ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score))+
  scale_fill_gradient2(lab.legend,high="darkred",low="darkblue") +
  theme_bw()+
  theme(legend.key=element_blank(),
        legend.position="right",
        panel.border=element_blank(),
        strip.background=element_blank(),
        axis.text.x=element_text(angle=45,vjust=0.5))


library(gtable)
library(grid)
# Get the ggplot grob
g = ggplotGrob(p)

# Get the legend
index = which(g$layout$name == "guide-box")
leg = g$grobs[[index]] 

# Get the legend labels 
# and calculate corresponding p values
z.breaks = as.numeric(leg$grobs[[1]]$grobs[[3]]$label)
p.breaks = as.character(round(pnorm(abs(z.breaks), lower.tail = F), 3))

# Get the width of the longest p.break string, taking account of font and font size
w = lapply(na.omit(p.breaks), function(x) grobWidth(textGrob(x, 
             gp = gpar(fontsize = leg$grobs[[1]]$grobs[[3]]$gp$fontsize,
                       fontfamily = leg$grobs[[1]]$grobs[[3]]$gp$fontfamily))))
w = do.call(unit.pmax, w)
w = convertX(w, "mm")

# Add columns to the legend gtable to take p.breaks, 
# setting the width of relevant column to w
leg$grobs[[1]] = gtable_add_cols(leg$grobs[[1]], leg$grobs[[1]]$widths[3], 1)
leg$grobs[[1]] = gtable_add_cols(leg$grobs[[1]], w, 1)

# Construct grob containing p.breaks
# Begin with the z.score grob, then make relevant changes
p.values = leg$grobs[[1]]$grobs[[3]]
p.values[c("label", "x", "hjust")] = list(p.breaks, unit(1, "npc"), 1)

# Put the p.values grob into the legend gtable
leg$grobs[[1]] = gtable_add_grob(leg$grobs[[1]], p.values, t=4, l=2, 
                        name = "p.values", clip = "off")

# Put 'p' and 'z' labels into the legend gtable
leg$grobs[[1]] = gtable_add_grob(leg$grobs[[1]], list(textGrob("p"), textGrob("z")), 
                        t=2, l=c(2,6), clip = "off")

# Drop the current legend title
leg$grobs[[1]]$grobs[[4]] = nullGrob()

# Put the legend back into the plot,
# and make sure the relevant column is wide enough to take the new legend
g$grobs[[index]] = leg
g$widths[8] = g$widths[8] + sum(leg$grobs[[1]]$widths[2:3])

# Draw the plot
grid.newpage()
grid.draw(g)

#您的数据
种子（1）
z、 score.mat这是IPA的路径分析结果，对吗？你到底想展示什么？在上面，你应该有
pnorm（abs（z.score.mat），lower.tail=F）
它实际上是测量多重对比度的结果（我在文章中指出为条件），但同样可以是IPA或任何其他浓缩分析的结果。我的帖子确实指出：p.val.mat在你的代码中有几个拼写错误，这并不是最小的。不错，但有点特别。干得好。有一件事值得指出。当前CRAN版本的ggplot2（V2.2.1）中存在一个bug（），这意味着第一个绘图中的
show.legend=F
未得到遵守，并且在您想要的图例旁边绘制了一个额外的不需要的图例。在github上更新到最新的ggplt2可以修复此问题。@dww您链接到的页面表明此问题已在2.2.0中修复（现在在CRAN上）？不确定此错误的确切版本。我昨天在使用2.2.1尝试代码时注意到了这一点。在CRAN上更新我的库并没有为我解决这个问题，而从Github更新则解决了这个问题。在任何情况下，我都会在这里留下这些评论，让其他遇到这个错误的人知道更新会解决它。这绝对是最合适的解决方案。
br <- seq(-3, 3, 1)
lab <- round(pnorm(abs(br),lower.tail = F), 3)

p <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score), show.legend = FALSE)+
  scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br)

p1 <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score))+
  scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br) +
  guides(fill = guide_colorbar(title = '', label.position = 'right', barheight = 10))

p2 <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score))+
  scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br, labels = lab) +
  guides(fill = guide_colorbar('', label.position = 'left', barheight = 10))

library(cowplot)
l1 <- get_legend(p1)
l2 <- get_legend(p2)

ggdraw() + 
  draw_plot(p, width = 0.85) +
  draw_grob(l1, 0.89, 0, 0.1, 1) +
  draw_grob(l2, 0.85, 0, 0.1, 1) +
  draw_label('p         z', 0.88, 0.675, hjust = 0)

# Your data
set.seed(1)
z.score.mat <- matrix(rnorm(1000),nrow=100,ncol=10)
# which are the result of some biological experimental data, and a corresponding p-value matrix:

p.val.mat <- pnorm(abs(z.score.mat),lower.tail = F)

rownames(z.score.mat) <- paste("p",1:100,sep="")
colnames(z.score.mat) <- paste("c",1:10,sep="")
rownames(p.val.mat) <- paste("p",1:100,sep="")
colnames(p.val.mat) <- paste("c",1:10,sep="")

hc.col <- hclust(dist(z.score.mat))
dd.col <- as.dendrogram(hc.col)
col.ord <- order.dendrogram(dd.col)
hc.row <- hclust(dist(t(z.score.mat)))
dd.row <- as.dendrogram(hc.row)
row.ord <- order.dendrogram(dd.row)
clustered.mat <- z.score.mat[col.ord,row.ord]
clustered.mat.names <- attr(clustered.mat,"dimnames")
clustered.mat.df <- as.data.frame(clustered.mat)
colnames(clustered.mat.df) <- clustered.mat.names[[2]]
clustered.mat.df[,"process"] <- clustered.mat.names[[1]]
clustered.mat.df[,"process"] <- with(clustered.mat.df,factor(clustered.mat.df[,"process"],levels=clustered.mat.df[,"process"],ordered=TRUE))

require(reshape2)
clustered.mat.df <- reshape2::melt(clustered.mat.df,id.vars="process")
colnames(clustered.mat.df)[2:3] <- c("condition","z.score")
clustered.mat.df$p.value <- sapply(1:nrow(clustered.mat.df),function(x) p.val.mat[which(rownames(p.val.mat) == clustered.mat.df$process[x]),which(colnames(p.val.mat) == clustered.mat.df$condition[x])])
lab.legend <- colnames(clustered.mat.df)[3]
lab.row <- colnames(clustered.mat.df)[1]
lab.col <- colnames(clustered.mat.df)[2]

# Your plot
require(ggplot2)
p = ggplot(clustered.mat.df,aes(x=condition,y=process))+
  geom_tile(aes(fill=z.score))+
  scale_fill_gradient2(lab.legend,high="darkred",low="darkblue") +
  theme_bw()+
  theme(legend.key=element_blank(),
        legend.position="right",
        panel.border=element_blank(),
        strip.background=element_blank(),
        axis.text.x=element_text(angle=45,vjust=0.5))


library(gtable)
library(grid)
# Get the ggplot grob
g = ggplotGrob(p)

# Get the legend
index = which(g$layout$name == "guide-box")
leg = g$grobs[[index]] 

# Get the legend labels 
# and calculate corresponding p values
z.breaks = as.numeric(leg$grobs[[1]]$grobs[[3]]$label)
p.breaks = as.character(round(pnorm(abs(z.breaks), lower.tail = F), 3))

# Get the width of the longest p.break string, taking account of font and font size
w = lapply(na.omit(p.breaks), function(x) grobWidth(textGrob(x, 
             gp = gpar(fontsize = leg$grobs[[1]]$grobs[[3]]$gp$fontsize,
                       fontfamily = leg$grobs[[1]]$grobs[[3]]$gp$fontfamily))))
w = do.call(unit.pmax, w)
w = convertX(w, "mm")

# Add columns to the legend gtable to take p.breaks, 
# setting the width of relevant column to w
leg$grobs[[1]] = gtable_add_cols(leg$grobs[[1]], leg$grobs[[1]]$widths[3], 1)
leg$grobs[[1]] = gtable_add_cols(leg$grobs[[1]], w, 1)

# Construct grob containing p.breaks
# Begin with the z.score grob, then make relevant changes
p.values = leg$grobs[[1]]$grobs[[3]]
p.values[c("label", "x", "hjust")] = list(p.breaks, unit(1, "npc"), 1)

# Put the p.values grob into the legend gtable
leg$grobs[[1]] = gtable_add_grob(leg$grobs[[1]], p.values, t=4, l=2, 
                        name = "p.values", clip = "off")

# Put 'p' and 'z' labels into the legend gtable
leg$grobs[[1]] = gtable_add_grob(leg$grobs[[1]], list(textGrob("p"), textGrob("z")), 
                        t=2, l=c(2,6), clip = "off")

# Drop the current legend title
leg$grobs[[1]]$grobs[[4]] = nullGrob()

# Put the legend back into the plot,
# and make sure the relevant column is wide enough to take the new legend
g$grobs[[index]] = leg
g$widths[8] = g$widths[8] + sum(leg$grobs[[1]]$widths[2:3])

# Draw the plot
grid.newpage()
grid.draw(g)