前面已经介绍了主成分分析的内容，并使用Python和R语言进行了演示。主成分分析里面很重要的一个作用，高维数据降维后的可视化，之前只是简单的讲了一下，这一篇就专门针对主成分分析的可视化来进行详细的介绍。

主成分分析（PCA）使我们能够对包含由多个相互关联的定量变量描述的个体/观测数据集中的信息进行总结和可视化。每个变量都可以被视为不同的维度。如果数据集中有3个以上的变量，那么就很难将多维超空间可视化。 主成分分析用于从多元数据表中提取重要信息，并将这些信息表示为一组称为主成分的少数新变量。这些新变量与原始变量的线性组合相对应。主成分的数量小于或等于原始变量的数量。 PCA的目标是找出数据变化最大的方向（或主成分）， PCA将多元数据的维度降低到两个或三个主成分，可以用图形直观地显示出来，同时将信息损失降到最低。

【案例演示】

数据是 使用的数据描述了运动员在两项体育赛事（十项全能和奥运会）中的表现。其中包含由 13 个变量描述的 27 个个体（运动员）。

我们首先读入数据，并对活跃个体和活跃变量进行分组，以便进行主成分分析↓

library("FactoMineR")library("factoextra")df <- read.delim("clipboard")# 将第一列作为索引row.names(df) <- df$姓名df <- df[, -1]  #删除第一列df.active <- df[1:23, 1:10]head(df.active[, 1:6], 4)

> head(df.active[, 1:6], 4)
        跑步100米 跳远  铅球 跳高 跑步400米 跨栏110米
SEBRLE      11.04 7.58 14.83 2.07     49.81     14.69
CLAY        10.76 7.40 14.26 1.86     49.37     14.05
BERNARD     11.02 7.23 14.25 1.92     48.93     14.99
YURKOV      11.34 7.09 15.19 2.10     50.42     15.31

【 主成分分析 】

下面的R代码对数据主成分分析，函数PCA()的输出是一个列表，包括以下组件↓

res.pca <- PCA(df.active, graph = TRUE)print(res.pca)

The analysis was performed on 23 individuals, described by 10 variables
*The results are available in the following objects:

   name               description                          
1  "$eig"             "eigenvalues"                        
2  "$var"             "results for the variables"          
3  "$var$coord"       "coord. for the variables"           
4  "$var$cor"         "correlations variables - dimensions"
5  "$var$cos2"        "cos2 for the variables"             
6  "$var$contrib"     "contributions of the variables"     
7  "$ind"             "results for the individuals"        
8  "$ind$coord"       "coord. for the individuals"         
9  "$ind$cos2"        "cos2 for the individuals"           
10 "$ind$contrib"     "contributions of the individuals"   
11 "$call"            "summary statistics"                 
12 "$call$centre"     "mean of the variables"              
13 "$call$ecart.type" "standard error of the variables"    
14 "$call$row.w"      "weights for the individuals"        
15 "$call$col.w"      "weights for the variables"

特征值和方差，特征值测量每个主成分保留的变异量。对于前几个主成分，特征值较大，对于后续的主成分，特征值较小。也就是说，前几个主成分对应于数据集中变异量最大的方向。我们检查特征值以确定应考虑的主成分数量。可以使用函数 get_eigenvalue()提取主成分保留的特征值和方差比例↓

eig.val <- get_eigenvalue(res.pca)eig.val

> eig.val
       eigenvalue variance.percent cumulative.variance.percent
Dim.1   4.1242133        41.242133                    41.24213
Dim.2   1.8385309        18.385309                    59.62744
Dim.3   1.2391403        12.391403                    72.01885
Dim.4   0.8194402         8.194402                    80.21325
Dim.5   0.7015528         7.015528                    87.22878
Dim.6   0.4228828         4.228828                    91.45760
Dim.7   0.3025817         3.025817                    94.48342
Dim.8   0.2744700         2.744700                    97.22812
Dim.9   0.1552169         1.552169                    98.78029
Dim.10  0.1219710         1.219710                   100.00000

