Discriminant Analysis with Categorical Variable

Data Mining

Description for Discriminant Analysis with Categorical Variable

Yeongeun Jeon , Jung In Seo
2023-06-10

Discriminant Analysis의 장점


Discriminant Analysis의 단점


실습 자료 : 유니버셜 은행의 고객 2,500명에 대한 자료(출처 : Data Mining for Business Intelligence, Shmueli et al. 2010)이며, 총 13개의 변수를 포함하고 있다. 이 자료에서 Target은 Personal Loan이다.



1. 데이터 불러오기

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>

2. 데이터 전처리 I

UB %<>%
  data.frame() %>%                                                      # Data Frame 형태로 변환 
  mutate(Personal.Loan = ifelse(Personal.Loan == 1, "yes", "no")) %>%   # Target을 문자형 변수로 변환
  dplyr::select(-1)                                                     # ID 변수 제거

# 1. 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)                                          # 범주형으로 변환

# 2. Convert to Dummy for 범주형 예측 변수
dummies <- dummyVars(formula = ~ .,                                      # formula : ~ 예측 변수 / "." : data에 포함된 모든 변수를 의미
                     data = UB[,-9],                                     # Dataset including Only 예측 변수 -> Target 제외
                     fullRank = TRUE)                                    # fullRank = TRUE : Dummy Variable, fullRank = FALSE : One-hot Encoding

UB.Var   <- predict(dummies, newdata = UB) %>%                           # 범주형 예측 변수에 대한 Dummy 변환
  data.frame()                                                           # Data Frame 형태로 변환

glimpse(UB.Var)                                                          # 데이터 구조 확인
Rows: 2,500
Columns: 15
$ Age                  <dbl> 25, 45, 39, 35, 35, 37, 53, 50, 35, 34,…
$ Experience           <dbl> 1, 19, 15, 9, 8, 13, 27, 24, 10, 9, 39,…
$ Income               <dbl> 49, 34, 11, 100, 45, 29, 72, 22, 81, 18…
$ ZIP.Code             <dbl> 91107, 90089, 94720, 94112, 91330, 9212…
$ Family.2             <dbl> 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, …
$ Family.3             <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, …
$ Family.4             <dbl> 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, …
$ CCAvg                <dbl> 1.6, 1.5, 1.0, 2.7, 1.0, 0.4, 1.5, 0.3,…
$ Education.2          <dbl> 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 0, …
$ Education.3          <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, …
$ Mortgage             <dbl> 0, 0, 0, 0, 0, 155, 0, 0, 104, 0, 0, 0,…
$ Securities.Account.1 <dbl> 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, …
$ CD.Account.1         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Online.1             <dbl> 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, …
$ CreditCard.1         <dbl> 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, …
# 3. Combine Target with 변환된 예측 변수
UB.df <- data.frame(Personal.Loan = UB$Personal.Loan,
                    UB.Var)

UB.df %>%
  as_tibble
# A tibble: 2,500 × 16
   Personal.Loan   Age Experience Income ZIP.Code Family.2 Family.3
   <fct>         <dbl>      <dbl>  <dbl>    <dbl>    <dbl>    <dbl>
 1 no               25          1     49    91107        0        0
 2 no               45         19     34    90089        0        1
 3 no               39         15     11    94720        0        0
 4 no               35          9    100    94112        0        0
 5 no               35          8     45    91330        0        0
 6 no               37         13     29    92121        0        0
 7 no               53         27     72    91711        1        0
 8 no               50         24     22    93943        0        0
 9 no               35         10     81    90089        0        1
10 yes              34          9    180    93023        0        0
# ℹ 2,490 more rows
# ℹ 9 more variables: Family.4 <dbl>, CCAvg <dbl>, Education.2 <dbl>,
#   Education.3 <dbl>, Mortgage <dbl>, Securities.Account.1 <dbl>,
#   CD.Account.1 <dbl>, Online.1 <dbl>, CreditCard.1 <dbl>

Caution! 범주형 예측 변수는 더미 변환을 통해 수치형(=더미 변수)으로 만들어 판별함수 모형식에 포함할 수 있다. 하지만, 판별분석은 예측 변수들에 대해 다변량 정규분포를 가정하며, “0” 또는 “1” 값을 가지는 더미 변수는 가정을 위배하므로 원칙적으로는 분석에서 범주형 예측 변수는 제외해야 한다.

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.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

