ggplot2绘制多边形热图

R语言数据分析指南

发布于 2023-12-20 15:27:30

1360

发布于 2023-12-20 15:27:30

欢迎关注R语言数据分析指南

❝本节通过一个案例来介绍如何绘制多边形热图，整个过程仅参考。希望对各位观众老爷能有所帮助。「数据代码已经整合上传到2023VIP交流群」，加群的观众老爷可自行下载，有需要的朋友可关注文末介绍加入VIP交流群。给予长期支持我们的忠实读者们一个特别待遇：凡是购买过小编2022年或2023年VIP会员文档的朋友们，将自动获得2024年及以后更新的绘图文档代码，无需额外付费。目前这两年的会员文档已累记卖出1500+，质量方面各位无需担忧。简要概括就是只要购买任意1年的会员内容，2024及后期公众号所更新的绘图文档均会在已经加入的会员群内分享。 ❞

加载R包

library(tidyverse)
library(camcorder)
library(RColorBrewer)

导入数据

scurvy <- read_csv('scurvy.csv')
pal <- RColorBrewer::brewer.pal(name = "Paired", n = 4)

定义函数

# 格式处理
clean_format <- function(column) {
  column %>%
    str_to_sentence() %>%
    str_remove("_d6") %>% 
    str_replace_all("_", " ")
}

数据清洗

scurvy_long <- scurvy %>%
  # 将指定列中的字符串解析为数字
  mutate(across(gum_rot_d6:fit_for_duty_d6, parse_number)) %>%
  # 将数据从宽格式转换为长格式
  pivot_longer(gum_rot_d6:fit_for_duty_d6, names_to = "symptom", values_to = "severity") %>%
  # 对处理和症状名称进行清洁和格式化
  mutate(
    treatment = clean_format(treatment) %>% fct_rev(),
    symptom = clean_format(symptom) %>% fct_inorder(),
    # 根据症状和严重程度设置颜色
    symptom_col = if_else(symptom == "Fit for duty", if_else(severity == 0, "grey35", "grey85"), pal[severity + 1]),
    treat_case = 2 - study_id %% 2) %>%     # 计算治疗案例
  rowwise() %>%   # 对每一行应用以下变换
  mutate(
    # 根据治疗案例计算 x 坐标
    x = case_when(
      treat_case == 1 ~ list(c(as.numeric(symptom), as.numeric(symptom) + 1, as.numeric(symptom))),
      treat_case == 2 ~ list(c(as.numeric(symptom), as.numeric(symptom) + 1, as.numeric(symptom) + 1))),
    # 根据治疗案例计算 y 坐标
    y = case_when(
      treat_case == 1 ~ list(c(as.numeric(treatment) + 1, as.numeric(treatment) + 1, as.numeric(treatment))),
      treat_case == 2 ~ list(c(as.numeric(treatment), as.numeric(treatment) + 1, as.numeric(treatment))))) %>% 
  ungroup() %>%    # 取消行级分组
  mutate(i = row_number())  # 为每一行添加一个行号

创建背景网格数据

rct <- expand.grid(x = 1:5 + 0.5, y = 1:6 + 0.5)

数据可视化

ggplot(scurvy_long %>% unnest(c(x, y))) +
  # 绘制多边形，填充颜色和边框颜色根据症状颜色设置
  geom_polygon(aes(x = x, y = y, fill = symptom_col, color = symptom_col, group = i)) +
  geom_text(aes(x = as.numeric(symptom) + 0.5, y = 0.5, label = str_wrap(symptom, 10)), stat = "unique") +
  geom_text(aes(x = 0.8, y = as.numeric(treatment) + 0.5, label = str_wrap(treatment, 10)), stat = "unique", hjust = 1) +
  # 添加背景网格
  geom_tile(data = rct, aes(x, y), fill = NA, color = "grey99", linewidth = 0.3) +
  scale_x_continuous(limits = c(0.3, 6)) +   # 设置 x 轴的范围
  scale_fill_identity() +   # 设置填充颜色和边框颜色
  scale_color_identity() +
  theme_void() +
  theme(
    plot.background = element_rect(fill = "grey99", color = NA),
    plot.margin = margin(10, 10, 10, 10))