所有特征值的总和为10，表示总方差。每个特征值解释的变化比例在第二列中给出。例如，4.124除10等于0.4124，或者说，大约41.24%的变化由第一个特征值解释。通过将连续的变化比例相加以获得累积百分比来获得累积百分比。例如，41.242%加上18.385%等于 59.627%，依此类推。因此，前两个特征值共解释了大约 59.627% 的变化。

下面通过绘制碎石图来直观的看一下特征的贡献度↓

fviz_eig(res.pca, addlabels = TRUE, ylim = c(0, 50))

从上面的图表可以看出，我们可能希望在第五个主成分处停止。数据中包含的87%的信息（方差）被前五个主成分保留。

从PCA输出中提取结果的一种简单方法是使用函数get_pca_var。该函数提供了一个包含所有变量结果的矩阵列表（坐标，变量和轴之间的相关性，平方余弦和贡献）↓

var <- get_pca_var(res.pca)var

Principal Component Analysis Results for variables
 ===================================================
  Name       Description                                    
1 "$coord"   "Coordinates for the variables"                
2 "$cor"     "Correlations between variables and dimensions"
3 "$cos2"    "Cos2 for the variables"                       
4 "$contrib" "contributions of the variables"

var$coord：变量的坐标，用于创建散点图；

var$cos2：表示因子图上变量表示质量。它的计算方法为平方坐标：var.cos2 = var.coord * var.coord；

var$contrib：包含变量对主成分的贡献（以百分比表示）。变量（var）对给定主成分的贡献（以百分比表示）为：(var.cos2 * 100) /（组件的总的 cos2）。可以通过下面的方式来查看↓

# 坐标head(var$coord)# Cos2: 因素图上的质量head(var$cos2)# 对主要成分的贡献head(var$contrib)

> # 坐标
> head(var$coord)
               Dim.1       Dim.2      Dim.3       Dim.4      Dim.5
跑步100米 -0.8506257 -0.17939806  0.3015564  0.03357320 -0.1944440
跳远       0.7941806  0.28085695 -0.1905465 -0.11538956  0.2331567
铅球       0.7339127  0.08540412  0.5175978  0.12846837 -0.2488129
跳高       0.6100840 -0.46521415  0.3300852  0.14455012  0.4027002
跑步400米 -0.7016034  0.29017826  0.2835329  0.43082552  0.1039085
跨栏110米 -0.7641252 -0.02474081  0.4488873 -0.01689589  0.2242200
> # Cos2: 因素图上的质量
> head(var$cos2)
              Dim.1        Dim.2      Dim.3        Dim.4      Dim.5
跑步100米 0.7235641 0.0321836641 0.09093628 0.0011271597 0.03780845
跳远      0.6307229 0.0788806285 0.03630798 0.0133147506 0.05436203
铅球      0.5386279 0.0072938636 0.26790749 0.0165041211 0.06190783
跳高      0.3722025 0.2164242070 0.10895622 0.0208947375 0.16216747
跑步400米 0.4922473 0.0842034209 0.08039091 0.1856106269 0.01079698
跨栏110米 0.5838873 0.0006121077 0.20149984 0.0002854712 0.05027463
> # 对主要成分的贡献
> head(var$contrib)
              Dim.1      Dim.2     Dim.3       Dim.4     Dim.5
跑步100米 17.544293  1.7505098  7.338659  0.13755240  5.389252
跳远      15.293168  4.2904162  2.930094  1.62485936  7.748815
铅球      13.060137  0.3967224 21.620432  2.01407269  8.824401
跳高       9.024811 11.7715838  8.792888  2.54987951 23.115504
跑步400米 11.935544  4.5799296  6.487636 22.65090599  1.539012
跨栏110米 14.157544  0.0332933 16.261261  0.03483735  7.166193

变量与主成分之间的相关性被用作变量在 主成分 上的坐标。变量的表示与观察图的表示不同：观察结果通过它们的投影表示，而变量通过它们的相关性表示，要绘制变量，代码如下↓

fviz_pca_var(res.pca, col.var = "black")

上面的图表也被称为变量相关性图。它展示了所有变量之间的关系。可以解释如下：

正相关的变量被分组在一起；

负相关的变量位于图表原点的对立象限；

变量与原点之间的距离衡量了变量在因子图上的质量。远离原点的变量在因子图上得到了很好的代表。

