Boosting은 이전 모형의 정보를 이용하여 다음 모형을 순차적으로 생성하는 알고리즘이다. 가장 대표적인 기법은 AdaBoost와 Gradient Boosting이며, 예제 데이터를 이용해 각 기법을 수행해보았다.
예제 데이터는 “Universal Bank_Main”로 유니버셜 은행의 고객들에 대한 데이터(출처 : Data Mining for Business Intelligence, Shmueli et al. 2010)이다. 데이터는 총 2500개이며, 변수의 갯수는 13개이다. 여기서 Target은Person.Loan이다.
1. 데이터 불러오기
pacman::p_load("data.table", "dplyr")
UB <- fread(paste(getwd(),"Universal Bank_Main.csv", sep="/")) %>% # 데이터 불러오기
data.frame() %>% # Data frame 변환환
mutate(Personal.Loan = ifelse(Personal.Loan==1, "yes","no")) %>% # Character for classification
select(-1) # ID변수 제거거
cols <- c("Family", "Education", "Personal.Loan", "Securities.Account",
"CD.Account", "Online", "CreditCard")
UB <- UB %>%
mutate_at(cols, as.factor) # 범주형 변수 변환
glimpse(UB) # 데이터 구조
Rows: 2,500
Columns: 13
$ Age <int> 25, 45, 39, 35, 35, 37, 53, 50, 35, 34, 6~
$ Experience <int> 1, 19, 15, 9, 8, 13, 27, 24, 10, 9, 39, 5~
$ Income <int> 49, 34, 11, 100, 45, 29, 72, 22, 81, 180,~
$ ZIP.Code <int> 91107, 90089, 94720, 94112, 91330, 92121,~
$ Family <fct> 4, 3, 1, 1, 4, 4, 2, 1, 3, 1, 4, 3, 2, 4,~
$ CCAvg <dbl> 1.6, 1.5, 1.0, 2.7, 1.0, 0.4, 1.5, 0.3, 0~
$ Education <fct> 1, 1, 1, 2, 2, 2, 2, 3, 2, 3, 3, 2, 3, 2,~
$ Mortgage <int> 0, 0, 0, 0, 0, 155, 0, 0, 104, 0, 0, 0, 0~
$ Personal.Loan <fct> no, no, no, no, no, no, no, no, no, yes, ~
$ Securities.Account <fct> 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,~
$ CD.Account <fct> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,~
$ Online <fct> 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1,~
$ CreditCard <fct> 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0,~2. 데이터 분할
3. AdaBoost
AdaBoost는 Boositng에서 가장 많이 사용되는 기법 중 하나이다. AdaBoost는를 수행할 수 있는 Package는
"adabag","ada","fastAdaboost"가 있으며, 예제 데이터에는"adabag"를 사용하였다."adabag"는 Package"rpart"이용하여 tree를 생성하기 때문에rpart.control로 다양한 옵션을 조정할 수 있다. 자세한 내용은 여기를 참고한다.
boosting(formula, data, mfinal, ...) # AdaBoost
boosting.cv(formula, data, v, mfinal, ...) # AdaBoost based on Cross Validation
formula: Target과 예측 변수에 대한 공식으로써 일반적으로Target ~ 예측변수사용data:formula의 변수들이 있는 데이터 프레임mfinal: 반복 횟수v: Cross Validation의 Fold 수
3-1. 모형 적합
"adabag"는 Package"rpart"이용하여 tree를 생성하며, 생성될 tree의 최대 깊이의 기본값은 30으로 좀 더 flexible한 tree를 이용하게 된다. 만약stump를 생성하고 싶다면 다음과 같은 코드를 이용하면 되지만 시간이 너무 오래 걸리는 단점이 있으므로 예제 데이터에서는 최대 깊이의 기본값을 사용하였다.
rc <- rpart.control(maxdepth = 1) # Generate Stumps
set.seed(100)
UB.ada <- boosting(Personal.Loan~., data=UB.trd,
mfinal=50, control = rc) # mfinal : 부스팅 반복 횟수수
3-1-1. 변수 중요도
# 변수 중요도도
UB.ada$importance
Age CCAvg CD.Account
9.9012456 16.1053091 3.9925553
CreditCard Education Experience
0.5879823 10.8749569 4.1984491
Family Income Mortgage
12.9359815 27.1774414 2.9310470
Online Securities.Account ZIP.Code
1.9911979 1.5755629 7.7282709 3-1-2. 가중치
UB.ada$weights # 각 Tree에 대한 정보의 양양
[1] 2.097443 1.785371 1.888646 1.712952 1.930341 1.351791 1.533943
[8] 1.867797 2.079210 1.650867 1.558312 1.571629 1.568280 1.630037
[15] 1.493036 1.681824 1.320032 2.108837 1.774053 1.494161 1.341960
[22] 1.434802 1.522104 1.359487 1.621086 1.262478 1.834848 1.891252
[29] 2.588213 2.343896 1.805872 1.870432 1.693862 1.747194 1.436110
[36] 1.657372 1.433991 1.753571 1.312846 1.796001 1.398650 1.561027
[43] 1.376526 1.554646 1.862709 1.281312 1.940800 1.581615 1.752497
[50] 1.4391173-2. 모형 평가
# 적합된 모형에 대하여 Test Data 예측NAUB.pred.ada <- predict(UB.ada, newdata=UB.ted) # predict(AdaBoost모형, Test Data)ConfusionMatrix
pp <- as.factor(UB.pred.ada$class) # 예측 클래스 : Charactor r
# Character covert to Factor
confusionMatrix(pp, UB.ted$Personal.Loan, positive="yes") # confusionMatrix(예측 클래스, 실제 클래스, positive = "관심 클래스") 클래스")
Confusion Matrix and Statistics
Reference
Prediction no yes
no 668 13
yes 5 63
Accuracy : 0.976
95% CI : (0.9623, 0.9857)
No Information Rate : 0.8985
P-Value [Acc > NIR] : < 2e-16
Kappa : 0.8618
Mcnemar's Test P-Value : 0.09896
Sensitivity : 0.82895
Specificity : 0.99257
Pos Pred Value : 0.92647
Neg Pred Value : 0.98091
Prevalence : 0.10147
Detection Rate : 0.08411
Detection Prevalence : 0.09079
Balanced Accuracy : 0.91076
'Positive' Class : yes
ROC 곡선
1) Package “pROC”
pacman::p_load("pROC")
ac <- UB.ted$Personal.Loan # 실제 클래스래스
pp <- UB.pred.ada$prob[,2] # "yes"에 대한 예측 확률 출력
ada.roc <- roc(ac, pp, plot=T, col="red") # roc(실제 클래스, 예측 확률)률)
auc <- round(auc(ada.roc), 3) # AUC
legend("bottomright",legend=auc, bty="n")
detach(package:pROC)
2) Package “Epi”
# install.packages("Epi")
pacman::p_load("Epi")
# install_version("etm", version = "1.1", repos = "http://cran.us.r-project.org")
ROC(pp,ac, plot="ROC") # ROC(예측 확률 , 실제 클래스)
detach(package:Epi)
3) Package “ROCR”
pacman::p_load("ROCR")
ada.pred <- prediction(pp, ac) # prediction(예측 확률, 실제 클래스)스)
ada.perf <- performance(ada.pred, "tpr", "fpr") # performance(, "민감도", "1-특이도")
plot(ada.perf, col="red") # ROC Curve
abline(0,1, col="black")
perf.auc <- performance(ada.pred, "auc") # AUC
auc <- attributes(perf.auc)$y.values
legend("bottomright",legend=auc,bty="n")
향상 차트
1) Package “ROCR”
ada.lift <- performance(ada.pred,"lift", "rpp") # Lift chart
plot(ada.lift, colorize=T, lwd=2)
detach(package:ROCR)
2) Package “lift”
# install.packages("lift")
pacman::p_load("lift")
ac.numeric <- ifelse(UB.ted$Personal.Loan=="yes",1,0) # 실제 클래스를 수치형으로 변환 변환
plotLift(pp, ac.numeric, cumulative = T, n.buckets =24) # plotLift(예측 확률, 실제 클래스)스)
TopDecileLift(pp, ac.numeric) # Top 10% 향상도 출력[1] 9.198detach(package:lift)
4. Gradient Boosting
Gradient Boosting은 Boosting에서 가장 많이 쓰이는 방법 중 하나이며, 손실함수가 최소가 되도록하는 값을 예측한다. Gradient Boosting을 수행하기 위하여 Package
"gbm"을 사용하였다. 자세한 내용은 여기를 참고한다.
gbm(formula, data, distribution, n.trees, interaction.depth, shrinkage, cv.folds, ...)
formula: Target과 예측 변수에 대한 공식으로써 일반적으로Target ~ 예측변수사용data:formula의 변수들이 있는 데이터 프레임distribution: Loss Functionn.trees: 생성할 나무 수interaction.depth: 생성되는 나무의 최대 깊이shrinkage: Learning Ratecv.folds: Cross Validation의 Fold 수로, 값을 지정해준다면 모형은 Cross Validation을 수행하며 적합
4-1. 모형 적합
pacman::p_load("gbm")
# gbm 은 distribution="bernoulli"일 때, Target이 0,1이어야함NAUB.trd <- UB.trd %>%
mutate(Personal.Loan = ifelse(Personal.Loan=="yes", 1,0))
set.seed(100)
UB.gbm <- gbm(Personal.Loan~., data=UB.trd,
distribution="bernoulli", # distribution : loss function/ 범주형 : bernoulli(이진분류) / 수치형 : gaussian(squared error) NA=50, # 생성되는 tree의 수
interaction.depth=30, # 각 tree의 최대 깊이NA= 0.1, # Learning Rate
cv.folds=5) # Cross Validation 수
4-1-1. 변수 중요도
# 변수 중요도도
summary(UB.gbm, cBars = 10, las=2) # cBars : 상위 몇개 나타낼 것인지
var rel.inf
Income Income 37.52364193
Education Education 31.98234478
Family Family 15.62228585
CCAvg CCAvg 9.56978513
Age Age 1.61879220
ZIP.Code ZIP.Code 1.18463099
CD.Account CD.Account 0.95565779
Mortgage Mortgage 0.70182276
Experience Experience 0.41586694
Online Online 0.30314118
CreditCard CreditCard 0.06232404
Securities.Account Securities.Account 0.059706414-1-2. 최적 부스팅 반복 수 찾기
ntrees.op <- gbm.perf(UB.gbm, plot.it = T, method="cv")
- 검은 선은 Train Error이며, 초록선은 Validation Error이다.
ntrees.op
[1] 48# 최적의 반복횟수로 다시 적합NAset.seed(100)
UB.gbm <- gbm(Personal.Loan~., data=UB.trd,
distribution="bernoulli", # distribution : loss function/ 범주형 : bernoulli(이진분류) / 수치형 : gaussian(squared error) NA=ntrees.op, # 생성되는 tree의 수
interaction.depth=30, # 각 tree의 최대 깊이NA= 0.1, # Learning Rate
cv.folds=5) # Cross Validation 수
4-2. 모형 평가
# 적합된 모형에 대하여 Test Data 예측NAUB.pred.gbm <- predict(UB.gbm, newdata=UB.ted,
type="response", # "1"에 대한 예측확률 출력 ntrees=ntrees.op) # ntrees : 몇 개의 나무를 사용하여 예측할 것인지
# gbm은 distribution이 distribution이 "bernoulli"일 때, type="response"를 해야 예측 확률을 return NAConfusionMatrix
cv <- 0.5 # cutoff value
pp <- as.factor(ifelse(UB.pred.gbm>cv,"yes","no")) # 예측 확률>cv이면 "yes" 아니면 "no"
confusionMatrix(pp, UB.ted$Personal.Loan, positive="yes") # confusionMatrix(예측 클래스, 실제 클래스, positive = "관심 클래스") 클래스")
Confusion Matrix and Statistics
Reference
Prediction no yes
no 672 9
yes 1 67
Accuracy : 0.9866
95% CI : (0.9756, 0.9936)
No Information Rate : 0.8985
P-Value [Acc > NIR] : < 2e-16
Kappa : 0.9232
Mcnemar's Test P-Value : 0.02686
Sensitivity : 0.88158
Specificity : 0.99851
Pos Pred Value : 0.98529
Neg Pred Value : 0.98678
Prevalence : 0.10147
Detection Rate : 0.08945
Detection Prevalence : 0.09079
Balanced Accuracy : 0.94005
'Positive' Class : yes
ROC 곡선
1) Package “pROC”
pacman::p_load("pROC")
ac <- UB.ted$Personal.Loan # 실제 클래스래스
pp <- UB.pred.gbm # "1=yes"에 대한 예측 확률 출력
gbm.roc <- roc(ac, pp, plot=T, col="red") # roc(실제 클래스, 예측 확률)률)
auc <- round(auc(gbm.roc), 3) # AUC
legend("bottomright",legend=auc, bty="n")
detach(package:pROC)
2) Package “Epi”
# install.packages("Epi")
pacman::p_load("Epi")
# install_version("etm", version = "1.1", repos = "http://cran.us.r-project.org")
ROC(pp,ac, plot="ROC") # ROC(예측 확률 , 실제 클래스)
detach(package:Epi)
3) Package “ROCR”
pacman::p_load("ROCR")
gbm.pred <- prediction(pp, ac) # prediction(예측 확률, 실제 클래스)스)
gbm.perf <- performance(gbm.pred, "tpr", "fpr") # performance(, "민감도", "1-특이도")
plot(gbm.perf, col="red") # ROC Curve
abline(0,1, col="black")
perf.auc <- performance(gbm.pred, "auc") # AUC
auc <- attributes(perf.auc)$y.values
legend("bottomright",legend=auc,bty="n")
향상 차트
1) Package “ROCR”
gbm.lift <- performance(gbm.pred,"lift", "rpp") # Lift chart
plot(gbm.lift, colorize=T, lwd=2)
detach(package:ROCR)
2) Package “lift”
# install.packages("lift")
pacman::p_load("lift")
ac.numeric <- ifelse(UB.ted$Personal.Loan=="yes",1,0) # 실제 클래스를 수치형으로 변환 변환
plotLift(pp, ac.numeric, cumulative = T, n.buckets =24) # plotLift(예측 확률, 실제 클래스)스)
TopDecileLift(pp, ac.numeric) # Top 10% 향상도 출력[1] 8.804detach(package:lift)
5. XGBoost
XGBoost는 Extreme Gradient Boosting으로 Gradient Boosting을 기반으로 확장되었다. XGBoost를 수행하기 위해 Package
"xgboost"를 사용하였다. 자세한 내용은 여기를 참고한다.
xgb.train(params, data, nrounds, watchlist, , ...)
params: XGBoost의 Hyperparameter들에 대한 정보가 있는Listdata:xgb.DMatrix형태의 datasetnrounds: 최대 반복 수watchlist: 모형 성능 평가에 사용할xgb.DMatrixdataset의 이름이 적혀있는List
5-1. 모형 적합
pacman::p_load("xgboost", # For xgb.train
"Matrix") # For sparse.model.matrix
# XGBoost는 변수가 모두 수치형이어야 함!# sparse.model.matrix : 범주형 변수를 더미변수로 바꿔줌
trainm <- sparse.model.matrix(Personal.Loan ~. , # Personal.Loan은 Target으로 제외
data=UB.trd)
testm <- sparse.model.matrix(Personal.Loan ~. , # Personal.Loan은 Target으로 제외
data=UB.ted)
# For xgb.train
train_matrix <- xgb.DMatrix(data=as.matrix(trainm), label=UB.trd$Personal.Loan)
test_matrix <- xgb.DMatrix(data=as.matrix(testm), label=UB.ted$Personal.Loan)
# Parameters
xgb_params <- list(objective = "binary:logistic", # Target 형태에 따른 분석방법 지정
eta = 0.01, # Learning Rate
gamma = 0, # 분할하기 위해 필요한 최소 손실 감소/ 클수록 분할이 쉽게 일어나지 않음NA= 5, # Tree의 최대 깊이NA= 1, # 하나의 leaf node가 가져야할 최소 가중치/ 만약 가중치보다 작으면 분할이 일어나지 않음NA= 1, # 원 Data로부터 모형 구축시 사용할 Sample 비율/ 1이면 그냥 원 DataNA= 1) # Regularization
watchlist <- list(train=train_matrix)
set.seed(100)
UB.xgb <- xgb.train(params = xgb_params, # List 형식의 모수 조합NA=train_matrix, # xgb.DMatrix 형식의 데이터NA= 50, # nrounds : 최대 반복 수
watchlist = watchlist)
[1] train-error:0.009709
[2] train-error:0.009709
[3] train-error:0.009709
[4] train-error:0.009709
[5] train-error:0.009709
[6] train-error:0.010280
[7] train-error:0.010280
[8] train-error:0.010280
[9] train-error:0.010280
[10] train-error:0.010280
[11] train-error:0.010280
[12] train-error:0.010280
[13] train-error:0.010280
[14] train-error:0.010280
[15] train-error:0.010280
[16] train-error:0.010280
[17] train-error:0.011422
[18] train-error:0.011422
[19] train-error:0.011422
[20] train-error:0.011422
[21] train-error:0.011422
[22] train-error:0.011422
[23] train-error:0.010280
[24] train-error:0.011422
[25] train-error:0.011422
[26] train-error:0.011422
[27] train-error:0.011422
[28] train-error:0.010280
[29] train-error:0.010280
[30] train-error:0.010280
[31] train-error:0.011422
[32] train-error:0.010280
[33] train-error:0.010280
[34] train-error:0.010280
[35] train-error:0.010280
[36] train-error:0.010280
[37] train-error:0.010280
[38] train-error:0.010280
[39] train-error:0.009709
[40] train-error:0.010280
[41] train-error:0.009709
[42] train-error:0.009709
[43] train-error:0.009709
[44] train-error:0.009138
[45] train-error:0.009138
[46] train-error:0.007995
[47] train-error:0.007995
[48] train-error:0.007995
[49] train-error:0.007995
[50] train-error:0.007995 5-1-1. 변수 중요도
# 변수 중요도도
importance <- xgb.importance(feature_names = colnames(trainm), model = UB.xgb)
head(importance)
Feature Gain Cover Frequency
1: Income 0.41051727 0.42115554 0.33107191
2: Education3 0.20465209 0.07438741 0.06784261
3: Education2 0.16415423 0.07938272 0.06784261
4: Family4 0.09962531 0.05241373 0.06784261
5: Family3 0.05755740 0.04849138 0.06784261
6: CCAvg 0.04462385 0.30389002 0.20624152xgb.plot.importance(importance_matrix = importance)
5-1-2. Training Data Error Plot
plot(UB.xgb$evaluation_log$train_error,
col="blue", type="l", xlab="iter", ylab="Error")
5-2. 모형 평가
# 적합된 모형에 대하여 Test Data 예측NAUB.pred.xgb <- predict(UB.xgb, test_matrix) # "1"에 대한 예측 확률
ConfusionMatrix
cv <- 0.5 # cutoff value
pp <- as.factor(ifelse(UB.pred.xgb>cv,"yes","no")) # 예측 확률>cv이면 "yes" 아니면 "no"
confusionMatrix(pp, UB.ted$Personal.Loan, positive="yes") # confusionMatrix(예측 클래스, 실제 클래스, positive = "관심 클래스") 클래스")
Confusion Matrix and Statistics
Reference
Prediction no yes
no 664 12
yes 9 64
Accuracy : 0.972
95% CI : (0.9575, 0.9826)
No Information Rate : 0.8985
P-Value [Acc > NIR] : 9.195e-15
Kappa : 0.8435
Mcnemar's Test P-Value : 0.6625
Sensitivity : 0.84211
Specificity : 0.98663
Pos Pred Value : 0.87671
Neg Pred Value : 0.98225
Prevalence : 0.10147
Detection Rate : 0.08545
Detection Prevalence : 0.09746
Balanced Accuracy : 0.91437
'Positive' Class : yes
ROC 곡선
1) Package “pROC”
pacman::p_load("pROC")
ac <- UB.ted$Personal.Loan # 실제 클래스래스
pp <- UB.pred.xgb # "1=yes"에 대한 예측 확률 출력
xgb.roc <- roc(ac, pp, plot=T, col="red") # roc(실제 클래스, 예측 확률)률)
auc <- round(auc(xgb.roc), 3) # AUC
legend("bottomright",legend=auc, bty="n")
detach(package:pROC)
2) Package “Epi”
# install.packages("Epi")
pacman::p_load("Epi")
# install_version("etm", version = "1.1", repos = "http://cran.us.r-project.org")
ROC(pp,ac, plot="ROC") # ROC(예측 확률 , 실제 클래스)
detach(package:Epi)
3) Package “ROCR”
pacman::p_load("ROCR")
xgb.pred <- prediction(pp, ac) # prediction(예측 확률, 실제 클래스)스)
xgb.perf <- performance(xgb.pred, "tpr", "fpr") # performance(, "민감도", "1-특이도")
plot(xgb.perf, col="red") # ROC Curve
abline(0,1, col="black")
perf.auc <- performance(xgb.pred, "auc") # AUC
auc <- attributes(perf.auc)$y.values
legend("bottomright",legend=auc,bty="n")
향상 차트
1) Package “ROCR”
xgb.lift <- performance(xgb.pred,"lift", "rpp") # Lift chart
plot(xgb.lift, colorize=T, lwd=2)
detach(package:ROCR)
2) Package “lift”
# install.packages("lift")
pacman::p_load("lift")
ac.numeric <- ifelse(UB.ted$Personal.Loan=="yes",1,0) # 실제 클래스를 수치형으로 변환 변환
plotLift(pp, ac.numeric, cumulative = T, n.buckets =24) # plotLift(예측 확률, 실제 클래스)스)
TopDecileLift(pp, ac.numeric) # Top 10% 향상도 출력[1] 8.41detach(package:lift)
6. 모형 비교
plot(ada.roc, col="red") # ROC Curve
par(new=TRUE)
plot(gbm.roc, col="green") # ROC Curve
par(new=TRUE)
plot(xgb.roc, col="orange") # ROC Curve
legend("bottomright", legend=c("AdaBoost", "GBM", "XGBoost" ),
col=c( "red", "green", "orange"), lty=c(1,1,1))
