1 기계학습 클래스 불균형 1 2 3

기계학습에서 관심있는 예측변수의 클래스가 매우 적은 경우가 흔하다.

  • 매년 약 2% 정도 신용카드가 도용되고 있다. 일반적으로 사기탐지(fraud detection) 분야는 2% 보다도 훨씬 적다.
  • 의학에서 질병검사도 건강한 일반인을 대상으로 하기 때문에 희귀하다. 예를 들어 미국에서 후천성면역결핍증(HIV) 발병율은 0.4% 정도에 불과하다.
  • 하드 디스크 고장율도 매년 약 1% 정도된다.
  • 온라인 광고의 전환율은 대략 \(10^{-3} ~ 10^{-6}\) 정도 된다.
  • 자동화된 생산공장의 불량율도 대략 0.1% 정도다.

이와 같이 관심을 갖고 예측하고자 하는 것이 매우 드문 경우가 빈번하기 때문에 지난 수십년동안 수많은 기계학습 분야에서 수많은 석박사를 배출했고, 따라서 예측에 빈번히 발생하는 클래스 불균형(class imbalance) 문제를 처리할 수 있는 방법이 많이 소개되었다.

대응방법은 다음과 같다.

  • 아무 것도 하지 않는다.
  • 훈련 데이터를 보정한다.
    • 과대표집(Over-Sampling)
    • 과소표집(Under-Sampling)
    • 소수 표본 데이터를 조합해서 생성시킴
  • 소수 표본 데이터를 버리고 비정상행위 탐지(anomaly detection framework)로 문제를 바꿔 접근한다.
  • 알고리즘 수준에서 미세 조정을 취한다.
    • 클래스 가중치(오분류 비용)를 조정
    • 컷오프 기준을 조정
    • 소수 표본 데이터에 좀더 예민하게 반응하도록 알고리즘을 조정

1.1 환경설정

Practical Guide to deal with Imbalanced Classification Problems in R에서 소개된 방법을 따라 환경을 설정히고 hacide 데이터를 준비한다. ROSE 팩키지에 포함되어 있는 가공된 데이터로 클래스 불균형 문제를 시작하는데 적절한 데이터로 사료된다.

# 0. 환경설정 --------------

library(ROSE)
library(tidyverse)
library(rpart)
library(caret)
library(ggpubr)
library(extrafont)
loadfonts()
library(plotROC)

# 1. 데이터 가져오기 --------

data(hacide)

hacide.train <- hacide.train %>% 
    mutate(cls = factor(cls, labels= c("no", "yes")))

hacide.test <- hacide.test %>% 
    mutate(cls = factor(cls, labels= c("no", "yes")))

1.2 데이터 살펴보기

hacide 데이터를 시각화를 통해 이해한다. 데이터는 cls가 0과 1일 경우 다른 방식으로 생성되었는데 자세한 내용은 hacide - Half Circle Filled Data 웹사이트를 참고한다.

# 2. 탐색적 데이터 분석 --------
## 2.1. 데이터 시각화
hacide.train %>% 
    ggplot(aes(x=x1, y=x2, color=cls)) +
      geom_point() +
      theme_pubr(base_family = "NanumGothic") +
      theme(legend.position = "top") +
      labs(color = "종속변수(cls)") +
      scale_color_manual(values = c("lightblue", "red"))

## 2.2. 데이터 장표
hacide.train %>% count(cls) %>% 
    mutate(비율 = scales::percent(n/ sum(n))) 
# A tibble: 2 x 3
  cls       n 비율 
  <fct> <int> <chr>
1 no      980 98.0%
2 yes      20 2.0% 

2 클래스 불균형 극복전략

클래스 불균형 문제에 대한 극복방법에 대해서 크게 4가지 방법이 제시되고 있다. 물론 ROSE 방법론을 옹호하는 입장에서 그렇다. 클래스 불균형 문제를 인식하고 이에 대해 체계적으로 접근할 수 있는 가장 손쉬운 시작점으로 이해하면 좋다.

  • 과대표집(Over-Sampling)
  • 과소표집(Under-Sampling)
  • 양쪽 표집(Both-Sampling)
  • 로즈 표집(ROSE Sampling)