5. 데이터 전처리 II

# Standardization
preProcValues <- preProcess(UB.trd[,c(2:5, 9, 12)],         # Target과 Dummy 변수 제외
                            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: 16
$ Personal.Loan        <fct> no, no, no, no, no, no, no, yes, no, no…
$ Age                  <dbl> -0.05431273, -0.57446728, -0.92123699, …
$ Experience           <dbl> -0.12175295, -0.46882565, -0.98943471, …
$ Income               <dbl> -0.85867297, -1.35649686, 0.56986515, -…
$ ZIP.Code             <dbl> -1.75250883, 0.88354520, 0.53745994, -1…
$ Family.2             <dbl> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, …
$ Family.3             <dbl> 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, …
$ Family.4             <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, …
$ CCAvg                <dbl> -0.25119120, -0.53150921, 0.42157204, -…
$ Education.2          <dbl> 0, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, …
$ Education.3          <dbl> 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0, …
$ Mortgage             <dbl> -0.5664192, -0.5664192, -0.5664192, -0.…
$ Securities.Account.1 <dbl> 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, …
$ CD.Account.1         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Online.1             <dbl> 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, …
$ CreditCard.1         <dbl> 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, …
glimpse(UB.ted)                                             # 데이터 구조 확인
Rows: 749
Columns: 16
$ Personal.Loan        <fct> no, no, no, no, no, no, no, no, no, no,…
$ Age                  <dbl> -1.7881612, -0.7478521, 1.2460737, 0.81…
$ Experience           <dbl> -1.68358012, -0.64236200, 0.83269699, 0…
$ Income               <dbl> -0.53400522, -0.96689556, -1.11840718, …
$ ZIP.Code             <dbl> -1.17304370, -0.59585545, 1.07366441, 0…
$ Family.2             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Family.3             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, …
$ Family.4             <dbl> 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, …
$ CCAvg                <dbl> -0.19512759, -0.86789083, -0.25119120, …
$ Education.2          <dbl> 0, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, …
$ Education.3          <dbl> 0, 0, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, …
$ Mortgage             <dbl> -0.5664192, 0.9609885, -0.5664192, -0.5…
$ Securities.Account.1 <dbl> 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 1, …
$ CD.Account.1         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, …
$ Online.1             <dbl> 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, …
$ CreditCard.1         <dbl> 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, …

6. 모공분산행렬의 동일성 검정

UB.boxM <- boxM(UB.trd[,-1],                  # Dataset including Only 예측 변수 -> Target 제외
                UB.trd$Personal.Loan)         # Target
UB.boxM

    Box's M-test for Homogeneity of Covariance Matrices

data:  UB.trd[, -1]
Chi-Sq (approx.) = 980.59, df = 120, 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\)값은 980.59이며 \(p\)값은 거의 0값에 가깝다. 이에 근거하여, 유의수준 5%에서 \(p\)값이 0.05보다 작기 때문에 귀무가설 \(H_0\)를 기각할 수 있다. 즉, Training Dataset에서 Target “Personal.Loan”의 두 클래스 “no”와 “yes”의 모공분산행렬은 동일하지 않다.

7. 선형판별분석(LDA)


7-1. 모형 훈련

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  Family.2
no   0.007050718  0.006493842 -0.1773736 -0.001354389 0.2590707
yes -0.061537099 -0.056676814  1.5480771  0.011820808 0.1722222
     Family.3  Family.4      CCAvg Education.2 Education.3
no  0.1909612 0.2565245 -0.1247715   0.2647995   0.2781668
yes 0.2722222 0.3166667  1.0889781   0.3888889   0.4055556
       Mortgage Securities.Account.1 CD.Account.1  Online.1
no  -0.05226732            0.1094844   0.03437301 0.6034373
yes  0.45617752            0.1444444   0.32222222 0.6611111
    CreditCard.1
no     0.2934437
yes    0.2722222

Coefficients of linear discriminants:
                             LD1
