热图的内部标签，在 R ggplot 中

Question

我正在尝试在热图的每个单元格上添加一个数字标签。因为它还需要边际条形图，所以我尝试了两个包。 iheatmapr 和 ComplexHeatmap。

（第一次尝试）iheatmapr 使添加条形图变得很容易，如下所示，但我看不到如何在单个单元格的热图中添加标签。

library(tidyverse)
library(iheatmapr)
library(RColorBrewer)

in_out <- data.frame(
  'Economic' = c(2,1,1,3,4),
  'Education' = c(0,3,0,1,1),
  'Health' = c(1,0,1,2,0),
  'Social' = c(2,5,0,3,1) )
rownames(in_out) <- c('Habitat', 'Resource', 'Combined', 'Protected', 'Livelihood')

GreenLong <- colorRampPalette(brewer.pal(9, 'Greens'))(12)
lowGreens <- GreenLong[0:5]

in_out_matrix <- as.matrix(in_out)
main_heatmap(in_out_matrix, colors = lowGreens)

in_out_plot <- iheatmap(in_out_matrix,
  colors=lowGreens) %>% 
  add_col_labels() %>% 
  add_row_labels() %>% 
  add_col_barplot(y = colSums(bcio)/total) %>% 
  add_row_barplot(x = rowSums(bcio)/total)
in_out_plot

然后使用：save_iheatmap(in_out_plot, "iheatmapr_test.png") 因为我无法将 ggsave(device = ragg::agg_png etc) 与 iheatmapr 对象一起使用。

此外，iheatmapr 对象与 ggsave() 的明显不兼容（也许我错了）对我来说是个问题，因为我通常使用 ragg 包导出图像 AGG 以保留字体大小。我怀疑其他一些热图包制作的自定义对象可能与 patchwork 和 ggsave 不兼容。

ggsave("png/iheatmapr_test.png", plot = in_out_plot,
       device = ragg::agg_png, dpi = 72,
       units="in", width=3.453, height=2.5,
       scaling = 0.45)

（第二次尝试）ComplexHeatmap 可以很容易地在热图中标记单个数字“单元格”，并且还在其“注释”之间提供边缘条，我已经尝试过了，但是它的调色板系统（使用整数指一组颜色）不适合我的 RGB 矢量颜色渐变，总体而言，它是一个复杂的包，显然旨在使图形比我正在做的更先进。

我的目标是如下面的截图示例所示的样式，它是在 Excel 中制作的。

谁能为像这样带有边缘条和内部数字标签的简单热图推荐更合适的 R 包？

Answer 1

与其依赖提供 out-of-the-box 解决方案的软件包，一种实现您想要的结果的选择是使用 ggplot2 和 patchwork 从头开始创建您的绘图，这会给您带来更多控件来设置绘图样式、添加标签等。

注意：iheatmapr 的问题在于它 returns 是一个 plotly 对象，而不是 ggplot。这就是你不能使用 ggsave 的原因。

library(tidyverse)
library(patchwork)

in_out <- data.frame(
  'Economic' = c(1,1,1,5,4),
  'Education' = c(0,0,0,1,1),
  'Health' = c(1,0,1,0,0),
  'Social' = c(1,1,0,3,1) )
rownames(in_out) <- c('Habitat', 'Resource', 'Combined', 'Protected', 'Livelihood')

in_out_long <- in_out %>% 
  mutate(y = rownames(.)) %>% 
  pivot_longer(-y, names_to = "x")

# Summarise data for marginal plots
yin <- in_out_long %>% 
  group_by(y) %>% 
  summarise(value = sum(value)) %>% 
  mutate(value = value / sum(value))

xin <- in_out_long %>% 
  group_by(x) %>% 
  summarise(value = sum(value)) %>% 
  mutate(value = value / sum(value))

# Heatmap
ph <- ggplot(in_out_long, aes(x, y, fill = value)) +
  geom_tile() +
  geom_text(aes(label = value), size = 8 / .pt) +
  scale_fill_gradient(low = "#F7FCF5", high = "#00441B") +
  theme(legend.position = "bottom") +
  labs(x = NULL, y = NULL, fill = NULL)

# Marginal plots
py <- ggplot(yin, aes(value, y)) +
  geom_col(width = .75) +
  geom_text(aes(label = scales::percent(value)), hjust = -.1, size = 8 / .pt) +
  scale_x_continuous(expand = expansion(mult = c(.0, .25))) +
  theme_void()

px <- ggplot(xin, aes(x, value)) +
  geom_col(width = .75) +
  geom_text(aes(label = scales::percent(value)), vjust = -.5, size = 8 / .pt) +
  scale_y_continuous(expand = expansion(mult = c(.0, .25))) +
  theme_void()

# Glue plots together
px + plot_spacer() + ph + py + plot_layout(ncol = 2, widths = c(2, 1), heights = c(1, 2))

热图的内部标签，在 R ggplot 中

inner labelling for heatmap, in R ggplot

label

r

heatmap

ggplot2

complexheatmap