Logistic Regression using Package caret

Data Mining

Description for Logistic Regression using Package caret

Yeongeun Jeon , Jung In Seo
2023-06-02

Logistic Regression의 장점


Logistic Regression의 단점


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




1. 데이터 불러오기

pacman::p_load("data.table", 
               "tidyverse", 
               "dplyr",
               "caret",   
               "ggplot2", "GGally",
               "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 Dataset

5. 모형 훈련

Caution! Package "caret"에서 Logistic Regression은 Target이 2개의 클래스를 가질 때 “두 번째 클래스”에 속할 확률을 모델링하며, 범주형 예측 변수의 경우 더미 변환을 자동적으로 수행한다. 여기서, “두 번째 클래스”란 “Factor” 변환하였을 때 두 번째 수준(Level)을 의미한다. 예를 들어, “a”와 “b” 2개의 클래스를 가진 Target을 “Factor” 변환하였을 때 수준이 “a” “b”라면, 첫 번째 클래스는 “a”, 두 번째 클래스는 “b”가 된다.

fitControl <- trainControl(method = "cv", number = 5,  # 5-Fold Cross Validation (5-Fold CV)
                           allowParallel = TRUE)       # 병렬 처리

set.seed(100)                                          # For CV
logis.fit <- train(Personal.Loan ~ ., data = UB.trd, 
                   trControl = fitControl,
                   method = "glm",
                   family = "binomial",                # For Logit Transformation
                   preProc = c("center", "scale"))     # Standardization for 예측 변수

logis.fit
Generalized Linear Model 

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:

  Accuracy  Kappa    
  0.958302  0.7504365
logis.fit$finalModel                                   # Fitted Logistic Regression

Call:  NULL

Coefficients:
        (Intercept)                  Age           Experience  
           -4.86535              0.49203             -0.34968  
             Income             ZIP.Code              Family2  
            2.63841              0.07646             -0.15682  
            Family3              Family4                CCAvg  
            0.80748              0.74350              0.41075  
         Education2           Education3             Mortgage  
            1.52376              1.57630              0.05690  
Securities.Account1          CD.Account1              Online1  
           -0.44126              1.08260             -0.17908  
        CreditCard1  
           -0.60286  

Degrees of Freedom: 1750 Total (i.e. Null);  1735 Residual
Null Deviance:      1160 
Residual Deviance: 400.8    AIC: 432.8
summary(logis.fit$finalModel)                          # Summary for Fitted Logistic Regression

Call:
NULL

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.6854  -0.1834  -0.0739  -0.0227   4.0543  

Coefficients:
                    Estimate Std. Error z value Pr(>|z|)    
(Intercept)         -4.86535    0.29353 -16.575  < 2e-16 ***
Age                  0.49203    1.29516   0.380 0.704018    
Experience          -0.34968    1.28719  -0.272 0.785884    
Income               2.63841    0.22575  11.687  < 2e-16 ***
ZIP.Code             0.07646    0.13144   0.582 0.560766    
Family2             -0.15682    0.17757  -0.883 0.377160    
Family3              0.80748    0.17462   4.624 3.76e-06 ***
Family4              0.74350    0.17347   4.286 1.82e-05 ***
CCAvg                0.41075    0.14253   2.882 0.003955 ** 
Education2           1.52376    0.19358   7.871 3.51e-15 ***
Education3           1.57630    0.20431   7.715 1.21e-14 ***
Mortgage             0.05690    0.10230   0.556 0.578032    
Securities.Account1 -0.44126    0.17163  -2.571 0.010140 *  
CD.Account1          1.08260    0.14802   7.314 2.60e-13 ***
Online1             -0.17908    0.14032  -1.276 0.201883    
CreditCard1         -0.60286    0.17376  -3.469 0.000522 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1159.8  on 1750  degrees of freedom
Residual deviance:  400.8  on 1735  degrees of freedom
AIC: 432.8

Number of Fisher Scoring iterations: 8

Result! 데이터 “UB.trd”의 Target “Personal.Loan”은 “no”와 “yes” 2개의 클래스를 가지며, “Factor” 변환하면 알파벳순으로 수준을 부여하기 때문에 “yes”가 두 번째 클래스가 된다. 즉, “yes”에 속할 확률(= 개인 대출 제의를 수락할 확률)을 \(p\)라고 할 때, 추정된 회귀계수를 이용하여 다음과 같은 모형식을 얻을 수 있다. \[ \begin{align*} \log{\frac{p}{1-p}} = &-4.865 + 0.492 Z_{\text{Age}} - 0.350 Z_{\text{Experience}} + 2.638 Z_{\text{Income}} \\ &+0.076 Z_{\text{ZIP.Code}} - 0.157 Z_{\text{Family2}} + 0.807 Z_{\text{Family3}} + 0.744 Z_{\text{Family4}} \\ &+ 0.411 Z_{\text{CCAvg}} + 1.524 Z_{\text{Education2}} + 1.576 Z_{\text{Education3}} + 0.057 Z_{\text{Mortgage}} \\ &- 0.441 Z_{\text{Securities.Account1}} + 1.083 Z_{\text{CD.Account1}} - 0.179 Z_{\text{Online1}} - 0.603 Z_{\text{CreditCard1}} \end{align*} \] 여기서, \(Z_{\text{예측 변수}}\)는 표준화한 예측 변수를 의미한다.
범주형 예측 변수(“Family”, “Education”, “Securities.Account”, “CD.Account”, “Online”, “CreditCard”)는 더미 변환이 수행되었는데, 예를 들어, Family2는 가족 수가 2명인 경우 “1”값을 가지고 2명이 아니면 “0”값을 가진다.

OR <- exp(coef(logis.fit$finalModel))                  # Odds Ratio
CI <- exp(confint(logis.fit$finalModel))               # 95% Confidence Interval

cbind("Odds Ratio" = round(OR, 3),                     # round : 반올림
      round(CI, 3))
                    Odds Ratio 2.5 % 97.5 %
(Intercept)              0.008 0.004  0.013
Age                      1.636 0.117 19.060
Experience               0.705 0.061  9.732
Income                  13.991 9.208 22.367
ZIP.Code                 1.079 0.836  1.401
Family2                  0.855 0.601  1.208
Family3                  2.242 1.604  3.190
Family4                  2.103 1.509  2.986
CCAvg                    1.508 1.144  2.004
Education2               4.589 3.190  6.828
Education3               4.837 3.292  7.352
Mortgage                 1.059 0.865  1.292
Securities.Account1      0.643 0.449  0.882
CD.Account1              2.952 2.234  3.997
Online1                  0.836 0.634  1.101
CreditCard1              0.547 0.382  0.758

Result! 오즈비를 살펴보면, 나이(“Age”)를 표준화한 값이 1 증가할 경우, 개인 대출 제의를 수락할 가능성이 1.636배 증가한다. 반면, 경력(“Experience”)을 표준화한 값이 1 증가할 경우, 개인 대출 제의를 수락할 가능성이 1.418(=1/0.705)배 감소한다.


6. 모형 평가

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

# 예측 class 생성
logis.pred <- predict(logis.fit,                                        
                      newdata = UB.ted[,-9])           # Test Dataset including Only 예측 변수 

logis.pred %>%
  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 rows


6-1. ConfusionMatrix

CM   <- caret::confusionMatrix(logis.pred, UB.ted$Personal.Loan, 
                               positive = "yes")        # confusionMatrix(예측 class, 실제 class, positive = "관심 class")
CM
Confusion Matrix and Statistics

          Reference
Prediction  no yes
       no  667  21
       yes   6  55
                                         
               Accuracy : 0.964          
                 95% CI : (0.948, 0.9761)
    No Information Rate : 0.8985         
    P-Value [Acc > NIR] : 1.447e-11      
                                         
                  Kappa : 0.7833         
                                         
 Mcnemar's Test P-Value : 0.007054       
                                         
            Sensitivity : 0.72368        
            Specificity : 0.99108        
         Pos Pred Value : 0.90164        
         Neg Pred Value : 0.96948        
             Prevalence : 0.10147        
         Detection Rate : 0.07343        
   Detection Prevalence : 0.08144        
      Balanced Accuracy : 0.85738        
                                         
       'Positive' Class : yes            
                                         


6-2. ROC 곡선

# 예측 확률 생성 
test.logis.prob <- predict(logis.fit, 
                           newdata = UB.ted[,-9],         # Test Dataset including Only 예측 변수 
                           type = "prob")                 # 예측 확률 생성 

test.logis.prob %>%
  as_tibble
# A tibble: 749 × 2
      no       yes
   <dbl>     <dbl>
 1 1.00  0.000167 
 2 0.996 0.00446  
 3 1.00  0.000336 
 4 1.00  0.0000715
 5 0.995 0.00548  
 6 0.999 0.00143  
 7 0.979 0.0211   
 8 0.896 0.104    
 9 0.917 0.0827   
10 0.983 0.0175   
# ℹ 739 more rows
test.logis.prob <- test.logis.prob[,2]                    # "Personal.Loan = yes"에 대한 예측 확률

ac  <- UB.ted$Personal.Loan                               # Test Dataset의 실제 class 
pp  <- as.numeric(test.logis.prob)                        # 예측 확률을 수치형으로 변환

1) Package “pROC”

pacman::p_load("pROC")

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

Caution! Package "pROC"를 통해 출력한 ROC 곡선은 다양한 함수를 이용해서 그래프를 수정할 수 있다.

# 함수 plot.roc() 이용
plot.roc(logis.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(logis.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")

logis.pred <- prediction(pp, ac)                          # prediction(예측 확률, 실제 class)    

logis.perf <- performance(logis.pred, "tpr", "fpr")       # performance(, "민감도", "1-특이도")                      
plot(logis.perf, col = "gray")                            # ROC Curve

perf.auc   <- performance(logis.pred, "auc")              # AUC
auc        <- attributes(perf.auc)$y.values 
legend("bottomright", legend = auc, bty = "n")


6-3. 향상 차트

1) Package “ROCR”

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

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