R 数据可视化 —— 聚类热图 ComplexHeatmap(四)图例

最新推荐文章于 2025-03-04 10:38:28 发布

名本无名

最新推荐文章于 2025-03-04 10:38:28 发布

阅读量1.5k

点赞数

分类专栏： R 数据可视化文章标签：信息可视化 r语言聚类

本文链接：https://blog.csdn.net/dxs18459111694/article/details/134520255

版权

R 数据可视化专栏收录该内容

55 篇文章

订阅专栏

前言

忘了说了，直接使用

install.packages("ComplexHeatmap")

安装的版本比较老旧，有些功能不支持。比如富文本解析函数 gt_render，以及一些参数和图形表现形式的差异。

所以为了获取更新的、完善的功能，推荐大家使用 devtools 安装 GitHub 上的 2.7 版本

library(devtools)
install_github("jokergoo/ComplexHeatmap")

热图和简单注释会自动生成图例，并放置在图像右边区域。而复杂注释默认不会显示图例，但是可以手动构建和添加

所有图例都是通过 Legend() 函数来构造的，不论是单个图例，还是多个图例都属于 Legends 类

热图和注释的图例可以分别在 Heatmap() 函数的 heatmap_legend_param 参数和 HeatmapAnnotation() 函数的 annotation_legend_param 参数中进行设置

1. 连续型图例

连续型图例需要传递一个颜色映射函数，类似于热图及注释函数中的 col 参数，但是图例中的颜色映射函数中的 break 与显式的并不完全一样

例如

col_fun <- colorRamp2(
  breaks = c(0, 0.5, 1), 
  colors = c("blue", "white", "red")
  )
lgd <- Legend(col_fun = col_fun, title = "foo")

图例中显示的断点数会自动调整，使标签数量接近 5 或 6

> class(lgd)
[1] "Legends"
attr(,"package")
[1] "ComplexHeatmap"

可以看到，lgd 为 Legends 类，可以使用 width.Legends() 和 height.Legends() 获取图例的大小

> width.Legends(lgd)
[1] 9.90361111111111mm
> height.Legends(lgd)
[1] 28.0329444444444mm

图例实际上由矩形、线条和文本组成的包装图形对象。它可以通过 draw() 函数添加到绘图中

pushViewport(viewport(width = 0.9, height = 0.9))
grid.rect()  
draw(lgd, x = unit(1, "cm"), 
     y = unit(1, "cm"), 
     just = c("left", "bottom"))
draw(lgd, x = unit(0.5, "npc"), 
     y = unit(0.5, "npc"))
draw(lgd, x = unit(1, "npc"), 
     y = unit(1, "npc"), 
     just = c("right", "top"))
popViewport()

下面的例子中，我们将只给出图例的配置，而不再显式地使用 draw 来绘制

可以使用 at 参数来调整图例的断点

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  at = c(0, 0.25, 0.5, 0.75, 1))

labels 用于设置图例标签，labels_gp 用于设置标签图形属性

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  at = c(0, 0.5, 1), 
  labels = c("low", "median", "high"),
  labels_gp = gpar(col = "red", font = 3)
)

图例标题和标签可以设置为公式

lgd <- Legend(
  col_fun = col_fun, 
  title = expression(hat(beta) == (X^t * X)^{-1} * X^t * y), 
  at = c(0, 0.25, 0.5, 0.75, 1), 
  labels = expression(alpha, beta, gamma, delta, epsilon)
)

设置富文本

lgd <- Legend(
  col_fun = col_fun, 
  title = gt_render("<span style='color:orange'>**Legend title**</span>"), 
  title_gp = gpar(box_fill = "grey"),
  at = c(-3, 0, 3), 
  labels = gt_render(c("<span style='color:blue'>*negative*</span> three", "zero", 
                       "<span style='color:red'>*positive*</span> three"))
)

legend_height 可以设置竖直图例主体的高度，不包括图例标题，grid_width 控制图例主体的宽度

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  legend_height = unit(6, "cm"),
  grid_width = unit(1, "cm")
)

