欢迎关注R语言数据分析指南
❝本节通过一个案例来介绍如何绘制多边形热图，整个过程仅参考。希望对各位观众老爷能有所帮助。「数据代码已经整合上传到2023VIP交流群」，加群的观众老爷可自行下载，有需要的朋友可关注文末介绍加入VIP交流群。 给予长期支持我们的忠实读者们一个特别待遇：凡是购买过小编2022年或2023年VIP会员文档的朋友们，将自动获得2024年及以后更新的绘图文档代码，无需额外付费。目前这两年的会员文档已累记卖出1500 ，质量方面各位无需担忧。简要概括就是只要购买任意1年的会员内容，2024及后期公众号所更新的绘图文档均会在已经加入的会员群内分享。 ❞
加载R包
代码语言：javascript复制library(tidyverse)
library(camcorder)
library(RColorBrewer)
导入数据
代码语言：javascript复制scurvy <- read_csv('scurvy.csv')
pal <- RColorBrewer::brewer.pal(name = "Paired", n = 4)
定义函数
代码语言：javascript复制# 格式处理
clean_format <- function(column) {
column %>%
str_to_sentence() %>%
str_remove("_d6") %>%
str_replace_all("_", " ")
}
数据清洗
代码语言：javascript复制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()) # 为每一行添加一个行号
创建背景网格数据
代码语言：javascript复制rct <- expand.grid(x = 1:5 0.5, y = 1:6 0.5)
数据可视化
代码语言：javascript复制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))