클래스 불균형 극복전략을 예측모형과 연관하여 부츠트랩 표본을 생성하고 나서 각 부츠트랩 표본에서 과소표집(Down-sampling)을 통해 클래스 불균형을 해소하고 단순한 예측모형을 적합시킨 후에 다수결 원칙에 의거하여 최종 예측모형을 완성하는 과정을 거친다.

클래스 불균형 대응 예측모형

# 3. 클래스 불균형(class imbalance) 극복전략 -----

balanced_over_sampling_df  <- ovun.sample(cls ~ ., data = hacide.train, method = "over", N = 1960)$data
balanced_under_sampling_df <- ovun.sample(cls ~ ., data = hacide.train, method = "under", N = 40, seed = 1)$data
balanced_both_sampling_df <- ovun.sample(cls ~ ., data = hacide.train, method = "both", p=0.5,                             N=1000, seed = 1)$data
rose_df <- ROSE(cls ~ ., data = hacide.train)$data

3 클래스 불균형 극복전략 성능비교

과대표집(Over-Sampling), 과소표집(Under-Sampling), 양쪽 표집(Both-Sampling), 로즈 표집(ROSE Sampling) 그리고 클래스 불균형 극복전략이 없는 경우 포함하여 총 5가지 전략에 대해서 성능을 비교해 보자.

3.1 AUC 성능비교

AUC 곡선 비교하면 hacide 데이터에는 로즈 방법론이 가장 좋은 성능을 나타내고 있다.

# 4. 재귀분할(rpart) 나무모형 적합 --------

raw_rpart   <- rpart(cls ~ ., data = hacide.train)
over_rpart  <- rpart(cls ~ ., data = balanced_over_sampling_df)
under_rpart <- rpart(cls ~ ., data = balanced_under_sampling_df)
both_rpart  <- rpart(cls ~ ., data = balanced_both_sampling_df)
rose_rpart  <- rpart(cls ~ ., data = rose_df)

# 5. 클래스 불균형 재귀분할(rpart) 나무모형 평가 --------
## 5.1. 검증데이터 적용 예측
pred_raw_rpart    <- predict(raw_rpart  , newdata = hacide.test)
pred_over_rpart   <- predict(over_rpart , newdata = hacide.test)
pred_under_rpart  <- predict(under_rpart, newdata = hacide.test)
pred_both_rpart   <- predict(both_rpart , newdata = hacide.test)
pred_rose_rpart   <- predict(rose_rpart , newdata = hacide.test)

## 5.2. AUC
roc.curve(hacide.test$cls, pred_raw_rpart[,2], plot=FALSE)
Area under the curve (AUC): 0.600
roc.curve(hacide.test$cls, pred_over_rpart[,2], plot=FALSE)
Area under the curve (AUC): 0.798
roc.curve(hacide.test$cls, pred_under_rpart[,2], plot=FALSE)
Area under the curve (AUC): 0.867
roc.curve(hacide.test$cls, pred_both_rpart[,2], plot=FALSE)
Area under the curve (AUC): 0.798
roc.curve(hacide.test$cls, pred_rose_rpart[,2], plot=FALSE)
Area under the curve (AUC): 0.989

3.2 AUC 성능비교 plotROC 시각화

ggplot을 통해 5가지 예측모형의 성능을 살펴본다.

## 5.3. ggplot ROC 데이터 

raw_roc_df  <- tibble(cls = hacide.test[,1], pred=pred_raw_rpart[,2],   sampling="원데이터")
over_roc_df <- tibble(cls = hacide.test[,1], pred=pred_over_rpart[,2],  sampling="과대 표집")
under_roc_df <- tibble(cls = hacide.test[,1], pred=pred_under_rpart[,2], sampling="과소 표집")
both_roc_df <- tibble(cls = hacide.test[,1], pred=pred_both_rpart[,2],  sampling="양쪽 표집")
rose_roc_df <- tibble(cls = hacide.test[,1], pred=pred_rose_rpart[,2],  sampling="ROSE 표집")

hacide_roc_df <- bind_rows(raw_roc_df, over_roc_df) %>% 
    bind_rows(under_roc_df) %>% 
    bind_rows(both_roc_df) %>% 
    bind_rows(rose_roc_df)

