0

我正在尝试在热图的每个单元格上添加一个数字标签。因为它还需要边际条形图，所以我尝试了两个包。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 对象一起使用。

用 iheatmap 保存

此外，iheatmapr 对象与 ggsave() 明显不兼容（也许我错了）对我来说是个问题，因为我通常使用 ragg 包导出图像 AGG 以保留字体大小。我怀疑其他一些热图包制作的自定义对象可能与拼凑和 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 中制作的。 带有条形和标记单元格的 Excel 热图

请任何人都可以为像这样的简单热图建议一个更合适的 R 包，里面有边栏和数字标签？

4

1 回答 1

4

与其依赖提供开箱即用解决方案的软件包，实现所需结果的一种选择是使用从头开始创建绘图ggplot2，patchwork这使您可以更好地控制绘图的样式、添加标签等。

注意：问题iheatmapr在于它返回一个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))

于 2022-02-26T08:57:17.493 回答