R语言实现群体遗传PCA分析与可视化实战-代码聚汇网

R语言实现群体遗传PCA分析与可视化实战

夏朱

1. 群体PCA分析及可视化实战指南

在生物信息学和群体遗传学研究中，PCA（主成分分析）是最常用的降维和可视化技术之一。通过将高维基因型数据投影到二维空间，我们可以直观地观察样本间的遗传关系和群体结构。本文将基于R语言生态，详细解析从原始基因型数据到精美PCA可视化图的完整流程。

2. 数据准备与预处理

2.1 输入文件格式解析

群体PCA分析通常需要两种核心输入文件：

基因型数据文件（如HapMap格式的.hmp.txt）：
- 每行代表一个SNP标记
- 每列代表一个样本的基因型（AA, TT, AT等）
- 包含染色体、位置等元信息
分组信息文件（group.txt）：
- 第一列为样本ID，需与基因型文件匹配
- 第二列为预先定义的群体分组
- 支持多个分组级别（如地理群体、表型分组等）

关键提示：确保两个文件的样本ID完全一致，否则后续分析会出现样本丢失。建议在R中使用intersect()函数检查ID匹配情况。

2.2 数据格式转换实战

HapMap格式的基因型需要转换为数值矩阵才能进行PCA计算。GAPIT包的转换过程实际上执行了以下操作：

r复制# 等效的手动转换逻辑（理解原理用）
hmp_num <- apply(hmp[, -c(1:11)], 2, function(x){
  as.numeric(factor(x, levels = c("AA","TT","CC","GG","AT","AC","AG","CT","CG","TG")))
})
rownames(hmp_num) <- hmp[, 1]

实际项目中更推荐使用GAPIT进行专业转换，因为它能：

自动处理缺失基因型
提供更完善的等位基因编码方案
保留完整的样本和标记信息

3. PCA计算与结果解析

3.1 核心计算过程

prcomp()函数执行的是基于奇异值分解（SVD）的PCA计算，其数学本质是：

中心化数据：每列减去均值（center=TRUE）
标准化：每列除以标准差（scale.=FALSE时不做）
计算协方差矩阵
特征值分解得到主成分

r复制# 完整参数设置建议
pca_data <- prcomp(hmp_num[row.names(group), ], 
                  center = TRUE,
                  scale. = FALSE)

经验之谈：对于基因型数据，通常不需要标准化（scale.=FALSE），因为所有SNP已经处于相同尺度（0,1,2）。但对于表达量等连续型数据，建议开启标准化。

3.2 结果对象解读

prcomp返回的对象包含多个关键元素：

r复制str(pca_data)
## List of 5
##  $ sdev    : num [1:10] 15.8 14.2 13.5 ...
##  $ rotation: num [1:10000, 1:10] -0.00504 -0.00392 ...
##  $ center  : Named num [1:10000] 1.12 1.08 ...
##  $ scale   : Named num [1:10000] 0.325 0.272 ...
##  $ x       : num [1:200, 1:10] -5.68 12.31 ...

sdev：各主成分的标准差（用于计算方差贡献率）
rotation：特征向量（标记的载荷量）
x：样本在主成分空间的坐标（用于绘图）

4. 高级可视化技巧

4.1 ggbiplot核心参数解析

示例代码中的ggbiplot调用包含多个关键可视化参数：

r复制p <- ggbiplot(pca_data,
         var.axes = FALSE,    # 不显示变量箭头
         groups = group[,1],  # 分组颜色
         obs.scale = 1,       # 样本点缩放因子
         ellipse = TRUE,      # 绘制置信椭圆
         circle = TRUE,       # 添加相关圈
         ellipse.prob = 0.95, # 椭圆置信水平
         ellipse.alpha = 0.2) # 椭圆透明度

4.2 颜色主题定制进阶

除了基本的scale_color_manual，还可以：

使用RColorBrewer调色板：

r复制library(RColorBrewer)
p + scale_color_brewer(palette = "Set2")

按分组自动分配颜色：

r复制p + scale_color_discrete(name = "Population")

添加透明度增强重叠点识别：

r复制p + geom_point(aes(color = groups), alpha = 0.6, size = 3)

4.3 图形元素增强

专业论文级PCA图通常需要：

添加方差解释率标签：

r复制variance <- pca_data$sdev^2 / sum(pca_data$sdev^2)
p + xlab(paste0("PC1 (", round(variance[1]*100,1), "%)")) +
    ylab(paste0("PC2 (", round(variance[2]*100,1), "%)"))

突出关键标记：

r复制top_markers <- head(order(-abs(pca_data$rotation[,1])), 10)
p + geom_segment(
  data = as.data.frame(pca_data$rotation[top_markers, 1:2]),
  aes(xend = PC1*3, yend = PC2*3),
  arrow = arrow(length = unit(0.2, "cm"))
)