border 用于控制图例框线和刻度颜色，可以是逻辑值或颜色值

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  border = "blue"
  )

title_position 控制图例标题的位置，对于竖直图例，可选的值为 topleft、topcenter、lefttop-rot 和 leftcenter-rot

例如，左侧上方旋转

lgd <- Legend(
  col_fun = col_fun, title = "foooooooo", 
  title_position = "lefttop-rot",
  legend_height = unit(4, "cm")
  )

左侧中心且旋转

lgd <- Legend(
  col_fun = col_fun, title = "foooooooo", 
  title_position = "leftcenter-rot",
  legend_height = unit(4, "cm")
  )

类似地，对于水平图例，legend_width 可以设置相应的宽度，topcenter、topleft、lefttop 和 leftcenter 控制图例标题

例如

lgd <- Legend(col_fun = col_fun, title = "foo", direction = "horizontal")

设置宽度

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  legend_width = unit(6, "cm"), 
  direction = "horizontal"
)

设置断点、标签及其图形参数

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  at = c(0, 0.5, 1), direction = "horizontal",
  labels = c("low", "median", "high"),
  labels_gp = gpar(col = "red", font = 3)
)

设置标题位置 topleft、topcenter、lefttop、leftcenter

lgd <- Legend(
  col_fun = col_fun, title = "foooooooo", 
  direction = "horizontal", 
  title_position = "topcenter"
)

lgd <- Legend(
  col_fun = col_fun, title = "foooooooo", 
  direction = "horizontal", 
  title_position = "lefttop"
)

在上面的示例中，断点都是等间隔的，其实 at 参数也可以设置为非等间隔的区间。例如

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  at = c(0, 0.1, 0.15, 0.5, 0.9, 0.95, 1)
)

会在对应断点处显示刻度，为了防止重叠，会自动调整标签的放置位置，且会有连接线连接刻度和标签

如果标签不需要调整，则正常显示

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  at = c(0, 0.3, 1)
)

对于水平方向的图例，设置方式类似

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  at = c(0, 0.1, 0.15, 0.5, 0.9, 0.95, 1),
  direction = "horizontal"
)

旋转标签

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  at = c(0, 0.1, 0.15, 0.5, 0.9, 0.95, 1),
  direction = "horizontal", labels_rot = 90,
  title_position = "lefttop"
)

如果 at 参数设置为降序，则图例也会翻转

lgd <- Legend(
  col_fun = col_fun, title = "foo", 
  at = c(1, 0.8, 0.6, 0.4, 0.2, 0)
)

2. 离散型图例

离散型图例的设置与连续型基本一致，我们主要介绍一下不同的地方

不同于连续型图例的颜色设置，离散型用 legend_gp 参数来设置

lgd <- Legend(
  at = 1:6, title = "foo", 
  legend_gp = gpar(fill = 1:6)
  )

lgd <- Legend(
  labels = month.name[1:6], 
  title = "foo", 
  legend_gp = gpar(fill = 1:6)
)

使用连续型颜色

at <- seq(0, 1, by = 0.2)
lgd <- Legend(
  at = at, title = "foo", 
  legend_gp = gpar(fill = col_fun(at))
)

标题位置设置与连续型图例一样

lgd <- Legend(
  labels = month.name[1:6], 
  title = "foo", 
  legend_gp = gpar(fill = 1:6),
  title_position = "lefttop",
  title_gp = gpar(col = "red", fontsize = 14)
)

grid_width 和 grid_height 可以控制每个颜色矩形的大小

lgd <- Legend(
  at = 1:6, legend_gp = gpar(fill = 1:6), title = "foo", 
  grid_height = unit(1, "cm"), grid_width = unit(5, "mm")
)

labels_gp 参数控制标签的图形属性

lgd <- Legend(
  labels = month.name[1:6], 
  legend_gp = gpar(fill = 1:6), title = "foo", 
  labels_gp = gpar(col = "red", fontsize = 14)
)

使用 gt_render 函数设置富文本

