《精通机器学习：基于R 第二版》学习笔记
1、主成分简介
成分就是特征的规范化线性组合。在一个数据集中，第一主成分就是能够最大程度解释数据中的方差的特征线性组合。第二主成分是另一种特征线性组合，它在方向与第一主成分垂直这个限制条件下，最大程度解释数据中的方差。其后的每一个主成分（可以构造与变量数相等数目的主成分）都遵循同样的规则。
主成分分析（PCA），可以对相关变量进行归类，从而降低数据维度，提高对数据的理解。
通过PCA从原始变量集合中找出一个更小的，但是能保留原来大部分信息的变量集合。这样可以简化数据集，并经常能够发现数据背后隐藏的知识。这些新的变量（主成分）彼此高度不相关，除了可以用于监督式学习之外，还经常用于数据可视化。
PCA对量度是敏感的，所以数据需要被标准化为均值为0、方差为1。
要达到降低数据维度这一首要目标，我们使用在特征值大于1的情况下选择主成分。主成分的特征值是它在整个数据集中能够解释的方差的数量。因为第一特征值可以解释最大数量的方差，它就有最大的特征值；第二主成分有第二大的特征值，依此类推。所以，特征值大于1就表示这个主成分解释的方差比任何一个原始变量都要大。如果通过标准化操作将特征值的总和变为1，就能够得到每个主成分解释的方差的比例。
特征值原则并不严格、明确，它必须和你的数据分析知识以及实际业务问题结合起来使用。
2、主成分旋转
PCA是一种无监督学习，所以我们是在努力去理解数据，而不是在验证某种假设。旋转可以修改每个变量的载荷，这样有助于对主成分的解释。
旋转后的成分能够解释的方差总量是不变的，但是每个成分对于能够解释的方差总量的贡献会改变。在旋转过程中，你会发现载荷的值或者更远离0，或者更接近0，这在理论上可以帮助我们识别那些对主成分起重要作用的变量。
3、数据理解与数据准备
> library(pacman)
> p_load(dplyr, ggplot2, psych)
>
> train <- read.csv("./data_set/data-master/NHLtrain.csv")
> str(train)
## 'data.frame': 30 obs. of 15 variables:
## $ Team : Factor w/ 30 levels "Anaheim","Arizona",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ ppg : num 1.26 0.95 1.13 0.99 0.94 1.05 1.26 1 0.93 1.33 ...
## $ Goals_For : num 2.62 2.54 2.88 2.43 2.79 2.39 2.85 2.59 2.6 3.23 ...
## $ Goals_Against: num 2.29 2.98 2.78 2.62 3.13 2.7 2.52 2.93 3.02 2.78 ...
## $ Shots_For : num 30.3 27.6 32 29.5 29.2 29.9 30.5 28.6 29.1 32 ...
## $ Shots_Against: num 27.5 31 30.4 30.6 29 27.6 30.8 32.3 31.1 28.9 ...
## $ PP_perc : num 23 17.7 20.5 18.9 17 16.8 22.6 18 17.3 22.1 ...
## $ PK_perc : num 87.2 77.3 82.2 82.6 75.6 84.3 80.3 80.2 81 82.3 ...
## $ CF60_pp : num 111.6 97.7 118.3 97.4 94 ...
## $ CA60_sh : num 94.1 96.1 94.4 100.6 102.8 ...
## $ OZFOperc_pp : num 78.4 72.5 79.4 76.2 77.1 ...
## $ Give : num 9.78 5.67 8.6 6.34 9.8 ...
## $ Take : num 5.22 5.89 6.11 5.26 6.99 9.22 5.82 5.56 5.98 7.01 ...
## $ hits : num 27.2 22.1 26.4 23.4 20.7 ...
## $ blks : num 14.4 14 14.4 13.3 16.1 ...
Team ：球队所在城市
ppg ：平均每场得分，胜得2分，常规负得0分，加时赛或点球大战负得1分
Goals_For ：平均每场进球数
Goals_Against ：平均每场失球数
Shots_For ：平均每场射中球门次数
Shots_Against ：平均每场被射中球门次数
PP_perc ：球队获得以多打少机会时的进球百分比
PK_perc ：对方获得以多打少机会时，球队力保球门不失的时间百分比
CF60_pp ：球队在每60分钟以多打少时间内获得的Corsi分值；Corsi分值是射门次数总和，包括射中球门次数（Shots_For）、射偏次数和被对方封堵的次数
CA60_sh ：对方以多打少时，即本方人数劣势时，对方每60分钟获得的Corsi分值
OZFOperc_pp ：球队以多打少时，在进攻区域发生的争球次数百分比
Give ：平均每场丢球次数
Take ：平均每场抢断次数
hits ：平均每场身体冲撞次数
blks ：平均每场封堵对方射门次数
对数据进行标准化：
> train.scale <- scale(train[, -1:-2])
相关性统计图：
> cor(train.scale) %>% cor.plot(.)
可以看到，Shots_For与Goals_For相关，反之，Shots_Against与Goals_Against也相关。 PP_perc及PK_perc与Goals_Against之间存在某种负相关。由此可知，这个数据集非常适合提取主成分。
4、模型构建与模型评价
按照以下几个步骤进行：
(1) 抽取主成分并决定保留的数量；
(2) 对留下的主成分进行旋转；
(3) 对旋转后的解决方案进行解释；
(4) 生成各个因子的得分；
(5) 使用得分作为输入变量进行回归分析，并使用测试数据评价模型效果。
4.1 主成分抽取
> # rotate是否要进行主成分旋转
> pca <- principal(train.scale, rotate = "none")
>
> # 碎石图确定要保留的成分的数量
> plot(pca$values, type = "b", ylab = "Eigenvalues", xlab = "Component")
X轴表示主成分的数量，Y轴表示相应的特征值。从图中找出使变化率降低的那个点，也就是我们常说的统计图中的“肘点”或弯曲点。这个点就是曲线由陡变平的转折点。从图中可以看出，第5个主成分是很令人信服的。
一条基本原则是，我们选择的主成分解释的方差累加起来，至少应该能解释70%左右的方差。
4.2 正交旋转与解释
进行正交旋转的方法称为“方差最大法”（当然还有其他非正交旋转方法）。旋转背后的意义是使变量在某个主成分上的载荷最大化，这样可以减少（或消灭）主成分之间的相关性，有助于对主成分的解释。
> # 使用5个主成分，并进行正交旋转
> pca.rotate <- principal(train.scale, nfactors = 5, rotate = "varimax")
> pca.rotate
## Principal Components Analysis
## Call: principal(r = train.scale, nfactors = 5, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 RC5 RC3 RC4 h2 u2 com
## Goals_For -0.21 0.82 0.21 0.05 -0.11 0.78 0.22 1.3
## Goals_Against 0.88 -0.02 -0.05 0.21 0.00 0.82 0.18 1.1
## Shots_For -0.22 0.43 0.76 -0.02 -0.10 0.81 0.19 1.8
## Shots_Against 0.73 -0.02 -0.20 -0.29 0.20 0.70 0.30 1.7
## PP_perc -0.73 0.46 -0.04 -0.15 0.04 0.77 0.23 1.8
## PK_perc -0.73 -0.21 0.22 -0.03 0.10 0.64 0.36 1.4
## CF60_pp -0.20 0.12 0.71 0.24 0.29 0.69 0.31 1.9
## CA60_sh 0.35 0.66 -0.25 -0.48 -0.03 0.85 0.15 2.8
## OZFOperc_pp -0.02 -0.18 0.70 -0.01 0.11 0.53 0.47 1.2
## Give -0.02 0.58 0.17 0.52 0.10 0.65 0.35 2.2
## Take 0.16 0.02 0.01 0.90 -0.05 0.83 0.17 1.1
## hits -0.02 -0.01 0.27 -0.06 0.87 0.83 0.17 1.2
## blks 0.19 0.63 -0.18 0.14 0.47 0.70 0.30 2.4
##
## RC1 RC2 RC5 RC3 RC4
## SS loadings 2.69 2.33 1.89 1.55 1.16
## Proportion Var 0.21 0.18 0.15 0.12 0.09
## Cumulative Var 0.21 0.39 0.53 0.65 0.74
## Proportion Explained 0.28 0.24 0.20 0.16 0.12
## Cumulative Proportion 0.28 0.52 0.72 0.88 1.00
##
## Mean item complexity = 1.7
## Test of the hypothesis that 5 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.08
## with the empirical chi square 28.59 with prob < 0.19
##
## Fit based upon off diagonal values = 0.91
输出中有两个部分比较重要，第一部分就是5个主成分中每个主成分的变量载荷，分别标注为RC1至RC5。我们看到，对于第一个主成分，变量Goals_Against和Shots_Against具有非常高的正载荷，而PP_perc和PK_perc具有高的负载荷。对于第二个主成分，具有高载荷的是Goals_For。第五个主成分在Shots_For、ff和OZFOperc_pp上具有高载荷。第三个主成分看上去只与变量take有关系，第四个主成分则只与hits有关。
第二个重要部分，就是以平方和SS loading开始的表格。SS loading中的值是每个主成分的特征值。如果对特征值进行标准化，就可以得到Proportion Explained行。这一行表示的是每个主成分解释的方差的比例。可以看到，对于旋转后的5个主成分能够解释的所有方差，第一个主成分可以解释其中的28%。查看Cumulative Var行可以知道，这5个旋转后的主成分可以解释74%的全部方差。
4.3 根据主成分建立因子得分
将旋转后的主成分载荷作为每个球队的因子得分，这些得分说明了每个观测与旋转后的主成分的相关程度。
> pca.scores <- pca.rotate$scores %>% as.data.frame()
> head(pca.scores)
## RC1 RC2 RC5 RC3 RC4
## 1 -2.21526408 0.002821488 0.3161588 -0.1572320 1.5278033
## 2 0.88147630 -0.569239044 -1.2361419 -0.2703150 -0.0113224
## 3 0.10321189 0.481754024 1.8135052 -0.1606672 0.7346531
## 4 -0.06630166 -0.630676083 -0.2121434 -1.3086231 0.1541255
## 5 1.49662977 1.156905747 -0.3222194 0.9647145 -0.6564827
## 6 -0.48902169 -2.119952370 1.0456190 2.7375097 -1.3735777
加入响应变量：
> pca.scores <- pca.scores %>% mutate(ppg = train$ppg)
4.4 回归分析
> lm.nh1 <- lm(ppg ~ ., data = pca.scores)
> summary(lm.nh1)
##
## Call:
## lm(formula = ppg ~ ., data = pca.scores)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.163274 -0.048189 0.003718 0.038723 0.165905
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.111333 0.015752 70.551 < 2e-16 ***
## RC1 -0.112201 0.016022 -7.003 3.06e-07 ***
## RC2 0.070991 0.016022 4.431 0.000177 ***
## RC5 0.022945 0.016022 1.432 0.164996
## RC3 -0.017782 0.016022 -1.110 0.278044
## RC4 -0.005314 0.016022 -0.332 0.743003
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.08628 on 24 degrees of freedom
## Multiple R-squared: 0.7502, Adjusted R-squared: 0.6981
## F-statistic: 14.41 on 5 and 24 DF, p-value: 1.446e-06
整体模型在统计上是高度显著的，p值为1.446e-06，修正R方几乎是70%。但是有3个主成分是不显著的。看看如果把它们排除出模型，只保留RC1和RC2，会发生什么：
> lm.nh2 <- lm(ppg ~ RC1 + RC2, data = pca.scores)
> summary(lm.nh2)
##
## Call:
## lm(formula = ppg ~ RC1 + RC2, data = pca.scores)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.18914 -0.04430 0.01438 0.05645 0.16469
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.11133 0.01587 70.043 < 2e-16 ***
## RC1 -0.11220 0.01614 -6.953 1.8e-07 ***
## RC2 0.07099 0.01614 4.399 0.000153 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0869 on 27 degrees of freedom
## Multiple R-squared: 0.7149, Adjusted R-squared: 0.6937
## F-statistic: 33.85 on 2 and 27 DF, p-value: 4.397e-08
修正R方几乎没有任何改善。查看预测值和实际值之间的关系：
> tibble(Predicted = lm.nh2$fitted.values, Actual = train$ppg) %>%
+ ggplot(aes(Predicted, Actual)) + geom_point() +
+ ggtitle("Predicted versus Actual") + geom_smooth(method = "lm", se = F) +
+ geom_text(aes(label = train$Team), size = 3.5, hjust = 0.1, vjust = -0.5, angle = 0) +
+ theme_bw()
可以这样解释这张图：位于斜线下方的球队发挥欠佳，位于斜线上方的球队则超过预期。
绘制球队及其因子得分之间的关系，双标图：
> pca.scores %>% bind_cols(Team = train$Team) %>% ggplot(aes(RC1, RC2, label = Team)) +
+ geom_point() + geom_text(size = 2.75, hjust = 0.2, vjust = -0.75, angle = 0) +
+ theme_bw()
X轴是球队在RC1上的得分，Y轴则是RC2上的得分。Anaheim队在RC1上的分数最低，在RC2上的分数位于中游。在RC1上，以多打少进球（PP_perc）和以少打多失球（PK_perc）具有负载荷，平均每场失球数（Goals_Against）具有正载荷，这说明这支球队的防守组织得非常好，并在处于人数劣势时表现得很好。
看看均方根误差：
> sqrt(mean(lm.nh2$residuals^2))
## [1] 0.08244449
看看在测试集上的表现：
> test <- read.csv("./data_set/data-master/NHLtest.csv")
> test.scores <- predict(pca.rotate, test[, -1:-2]) %>% as.data.frame()
> test.scores <- test.scores %>% mutate(pred = predict(lm.nh2, test.scores), ppg = test$ppg,
+ Team = test$Team)
> ggplot(test.scores, aes(pred, ppg, label = Team)) + geom_point() +
+ geom_text(size = 3.5, hjust = 0.4, vjust = -0.9, angle = 35) +
+ stat_smooth(method = "lm", se = F) +
+ theme_bw()
检查RMSE：
> resid <- test.scores$ppg - test.scores$pred
> sqrt(mean(resid^2))
## [1] 0.1011561
与样本内误差0.08比起来，0.1的样本外误差并不坏。