Regork Analysis

Introduction

In this report, I will be looking into the potential of Regork to expand or retain customers with multiple phone lines. The goal of this analysis is to identify if customers having a partner can lead to potentially expanding our multiple line service or tenure of customers. Additionally, three models will be created to analyze the potential impact of variables on the Status of the customer.

This report will briefly analyze the impact of Tenure length, Partner, and Phone Line type to find potential ways to generate or maintain profits. This will be done through creating multiple graphs analyzing the data and through machine learning finding the imapct of these variables.

Library and Data Preparation

# Library
library(tidymodels)
library(tidyverse)
library(baguette)
library(vip)
library(pdp)
library(kernlab)
library(earth)
library(rpart.plot)

cret <- read_csv("customer_retention.csv")
cret <- na.omit(cret)

Exploratory Analysis

ggplot(data = cret)+
  geom_bar(aes(x = Partner, fill = Contract), position = "dodge")+
  labs(title = "Count of Partner Status Grouped by Contract Term",
       x = "Partner", y = "Count of Customers")

ggplot(data = cret)+
  geom_bar(aes(x = Partner, fill = Status), position = "fill")+
  labs(title = "Partner Status of Customer by Status with Regork",
       x = "Partner",
       y = "Percentage of Customers")

These first two graphs display partner status grouped by contract term, displaying how customers with partners are more likely to form a longer contract. The second graph emphasizes that customers with partners stay with the company more than customers without partners. The conclusion from these graphs is Regork sees more loyalty from customers with partners at longer contract terms.

cret %>%
  filter(Partner == "Yes") %>%
  ggplot()+
  geom_bar(aes(x = Status, fill = MultipleLines))+
  labs(title = "Customer Status by Amount of Lines Owned",
       subtitle = "Sorted by Customers with Partners Only",
       x = "Status",
       y = "Count of Customers")

cret %>%
  filter(Partner == "Yes") %>%
  ggplot()+
  geom_bar(aes(x = Tenure, fill = MultipleLines), position = "fill")+
  labs(title = "Length of Tenure by Multiple Lines",
       subtitle = "Information is in a percentage based off of customers with a partner",
       x = "Tenure (Months)",
       y = "Percentage of Customers",
       fill = "Multiple Lines")

For Customers with Partners, around half the customers do not share multiple lines. This could be advertised as a way for partners to stay connected for a bundle. Additionally, there are a few hundred customers without phone services at all.

The final graph displays partners Tenure as a percentage of what type of line contract they own. This graph displays a clear trend that as length of Tenure increases, the chance the customer has multiple lines increases as well. With the higher chance of customers getting multiple lines over time, retaining customers for longer is better.

Machine Learning

cret <- mutate(cret, Status = factor(Status))
set.seed(123)
# Random Forest
split <- initial_split(cret, prop = 0.7, strata = Status)
train <- training(split)
test <- testing(split)

model_recipe <- recipe(Status ~ ., data = train)
cret_rf_mod <- rand_forest(mode = "classification") %>%
  set_engine("ranger")

kfold <- vfold_cv(train, v = 5)
results <- fit_resamples(cret_rf_mod, model_recipe, kfold)
collect_metrics(results)
FALSE # A tibble: 2 × 6
FALSE   .metric  .estimator  mean     n std_err .config             
FALSE   <chr>    <chr>      <dbl> <int>   <dbl> <chr>               
FALSE 1 accuracy binary     0.801     5 0.00497 Preprocessor1_Model1
FALSE 2 roc_auc  binary     0.838     5 0.00388 Preprocessor1_Model1

The Auc of the Random Forest model is 0.838, This is the second best performing model of the three.

# Decision Tree Model
split <- initial_split(cret, prop = 0.7, strata = Status)
train <- training(split)
test <- testing(split)
cret_mod <- decision_tree(mode = "classification") %>%
  set_engine("rpart")
dt_mod_recipe <- recipe(Status ~ ., data = train)
dt_fit <- workflow() %>%
  add_recipe(dt_mod_recipe) %>%
  add_model(cret_mod) %>%
  fit(data = cret)
dt_fit
FALSE ══ Workflow [trained] ══════════════════════════════════════════════════════════
FALSE Preprocessor: Recipe
FALSE Model: decision_tree()
FALSE 
FALSE ── Preprocessor ────────────────────────────────────────────────────────────────
FALSE 0 Recipe Steps
FALSE 
FALSE ── Model ───────────────────────────────────────────────────────────────────────
FALSE n= 6988 
FALSE 
FALSE node), split, n, loss, yval, (yprob)
FALSE       * denotes terminal node
FALSE 
FALSE  1) root 6988 1856 Current (0.7344018 0.2655982)  
FALSE    2) Contract=One year,Two year 3141  213 Current (0.9321872 0.0678128) *
FALSE    3) Contract=Month-to-month 3847 1643 Current (0.5729140 0.4270860)  
FALSE      6) InternetService=DSL,No 1736  489 Current (0.7183180 0.2816820) *
FALSE      7) InternetService=Fiber optic 2111  957 Left (0.4533396 0.5466604)  
FALSE       14) Tenure>=15.5 1080  442 Current (0.5907407 0.4092593) *
FALSE       15) Tenure< 15.5 1031  319 Left (0.3094083 0.6905917) *
rpart.plot(dt_fit$fit$fit$fit)