lgd <- Legend(
  title = gt_render("<span style='color:orange'>**Legend title**</span>"), 
  title_gp = gpar(box_fill = "grey"),
  at = c(-3, 0, 3), 
  labels = gt_render(c("**negative** three", "*zero*", "**positive** three")),
  legend_gp = gpar(fill = 1:3)
)

离散型图例的一个重要特征是，可以将图例排列为多行多列。如果 ncol 为数值，则图例会排列为 ncol 列

lgd <- Legend(
  labels = month.name[1:10], 
  legend_gp = gpar(fill = 1:10), 
  title = "foo", ncol = 3,
  title_position = "topcenter"
)

设置 by_row = TRUE 可以使图例按行顺序排列

lgd <- Legend(
  labels = month.name[1:10], 
  legend_gp = gpar(fill = 1:10), 
  title = "foo", ncol = 3,
  title_position = "topcenter",
  by_row = TRUE
)

可以使用 gap 或 column_gap 设置两列之间的间距

lgd <- Legend(
  labels = month.name[1:10], 
  legend_gp = gpar(fill = 1:10), 
  title = "foo", ncol = 3,
  title_position = "topcenter",
  by_row = TRUE,
  gap = unit(1, "cm")
)

row_gap 可以设置行间距

lgd <- Legend(
  labels = month.name[1:10], 
  legend_gp = gpar(fill = 1:10), 
  title = "foo", ncol = 3, 
  row_gap = unit(5, "mm")
)

设置为一行

lgd <- Legend(
  labels = month.name[1:6], 
  legend_gp = gpar(fill = 1:6), 
  title = "foooooo", nrow = 1, 
  title_position = "leftcenter"
)

Legend() 还支持使用简单的图形作为图例，如 points、lines、boxplots，如果 type 设置为 points 或 p，则 pch 参数可以设置为一个字符。例如

lgd <- Legend(
  labels = month.name[1:6], 
  title = "foo", type = "points", 
  pch = 1:6, background = "#FF8080",
  legend_gp = gpar(col = 1:6),
  nrow = 1
)

设置为字母

lgd <- Legend(
  labels = month.name[1:6], 
  title = "foo", type = "p", 
  pch = letters[1:6], background = "white",
  legend_gp = gpar(col = 1:6),
  nrow = 1
)

或者使用线条 type = "lines"/type = "l"

lgd <- Legend(
  labels = month.name[1:6], 
  title = "foo", type = "lines", 
  pch = letters[1:6], background = "white",
  legend_gp = gpar(col = 1:6, lty = 1:6),
  nrow = 1
)

或者使用 type = "boxplot"/type = "box"

lgd <- Legend(
  labels = month.name[1:6], 
  title = "foo", type = "boxplot", 
  pch = letters[1:6], background = "white",
  legend_gp = gpar(fill = 1:6),
  nrow = 1
)

lgd <- Legend(
  labels = paste0("pch = ", 26:28), 
  type = "points", pch = 26:28
)

如果标签是多行，会自动调整图例的高度

lgd <- Legend(
  labels = c("aaaaa\naaaaa", "bbbbb\nbbbbb", "c", "d"),
  legend_gp = gpar(fill = 1:4),
)

如果标签使多行或多列，会根据文本长度自动调整间距

lgd <- Legend(
  labels = c("aaaaa\naaaaa", "c", "d", "bbbbb\nbbbbb"),
  legend_gp = gpar(fill = 1:4), nrow = 2
)

graphics 参数，可以为图例设置自定义图形，该参数必须为一个函数列表，每个函数有 4 个参数值：

x、y：控制图例格子的中心点
w、h：控制图例格子的宽度和高度

graphics 的长度必须与 at 或 labels 参数的长度一致。如果 graphics 是命名列表，且与 labels 的名称相对应，会自动调整 graphics 的顺序

