使用 R 进行集成建模

2019-11-21 08:00:00 · 飞浪

集成方法是将不同的、独立的模型（也称为“弱学习者”）组合起来以产生结果的过程。

介绍

集成方法是解决复杂机器学习问题的常用高级技术。简单来说，集成方法是将不同的独立模型（也称为“弱学习器”）组合起来以产生结果的过程。假设组合多个模型可以通过减少泛化误差来产生更好的结果。

集成建模最流行的三种方法是bagging、boosting和stacking。在本指南中，您将学习如何使用 R 实现这些技术。

数据

在本指南中，我们将使用一个虚构的贷款申请人数据集，其中包含 600 个观测值和 10 个变量，如下所述：

Marital_status：申请人是否已婚（“是”）或未婚（“否”）
Is_graduate：申请人是否为毕业生（“是”）或不是（“否”）
收入：申请人的年收入（美元）
Loan_amount：提交申请的贷款金额（美元）
Credit_score：申请人的信用评分是好（“好”）还是不好（“坏”）
Approval_status：贷款申请是否被批准（“是”）或不被批准（“否”）
年龄：申请人的年龄（岁）
性别：申请人是男性（“M”）还是女性（“F”）
投资额：申请人申报的股票和共同基金投资总额（美元）
目的：申请贷款的目的

让我们首先加载所需的库和数据。

      library(plyr)
library(readr)
library(dplyr)
library(caret)
library(caretEnsemble)
library(ROSE)

dat <- read_csv("data_set.csv")

glimpse(dat)
    

输出：

      Observations: 600
Variables: 10
$ Marital_status  <chr> "Yes", "No", "Yes", "No", "Yes", "Yes", "Yes", "Yes", ...
$ Is_graduate     <chr> "No", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes",...
$ Income          <int> 30000, 30000, 30000, 30000, 89900, 133300, 136700, 136...
$ Loan_amount     <int> 60000, 90000, 90000, 90000, 80910, 119970, 123030, 123...
$ Credit_score    <chr> "Satisfactory", "Satisfactory", "Satisfactory", "Satis...
$ approval_status <chr> "Yes", "Yes", "No", "No", "Yes", "No", "Yes", "Yes", "...
$ Age             <int> 25, 29, 27, 33, 29, 25, 29, 27, 33, 29, 25, 29, 27, 33...
$ Sex             <chr> "F", "F", "M", "F", "M", "M", "M", "F", "F", "F", "M",...
$ Investment      <int> 21000, 21000, 21000, 21000, 62930, 93310, 95690, 95690...
$ Purpose         <chr> "Education", "Travel", "Others", "Others", "Travel", "...
    

输出显示数据集有五个数值变量（标记为int）和五个字符变量（标记为chr）。我们将使用下面的代码行将它们转换为因子变量。

      names <- c(1,2,5,6,8,10)
dat[,names] <- lapply(dat[,names] , factor)
glimpse(dat)
    

输出：

      Observations: 600
Variables: 10
$ Marital_status  <fct> Yes, No, Yes, No, Yes, Yes, Yes, Yes, Yes, Yes, No, No...
$ Is_graduate     <fct> No, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, No, Y...
$ Income          <int> 30000, 30000, 30000, 30000, 89900, 133300, 136700, 136...
$ Loan_amount     <int> 60000, 90000, 90000, 90000, 80910, 119970, 123030, 123...
$ Credit_score    <fct> Satisfactory, Satisfactory, Satisfactory, Satisfactory...
$ approval_status <fct> Yes, Yes, No, No, Yes, No, Yes, Yes, Yes, No, No, No, ...
$ Age             <int> 25, 29, 27, 33, 29, 25, 29, 27, 33, 29, 25, 29, 27, 33...
$ Sex             <fct> F, F, M, F, M, M, M, F, F, F, M, F, F, M, M, M, M, M, ...
$ Investment      <int> 21000, 21000, 21000, 21000, 62930, 93310, 95690, 95690...
$ Purpose         <fct> Education, Travel, Others, Others, Travel, Travel, Tra...
    

构建和评估单一算法

集成建模的目标是通过组合多个模型来提高基准模型的性能。因此，我们将从一种算法开始设置基准性能指标。在我们的例子中，我们将构建一个逻辑回归算法。

我们将在训练集上构建模型，并在测试集上评估其性能。这称为用于评估模型性能的保留验证方法。