## 5.4. ggplot ROC 시각화

ggplot(hacide_roc_df, aes(d = cls, m = pred, color=sampling)) + 
    geom_roc(labels =FALSE)  +
    style_roc() +
    theme_pubr(base_family="NanumGothic") +
    theme(legend.position = "top") +
    labs(color="클래스 불균형 해소방법: ")

4 caret 구현 4

4.1 caret 클래스 불균형 대응

caret 팩키지 클래스 불균형 대응 구현된 기능을 활용하여 예측모형 성능을 비교평가한다. 예측모형은 동일하게 randomForest를 사용하고 앞서 언급된 클래스 불균형 대응 알고리즘을 반영한다.

# 2. 모형 적합 --------
## 2.1. 원데이터 ------
hacide_ctrl <- trainControl(method = "repeatedcv", 
                            number = 5, 
                            repeats = 5, 
                            verboseIter = FALSE)

model_rf <- train(cls ~ .,
                  data = hacide.train,
                  method = "rf",
                  preProcess = c("scale", "center"),
                  trControl = hacide_ctrl)
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
## 2.2. Under-sampling ------
hacide_under_ctrl <- trainControl(method = "repeatedcv", 
                            number = 5, 
                            repeats = 5, 
                            verboseIter = FALSE,
                            sampling = "down")

model_under_rf <- train(cls ~ .,
                  data = hacide.train,
                  method = "rf",
                  preProcess = c("scale", "center"),
                  trControl = hacide_under_ctrl)
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
## 2.3. Up-sampling ------
hacide_up_ctrl <- trainControl(method = "repeatedcv", 
                                  number = 5, 
                                  repeats = 5, 
                                  verboseIter = FALSE,
                                  sampling = "up")

model_up_rf <- train(cls ~ .,
                        data = hacide.train,
                        method = "rf",
                        preProcess = c("scale", "center"),
                        trControl = hacide_up_ctrl)
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
## 2.4. ROSE ------
hacide_rose_ctrl <- trainControl(method = "repeatedcv", 
                               number = 5, 
                               repeats = 5, 
                               verboseIter = FALSE,
                               sampling = "rose")

model_rose_rf <- train(cls ~ .,
                     data = hacide.train,
                     method = "rf",
                     preProcess = c("scale", "center"),
                     trControl = hacide_rose_ctrl)
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
## 2.5. SMOTE ------
hacide_smote_ctrl <- trainControl(method = "repeatedcv", 
                                 number = 5, 
                                 repeats = 5, 
                                 verboseIter = FALSE,
                                 sampling = "smote")

model_smote_rf <- train(cls ~ .,
                       data = hacide.train,
                       method = "rf",
                       preProcess = c("scale", "center"),
                       trControl = hacide_smote_ctrl)
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .

4.2 caret 클래스 불균형 성능평가

AUC 값을 성능평가 기준으로 삼아 예측모형 성능을 비교한다.

# 3. 성능 비교 ------
## 3.1. 일반적인 성능 평가 지표
hacide_models <- list(original = model_rf,
                      under    = model_under_rf,
                      over     = model_up_rf,
                      smote    = model_smote_rf,
                      rose     = model_rose_rf)

hacide_resampling <- resamples(hacide_models)
bwplot(hacide_resampling)

## 3.2. AUC 지표
pred_rf           <- predict(model_rf,       newdata = hacide.test)
pred_under_rf     <- predict(model_under_rf, newdata = hacide.test)
pred_up_rf        <- predict(model_up_rf,    newdata = hacide.test)
pred_smote_rf     <- predict(model_smote_rf, newdata = hacide.test)
pred_rose_rf      <- predict(model_rose_rf,  newdata = hacide.test)

roc.curve(hacide.test$cls, pred_rf, plot=FALSE)
Area under the curve (AUC): 0.700
roc.curve(hacide.test$cls, pred_under_rf, plot=FALSE)
Area under the curve (AUC): 0.939
roc.curve(hacide.test$cls, pred_up_rf, plot=FALSE)
Area under the curve (AUC): 0.698
roc.curve(hacide.test$cls, pred_smote_rf, plot=FALSE)
Area under the curve (AUC): 0.796
roc.curve(hacide.test$cls, pred_rose_rf, plot=FALSE)
Area under the curve (AUC): 0.963