lgd <- Legend(
  labels = letters[1:4],
  graphics = list(
    function(x, y, w, h) 
      grid.rect(x, y, w*0.33, h, gp = gpar(fill = "red")),
    function(x, y, w, h)
      grid.rect(x, y, w, h * 0.33, gp = gpar(fill = "blue")),
    function(x, y, w, h)
      grid.text("A", x, y, gp = gpar(col = "darkgreen")),
    function(x, y, w, h)
      grid.points(x, y, gp = gpar(col = "orange"), pch = 16)
    )
)

3. 图例列表

要添加多个图例，可以将每个图例分别添加到 packLegend() 函数中，或以列表的形式传递。例如

lgd1 <- Legend(
  at = 1:6, legend_gp = gpar(fill = 1:6), 
  title = "legend1"
  )
lgd2 <- Legend(
  col_fun = col_fun, title = "legend2", 
  at = c(0, 0.25, 0.5, 0.75, 1)
  )
lgd3 <- Legend(
  labels = month.name[1:3], 
  legend_gp = gpar(fill = 7:9), 
  title = "legend3"
  )

pd <- packLegend(lgd1, lgd2, lgd3)
# 同上
# pd <- packLegend(list = list(lgd1, lgd2, lgd3))
draw(pd)

类似于单个图例，也可以获取图例列表的大小

> width.Legends(pd)
[1] 19.1675555555556mm
> height.Legends(pd)
[1] 78.6988333333334mm

水平排列

pd <- packLegend(
  lgd1, lgd2, lgd3, 
  direction = "horizontal"
)

如果图例是竖直排列的，并且图例的高度超过了指定值，则会自动排列为多列

pd <- packLegend(
  lgd1, lgd3, lgd2, lgd3, lgd2, lgd1, 
  max_height = unit(10, "cm"), 
  column_gap = unit(1, "cm")
)

column_gap 用于控制列的间距

对于水平排列的图例，也是类似的

pd <- packLegend(
  lgd1, lgd2, lgd3, lgd1, lgd2, lgd3, 
  max_width = unit(10, "cm"), 
  direction = "horizontal", 
  column_gap = unit(5, "mm"), 
  row_gap = unit(1, "cm")
)

可以在绘制的时候，指定图例列表的位置

pd <- packLegend(
  lgd1, lgd2, lgd3,
  direction = "horizontal")
pushViewport(viewport(width = 0.8, height = 0.8))
grid.rect()
draw(pd, x = unit(1, "cm"), 
     y = unit(1, "cm"), 
     just = c("left", "bottom"))
draw(pd, x = unit(1, "npc"), 
     y = unit(1, "npc"), 
     just = c("right", "top"))
popViewport()

4. 热图和注释的图例

Heatmap() 函数的 heatmap_legend_param 参数，可以控制热图的图例，例如

m <- matrix(rnorm(100), 10)
Heatmap(
  m, name = "mat", 
  heatmap_legend_param = list(
    at = c(-2, 0, 2),
    labels = c("low", "zero", "high"),
    title = "Some values",
    legend_height = unit(4, "cm"),
    title_position = "lefttop-rot"
  )
)

heatmap_legend_param 接受一个列表，列表中的参数名称与 Legend 中的参数对应

类似地，在 HeatmapAnnotation() 函数中，也有一个 annotation_legend_param 参数，用于控制注释图例

ha <- HeatmapAnnotation(
  foo = runif(10), 
  bar = sample(c("f", "m"), 10, replace = TRUE),
  annotation_legend_param = list(
    foo = list(
      title = "Fooooooh",
      at = c(0, 0.5, 1),
      labels = c("zero", "median", "one")
    ),
    bar = list(
      title = "Baaaaaaar",
      at = c("f", "m"),
      labels = c("Female", "Male")
    )
  )
)
Heatmap(m, name = "mat", top_annotation = ha)

color_bar = "discrete" 可以为连续型的颜色映射设置离散的图例

Heatmap(
  m, name = "mat", 
  heatmap_legend_param = list(
    color_bar = "discrete"),
  top_annotation = HeatmapAnnotation(
    foo = 1:10,
    annotation_legend_param = list(
      foo = list(color_bar = "discrete")))
  )

5. 添加自定义图例