Age                  -0.47464616
Experience            0.50676236
Income                1.00862440
ZIP.Code              0.04036519
Family.2             -0.02446717
Family.3              0.60520194
Family.4              0.54284147
CCAvg                 0.12422080
Education.2           0.97482668
Education.3           1.03737093
Mortgage              0.05091070
Securities.Account.1 -0.47479897
CD.Account.1          2.43620067
Online.1             -0.14846577
CreditCard.1         -0.40061099

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.475Z_{\text{Age}} + 0.507 Z_{\text{Experience}} + 1.009 Z_{\text{Income}} + 0.040 Z_{\text{ZIP.Code}}\\ &-0.024 (X_{\text{Family.2}} - \bar{X}_{\text{Family.2}}) + 0.605 (X_{\text{Family.3}} - \bar{X}_{\text{Family.3}}) + 0.543 (X_{\text{Family.4}} - \bar{X}_{\text{Family.4}}) + 0.124 Z_{\text{CCAvg}} \\ &+ 0.975 (X_{\text{Education.2}} - \bar{X}_{\text{Education.2}}) + 1.037 (X_{\text{Education.3}} - \bar{X}_{\text{Education.3}}) + 0.051 Z_{\text{Mortgage}} \\ &-0.475 (X_{\text{Securities.Account.1}} - \bar{X}_{\text{Securities.Account.1}}) +2.436 (X_{\text{CD.Account.1}} - \bar{X}_{\text{CD.Account.1}}) \\ &-0.148 (X_{\text{Online.1}} - \bar{X}_{\text{Online.1}}) -0.401 (X_{\text{CreditCard.1}} - \bar{X}_{\text{CreditCard.1}}) \end{align*} \] 여기서, \(Z_{\text{예측 변수}}\)는 표준화한 예측 변수, \(X_{\text{예측 변수}}\)는 더미 변수를 의미한다. 예를 들어, \(X_{\text{Family.2}}\)는 가족 수가 2명인 경우 “1”값을 가지고 2명이 아니면 “0”값을 가진다. 위에서 언급했듯이 함수 lda()는 예측 변수의 평균을 0으로 변환한 후 분석을 수행하기 때문에 더미 변수들은 평균 \(\bar{X}_{\text{예측 변수}}\) 항을 추가하였으며, 나머지 예측 변수들은 데이터 전처리 II에서 표준화를 수행하여 평균이 0이기 때문에 평균항을 추가하지 않았다.
판별계수의 부호를 이용하여 해석해보면, 판별계수가 양수인 예측 변수(예를 들어, “Experience”, “Income” 등)의 값이 클수록 선형판별함수 \(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를 의미하며, 직선형태로 분류 영역이 나뉘어져 있다는 것을 알 수 있다.

7-2. 모형 평가

Caution! 모형 평가를 위해 Test Dataset에 대한 예측 class/확률이 필요하며, 함수 predict()를 이용하여 생성한다.

# 예측 class와 예측 확률 생성
UB.lda.pred <- predict(UB.lda, 
                       newdata = UB.ted[,-1])           # 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               1.00  0.0000810   -1.30  
 2 no               0.999 0.00119     -0.384 
 3 no               1.00  0.0000388   -1.55  
 4 no               1.00  0.0000131   -1.92  
 5 no               0.999 0.00112     -0.406 
 6 no               1.00  0.000372    -0.782 
 7 no               0.995 0.00488      0.0955
 8 no               0.953 0.0472       0.882 
 9 no               0.976 0.0241       0.646 
10 no               0.996 0.00405      0.0317
# ℹ 739 more rows

Result! 함수 predict()는 3개의 결과를 리스트로 반환한다.

  1. class : 예측 class
  2. posterior : 각 클래스에 대한 예측 확률(사후 확률)
  3. x : 판별점수


7-2-1. ConfusionMatrix

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  659  26
       yes  14  50
                                         
               Accuracy : 0.9466         
                 95% CI : (0.928, 0.9616)
    No Information Rate : 0.8985         
    P-Value [Acc > NIR] : 1.605e-06      
                                         
                  Kappa : 0.6851         
                                         
 Mcnemar's Test P-Value : 0.08199        
                                         
            Sensitivity : 0.65789        
            Specificity : 0.97920        
         Pos Pred Value : 0.78125        
         Neg Pred Value : 0.96204        
             Prevalence : 0.10147        
         Detection Rate : 0.06676        
   Detection Prevalence : 0.08545        
      Balanced Accuracy : 0.81855        
                                         
       'Positive' Class : yes


7-2-2. ROC 곡선

ac  <- UB.ted$Personal.Loan                             # Test Dataset의 실제 class 
pp  <- as.numeric(UB.lda.pred$posterior[,2])            # "Personal.Loan = yes"에 대한 예측 확률을 수치형으로 변환

1) Package “pROC”

