《精通機器學習：基于R 第二版》學習筆記

1、數據理解與準備

> library(pacman)
> p_load(MASS, dplyr, ggplot2)
> data("biopsy")
> str(biopsy)

## 'data.frame':    699 obs. of  11 variables:
##  $ ID   : chr  "1000025" "1002945" "1015425" "1016277" ...
##  $ V1   : int  5 5 3 6 4 8 1 2 2 4 ...
##  $ V2   : int  1 4 1 8 1 10 1 1 1 2 ...
##  $ V3   : int  1 4 1 8 1 10 1 2 1 1 ...
##  $ V4   : int  1 5 1 1 3 8 1 1 1 1 ...
##  $ V5   : int  2 7 2 3 2 7 2 2 2 2 ...
##  $ V6   : int  1 10 2 4 1 10 10 1 1 1 ...
##  $ V7   : int  3 3 3 3 3 9 3 3 1 2 ...
##  $ V8   : int  1 2 1 7 1 7 1 1 1 1 ...
##  $ V9   : int  1 1 1 1 1 1 1 1 5 1 ...
##  $ class: Factor w/ 2 levels "benign","malignant": 1 1 1 1 1 2 1 1 1 1 ...

? ID ：樣本編碼
? V1 ：細胞濃度
? V2 ：細胞大小均勻度
? V3 ：細胞形狀均勻度
? V4 ：邊緣黏著度
? V5 ：單上皮細胞大小
? V6 ：裸細胞核（16個觀測值缺失）
? V7 ：平和染色質
? V8 ：正常核仁
? V9 ：有絲分裂狀態
? class ：腫瘤診斷結果，良性或惡性；這就是我們要預測的結果變量

重命名變量：

> # 刪除ID列
> biopsy$ID <- NULL
> 
> # 換成有意義的列名
> names(biopsy) <- c("thick", "u.size", "u.shape", "ashsn", "s.size", "nucl", "chrom", "n.nuc", "mit", "class")
> 
> # 刪除缺失值
> df <- na.omit(biopsy)
> 
> # 用箱線圖檢查各個特征
> df2 <- reshape2::melt(df[, -11], value.name = "value")
> head(df2)

##       class variable value
## 1    benign    thick     5
## 2    benign    thick     5
## 3    benign    thick     3
## 4    benign    thick     6
## 5    benign    thick     4
## 6 malignant    thick     8

> ggplot(df2, aes(class, value)) + geom_boxplot(outlier.color = "red") + 
      labs(y = "", x = "") + facet_wrap(~variable, ncol = 3)

箱線圖檢查各變量

從中位數的間隔距離和相關分布來看，我覺得可以有把握地認為nucl是一個重要特征。與之相反，不同class組的mit特征的中位數幾乎沒有區別，這說明它很可能是個無關特征。

1.1 檢查相關性

> df[, 1:9] %>% cor %>% corrplot::corrplot.mixed()

相關性檢查

從相關系數可以看出，我們會遇到共線性問題，特別是細胞大小均勻度(u.size)和細胞形狀均勻度(u.shape)表現出非常明顯的共線性。

1.2 劃分訓練集和測試集

> # 按70/30比例劃分
> set.seed(123)
> ind <- sample(2, nrow(df), replace = T, prob = c(0.7, 0.3))
> train <- df[ind == 1, ]
> test <- df[ind == 2, ]
> str(test)

## 'data.frame':    209 obs. of  10 variables:
##  $ thick  : int  5 6 4 2 1 7 6 7 1 3 ...
##  $ u.size : int  4 8 1 1 1 4 1 3 1 2 ...
##  $ u.shape: int  4 8 1 2 1 6 1 2 1 1 ...
##  $ ashsn  : int  5 1 3 1 1 4 1 10 1 1 ...
##  $ s.size : int  7 3 2 2 1 6 2 5 2 1 ...
##  $ nucl   : int  10 4 1 1 1 1 1 10 1 1 ...
##  $ chrom  : int  3 3 3 3 3 4 3 5 3 2 ...
##  $ n.nuc  : int  2 7 1 1 1 3 1 4 1 1 ...
##  $ mit    : int  1 1 1 1 1 1 1 4 1 1 ...
##  $ class  : Factor w/ 2 levels "benign","malignant": 1 1 1 1 1 2 1 2 1 1 ...
##  - attr(*, "na.action")= 'omit' Named int  24 41 140 146 159 165 236 250 276 293 ...
##   ..- attr(*, "names")= chr  "24" "41" "140" "146" ...