只有热图和简单注释会自动添加热图，复杂热图是没有图例的，例如

ha1 <- HeatmapAnnotation(
  pt = anno_points(
    1:10, height = unit(2, "cm"),
    gp = gpar(col = rep(2:3, each = 5))), 
  show_annotation_name = FALSE
)
ha2 <- HeatmapAnnotation(
  ln = anno_lines(
    cbind(1:10, 10:1), height = unit(2, "cm"),
    gp = gpar(col = 4:5, lty = 1:2)), 
  show_annotation_name = FALSE
)
m <- matrix(rnorm(100), 10)
ht_list = Heatmap(
  m, name = "mat1", top_annotation = ha1) + 
  Heatmap(m, name = "mat2", top_annotation = ha2) +
  Heatmap(
    m[, 1], name = "mat3", 
    top_annotation = HeatmapAnnotation(
      summary = anno_summary(gp = gpar(fill = 2:3))), 
    width = unit(1, "cm")
)
draw(ht_list, ht_gap = unit(7, "mm"), row_km = 2)

可以在 draw 函数中使用 annotation_legend_list 参数添加自定义热图

lgd_list <- list(
  Legend(
    labels = c("red", "green"), 
    title = "pt", type = "points", 
    pch = 16, legend_gp = gpar(col = 2:3)
    ),
  Legend(
    labels = c("darkblue", "lightblue"), 
    title = "ln", type = "lines", 
    legend_gp = gpar(col = 4:5, lty = 1:2)
    ),
  Legend(
    labels = c("group1", "group2"), 
    title = "km", type = "boxplot",
    legend_gp = gpar(fill = 2:3)
    )
)
draw(
  ht_list, ht_gap = unit(7, "mm"), 
  row_km = 2, annotation_legend_list = lgd_list)

6. 图例的位置

默认情况下，热图和注释的图例是放置在图像的右边。

draw 函数的 heatmap_legend_side 和 annotation_legend_side 参数可以控制热图和注释图例的位置。位置的选择可以是 left, right, bottom 和 top

m <- matrix(rnorm(100), 10)
ha1 <- HeatmapAnnotation(
  foo1 = runif(10), 
  bar1 = sample(c("f", "m"), 10, replace = TRUE)
  )
ha2 <- HeatmapAnnotation(
  foo2 = runif(10), 
  bar2 = sample(c("f", "m"), 10, replace = TRUE)
  )
ht_list <- Heatmap(
  m, name = "mat1", top_annotation = ha1) +
  rowAnnotation(sth = runif(10)) +
  Heatmap(m, name = "mat2", top_annotation = ha2)

draw(ht_list, heatmap_legend_side = "left", 
     annotation_legend_side = "bottom")

对于放置在上面和下面的图例，可能以水平的排列方式会更好些。

除了设置整个图例的排列方式，还要使用 annotation_legend_param 参数来设置每个图例的方向

ha1 <- HeatmapAnnotation(
  foo1 = runif(10), 
  bar1 = sample(c("f", "m"), 10, replace = TRUE),
  annotation_legend_param = list(
    foo1 = list(direction = "horizontal"),
    bar1 = list(nrow = 1))
  )
ha2 <- HeatmapAnnotation(
  foo2 = runif(10), 
  bar2 = sample(c("f", "m"), 10, replace = TRUE),
  annotation_legend_param = list(
    foo2 = list(direction = "horizontal"),
    bar2 = list(nrow = 1))
  )
ht_list <- Heatmap(
  m, name = "mat1", top_annotation = ha1, 
  heatmap_legend_param = list(direction = "horizontal")) +
  rowAnnotation(
    sth = runif(10), 
    annotation_legend_param = list(
      sth = list(direction = "horizontal"))) +
  Heatmap(
    m, name = "mat2", top_annotation = ha2,
    heatmap_legend_param = list(direction = "horizontal"))
draw(
  ht_list, merge_legend = TRUE, 
  heatmap_legend_side = "bottom", 
  annotation_legend_side = "bottom"
  )