再见R语言，AI搞定Nature子刊主图「a~h 8张图」，只用1分钟

pythonic生物人2026年09月11日约 4 分钟

使用R语言复现一下Nature aging中以下子图a~h 8张图，细节拉满，非常值得学习！

先理解一下图要表达的意思：

a～h图依次展示8个变量，即p16ink4a (a), Cdkn2a (b), Lgals3 (c), Cdkn1a/p21 (d), Ccl2 (e), Ccl5 (f), Apoe (g)和Gpr34 (h)在雌雄鼠的两个部位中的表达量差异。

以子图a为例，

以上直接将原图给到AI，让它描述即可，

再理解一下作者用什么样的图来展示：

用抖动散点图展示数据点
用颜色展示雌（粉色）雄（蓝色）个体
用虚线展示雌（粉色）雄（蓝色）个体
用标记展示小鼠中不同部分，圆圈（HIP部分），三角（FFCC部位）
同性别内，上侧展示不同部位之间统计p value
每个性别，添加误差棒（mean ± SD）
添加均值横线

还是以子图a为例，

同样，以上直接将原图给到AI，让它描述即可，

通过以上两步已经搞定图的含义+图的展现形式，然后让AI再次汇总回答，结合原图描述，使用R语言复现，

每次输出代码后，结合原图，让它调整，经过多轮交流，看一下最终效果图

代码学习：导入R package

library(ggplot2)
library(patchwork)
library(readxl)

设置颜色、导入数据

xlsx_file <- "r_data/s43587-026-01154-7_fig1.xlsx"
group_levels <- c("F:HIP", "F:FFCC", "M:HIP", "M:FFCC")
female_fill <- "#E98AA8"# 雌性填充色（粉）
male_fill   <- "#7EB6E0"# 雄性填充色（蓝）

数据转换为长数据

# ---- 转换为长表（每个观测一行） ----
  long <- do.call(rbind, lapply(group_levels, function(g)
    data.frame(
      group  = factor(g, levels = group_levels),                     # F:HIP, F:FFCC, M:HIP, M:FFCC
      sex    = factor(ifelse(startsWith(g, "F"), "Female", "Male"), c("Female", "Male")),
      region = factor(ifelse(grepl("HIP", g), "HIP", "FFCC"), c("HIP", "FFCC")),
      value  = as.numeric(raw[[g]]),
      stringsAsFactors = FALSE
    )
  ))
  long <- long[!is.na(long$value), ]  # 去除缺失值

数据作Welch双尾t检验、计算每组均值和标准差

# ---- 计算每组均值和标准差 ----
  sm <- aggregate(value ~ group + sex + region, long, function(x)
    c(mean = mean(x), sd = sd(x)))
  sm <- data.frame(
    group = sm$group, sex = sm$sex, region = sm$region,
    mean_y = sm$value[, "mean"], sd_y = sm$value[, "sd"]
  )

# ---- Welch双尾t检验（HIP vs FFCC，分雌雄） ----
  hip_f  <- long$value[long$sex == "Female" & long$region == "HIP"]
  ffcc_f <- long$value[long$sex == "Female" & long$region == "FFCC"]
  hip_m  <- long$value[long$sex == "Male"   & long$region == "HIP"]
  ffcc_m <- long$value[long$sex == "Male"   & long$region == "FFCC"]
  pf <- t.test(hip_f, ffcc_f, var.equal = FALSE)$p.value  # 雌性p值
  pm <- t.test(hip_m, ffcc_m, var.equal = FALSE)$p.value  # 雄性p值

雌雄分组虚线、误差棒、均值横线

ggplot(long, aes(group, value, fill = sex, shape = region)) +
# 雌雄分组虚线
    geom_vline(xintercept = 2.5, linetype = "dashed", colour = "#333", linewidth = 0.35) +
# 误差棒（mean ± SD）
    geom_linerange(
      data = sm, aes(x = group, ymin = pmax(0, mean_y - sd_y), ymax = mean_y + sd_y),
      inherit.aes = FALSE, linewidth = 0.45, colour = "#111"
    ) +
# 均值横线
    geom_crossbar(
      data = sm, aes(x = group, y = mean_y, ymin = mean_y, ymax = mean_y),
      inherit.aes = FALSE, width = 0.38, linewidth = 0.55, colour = "#111", middle.linewidth = 0.85
    )

抖动散点

# 散点（jitter避免重叠）
    geom_jitter(width = 0.12, height = 0, size = 2.1, stroke = 0.25, colour = "#333")

添加统计P value

if (pf < 0.05) {
    g <- g +
      annotate("segment", x = 1, xend = 2, y = ym * 1.02, yend = ym * 1.02, linewidth = 0.32) +
      annotate("text", x = 1.5, y = ym * 1.065, label = fmt(pf), size = 2.35)
  }
if (pm < 0.05) {
    g <- g +
      annotate("segment", x = 3, xend = 4, y = ym * 1.02, yend = ym * 1.02, linewidth = 0.32) +
      annotate("text", x = 3.5, y = ym * 1.065, label = fmt(pm), size = 2.35)
  }

设置坐标轴、线、刻度、颜色、字号等细节

# y轴范围与刻度
    scale_y_continuous(
      limits = c(0, ym * 1.16), breaks = p$y_breaks, expand = c(0, 0)
    ) +
    labs(x = NULL, y = p$y_label, title = p$letter) +
    theme_classic(base_family = "sans") +
    theme(
      plot.title = element_text(face = "bold", size = 12, hjust = 0),
      axis.title.y = element_text(size = 8),
      axis.text.y = element_text(size = 7),
      axis.text.x = element_text(size = 6.5, angle = 90, hjust = 1, vjust = 0.5)
    )