下面的第一行代码设置了随机种子，以确保结果的可重复性。第二行加载用于数据分区的caTools包，而第三至第五行创建训练和测试数据集。训练集包含 70% 的数据（10 个变量的 420 个观测值），测试集包含剩余的 30%（10 个变量的 180 个观测值）。

      set.seed(100)
library(caTools)

spl = sample.split(dat$approval_status, SplitRatio = 0.7)
train = subset(dat, spl==TRUE)
test = subset(dat, spl==FALSE)

print(dim(train)); print(dim(test))
    

输出：

      1] 420  10

[1] 180  10

建立、预测和评估模型

为了拟合逻辑回归模型，第一步是实例化算法，这可以使用下面的第一行代码完成。第二行使用训练好的算法对测试数据进行预测。第三行生成混淆矩阵，而第四行打印测试数据的准确性。

      model_glm = glm(approval_status ~ . , family="binomial", data = train)

#Predictions on the test set
predictTest = predict(model_glm, newdata = test, type = "response")

# Confusion matrix on test set
table(test$approval_status, predictTest >= 0.5)
158/nrow(test) #Accuracy - 88%
    

输出：

      1] 0.8777778

我们看到单个模型的准确率为 88%。现在我们将构建各种集成模型，看看它们是否能提高性能。

装袋

Bagging 或 bootstrap 聚合是一种集成方法，它涉及使用从训练数据中抽取的不同子集多次训练同一算法。然后，最终输出预测是所有子模型预测的平均值。两种最流行的 bagging 集成技术是Bagged 决策树和随机森林。

袋装决策树

此方法最适合方差较大的算法，例如决策树。我们首先在第一行代码中设置种子。第二行指定用于控制模型训练过程的参数，而第三行训练 bagged 树算法。参数method="treebag"指定算法。第四到第六行代码对测试数据生成预测，创建混淆矩阵，并计算准确率，结果为 79%。这并不比逻辑回归模型好。

      set.seed(100)

control1 <- trainControl(sampling="rose",method="repeatedcv", number=5, repeats=5)

bagCART_model <- train(approval_status ~., data=train, method="treebag", metric="Accuracy", trControl=control1)

#Predictions on the test set
predictTest = predict(bagCART_model, newdata = test)

# Confusion matrix on test set
table(test$approval_status, predictTest)
142/nrow(test) #Accuracy - 78.9%
    

输出：

      predictTest
       No Yes
  No   33  24
  Yes  14 109

[1] 0.7888889
    

随机森林

随机森林是袋装决策树的扩展，其中训练数据集的样本是随机抽取的。构建决策树的目的是降低各个决策树之间的相关性。

我们遵循与上述相同的步骤，但在训练算法时，我们设置method="rf"来指定要构建随机森林模型。随机森林集成的准确率为 92%，与之前构建的模型相比有显著的提高。

      set.seed(100)

control1 <- trainControl(sampling="rose",method="repeatedcv", number=5, repeats=5)

rf_model <- train(approval_status ~., data=train, method="rf", metric="Accuracy", trControl=control1)

predictTest = predict(rf_model, newdata = test, type = "raw")

# Confusion matrix on test set
table(test$approval_status, predictTest)
165/nrow(test) #Accuracy - 91.67%

输出：

      1] 0.9166667

提升

在 boosting 中，多个模型会按顺序进行训练，每个模型都会从其前辈的错误中学习。在本指南中，我们将实现梯度 boosting 算法。

随机梯度提升

增强算法专注于分类问题，旨在将一组弱分类器转换为强分类器。

我们遵循与上述相同的步骤，但在训练算法时，我们设置method="gbm"以指定要构建梯度提升模型。该模型的准确率为 78.9%，低于基线准确率。

      set.seed(100)
control2 <- trainControl(sampling="rose",method="repeatedcv", number=5, repeats=5)

gbm_model <- train(approval_status ~., data=train, method="gbm", metric="Accuracy", trControl=control2)

predictTest = predict(gbm_model, newdata = test)

table(test$approval_status, predictTest)
142/nrow(test) #Accuracy - 78.9%
    

输出：

      1] 0.7888889

堆叠

在这种方法中，使用caretEnsemble包将多个 caret 模型的预测组合在一起。然后，给定模型列表，使用caretStack()函数指定高阶模型，以了解如何最好地将子模型的预测组合在一起。第一行代码设置种子，而第二行指定建模时要使用的控制参数。第三行使用要使用的算法列表，而第四行使用 caretList ()函数来训练模型。第六行打印结果摘要。输出显示SVM算法创建了最准确的模型，平均准确率为 92.7%。

      set.seed(100)

