如何修改R语言humapr包热力图标签为year变量的两位小数数值？

问题说明 #

使用R语言的humapr包绘制人体热力图时，希望将默认显示的频率标签（如0、1及异常百分号）替换为year变量的数值，且保留两位小数，但设置stat = "identity"参数未达到预期效果。

原代码 #

library(tidyverse)
library(humapr)
set.seed(1)
body_data <- data.frame(
  loc = rep(c(
    "Upper extremities", "Lower extremities","Trunk", "Head & neck"
  ), times = 2),
  side = rep(c("left", "right"), each = 4),
  gender = rep(c("male", "female"), each = 4),
  year = runif(8)
)
humap() +
  geom_body(aes(loc = loc, side = side, fill = year ), annotate = "all",
            data = body_data, combine =
              list(
                `Upper extremities` = c("arm", "forearm", "hand"),
                `Lower extremities` = c("thigh", "leg", "foot"),
                `Trunk` = c("abdomen", "chest"),
                `Head & neck` = c("head", "neck")
              ), stat = "identity"
  ) 

当前热力图标签显示的是默认频率值，而非自定义的year变量数值。

解决方案 #

humapr的geom_body函数在annotate="all"时，会强制使用统计后的频率值作为标签，即使设置stat="identity"也无法覆盖。要实现自定义标签，需要手动关闭默认标注，通过geom_text添加格式化后的year值：

修改后代码 #

library(tidyverse)
library(humapr)
set.seed(1)

# 原数据集
body_data <- data.frame(
  loc = rep(c(
    "Upper extremities", "Lower extremities","Trunk", "Head & neck"
  ), times = 2),
  side = rep(c("left", "right"), each = 4),
  gender = rep(c("male", "female"), each = 4),
  year = runif(8)
)

# 构建大部位到小部位的映射关系
combine_map <- tibble(
  loc = rep(names(list(
    `Upper extremities` = c("arm", "forearm", "hand"),
    `Lower extremities` = c("thigh", "leg", "foot"),
    `Trunk` = c("abdomen", "chest"),
    `Head & neck` = c("head", "neck")
  )), sapply(list(
    `Upper extremities` = c("arm", "forearm", "hand"),
    `Lower extremities` = c("thigh", "leg", "foot"),
    `Trunk` = c("abdomen", "chest"),
    `Head & neck` = c("head", "neck")
  ), length)),
  sub_loc = unlist(list(
    `Upper extremities` = c("arm", "forearm", "hand"),
    `Lower extremities` = c("thigh", "leg", "foot"),
    `Trunk` = c("abdomen", "chest"),
    `Head & neck` = c("head", "neck")
  ))
)

# 合并数据，匹配每个小部位的坐标和year值
label_data <- body_data %>%
  left_join(combine_map, by = "loc") %>%
  left_join(humapr:::body_parts, by = c("sub_loc" = "part", "side" = "side"))

# 绘制热力图并添加自定义标签
humap() +
  geom_body(aes(loc = loc, side = side, fill = year ), annotate = "none",
            data = body_data, combine =
              list(
                `Upper extremities` = c("arm", "forearm", "hand"),
                `Lower extremities` = c("thigh", "leg", "foot"),
                `Trunk` = c("abdomen", "chest"),
                `Head & neck` = c("head", "neck")
              ), stat = "identity"
  ) +
  geom_text(data = label_data, aes(x = x, y = y, label = sprintf("%.2f", year)),
            color = "black", size = 3)

关键步骤说明 #

1. 关闭默认标注：将geom_body的annotate参数设为"none"，避免默认频率标签干扰。
2. 匹配部位坐标：通过humapr:::body_parts获取包内部的身体部位坐标数据，确保标签能精准对应到每个小部位。
3. 格式化标签文本：用sprintf("%.2f", year)将year值格式化为两位小数，通过geom_text添加到图中。

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