5. 实战问题排查指南

5.1 常见报错与解决

样本不匹配错误：

r复制Error in hmp_num[row.names(group), ] : 下标越界

解决方案：

r复制common_samples <- intersect(rownames(hmp_num), rownames(group))
hmp_num <- hmp_num[common_samples, ]
group <- group[common_samples, , drop = FALSE]

GAPIT转换失败：
确保输入文件：
- 不含特殊字符
- 表头格式正确
- 无全缺失的SNP

5.2 可视化优化技巧

样本点重叠严重时：

r复制p + geom_point(position = position_jitter(width = 0.2, height = 0.2))

群体区分不明显时：
- 尝试PC3 vs PC4组合
- 检查是否应该调整分组方案
- 考虑使用t-SNE等非线性方法

图形导出建议：

r复制ggsave("PCA_plot.pdf", width = 8, height = 6, dpi = 300)

6. 扩展应用场景

6.1 群体遗传距离计算

基于PCA结果可计算群体间距离：

r复制library(ape)
pca_dist <- dist(pca_data$x[,1:3])
hc <- hclust(pca_dist)
plot(hc, hang = -1)

6.2 混合群体检测

通过k-means聚类识别潜在混合个体：

r复制set.seed(123)
kmeans_res <- kmeans(pca_data$x[,1:2], centers = 3)
plot(pca_data$x[,1:2], col = kmeans_res$cluster)

6.3 全基因组关联分析

PCA结果可作为协变量：

r复制pcs <- pca_data$x[,1:3]
colnames(pcs) <- c("PC1", "PC2", "PC3")
write.table(pcs, "pca_covariates.txt", quote = F)

7. 性能优化建议

7.1 大数据集处理

对于超过10,000个样本的数据：

使用随机PCA算法：

r复制library(rsvd)
pca_data <- rpca(hmp_num, k = 10)

分染色体计算后合并

7.2 并行计算加速

r复制library(foreach)
library(doParallel)
registerDoParallel(cores = 4)
pca_list <- foreach(chr = 1:12) %dopar% {
  prcomp(hmp_num[, grep(paste0("^", chr, "_"), colnames(hmp_num))])
}

8. 完整代码整合

最终优化后的完整分析流程：

r复制library(tidyverse)
library(PCAtools)
library(ggbiplot)

# 1. 数据加载
hmp <- read.delim("my.hmp.txt", header = FALSE)
group <- read.delim("group.txt", header = TRUE, row.names = 1) %>%
  na.omit()

# 2. 格式转换
hmp_gapit <- GAPIT::GAPIT(G = hmp, output.numerical = FALSE, file.output = FALSE)
hmp_num <- data.frame(hmp_gapit$GD, row.names = 1)

# 3. 样本匹配
common_samples <- intersect(rownames(hmp_num), rownames(group))
hmp_num <- hmp_num[common_samples, ]
group <- group[common_samples, , drop = FALSE]

# 4. PCA计算
pca_data <- prcomp(hmp_num, center = TRUE, scale. = FALSE)

# 5. 可视化
variance <- pca_data$sdev^2 / sum(pca_data$sdev^2)
ggbiplot(pca_data, var.axes = FALSE, groups = group[,1],
         ellipse = TRUE, circle = TRUE) +
  xlab(paste0("PC1 (", round(variance[1]*100,1), "%)")) +
  ylab(paste0("PC2 (", round(variance[2]*100,1), "%)")) +
  theme_minimal(base_size = 14) +
  scale_color_brewer(palette = "Set1", name = "Population") +
  geom_point(aes(color = group[,1]), size = 3, alpha = 0.7)

9. 项目经验总结

在实际应用中，我发现以下几个要点对获得理想的PCA结果至关重要：

数据质量检查：分析前务必检查缺失率，建议过滤掉缺失率>10%的SNP和样本。可以使用colMeans(is.na(hmp_num))快速检查。
主成分数选择：通常前3-5个PC足够揭示主要群体结构。可以通过碎石图（plot(pca_data$sdev^2, type="b")）辅助判断。
群体标签验证：当发现某些样本明显偏离其预设群体时，应该检查是否样本标签错误或存在污染。我曾通过这种方式发现过实验室样本混淆的情况。
批次效应处理：如果样本分多批次测序，建议在PCA前使用ComBat等方法校正批次效应，否则批次可能成为PC1的主要变异来源。
交互式探索：对于大型项目，建议使用plotly创建交互式PCA图，便于检查每个离群点的属性：

r复制library(plotly)
plot_ly(x = pca_data$x[,1], y = pca_data$x[,2], 
        color = group[,1], text = rownames(pca_data$x))