> # 檢查拆分后是否均衡
> table(train$class)

## 
##    benign malignant 
##       302       172

> table(test$class)

## 
##    benign malignant 
##       142        67

2、模型構建與評價

> full.fit <- glm(class ~ ., family = binomial, data = train)
> summary(full.fit)

## 
## Call:
## glm(formula = class ~ ., family = binomial, data = train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.3397  -0.1387  -0.0716   0.0321   2.3559  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -9.4293     1.2273  -7.683 1.55e-14 ***
## thick         0.5252     0.1601   3.280 0.001039 ** 
## u.size       -0.1045     0.2446  -0.427 0.669165    
## u.shape       0.2798     0.2526   1.108 0.268044    
## ashsn         0.3086     0.1738   1.776 0.075722 .  
## s.size        0.2866     0.2074   1.382 0.167021    
## nucl          0.4057     0.1213   3.344 0.000826 ***
## chrom         0.2737     0.2174   1.259 0.208006    
## n.nuc         0.2244     0.1373   1.635 0.102126    
## mit           0.4296     0.3393   1.266 0.205402    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 620.989  on 473  degrees of freedom
## Residual deviance:  78.373  on 464  degrees of freedom
## AIC: 98.373
## 
## Number of Fisher Scoring iterations: 8

可以看到，只有兩個特征的p值小于0.05（thick和nucl）。使用 confint() 函數可以對模型進行95%置信區間的檢驗。如下所示：

> confint(full.fit)

##                    2.5 %     97.5 %
## (Intercept) -12.23786660 -7.3421509
## thick         0.23250518  0.8712407
## u.size       -0.56108960  0.4212527
## u.shape      -0.24551513  0.7725505
## ashsn        -0.02257952  0.6760586
## s.size       -0.11769714  0.7024139
## nucl          0.17687420  0.6582354
## chrom        -0.13992177  0.7232904
## n.nuc        -0.03813490  0.5110293
## mit          -0.14099177  1.0142786

2.1 計算優勢比

> exp(coef(full.fit))

##  (Intercept)        thick       u.size      u.shape        ashsn       s.size 
## 8.033466e-05 1.690879e+00 9.007478e-01 1.322844e+00 1.361533e+00 1.331940e+00 
##         nucl        chrom        n.nuc          mit 
## 1.500309e+00 1.314783e+00 1.251551e+00 1.536709e+00

優勢比可以解釋為特征中1個單位的變化導致的結果發生比的變化。如果系數大于1，就說明當特征的值增加時，結果的發生比會增加。反之，系數小于1就說明，當特征的值增加時，結果的發生比會減小。在本例中，除u.size之外的所有特征都會增加對數發生比。

2.2 檢查潛在的多重共線性問題

> car::vif(full.fit)

##    thick   u.size  u.shape    ashsn   s.size     nucl    chrom    n.nuc    mit 
## 1.235204 3.248811 2.830353 1.302178 1.635668 1.372931 1.523493 1.343145  1.059707

沒有一個VIF值大于5，根據VIF經驗法則，共線性看來不成為一個問題。

2.3 檢查模型的準確性

> train.prob <- predict(full.fit, type = "response")
> train.p <- ifelse(train.prob < 0.5, 0L, 1L)
> y <- ifelse(df$class == "benign", 0L, 1L)
> train.y <- y[ind == 1] 
> test.y <- y[ind == 2]
> caret::confusionMatrix(as.factor(train.y),as.factor(train.p))

