R 数据可视化 —— 聚类热图 ComplexHeatmap(四)图例
前言
忘了说了，直接使用
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("**Legend title**"),
title_gp = gpar(box_fill = "grey"),
at = c(-3, 0, 3),
labels = gt_render(c("*negative* three", "zero",
"*positive* 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("**Legend title**"),
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"
)