如何绘制数据框的行（基因）相关性及显著性可视化图？

一、已有基础数据与计算结果 #

你已经完成了以下预处理步骤：

1. 构建了包含基因表达数据的示例数据框mat2
2. 通过Hmisc::rcorr计算得到基因间的Pearson相关系数和p值，整理为长格式的cor_matrix（包含基因对、相关系数、p值）
3. 计算了每个基因的行中位数medRNA，用于Y轴定位

对应的预处理代码如下：

# 构建示例数据框
nr1 = 4; nr2 = 8; nr3 = 6; nr = nr1 + nr2 + nr3
nc1 = 4; nc2 = 6; nc3 = 4; nc = nc1 + nc2 + nc3
mat2 = cbind(rbind(matrix(rnorm(nr1*nc1, mean = 1,   sd = 1.5), nr = nr1),
                   matrix(rnorm(nr2*nc1, mean = 0,   sd = 0.5), nr = nr2),
                   matrix(rnorm(nr3*nc1, mean = 0,   sd = 1.5), nr = nr3)),
             rbind(matrix(rnorm(nr1*nc2, mean = 0,   sd = 0.5), nr = nr1),
                   matrix(rnorm(nr2*nc2, mean = 1,   sd = 0.5), nr = nr2),
                   matrix(rnorm(nr3*nc2, mean = 0,   sd = 0.5), nr = nr3)),
             rbind(matrix(rnorm(nr1*nc3, mean = 0.5, sd = 2.5), nr = nr1),
                   matrix(rnorm(nr2*nc3, mean = 0.5, sd = 0.5), nr = nr2),
                   matrix(rnorm(nr3*nc3, mean = 1,   sd = 0.5), nr = nr3))
)
mat2 = mat2[sample(nr, nr), sample(nc, nc)] # 随机打乱行和列
rownames(mat2) = paste0("row", seq_len(nr))
colnames(mat2) = paste0("column", seq_len(nc))
mat2 =  as.data.frame((mat2)) %>% rownames_to_column('gene')

# 计算基因间相关系数与p值
library(tidyr)
library(dplyr)
df_transpose <- mat2 %>% 
  gather(variable, value, -gene) %>% 
  spread(gene, value) %>% 
  select(-variable)

flattenCorrMatrix <- function(cormat, pmat) {
  ut <- upper.tri(cormat)
  data.frame(
    row = rownames(cormat)[row(cormat)[ut]],
    column = rownames(cormat)[col(cormat)[ut]],
    cor  =(cormat)[ut],
    p = pmat[ut]
  )
}

library(Hmisc)
res <- rcorr(as.matrix(df_transpose))
cor_matrix <- flattenCorrMatrix(res$r, res$P)

# 计算行中位数
library(matrixStats)
medRNA <- rowMedians(as.matrix(mat2[-c(1)]))

二、可视化实现方法 #

根据常见的文献相关性可视化风格，提供两种复刻方案：

方案1：散点式相关性-中位数关联图 #

适合展示基因对的相关系数与基因中位数的关系，同时标记显著性：

# 1. 关联中位数到基因对数据
med_df <- data.frame(gene = mat2$gene, med = medRNA)
cor_matrix <- cor_matrix %>%
  left_join(med_df, by = c("row" = "gene")) %>%
  rename(med_row = med) %>%
  left_join(med_df, by = c("column" = "gene")) %>%
  rename(med_col = med) %>%
  # 定义显著性标记
  mutate(sig = case_when(
    p < 0.001 ~ "***",
    p < 0.01 ~ "**",
    p < 0.05 ~ "*",
    TRUE ~ "ns"
  ))

# 2. 绘制散点图
library(ggplot2)
ggplot(cor_matrix, aes(x = cor, y = (med_row + med_col)/2, color = sig, size = abs(cor))) +
  geom_point(alpha = 0.7) +
  # 自定义显著性配色
  scale_color_manual(values = c("***" = "#cc0000", "**" = "#ff9900", "*" = "#0066cc", "ns" = "#999999")) +
  scale_size_continuous(range = c(1, 5)) +
  labs(x = "Pearson相关系数", y = "基因对中位数均值", color = "显著性", size = "相关系数绝对值") +
  theme_bw() +
  ggtitle("基因间相关性与表达中位数关联") +
  theme(plot.title = element_text(hjust = 0.5))

方案2：按中位数排序的相关性热图 #

适合展示基因间的相关性整体分布，同时标记显著性，且按基因中位数排序：

# 1. 按中位数对基因排序
sorted_genes <- med_df %>% arrange(med) %>% pull(gene)

# 2. 将相关系数和p值转换为宽格式并按排序后的基因排列
cor_wide <- cor_matrix %>%
  select(row, column, cor) %>%
  pivot_wider(names_from = column, values_from = cor) %>%
  column_to_rownames("row") %>%
  select(sorted_genes) %>%
  rownames_to_column("row") %>%
  filter(row %in% sorted_genes) %>%
  arrange(match(row, sorted_genes)) %>%
  column_to_rownames("row")

p_wide <- cor_matrix %>%
  select(row, column, p) %>%
  pivot_wider(names_from = column, values_from = p) %>%
  column_to_rownames("row") %>%
  select(sorted_genes) %>%
  rownames_to_column("row") %>%
  filter(row %in% sorted_genes) %>%
  arrange(match(row, sorted_genes)) %>%
  column_to_rownames("row")

# 3. 构建显著性标记矩阵（仅上三角）
sig_mat <- matrix("", nrow = nrow(cor_wide), ncol = ncol(cor_wide))
sig_mat[upper.tri(sig_mat)] <- case_when(
  p_wide[upper.tri(p_wide)] < 0.001 ~ "***",
  p_wide[upper.tri(p_wide)] < 0.01 ~ "**",
  p_wide[upper.tri(p_wide)] < 0.05 ~ "*",
  TRUE ~ ""
)

# 4. 绘制热图
library(pheatmap)
pheatmap(cor_wide,
         cluster_rows = FALSE, cluster_cols = FALSE, # 禁用聚类，按中位数排序
         upper.tri = TRUE, lower.tri = FALSE, # 仅展示上三角
         cellwidth = 15, cellheight = 15,
         # 添加中位数注释到行
         annotation_row = med_df %>% arrange(match(gene, sorted_genes)) %>% column_to_rownames("gene"),
         color = colorRampPalette(c("#3366ff", "#ffffff", "#cc0000"))(100), # 正负相关配色
         display_numbers = sig_mat, # 显示显著性标记
         number_color = "black",
         main = "基因间相关性热图（按表达中位数排序）"
)

三、优化建议 #

• 若文献有特定配色，可修改scale_color_manual（散点图）或color参数（热图）适配
• 若需展示基因分组（如你构建数据时的nr1/nr2/nr3组），可添加分组注释到热图的annotation_row/annotation_col
• 散点图可添加拟合线：geom_smooth(method = "lm", color = "black", se = FALSE)，展示整体趋势
• 数据量大时，散点图用geom_jitter(width = 0.02)避免点重叠，或降低alpha值提升可读性

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