## Confusion Matrix and Statistics
## 
##                 Reference
## Prediction        0     1
##               0  294    8
##               1   7    165
##                                           
##                Accuracy : 0.9684          
##                  95% CI : (0.9483, 0.9822)
##     No Information Rate : 0.635           
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.9316          
##                                           
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 0.9767          
##             Specificity : 0.9538          
##          Pos Pred Value : 0.9735          
##          Neg Pred Value : 0.9593          
##              Prevalence : 0.6350          
##          Detection Rate : 0.6203          
##    Detection Prevalence : 0.6371          
##       Balanced Accuracy : 0.9653          
##                                           
##        'Positive' Class : 0  

> p_load(InformationValue)
> # 繪制ROC曲線
> plotROC(actuals = train.y, predictedScores = train.p, Show.labels = F, returnSensitivityMat = F)

ROC曲線

> # 查看錯誤率
> misClassError(actuals = train.y, predictedScores = train.p)

## [1] 0.0316

從ROC曲線和錯誤率上看我們干得相當不錯，訓練集上只有3.16%的預測錯誤率。如前所述，我們必須正確預測未知數據，換句話說，必須正確預測測試集。

> test.prob <- predict(full.fit, newdata = test, type = "response")
> test.p <- ifelse(test.prob < 0.5, 0, 1)
> misClassError(test.y, test.p)

## [1] 0.0239

看上去，我們使用全部特征建立的模型效果非常好，差不多98%的預測正確率，那么還有沒有更好的方式來建立模型呢？

3、使用交叉驗證的邏輯回歸

模擬表明，LOOCV可以獲得近乎無偏的估計，但是會有很高的方差。所以，大多數機器學習專家都建議將K的值定為5或10。

> p_load(bestglm)
> # bestglm包需要將因子變量編碼為0或1，并且要求結果變量必須是最后一列，刪除所有沒有用的列
> df3 <- df %>% 
+      mutate(y = case_when(class == "benign" ~ 0L, class == "malignant" ~ 1L)) %>%
+      select(-"class")
> head(df3)

##   thick u.size u.shape ashsn s.size nucl chrom n.nuc mit y
## 1     5      1       1     1      2    1     3     1   1 0
## 2     5      4       4     5      7   10     3     2   1 0
## 3     3      1       1     1      2    2     3     1   1 0
## 4     6      8       8     1      3    4     3     7   1 0
## 5     4      1       1     3      2    1     3     1   1 0
## 6     8     10      10     8      7   10     9     7   1 1

> train.2 <- df3[ind == 1, ]
> 
> # Xy = train.2 指的是我們已經格式化的數據框 
> # IC = 'CV' 告訴程序使用的信息準則為交叉驗證 
> # CVArgs 是我們要使用的交叉驗證參數 
> # HTF 方法就是K折交叉驗證，后面的數字 K = 10 指定了均分的份數 
> # REP = 1 告訴程序隨機使用等份并且只迭代一次 
> # family = binomial，表示邏輯回歸，如果family =gaussian 表示線性回歸 
> # bestglm不支持tibble數據框

> bestglm(Xy = train.2, IC = "CV", CVArgs = list(Method = "HTF", K = 10, REP = 1), 
+     family = binomial)

## CV(K = 10, REP = 1)
## BICq equivalent for q in (7.16797006619085e-05, 0.273173435514231)
## Best Model:
##               Estimate Std. Error   z value     Pr(>|z|)
## (Intercept) -7.8147191 0.90996494 -8.587934 8.854687e-18
## thick        0.6188466 0.14713075  4.206100 2.598159e-05
## u.size       0.6582015 0.15295415  4.303260 1.683031e-05
## nucl         0.5725902 0.09922549  5.770596 7.899178e-09

將thick,u.size,nucl特征放到 glm() 函數中，看看模型在測試集上表現如何。 因為predict() 函數不能用于bestglm生成的模型，所以下面的步驟是必需的：

> reduce.fit <- glm(class ~ thick + u.size + nucl, family = binomial, data = train)
> test.prob.2 <- predict(reduce.fit, newdata = test, type = "response")
> test.p.2 <- ifelse(test.prob.2 < 0.5, 0L, 1L)
> misClassError(test.y, test.prob.2)