4.3 caret 클래스 불균형 성능평가 시각화

ggplot으로 ROC 곡선을 도식화하여 성능을 비교한다.

## 3.3. ggplot ROC 데이터 
pred_rf           <- predict(model_rf,       newdata = hacide.test, type="prob")
pred_under_rf     <- predict(model_under_rf, newdata = hacide.test, type="prob")
pred_up_rf        <- predict(model_up_rf,    newdata = hacide.test, type="prob")
pred_smote_rf     <- predict(model_smote_rf, newdata = hacide.test, type="prob")
pred_rose_rf      <- predict(model_rose_rf,  newdata = hacide.test, type="prob")


raw_roc_df   <- tibble(cls = hacide.test$cls, pred= pred_rf[,2],   sampling="원데이터")
under_roc_df <- tibble(cls = hacide.test$cls, pred=pred_under_rf[,2],  sampling="과소 표집")
up_roc_df    <- tibble(cls = hacide.test$cls, pred=pred_up_rf[,2], sampling="과대 표집")
smote_roc_df <- tibble(cls = hacide.test$cls, pred=pred_smote_rf[,2],  sampling="SMOTE 표집")
rose_roc_df  <- tibble(cls = hacide.test$cls, pred=pred_rose_rf[,2],  sampling="ROSE 표집")

hacide_caret_roc_df <- bind_rows(raw_roc_df, under_roc_df) %>% 
    bind_rows(up_roc_df) %>% 
    bind_rows(smote_roc_df) %>% 
    bind_rows(rose_roc_df)

## 4.4. ggplot ROC 시각화

ggplot(hacide_caret_roc_df, aes(d = cls, m = pred, color=sampling)) + 
    geom_roc(labels =FALSE)  +
    style_roc() +
    theme_pubr(base_family="NanumGothic") +
    theme(legend.position = "top") +
    labs(color="클래스 불균형 해소방법: ")

5 향상도(Lift) 5

향상도(Lift)를 통해 희소한, 관심있는 클래스를 탐지하는데 예측모형에서 나온 표본 중 얼마를 탐지해야 유의미한지 확인한다.

# 5. lift ------------

hacide.test$pred <- predict(model_rose_rf,  newdata = hacide.test, type="prob")[, "yes"]

hacide_lift <- caret::lift(cls ~ pred,  data = hacide.test, cuts = 100, class="yes")

ggplot(hacide_lift, values=80) +
    geom_line(color="blue") +
    theme_pubr(base_family = "NanumGothic") +
    labs(title = "hacide 데이터에 대한 향상도(lift)", 
         subtitle = "희귀한 2% 사례 80%를 탐지하기 하는데 약 5% 정도 노력만 필요",
        x="탐색해야 될 표본비율(% Samples Tested)", y="탐색된 표본비율(% Samples Found)") +
    scale_x_continuous(breaks = seq(0,100,10))

6 캐글 사례 6

Medical Appointment No Shows - Why do 30% of patients miss their scheduled appointments? 병원약속을 했으나 나타나지 않는 노쇼(No Show) 데이터를 바탕으로 클래스 불균형이 극심한 경우 이를 예측할 수 있는 모형을 개발해보자.

6.1 데이터 다운로드 및 정제작업

먼저 데이터를 다운로드 받아… 변수명에 대한 전처리 작업을 수행한다. janitor 팩키지 clean_names() 함수를 사용해도 유사한 효과를 기대할 수 있다. 문자형 변수를 요인형 변수로 변환시키고, 날짜 변수에서 유용한 몇가지 피쳐를 추출하고 예측모형에 불필요한 변수는 제거하여 예측모형 데이터프레임을 생성시킨다.

library(lubridate)
## 데이터 가져오기
ns_dat <- read_csv(file = "data/KaggleV2-May-2016.csv")

## 변수명 변환
ns_dat <- ns_dat %>% 
  setNames(names(.) %>% str_to_lower() %>% str_replace("[.-]", "_")) %>%
  dplyr::rename(
    hypertension = hipertension,
    handicap = handcap
  )