pacman::p_load("pROC")

lda.roc  <- roc(ac, pp, plot = T, col = "gray")         # roc(실제 class, 예측 확률)
auc      <- round(auc(lda.roc), 3)
legend("bottomright", legend = auc, bty = "n")

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()

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")

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")


7-2-3. 향상 차트

1) Package “ROCR”

lda.pred <- performance(lda.pred, "lift", "rpp")          # Lift Chart
plot(lda.pred, main = "lift curve", 
     colorize = T,                                        # Coloring according to cutoff
     lwd = 2)


7-2-4. 오분류표

# 오분류표
lda.ctbl <- table(UB.ted$Personal.Loan,                   # Test Dataset의 실제 class 
                  UB.lda.pred$class)                      # 예측 class
lda.ctbl
     
       no yes
  no  659  14
  yes  26  50
Desc(lda.ctbl,                                         
     digits = 4)
-------------------------------------------------------------------- 
lda.ctbl (table)

Summary: 
n: 749, rows: 2, columns: 2

Pearson's Chi-squared test (cont. adj):
  X-squared = 346.58, df = 1, p-value < 2.2e-16
Fisher's exact test p-value < 2.2e-16
McNemar's chi-squared = 3.025, df = 1, p-value = 0.08199

                    estimate   lwr.ci   upr.ci'
                                              
odds ratio           90.5220  44.4828 184.2112
rel. risk (col1)      2.8623   2.0952   3.9102
rel. risk (col2)      0.0316   0.0184   0.0544


Contingency Coeff.     0.567
Cramer's V             0.688
Kendall Tau-b          0.688

                                         
                   no       yes       Sum
                                         
no    freq        659        14       673
      perc   87.9840%   1.8692%  89.8531%
      p.row  97.9198%   2.0802%         .
      p.col  96.2044%  21.8750%         .
                                         
yes   freq         26        50        76
      perc    3.4713%   6.6756%  10.1469%
      p.row  34.2105%  65.7895%         .
      p.col   3.7956%  78.1250%         .
                                         
Sum   freq        685        64       749
      perc   91.4553%   8.5447% 100.0000%
      p.row         .         .         .
      p.col         .         .         .
                                         

----------
' 95% conf. level

Result! Test Dataset에 대해서 Target “Personal.Loan”의 “no”에 속하는 673개의 case 중 659개(659/673=97.9%)는 “no”로 제대로 분류되었으나 14개(14/673=2.1%)는 “yes”로 잘못 분류되었다. 또한, Target “Personal.Loan”의 “yes”에 속하는 76개의 case 중 50개(50/76=65.8%)는 “yes”로 제대로 분류되었으나 26개(26/76=34.2%)는 “no”로 잘못 분류되었다. 유도된 선형판별함수에 대한 오분류율은 (14+26)/749=5.3%이며, 정확도는 (659+50)/749=94.7%이다.

8. 이차판별분석(QDA)


8-1. 모형 훈련

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  Family.2
no   0.007050718  0.006493842 -0.1773736 -0.001354389 0.2590707
yes -0.061537099 -0.056676814  1.5480771  0.011820808 0.1722222
     Family.3  Family.4      CCAvg Education.2 Education.3
no  0.1909612 0.2565245 -0.1247715   0.2647995   0.2781668
yes 0.2722222 0.3166667  1.0889781   0.3888889   0.4055556
       Mortgage Securities.Account.1 CD.Account.1  Online.1
no  -0.05226732            0.1094844   0.03437301 0.6034373
yes  0.45617752            0.1444444   0.32222222 0.6611111
    CreditCard.1
no     0.2934437
yes    0.2722222

Caution! 이차판별분석에서는 판별계수를 출력하지 않는다.

# 두 예측 변수 "Income"와 "CCAvg"에 대해 이차판별분석에 기초한 관측값의 분류 결과
partimat(Personal.Loan ~ Income + CCAvg ,      
         data = UB.trd,
         method = "qda")

Result! 빨간색은 잘못 분류된 case를 의미한다. 선형판별분석에서 살펴본 그림과 달리 곡선형태로 분류 영역이 나뉘어져 있다는 것을 알 수 있다.

8-2. 모형 평가

Caution! 모형 평가를 위해 Test Dataset에 대한 예측 class/확률이 필요하며, 함수 predict()를 이용하여 생성한다.

