Final Report

Sypnosis

To assist Regork in entering the newly expanded telecommunications market, I aimed to analyze customer retention. This involved visualizing trends within the dataset and training three machine learning models to predict and understand customer behavior and retention patterns. The goal is to use these insights to assist in strategic decisions and optimize customer retention strategies.By doing this, we can help Regork by predicting when current consumers leave based on the data, to assist in preserving current consumers for a longer tenure. We addressed this problem by using logistic regression, decison tree, and random forest models

Packages Required

To produce the results in this project, these packages have to be installed and loaded:

readr: Used to read given CSV file.
tidymodels: Used for data manipulation, splitting data, and building predictive models.
tidyverse: Used for data manipulation and visualization
ggplot2: Used for creating various graphs.
dplyr: Used for data manipulation.
rsample: Used for data splitting.
randomForest: Used for building a Random Forest.
rpart: Used for building a Decision Tree model.
pROC: Used for computing ROC and AUC curves.

library(readr)
library(tidymodels)
library(tidyverse)
library(rsample)
library(ggplot2)
library(dplyr)
library(ranger)
library(randomForest)
library(rpart)
library(pROC)

I also needed to save the dataset within my working directory:

setwd("~/BANA 4080/Final/")
customer_retention <- read_csv("customer_retention.csv")

customer_retention <- customer_retention %>%
  mutate(Status = as.factor(Status))

customer_retention <- customer_retention %>%
  drop_na()

customer_retention %>%
  summarise_all(~ sum(is.na(.)))

## # A tibble: 1 × 20
##   Gender SeniorCitizen Partner Dependents Tenure PhoneService MultipleLines
##    <int>         <int>   <int>      <int>  <int>        <int>         <int>
## 1      0             0       0          0      0            0             0
## # ℹ 13 more variables: InternetService <int>, OnlineSecurity <int>,
## #   OnlineBackup <int>, DeviceProtection <int>, TechSupport <int>,
## #   StreamingTV <int>, StreamingMovies <int>, Contract <int>,
## #   PaperlessBilling <int>, PaymentMethod <int>, MonthlyCharges <int>,
## #   TotalCharges <int>, Status <int>

Exploratory Data Analysis

To start my analysis on Regork, I identified patterns within the data by graphing points, to make the visualization easier:

The first graph above shows current and left members based on preference on payment method.

#Graph 1
ggplot(customer_retention, aes(x = PaymentMethod, fill = Status)) +
  geom_bar(position = "dodge") + 
  labs(title = "Customer Status by Payment Method", x = "Payment Method", y = "Count") +
  scale_fill_manual(values = c("Current" = "darkgreen", "Left" = "red")) +
  theme_minimal() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1),  
        axis.text.y = element_blank(),  
        axis.ticks.y = element_blank(),  
        plot.title = element_text(hjust = 0.5)) +  
  stat_count(aes(label = ..count..), geom = "text", position = position_dodge(width = 0.9), vjust = -0.5) +
  ylim(0, 1750)

The second graph is a box plot showing the amount charged monthly between a Bank Transfer (automatic), Credit Card (automatic), Electronic Check, and Mailed Check

#Graph 2
p <- ggplot(customer_retention, aes(x = PaymentMethod, y = MonthlyCharges, fill = PaymentMethod)) +
  geom_boxplot(alpha = 0.7) + 
  labs(title = "Relationship between Payment Method and Monthly Charges", x = "Payment Method", y = "Monthly Charges") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  
medians <- customer_retention %>%
  group_by(PaymentMethod) %>%
  summarize(median = median(MonthlyCharges))

p + geom_text(data = medians, aes(label = paste("Average:", round(median, 1))), 
              x = seq_along(medians$PaymentMethod), y = medians$median, vjust = -0.5, size = 3)

Finally, I used another box plot graph to show how long customers stayed with Regork based on their Payment Method.

#Graph 3
ggplot(customer_retention, aes(x = PaymentMethod, y = Tenure, fill = PaymentMethod)) +
  geom_boxplot(alpha = 0.7) + 
  labs(title = "Relationship between Tenure and Payment Method", x = "Payment Method", y = "Tenure (Months)") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Machine Learning

First, I looked at a logistic regression model. Although the AUC is good, the accuracy of the model is only .19, due to there being so many false negatives.

# Splitting the Data
set.seed(123)
customer_split <- initial_split(customer_retention, prop = 0.7, strata = "Status")
customer_train <- training(customer_split)
customer_test <- testing(customer_split)

# Logistic Model Fitting
model <- glm(Status ~ ., data = customer_train, family = binomial)

# Making Predictions on Test Data
predicted_probabilities <- predict(model, newdata = customer_test, type = "response")
predicted_classes <- ifelse(predicted_probabilities > 0.5, "Current", "Left")

# Calculating ROC curve and AUC
roc_curve <- roc(customer_test$Status, predicted_probabilities)
auc_value <- auc(roc_curve)

# Creating Confusion Matrix
confusion_matrix <- table(predicted_classes, customer_test$Status)
print(confusion_matrix)

##                  
## predicted_classes Current Left
##           Current     178  332
##           Left       1362  225

# Calculating Accuracy
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
print(paste("Accuracy of Model:", accuracy))

## [1] "Accuracy of Model: 0.192179303767287"

# Printing the AUC value
print(paste("Area Under the Curve (AUC):", round(auc_value, 2)))

## [1] "Area Under the Curve (AUC): 0.84"

Second, I looked at a decision tree model. Compared to the logistic regrssion model, the area of the curve is less than the logistic regression model. However, there are far less false negatives, making the accuracy a lot more reliable. For that, I would prefer the decision tree model

set.seed(123)
customer_split <- initial_split(customer_retention, prop = 0.7, strata = "Status")
customer_train <- training(customer_split)
customer_test <- testing(customer_split)

