Description for Discriminant Analysis with Only Numeric Variable
Discriminant Analysis의 장점
Discriminant Analysis의 단점
실습 자료 : 유니버셜 은행의 고객 2,500명에 대한 자료(출처 : Data Mining for Business Intelligence, Shmueli et al. 2010)이며, 총 13개의 변수를 포함하고 있다. 이 자료에서 Target은
Personal Loan
이다.
pacman::p_load("data.table",
"tidyverse",
"dplyr",
"caret",
"ggplot2", "GGally",
"biotools", # For boxM
"MASS", # For lda and qda
"DescTools", # For Desc
"klaR" # For partimat
)
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>
UB %<>%
data.frame() %>% # Data Frame 형태로 변환
mutate(Personal.Loan = ifelse(Personal.Loan == 1, "yes", "no")) %>% # Target을 문자형 변수로 변환
dplyr::select(-1) # ID 변수 제거
# 1. Convert to Factor
UB$Personal.Loan <- factor(UB$Personal.Loan) # Target을 범주형으로 변환
# 2. Select Variables used for Analysis
col <- c("Age", "Experience", "Income", "ZIP.Code", "CCAvg", "Mortgage",# 연속형 예측 변수
"Personal.Loan") # Target
UB.df <- UB %>%
dplyr::select(all_of(col)) # 분석에 사용할 변수만 선택 -> 판별분석에서 예측 변수들은 다변량 정규분포를 가정하기 때문에 범주형 예측 변수는 제거
glimpse(UB.df) # 데이터 구조 확인
Rows: 2,500
Columns: 7
$ Age <int> 25, 45, 39, 35, 35, 37, 53, 50, 35, 34, 65, 29…
$ Experience <int> 1, 19, 15, 9, 8, 13, 27, 24, 10, 9, 39, 5, 23,…
$ Income <int> 49, 34, 11, 100, 45, 29, 72, 22, 81, 180, 105,…
$ ZIP.Code <int> 91107, 90089, 94720, 94112, 91330, 92121, 9171…
$ CCAvg <dbl> 1.6, 1.5, 1.0, 2.7, 1.0, 0.4, 1.5, 0.3, 0.6, 8…
$ Mortgage <int> 0, 0, 0, 0, 0, 155, 0, 0, 104, 0, 0, 0, 0, 0, …
$ Personal.Loan <fct> no, no, no, no, no, no, no, no, no, yes, no, n…
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_colour_manual(values = c("#00798c", "#d1495b")) + # 특정 색깔 지정
scale_fill_manual(values = c("#00798c", "#d1495b")) + # 특정 색깔 지정
theme_bw()
# Partition (Training Dataset : Test Dataset = 7:3)
y <- UB.df$Personal.Loan # Target
set.seed(200)
ind <- createDataPartition(y, p = 0.7, list = T) # Index를 이용하여 7:3으로 분할
UB.trd <- UB.df[ind$Resample1,] # Training Dataset
UB.ted <- UB.df[-ind$Resample1,] # Test Dataset
# Standardization
preProcValues <- preProcess(UB.trd,
method = c("center", "scale")) # Standardization 정의 -> Training Dataset에 대한 평균과 표준편차 계산
UB.trd <- predict(preProcValues, UB.trd) # Standardization for Training Dataset
UB.ted <- predict(preProcValues, UB.ted) # Standardization for Test Dataset
glimpse(UB.trd) # 데이터 구조 확인
Rows: 1,751
Columns: 7
$ Age <dbl> -0.05431273, -0.57446728, -0.92123699, -0.9212…
$ Experience <dbl> -0.12175295, -0.46882565, -0.98943471, -1.0762…
$ Income <dbl> -0.85867297, -1.35649686, 0.56986515, -0.62058…
$ ZIP.Code <dbl> -1.75250883, 0.88354520, 0.53745994, -1.046107…
$ CCAvg <dbl> -0.25119120, -0.53150921, 0.42157204, -0.53150…
$ Mortgage <dbl> -0.5664192, -0.5664192, -0.5664192, -0.5664192…
$ Personal.Loan <fct> no, no, no, no, no, no, no, yes, no, no, no, n…
glimpse(UB.ted) # 데이터 구조 확인
Rows: 749
Columns: 7
$ Age <dbl> -1.7881612, -0.7478521, 1.2460737, 0.8126115, …
$ Experience <dbl> -1.68358012, -0.64236200, 0.83269699, 0.659160…
$ Income <dbl> -0.53400522, -0.96689556, -1.11840718, -1.1400…
$ ZIP.Code <dbl> -1.17304370, -0.59585545, 1.07366441, 0.883545…
$ CCAvg <dbl> -0.19512759, -0.86789083, -0.25119120, -0.8118…
$ Mortgage <dbl> -0.5664192, 0.9609885, -0.5664192, -0.5664192,…
$ Personal.Loan <fct> no, no, no, no, no, no, no, no, no, no, no, no…
UB.boxM <- boxM(UB.trd[,-7], # Dataset including Only 예측 변수 -> Target 제외
UB.trd$Personal.Loan) # Target
UB.boxM
Box's M-test for Homogeneity of Covariance Matrices
data: UB.trd[, -7]
Chi-Sq (approx.) = 292.16, df = 21, p-value < 2.2e-16
Caution!
Package "biotools"
에서 제공하는 함수 boxM()
를 이용하여 모공분산행렬의 동일성 검정을 수행할 수 있다. 해당 검정에서 귀무가설 \(H_0\)은 “Target의 모든 클래스의 모공분산행렬은 동일하다.”이며, 귀무가설 \(H_0\)을 기각할 증거가 부족할 경우 원칙적으로는 선형판별분석을 수행한다.
Result!
가설 \(H_0 :\Sigma_{\text{yes}}=\Sigma_{\text{no}}\) vs \(H_1 :\Sigma_{\text{yes}}\ne\Sigma_{\text{no}}\)에 대하여, 카이제곱 검정통계량 \(\chi^2\)값은 292.16이며 \(p\)값은 거의 0값에 가깝다. 이에 근거하여, 유의수준 5%에서 \(p\)값이 0.05보다 작기 때문에 귀무가설 \(H_0\)를 기각할 수 있다. 즉, Training Dataset
에서 Target “Personal.Loan”의 두 클래스 “no”와 “yes”의 모공분산행렬은 동일하지 않다.
Caution!
Package "MASS"
에서 제공하는 함수 lda()
를 통해 선형판별함수 \(L(x)\)를 얻을 수 있다. 함수 lda()
는 예측 변수의 평균을 0으로 변환(중심화)한 후 분석을 수행하며, 정규화된 판별계수벡터 \(\boldsymbol{b}\)를 계산한다. 여기서, 정규화된 판별계수벡터란 합동공분산행렬을 \(\boldsymbol{S}\)라 할 때 \(\boldsymbol{b}^T \boldsymbol{S}\boldsymbol{b}=1\)을 만족하는 \(\boldsymbol{b}\)를 의미한다.
UB.lda <- lda(Personal.Loan ~ .,
# prior = c(1/2, 1/2), # 사전확률
data = UB.trd)
UB.lda
Call:
lda(Personal.Loan ~ ., data = UB.trd)
Prior probabilities of groups:
no yes
0.8972016 0.1027984
Group means:
Age Experience Income ZIP.Code CCAvg
no 0.007050718 0.006493842 -0.1773736 -0.001354389 -0.1247715
yes -0.061537099 -0.056676814 1.5480771 0.011820808 1.0889781
Mortgage
no -0.05226732
yes 0.45617752
Coefficients of linear discriminants:
LD1
Age 0.81295074
Experience -0.76949842
Income 1.08573373
ZIP.Code 0.05322385
CCAvg 0.11145396
Mortgage 0.10678620
Caution!
“Prior probabilities of groups”는 Target의 각 클래스에 대한 사전확률을 의미하며, 함수 lda()
의 옵션 prior
을 이용하여 직접 지정할 수 있다. 옵션을 따로 지정해주지 않으면, Training Dataset
에서 Target의 클래스 비율을 사전확률로 사용한다.
“Group means”는 Target의 클래스별 예측 변수들의 평균을 의미한다.
“Coefficients of linear discriminants”는 선형판별함수의 정규화된 판별계수벡터를 의미한다.
Result!
Training Dataset
“UB.trd”에서 Target “Personal.Loan”의 클래스별 비율은 각각 “no” 89.7%, “yes” 10.3%이다. “Coefficients of linear discriminants”에 출력된 결과를 이용하여 선형판별함수 \(L(x)\)를 다음과 같이 얻을 수 있다.
\[ \begin{align*} L(x) = &\; 0.813Z_{\text{Age}} -0.769 Z_{\text{Experience}} + 1.086 Z_{\text{Income}} \\ &+ 0.053 Z_{\text{ZIP.Code}} + 0.111 Z_{\text{CCAvg}} + 0.107 Z_{\text{Mortgage}} \end{align*} \] 여기서, \(Z_{\text{예측 변수}}\)는 표준화한 예측 변수를 의미한다. 판별계수의 부호를 이용하여 해석해보면, 판별계수가 양수인 예측 변수 “Age”, “Income”, “ZIP.Code”, “CCAvg”, “Mortgage”의 값이 클수록 선형판별함수 \(L(x)\)의 값이 커지며, 이는 개인 대출 제의를 수락할 가능성(Target “Personal.Loan = yes”일 확률)이 커진다는 것을 의미한다.
# Target "Personal.Loan"의 클래스별 판별점수 히스토그램
plot(UB.lda, dimen = 1, type = "b")
Result!
각 case에 대하여 예측 변수들의 관측값을 위에서 구한 선형판별함수 \(L(x)\)에 대입하여 얻은 값을 “판별점수”라고 한다. Training Dataset
의 Target “Personal.Loan”의 클래스별 판별점수 히스토그램을 살펴보면, “no”에 속하는 case의 판별점수는 대체로 0보다 작은 음수값이고 “yes”에 속하는 case의 판별점수는 대체로 0보다 큰 양수값이다.
# 두 예측 변수 "Income"와 "CCAvg"에 대해 선형판별분석에 기초한 관측값의 분류 결과
partimat(Personal.Loan ~ Income + CCAvg ,
data = UB.trd,
method = "lda")
Result!
빨간색은 잘못 분류된 case를 의미하며, 직선형태로 분류 영역이 나뉘어져 있다는 것을 알 수 있다.
Caution!
모형 평가를 위해 Test Dataset
에 대한 예측 class/확률
이 필요하며, 함수 predict()
를 이용하여 생성한다.
# 예측 class와 예측 확률 생성
UB.lda.pred <- predict(UB.lda,
newdata = UB.ted[,-7]) # Test Dataset including Only 예측 변수
UB.lda.pred %>%
as_tibble
# A tibble: 749 × 3
class posterior[,"no"] [,"yes"] x[,"LD1"]
<fct> <dbl> <dbl> <dbl>
1 no 0.997 0.00347 -0.883
2 no 0.998 0.00185 -1.19
3 no 0.996 0.00353 -0.873
4 no 0.998 0.00185 -1.19
5 no 0.998 0.00220 -1.10
6 no 0.993 0.00733 -0.516
7 no 0.994 0.00615 -0.602
8 no 0.962 0.0377 0.296
9 no 0.970 0.0296 0.173
10 no 0.995 0.00523 -0.682
# ℹ 739 more rows
Result!
함수 predict()
는 3개의 결과를 리스트로 반환한다.
class
: 예측 classposterior
: 각 클래스에 대한 예측 확률(사후 확률)x
: 판별점수CM <- caret::confusionMatrix(UB.lda.pred$class, UB.ted$Personal.Loan,
positive = "yes") # confusionMatrix(예측 class, 실제 class, positive = "관심 class")
CM
Confusion Matrix and Statistics
Reference
Prediction no yes
no 627 30
yes 46 46
Accuracy : 0.8985
95% CI : (0.8746, 0.9192)
No Information Rate : 0.8985
P-Value [Acc > NIR] : 0.53050
Kappa : 0.4911
Mcnemar's Test P-Value : 0.08532
Sensitivity : 0.60526
Specificity : 0.93165
Pos Pred Value : 0.50000
Neg Pred Value : 0.95434
Prevalence : 0.10147
Detection Rate : 0.06142
Detection Prevalence : 0.12283
Balanced Accuracy : 0.76846
'Positive' Class : yes
ac <- UB.ted$Personal.Loan # Test Dataset의 실제 class
pp <- as.numeric(UB.lda.pred$posterior[,2]) # "Personal.Loan = yes"에 대한 예측 확률을 수치형으로 변환
Caution!
Package "pROC"
를 통해 출력한 ROC 곡선은 다양한 함수를 이용해서 그래프를 수정할 수 있다.
# 함수 plot.roc() 이용
plot.roc(lda.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(lda.roc) +
annotate(geom = "text", x = 0.9, y = 1.0,
label = paste("AUC = ", auc),
size = 5,
color="red") +
theme_bw()
pacman::p_load("Epi")
# install_version("etm", version = "1.1", repos = "http://cran.us.r-project.org")
ROC(pp, ac, plot = "ROC") # ROC(예측 확률, 실제 class)
pacman::p_load("ROCR")
lda.pred <- prediction(pp, ac) # prediction(예측 확률, 실제 class)
lda.perf <- performance(lda.pred, "tpr", "fpr") # performance(, "민감도", "1-특이도")
plot(lda.perf, col = "gray") # ROC Curve
perf.auc <- performance(lda.pred, "auc") # AUC
auc <- attributes(perf.auc)$y.values
legend("bottomright", legend = auc, bty = "n")
lda.pred <- performance(lda.pred, "lift", "rpp") # Lift Chart
plot(lda.pred, main = "lift curve",
colorize = T, # Coloring according to cutoff
lwd = 2)
# 오분류표
lda.ctbl <- table(UB.ted$Personal.Loan, # Test Dataset의 실제 class
UB.lda.pred$class) # 예측 class
lda.ctbl
no yes
no 627 46
yes 30 46
Desc(lda.ctbl,
digits = 4)
--------------------------------------------------------------------
lda.ctbl (table)
Summary:
n: 749, rows: 2, columns: 2
Pearson's Chi-squared test (cont. adj):
X-squared = 177.76, df = 1, p-value < 2.2e-16
Fisher's exact test p-value < 2.2e-16
McNemar's chi-squared = 2.9605, df = 1, p-value = 0.08532
estimate lwr.ci upr.ci'
odds ratio 20.900 12.073 36.182
rel. risk (col1) 2.360 1.785 3.120
rel. risk (col2) 0.113 0.081 0.158
Contingency Coeff. 0.443
Cramer's V 0.494
Kendall Tau-b 0.494
no yes Sum
no freq 627 46 673
perc 83.7116% 6.1415% 89.8531%
p.row 93.1649% 6.8351% .
p.col 95.4338% 50.0000% .
yes freq 30 46 76
perc 4.0053% 6.1415% 10.1469%
p.row 39.4737% 60.5263% .
p.col 4.5662% 50.0000% .
Sum freq 657 92 749
perc 87.7170% 12.2830% 100.0000%
p.row . . .
p.col . . .
----------
' 95% conf. level
Result!
Test Dataset
에 대해서 Target “Personal.Loan”의 “no”에 속하는 673개의 case 중 627개(627/673=93.2%)는 “no”로 제대로 분류되었으나 46개(46/673=6.8%)는 “yes”로 잘못 분류되었다. 또한, Target “Personal.Loan”의 “yes”에 속하는 76개의 case 중 46개(46/76=60.5%)는 “yes”로 제대로 분류되었으나 30개(30/76=39.5%)는 “no”로 잘못 분류되었다. 유도된 선형판별함수에 대한 오분류율은 (46+30)/749=10.1%이며, 정확도는 (627+46)/749=89.9%이다.
Caution!
Package "MASS"
에서 제공하는 함수 qda()
를 통해 이차판별함수를 얻을 수 있다.
UB.qda <- qda(Personal.Loan ~ .,
# prior = c(1/2, 1/2), # 사전확률
data = UB.trd)
UB.qda
Call:
qda(Personal.Loan ~ ., data = UB.trd)
Prior probabilities of groups:
no yes
0.8972016 0.1027984
Group means:
Age Experience Income ZIP.Code CCAvg
no 0.007050718 0.006493842 -0.1773736 -0.001354389 -0.1247715
yes -0.061537099 -0.056676814 1.5480771 0.011820808 1.0889781
Mortgage
no -0.05226732
yes 0.45617752
Caution!
이차판별분석에서는 판별계수를 출력하지 않는다.
# 두 예측 변수 "Income"와 "CCAvg"에 대해 이차판별분석에 기초한 관측값의 분류 결과
partimat(Personal.Loan ~ Income + CCAvg ,
data = UB.trd,
method = "qda")
Result!
빨간색은 잘못 분류된 case를 의미한다. 선형판별분석에서 살펴본 그림과 달리 곡선형태로 분류 영역이 나뉘어져 있다는 것을 알 수 있다.
Caution!
모형 평가를 위해 Test Dataset
에 대한 예측 class/확률
이 필요하며, 함수 predict()
를 이용하여 생성한다.
# 예측 class와 예측 확률 생성
UB.qda.pred <- predict(UB.qda,
newdata = UB.ted[,-7]) # Test Dataset including Only 예측 변수
UB.qda.pred %>%
as_tibble
# A tibble: 749 × 2
class posterior[,"no"] [,"yes"]
<fct> <dbl> <dbl>
1 no 0.999 0.00119
2 no 1.00 0.000216
3 no 1.00 0.0000388
4 no 1.00 0.0000463
5 no 1.00 0.000120
6 no 0.999 0.00114
7 no 0.999 0.00117
8 no 0.940 0.0601
9 no 0.991 0.00890
10 no 0.999 0.000580
# ℹ 739 more rows
CM <- caret::confusionMatrix(UB.qda.pred$class, UB.ted$Personal.Loan,
positive = "yes") # confusionMatrix(예측 class, 실제 class, positive = "관심 class")
CM
Confusion Matrix and Statistics
Reference
Prediction no yes
no 608 32
yes 65 44
Accuracy : 0.8705
95% CI : (0.8443, 0.8937)
No Information Rate : 0.8985
P-Value [Acc > NIR] : 0.994128
Kappa : 0.4045
Mcnemar's Test P-Value : 0.001158
Sensitivity : 0.57895
Specificity : 0.90342
Pos Pred Value : 0.40367
Neg Pred Value : 0.95000
Prevalence : 0.10147
Detection Rate : 0.05874
Detection Prevalence : 0.14553
Balanced Accuracy : 0.74118
'Positive' Class : yes
ac <- UB.ted$Personal.Loan # Test Dataset의 실제 class
pp <- as.numeric(UB.qda.pred$posterior[,2]) # "Personal.Loan = yes"에 대한 예측 확률을 수치형으로 변환
Caution!
Package "pROC"
를 통해 출력한 ROC 곡선은 다양한 함수를 이용해서 그래프를 수정할 수 있다.
# 함수 plot.roc() 이용
plot.roc(qda.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(qda.roc) +
annotate(geom = "text", x = 0.9, y = 1.0,
label = paste("AUC = ", auc),
size = 5,
color="red") +
theme_bw()
pacman::p_load("Epi")
# install_version("etm", version = "1.1", repos = "http://cran.us.r-project.org")
ROC(pp, ac, plot = "ROC") # ROC(예측 확률, 실제 class)
pacman::p_load("ROCR")
qda.pred <- prediction(pp, ac) # prediction(예측 확률, 실제 class)
qda.perf <- performance(qda.pred, "tpr", "fpr") # performance(, "민감도", "1-특이도")
plot(qda.perf, col = "gray") # ROC Curve
perf.auc <- performance(qda.pred, "auc") # AUC
auc <- attributes(perf.auc)$y.values
legend("bottomright", legend = auc, bty = "n")
qda.pred <- performance(qda.pred, "lift", "rpp") # Lift Chart
plot(qda.pred, main = "lift curve",
colorize = T, # Coloring according to cutoff
lwd = 2)
# 오분류표
qda.ctbl <- table(UB.ted$Personal.Loan, # Test Dataset의 실제 class
UB.qda.pred$class) # 예측 class
qda.ctbl
no yes
no 608 65
yes 32 44
Desc(qda.ctbl,
digits = 4)
--------------------------------------------------------------------
qda.ctbl (table)
Summary:
n: 749, rows: 2, columns: 2
Pearson's Chi-squared test (cont. adj):
X-squared = 123.93, df = 1, p-value < 2.2e-16
Fisher's exact test p-value < 2.2e-16
McNemar's chi-squared = 10.557, df = 1, p-value = 0.001158
estimate lwr.ci upr.ci'
odds ratio 12.862 7.629 21.683
rel. risk (col1) 2.146 1.646 2.796
rel. risk (col2) 0.167 0.124 0.225
Contingency Coeff. 0.382
Cramer's V 0.413
Kendall Tau-b 0.413
no yes Sum
no freq 608 65 673
perc 81.1749% 8.6782% 89.8531%
p.row 90.3418% 9.6582% .
p.col 95.0000% 59.6330% .
yes freq 32 44 76
perc 4.2724% 5.8745% 10.1469%
p.row 42.1053% 57.8947% .
p.col 5.0000% 40.3670% .
Sum freq 640 109 749
perc 85.4473% 14.5527% 100.0000%
p.row . . .
p.col . . .
----------
' 95% conf. level
Result!
Test Dataset
에 대해서 Target “Personal.Loan”의 “no”에 속하는 673개의 case 중 608개(608/673=90.3%)는 “no”로 제대로 분류되었으나 65개(65/673=9.7%)는 “yes”로 잘못 분류되었다. 또한, Target “Personal.Loan”의 “yes”에 속하는 76개의 case 중 44개(44/76=57.9%)는 “yes”로 제대로 분류되었으나 32개(32/76=42.1%)는 “no”로 잘못 분류되었다. 유도된 이차판별함수에 대한 오분류율은 (65+32)/749=13.0%이며, 정확도는 (608+44)/749=87.0%이다.
Text and figures are licensed under Creative Commons Attribution CC BY 4.0. The figures that have been reused from other sources don't fall under this license and can be recognized by a note in their caption: "Figure from ...".