## [1] 0.0383

精簡了特征的模型和全特征模型相比，精確度略有下降。我們使用bestglm包信息準則為BIC的最優子集再試一次：

> bestglm(Xy = train.2, IC = "BIC", family = binomial)

## BIC
## BICq equivalent for q in (0.273173435514231, 0.577036596263757)
## Best Model:
##               Estimate Std. Error   z value     Pr(>|z|)
## (Intercept) -8.6169613 1.03155250 -8.353391 6.633065e-17
## thick        0.7113613 0.14751510  4.822295 1.419160e-06
## ashsn        0.4537948 0.15034294  3.018398 2.541153e-03
## nucl         0.5579922 0.09848156  5.665956 1.462068e-08
## n.nuc        0.4290854 0.11845720  3.622282 2.920152e-04

thick,ashsn,nucl,n.nuc4個變量提供了最小的BIC評分，檢測下預測效果：

> bic.fit <- glm(class ~ thick + ashsn + nucl + n.nuc, family = binomial, data = train)
> test.prob.3 <- predict(bic.fit, newdata = test, type = "response")
> test.p.3 <- ifelse(test.prob.3 < 0.5, 0L, 1L)
> misClassError(test.y, test.p.3)

## [1] 0.0239

錯誤率為2.39%，有所下降。那么問題來了：哪一個模型更好？在任何正常情況下，如果具有相同的泛化效果，經驗法則會選擇最簡單的或解釋性最好的模型。

4、判別分析

當遇到分類結果很確定的分類問題時，邏輯斯蒂回歸的估計結果可能是不穩定的，即置信區間很寬，不同樣本之間的估計值會有很大變化。判別分析不會受到這個問題的困擾，實際上，它會比邏輯回歸做得更好，泛化能力更強。反之，如果特征和結果變量之間具有錯綜復雜的關系，判別分析在分類任務上的表現就會非常差。

4.1 線性判別分析

線性判別分析技術比邏輯斯蒂回歸更具靈活性，同時還要時刻牢記偏差—方差權衡的問題。使用更有靈活性的技術可以得到偏差更小的結果，但很可能具有更高的方差。和很多靈活的技術一樣，需要一個高魯棒性的訓練數據集來降低高分類方差。

> lda.fit <- lda(class ~ ., data = train)
> lda.fit

## Call:
## lda(class ~ ., data = train)
## 
## Prior probabilities of groups:
##    benign malignant 
## 0.6371308 0.3628692 
## 
## Group means:
##             thick   u.size  u.shape    ashsn   s.size     nucl    chrom
## benign    2.92053 1.304636 1.413907 1.324503 2.115894 1.397351 2.082781
## malignant 7.19186 6.697674 6.686047 5.668605 5.500000 7.674419 5.959302
##              n.nuc      mit
## benign    1.225166 1.092715
## malignant 5.906977 2.639535
## 
## Coefficients of linear discriminants:
##                 LD1
## thick    0.19557291
## u.size   0.10555201
## u.shape  0.06327200
## ashsn    0.04752757
## s.size   0.10678521
## nucl     0.26196145
## chrom    0.08102965
## n.nuc    0.11691054
## mit     -0.01665454

從結果可以看出，在分組先驗概率中，良性概率大約為64%，惡性概率大約為36%。下面再看看分組均值，這是按類別分組的每個特征的均值。線性判別系數是標準線性組合，用來確定觀測的判別評分的特征。評分越高，越可能被分入惡性組。

判別評分的直方圖和密度圖：

> plot(lda.fit, type = "both")

判別評分的直方圖和密度圖

可以看出，組間有些重合，這表明有些觀測被錯誤分類。

查看LDA模型的準確率：

> train.lda.class <- predict(lda.fit)$class
> 
> # 創建一個計算錯誤率的函數
> test_err <- function(df, pre) {
+     n <- 0
+     for (i in 1:nrow(df)) {
+         if (df$class[i] != pre[i]) 
+             n = n + 1
+     }
+     error <- n/nrow(df)
+     return(error)
+ }
> train.err <- test_err(train, train.lda.class)
> print(train.err)