control_stacking <- trainControl(method="repeatedcv", number=5, repeats=2, savePredictions=TRUE, classProbs=TRUE)

algorithms_to_use <- c('rpart', 'glm', 'knn', 'svmRadial')

stacked_models <- caretList(approval_status ~., data=dat, trControl=control_stacking, methodList=algorithms_to_use)

stacking_results <- resamples(stacked_models)

summary(stacking_results)

输出：

      Call:
summary.resamples(object = stacking_results)

Models: rpart, glm, knn, svmRadial 
Number of resamples: 10 

Accuracy 
               Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
rpart     0.8333333 0.8562500 0.9000000 0.8975000 0.9250000 0.9833333    0
glm       0.8333333 0.8729167 0.8958333 0.8925000 0.9208333 0.9416667    0
knn       0.5666667 0.6020833 0.6583333 0.6375000 0.6645833 0.6750000    0
svmRadial 0.8833333 0.9041667 0.9208333 0.9266667 0.9395833 0.9916667    0

Kappa 
                Min.     1st Qu.      Median        Mean    3rd Qu.      Max. NA's
rpart      0.6148909  0.66732995 0.780053451  0.76715842 0.83288101 0.9620253    0
glm        0.6148909  0.71001041 0.767803348  0.75310834 0.81481075 0.8602794    0
knn       -0.2055641 -0.09025536 0.006059649 -0.02267757 0.05209491 0.1034483    0
svmRadial  0.7448360  0.78978371 0.826301181  0.83812274 0.86541005 0.9808795    0
    

让我们使用一个简单的逻辑回归模型来结合分类器的预测。输出显示准确率为 91.7%。

      # stack using glm
stackControl <- trainControl(method="repeatedcv", number=5, repeats=3, savePredictions=TRUE, classProbs=TRUE)

set.seed(100)

glm_stack <- caretStack(stacked_models, method="glm", metric="Accuracy", trControl=stackControl)

print(glm_stack)

输出：

      A glm ensemble of 2 base models: lda, rpart, glm, knn, svmRadial

Ensemble results:
Generalized Linear Model 

1200 samples
   5 predictor
   2 classes: 'No', 'Yes' 

No pre-processing
Resampling: Cross-Validated (5 fold, repeated 3 times) 
Summary of sample sizes: 960, 960, 960, 960, 960, 960, ... 
Resampling results:

  Acc

_{免责声明：本内容来源于第三方作者授权、网友推荐或互联网整理，旨在为广大用户提供学习与参考之用。所有文本和图片版权归原创网站或作者本人所有，其观点并不代表本站立场。如有任何版权侵犯或转载不当之情况，请与我们取得联系，我们将尽快进行相关处理与修改。感谢您的理解与支持！}

_查看原文

技术指南

R语言

阅读全文

使用 R 进行集成建模

杭州电子商务研究院

5年前 · 面向社会、服务行业、政产学研结合、整合资源、和谐发展

Observations: 600 Variables: 10 $ Marital_status <chr> "Yes", "No", "Yes", "No", "Yes", "Yes", "Yes", "Yes", ... $ Is_graduate <chr> "No", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes",... $ Income <int> 30000, 30000, 30000, 30000, 89900, 133300, 136700, 136... $ Loan_amount <int> 60000, 90000, 90000, 90000, 80910, 119970, 123030, 123... $ Credit_score <chr> "Satisfactory", "Satisfactory", "Satisfactory", "Satis... $ approval_status <chr> "Yes", "Yes", "No", "No", "Yes", "No", "Yes", "Yes", "... $ Age <int> 25, 29, 27, 33, 29, 25, 29, 27, 33, 29, 25, 29, 27, 33... $ Sex <chr> "F", "F", "M", "F", "M", "M", "M", "F", "F", "F", "M",... $ Investment <int> 21000, 21000, 21000, 21000, 62930, 93310, 95690, 95690... $ Purpose <chr> "Education", "Travel", "Others", "Others", "Travel", "...