kfold <- vfold_cv(train, v = 5)

results <- fit_resamples(cret_mod, dt_mod_recipe, kfold)

collect_metrics(results)
FALSE # A tibble: 2 × 6
FALSE   .metric  .estimator  mean     n std_err .config             
FALSE   <chr>    <chr>      <dbl> <int>   <dbl> <chr>               
FALSE 1 accuracy binary     0.791     5 0.00755 Preprocessor1_Model1
FALSE 2 roc_auc  binary     0.805     5 0.00527 Preprocessor1_Model1

The Auc of this model comes in at 0.805, slightly lower than the ridge model.

split <- initial_split(cret, prop = 0.7, strata = Status)
train <- training(split)
test <- testing(split)

kfold <- vfold_cv(train, v = 5)
cret_recipe = recipe(Status ~ ., data = train)%>%
  step_dummy(all_nominal_predictors(), one_hot = TRUE)

cret_logit_mod <- logistic_reg(mixture = tune(), penalty = tune()) %>%
  set_engine("glmnet") %>%
  set_mode("classification")

cret_grid <- grid_regular(mixture(), penalty(), levels = 10)

cret_wf <- workflow() %>%
  add_recipe(cret_recipe) %>%
  add_model(cret_logit_mod)

tuning_results <- cret_wf %>%
  tune_grid(resamples = kfold, grid = cret_grid)
autoplot(tuning_results)

collect_metrics(tuning_results) %>%
  filter(.metric == "roc_auc")
FALSE # A tibble: 100 × 8
FALSE          penalty mixture .metric .estimator  mean     n std_err .config         
FALSE            <dbl>   <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>           
FALSE  1 0.0000000001        0 roc_auc binary     0.838     5 0.00653 Preprocessor1_M…
FALSE  2 0.00000000129       0 roc_auc binary     0.838     5 0.00653 Preprocessor1_M…
FALSE  3 0.0000000167        0 roc_auc binary     0.838     5 0.00653 Preprocessor1_M…
FALSE  4 0.000000215         0 roc_auc binary     0.838     5 0.00653 Preprocessor1_M…
FALSE  5 0.00000278          0 roc_auc binary     0.838     5 0.00653 Preprocessor1_M…
FALSE  6 0.0000359           0 roc_auc binary     0.838     5 0.00653 Preprocessor1_M…
FALSE  7 0.000464            0 roc_auc binary     0.838     5 0.00653 Preprocessor1_M…
FALSE  8 0.00599             0 roc_auc binary     0.838     5 0.00653 Preprocessor1_M…
FALSE  9 0.0774              0 roc_auc binary     0.837     5 0.00646 Preprocessor1_M…
FALSE 10 1                   0 roc_auc binary     0.829     5 0.00663 Preprocessor1_M…
FALSE # ℹ 90 more rows
best_hyperparameters <- select_best(tuning_results, metric = "roc_auc")
final_wf <- workflow() %>%
  add_recipe(cret_recipe) %>%
  add_model(cret_logit_mod) %>%
  finalize_workflow(best_hyperparameters)

final_fit <- final_wf %>%
  fit(data = train)

final_fit %>%
  extract_fit_parsnip() %>%
  vip()

The most important feature in this model is the Contract variable, with month to month and two year contracts having the most impact. Additionally, internet service and online security are also important. With an Auc of 0.838, this model is the best performing model along with the random forest model.

Conclusion

The most important predictors in my models were the Contract Term and if the customer had multiple lines, single line, or no lines. The easiest to focus on based on my analysis is the amount of lines the customer has. Only around half of the customers with partners had multiple lines. We can use this to incentivize customers to join together with their partners under one contract. The analysis showed how customers with multiple lines on average stayed longer with the company. By taking this action, we can help secure more long-term contracts with customers.

The earlier graphs displayed how around 25% of the customer basis leaves over time, but those with Partners tend to stay longer, along with getting a multiple line contract, we can try to reduce the number of people leaving. With this, I propose Regork creates a discounted price for groups who upgrade to a multiple line, multi-year contract. This will increase the immediate revenues, and, as long as customer satisfaction is remained, a large majority of these groups will continue their service past the initial contract.

The main limitations of the analysis involves not knowing reasons as to why the customer has left, by only indicating if a customer is a current one or not, there is no information as to why they left. If there is an underlying issue im the company, there is not a clear reason as to why to be found in the data collected. Issuing a survey on customers who left asking for a reason could lead to further insights.