如何在ggplot2中为每个变量创建独立Y轴并可视化均值与标准差

需要绘制一款类似平行坐标图的描述统计图表，按性别分层展示各变量的均值及标准差，但无法实现为每个变量创建独立Y轴的效果，现有数据及代码如下：

library(dplyr)
library(tidyr)
library(ggplot2)

my_data <- data.frame(
  sex = c("m", "w", "m", "w", "m", "w"),
  age = c(25, 30, 22, 35, 28, 46),
  testosterone = c(450, 200, 400, 300, 500, 350),
  cognition = c(75, 80, 70, 85, 78, 90),
  estrogen = c(20, 40, 15, 50, 10, 45)
)

numeric_vars <- c("age", "testosterone", "cognition", "estrogen")

# 计算各性别下各变量的均值及标准差
df_means <- my_data %>%
  group_by(sex) %>%
  summarise(across(all_of(numeric_vars), mean, na.rm = TRUE))

df_sds <- my_data %>%
  group_by(sex) %>%
  summarise(across(all_of(numeric_vars), sd, na.rm = TRUE))

# 重塑数据格式
df_melted <- reshape2::melt(df_means, id.vars = 'sex')
df_sds_melted <- reshape2::melt(df_sds, id.vars = 'sex')

# 合并均值和标准差数据
df_combined <- merge(df_melted, df_sds_melted, by = c('sex', 'variable'))
names(df_combined)[names(df_combined) == 'value.x'] <- 'mean'
names(df_combined)[names(df_combined) == 'value.y'] <- 'sd'

# 绘制未标准化的平行坐标图
ggplot(df_combined, aes(x = variable, y = mean, group = sex, color = sex)) +
  geom_line() +
  geom_ribbon(aes(ymin = mean - sd, ymax = mean + sd, fill = sex), alpha = 0.2) +
  scale_color_manual(values = c("m" = "#007BC3", "w" = "#EA5451")) +
  scale_fill_manual(values = c("m" = "#007BC3", "w" = "#EA5451")) +
  theme_minimal() 

ggplot本身不推荐使用多独立Y轴（易造成视觉误导），但可以通过以下两种方式满足需求：

方式1：分面展示（推荐） #

将每个变量拆分为独立面板，每个面板自带独立Y轴，同时保留性别分组的均值线和标准差区间，视觉清晰且无误导性：

library(dplyr)
library(tidyr)
library(ggplot2)

my_data <- data.frame(
  sex = c("m", "w", "m", "w", "m", "w"),
  age = c(25, 30, 22, 35, 28, 46),
  testosterone = c(450, 200, 400, 300, 500, 350),
  cognition = c(75, 80, 70, 85, 78, 90),
  estrogen = c(20, 40, 15, 50, 10, 45)
)

numeric_vars <- c("age", "testosterone", "cognition", "estrogen")

# 一步计算均值、标准差并整理数据格式
df_combined <- my_data %>%
  group_by(sex) %>%
  summarise(across(all_of(numeric_vars), list(mean = mean, sd = sd), na.rm = TRUE)) %>%
  pivot_longer(-sex, names_to = c("variable", ".value"), names_sep = "_")

# 分面绘制，每个变量使用独立Y轴
ggplot(df_combined, aes(x = sex, y = mean, color = sex)) +
  geom_line(aes(group = sex), linewidth = 1, position = position_dodge(0.2)) +
  geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = 0.2, position = position_dodge(0.2)) +
  facet_wrap(~variable, scales = "free_y") +
  scale_color_manual(values = c("m" = "#007BC3", "w" = "#EA5451")) +
  theme_minimal() +
  labs(y = "均值（±标准差）")

方式2：同一画布添加多Y轴（不推荐） #

如果坚持要在同一图中展示所有变量和多Y轴，需要先将变量标准化到同一区间，再手动添加每个变量的原始刻度，代码如下：

library(dplyr)
library(tidyr)
library(ggplot2)
library(grid)

my_data <- data.frame(
  sex = c("m", "w", "m", "w", "m", "w"),
  age = c(25, 30, 22, 35, 28, 46),
  testosterone = c(450, 200, 400, 300, 500, 350),
  cognition = c(75, 80, 70, 85, 78, 90),
  estrogen = c(20, 40, 15, 50, 10, 45)
)

numeric_vars <- c("age", "testosterone", "cognition", "estrogen")

# 计算均值、标准差并整理数据
df_combined <- my_data %>%
  group_by(sex) %>%
  summarise(across(all_of(numeric_vars), list(mean = mean, sd = sd), na.rm = TRUE)) %>%
  pivot_longer(-sex, names_to = c("variable", ".value"), names_sep = "_")

# 为每个变量分配X轴位置
x_pos <- setNames(1:4, numeric_vars)
df_combined$x <- x_pos[df_combined$variable]

# 将每个变量的均值和标准差标准化到0-1区间
scale_func <- function(x) (x - min(x)) / (max(x) - min(x))
df_scaled <- df_combined %>%
  group_by(variable) %>%
  mutate(mean_scaled = scale_func(mean),
         sd_scaled = sd / (max(mean) - min(mean)))

# 绘制主图（标准化后的数据）
p <- ggplot(df_scaled, aes(x = x, y = mean_scaled, group = sex, color = sex)) +
  geom_line(linewidth = 1) +
  geom_ribbon(aes(ymin = mean_scaled - sd_scaled, ymax = mean_scaled + sd_scaled, fill = sex), alpha = 0.2) +
  scale_x_continuous(breaks = x_pos, labels = names(x_pos)) +
  scale_color_manual(values = c("m" = "#007BC3", "w" = "#EA5451")) +
  scale_fill_manual(values = c("m" = "#007BC3", "w" = "#EA5451")) +
  theme_minimal() +
  theme(axis.title.y = element_blank())

# 为每个变量添加独立Y轴
for(var in numeric_vars){
  var_data <- df_combined %>% filter(variable == var)
  y_min <- min(var_data$mean - var_data$sd)
  y_max <- max(var_data$mean + var_data$sd)
  
  # 添加变量名称标注
  p <- p + annotation_custom(
    textGrob(var, rot = 90, gp = gpar(fontsize = 10)),
    xmin = x_pos[var], xmax = x_pos[var],
    ymin = -0.1, ymax = -0.1
  )
  
  # 添加对应Y轴刻度
  p <- p + scale_y_continuous(
    sec.axis = sec_axis(
      trans = ~ .*(y_max - y_min) + y_min,
      breaks = seq(floor(y_min), ceiling(y_max), length.out = 3),
      labels = function(x) round(x, 1)
    )
  )
}

# 调整右侧Y轴文字大小
p + theme(axis.text.y.right = element_text(size = 8))

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