## 데이터 정제
ns_df <- ns_dat %>%
    mutate_at(vars(gender, neighbourhood:no_show), factor) %>% # 자료형 변환: 문자 --> 요인
    select(-patientid, -appointmentid, -neighbourhood)  %>%  # ID 변수명 제거 및 많은 수준을 갖는 변수 제거
    mutate(scheduleddow = wday(scheduledday) %>% factor(),
           hour = hour(scheduledday) + (minute(scheduledday) + second(scheduledday) / 60) / 60,
           appointmentdow = wday(appointmentday) %>% factor(),
           advance = difftime(scheduledday, appointmentday, units = "hours") %>% as.numeric()) %>% # 날짜 데이터에서 피처 추출   
    select(-scheduledday, -appointmentday) %>% 
    mutate(no_show = relevel(no_show, "Yes")) %>% 
    select(no_show, everything())

ns_df %>% 
  sample_n(100) %>% 
  DT::datatable()

6.2 예측 모형 개발

훈련/시험 데이터로 데이터를 분할하고, 훈련데이터를 다시 훈련/검증 데이터로 분할시켜 각 예측모형 아키텍처에서 최적의 모형이 개발되도록 한다. 그리고 나서 윈도우 환경에서 doSNOW 팩키지를 통해 병렬처리를 위한 클러스터를 생성시키고 나서, GLM, RF, GBM 모형을 적합시켜 최적의 모형을 추출해 낸다.

library(caret)

ns_m_df  <- ns_df %>% 
  sample_frac(0.1)

ns_index <- createDataPartition(ns_m_df$no_show, times =1, p=0.3, list=FALSE)

train_df <- ns_m_df[ns_index, ]
test_df  <- ns_m_df[-ns_index, ]

## 2.2. 모형 개발/검증 데이터셋 준비 ------

cv_folds <- createMultiFolds(train_df$no_show, k = 10, times = 3)

cv_cntrl <- trainControl(method = "repeatedcv", number = 10,
                         repeats = 1, 
                         index = cv_folds,
                         classProbs = TRUE,
                         summaryFunction = twoClassSummary)

library(doSNOW)
# 실행시간
start.time <- Sys.time()

cl <- makeCluster(8, type = "SOCK")
registerDoSNOW(cl)

ns_glm   <- train(no_show ~ ., data = train_df, 
                  method = "glm",
                  family = "binomial",
                  metric = "Sens",
                  trControl = cv_cntrl, 
                  tuneLength = 3)

# ns_rf    <- train(no_show ~ ., data = train_df, 
#                    method = "rf",
#                    metric = "Sens",
#                    importance = TRUE,
#                    trControl = cv_cntrl, 
#                    tuneLength = 7)

ns_gbm <- train(no_show ~ ., data = train_df, 
                  method = "xgbTree",
                  metric = "Sens",
                  trControl = cv_cntrl, 
                  tuneLength = 1)

stopCluster(cl)
 
total.time <- Sys.time() - start.time
total.time
Time difference of 14.31337 secs

클래스 불균형으로 예측모형의 성능의 민감도(Sensitivity)가 낮게 나와 이를 클래스를 균형있게 잡아 보정해보자.

ns_df %>% 
  count(no_show) %>% 
  mutate(pcnt = scales::percent(n / sum(n)))
# A tibble: 2 x 3
  no_show     n pcnt 
  <fct>   <int> <chr>
1 Yes     22319 20.2%
2 No      88208 79.8%
confusionMatrix(predict(ns_gbm, test_df), test_df$no_show)
Confusion Matrix and Statistics

          Reference
Prediction  Yes   No
       Yes   38   82
       No  1518 6099
                                         
               Accuracy : 0.7932         
                 95% CI : (0.784, 0.8022)
    No Information Rate : 0.7989         
    P-Value [Acc > NIR] : 0.8963         
                                         
                  Kappa : 0.017          
 Mcnemar's Test P-Value : <2e-16         
                                         
            Sensitivity : 0.024422       
            Specificity : 0.986734       
         Pos Pred Value : 0.316667       
         Neg Pred Value : 0.800709       
             Prevalence : 0.201112       
         Detection Rate : 0.004911       
   Detection Prevalence : 0.015510       
      Balanced Accuracy : 0.505578       
                                         
       'Positive' Class : Yes            
                                         