Observations: 600 Variables: 10 $ Marital_status <fct> Yes, No, Yes, No, Yes, Yes, Yes, Yes, Yes, Yes, No, No... $ Is_graduate <fct> No, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, No, Y... $ Income <int> 30000, 30000, 30000, 30000, 89900, 133300, 136700, 136... $ Loan_amount <int> 60000, 90000, 90000, 90000, 80910, 119970, 123030, 123... $ Credit_score <fct> Satisfactory, Satisfactory, Satisfactory, Satisfactory... $ approval_status <fct> Yes, Yes, No, No, Yes, No, Yes, Yes, Yes, No, No, No, ... $ Age <int> 25, 29, 27, 33, 29, 25, 29, 27, 33, 29, 25, 29, 27, 33... $ Sex <fct> F, F, M, F, M, M, M, F, F, F, M, F, F, M, M, M, M, M, ... $ Investment <int> 21000, 21000, 21000, 21000, 62930, 93310, 95690, 95690... $ Purpose <fct> Education, Travel, Others, Others, Travel, Travel, Tra...

model_glm = glm(approval_status ~ . , family="binomial", data = train) #Predictions on the test set predictTest = predict(model_glm, newdata = test, type = "response") # Confusion matrix on test set table(test$approval_status, predictTest >= 0.5) 158/nrow(test) #Accuracy - 88%

set.seed(100) control1 <- trainControl(sampling="rose",method="repeatedcv", number=5, repeats=5) bagCART_model <- train(approval_status ~., data=train, method="treebag", metric="Accuracy", trControl=control1) #Predictions on the test set predictTest = predict(bagCART_model, newdata = test) # Confusion matrix on test set table(test$approval_status, predictTest) 142/nrow(test) #Accuracy - 78.9%

set.seed(100) control1 <- trainControl(sampling="rose",method="repeatedcv", number=5, repeats=5) rf_model <- train(approval_status ~., data=train, method="rf", metric="Accuracy", trControl=control1) predictTest = predict(rf_model, newdata = test, type = "raw") # Confusion matrix on test set table(test$approval_status, predictTest) 165/nrow(test) #Accuracy - 91.67%

set.seed(100) control2 <- trainControl(sampling="rose",method="repeatedcv", number=5, repeats=5) gbm_model <- train(approval_status ~., data=train, method="gbm", metric="Accuracy", trControl=control2) predictTest = predict(gbm_model, newdata = test) table(test$approval_status, predictTest) 142/nrow(test) #Accuracy - 78.9%

set.seed(100) control_stacking <- trainControl(method="repeatedcv", number=5, repeats=2, savePredictions=TRUE, classProbs=TRUE) algorithms_to_use <- c('rpart', 'glm', 'knn', 'svmRadial') stacked_models <- caretList(approval_status ~., data=dat, trControl=control_stacking, methodList=algorithms_to_use) stacking_results <- resamples(stacked_models) summary(stacking_results)

Call: summary.resamples(object = stacking_results) Models: rpart, glm, knn, svmRadial Number of resamples: 10 Accuracy Min. 1st Qu. Median Mean 3rd Qu. Max. NA's rpart 0.8333333 0.8562500 0.9000000 0.8975000 0.9250000 0.9833333 0 glm 0.8333333 0.8729167 0.8958333 0.8925000 0.9208333 0.9416667 0 knn 0.5666667 0.6020833 0.6583333 0.6375000 0.6645833 0.6750000 0 svmRadial 0.8833333 0.9041667 0.9208333 0.9266667 0.9395833 0.9916667 0 Kappa Min. 1st Qu. Median Mean 3rd Qu. Max. NA's rpart 0.6148909 0.66732995 0.780053451 0.76715842 0.83288101 0.9620253 0 glm 0.6148909 0.71001041 0.767803348 0.75310834 0.81481075 0.8602794 0 knn -0.2055641 -0.09025536 0.006059649 -0.02267757 0.05209491 0.1034483 0 svmRadial 0.7448360 0.78978371 0.826301181 0.83812274 0.86541005 0.9808795 0

# stack using glm stackControl <- trainControl(method="repeatedcv", number=5, repeats=3, savePredictions=TRUE, classProbs=TRUE) set.seed(100) glm_stack <- caretStack(stacked_models, method="glm", metric="Accuracy", trControl=stackControl) print(glm_stack)

A glm ensemble of 2 base models: lda, rpart, glm, knn, svmRadial Ensemble results: Generalized Linear Model 1200 samples 5 predictor 2 classes: 'No', 'Yes' No pre-processing Resampling: Cross-Validated (5 fold, repeated 3 times) Summary of sample sizes: 960, 960, 960, 960, 960, 960, ... Resampling results: Acc