如何在R语言热力图中为每个X类别添加黑色轮廓

问题背景 #

现有如下数据集，需要生成多张热力图，每张图为一个特定的id类别添加黑色轮廓。

数据集 #

data <- data.frame(
  id = c("john","john","john","kate","kate","kate","chris","chris","chris"),
  group = c("geo","his","math","geo","his","math","geo","his","math"),
  grade = c(65,76,87,67,89,98,99,97,96),
  class = c("A","A","A","A","A","A","B","B","B")
)

原始热力图代码 #

mine.heatmap <- ggplot(data = data, mapping = aes(x = id, y = group, fill = grade)) +
  geom_tile() +
  xlab(label = "id") + 
  ylab(label = "group") +
  labs(fill = "grade") +
  scale_fill_gradient2(low = "#800080", high = "#FF8C00", mid = "white")

x <- mine.heatmap + facet_grid(cols = vars(class), scales = "free", space = "free")

x + theme(
  axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 18, margin = margin(b=2)),
  axis.text.y = element_text(angle = 0, vjust = 0.5, hjust=1, size = 18),
  legend.text = element_text(size=14),
  legend.title = element_text(size=14),
  strip.text = element_text(size=14),
  axis.title.x = element_text(size=18),
  axis.title.y = element_text(size=18)
)

原始热力图效果：

期望效果 #

分别为每个id添加黑色轮廓的热力图：

• 为john类别加轮廓
  
• 为kate类别加轮廓
  
• 为chris类别加轮廓
  

解决方案 #

通过叠加图层的方式，针对每个特定id单独绘制带黑色边框的tile，即可实现需求。以下提供两种实现方式：

方式1：批量生成所有id的热力图 #

# 获取所有唯一id
unique_ids <- unique(data$id)

# 循环生成每张图
for (target_id in unique_ids) {
  p <- ggplot(data = data, aes(x = id, y = group, fill = grade)) +
    geom_tile() +
    # 为目标id添加黑色轮廓
    geom_tile(data = subset(data, id == target_id), 
              aes(x = id, y = group), 
              color = "black", size = 2, fill = NA) +
    xlab("id") + 
    ylab("group") +
    labs(fill = "grade", title = paste("为", target_id, "添加轮廓")) +
    scale_fill_gradient2(low = "#800080", high = "#FF8C00", mid = "white") +
    facet_grid(cols = vars(class), scales = "free", space = "free") +
    theme(
      axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 18, margin = margin(b=2)),
      axis.text.y = element_text(angle = 0, vjust = 0.5, hjust=1, size = 18),
      legend.text = element_text(size=14),
      legend.title = element_text(size=14),
      strip.text = element_text(size=14),
      axis.title.x = element_text(size=18),
      axis.title.y = element_text(size=18),
      plot.title = element_text(size=18, hjust=0.5)
    )
  # 打印图片，如需保存可取消下方注释
  print(p)
  # ggsave(paste0("heatmap_", target_id, ".png"), p, width = 8, height = 6)
}

方式2：单独生成单张图 #

如果只需要生成某一个id的图（比如john）：

ggplot(data = data, aes(x = id, y = group, fill = grade)) +
  geom_tile() +
  geom_tile(data = subset(data, id == "john"), 
            aes(x = id, y = group), 
            color = "black", size = 2, fill = NA) +
  xlab("id") + 
  ylab("group") +
  labs(fill = "grade", title = "为john添加轮廓") +
  scale_fill_gradient2(low = "#800080", high = "#FF8C00", mid = "white") +
  facet_grid(cols = vars(class), scales = "free", space = "free") +
  theme(
    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 18, margin = margin(b=2)),
    axis.text.y = element_text(angle = 0, vjust = 0.5, hjust=1, size = 18),
    legend.text = element_text(size=14),
    legend.title = element_text(size=14),
    strip.text = element_text(size=14),
    axis.title.x = element_text(size=18),
    axis.title.y = element_text(size=18),
    plot.title = element_text(size=18, hjust=0.5)
  )

核心逻辑：通过geom_tile叠加一层仅包含目标id的图层，设置color="black"和较大的size值显示黑色轮廓，fill=NA保证不覆盖原有填充色。

内容的提问来源于stack exchange，提问作者T K