# 예측 class와 예측 확률 생성
UB.qda.pred <- predict(UB.qda, 
                       newdata = UB.ted[,-1])           # 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.000564   
 2 no               1.00  0.0000738  
 3 no               1.00  0.000000621
 4 no               1.00  0.000000482
 5 no               1.00  0.0000274  
 6 no               1.00  0.00000444 
 7 no               1.00  0.000358   
 8 no               0.942 0.0584     
 9 no               0.991 0.00875    
10 no               1.00  0.000201   
# ℹ 739 more rows


8-2-1. ConfusionMatrix

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  645  27
       yes  28  49
                                          
               Accuracy : 0.9266          
                 95% CI : (0.9055, 0.9442)
    No Information Rate : 0.8985          
    P-Value [Acc > NIR] : 0.004995        
                                          
                  Kappa : 0.5996          
                                          
 Mcnemar's Test P-Value : 1.000000        
                                          
            Sensitivity : 0.64474         
            Specificity : 0.95840         
         Pos Pred Value : 0.63636         
         Neg Pred Value : 0.95982         
             Prevalence : 0.10147         
         Detection Rate : 0.06542         
   Detection Prevalence : 0.10280         
      Balanced Accuracy : 0.80157         
                                          
       'Positive' Class : yes


8-2-2. ROC 곡선

ac  <- UB.ted$Personal.Loan                             # Test Dataset의 실제 class 
pp  <- as.numeric(UB.qda.pred$posterior[,2])            # "Personal.Loan = yes"에 대한 예측 확률을 수치형으로 변환

1) Package “pROC”

pacman::p_load("pROC")

qda.roc  <- roc(ac, pp, plot = T, col = "gray")         # roc(실제 class, 예측 확률)
auc      <- round(auc(qda.roc), 3)
legend("bottomright", legend = auc, bty = "n")

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()

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")

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")


8-2-3. 향상 차트

1) Package “ROCR”

qda.pred <- performance(qda.pred, "lift", "rpp")          # Lift Chart
plot(qda.pred, main = "lift curve", 
     colorize = T,                                        # Coloring according to cutoff
     lwd = 2)


8-2-4. 오분류표

# 오분류표
qda.ctbl <- table(UB.ted$Personal.Loan,                   # Test Dataset의 실제 class 
                  UB.qda.pred$class)                      # 예측 class
qda.ctbl
     
       no yes
  no  645  28
  yes  27  49
Desc(qda.ctbl,                                           
     digits = 4)
-------------------------------------------------------------------- 
qda.ctbl (table)

Summary: 
n: 749, rows: 2, columns: 2

Pearson's Chi-squared test (cont. adj):
  X-squared = 262.82, df = 1, p-value < 2.2e-16
Fisher's exact test p-value < 2.2e-16
McNemar's chi-squared = 0, df = 1, p-value = 1

                    estimate  lwr.ci  upr.ci'
                                            
odds ratio           41.8056 22.8706 76.4172
rel. risk (col1)      2.6977  1.9920  3.6535
rel. risk (col2)      0.0645  0.0433  0.0962


Contingency Coeff.     0.514
Cramer's V             0.600
Kendall Tau-b          0.600

                                         
                   no       yes       Sum
                                         
no    freq        645        28       673
      perc   86.1148%   3.7383%  89.8531%
      p.row  95.8395%   4.1605%         .
      p.col  95.9821%  36.3636%         .
                                         
yes   freq         27        49        76
      perc    3.6048%   6.5421%  10.1469%
      p.row  35.5263%  64.4737%         .
      p.col   4.0179%  63.6364%         .
                                         
Sum   freq        672        77       749
      perc   89.7196%  10.2804% 100.0000%
      p.row         .         .         .
      p.col         .         .         .
                                         

----------
' 95% conf. level

Result! Test Dataset에 대해서 Target “Personal.Loan”의 “no”에 속하는 673개의 case 중 645개(645/673=95.8%)는 “no”로 제대로 분류되었으나 28개(28/673=4.2%)는 “yes”로 잘못 분류되었다. 또한, Target “Personal.Loan”의 “yes”에 속하는 76개의 case 중 49개(49/76=64.5%)는 “yes”로 제대로 분류되었으나 27개(27/76=35.5%)는 “no”로 잘못 분류되었다. 유도된 이차판별함수에 대한 오분류율은 (28+27)/749=7.3%이며, 정확도는 (645+49)/749=92.7%이다.

Reuse

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 ...".