修改 Pheatmap 中的连续图例

Question

我在 pheatmap 图例注释方面遇到问题。我想用我的 coldata 中的元数据来注释我的列（使用 RNAseq、DESeq2）。

DESeq2：

dds <- DESeqDataSetFromMatrix(countData = counts, # Raw expression counts.
                                  colData = coldata, # Metadata with age & sex lables.
                                  design = ~ age)


dds <- DESeq(dds, test="LRT", reduced = ~ 1) # LRT test for model fitting.
res <- results(dds)

vsd <- vst(dds, blind = FALSE)

plotPCA(vsd, intgroup = c("age","sex", "batch"), returnData = FALSE)

# Create annotation 
heat_anno <- as.data.frame(colData(vsd)[,c("age", "sex")])

heat_colors <- list(
    sex = c("M" = "#01bfc5", "F" = "salmon"))

热图代码的简化版本：

pheatmap(mat = assay(vsd[genes, ]),
    cluster_rows = TRUE,
    cluster_cols = FALSE,
    annotation_col = heat_anno,
    labels_col = coldata$age)

结果看起来像这样：

热图顶部的颜色已正确分配给相应的值。然而，正如您在我的 colnames 中看到的，年龄图例错误地将最小值和最大值显示为 2 和 8，而不是我的 0.6 - 9.8。我想将图例注释设置为 0 和 10（或者至少设置为我的 Coldata$age 的最小值和最大值）。有人知道我该怎么做吗？ Breaks 和 legend_breaks 修改热图值本身的颜色渐变（此处为缩放表达式），但不修改其他注释。

Answer 1

这是我修改过的函数

pheatmap:::draw_annotation_legend

的一个版本。
将此函数复制到您的脚本中（或复制到

funct.r

文件中，然后使用命令

source("funct.r")

调用该文件）。

draw_annotation_legend <- function (annotation, annotation_colors, border_color, 
                          nbreaks=6, txt="minmax", cex.txt=.9, ...) {
    y = grid:::unit(1, "npc")
    text_height = grid:::unit(1, "grobheight", textGrob("FGH", gp = gpar(...)))
    res = gList()
    for (i in names(annotation)) {
        res[[i]] = textGrob(i, x = 0, y = y, vjust = 1, hjust = 0, 
            gp = gpar(fontface = "bold", ...))
        y = y - 1.5 * text_height
        if (is.character(annotation[[i]]) | is.factor(annotation[[i]])) {
            n = length(annotation_colors[[i]])
            yy = y - (1:n - 1) * 2 * text_height
            res[[paste(i, "r")]] = rectGrob(x = unit(0, "npc"), 
                y = yy, hjust = 0, vjust = 1, height = 2 * text_height, 
                width = 2 * text_height, gp = gpar(col = border_color, 
                  fill = annotation_colors[[i]]))
            res[[paste(i, "t")]] = textGrob(names(annotation_colors[[i]]), 
                x = text_height * 2.4, y = yy - text_height, 
                hjust = 0, vjust = 0.5, gp = gpar(...))
            y = y - n * 2 * text_height
        }
        else {

            # Modified: number of breaks
            yy = y - 8 * text_height + seq(0, 1, length.out=nbreaks+1)[-1] * 
                8 * text_height
            h = 8 * text_height * 1/nbreaks
            res[[paste(i, "r")]] = rectGrob(x = unit(0, "npc"), 
                y = yy, hjust = 0, vjust = 1, height = h, width = 2 * 
                  text_height, gp = gpar(col = NA, 
                  fill = colorRampPalette(annotation_colors[[i]])(nbreaks)))
            res[[paste(i, "r2")]] = rectGrob(x = unit(0, "npc"), 
                y = y, hjust = 0, vjust = 1, height = 8 * text_height, 
                width = 2 * text_height, gp = gpar(col = border_color, 
                  fill = NA))

            # Modified: how to handle colormap labels
            if (is.null(txt)) {
              txt = rev(range(grid.pretty(range(annotation[[i]], 
                  na.rm = TRUE))))
            } else if (txt=="minmax") {
              txt = rev(range(annotation[[i]], na.rm = TRUE))
            } else {
              txt = rev(txt)
            }

            # Modified: label position
            xx <- grid:::unit(1, "npc")*.6
            lab_height <- grid:::unit(1, "grobheight", 
                             textGrob("FGH", gp=gpar(cex=1/cex.txt, ...)))
            yy = grid:::unit(1, "npc") - 1.5 * lab_height - c(0.5, 7.5) * lab_height
            res[[paste(i, "t")]] = textGrob(txt, x = xx, y = yy, 
                                   hjust = 0, vjust = 0.5, gp = gpar(cex=cex.txt,...))

            y = y - 8 * text_height
        }
        y = y - 1.5 * text_height
    }
    res = gTree(children = res)
    return(res)
}