## [1] 0.04008439

LDA模型的錯誤率為4.01%，比邏輯斯蒂回歸模型差多了。看看在測試集上的表現：

> test.lda <- predict(lda.fit, newdata = test)$class
> test.err <- test_err(test, test.lda)
> print(test.err)

## [1] 0.03827751

從正確分類率的角度看，LDA模型表現得依然不如邏輯斯蒂回歸模型（LDA模型：96%，邏輯斯蒂回歸模型：98%）。

4.2 二次判別分析

> qda.fit <- qda(class ~ ., data = train)
> qda.fit

## Call:
## qda(class ~ ., data = train)
## 
## Prior probabilities of groups:
##    benign malignant 
## 0.6371308 0.3628692 
## 
## Group means:
##             thick   u.size  u.shape    ashsn   s.size     nucl    chrom
## benign    2.92053 1.304636 1.413907 1.324503 2.115894 1.397351 2.082781
## malignant 7.19186 6.697674 6.686047 5.668605 5.500000 7.674419 5.959302
##              n.nuc      mit
## benign    1.225166 1.092715
## malignant 5.906977 2.639535

> # 查看QDA模型在訓練集和測試集上的準確率
> train.qda <- predict(qda.fit)$class
> train.qda.err <- test_err(train, train.qda)
> print(train.qda.err)

## [1] 0.04219409

> test.qda <- predict(qda.fit, newdata = test)$class
> test.qda.err <- test_err(test, test.qda)
> print(test.qda.err)

## [1] 0.05263158

根據錯誤率可以立即斷定，QDA模型在訓練集和測試集上表現得最差。

4.3 多元自適應回歸樣條方法

> p_load(earth)
> set.seed(111)
> # nfold = 5：5折交叉驗證 
> # ncross = 3：重復3次 
> # degree = 1：使用沒有交互項的加法
> # minspan = 1：每個輸入特征只使用一個鉸鏈函數。負值表示每個預測器的最大節數。這些是等距的。
> # 例如，minspan=-3允許每個預測器有三個均勻間隔的節點
> earth.fit <- earth(class ~ ., data = train, pmethod = "cv", nfold = 5, ncross = 3, 
+     degree = 1, minspan = -1, glm = list(family = binomial))
> summary(earth.fit)

## Call: earth(formula=class~., data=train, pmethod="cv",
##             glm=list(family=binomial), degree=1, nfold=5, ncross=3,
##             minspan=-1)
## 
## GLM coefficients
##              malignant
## (Intercept) -6.5746417
## u.size       0.1502747
## ashsn        0.3058496
## s.size       0.3188098
## nucl         0.4426061
## n.nuc        0.2307595
## h(thick-3)   0.7019053
## h(3-chrom)  -0.6927319
## 
## GLM (family binomial, link logit):
##  nulldev  df       dev  df   devratio     AIC iters converged
##  620.989 473   81.9098 466      0.868   97.91     8         1
## 
## Earth selected 8 of 10 terms, and 7 of 9 predictors (pmethod="cv")
## Termination condition: RSq changed by less than 0.001 at 10 terms
## Importance: nucl, u.size, thick, n.nuc, chrom, s.size, ashsn, ...
## Number of terms at each degree of interaction: 1 7 (additive model)
## Earth GRSq 0.8354593  RSq 0.8450554  mean.oof.RSq 0.8330208 (sd 0.0468)
## 
## pmethod="backward" would have selected the same model:
##     8 terms 7 preds,  GRSq 0.8354593  RSq 0.8450554  mean.oof.RSq 0.8330208

模型有8項，包括截距和7個預測變量。其中兩個預測變量有鉸鏈函數，這就是濃度（thick）和染色質（chrom）變量。如果濃度大于3，就會用系數0.7019乘以鉸鏈函數的值，否則這一項就是0。對于染色質，如果它的值小于3，那么就用系數乘以鉸鏈函數值，否則這一項就是0。