在因子图上变量的表示质量称为cos2（方位余弦，平方坐标）。代码如下↓

library("corrplot")corrplot(var$cos2, is.corr=FALSE)

高的cos2意味着变量在主成分上的表现良好。在这种情况下，变量位置靠近相关圆的周长。低的cos2表示变量不完全由主成分代表。在这种情况下，变量靠近圆的中心。 还可以使用函数fviz_cos2创建变量cos2的条形图，代码如下↓

fviz_cos2(res.pca, choice = "var", axes = 1:2)

对于给定的变量，所有主成分上的cos2之和等于1。如果一个变量仅由两个主成分（Dim.1 和 Dim.2）完美表示，那么这两个成分上的 cos2 之和等于1。在这种情况下，变量将位于相关圆的圆周上。对于某些变量，可能需要超过 2 个成分来完美表示数据。在这种情况下，变量将位于相关圆内部。

可以使用参数按照它们的cos2值来着色变量。这将产生渐变颜色。在这种情况下，参数可以用于提供自定义颜色。低cos2值的变量将被着为白色，中等cos2值的变量将被着为蓝色，高cos2值的变量将被着为红色↓

fviz_pca_var(res.pca, col.var = "cos2",             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),              repel = TRUE             )

当然，也可以根据变量的cos2值更改变量的透明度，这在只能黑白打印使用的时候很方便，代码如下↓

fviz_pca_var(res.pca, alpha.var = "cos2")

变量对于解释给定主成分中的可变性的贡献以百分比表示。与 PC1 (即 Dim.1) 和 PC2 (即 Dim.2) 相关的变量在解释数据集中的可变性方面最为重要。与任何主成分不相关或与最后维度相关的变量是贡献较低的变量，可能被移除以简化整体分析。

head(var$contrib, 4)

> head(var$contrib, 4)
              Dim.1      Dim.2     Dim.3     Dim.4     Dim.5
跑步100米 17.544293  1.7505098  7.338659 0.1375524  5.389252
跳远      15.293168  4.2904162  2.930094 1.6248594  7.748815
铅球      13.060137  0.3967224 21.620432 2.0140727  8.824401
跳高       9.024811 11.7715838  8.792888 2.5498795 23.115504

贡献值越大，变量对组分的贡献越大。

继续使用相关性图来绘制变量的贡献度↓

corrplot(var$contrib, is.corr=FALSE)

同样，也可以使用条形图来绘制表里的贡献度。 如果您的数据包含许多变量，可以决定仅显示排名靠前的变量，下面绘制前10的变量↓

# 变量对 PC1 的贡献fviz_contrib(res.pca, choice = "var", axes = 1, top = 10)# 变量对 PC2 的贡献fviz_contrib(res.pca, choice = "var", axes = 2, top = 10)

对主成分1和主成分2合计贡献如下↓

fviz_contrib(res.pca, choice = "var", axes = 1:2, top = 10)

最重要（或具有贡献）的变量可以在相关图上突出显示如下↓

fviz_pca_var(res.pca, col.var = "contrib",             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))

同样还是可以通过透明度的方式来实现。

我们前面介绍了如何根据它们的贡献和它们的cos2来给变量上色。但是可以根据任何自定义的连续变量来给变量上色。上色变量的长度应与PCA中活跃变量的数量相同↓

my.cont.var <- rnorm(10)fviz_pca_var(res.pca, col.var = my.cont.var,             gradient.cols = c("#393b38", "#15a80d", "red"),             legend.title = "Cont.Var")

当然也可以使用固定的颜色↓

res.km <- kmeans(var$coord, centers = 3, nstart = 25)grp <- as.factor(res.km$cluster)# Color variables by groupsfviz_pca_var(res.pca, col.var = grp,              palette = c("#00AFBB", "#E7B800", "#FC4E07"),             legend.title = "Cluster")

通过dimdesc描述，可以查看每个变量对主成分的贡献值↓

res.desc <- dimdesc(res.pca, axes = c(1,2), proba = 0.05)res.desc$Dim.1res.desc$Dim.2

> res.desc$Dim.1

Link between the variable and the continuous variables (R-square)
=================================================================================
          correlation      p.value