我为此函数添加了三个新参数：

• nbreaks

  ，定义注释图例的热图颜色渐变中的中断数量

• txt

  ，它确定要放置在极端处的标签 热图比例；

  txt="minmax"

  将标签设置为最小值并 数值变量的最大值（在您的示例中为“age”）；

  txt=NULL

  使用

  grid.pretty

  定义的标签；你还可以定义两个 您选择的带有

  txt=c("lab1","lab2")

的标签

• cex.txt

  ，设置用于标签的放大倍数。

为了尽量减少对

pheatmap

的修改，我决定这三个选项应该直接在函数

draw_annotation_legend

的默认值中定义。这不是一个优雅的解决方案，但从实用的角度来看它很简单。

这是一个示例，演示了如何使用修改后的函数和我生成的数据。

mtx <- structure(c(0.73, 0.89, -0.14, -0.57, 0.76, -2.27, 0.79, -0.35, 
-0.36, -1.15, -0.15, 2.27, 0.46, 0.65, -0.94, 1.02, -1.11, -0.41, 
1.4, 0.37, 0.97, 1.82, -0.81, -1.94, -2, 2.26, -0.6, 0.78, 0.77, 
-0.2, 1.01, 2.75, 2.56, 2.04, 0.32, 0.61, -0.41, -2.08, 2.21, 
0.03, 1.41, -2.98, -1.33, 1.17, 1.07, 1.83, -1.77, 0.71, 0.73, 
-1.63, -0.68, 2.43, 0.07, 0.44, -0.84, 0.35, 0.86, 1.03, 2.68, 
-2.93, 0.19, -1.68, 0.69, 1.99, -0.73, -2.29, 1.11, 1.99, 0.65, 
-1.62, 0.07, -0.98, -1.31, 2.91, 1.75, 1.18, 1.03, -1.01, 0.6, 
1.28, 0.81, 1.3, -0.38, 3.1, 1.21, 2.33, 0.84, -0.38, 0.67, 1.03, 
-1.2, -1.07, 2.36, -0.49, -1.23, 0.86, -0.63, 2.7, -0.75, -0.87, 
0.28, -1.45, 0.53, -1.66, 0.18, -0.67, -0.39, 1.95, -0.56, 0.4, 
-1.54, -1.66, 1.58, 1.65, -0.1, -0.63, -0.07, 0.79, 2.73, -0.09, 
1.93, 1.65, 0.4, 1.91, -0.53, -1.45, -2.31, 1.45, -2.65, -1.5, 
2.05, 1.1, 0.66, -1.48, 3.32, -1.31, -1.26, 0.84, 0.16, -0.53, 
-1.43, -1.62, -0.74, -1.88, 0.02, 0.68, -1.93, 1.06, 1.12, 0.17, 
-2.02, 0.69, 0.24, -1.01, -0.14, -0.31, 2.12, -0.43, 0.08, -0.81, 
-0.61, 0.38, -0.3, -0.6, -1.24, -0.35, 0.79, -1.55, 2.21, -0.03, 
0.25, 1.68, 0.05, 1.03, -2.13, 0.6, 3.1, 0.5, 0.27, -2.27, -1.14, 
-0.06, -0.51, 1.41, 1.02, 0.1, 1.82, 0.47, -0.21, -0.63, 0.68, 
-0.63, 0.98, 0.38, 1.64, 1, 1.06, -0.55, -0.56, 0.02, -1.8, -0.79, 
0.3, 1.32, 1.04, 0.13, -2.18, 0.81, 0.12, -0.1, 1.24, -1.07, 
-0.35, 2.58, -0.76, 0.39, 0.83, -2.15, -2.67, 0.09, 1.08, -2.86, 
-0.19, -0.34, 2.24, 0.84, -0.26, 0.02, 1.92, 0.1, 0.1, -0.97, 
0.21, 0.33, 1.11, -0.58, 0.95, -0.8, 0.78, 0.31, -0.88, -0.71, 
-0.33, -1.33, -0.13, 0.96, 3.43, -0.1, 0.68, 0.94, -1.01, 1.25, 
0.57, -1.79, -0.33, 0.8, -0.52, -0.57, -0.99, -1.45, 0.89, 1.58, 
-0.18, -0.64, 1.85, -0.2, 0.05, 0.6, -1.48, -0.83, -0.79, -0.88, 
0.72, -2.64, 0.33, 1.43, 0.02, -0.39, -1.2, 0.59, -1.89, 0.21, 
-1.09, 1.99, 0.81, 0.45, 0.13, -0.84, 1.22, 0.94, -0.54, -0.89, 
-0.24, 0.5, -1.22, 0.23, -2.69, -0.78, -0.96, 0.58, 0.65, 0.01, 
-0.55, 1.5, -0.15, 0.05, 1.49, 0.43, -0.41, 2.09, -1.15, -0.11, 
1.65, 2.16, 2.7, -0.39, -0.72, -1.76, 2.83, -0.96, 0.48, 0.76, 
1.27, 0.59, -2.73, 1.17, 0.59, 0.49, -0.91, 1.23, 1.78, 0.61, 
0.44, 1.08, 0.51, 0.46, -1.9, 1.94, 0.62, 0.58, 2.6, -0.38, 1.19, 
0.67, -0.12, -0.18, -1.48, 0.68, -3.23, 0.97, 0.37, -0.11, -1.83, 
-1.35, 1.32, -0.45, 0.44, 0.04, 0.59, -1.15, -0.47, -2.27, 0.36, 
-0.24), dim = c(7L, 52L), dimnames = list(NULL, c("1", "2", "3", 
"4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", 
"16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", 
"27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", 
"38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", 
"49", "50", "51", "52")))