統計圖展示了保持其他預測變量不變，某個預測變量發生變化時，相應變量發生的改變。可以清楚地看到鉸鏈函數對濃度（thick）所起的作用。

> plotmo(earth.fit)

##  plotmo grid:    thick u.size u.shape ashsn s.size nucl chrom n.nuc mit
##                      4      1       2     1      2    1     3     1   1

統計圖

生成按類別標簽分類的預測概率密度圖：

> plotd(earth.fit)

預測概率密度圖

查看變量的相對重要性：

> # nsubsets表示精簡過程完成之后包含這個變量的模型的個數 
> # gcv和 rss的范圍都是0~100，值表示這個變量貢獻的 gcv 和 rss 值的減少量
> evimp(earth.fit)

##        nsubsets   gcv    rss
## nucl          7 100.0  100.0
## u.size        6  44.2   44.8
## thick         5  23.8   25.1
## n.nuc         4  15.1   16.8
## chrom         3   8.3   10.7
## s.size        2   6.0    8.1
## ashsn         1   2.3    4.6

模型在測試集上的錯誤率：

> test.earth.prob <- predict(earth.fit, newdata = test, type = "class")
> test.earth.err <- test_err(test, test.earth.prob)
> print(test.earth.err)

## [1] 0.02870813

錯誤率為2.875%，跟邏輯斯蒂回歸模型差不多。

5、模型選擇

> p_load(ROCR)
> 
> # 最差bad
> bad.fit <- glm(class ~ thick, family = binomial, data = test)
> test.bad.prob <- predict(bad.fit, type = "response")
> 
> pred.full <- prediction(test.prob, test$class)
> perf.full <- performance(pred.full, "tpr", "fpr")
> plot(perf.full, main = "ROC", col = 1)
> 
> pred.bic <- prediction(test.prob.3, test$class)
> perf.bic <- performance(pred.bic, "tpr", "fpr")
> plot(perf.bic, col = 2, add = TRUE)
> 
> # bad
> pred.bad <- prediction(test.bad.prob, test$class)
> perf.bad <- performance(pred.bad, "tpr", "fpr")
> plot(perf.bad, col = 3, add = TRUE)
> 
> # earth
> test.earth.p <- predict(earth.fit, newdata = test, type = "response")
> pred.earth <- prediction(test.earth.p, test$class)
> perf.earth <- performance(pred.earth, "tpr", "fpr")
> plot(perf.earth, col = 4, add = TRUE)
> 
> legend(0.6, 0.6, c("FULL", "BIC", "BAD", "EARTH"), 1:4)

ROC

可以看到，全特征模型、BIC模型和MARS模型基本上重疊在一起。顯而易見， 糟糕的模型表現得和我們預想的一樣差。

計算AUC：

> performance(pred.full, "auc")@y.values

## [[1]]
## [1] 0.9972672

> performance(pred.bic, "auc")@y.values

## [[1]]
## [1] 0.9944293

> performance(pred.bad, "auc")@y.values

## [[1]]
## [1] 0.8962056

> performance(pred.earth, "auc")@y.values

## [[1]]
## [1] 0.9952701

最高的AUC值是全模型的99.7%，BIC模型是99.4%，糟糕模型是89.6%，MARS模型是99.5%。所以，從各個方面來看，排除掉糟糕模型，其他幾個模型在預測能力方面沒有什么區別。我們該怎么做？一個簡單的解決方案就是，將訓練集和測試集重新隨機化，把各種分析再做一遍，比如使用60/40的劃分比例和一個不同的隨機數種子。但是，如果我們還是得到相同的結果，又該怎么辦？我認為，一個純粹的統計學家會建議選擇最簡約的模型，但其他人可能更傾向于全特征模型。這就又歸結到各種因素的權衡問題了，比如模型準確性與解釋性、簡約性與擴展性之間的權衡。在本章的例子中，我們完全可以選擇更簡單的模型，它具有和全模型一樣的正確性。