《精通機器學(xué)習(xí)：基于R 第二版》學(xué)習(xí)筆記
1、主成分簡介
成分就是特征的規(guī)范化線性組合。在一個數(shù)據(jù)集中，第一主成分就是能夠最大程度解釋數(shù)據(jù)中的方差的特征線性組合。第二主成分是另一種特征線性組合，它在方向與第一主成分垂直這個限制條件下，最大程度解釋數(shù)據(jù)中的方差。其后的每一個主成分（可以構(gòu)造與變量數(shù)相等數(shù)目的主成分）都遵循同樣的規(guī)則。
主成分分析（PCA），可以對相關(guān)變量進行歸類，從而降低數(shù)據(jù)維度，提高對數(shù)據(jù)的理解。
通過PCA從原始變量集合中找出一個更小的，但是能保留原來大部分信息的變量集合。這樣可以簡化數(shù)據(jù)集，并經(jīng)常能夠發(fā)現(xiàn)數(shù)據(jù)背后隱藏的知識。這些新的變量（主成分）彼此高度不相關(guān)，除了可以用于監(jiān)督式學(xué)習(xí)之外，還經(jīng)常用于數(shù)據(jù)可視化。
PCA對量度是敏感的，所以數(shù)據(jù)需要被標準化為均值為0、方差為1。
要達到降低數(shù)據(jù)維度這一首要目標，我們使用在特征值大于1的情況下選擇主成分。主成分的特征值是它在整個數(shù)據(jù)集中能夠解釋的方差的數(shù)量。因為第一特征值可以解釋最大數(shù)量的方差，它就有最大的特征值；第二主成分有第二大的特征值，依此類推。所以，特征值大于1就表示這個主成分解釋的方差比任何一個原始變量都要大。如果通過標準化操作將特征值的總和變?yōu)?，就能夠得到每個主成分解釋的方差的比例。
特征值原則并不嚴格、明確，它必須和你的數(shù)據(jù)分析知識以及實際業(yè)務(wù)問題結(jié)合起來使用。
2、主成分旋轉(zhuǎn)
PCA是一種無監(jiān)督學(xué)習(xí)，所以我們是在努力去理解數(shù)據(jù)，而不是在驗證某種假設(shè)。旋轉(zhuǎn)可以修改每個變量的載荷，這樣有助于對主成分的解釋。
旋轉(zhuǎn)后的成分能夠解釋的方差總量是不變的，但是每個成分對于能夠解釋的方差總量的貢獻會改變。在旋轉(zhuǎn)過程中，你會發(fā)現(xiàn)載荷的值或者更遠離0，或者更接近0，這在理論上可以幫助我們識別那些對主成分起重要作用的變量。
3、數(shù)據(jù)理解與數(shù)據(jù)準備
> 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分，常規(guī)負得0分，加時賽或點球大戰(zhàn)負得1分
? Goals_For ：平均每場進球數(shù)
? Goals_Against ：平均每場失球數(shù)
? Shots_For ：平均每場射中球門次數(shù)
? Shots_Against ：平均每場被射中球門次數(shù)
? PP_perc ：球隊獲得以多打少機會時的進球百分比
? PK_perc ：對方獲得以多打少機會時，球隊力保球門不失的時間百分比
? CF60_pp ：球隊在每60分鐘以多打少時間內(nèi)獲得的Corsi分值；Corsi分值是射門次數(shù)總和，包括射中球門次數(shù)（Shots_For）、射偏次數(shù)和被對方封堵的次數(shù)
? CA60_sh ：對方以多打少時，即本方人數(shù)劣勢時，對方每60分鐘獲得的Corsi分值
? OZFOperc_pp ：球隊以多打少時，在進攻區(qū)域發(fā)生的爭球次數(shù)百分比
? Give ：平均每場丟球次數(shù)
? Take ：平均每場搶斷次數(shù)
? hits ：平均每場身體沖撞次數(shù)
? blks ：平均每場封堵對方射門次數(shù)
對數(shù)據(jù)進行標準化：
> train.scale <- scale(train[, -1:-2])
相關(guān)性統(tǒng)計圖：
> cor(train.scale) %>% cor.plot(.)
可以看到，Shots_For與Goals_For相關(guān)，反之，Shots_Against與Goals_Against也相關(guān)。 PP_perc及PK_perc與Goals_Against之間存在某種負相關(guān)。由此可知，這個數(shù)據(jù)集非常適合提取主成分。
4、模型構(gòu)建與模型評價
按照以下幾個步驟進行：
(1) 抽取主成分并決定保留的數(shù)量；
(2) 對留下的主成分進行旋轉(zhuǎn)；
(3) 對旋轉(zhuǎn)后的解決方案進行解釋；
(4) 生成各個因子的得分；
(5) 使用得分作為輸入變量進行回歸分析，并使用測試數(shù)據(jù)評價模型效果。
4.1 主成分抽取
> # rotate是否要進行主成分旋轉(zhuǎn)
> pca <- principal(train.scale, rotate = "none")
>
> # 碎石圖確定要保留的成分的數(shù)量
> plot(pca$values, type = "b", ylab = "Eigenvalues", xlab = "Component")
X軸表示主成分的數(shù)量，Y軸表示相應(yīng)的特征值。從圖中找出使變化率降低的那個點，也就是我們常說的統(tǒng)計圖中的“肘點”或彎曲點。這個點就是曲線由陡變平的轉(zhuǎn)折點。從圖中可以看出，第5個主成分是很令人信服的。
一條基本原則是，我們選擇的主成分解釋的方差累加起來，至少應(yīng)該能解釋70%左右的方差。
4.2 正交旋轉(zhuǎn)與解釋
進行正交旋轉(zhuǎn)的方法稱為“方差最大法”（當(dāng)然還有其他非正交旋轉(zhuǎn)方法）。旋轉(zhuǎn)背后的意義是使變量在某個主成分上的載荷最大化，這樣可以減少（或消滅）主成分之間的相關(guān)性，有助于對主成分的解釋。
> # 使用5個主成分，并進行正交旋轉(zhuǎn)
> 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有關(guān)系，第四個主成分則只與hits有關(guān)。
第二個重要部分，就是以平方和SS loading開始的表格。SS loading中的值是每個主成分的特征值。如果對特征值進行標準化，就可以得到Proportion Explained行。這一行表示的是每個主成分解釋的方差的比例?？梢钥吹?，對于旋轉(zhuǎn)后的5個主成分能夠解釋的所有方差，第一個主成分可以解釋其中的28%。查看Cumulative Var行可以知道，這5個旋轉(zhuǎn)后的主成分可以解釋74%的全部方差。
4.3 根據(jù)主成分建立因子得分
將旋轉(zhuǎn)后的主成分載荷作為每個球隊的因子得分，這些得分說明了每個觀測與旋轉(zhuǎn)后的主成分的相關(guān)程度。
> 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
加入響應(yīng)變量：
> 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
整體模型在統(tǒng)計上是高度顯著的，p值為1.446e-06，修正R方幾乎是70%。但是有3個主成分是不顯著的?？纯慈绻阉鼈兣懦瞿Ｐ停槐Ａ鬜C1和RC2，會發(fā)生什么：
> 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方幾乎沒有任何改善。查看預(yù)測值和實際值之間的關(guān)系：
> 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()
可以這樣解釋這張圖：位于斜線下方的球隊發(fā)揮欠佳，位于斜線上方的球隊則超過預(yù)期。
繪制球隊及其因子得分之間的關(guān)系，雙標圖：
> 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上的分數(shù)最低，在RC2上的分數(shù)位于中游。在RC1上，以多打少進球（PP_perc）和以少打多失球（PK_perc）具有負載荷，平均每場失球數(shù)（Goals_Against）具有正載荷，這說明這支球隊的防守組織得非常好，并在處于人數(shù)劣勢時表現(xiàn)得很好。
看看均方根誤差：
> sqrt(mean(lm.nh2$residuals^2))
## [1] 0.08244449
看看在測試集上的表現(xiàn)：
> 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
與樣本內(nèi)誤差0.08比起來，0.1的樣本外誤差并不壞。
