1 고객이탈과 HR 이탈

고객이탈은 영어로 “Customer Churn” 혹은 “Customer Attrition”이라고 하는데 통상적으로 고객이 더이상 서비스 이용이나 제품구매를 멈출 때 발생된다. 거의 모든 사업영역에서 고객이탈이 문제가 되지만, 특히 문제가 되는 분야가 통신(텔코, Tele-communication)산업으로 KT, SKT, U+ 등 통신3사가 거의 과점을 하고 있는 산업분야로 이해하면 된다.

과거 고객이탈에 대한 부분만 관심을 가졌다는 현재는 인적자원(Human Resource) 임직원 이탈이 부각되고 있다.

인적자원 이탈을 두가지 형태로 나타난다.

  • 자발적인 이직: 임직원이 사직하고 조직을 떠나는 경우.
    • 명목적인 이유
      • 더 나은 기회를 찾아 이직
      • 건강상의 이유
      • 업무전환배치와 근무지 변경
      • 교육
      • 개인적 사유 外
    • 숨겨진 이유
      • 상급자와 관계
      • 급여인상율
      • 초과근무
      • 업무상 출장 거리
      • 직무 만족도
      • 정년보장
  • 비자발적인 이직: 조직이 임직원을 사직하게 되는 경우.

데이터가 다양해졌고 많이 축적되었기 때문에 과거에 비해 인적자원 및 고객이탈 대한 원인파악 및 대책 수립이 가능하게 되었다.

1.1 데이터셋

임직원 이탈에 대한 내용보다 고객이탈에 대한 내용을 중심을 설명가능한 예측모형을 만들어 나갑니다.

1.2 작업흐름도

원데이터에 대한 정제작업이 마무리되면 Information Value를 통해 변수 선택과 변수내 수준도 적절한 형태로 조정한 후에 로지스틱 선형회귀모형에 적합시킨다. 이 과정에서 VIF를 통해 중복되는 변수도 걸러내고 최종 모형을 만들어 성능평가를 한후에 모형에 대한 이해와 커뮤니케이션을 위한 정리작업을 수행한다.

작업흐름도

2 고객이탈 데이터 정제

.csv 데이터를 read_csv()를 통해 불러와서 변수명과 변수 자료형을 향수 분석에 맞게 조정한다.

library(tidyverse)
library(readxl)
library(janitor)
library(skimr)

churn_dat <- read_csv("data/WA_Fn-UseC_-Telco-Customer-Churn.csv")

churn_df <- churn_dat %>% 
  clean_names()

churn_list <- skim_to_list(churn_df)

churn_df <- churn_df %>% 
  mutate(churn = factor(churn, levels = c("No", "Yes"))) %>% 
  mutate_at(vars(churn_list$character$variable), as.factor) %>% 
  mutate(senior_citizen = factor(senior_citizen)) %>% 
  select(-customer_id) %>% 
  mutate(multiple_lines    = ifelse(str_detect(multiple_lines, "No"), "No", "Yes"),
         internet_service  = ifelse(str_detect(internet_service, "No"), "No", "Yes"),
         online_security   = ifelse(str_detect(online_security, "No"), "No", "Yes"),
         online_backup     = ifelse(str_detect(online_backup, "No"), "No", "Yes"),
         device_protection = ifelse(str_detect(device_protection, "No"), "No", "Yes"),
         tech_support      = ifelse(str_detect(tech_support, "No"), "No", "Yes"),
         streaming_tv      = ifelse(str_detect(streaming_tv, "No"), "No", "Yes"),
         streaming_movies  = ifelse(str_detect(streaming_movies, "No"), "No", "Yes")) 

2.1 고객 이탈 통계

먼저 고객 이탈에 대한 통계를 산출한다. 이를 위해서 문자형을 정수형으로 변환하고 이탈은 1 잔존을 0으로 인코딩한 후에 mean() 함수로 평균을 낸다.

churn_df %>% 
  summarise(churn_rate = mean(as.integer(churn)-1))
# A tibble: 1 x 1
  churn_rate
       <dbl>
1      0.265

2.2 고객이탈 시각화 - 연속형