跳远        0.7941806 6.059893e-06
铁饼        0.7432090 4.842563e-05
铅球        0.7339127 6.723102e-05
跳高        0.6100840 1.993677e-03
标枪        0.4282266 4.149192e-02
跑步400米  -0.7016034 1.910387e-04
跨栏110米  -0.7641252 2.195812e-05
跑步100米  -0.8506257 2.727129e-07
> res.desc$Dim.2

Link between the variable and the continuous variables (R-square)
=================================================================================
           correlation      p.value
撑杆跳       0.8074511 3.205016e-06
跑步1500米   0.7844802 9.384747e-06
跳高        -0.4652142 2.529390e-02

也可以同每个个体变量进行可视化展示，最简单的代码直接使用 fviz_pca_ind函数，当然我们可以给它增加一点颜色↓

fviz_pca_ind(res.pca, col.ind = "cos2",              gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),             repel = TRUE)

也可以使用点图大小来进行展示↓

fviz_pca_ind(res.pca, pointsize = "cos2",              pointshape = 21, fill = "#E7B800",             repel = TRUE)

或者把上面的两者结合起来↓

fviz_pca_ind(res.pca, col.ind = "cos2", pointsize = "cos2",             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),             repel = TRUE)

同样也可以使用条形图，来看个人对主成分的贡献程度↓

fviz_cos2(res.pca, choice = "ind")fviz_contrib(res.pca, choice = "ind", axes = 1:2)

同理，也可以使用渐变的颜色来绘制↓

my.cont.var <- rnorm(23)fviz_pca_ind(res.pca, col.ind = my.cont.var,             gradient.cols = c("blue", "yellow", "red"),             legend.title = "Cont.Var")

res.pca <- PCA(df, ind.sup = 24:27,                quanti.sup = 11:12, quali.sup = 13, graph=FALSE)fviz_pca_var(res.pca,             col.var = "black",              col.quanti.sup = "red")

fviz_pca_var(res.pca, arrowsize = 1, labelsize = 5,              repel = TRUE)

fviz_pca_var(res.pca, axes = c(2, 3))

【鸢尾花数据集，分组PCA】

下面我们使用鸢尾花数据集，来展示一下有多组分类的主成分数据的可视化↓

iris.pca <- PCA(iris[,-5], graph = FALSE)fviz_pca_ind(iris.pca,             geom.ind = "point",             col.ind = iris$Species,             palette = c("#00AFBB", "#E7B800", "#FC4E07"),             addEllipses = TRUE,             legend.title = "Groups")

fviz_pca_ind(iris.pca, geom.ind = "point", col.ind = iris$Species,              palette = c("#00AFBB", "#E7B800", "#FC4E07"),             addEllipses = TRUE, ellipse.type = "confidence",             legend.title = "Groups")

fviz_pca_ind(iris.pca, geom.ind = "point",             col.ind = iris$Species, # color by groups             palette = c("#00AFBB", "#E7B800", "#FC4E07"),             addEllipses = TRUE, ellipse.type = "convex",             legend.title = "Groups")

fviz_pca_biplot(iris.pca,                 col.ind = iris$Species, palette = "jco",                 addEllipses = TRUE, label = "var",                col.var = "black", repel = TRUE,                legend.title = "Species")

fviz_pca_biplot(iris.pca,                 # Fill individuals by groups                geom.ind = "point",                pointshape = 21,                pointsize = 2.5,                fill.ind = iris$Species,                col.ind = "black",                # Color variable by groups                col.var = factor(c("sepal", "sepal", "petal", "petal")),                                legend.title = list(fill = "Species", color = "Clusters"),                repel = TRUE        # Avoid label overplotting)+  ggpubr::fill_palette("jco")+      # Indiviual fill color  ggpubr::color_palette("npg")      # Variable colors

fviz_pca_biplot(iris.pca,                 # Individuals                geom.ind = "point",                fill.ind = iris$Species, col.ind = "black",                pointshape = 21, pointsize = 2,                palette = "jco",                addEllipses = TRUE,                # Variables                alpha.var ="contrib", col.var = "contrib",                gradient.cols = "RdYlBu",                                legend.title = list(fill = "Species", color = "Contrib",                                    alpha = "Contrib"))