6.3 클래스 불균형 보정 7

DMwR 팩키지 smote, ROSE 팩키지 rosetrainControl()에 적용시켜, 기존 upsamping, downsampling과 함께 클래스 불균형에 따른 예측모형 성능저하를 보완할 수 있다. 8

table(train_df$no_show) 

 Yes   No 
 667 2649 
smote_train <- DMwR::SMOTE(no_show ~ ., data  = as.data.frame(train_df), perc.over = 100, perc.under = 200)
table(smote_train$no_show) 

 Yes   No 
1334 1334 
# 실행시간
start.time <- Sys.time()

cl <- makeCluster(8, type = "SOCK")
registerDoSNOW(cl)

ns_balance_glm   <- train(no_show ~ ., data = train_df, 
                  method = "glm",
                  family = "binomial",
                  metric = "Sens",
                  trControl = cv_cntrl, 
                  tuneLength = 3)

# ns_balance_rf    <- train(no_show ~ ., data = train_df, 
#                    method = "rf",
#                    metric = "Sens",
#                    importance = TRUE,
#                    trControl = cv_cntrl, 
#                    tuneLength = 7)

ns_balance_gbm <- train(no_show ~ ., data = train_df, 
                  method = "xgbTree",
                  metric = "Sens",
                  trControl = cv_cntrl, 
                  tuneLength = 3)

stopCluster(cl)
 
total.time <- Sys.time() - start.time
total.time
Time difference of 1.977234 mins

rose, smote 클래스 불균형 보완전략을 적용시켜 예측모형의 성능을 파악할 수 있다. 관심있는 것이 전반적인 정확도 보다는 노쇼에 대한 예측이기 때문에 민감도(Sensitivity)를 높일 수 있는 측도에 방점을 두고 예측모형을 개발해 나간다.

confusionMatrix(predict(ns_balance_gbm, test_df), test_df$no_show)
Confusion Matrix and Statistics

          Reference
Prediction  Yes   No
       Yes  282  531
       No  1274 5650
                                          
               Accuracy : 0.7667          
                 95% CI : (0.7571, 0.7761)
    No Information Rate : 0.7989          
    P-Value [Acc > NIR] : 1               
                                          
                  Kappa : 0.1161          
 Mcnemar's Test P-Value : <2e-16          
                                          
            Sensitivity : 0.18123         
            Specificity : 0.91409         
         Pos Pred Value : 0.34686         
         Neg Pred Value : 0.81600         
             Prevalence : 0.20111         
         Detection Rate : 0.03645         
   Detection Prevalence : 0.10508         
      Balanced Accuracy : 0.54766         
                                          
       'Positive' Class : Yes             
                                          

클래스 보완한 것만으로 전반적인 예측(정확도)은 조금 하락(했으나, 노쇼에 대한 예측은 일정부분 개선된 것을 확인할 수 있다.

orig_conf <- confusionMatrix(predict(ns_gbm, test_df), test_df$no_show)
balance_conf <- confusionMatrix(predict(ns_balance_gbm, test_df), test_df$no_show)

## 민감도 측도 변경
orig_conf_df <- orig_conf$byClass %>% as.data.frame %>% 
  rownames_to_column(var="측도") %>% 
  rename(원데이터 = ".") %>% 
  add_row(측도 = "Accuracy", 원데이터 = orig_conf$overall["Accuracy"])

balance_conf_df <- balance_conf$byClass %>% as.data.frame %>% 
  rownames_to_column(var="측도") %>% 
  rename(SMOTE = ".") %>% 
  add_row(측도 = "Accuracy", SMOTE = balance_conf$overall["Accuracy"])

comp_df  <- inner_join(orig_conf_df, balance_conf_df)

comp_df %>% 
  filter(측도 %in% c("Sensitivity", "Specificity", "Accuracy")) %>% 
  DT::datatable() %>% 
  DT::formatRound(c(2:3), digits=3)