skimr 팩키지 skim_to_list() 함수를 사용해서 변수 자료형을 문자형, 정수형, 숫자형, 부울형 등올 나눈후에 숫자형만 추출하여 이를 이탈목적변수(churn)와 교차하여 시각화한다.

library(ggridges)
library(cowplot)
## 2.1. 정적 시각화 -----
y_p <- churn_df %>%
    ggplot(aes(x = churn, fill = churn)) +
    geom_bar(alpha = 0.8) +
    scale_fill_manual(values = c("gray", "red")) +
    guides(fill = FALSE)

x_cont_p <- churn_df %>%
    select(churn, tenure, churn_list$numeric$variable) %>% 
    gather(variable, value, -churn) %>%
    mutate(value = as.integer(value)) %>% 
    ggplot(aes(x = value, y = churn, fill = churn)) +
    facet_wrap( ~ variable, scale = "free", ncol = 2) +
    scale_fill_manual(values = c("gray", "red")) +
    geom_density_ridges(alpha = 0.8) +
    guides(fill = FALSE, color = FALSE)

plot_grid(y_p, x_cont_p, rel_widths = c(1,3))

2.3 고객이탈 시각화 - 범주형

동일하게 skimr 팩키지 skim_to_list() 함수를 사용해서 변수 자료형을 문자형, 정수형, 숫자형, 부울형 등올 나눈후에 문자형을 요인(factor)형 변환한 후에 이를 이탈목적변수(churn)와 교차하여 시각화한다.

x_cat_p <- churn_df %>%
    select_if(is.factor) %>% 
    gather(variable, value, -churn) %>% 
    group_by(churn) %>% 
    count(variable, value) %>% 
    ungroup() %>% 
    ggplot(data = ., aes(x=value, y=n, fill=churn)) + 
      geom_col(position="dodge", width=0.7) +
      facet_wrap(~variable, scale = "free", ncol = 4) +
      scale_fill_manual(values = c("gray", "red")) +
      guides(fill = FALSE, color = FALSE)

plot_grid(y_p, x_cat_p, rel_widths = c(1,3))

3 IV (information value)

Information 팩키지 create_infotables() 함수를 통해 IV를 쉽게 계산할 수 있다. 고객이탈에 영향을 많이 주는 변수를 예측변수를 사전에 선정하는데 참조한다.

Information value 예측력(Predictive power)
IV < 0.15 Poor
0.15 < IV < 0.4 Moderate
IV > 0.4 Strong
library(Information) # install.packages("Information")

churn_iv_df <- churn_df %>% 
  mutate(churn = as.integer(churn) -1 )

churn_iv <- create_infotables(data=churn_iv_df, y="churn", bins=10, parallel=TRUE)

churn_iv$Summary %>% 
  mutate(Variable = fct_reorder(Variable, IV)) %>% 
  ggplot(aes(x=Variable, y=IV)) +
    geom_col() +
    coord_flip()

churn_iv$Summary %>% 
  top_n(6, wt=IV)
          Variable        IV
1         contract 1.2385598
2           tenure 0.8262254
3   payment_method 0.4571089
4 internet_service 0.3751828
5  monthly_charges 0.3656368
6    total_charges 0.3373546

4 예측모형 생성1

과거 caret 팩키지를 활용하여 훈련데이터와 검증데이터로 분리했다면, 이번에는 tidymodels를 구성하는 parsnip 팩키지를 활용하여 로지스틱 회귀모형을 구현한다.

4.1 훈련/시험 데이터 생성

먼저, 훈련/시험 데이터로 나눠 훈련데이터를 대상으로 고객이탈 예측모형을 개발한다. initial_split() 함수로 전체 데이터를 7:3으로 훈련/시험 데이터로 분리할 수 있다.

library(tidymodels)

churn_tbl <- churn_df %>% 
  mutate_if(is.character, as.factor) %>% 
  drop_na()

set.seed(777)

splits <- initial_split(churn_tbl, prop = 0.7, strata = churn)

splits
<Analysis/Assess/Total>
<4924/2108/7032>

4.2 피처 공학