# Decision Tree Model Fitting
model <- rpart(Status ~ ., data = customer_train, method = "class")

# Making Predictions on Test Data
predicted_probabilities <- predict(model, newdata = customer_test, type = "prob")
predicted_classes <- ifelse(predicted_probabilities[, "Current"] > 0.5, "Current", "Left")

# calculating ROC curve and AUC
roc_curve <- roc(ifelse(customer_test$Status == "Current", 1, 0), predicted_probabilities[, "Current"])
auc_value <- auc(roc_curve)

# Creating Confusion Matrix
confusion_matrix <- table(predicted_classes, customer_test$Status)
print(confusion_matrix)

##                  
## predicted_classes Current Left
##           Current    1398  294
##           Left        142  263

# Calculating Accuracy
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
print(paste("Accuracy of Model:", accuracy))

## [1] "Accuracy of Model: 0.792083929422985"

# Printing the AUC value
print(paste("Area Under the Curve (AUC):", round(auc_value, 2)))

## [1] "Area Under the Curve (AUC): 0.8"

Finally, I looked at a random forest model. Although the accuracy of the model is almost the same as decision tree models, the accuracy is noticably greater. This makes the random forest model the ideal model to check for the most influential variables in the customer retention table.

set.seed(123)
customer_split <- initial_split(customer_retention, prop = 0.7, strata = "Status")
customer_train <- training(customer_split)
customer_test <- testing(customer_split)

# Random Forest Model Fitting
model <- randomForest(Status ~ ., data = customer_train)

#Predictions on Test Data
predicted_probabilities <- predict(model, newdata = customer_test, type = "prob")
predicted_classes <- ifelse(predicted_probabilities[, "Current"] > 0.5, "Current", "Left")

# Calculating ROC curve and AUC
roc_curve <- roc(ifelse(customer_test$Status == "Current", 1, 0), predicted_probabilities[, "Current"])
auc_value <- auc(roc_curve)

# Creating the Confusion Matrix
confusion_matrix <- table(predicted_classes, customer_test$Status)
print(confusion_matrix)

##                  
## predicted_classes Current Left
##           Current    1347  234
##           Left        193  323

# Calculating Accuracy
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
print(paste("Accuracy of Model:", accuracy))

## [1] "Accuracy of Model: 0.796375774916547"

# Printing the AUC value
print(paste("Area Under the Curve (AUC):", round(auc_value, 2)))

## [1] "Area Under the Curve (AUC): 0.83"

importance <- importance(model)
var_importance <- data.frame(Variables = rownames(importance), Importance = importance[, 1]) 

# Order variables by importance (descending)
var_importance <- var_importance[order(-var_importance$Importance), ]

# Displays Important Variables
print("Top 10 Important Variables for Customer Retention Prediction:")

## [1] "Top 10 Important Variables for Customer Retention Prediction:"

print(head(var_importance, 10))

##                       Variables Importance
## TotalCharges       TotalCharges  302.62382
## MonthlyCharges   MonthlyCharges  284.66771
## Tenure                   Tenure  270.94804
## Contract               Contract  155.55876
## OnlineSecurity   OnlineSecurity   88.22806
## PaymentMethod     PaymentMethod   84.91723
## TechSupport         TechSupport   66.80836
## InternetService InternetService   53.41933
## OnlineBackup       OnlineBackup   49.17229
## Gender                   Gender   44.25027

Conclusion

Based on the most accurate model of random forests, the top 5 influential variables include Total Charges, Monthly Charges, Tenure, Contract, and Online Security.

My model reveals that total Charges and Monthly Charges are the most influential variables. This indicates that customers of Regork’s telecommunication services are sensitive to price. While Regork can consider price adjustments, it’s crucial to strike a balance that allows for price increases without significant customer loss, ensuring a positive trade-off.

Tenure was the third most important variable in the model. That means the longer a customer stays with Regrok, the less likely they will leave. Given this, I would target new customers with discounts to increase their chances of having a longer tenure due to positive relations with Regork.

The contract was the fourth most crucial variable. That means customers with extended contracts tend to stay with Regork longer than customers with shorter contracts. I offer discounts for longer contracts, which is cheaper over the long run than buying multiple short contracts.

Finally, Online Security was the fifth most important variable. Customers believe that having privacy when shopping online is essential. Regork must put more resources into security to ensure that these customers will stay longer.

To Summarize, the best way to keep current customers from leaving is to keep price raises for telecommunications at a minimum, especially for newer tenured customers. It would be impossible to say that prices should always be the same or that there should be constant discounts for telecommunications. Although discounts will help, it will be unsustainable. Instead, Regrok should focus on how much the price hike will be for customers whenever they decide.

The table shows monthly and total charges as the most influential variables, meaning that these customers are price-sensitive. However, as I stated, Regrok has to raise prices to maintain profit. They must balance maximizing their profit and minimizing the number of customers leaving due to price raises. Having the telecommunication charges adjust with inflation might solve this. Although prices will always increase, there is a justifiable reason for raising prices in the consumer’s eyes. This also prevents Regork from doing out-of-nowhere price hikes, forcing many consumers to leave.

Limitations

The customer retention set needed some fixing. First, household size is not a factor in the data. The data only lists if the user has a partner and does not mention other family members in the house. This can skew the data because larger-sized households might opt into family deals, which will cost more than smaller households.

Second, an individual’s personal background can be a factor in whether a customer stays or goes. Outside of gender, which is already listed, specific age, race, the town they live in, and income level can be possible factors that were left out of the data.

Finally, the type of property the user has is not listed. Maybe there is a correlation between the square footage of a property owned or the kind of property the user lives in, which can be a factor in whether they stay or leave Regork.