Customer Churn Prediction
WQD7004 Group 1
Group Members
| Name | Matric No. |
|---|---|
| Sim Pei Jin | 22088531 |
| Goh Chia Sing | 23055707 |
| Loh Bi Jia | 23078886 |
| Yuki Sim Tze Yii | 22090924 |
1 Introduction
1.1 Dataset Details:
Dataset Title:
E-commerce Customer Behavior and Purchase Dataset
Purpose of Dataset:
Dataset is intended for analytical use, data scientists and analysts can examine different facets of consumer behavior, examine buying trends, and look into churn rates.
Dimension:
The dataset comprises 250,000 rows and 13 columns.
Content:
It provides a wide range of features, such as payment methods, purchase data, customer names, ages, and genders, among others.
Structure:
The information is arranged in a tabular format, where rows correspond to distinct transactions or exchanges and columns indicate various characteristics or traits linked to each person or transaction.
Summary:
To comprehend the properties and distributions of the dataset, a thorough synopsis of statistical measures like mean, median, standard deviation, and frequency distributions for categorical variables would be helpful. Finding any outliers or missing numbers is also essential for later data cleaning and analysis.
Project Question:
1.Regression : What is the probability that a candidate will churn the e-commerce service after the certain period of time?
2.Classification : Will the customer decides to continue or end the membership of the e-commerce after certain period of time?
Project Objective:
To identify the factors that influence customer churn.
To predict the likehood of customer churn and to identify the most effective model for predicting customer churn.
Libraries
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ ggplot2 3.5.1 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(ggplot2)
library(formattable)
library(fastDummies)## Thank you for using fastDummies!
## To acknowledge our work, please cite the package:
## Kaplan, J. & Schlegel, B. (2023). fastDummies: Fast Creation of Dummy (Binary) Columns and Rows from Categorical Variables. Version 1.7.1. URL: https://github.com/jacobkap/fastDummies, https://jacobkap.github.io/fastDummies/.library(caTools)
library(e1071)
library(class)
library(C50)
library(tree)
library(rpart)
library(MASS)##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:formattable':
##
## area
##
## The following object is masked from 'package:dplyr':
##
## selectlibrary(ROCR)Load dataset
data <- read.csv("/Users/pj/Desktop/WQD 7004 -Programming for Data Science/Group Assignment/ecommerce_customer_data_large.csv")
head(data)## Customer.ID Purchase.Date Product.Category Product.Price Quantity
## 1 44605 2023-05-03 21:30:02 Home 177 1
## 2 44605 2021-05-16 13:57:44 Electronics 174 3
## 3 44605 2020-07-13 06:16:57 Books 413 1
## 4 44605 2023-01-17 13:14:36 Electronics 396 3
## 5 44605 2021-05-01 11:29:27 Books 259 4
## 6 13738 2022-08-25 06:48:33 Home 191 3
## Total.Purchase.Amount Payment.Method Customer.Age Returns Customer.Name Age
## 1 2427 PayPal 31 1 John Rivera 31
## 2 2448 PayPal 31 1 John Rivera 31
## 3 2345 Credit Card 31 1 John Rivera 31
## 4 937 Cash 31 0 John Rivera 31
## 5 2598 PayPal 31 1 John Rivera 31
## 6 3722 Credit Card 27 1 Lauren Johnson 27
## Gender Churn
## 1 Female 0
## 2 Female 0
## 3 Female 0
## 4 Female 0
## 5 Female 0
## 6 Female 0Dimension of the dataset
dim(data)## [1] 250000 13Overall statistic report
summary(data)## Customer.ID Purchase.Date Product.Category Product.Price
## Min. : 1 Length:250000 Length:250000 Min. : 10.0
## 1st Qu.:12590 Class :character Class :character 1st Qu.:132.0
## Median :25011 Mode :character Mode :character Median :255.0
## Mean :25018 Mean :254.7
## 3rd Qu.:37441 3rd Qu.:377.0
## Max. :50000 Max. :500.0
##
## Quantity Total.Purchase.Amount Payment.Method Customer.Age
## Min. :1.000 Min. : 100 Length:250000 Min. :18.0
## 1st Qu.:2.000 1st Qu.:1476 Class :character 1st Qu.:30.0
## Median :3.000 Median :2725 Mode :character Median :44.0
## Mean :3.005 Mean :2725 Mean :43.8
## 3rd Qu.:4.000 3rd Qu.:3975 3rd Qu.:57.0
## Max. :5.000 Max. :5350 Max. :70.0
##
## Returns Customer.Name Age Gender
## Min. :0.0 Length:250000 Min. :18.0 Length:250000
## 1st Qu.:0.0 Class :character 1st Qu.:30.0 Class :character
## Median :1.0 Mode :character Median :44.0 Mode :character
## Mean :0.5 Mean :43.8
## 3rd Qu.:1.0 3rd Qu.:57.0
## Max. :1.0 Max. :70.0
## NA's :47382
## Churn
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.2005
## 3rd Qu.:0.0000
## Max. :1.0000
## str(data)## 'data.frame': 250000 obs. of 13 variables:
## $ Customer.ID : int 44605 44605 44605 44605 44605 13738 13738 13738 13738 13738 ...
## $ Purchase.Date : chr "2023-05-03 21:30:02" "2021-05-16 13:57:44" "2020-07-13 06:16:57" "2023-01-17 13:14:36" ...
## $ Product.Category : chr "Home" "Electronics" "Books" "Electronics" ...
## $ Product.Price : int 177 174 413 396 259 191 205 370 12 40 ...
## $ Quantity : int 1 3 1 3 4 3 1 5 2 4 ...
## $ Total.Purchase.Amount: int 2427 2448 2345 937 2598 3722 2773 1486 2175 4327 ...
## $ Payment.Method : chr "PayPal" "PayPal" "Credit Card" "Cash" ...
## $ Customer.Age : int 31 31 31 31 31 27 27 27 27 27 ...
## $ Returns : num 1 1 1 0 1 1 NA 1 NA 0 ...
## $ Customer.Name : chr "John Rivera" "John Rivera" "John Rivera" "John Rivera" ...
## $ Age : int 31 31 31 31 31 27 27 27 27 27 ...
## $ Gender : chr "Female" "Female" "Female" "Female" ...
## $ Churn : int 0 0 0 0 0 0 0 0 0 0 ...Explore the unique value of each categorical variable
Except for the Purchase.Date and Customer.Name
col_name <- names(data)
categorical_col_names <- names(Filter(is.character,data))
num_col_names <- setdiff(col_name, categorical_col_names)
num_col_names <- num_col_names[!num_col_names %in% 'target']
categorical_data <- data[,c(categorical_col_names)] %>% dplyr::select(-Purchase.Date, -Customer.Name)
unique_value <- function(x){
print("Unique values of categorical variables in the dataset: ")
lapply(x,unique)
}
unique_value(categorical_data)## [1] "Unique values of categorical variables in the dataset: "## $Product.Category
## [1] "Home" "Electronics" "Books" "Clothing"
##
## $Payment.Method
## [1] "PayPal" "Credit Card" "Cash"
##
## $Gender
## [1] "Female" "Male"2 Data Cleaning and Pre-processing
Check for Duplicates
duplicated_rows <- data %>%
filter(duplicated(.) | duplicated(., fromLast = TRUE))
print(duplicated_rows)## [1] Customer.ID Purchase.Date Product.Category
## [4] Product.Price Quantity Total.Purchase.Amount
## [7] Payment.Method Customer.Age Returns
## [10] Customer.Name Age Gender
## [13] Churn
## <0 rows> (or 0-length row.names)are_identical <- identical(data$Customer.Age, data$Age)
if (are_identical) {
print("Customer.Age and Age columns are identical.")
} else {
print("Customer.Age and Age columns are NOT identical.")
}## [1] "Customer.Age and Age columns are identical."No duplicate rows. For columns, Customer Age and Age columns seem to contain identical data, so one should be removed.
data[,c("Customer.Age")] <- list(NULL)
head(data)## Customer.ID Purchase.Date Product.Category Product.Price Quantity
## 1 44605 2023-05-03 21:30:02 Home 177 1
## 2 44605 2021-05-16 13:57:44 Electronics 174 3
## 3 44605 2020-07-13 06:16:57 Books 413 1
## 4 44605 2023-01-17 13:14:36 Electronics 396 3
## 5 44605 2021-05-01 11:29:27 Books 259 4
## 6 13738 2022-08-25 06:48:33 Home 191 3
## Total.Purchase.Amount Payment.Method Returns Customer.Name Age Gender Churn
## 1 2427 PayPal 1 John Rivera 31 Female 0
## 2 2448 PayPal 1 John Rivera 31 Female 0
## 3 2345 Credit Card 1 John Rivera 31 Female 0
## 4 937 Cash 0 John Rivera 31 Female 0
## 5 2598 PayPal 1 John Rivera 31 Female 0
## 6 3722 Credit Card 1 Lauren Johnson 27 Female 0Check for Missing Values
We use sapply to check the number if missing values in each columns.
sapply(data, function(x) sum(is.na(x)))## Customer.ID Purchase.Date Product.Category
## 0 0 0
## Product.Price Quantity Total.Purchase.Amount
## 0 0 0
## Payment.Method Returns Customer.Name
## 0 47382 0
## Age Gender Churn
## 0 0 0We can observe that missing value only occur in Returns column. Find the size of missing value in Returns column.
data %>% count(data$Returns)## data$Returns n
## 1 0 101142
## 2 1 101476
## 3 NA 47382sum(is.na(data$Returns))/nrow(data)## [1] 0.189528The proportion of missing value is extremely large, we choose not to remove the rows as there are significant for analysis. Instead, replace NA with 0 assuming no return of product.
data$Returns<-replace(data$Returns,is.na(data$Returns), 0)Check again if missing values have been processed.
sapply(data, function(x) sum(is.na(x)))## Customer.ID Purchase.Date Product.Category
## 0 0 0
## Product.Price Quantity Total.Purchase.Amount
## 0 0 0
## Payment.Method Returns Customer.Name
## 0 0 0
## Age Gender Churn
## 0 0 0Check for Outliers
colnames(data)## [1] "Customer.ID" "Purchase.Date" "Product.Category"
## [4] "Product.Price" "Quantity" "Total.Purchase.Amount"
## [7] "Payment.Method" "Returns" "Customer.Name"
## [10] "Age" "Gender" "Churn"num_col_names## [1] "Customer.ID" "Product.Price" "Quantity"
## [4] "Total.Purchase.Amount" "Customer.Age" "Returns"
## [7] "Age" "Churn"print(paste('Product.Price',length(data[,][data[,'Product.Price'] %in% boxplot.stats(data[,'Product.Price'])$out])))## [1] "Product.Price 0"print(paste('Quantity',length(data[,][data[,'Quantity'] %in% boxplot.stats(data[,'Quantity'])$out])))## [1] "Quantity 0"print(paste('Total.Purchase.Amount',length(data[,][data[,'Total.Purchase.Amount'] %in% boxplot.stats(data[,'Total.Purchase.Amount'])$out])))## [1] "Total.Purchase.Amount 0"print(paste('Returns',length(data[,][data[,'Returns'] %in% boxplot.stats(data[,'Returns'])$out])))## [1] "Returns 0"print(paste('Age',length(data[,][data[,'Age'] %in% boxplot.stats(data[,'Age'])$out])))## [1] "Age 0"No outliers found in each attribute.
Check for Inconsistency
Re-calculate incorrect Total Purchased Amount column
data$Total.Purchase.Amount = data$Product.Price * data$Quantity
head(data)## Customer.ID Purchase.Date Product.Category Product.Price Quantity
## 1 44605 2023-05-03 21:30:02 Home 177 1
## 2 44605 2021-05-16 13:57:44 Electronics 174 3
## 3 44605 2020-07-13 06:16:57 Books 413 1
## 4 44605 2023-01-17 13:14:36 Electronics 396 3
## 5 44605 2021-05-01 11:29:27 Books 259 4
## 6 13738 2022-08-25 06:48:33 Home 191 3
## Total.Purchase.Amount Payment.Method Returns Customer.Name Age Gender Churn
## 1 177 PayPal 1 John Rivera 31 Female 0
## 2 522 PayPal 1 John Rivera 31 Female 0
## 3 413 Credit Card 1 John Rivera 31 Female 0
## 4 1188 Cash 0 John Rivera 31 Female 0
## 5 1036 PayPal 1 John Rivera 31 Female 0
## 6 573 Credit Card 1 Lauren Johnson 27 Female 0Add Purchase.Year column
library(lubridate)
data$Purchase.Date <- ymd_hms(data$Purchase.Date)
data$Purchase.Year <- year(data$Purchase.Date)
data <- data%>% relocate(Purchase.Year, .before = Product.Category)Split the Purchase.Date column into Purchase.Date and Purchase.Time
split_Purchase.Date <-strsplit(as.character(data$Purchase.Date), " ")
data$Purchase.Date <- sapply(split_Purchase.Date, '[', 1)
data$Purchase.Time <- sapply(split_Purchase.Date, '[', 2)
data <- data %>% relocate(Purchase.Time, .after = Purchase.Date)
head(data)## Customer.ID Purchase.Date Purchase.Time Purchase.Year Product.Category
## 1 44605 2023-05-03 21:30:02 2023 Home
## 2 44605 2021-05-16 13:57:44 2021 Electronics
## 3 44605 2020-07-13 06:16:57 2020 Books
## 4 44605 2023-01-17 13:14:36 2023 Electronics
## 5 44605 2021-05-01 11:29:27 2021 Books
## 6 13738 2022-08-25 06:48:33 2022 Home
## Product.Price Quantity Total.Purchase.Amount Payment.Method Returns
## 1 177 1 177 PayPal 1
## 2 174 3 522 PayPal 1
## 3 413 1 413 Credit Card 1
## 4 396 3 1188 Cash 0
## 5 259 4 1036 PayPal 1
## 6 191 3 573 Credit Card 1
## Customer.Name Age Gender Churn
## 1 John Rivera 31 Female 0
## 2 John Rivera 31 Female 0
## 3 John Rivera 31 Female 0
## 4 John Rivera 31 Female 0
## 5 John Rivera 31 Female 0
## 6 Lauren Johnson 27 Female 0Rearrange the data according to Customer.ID and Purchase.Date
data <- data %>% arrange(Customer.ID, Purchase.Date)
head(data)## Customer.ID Purchase.Date Purchase.Time Purchase.Year Product.Category
## 1 1 2020-03-04 10:26:02 2020 Clothing
## 2 1 2021-04-08 18:33:34 2021 Books
## 3 1 2022-11-29 06:48:25 2022 Electronics
## 4 2 2020-07-31 16:27:41 2020 Electronics
## 5 2 2021-08-30 06:29:32 2021 Clothing
## 6 2 2022-03-14 04:31:25 2022 Home
## Product.Price Quantity Total.Purchase.Amount Payment.Method Returns
## 1 205 5 1025 Cash 0
## 2 456 5 2280 Credit Card 0
## 3 459 5 2295 Credit Card 0
## 4 408 2 816 PayPal 0
## 5 368 2 736 PayPal 1
## 6 376 4 1504 Cash 1
## Customer.Name Age Gender Churn
## 1 Dominic Cline 67 Female 0
## 2 Dominic Cline 67 Female 0
## 3 Dominic Cline 67 Female 0
## 4 Crystal Day 42 Female 0
## 5 Crystal Day 42 Female 0
## 6 Crystal Day 42 Female 0Update churn values to 0 except for the last transaction of each customer
data_updated <- data %>%
group_by(Customer.ID) %>%
mutate(Churn = if_else(Purchase.Date == max(Purchase.Date), Churn, 0)) %>%
ungroup()Update age values accordingly
#Identify the last transaction for each customer
last_transactions <- data_updated %>%
group_by(Customer.ID) %>%
slice_max(order_by = Purchase.Date, n = 1, with_ties = FALSE) %>%
ungroup() %>%
dplyr::select(Customer.ID, Last.Age = Age, Last.Purchase.Year = Purchase.Year)
#Calculate the age of each customer
data_updated2 <- data_updated %>%
left_join(last_transactions, by = "Customer.ID") %>%
mutate(Age = if_else(Purchase.Year == Last.Purchase.Year, Last.Age, Last.Age - (Last.Purchase.Year - Purchase.Year))) %>%
dplyr::select(-Last.Age, -Last.Purchase.Year)Add a new column name add a new column named subscription period, calculate based on first transaction (year)
# Identify the first transaction year for each customer
first_transactions <- data_updated2 %>%
group_by(Customer.ID) %>%
slice_min(order_by = Purchase.Date, n = 1, with_ties = FALSE) %>%
ungroup() %>%
dplyr::select(Customer.ID, First.Purchase.Year = Purchase.Year)
# Calculate Subscription.Period
data_updated3 <- data_updated2 %>%
left_join(first_transactions, by = "Customer.ID") %>%
mutate(Subscription.Period = Purchase.Year - First.Purchase.Year +1) %>%
dplyr::select(-First.Purchase.Year)Checking the udpates and copy to a new name
data_updated3 %>% filter(Customer.ID==26154)## # A tibble: 6 × 15
## Customer.ID Purchase.Date Purchase.Time Purchase.Year Product.Category
## <int> <chr> <chr> <dbl> <chr>
## 1 26154 2020-03-01 19:58:32 2020 Electronics
## 2 26154 2020-08-30 03:26:39 2020 Electronics
## 3 26154 2021-03-29 18:18:56 2021 Home
## 4 26154 2022-02-23 16:21:21 2022 Electronics
## 5 26154 2022-10-05 07:13:25 2022 Clothing
## 6 26154 2023-05-08 15:11:23 2023 Home
## # ℹ 10 more variables: Product.Price <int>, Quantity <int>,
## # Total.Purchase.Amount <int>, Payment.Method <chr>, Returns <dbl>,
## # Customer.Name <chr>, Age <dbl>, Gender <chr>, Churn <dbl>,
## # Subscription.Period <dbl>#Put Subscription.Period right before Churn and save a new copy named "churn"
data_updated4 <- data_updated3%>% relocate(Subscription.Period, .before = Churn)
churn <- data_updated43 Exploratory Data Analysis (EDA)
Correlation between Numeric Variables
library(corrplot)## corrplot 0.92 loadednumeric.var <- sapply(churn, is.numeric)
corr.matrix <- cor(churn[,numeric.var])
corrplot(corr.matrix, main="\n\nCorrelation Plot for Numerical Variables", method="number")
Total purchase amount and product price, subscription period and
purchase year, these two pairs are both highly positively
correlated.
Bar plots of Categorical Variables
#Create an Age Group column
churn <- churn %>%
mutate(Age.Group = cut(Age, breaks = c(0, 18, 25, 35, 45, 55, 65, Inf),
labels = c("0-18", "19-25", "26-35", "36-45", "46-55", "56-65", "65+")))
#Convert Return column to a more descriptive format
churn <- churn %>%
mutate(Returns.Status = ifelse(Returns == 1, "Yes", "No"))
#Plot graphs
p1<-ggplot(churn, aes(x=Gender)) + ggtitle("Gender") + xlab("Gender") +
geom_bar(aes(y = 100*(..count..)/sum(..count..)), width = 0.5) + ylab("Percentage") + coord_flip() + theme_minimal()
p2<-ggplot(churn, aes(x=Product.Category)) + ggtitle("Product Category") + xlab("Product Category") +
geom_bar(aes(y = 100*(..count..)/sum(..count..)), width = 0.5) + ylab("Percentage") + coord_flip() + theme_minimal()
p3<-ggplot(churn, aes(x=Payment.Method)) + ggtitle("Payment Method") + xlab("Payment Method") +
geom_bar(aes(y = 100*(..count..)/sum(..count..)), width = 0.5) + ylab("Percentage") + coord_flip() + theme_minimal()
p4<-ggplot(churn, aes(x=Returns.Status)) + ggtitle("Returns") + xlab("Returns") +
geom_bar(aes(y = 100*(..count..)/sum(..count..)), width = 0.5) + ylab("Percentage") + coord_flip() + theme_minimal()
p5<-ggplot(churn, aes(x=Subscription.Period)) + ggtitle("Subscription Period (year)") + xlab("Subscription Period") +
geom_bar(aes(y = 100*(..count..)/sum(..count..)), width = 0.5) + ylab("Percentage") + coord_flip() + theme_minimal()
p6<-ggplot(churn, aes(x=Age.Group)) + ggtitle("Age Group") + xlab("Age Group") +
geom_bar(aes(y = 100*(..count..)/sum(..count..)), width = 0.5) + ylab("Percentage") + coord_flip() + theme_minimal()
library(gridExtra)##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinegrid.arrange(p1, p2, p3, p4, p5, p6, ncol=2)## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
All of the categorical variables seem to have a reasonably broad
distribution, therefore, all of them will be kept for the further
analysis.
Churn Analysis In this part of our project, we’re addressing the critical issue of customer churn, where customers cease purchasing from our platform. We’re diving into this analysis with the following objectives:
# Convert Churn column to a more descriptive format
library(ggplot2)
churn <- churn %>%
mutate(Churn_Status = ifelse(Churn == 1, "Churned", "Retained"))- Churn rate among customers
ggplot(churn, aes(x = Churn_Status)) +
geom_bar() +
ggtitle("Churn Rate Among Customers") +
xlab("Churn Status") +
ylab("Count") +
theme_minimal()
churn_rate <- (sum(churn$Churn) / length(churn$Churn)) * 100
cat(sprintf("Churn Rate: %.2f%%\n", churn_rate))## Churn Rate: 3.98%It indicates that the 3.98% of customers have stopped purchasing from the platform.
- Factors influencing churn:
- average purchase amount
# Calculate average purchase amount by Churn Status
avg_purchase <- churn %>%
group_by(Churn_Status) %>%
summarise(Average_Purchase_Amount = mean(Total.Purchase.Amount))
ggplot(avg_purchase, aes(x = Churn_Status, y = Average_Purchase_Amount)) +
geom_bar(stat = "identity") +
ggtitle("Average Purchase Amount by Churn Status") +
xlab("Churn Status") +
ylab("Average Purchase Amount") +
theme_minimal()
- frequency of purchases
#add a new column called purchase frequency
churn <- churn %>%
group_by(Customer.ID) %>%
mutate(Purchase.Frequency = row_number())
ggplot(churn, aes(x = Purchase.Frequency, fill = factor(Churn))) +
geom_bar(position = "dodge") +
labs(title = "Purchase Frequency vs. Churn",
x = "Purchase Frequency",
y = "Count",
fill = "Churn Status") +
scale_fill_manual(values = c("coral", "steelblue"), labels = c("Churned", "Retained")) +
theme_minimal()
Customers are likely to churn after few purchases, thus there are less churn cases in loyalty customers.
- Plotting Returns by Churn Status
ggplot(churn, aes(x = Churn_Status, fill = factor(Returns))) +
geom_bar(position = "fill") +
labs(title = "Returns by Churn Status",
x = "Churn Status",
y = "Proportion",
fill = "Returns") +
scale_fill_manual(values = c("coral", "steelblue"), labels = c("No Return", "Returned")) +
theme_minimal()
The return rate seems to be no difference in affecting churn.
- Correlation between churn and demographic factors
# For Age Groups
ggplot(churn, aes(x = Age.Group, fill = Churn_Status)) +
geom_bar(position = "dodge") +
ggtitle("Churn by Age Group") +
xlab("Age Group") +
ylab("Count") +
theme_minimal()
The churn rate for age group 19-65 are higher compared to younger and elder customers group as as age group 19-65 have higher purchase power, so age might be a significant factor for churn prediction.
# For Gender
ggplot(churn, aes(x = Gender, fill = Churn_Status)) +
geom_bar(position = "dodge") +
ggtitle("Churn by Gender") +
xlab("Gender") +
ylab("Count") +
theme_minimal()
The churn rate for female and male make light differences, so there
might be a small impact on churn only. Conclusion: To reduce churn and
retain customers, it’s essential to develop strategies tailored to the
specific characteristics of churned customers.
4 Feature Engineering
Remove certain column might not contributing to churn prediction, save it as “cleandf”.
cleandf <- churn %>% ungroup() %>% dplyr::select(Customer.ID, Purchase.Date, Product.Category, Quantity, Total.Purchase.Amount, Payment.Method, Returns, Age, Gender, Subscription.Period, Purchase.Frequency, Churn)Identify the last transaction for each customer which is comparable and relevant for churn prediction.
last_transactions <- cleandf %>%
group_by(Customer.ID) %>%
slice_max(order_by = Purchase.Date, n = 1, with_ties = FALSE) %>%
ungroup()
head(last_transactions)## # A tibble: 6 × 12
## Customer.ID Purchase.Date Product.Category Quantity Total.Purchase.Amount
## <int> <chr> <chr> <int> <int>
## 1 1 2022-11-29 Electronics 5 2295
## 2 2 2023-07-03 Books 1 190
## 3 3 2023-02-03 Electronics 3 564
## 4 4 2022-06-29 Books 5 95
## 5 5 2022-07-16 Home 4 656
## 6 6 2023-04-26 Clothing 5 1205
## # ℹ 7 more variables: Payment.Method <chr>, Returns <dbl>, Age <dbl>,
## # Gender <chr>, Subscription.Period <dbl>, Purchase.Frequency <int>,
## # Churn <dbl>Convert the categorical variables to dummy value for data analysis facilitating purpose.
last_transactions <- last_transactions %>% dplyr::select(-Customer.ID, -Purchase.Date )
categorical_col_name<-names(Filter(is.character,last_transactions))
data_preprocessed<-dummy_cols(last_transactions,select_columns=categorical_col_name)
data_preprocessed[,c(categorical_col_name)]<-list(NULL)
dim(data_preprocessed)## [1] 49661 16Save the data to csv file.
#write.csv(data_preprocessed, file = "preprocessed_data.csv", row.names = FALSE)5 Modelling
getwd()## [1] "/Users/pj/Desktop/WQD 7004 -Programming for Data Science/Group Assignment/Yuki"data <- read.csv("/Users/pj/Desktop/WQD 7004 -Programming for Data Science/Group Assignment/Yuki/preprocessed_data.csv")
head(data)## Quantity Total.Purchase.Amount Returns Age Subscription.Period
## 1 5 2295 0 67 3
## 2 1 190 1 42 4
## 3 3 564 0 31 4
## 4 5 95 1 37 3
## 5 4 656 0 24 3
## 6 5 1205 1 34 4
## Purchase.Frequency Churn Product.Category_Books Product.Category_Clothing
## 1 3 0 0 0
## 2 6 0 1 0
## 3 4 0 0 0
## 4 5 0 1 0
## 5 5 0 0 0
## 6 9 0 0 1
## Product.Category_Electronics Product.Category_Home Payment.Method_Cash
## 1 1 0 0
## 2 0 0 0
## 3 1 0 1
## 4 0 0 1
## 5 0 1 0
## 6 0 0 0
## Payment.Method_Credit.Card Payment.Method_PayPal Gender_Female Gender_Male
## 1 1 0 1 0
## 2 1 0 1 0
## 3 0 0 0 1
## 4 0 0 0 1
## 5 1 0 1 0
## 6 0 1 1 0class(data)## [1] "data.frame"data22 <-data
preprocessed_data <- data22# Predicting the churn rate of customer
# split training and testing dataset
library(caTools)
library(dplyr)
library(randomForest)## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:gridExtra':
##
## combine## The following object is masked from 'package:ggplot2':
##
## margin## The following object is masked from 'package:dplyr':
##
## combinepreprocessed_data$Churn <- as.factor(preprocessed_data$Churn)
set.seed(1)
sample <-sample.split(preprocessed_data$Churn, SplitRatio = 0.7)
train_data <- subset(preprocessed_data, sample == TRUE)
test_data <- subset(preprocessed_data, sample == FALSE)We will be using a split of training and testing data of ratio 70:30.
# Construct performance table
performance = function(xtab, desc="") {
cat(desc,"\n")
ACR = sum(diag(xtab)) / sum(xtab)
TPR = xtab[1,1] / sum(xtab[,1]); TNR = xtab[2,2] / sum(xtab[,2])
PPV = xtab[1,1] / sum(xtab[1,]); NPV = xtab[2,2] / sum(xtab[2,])
FPR = 1 - TNR; FNR = 1 - TPR
# Calculate F1 score
precision = PPV
recall = TPR
f1_score = 2 * (precision * recall) / (precision + recall)
# Calculate Kappa
RandomAccuracy = (sum(xtab[,2]) * sum(xtab[2,]) + sum(xtab[,1]) * sum(xtab[1,])) / sum(xtab)^2
Kappa = (ACR - RandomAccuracy) / (1 - RandomAccuracy)
# Print confusion matrix and metrics
print(xtab)
cat("\nAccuracy(ACR) :", ACR, "\n")
cat("Sensitivity(TPR) :", TPR, "\n")
cat("Specificity(TNR) :", TNR, "\n")
cat("Positive Predictive Value(PPV) :", PPV, "\n")
cat("Negative Predictive Value (NPV) :", NPV, "\n")
cat("False Positive Rate (FPR): ", FPR, "\n")
cat("False Negative Rate (FNR):", FNR, "\n")
cat("F1 Score: ", f1_score, "\n")
}
prob_gen <- function(x){
print(paste("Predicted probability that a customer will not churn", round (sum(x[2,])/sum(x),4)))
print(paste("Predicted probability that a customer will churn", round(sum(x[1, ])/sum(x), 4)))
}Naive Bayes
library(e1071)
set.seed(107)
naive_model <- naiveBayes(Churn ~., data=train_data)
naive_pred <- predict(naive_model, test_data)
churn_customer = table(naive_pred, test_data$Churn)
churn_customer = churn_customer[2:1, 2:1]
performance(churn_customer)##
##
## naive_pred 1 0
## 1 0 0
## 0 2979 11920
##
## Accuracy(ACR) : 0.8000537
## Sensitivity(TPR) : 0
## Specificity(TNR) : 1
## Positive Predictive Value(PPV) : NaN
## Negative Predictive Value (NPV) : 0.8000537
## False Positive Rate (FPR): 0
## False Negative Rate (FNR): 1
## F1 Score: NaNprob_gen(churn_customer)## [1] "Predicted probability that a customer will not churn 1"
## [1] "Predicted probability that a customer will churn 0"Naïve Bayes theorem is used to build the model to train and test the data. The accuracy rate from the confusion matrix is 80%; for the positive classes, the Naïve Bayes model shows precision (PPV) of NaN as there are no customer being predicted as churned. The recall rate is 0% as well, and from the confusion matrix we can see that when the actual customer has churned, the model does not predict it incorrectly.There is no false negative and type II error occurrence = 0. The confusion matrix also shows that the model is unable to detect the customers who churned.
On the other hand, the negative predictive value (NPV) is 80% and the specificity rate is 100%. This suggests that the abiilty of this model to detect all customers who does not churn but the rate of correct prediction is 80% as 20% of them are predicted as will churn. A huge difference between the false positive rate and false negative rate is possiblydue to the fact that we have more customers who do not churn that who churn in the population dataset.
For the probability rate predicted using the Naïve Bayes method, the probability of customers who does not churn (100%) is higher than customers who churn (0%).
Build Naïve Bayes Model with Laplace Smoothing
set.seed(107)
naive_model_laplace <- naiveBayes(Churn ~., data=train_data, laplace=1)
naive_pred_laplace <- predict(naive_model_laplace,test_data,type="class")
churn_customer_laplace=table(naive_pred_laplace,test_data$Churn)
churn_customer_laplace = churn_customer_laplace[2:1,2:1]
performance(churn_customer_laplace)##
##
## naive_pred_laplace 1 0
## 1 0 0
## 0 2979 11920
##
## Accuracy(ACR) : 0.8000537
## Sensitivity(TPR) : 0
## Specificity(TNR) : 1
## Positive Predictive Value(PPV) : NaN
## Negative Predictive Value (NPV) : 0.8000537
## False Positive Rate (FPR): 0
## False Negative Rate (FNR): 1
## F1 Score: NaNprob_gen(churn_customer_laplace)## [1] "Predicted probability that a customer will not churn 1"
## [1] "Predicted probability that a customer will churn 0"We constructed the Naïve Bayes model wth Laplace Smoothing to avoid zero probability results that might casue errors in the final prediction of churning of customers for Naïve Bayes Classification. However, the results show no changes in the accuracy and evaluation metrics of our prediction model. It signals that our Naïve Bayes model may not have any zero probabilities that affect the prediction of our Naïve Bayes model without Laplace Smoothing.
For the probability rate predicted using the Naïve Bayes Laplace Smoothing method, the probability of customers who does not churn (100%) is higher than customers who churn (0%).
Random forest
set.seed(107)
train_RF <- train_data
train_RF[,c('target')] <- list(NULL)
set.seed(2)
RF_model <- randomForest(x=train_RF, y=train_data$Churn,mtry=3,importance = TRUE)
RF_pred<-predict(RF_model,test_data, type="class")
churn_customer_RF = table(RF_pred,test_data$Churn)
churn_customer_RF = churn_customer_RF[2:1,2:1]
performance(churn_customer_RF,"\n*** Random Forest (RF) Strategy (m=3) Performance")##
## *** Random Forest (RF) Strategy (m=3) Performance
##
## RF_pred 1 0
## 1 2979 0
## 0 0 11920
##
## Accuracy(ACR) : 1
## Sensitivity(TPR) : 1
## Specificity(TNR) : 1
## Positive Predictive Value(PPV) : 1
## Negative Predictive Value (NPV) : 1
## False Positive Rate (FPR): 0
## False Negative Rate (FNR): 0
## F1 Score: 1prob_gen(churn_customer_RF)## [1] "Predicted probability that a customer will not churn 0.8001"
## [1] "Predicted probability that a customer will churn 0.1999"print(head(importance(RF_model),10))## 0 1 MeanDecreaseAccuracy
## Quantity 6.5160677 1.5342191 6.5215954
## Total.Purchase.Amount 6.4241716 2.5149931 6.7734421
## Returns -0.1997753 0.3414952 0.2028659
## Age 0.1834531 -3.2202504 -2.4313877
## Subscription.Period 10.1429917 3.3248218 8.8500786
## Purchase.Frequency 9.1107042 4.5786050 8.9246395
## Churn 230.7640007 234.3353531 232.4413089
## Product.Category_Books -1.1723195 -2.5021118 -2.6139109
## Product.Category_Clothing -1.8344375 -1.4151175 -1.8878897
## Product.Category_Electronics -0.9875627 -0.9847175 -1.2613277
## MeanDecreaseGini
## Quantity 21.573296
## Total.Purchase.Amount 85.247983
## Returns 9.573654
## Age 60.950119
## Subscription.Period 17.640895
## Purchase.Frequency 38.332291
## Churn 10141.638734
## Product.Category_Books 5.584718
## Product.Category_Clothing 5.644233
## Product.Category_Electronics 5.445948Setting mtry = 3, the confusion matrix of our Random Forest model shows an accuracy rate of 100%. The sensitivity, specificity, PPV, NPV rate are all 100%. This shows that using the Random Forest model, the churning decision of the customers can be accurately predicted by the model. There are no type I and type II error when using this model.
For the probability rate predicted using Random Forest model, the probability of customers who does not churn (80.01%) is higher than customers who churn (19.99%).
Decision Tree
#install.packages("rpart")
library(rpart)
set.seed(107)
DT_model<-rpart(Churn~., train_data)
DT_pred<-predict(DT_model,test_data,type="class")
churn_customer_DT=table(DT_pred,test_data$Churn)
churn_customer_DT = churn_customer_DT[2:1,2:1]
performance(churn_customer_DT)##
##
## DT_pred 1 0
## 1 0 0
## 0 2979 11920
##
## Accuracy(ACR) : 0.8000537
## Sensitivity(TPR) : 0
## Specificity(TNR) : 1
## Positive Predictive Value(PPV) : NaN
## Negative Predictive Value (NPV) : 0.8000537
## False Positive Rate (FPR): 0
## False Negative Rate (FNR): 1
## F1 Score: NaNprob_gen(churn_customer_DT)## [1] "Predicted probability that a customer will not churn 1"
## [1] "Predicted probability that a customer will churn 0"Using the decision tree, the confusion matrix shows an accuracy of 80% in predicting the actual rate of churning of customers. The sensitivity is 0% and it means that among the all true churning customers, the model cannot predict any of them. There is a high type II error of false negatives as the model predicted customers do not churn but they have actually churned.The PPV shows not applicable as the number of predicted churn is zero.
For the probability rate predicted using the decision tree, the probability of customers who does not churn is 100% and customers who churn is 0%.
SVM
#install.packages("e1071")
library(e1071)
set.seed(107)
SVM_model = svm(Churn ~., data=train_data, kernel='radial', scale=F)
summary(SVM_model)##
## Call:
## svm(formula = Churn ~ ., data = train_data, kernel = "radial", scale = F)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: radial
## cost: 1
##
## Number of Support Vectors: 27591
##
## ( 20641 6950 )
##
##
## Number of Classes: 2
##
## Levels:
## 0 1SVM_pred = predict(SVM_model, newdata = test_data)
churn_customer_svm = table(SVM_pred, test_data$Churn)
churn_customer_svm = churn_customer_svm[2:1,2:1]
performance(churn_customer_svm, "SVM Model")## SVM Model
##
## SVM_pred 1 0
## 1 17 70
## 0 2962 11850
##
## Accuracy(ACR) : 0.7964964
## Sensitivity(TPR) : 0.005706613
## Specificity(TNR) : 0.9941275
## Positive Predictive Value(PPV) : 0.1954023
## Negative Predictive Value (NPV) : 0.800027
## False Positive Rate (FPR): 0.005872483
## False Negative Rate (FNR): 0.9942934
## F1 Score: 0.01108937prob_gen(churn_customer_svm)## [1] "Predicted probability that a customer will not churn 0.9942"
## [1] "Predicted probability that a customer will churn 0.0058"From the confusion matrix, we can see that the SVM model has an accuracy rate of 79.46%. The sensitivity and PPV is much lower than the specificity and NPV, with values of 0.57%, 19.54%, 99.41% and 80%, respectively. This suggests that the SVM model is able to predict customers who does not churn more accurately: 99.41% of customers who does not churn are predicted and among them, 80% are predicted correctly. On the other hand, for customers who churn, there are only 19.54% being predicted and among those customers, 0.57% were predicted correctly. This yields a high false negative rate (Type II error).
For the probability rate predicted using the SVM, the probability of customers who does not churn (99.42%) is higher than customers who churn (0.58%).
LDA Model
library(MASS)
library(dplyr)
set.seed(123)
LDA_model = lda(Churn ~., data = train_data)## Warning in lda.default(x, grouping, ...): variables are collinearsummary(LDA_model)## Length Class Mode
## prior 2 -none- numeric
## counts 2 -none- numeric
## means 30 -none- numeric
## scaling 15 -none- numeric
## lev 2 -none- character
## svd 1 -none- numeric
## N 1 -none- numeric
## call 3 -none- call
## terms 3 terms call
## xlevels 0 -none- listhead(coef(LDA_model), 10)## LD1
## Quantity -0.2953591943
## Total.Purchase.Amount 0.0009218544
## Returns -0.7445590840
## Age -0.0111247383
## Subscription.Period 0.3584098305
## Purchase.Frequency -0.0283720416
## Product.Category_Books 0.4291805692
## Product.Category_Clothing 0.3319053826
## Product.Category_Electronics -0.2443841051
## Product.Category_Home -0.5051320617plot(LDA_model) 
LDA_pred = LDA_model %>% predict(test_data)
mean(LDA_pred$class == test_data$Churn)## [1] 0.8000537LDA = test_data$Churn
mean(LDA_pred$class == LDA)## [1] 0.8000537churn_customer_LDA = table(LDA_pred$class,LDA)
churn_customer_LDA = churn_customer_LDA[2:1,2:1]
performance(churn_customer_LDA, "LDA")## LDA
## LDA
## 1 0
## 1 0 0
## 0 2979 11920
##
## Accuracy(ACR) : 0.8000537
## Sensitivity(TPR) : 0
## Specificity(TNR) : 1
## Positive Predictive Value(PPV) : NaN
## Negative Predictive Value (NPV) : 0.8000537
## False Positive Rate (FPR): 0
## False Negative Rate (FNR): 1
## F1 Score: NaNprob_gen(churn_customer_LDA) ## [1] "Predicted probability that a customer will not churn 1"
## [1] "Predicted probability that a customer will churn 0"Linear Discriminant Analysis (LDA) is one of the “parametric” and generative models on the dataset, it assumes the predictors are numeric and are drawn from multivariate gaussian/normal distribution. We include all attributes to train the LDA model. From the confusion matrix, the results show that the performance of LDA model is not operating well for predicting churn of customers as similar to the decision tree model. This might be attributable to our dataset that consists of more customers who do not churn than customers who churn, which signals that there is no normal distribution in our dataset. By assuming 1 is customer who churns and 0 as customer who do not churns, the accuracy for the prediction is computed to be 80%. The sensitivityis 0% and it means that among the all true churning customers, the model cannot predict any of them. There is a high type II error of false negatives as the model predicted customers do not churn but they have actually churned.The PPV shows not applicable as the number of predicted churn is zero.
For the probability rate predicted using the LDA, the probability of customers who does not churn is 100% and customers who churn is 0%.
Logistic Regression Model
library(dplyr)
set.seed(123)
log_model <- glm(Churn~., data = train_data, family = binomial)
head(summary(log_model)$coef)## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.369430e+00 7.647609e-02 -17.9066403 1.046656e-71
## Quantity -1.411111e-02 1.196153e-02 -1.1797083 2.381162e-01
## Total.Purchase.Amount 4.383707e-05 2.850476e-05 1.5378860 1.240765e-01
## Returns -3.541432e-02 2.737676e-02 -1.2935908 1.958068e-01
## Age -5.279286e-04 8.719517e-04 -0.6054562 5.448759e-01
## Subscription.Period 1.707186e-02 1.761733e-02 0.9690381 3.325262e-01# summary statistics of logistic regression model
logreg_prob<-log_model %>% predict(test_data, type="response")
head(logreg_prob)## 4 6 8 18 20 22
## 0.1920905 0.2042491 0.2002092 0.2112590 0.2151602 0.2012264# Table of probability of each customer churning or not
hist(logreg_prob)
contrasts(test_data$Churn)## 1
## 0 0
## 1 1logreg_pred <- ifelse(logreg_prob >0.2, 1, 0)
churn_customer_LR1 = table(logreg_pred,test_data$Churn)
churn_customer_LR1 = churn_customer_LR1[2:1,2:1]
performance(churn_customer_LR1)##
##
## logreg_pred 1 0
## 1 1512 5943
## 0 1467 5977
##
## Accuracy(ACR) : 0.5026512
## Sensitivity(TPR) : 0.5075529
## Specificity(TNR) : 0.5014262
## Positive Predictive Value(PPV) : 0.2028169
## Negative Predictive Value (NPV) : 0.8029285
## False Positive Rate (FPR): 0.4985738
## False Negative Rate (FNR): 0.4924471
## F1 Score: 0.2898217prob_gen(churn_customer_LR1)## [1] "Predicted probability that a customer will not churn 0.4996"
## [1] "Predicted probability that a customer will churn 0.5004"From the above result, there is a 50.27% accuracy with cut-off point = 0.2. The LR model shows that the sensitivity and specificity is 50.76% and 50.14%, respectively. This suggests that the logistic model is able to predict customers who actualy churned at a rate of 50.76% and those who actually does not churn at a rate of 50.14%. For the PPV and NPV of 20.28% and 80.29% respectively, the results suggest that among the predicted churned customers, only 20.8% are true, while 80.29% of those predicted as not going to churn are true. It has a around 49% rate of false positive and false negative.
For the probability rate predicted using the logistic regression, the probability of customers who does not churn (49.96%) is lower than customers who churn (50.04%).
KNN Model
# we use k=186 and k=187 for our KNN model
library(class)
set.seed(107)
knn186_model <- knn(train_data, test_data, cl = train_data$Churn, k=floor(sqrt(nrow(train_data))))
knn187_model <- knn(train_data, test_data, cl = train_data$Churn, k=ceiling(sqrt(nrow(train_data))))
churn_customer_186=table(knn186_model,test_data$Churn)
churn_customer_186=churn_customer_186[2:1,2:1]
performance(churn_customer_186)##
##
## knn186_model 1 0
## 1 0 0
## 0 2979 11920
##
## Accuracy(ACR) : 0.8000537
## Sensitivity(TPR) : 0
## Specificity(TNR) : 1
## Positive Predictive Value(PPV) : NaN
## Negative Predictive Value (NPV) : 0.8000537
## False Positive Rate (FPR): 0
## False Negative Rate (FNR): 1
## F1 Score: NaNprob_gen(churn_customer_186)## [1] "Predicted probability that a customer will not churn 1"
## [1] "Predicted probability that a customer will churn 0"churn_customer_187=table(knn187_model,test_data$Churn)
churn_customer_187 = churn_customer_187[2:1,2:1]
performance(churn_customer_187)##
##
## knn187_model 1 0
## 1 0 0
## 0 2979 11920
##
## Accuracy(ACR) : 0.8000537
## Sensitivity(TPR) : 0
## Specificity(TNR) : 1
## Positive Predictive Value(PPV) : NaN
## Negative Predictive Value (NPV) : 0.8000537
## False Positive Rate (FPR): 0
## False Negative Rate (FNR): 1
## F1 Score: NaNprob_gen(churn_customer_187)## [1] "Predicted probability that a customer will not churn 1"
## [1] "Predicted probability that a customer will churn 0"Comparing the results of using k=186 and k=187, the accuracy rate for the knn model with k = 186 and k =187 has the same accuracy rate of 80%. For the probability rate predicted using the KNN method of k = 186 and k = 187, the probability of customers who does not churn is 100% and the probability for customers who churn is 0%.
6 Discussions and Conclusion
# Install and load the pander package
# Create the data
Model <- c("Naïve Bayes theorem", "Naïve Bayes Model with Laplace Smoothing",
"Random Forest", "Desicion Tree", "SVM", "Linear Discriminant Analysis (LDA)",
"Logistic Regression Model", "KNN model, k=186", "KNN model, k=187")
Accuracy_ACR <- c(0.8000537, 0.8000537, 1, 0.8000537,
0.7964964, 0.8000537, 0.5026512,
0.8000537, 0.8000537)
Sensitivity_TPR <- c(0, 0, 1, 0, 0.005706613, 0, 0.5075529,
0, 0)
Specificity_TNR <- c(1, 1, 1, 1, 0.9941275, 1, 0.5014262, 1,
1)
Positive_Predictive_Value_PPV <- c(NaN, NaN, 1, NaN,
0.1954023, NaN,
0.2028169, NaN, NaN)
Negative_Predictive_Value_NPV <- c(0.8000537, 0.8000537, 1,
0.8000537, 0.800027,
0.8000537, 0.8029285,
0.8000537, 0.8000537)
False_Positive_Rate_FPR <- c(0, 0, 0, 0, 0.005872483, 0,
0.4985738, 0, 0)
False_Negative_Rate_FNR <- c(1, 1, 0, 1, 0.9942934, 1,
0.4924471, 1, 1)
F1_Score <- c(NaN, NaN, 1, NaN, 0.01108937, NaN, 0.2898217,
NaN, NaN)
churn <- c(0, 0, 0.1999, 0, 0.0058, 0, 0.5004, 0, 0)
not_churn <- c(1, 1, 0.8001, 1, 0.9942, 1, 0.4996,
1, 1)
dataframe <- data.frame(Model, Accuracy_ACR,
Sensitivity_TPR, Specificity_TNR,
Positive_Predictive_Value_PPV,
Negative_Predictive_Value_NPV,
False_Positive_Rate_FPR,
False_Negative_Rate_FNR, F1_Score,
churn, not_churn)
# Print the table
print(dataframe)## Model Accuracy_ACR Sensitivity_TPR
## 1 Naïve Bayes theorem 0.8000537 0.000000000
## 2 Naïve Bayes Model with Laplace Smoothing 0.8000537 0.000000000
## 3 Random Forest 1.0000000 1.000000000
## 4 Desicion Tree 0.8000537 0.000000000
## 5 SVM 0.7964964 0.005706613
## 6 Linear Discriminant Analysis (LDA) 0.8000537 0.000000000
## 7 Logistic Regression Model 0.5026512 0.507552900
## 8 KNN model, k=186 0.8000537 0.000000000
## 9 KNN model, k=187 0.8000537 0.000000000
## Specificity_TNR Positive_Predictive_Value_PPV Negative_Predictive_Value_NPV
## 1 1.0000000 NaN 0.8000537
## 2 1.0000000 NaN 0.8000537
## 3 1.0000000 1.0000000 1.0000000
## 4 1.0000000 NaN 0.8000537
## 5 0.9941275 0.1954023 0.8000270
## 6 1.0000000 NaN 0.8000537
## 7 0.5014262 0.2028169 0.8029285
## 8 1.0000000 NaN 0.8000537
## 9 1.0000000 NaN 0.8000537
## False_Positive_Rate_FPR False_Negative_Rate_FNR F1_Score churn not_churn
## 1 0.000000000 1.0000000 NaN 0.0000 1.0000
## 2 0.000000000 1.0000000 NaN 0.0000 1.0000
## 3 0.000000000 0.0000000 1.00000000 0.1999 0.8001
## 4 0.000000000 1.0000000 NaN 0.0000 1.0000
## 5 0.005872483 0.9942934 0.01108937 0.0058 0.9942
## 6 0.000000000 1.0000000 NaN 0.0000 1.0000
## 7 0.498573800 0.4924471 0.28982170 0.5004 0.4996
## 8 0.000000000 1.0000000 NaN 0.0000 1.0000
## 9 0.000000000 1.0000000 NaN 0.0000 1.0000From the model comparison table as shown above, we have achieved 100% accuracy for Random Forest while the Logistic Regression Model shows the worst performance with only 50.27% accuracy. Meanwhile, Naïve Bayes theorem (with and without Laplace Smoothing), Decision Tree, Linear Discriminant Analysis (LDA) and KNN model(k=186 and k=187) show the same results with 80.01% accuracy. SVM shows an average performance with 79.65% accuracy.
This could be because Random Forest is an ensemble learning technique that combines several decision trees to create a very adaptable model that can identify complex connections in the data. However, Logistic Regression is a more simple linear model that predicts a linear relationship between the target variable and the features. Non-linear correlation in the data can be easily captured by models such as Random Forest, Decision Trees, and k-Nearest Neighbors (KNN). Their core adaptability help us to adjust to complex decisions boundaries. On the other hand, without the clear introduction of feature transformations or interactions, linear models such as Logistic Regression may find it difficult to capture non-linear correlations.
The improvement for futher analysis of this project is to balanced the dataset. We missed working through one step in our project that would have balanced the dataset. Due to the imbalance in the dataset, which results from a large number of churns compared to non-churns, the model’s performance is affected. Since some models are more sensitive to class imbalances, dataset may need to be weighted differently or resampled in order to reduce the imbalance, especially for logistic regression, linear discriminant analysis (LDA), support vector machines (SVM), and k-nearest neighbors (KNN) before the performance test is conducted.
Customer churn prediction is important nowadays across several industries. Organisations may use predictive analytics and machine learning models to estimate loss of consumers and produce more suitable marketing plans to lower the customer turnover rates. Moreover, churn prediction algorithms provide insightful data on consumer behavior, enabling companies to modify products to better serve client demands. Therefore, organisations can promote long-term growth while maintaining a competitive advantage in today’s changing industry with accurate churn prediction.
In conclusion, based on our project, factors influence customer churn includes Quantity, Total.Purchase.Amount, Returns, Age, Subscription.Period, Purchase.Frequency, Churn, Product.Category_Books, Product.Category_Clothing and Product.Category_Electronics. The model with the highest performance for customer churn prediction is the Random Forest Model.