피처 공학을 통해 먼저 범주형 데이터는 step_other() 함수로 One-hot 인코딩하고, 숫자형 변수는 정규화시킨다.

recipe_spec <- recipe(churn ~ ., data = training(splits)) %>% 
  step_other(all_nominal(), -all_outcomes()) %>% 
  step_normalize(all_numeric())

# recipe_spec %>% prep() %>% juice()

4.3 예측모형 생성

과적합을 방지하기 위해서 car 팩키지 vif() 함수를 사용해서 VIF가 5 이상되는 변수를 제거하여 강건한 예측모형을 생성했다.

VIF Interpretation
1 < VIF 상관관계 없음
1 < VIF < 5 다소 상관관계 존재함
VIF > 5 심하게 상관관계 존재함

VIF가 5보다 큰 경우 해당 변수를 제거하고 회귀모형을 구축하고 더이상 VIF가 5보다 큰게 없는 경우까지 반복하는 과정을 거쳤다.

하지만, tidymodels로 바뀌게 되면 Feature Engineering은 recipes, 다양한 모형은 parsnip을 사용해서 정의하고 이를 workflows로 연결시키면 코드도 깔끔하고 나중에 유연하게 고성능 예측모형을 개발할 수 있게 된다.

model_spec <- logistic_reg( mode = "classification") %>%
    set_engine("glm")

wkfl_fit <- workflows::workflow() %>% 
  add_recipe(recipe_spec) %>% 
  add_model(model_spec) %>% 
  fit(training(splits))

wkfl_fit
== Workflow [trained] ==========================================================
Preprocessor: Recipe
Model: logistic_reg()

-- Preprocessor ----------------------------------------------------------------
2 Recipe Steps

* step_other()
* step_normalize()

-- Model -----------------------------------------------------------------------

Call:  stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)

Coefficients:
                          (Intercept)                             genderMale  
                             -0.06511                                0.02437  
                      senior_citizen1                             partnerYes  
                              0.23080                                0.02981  
                        dependentsYes                                 tenure  
                             -0.03450                               -1.40916  
                     phone_serviceYes                      multiple_linesYes  
                             -1.27111                                0.07666  
                  internet_serviceYes                     online_securityYes  
                              0.15628                               -0.37865  
                     online_backupYes                   device_protectionYes  
                             -0.38647                               -0.19659  
                      tech_supportYes                        streaming_tvYes  
                             -0.48495                               -0.08017  
                  streaming_moviesYes                       contractOne year  
                             -0.14768                               -0.70626  
                     contractTwo year                   paperless_billingYes  
                             -1.37344                                0.35043  
payment_methodCredit card (automatic)         payment_methodElectronic check  
                             -0.16168                                0.34069  
           payment_methodMailed check                        monthly_charges  
                             -0.09263                                0.91578  
                        total_charges  
                              0.62213  

Degrees of Freedom: 4923 Total (i.e. Null);  4901 Residual
Null Deviance:      5703 
Residual Deviance: 4047     AIC: 4093

4.4 예측모형 성능

VIF를 통해 다공선성을 방지한 강건한 예측모형을 생성했는데 이에 대한 성능평가를 예측모형 구축에 사용되지 않은 test_df 데이터를 바탕으로 caret 팩키지 confusionMatrix() 함수로 평가했다.

workflow 객체를 predict() 함수에 넣어 시험데이터를 대상으로 고객이탈 여부와 확률을 산출하여 이를 데이터프레임으로 저장시킨다.

prediction_class_test <- predict(wkfl_fit, new_data = testing(splits), type = "class")

prediction_prob_test  <- predict(wkfl_fit, new_data = testing(splits), type = "prob")

results_tbl <- bind_cols(
    prediction_class_test,
    prediction_prob_test,
    testing(splits)
)

고객이탈 분류기 성능을 roc_auc() 함수로 추정할 수 있고, autoplot() 함수로 시각적으로 확이도 가능하다.

results_tbl %>%
    roc_auc(churn, .pred_Yes )
# A tibble: 1 x 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 roc_auc binary         0.836
results_tbl %>%
    roc_curve(churn, .pred_Yes ) %>%
    autoplot(
        options = list(
            smooth = TRUE
        )
    ) +
    labs(title = "Area Under the Curve (AUC): 0.836")

