R实现主成分分析
如何使用prcomp()函数来做PCA
如何使用基础图形和ggplot2绘制PCA图
如何确定每个主成分占多少变动
如何检查载荷得分（Loading Scores），以确定哪些变量对图表有最大的影响。
构建数据集
首先，让我们生成一个可以在演示中使用的假数据集。
#我们将用10个样本制作一个数据矩阵，在每个样本中测量100个基因
data.matrix <- matrix(nrow=100, ncol=10)
#这是我们给样品命名的地方,前5个样品为“wt”或“野生型”样品,“wt”样本是正常的,最后5个样品为“ko”或"敲除"样品，样本为我们敲掉一个基因
colnames(data.matrix) <- c(
paste("wt",1:5,sep=""),
paste("ko",1:5,sep=""))
rownames(data.matrix) <- paste("gene", 1:100, sep="")
for (i in 1:100){
wt.values <- rpois(5, lambda = sample(x=10:1000, size=1))
ko.values <- rpois(5, lambda = sample(x=10:1000, size=1))
data.matrix[i,] <- c(wt.values, ko.values)
}
head(data.matrix)
prcomp()函数来做PCA
我们调用prcomp()对我们的数据进行PCA。我们的目标是绘制一个图表来显示样本之间是如何相互关联(或不关联)的。注意:默认情况下，prcomp()希望样本为行，基因为列。由于我们的数据矩阵中的样本是列，而基因是行，我们必须使用t()函数转置矩阵。如果我们不转置矩阵，我们最终会得到一张显示基因如何相互关联的图表。
prcomp()返回三个东西：
x
sdev
rotation
pca <- prcomp(t(data.matrix),scale=TRUE)
> str(pca)
List of 5
$ sdev : num [1:10] 9.53 1.55 1.23 1.22 1.09 ...
$ rotation: num [1:100, 1:10] -0.1043 -0.101 0.104 0.1049 -0.0778 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:100] "gene1" "gene2" "gene3" "gene4" ...
.. ..$ : chr [1:10] "PC1" "PC2" "PC3" "PC4" ...
$ center : Named num [1:100] 364 571 787 537 928 ...
..- attr(*, "names")= chr [1:100] "gene1" "gene2" "gene3" "gene4" ...
$ scale : Named num [1:100] 160.9 94.6 191.5 435.4 26 ...
..- attr(*, "names")= chr [1:100] "gene1" "gene2" "gene3" "gene4" ...
$ x : num [1:10, 1:10] -8.78 -9.32 -8.89 -8.99 -9.2 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:10] "wt1" "wt2" "wt3" "wt4" ...
.. ..$ : chr [1:10] "PC1" "PC2" "PC3" "PC4" ...
- attr(*, "class")= chr "prcomp"
>
x(主成分)
x包含绘制图形的主成分(PCs)。这里我们使用x的前两列来绘制二维图，使用前两个PC。第一个PC在原始数据(所有10个样本的基因表达)中占最多的变异，第二个PC占第二大变异，以此类推。为了绘制一个二维PCA图，我们通常使用前2个PCs。然而，有时我们使用PC2和PC3。
> pca$x
PC1 PC2 PC3 PC4 PC5 PC6 PC7
wt1 -8.600763 0.5663310 -1.94415011 0.5329527 -0.2864921 0.34663901 0.3980066
wt2 -9.287861 1.7650245 0.97270495 0.4696584 -1.3012428 -1.58284668 0.7760627
wt3 -8.863040 -1.2216062 -0.06383822 -2.1903326 -0.8216582 1.18701147 0.2993701
wt4 -9.529562 -2.0998590 0.25677668 0.7338328 2.1303556 -0.62431431 0.3974616
wt5 -8.672659 1.1320231 0.70013883 0.4119996 0.2611813 0.76023629 -1.9013924
ko1 9.195229 2.7372739 0.73373070 0.7371755 0.5822602 0.83186376 0.1686659
ko2 9.181781 1.1797157 -0.01108258 -1.6554134 1.0400690 -0.01517568 0.9489653
ko3 8.997543 -0.2811094 -2.87240846 -0.2775294 -0.1974510 -1.06628239 -0.9811960
ko4 8.844136 -2.0996810 0.02594496 1.8928868 -0.9383461 0.97168627 0.6576168
ko5 8.735196 -1.6781127 2.20218325 -0.6552303 -0.4686759 -0.80881775 -0.7635606
PC8 PC9 PC10
wt1 -0.2540217 -1.06789444 2.969847e-15
wt2 0.1956564 0.32497880 2.900458e-15
wt3 -0.4700103 0.42915382 2.053913e-15
wt4 -0.2629516 0.22498659 4.725387e-15
wt5 0.8012324 0.06610679 2.713108e-15
ko1 -1.0912341 0.22831819 1.991463e-15
ko2 1.0725213 -0.18244780 2.296774e-15
ko3 -0.1756349 0.42251257 1.804112e-15
ko4 0.6000006 0.20369403 3.018419e-15
ko5 -0.4155581 -0.64940855 2.726985e-15
## 我们使用x的前两列绘制一个二维图
plot(pca$x[,1],pca$x[,2])
Rplot.png
sdev（奇异值）
图的左边有五个样本，图的右边有五个样本，此时我们再看一下PC1占的总变异的比例，我们用sdev的平方(sdev为奇异值，特征值(SS)的平方根=sdev)，即标准差来计算每个主成分在原始数据中所占的变化量。因为每个PC所占的变异百分比比实际值更有意义，所以我们计算了这些百分比，并画出图。
pca.var <- pca$sdev^2
pca.var.per <- round(pca.var/sum(pca.var)*100,1)
barplot(pca.var.per,
main="Scree Plot",
xlab="Principal Component",
ylab="Percent Variation")
Rplot01.png
PC1几乎解释了所有的数据变异!这意味着左右两个样本类之间有很大的不同。我们可以使用ggplot2制作一个漂亮的PCA图，它看起来很漂亮，还为我们提供了大量的信息。首先，按照ggplot2喜欢的方式格式化数据，一个带有示例id的列。两列表示每个样本的X坐标和Y坐标。
library(ggplot2)
pca.data <- data.frame(Sample=rownames(pca$x),
X=pca$x[,1],
Y=pca$x[,2])
pca.data
> Sample X Y
wt1 wt1 -8.600763 0.5663310
wt2 wt2 -9.287861 1.7650245
wt3 wt3 -8.863040 -1.2216062
wt4 wt4 -9.529562 -2.0998590
wt5 wt5 -8.672659 1.1320231
ko1 ko1 9.195229 2.7372739
ko2 ko2 9.181781 1.1797157
ko3 ko3 8.997543 -0.2811094
ko4 ko4 8.844136 -2.0996810
ko5 ko5 8.735196 -1.6781127
ggplot2绘图
ggplot(data=pca.data, aes(x=X, y=Y, label=Sample))+
geom_text() +
xlab(paste("PC1 - ", pca.var.per[1], "%", sep=""))+
ylab(paste("PC2 - ", pca.var.per[2], "%", sep=""))+
theme_bw()+
ggtitle("My PCA Graph")
#然后我们使用geom_text告诉ggplot绘制标签，而不是点或其他形状
Rplot02.png
x轴告诉我们PC1占原始数据变异的百分比。y轴告诉我们PC2占原始数据变异的百分比。
rotation
最后，让我们看看如何使用载荷得分（Loading Scores）来确定哪些基因对样本在PCA图中的位置有最大的影响。rotation,对每个PC有载荷得分（Loading Scores）。在这里，我将查看PC1的载荷得分，因为它占数据变异的92%。将样本推到图表左侧的基因会有很大的负值，而将样本推到右侧的基因会有很大的正值。由于我们对这两组基因都感兴趣，所以我们将使用abs()根据绝对值进行排序。
loading_score <- pca$rotation[,1]
gene_scores <- abs(loading_score)
gene_score_ranked <- sort(gene_scores, decreasing = TRUE)
top_10_genes <- names(gene_score_ranked[1:10])
top_10_genes
> [1] "gene77" "gene96" "gene73" "gene7" "gene98" "gene43" "gene25" "gene4" "gene91" "gene46"
#最后，我们看一下这些基因的loading score的数值
pca$rotation[top_10_genes,1]
> gene77 gene96 gene73 gene7 gene98 gene43 gene25
-0.1054378 0.1054265 0.1053676 -0.1053548 0.1053443 -0.1053442 0.1053430
gene4 gene91 gene46
-0.1053310 0.1053132 0.1053060