Elastic Net Regression의 장점
- 예측 변수의 개수가 표본의 크기보다 큰 경우,
LASSO Regression의 문제(표본의 크기보다 많은 예측 변수를 선택 X)를 극복한다. - 예측 변수 사이에 어떤 그룹 구조(쌍별 상관 관계가 매우 높은)가 있을 때,
LASSO Regression의 문제(그룹에서 하나의 예측 변수만 선택)를 극복한다.
Elastic Net Regression의 단점
Ridge Regression이나LASSO Regression에 매우 근접하지 않을 경우, 만족스럽지 않은 결과를 보여준다.- 이중 수축 문제(Double Shrinkage Problem)가 발생한다.
Ridge Regression이나LASSO Regression에 비해 분산을 크게 줄이는 데 도움이 되지 않고, 불필요한 편의(bias)가 추가로 발생한다.
- 회귀계수에 대한 추정치만 계산이 가능하며, 회귀계수에 대한 추론(신뢰 구간 등)은 불가능하다.
실습 자료 : 유니버셜 은행의 고객 2,500명에 대한 자료(출처 : Data Mining for Business Intelligence, Shmueli et al. 2010)이며, 총 13개의 변수를 포함하고 있다. 이 자료에서 Target은
Personal Loan이다.
1. 데이터 불러오기
pacman::p_load("data.table",
"tidyverse",
"dplyr",
"ggplot2", "GGally",
"caret",
"doParallel", "parallel") # For 병렬 처리
registerDoParallel(cores=detectCores()) # 사용할 Core 개수 지정
UB <- fread("../Universal Bank_Main.csv") # 데이터 불러오기
UB %>%
as_tibble# A tibble: 2,500 × 14
ID Age Experience Income `ZIP Code` Family CCAvg Education
<int> <int> <int> <int> <int> <int> <dbl> <int>
1 1 25 1 49 91107 4 1.6 1
2 2 45 19 34 90089 3 1.5 1
3 3 39 15 11 94720 1 1 1
4 4 35 9 100 94112 1 2.7 2
5 5 35 8 45 91330 4 1 2
6 6 37 13 29 92121 4 0.4 2
7 7 53 27 72 91711 2 1.5 2
8 8 50 24 22 93943 1 0.3 3
9 9 35 10 81 90089 3 0.6 2
10 10 34 9 180 93023 1 8.9 3
# ℹ 2,490 more rows
# ℹ 6 more variables: Mortgage <int>, `Personal Loan` <int>,
# `Securities Account` <int>, `CD Account` <int>, Online <int>,
# CreditCard <int>2. 데이터 전처리
UB %<>%
data.frame() %>% # Data Frame 형태로 변환
mutate(Personal.Loan = ifelse(Personal.Loan == 1, "yes", "no")) %>% # Target을 문자형 변수로 변환
select(-1) # ID 변수 제거
# Convert to Factor
fac.col <- c("Family", "Education", "Securities.Account",
"CD.Account", "Online", "CreditCard",
# Target
"Personal.Loan")
UB <- UB %>%
mutate_at(fac.col, 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,…3. 데이터 탐색
ggpairs(UB,
columns = c("Age", "Experience", "Income", # 수치형 예측 변수
"ZIP.Code", "CCAvg", "Mortgage"),
aes(colour = Personal.Loan)) + # Target의 범주에 따라 색깔을 다르게 표현
theme_bw() 
ggpairs(UB,
columns = c("Age", "Experience", "Income", # 수치형 예측 변수
"ZIP.Code", "CCAvg", "Mortgage"),
aes(colour = Personal.Loan)) + # Target의 범주에 따라 색깔을 다르게 표현
scale_color_brewer(palette="Purples") + # 특정 색깔 지정
scale_fill_brewer(palette="Purples") + # 특정 색깔 지정
theme_bw()
ggpairs(UB,
columns = c("Age", "Income", # 수치형 예측 변수
"Family", "Education"), # 범주형 예측 변수
aes(colour = Personal.Loan, alpha = 0.8)) + # Target의 범주에 따라 색깔을 다르게 표현
scale_colour_manual(values = c("purple","cyan4")) + # 특정 색깔 지정
scale_fill_manual(values = c("purple","cyan4")) + # 특정 색깔 지정
theme_bw()
4. 데이터 분할
# Partition (Training Dataset : Test Dataset = 7:3)
y <- UB$Personal.Loan # Target
set.seed(200)
ind <- createDataPartition(y, p = 0.7, list = T) # Index를 이용하여 7:3으로 분할
UB.trd <- UB[ind$Resample1,] # Training Dataset
UB.ted <- UB[-ind$Resample1,] # Test Dataset5. 모형 훈련
Package "caret"은 통합 API를 통해 R로 기계 학습을 실행할 수 있는 매우 실용적인 방법을 제공한다. Package "caret"에서는 초모수의 최적의 조합을 찾는 방법으로 그리드 검색(Grid Search), 랜덤 검색(Random Search), 직접 탐색 범위 설정이 있다. 여기서는 초모수 alpha와 lambda의 최적의 조합값을 찾기 위해 그리드 검색을 수행하였고, 이를 기반으로 직접 탐색 범위를 설정하였다. 아래는 그리드 검색을 수행하였을 때 결과이다.
fitControl <- trainControl(method = "cv", number = 5, # 5-Fold Cross Validation (5-Fold CV)
allowParallel = TRUE) # 병렬 처리
set.seed(200) # For CV
elast.fit <- train(Personal.Loan ~ ., data = UB.trd,
trControl = fitControl ,
method = "glmnet",
preProc = c("center", "scale")) # Standardization for 예측 변수
elast.fitglmnet
1751 samples
12 predictor
2 classes: 'no', 'yes'
Pre-processing: centered (15), scaled (15)
Resampling: Cross-Validated (5 fold)
Summary of sample sizes: 1401, 1401, 1400, 1401, 1401
Resampling results across tuning parameters:
alpha lambda Accuracy Kappa
0.10 0.0003183706 0.9588767 0.7544648
0.10 0.0031837062 0.9583085 0.7440845
0.10 0.0318370619 0.9440244 0.6165418
0.55 0.0003183706 0.9588767 0.7544648
0.55 0.0031837062 0.9583085 0.7449441
0.55 0.0318370619 0.9320293 0.5154404
1.00 0.0003183706 0.9588767 0.7544648
1.00 0.0031837062 0.9577354 0.7420599
1.00 0.0318370619 0.9154758 0.3820311
Accuracy was used to select the optimal model using the
largest value.
The final values used for the model were alpha = 0.1 and lambda
= 0.0003183706.plot(elast.fit) # Plot
Result! 랜덤하게 결정된 3개의 초모수 alpha, lambda 값을 조합하여 만든 9개의 초모수 조합값 (alpha, lambda)에 대한 정확도를 보여주며, (alpha = 0.1, lambda = 0.0003183706)일 때 정확도가 가장 높은 것을 알 수 있다. 따라서 그리드 검색을 통해 찾은 최적의 초모수 조합값 (alpha = 0.1, lambda = 0.0003183706) 근처의 값들을 탐색 범위로 설정하여 훈련을 다시 수행할 수 있다.
customGrid <- expand.grid(alpha = seq(0.05, 0.15, by = 0.01), # alpha의 탐색 범위
lambda = seq(0.0001, 0.0005, by = 0.0001)) # lambda의 탐색 범위
set.seed(200) # For CV
elast.tune.fit <- train(Personal.Loan ~ ., data = UB.trd,
trControl = fitControl ,
method = "glmnet",
tuneGrid = customGrid,
preProc = c("center", "scale")) # Standardization for 예측 변수
elast.tune.fitglmnet
1751 samples
12 predictor
2 classes: 'no', 'yes'
Pre-processing: centered (15), scaled (15)
Resampling: Cross-Validated (5 fold)
Summary of sample sizes: 1401, 1401, 1400, 1401, 1401
Resampling results across tuning parameters:
alpha lambda Accuracy Kappa
0.05 1e-04 0.9588767 0.7526830
0.05 2e-04 0.9588767 0.7526830
0.05 3e-04 0.9588767 0.7526830
0.05 4e-04 0.9588767 0.7526830
0.05 5e-04 0.9594481 0.7551468
0.06 1e-04 0.9583053 0.7515390
0.06 2e-04 0.9583053 0.7515390
0.06 3e-04 0.9583053 0.7515390
0.06 4e-04 0.9588767 0.7526830
0.06 5e-04 0.9594481 0.7551468
0.07 1e-04 0.9583053 0.7515390
0.07 2e-04 0.9583053 0.7515390
0.07 3e-04 0.9583053 0.7515390
0.07 4e-04 0.9588767 0.7526830
0.07 5e-04 0.9594481 0.7551468
0.08 1e-04 0.9583053 0.7515390
0.08 2e-04 0.9583053 0.7515390
0.08 3e-04 0.9583053 0.7515390
0.08 4e-04 0.9588767 0.7526830
0.08 5e-04 0.9594481 0.7551468
0.09 1e-04 0.9583053 0.7515390
0.09 2e-04 0.9583053 0.7515390
0.09 3e-04 0.9583053 0.7515390
0.09 4e-04 0.9588767 0.7526830
0.09 5e-04 0.9594481 0.7551468
0.10 1e-04 0.9583053 0.7515390
0.10 2e-04 0.9583053 0.7515390
0.10 3e-04 0.9583053 0.7515390
0.10 4e-04 0.9588767 0.7526830
0.10 5e-04 0.9594481 0.7551468
0.11 1e-04 0.9583053 0.7515390
0.11 2e-04 0.9583053 0.7515390
0.11 3e-04 0.9583053 0.7515390
0.11 4e-04 0.9588767 0.7526830
0.11 5e-04 0.9588767 0.7526830
0.12 1e-04 0.9583053 0.7515390
0.12 2e-04 0.9583053 0.7515390
0.12 3e-04 0.9583053 0.7515390
0.12 4e-04 0.9588767 0.7526830
0.12 5e-04 0.9588767 0.7526830
0.13 1e-04 0.9583053 0.7515390
0.13 2e-04 0.9583053 0.7515390
0.13 3e-04 0.9588767 0.7544648
0.13 4e-04 0.9588767 0.7526830
0.13 5e-04 0.9588767 0.7526830
0.14 1e-04 0.9583053 0.7515390
0.14 2e-04 0.9583053 0.7515390
0.14 3e-04 0.9588767 0.7544648
0.14 4e-04 0.9588767 0.7526830
0.14 5e-04 0.9588767 0.7526830
0.15 1e-04 0.9583053 0.7515390
0.15 2e-04 0.9583053 0.7515390
0.15 3e-04 0.9588767 0.7544648
0.15 4e-04 0.9588767 0.7526830
0.15 5e-04 0.9588767 0.7526830
Accuracy was used to select the optimal model using the
largest value.
The final values used for the model were alpha = 0.05 and lambda
= 5e-04.plot(elast.tune.fit) # Plot
elast.tune.fit$bestTune # 최적의 초모수 조합값 alpha lambda
5 0.05 5e-04Result! (alpha = 0.05, lambda = 0.0005)일 때 정확도가 가장 높은 것을 알 수 있으며, (alpha = 0.05, lambda = 0.0005)를 가지는 모형을 최적의 훈련된 모형으로 선택한다.
round(coef(elast.tune.fit$finalModel, elast.tune.fit$bestTune$lambda), 3) # 최적의 초모수 조합값에 대한 회귀계수 추정치 16 x 1 sparse Matrix of class "dgCMatrix"
s1
(Intercept) -4.649
Age 0.131
Experience -0.003
Income 2.470
ZIP.Code 0.080
Family2 -0.163
Family3 0.749
Family4 0.694
CCAvg 0.404
Education2 1.408
Education3 1.457
Mortgage 0.059
Securities.Account1 -0.408
CD.Account1 1.021
Online1 -0.164
CreditCard1 -0.565Result! 데이터 “UB.trd”의 Target “Personal.Loan”은 “no”와 “yes” 2개의 클래스를 가지며, “Factor” 변환하면 알파벳순으로 수준을 부여하기 때문에 “yes”가 두 번째 클래스가 된다. 즉, “yes”에 속할 확률(= 개인 대출 제의를 수락할 확률)을 \(p\)라고 할 때, 추정된 회귀계수를 이용하여 다음과 같은 모형식을 얻을 수 있다.
\[
\begin{align*}
\log{\frac{p}{1-p}} = &-4.649 +0.131 Z_{\text{Age}} -0.003 Z_{\text{Experience}} + 2.470 Z_{\text{Income}} \\
&+0.080 Z_{\text{ZIP.Code}} -0.163 Z_{\text{Family2}} + 0.749 Z_{\text{Family3}} + 0.694 Z_{\text{Family4}} \\
&+ 0.404 Z_{\text{CCAvg}} + 1.408 Z_{\text{Education2}} + 1.457 Z_{\text{Education3}} + 0.059 Z_{\text{Mortgage}} \\
&-0.408 Z_{\text{Securities.Account1}} + 1.021 Z_{\text{CD.Account1}} -0.164 Z_{\text{Online1}} -0.565 Z_{\text{CreditCard1}}
\end{align*}
\]
여기서, \(Z_{\text{예측 변수}}\)는 표준화한 예측 변수를 의미한다.
범주형 예측 변수(“Family”, “Education”, “Securities.Account”, “CD.Account”, “Online”, “CreditCard”)는 더미 변환이 수행되었는데, 예를 들어, Family2는 가족 수가 2명인 경우 “1”값을 가지고 2명이 아니면 “0”값을 가진다.
6. 모형 평가
Caution! 모형 평가를 위해 Test Dataset에 대한 예측 class/확률 이 필요하며, 함수 predict()를 이용하여 생성한다.
# 예측 class 생성
test.elast.class <- predict(elast.tune.fit,
newdata = UB.ted[,-9]) # Test Dataset including Only 예측 변수
test.elast.class %>%
as_tibble# A tibble: 749 × 1
value
<fct>
1 no
2 no
3 no
4 no
5 no
6 no
7 no
8 no
9 no
10 no
# ℹ 739 more rows6-1. ConfusionMatrix
CM <- caret::confusionMatrix(test.elast.class, UB.ted$Personal.Loan,
positive = "yes") # confusionMatrix(예측 class, 실제 class, positive = "관심 class")
CMConfusion Matrix and Statistics
Reference
Prediction no yes
no 667 23
yes 6 53
Accuracy : 0.9613
95% CI : (0.9449, 0.9739)
No Information Rate : 0.8985
P-Value [Acc > NIR] : 1.228e-10
Kappa : 0.7643
Mcnemar's Test P-Value : 0.002967
Sensitivity : 0.69737
Specificity : 0.99108
Pos Pred Value : 0.89831
Neg Pred Value : 0.96667
Prevalence : 0.10147
Detection Rate : 0.07076
Detection Prevalence : 0.07877
Balanced Accuracy : 0.84423
'Positive' Class : yes
6-2. ROC 곡선
# 예측 확률 생성
test.elast.prob <- predict(elast.tune.fit,
newdata = UB.ted[,-9], # Test Dataset including Only 예측 변수
type = "prob") # 예측 확률 생성
test.elast.prob %>%
as_tibble# A tibble: 749 × 2
no yes
<dbl> <dbl>
1 1.00 0.000283
2 0.994 0.00579
3 1.00 0.000441
4 1.00 0.000112
5 0.993 0.00687
6 0.998 0.00193
7 0.976 0.0238
8 0.892 0.108
9 0.914 0.0856
10 0.980 0.0203
# ℹ 739 more rowstest.elast.prob <- test.elast.prob[,2] # "Personal.Loan = yes"에 대한 예측 확률
ac <- UB.ted$Personal.Loan # Test Dataset의 실제 class
pp <- as.numeric(test.elast.prob) # 예측 확률을 수치형으로 변환1) Package “pROC”
pacman::p_load("pROC")
elast.roc <- roc(ac, pp, plot = T, col = "gray") # roc(실제 class, 예측 확률)
auc <- round(auc(elast.roc), 3)
legend("bottomright", legend = auc, bty = "n")
Caution! Package "pROC"를 통해 출력한 ROC 곡선은 다양한 함수를 이용해서 그래프를 수정할 수 있다.
# 함수 plot.roc() 이용
plot.roc(elast.roc,
col="gray", # Line Color
print.auc = TRUE, # AUC 출력 여부
print.auc.col = "red", # AUC 글씨 색깔
print.thres = TRUE, # Cutoff Value 출력 여부
print.thres.pch = 19, # Cutoff Value를 표시하는 도형 모양
print.thres.col = "red", # Cutoff Value를 표시하는 도형의 색깔
auc.polygon = TRUE, # 곡선 아래 면적에 대한 여부
auc.polygon.col = "gray90") # 곡선 아래 면적의 색깔
# 함수 ggroc() 이용
ggroc(elast.roc) +
annotate(geom = "text", x = 0.9, y = 1.0,
label = paste("AUC = ", auc),
size = 5,
color="red") +
theme_bw()
2) Package “Epi”
pacman::p_load("Epi")
# install_version("etm", version = "1.1", repos = "http://cran.us.r-project.org")
ROC(pp, ac, plot = "ROC") # ROC(예측 확률, 실제 class) 
3) Package “ROCR”
pacman::p_load("ROCR")
elast.pred <- prediction(pp, ac) # prediction(예측 확률, 실제 class)
elast.perf <- performance(elast.pred, "tpr", "fpr") # performance(, "민감도", "1-특이도")
plot(elast.perf, col = "gray") # ROC Curve
perf.auc <- performance(elast.pred, "auc") # AUC
auc <- attributes(perf.auc)$y.values
legend("bottomright", legend = auc, bty = "n")
6-3. 향상 차트
1) Package “ROCR”
elast.perf <- performance(elast.pred, "lift", "rpp") # Lift Chart
plot(elast.perf, main = "lift curve",
colorize = T, # Coloring according to cutoff
lwd = 2) 