5 예측모형 설명

5.1 중요 변수

workflow 객체로부터 parsnip 객체를 뽑아내서 이를 vip() 함수에 넣어준다. 이를 통해, 중요변수로 tenure, monthly_charges를 확인할 수 있다.

library(vip)

# 중요변수 시각화
wkfl_fit$fit$fit %>%
    vip(
        num_features = 20,
        geom         = "point",
        aesthetics   = list(
            size     = 4,
            color    = "#18bc9c"
        )
    ) +
    theme_minimal(base_size = 18) +
    labs(title = "로지스틱 회귀모형 - 변수 중요도",
         y="중요도")

5.2 고객 이탈 설명

중요변수로 tenure, monthly_charges를 고객이탈야부를 교차시켜 시각화한다. 월별 통신료가 높은 고객의 이탈율이 상대적으로 초기에 높은 것이 확인된다.

churn_tbl %>%
    ggplot(aes(tenure, monthly_charges, color = churn)) +
    geom_smooth(method = "loess") +
    geom_jitter(alpha = 0.25) +
    theme_minimal(base_size = 18) +
    scale_color_viridis_d(end = 0.4) +
    labs(title = "월별 통신료가 높은 고객의 이탈율이 높음",
         x     = "가입기간",
         y     = "월별 통신료",
         color = "이탈여부") +
    theme(legend.position = "top")

6 예측모형 활용

예측모형 성능을 확인한 후에 가장 이탈 위험이 많은 고객 상위 10을 뽑아 이를 다음 후속작업에 활용한다. tidypredict 팩키지 tidypredict_to_column() 함수를 사용하면 깔끔하게 이탈확률이 높은 고객을 추려내는데 도움이 되는데, 따로 팩키지를 사용하지 말고 앞서 제작한 results_tbl 데이터프레임에 모든 정보가 담겨있어 이를 활용하여 이탈위험이 높은 고객 10명을 추려낸다.

results_tbl %>%  
  select(-.pred_No) %>% 
  top_n(10, wt=.pred_Yes) %>% 
  DT::datatable() %>% 
    DT::formatPercentage(".pred_Yes", digits=1)

7 예측모형 커뮤니케이션

texreg 팩키지 혹은 stargazer 팩키지를 통해 예측모형에 대한 사항을 정리하여 커뮤니케이션하기 용이하다. 마찬가지로 workflow 객체에서 parsnip 객체를 추출한다.

library(texreg)

# screenreg(list(churn_glm, best_glm), custom.note = "")
# htmlreg(list(churn_glm, best_glm), custom.note = "")

htmlreg(wkfl_fit$fit$fit, custom.note = "")
Statistical models
  Model 1
(Intercept) -0.07
  (0.42)
genderMale 0.02
  (0.08)
senior_citizen1 0.23*
  (0.10)
partnerYes 0.03
  (0.09)
dependentsYes -0.03
  (0.11)
tenure -1.41***
  (0.18)
phone_serviceYes -1.27***
  (0.21)
multiple_linesYes 0.08
  (0.10)
internet_serviceYes 0.16
  (0.24)
online_securityYes -0.38***
  (0.10)
online_backupYes -0.39***
  (0.09)
device_protectionYes -0.20*
  (0.10)
tech_supportYes -0.48***
  (0.10)
streaming_tvYes -0.08
  (0.11)
streaming_moviesYes -0.15
  (0.11)
contractOne year -0.71***
  (0.13)
contractTwo year -1.37***
  (0.22)
paperless_billingYes 0.35***
  (0.09)
payment_methodCredit card (automatic) -0.16
  (0.14)
payment_methodElectronic check 0.34**
  (0.11)
payment_methodMailed check -0.09
  (0.14)
monthly_charges 0.92***
  (0.14)
total_charges 0.62**
  (0.19)
Deviance (Null) 5702.76
df.null 4923
Log Likelihood -2023.75
AIC 4093.49
BIC 4243.03
Deviance 4047.49
DF Resid. 4901
 

데이터 과학자 이광춘 저작

kwangchun.lee.7@gmail.com