复现Nature图，换数据可用！

pythonic生物人2026年05月22日约 3 分钟

本次使用R语言复现Nature正刊上的Fig.3a图，

复现效果图，

这张图一次性展示一组连续变量之间的线性相关强度、联合分布形态，由三部分构成：

上三角，显示Spearman相关系数，颜色越深越接近 1，越浅接近0。
下三角，显示二维密度等高线图，反映变量的联合分布。
对角线，是变量名（sp4+、spd3+、CoH3+、PEG、Ca2+、HP1α、HP1β）。

R实现

读入数据

右上角，Spearman相关系数热图

upper_fn <- function(data, mapping, ...) {

  x <- eval_data_col(data, mapping$x)
  y <- eval_data_col(data, mapping$y)

# 计算Spearman相关系数
  r <- cor(x, y, method = "spearman")

# 根据相关系数大小决定文字颜色（低相关用白色，高相关用黑色）
  label_col <- ifelse(r < 0.35, "white", "black")

# 热图
  ggplot(data.frame(x = 1, y = 1, r = r), aes(x, y)) +

# 画方块
    geom_tile(
      aes(fill = r),
      colour = "#4d4d4d",   # 方格边框颜色
      linewidth = 0.7
    ) +

# 添加相关系数文本
    geom_text(
      aes(label = sub("0+$", "", sub("\\.$", "", sprintf("%.2f", r)))),
      size = 7,
      colour = label_col,
      family = "Arial"
    ) +

# 自定义渐变颜色
    scale_fill_gradientn(
      colours = c(
"#0b32ff", "#3f8cff", "#9be37d",
"#f2e84a", "#f28e2b", "#e31a1c"
      ),
      limits = c(0.1, 0.8),
      oob = squish   # 超出范围的值压缩到边界
    ) +

    coord_fixed() +  # 保持正方形

    theme_void() +   # 去除所有背景元素

    theme(
      legend.position = "none",   # 不显示图例
      plot.margin = margin(1, 1, 1, 1)
    )
}

左下角：二维密度散点图

lower_fn <- function(data, mapping, ...) {

  ggplot(data, mapping) +

# 等高线填充的密度图
    stat_density_2d(
      aes(fill = after_stat(level)),
      geom = "polygon",
      contour = TRUE,
      n = 300,
      bins = 8,
      alpha = 1
    ) +

# 自定义密度颜色
    scale_fill_gradientn(
      colours = c(
"#d9f0f3", "#7fcdbb", "#41b6c4",
"#f0e442", "#e31a1c"
      )
    ) +

    theme_bw() +

    theme(
      axis.text = element_text(size = 7, colour = "black"),
      axis.title = element_blank(),
      axis.ticks = element_line(linewidth = 0.3, colour = "black"),
      axis.line = element_line(linewidth = 0.3, colour = "black"),
      panel.grid = element_blank(),
      panel.border = element_rect(
        colour = "#4d4d4d",
        fill = NA,
        linewidth = 0.6
      ),
      panel.background = element_rect(fill = "white"),
      legend.position = "none"
    )
}

对角线，变量名称

diag_fn <- function(data, mapping, ...) {

  ggplot() +

# 在对角格中标注变量名
    annotate(
"text",
      x = 0.5,
      y = 0.5,
      label = mapping$x,
      size = 6,
      family = "Arial"
    ) +

    theme_void()
}

上中下三部分拼接

p <- ggpairs(
  df,
  lower = list(continuous = lower_fn),  # 左下角
  upper = list(continuous = upper_fn),  # 右上角
  diag  = list(continuous = diag_fn)    # 对角线
)