heat_anno <- structure(list(age = c(0.6, 0.6, 0.6, 0.8, 0.8, 0.8, 1, 1, 1, 
1.3, 1.3, 1.3, 2.1, 2.1, 2.1, 2.3, 2.3, 2.5, 2.5, 2.8, 2.8, 2.8, 
3.3, 3.3, 3.6, 3.6, 3.6, 3.8, 3.8, 3.8, 4.2, 4.2, 4.2, 4.8, 4.8, 
5.2, 5.2, 5.2, 5.6, 5.6, 6.6, 6.6, 6.6, 7.5, 7.5, 8, 8, 8, 8.6, 
9.8, 9.8, 9.8), sex = c("M", "M", "M", "F", "F", "F", "F", "M", 
"M", "F", "F", "M", "M", "M", "F", "F", "M", "F", "M", "M", "M", 
"F", "F", "M", "M", "M", "M", "M", "M", "M", "F", "F", "F", "M", 
"F", "F", "F", "F", "F", "F", "F", "F", "F", "M", "F", "M", "M", 
"F", "F", "F", "F", "F")), class = "data.frame", row.names = c(NA, 
52L))

heat_colors <- list(sex = c("M" = "#01bfc5", "F" = "salmon"))

library(pheatmap)
library(gtable)
assignInNamespace(x="draw_annotation_legend", value=draw_annotation_legend, ns="pheatmap")

pheatmap(mat = mtx,
    cluster_rows = TRUE,
    cluster_cols = FALSE,
    annotation_col = heat_anno[,c("sex", "age")],
    annotation_color=heat_colors)