WQD7004_Group5

Sales Performance Analysis

Group: Group 5

Name	Matric No
Lee Jih Shian	17126198
Melanie Ng Huei Yee	17072752
Chong Jia En	23059042
Duan Xuanrui	22099265
Khai Yao Wong	S2179520

Introduction

In today’s highly competitive business environment, understanding customer behavior and accurately predicting sales are crucial for making informed strategic decisions. Businesses are increasingly leveraging data analytics to gain insights into their customers’ purchasing patterns and forecast future sales trends. This project aims to harness the power of data science and machine learning to enhance business intelligence through sales prediction and customer segmentation.

Objectives

1. To develop predictive models to forecast future sales, enabling better inventory management, production planning, and marketing campaign design.

2. To develop segmentation model to segment customers into distinct groups, facilitating targeted marketing efforts and personalized customer service.

3. To compare and evaluate the performance of different models in predicting sales and customer segmentation.

Data Mining Goals

1. Analyze past marketing campaigns to learn what strategies have been most effective in attracting new customers. Data mining can help refine these strategies to improve the efficiency of future campaigns.

2. Through effective data mining, customers can be divided into different levels based on purchase history, behavior, etc. Companies can develop marketing strategies. To meet the needs and preferences of each group and improve customer satisfaction and loyalty.

3. Data mining focuses on ranking and segmentation of customers, helping to identify high-value customers who are likely to respond positively to promotions and offers to prevent customer churn.

CRISP-DM

1. Business Understanding:
   • Challenge:
     • Businesses face the challenge of accurately forecasting sales and understanding customer preferences in this dynamic market conditions.
   • Objective:
     • This project aims to utilise data analytics and machine learning to enhance business intelligence through sales prediction and customer segmentation.
   • Goals:
     • Sales Prediction: Develop models to forecast future sales trends, enabling proactive decision-making in resource allocation and operational planning.
     • Customer Segmentation: Utilize data science techniques to segment customers based on purchasing behavior, facilitating targeted marketing strategies and personalized customer engagement.
   • Importance:
     • By utilized the power of data science, businesses can gain valuable insights into customer preferences, optimize sales strategies, and stay competitive in the market landscape.
2. Data Understanding:
   • Data Acquisition: Gather sales data from relevant sources, identifying key variables and records.
   • Exploratory Data Analysis (EDA): Analyze variable distributions, detect outliers, and understand relationships between variables.
3. Data Preparation:
   • Handling Missing Values: Address missing data, correct inconsistencies, and encode categorical variables for analysis.
   • Data Transformation: Clean and transform sales data to prepare it for modeling and analysis.
4. Modelling: Several classification machine learning models will be train to:
   • Sales Prediction - Multiple Linear Regression, Decision Tree, Support Vector Machine (SVM), Gradient Boosting
   • Customer Segmentation - Decision Tree, SVM, K-Nearest Neighbors (KNN)
5. Evaluation : Evaluation metrics used to determine the performance of each models will be based on
   • Sales Prediction: R2, MAPE, RMSE, MAE
   • Customer Segmentation: Accuracy, Kappa, Sensitivity, Specificity
6. Deployment: Final model suggested to be implemented for sales prediction and marketing reference tools
   • Sales Prediction Tool: Implement real-time sales predicting model to support proactive decision-making.
   • Marketing Reference Tool: Develop a tool to prioritize high-value customers and customize marketing approaches based on their characteristics and behaviors.

Data Understanding

The sample sales dataset obtained from Kaggle https://www.kaggle.com/datasets/kyanyoga/sample-sales-data

Data contains purchase information of a fictional store named Steel Wheels. Each record refers to a specific product that was sold to a customer in a specific order.

Sales Dataset

Variable	Explaination
ORDERNUMBER	Unique ID for each order made by a customer
QUANTITYORDERED	Quantity of the product item included in the considered order specified by ORDERNUMBER
PRICEEACH	Price of product item
ORDERLINENUMBER	Line number of the product in each order number
SALES	Total price of the product item included in the considered order
ORDERDATE	Date of the order
STATUS	Order status of the purchase
QTR_ID	Quarter of the product purchased
MONTH_ID	Month of the product purchased
YEAR_ID	Year of product purchased
PRODUCTLINE	Type of product
MSRP	Manufacturer’s Suggested Retail Price
PRODUCTCODE	Product code of the product item
CUSTOMERNAME	Name of the customer of the considered order
PHONE	Contact number of customer
ADDRESSLINE1	Address details of customer
ADDRESSLINE2	Address details of customer
CITY	Address details of customer
STATE	Address details of customer
POSTALCODE	Address details of customer
COUNTRY	Address details of customer
TERRITORY	Address details of customer
CONTACTLASTNAME	Contact person details of customer
CONTACTFIRSTNAME	Contact person details of customer
DEALSIZE	Magnitude of business transactions

sales <- read.csv("/Users/zhikiat/sales_data_sample.csv", header = T, stringsAsFactors = T)

# Structure of dataframe
str(sales)

## 'data.frame':    2823 obs. of  25 variables:
##  $ ORDERNUMBER     : int  10107 10121 10134 10145 10159 10168 10180 10188 10201 10211 ...
##  $ QUANTITYORDERED : int  30 34 41 45 49 36 29 48 22 41 ...
##  $ PRICEEACH       : num  95.7 81.3 94.7 83.3 100 ...
##  $ ORDERLINENUMBER : int  2 5 2 6 14 1 9 1 2 14 ...
##  $ SALES           : num  2871 2766 3884 3747 5205 ...
##  $ ORDERDATE       : Factor w/ 252 levels "1/10/2003 0:00",..: 113 186 205 227 24 40 49 57 83 5 ...
##  $ STATUS          : Factor w/ 6 levels "Cancelled","Disputed",..: 6 6 6 6 6 6 6 6 6 6 ...
##  $ QTR_ID          : int  1 2 3 3 4 4 4 4 4 1 ...
##  $ MONTH_ID        : int  2 5 7 8 10 10 11 11 12 1 ...
##  $ YEAR_ID         : int  2003 2003 2003 2003 2003 2003 2003 2003 2003 2004 ...
##  $ PRODUCTLINE     : Factor w/ 7 levels "Classic Cars",..: 2 2 2 2 2 2 2 2 2 2 ...
##  $ MSRP            : int  95 95 95 95 95 95 95 95 95 95 ...
##  $ PRODUCTCODE     : Factor w/ 109 levels "S10_1678","S10_1949",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ CUSTOMERNAME    : Factor w/ 92 levels "Alpha Cognac",..: 47 68 48 87 24 81 27 42 58 9 ...
##  $ PHONE           : Factor w/ 91 levels "(02) 5554 67",..: 49 55 17 77 78 80 41 22 79 4 ...
##  $ ADDRESSLINE1    : Factor w/ 92 levels "?kergatan 24",..: 59 42 23 56 53 60 9 69 39 19 ...
##  $ ADDRESSLINE2    : Factor w/ 10 levels "","2nd Floor",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ CITY            : Factor w/ 73 levels "Aaarhus","Allentown",..: 49 57 53 54 60 13 29 5 60 53 ...
##  $ STATE           : Factor w/ 17 levels "","BC","CA","CT",..: 11 1 1 3 3 3 1 1 3 1 ...
##  $ POSTALCODE      : Factor w/ 74 levels "","10022","10100",..: 2 29 43 51 1 56 33 66 1 42 ...
##  $ COUNTRY         : Factor w/ 19 levels "Australia","Austria",..: 19 7 7 19 19 19 7 12 19 7 ...
##  $ TERRITORY       : Factor w/ 3 levels "APAC","EMEA",..: NA 2 2 NA NA NA 2 2 NA 2 ...
##  $ CONTACTLASTNAME : Factor w/ 77 levels "Accorti","Ashworth",..: 77 29 18 76 9 31 58 53 49 54 ...
##  $ CONTACTFIRSTNAME: Factor w/ 72 levels "Adrian","Akiko",..: 37 55 12 32 32 33 44 66 32 15 ...
##  $ DEALSIZE        : Factor w/ 3 levels "Large","Medium",..: 3 3 2 2 2 2 3 2 3 2 ...

# Get the data types of each column
column_types <- sapply(sales, class)
# Display column names and data types side by side
column_info <- data.frame(
  Column_Name = names(column_types),
  Data_Type = as.character(column_types),
  stringsAsFactors = FALSE
)

# Count how many columns for each data type
data_type_counts <- table(column_info$Data_Type)
print(data_type_counts)

## 
##  factor integer numeric 
##      16       7       2

From the above summary we could observe that:

1. There are 2823 observations and 25 variables in the dataset.
2. Among the dataset, there are 16 factor, 7 integer and 2 numeric variables.

RFM Table Dataset

The dataset consists of customer transaction information used to perform RFM (Recency, Frequency, Monetary) analysis.

Variable	Explaination
CUSTOMERNAME	Identifier for each customer.
ORDERNUMBER	Unique identifier for each order.
ORDERDATE	Date when the order was placed.
SALES	Total sales amount for each order.
Recency	Number of days since the customer’s last purchase.
Frequency	Total number of orders placed by the customer.
Monetary_value	Total amount of money spent by the customer.
r_quartile	Quartile ranking for Recency, where 4 is most recent.
f_quartile	Quartile ranking for Frequency, where 4 is most frequent.
m_quartile	Quartile ranking for Monetary_value, where 4 is highest spending.
RFM_Score	Sum of r_quartile, f_quartile, and m_quartile.
RFM_Value	Customer segment based on RFM_Score (High, Mid, Low Value).

RFM <- read.csv("/Users/zhikiat/RFM_table.csv", header = T, stringsAsFactors = T)

# Structure of dataframe
str(RFM)

## 'data.frame':    86 obs. of  10 variables:
##  $ X             : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ CUSTOMERNAME  : Factor w/ 86 levels "Alpha Cognac",..: 1 2 3 4 5 6 9 7 8 10 ...
##  $ Recency       : int  64 264 83 187 22 118 179 232 54 195 ...
##  $ Frequency     : int  20 26 46 7 23 15 8 18 27 51 ...
##  $ Monetary_value: num  70488 94117 153996 24180 64591 ...
##  $ r_quartile    : int  4 1 3 2 4 3 3 1 4 2 ...
##  $ f_quartile    : int  2 2 4 1 2 1 1 1 3 4 ...
##  $ m_quartile    : int  2 3 4 1 1 1 1 1 3 4 ...
##  $ RFM_Score     : int  5 9 10 5 4 4 4 6 7 11 ...
##  $ RFM_Value     : Factor w/ 3 levels "High Value Customer",..: 2 3 1 2 2 2 2 3 3 1 ...

# Get the data types of each column
column_types <- sapply(RFM, class)
# Display column names and data types side by side
column_info <- data.frame(
  Column_Name = names(column_types),
  Data_Type = as.character(column_types),
  stringsAsFactors = FALSE
)

# Count how many columns for each data type
data_type_counts <- table(column_info$Data_Type)
print(data_type_counts)

## 
##  factor integer numeric 
##       2       7       1

From the above summary we could observe that:

1. There are 86 observations and 10 variables in the dataset.
2. Among the dataset, there are 2 factor, 7 integer and 1 numeric variables.

Data Cleaning

library(vcd)
library(ggplot2)
library(reshape2)
library(dplyr)
library(tidyverse)
library(viridis)
library(corrplot)
library(scales)
library(plotly)
options(scipen = 999)

Step 1: Checking for missing value / droppping irrelevant columns

# Identify if there is missing value in the dataframe (general)
paste0("The total number of rows with missing values(s): ", sum(complete.cases(sales)))

## [1] "The total number of rows with missing values(s): 1749"

# Convert empty string as NA values
sales[sales == ""] <- NA

# Check for missing / empty values by column
missing_values_summary <- function(sales) {
  missing_counts <- colSums(is.na(sales))
  total_rows <- nrow(sales)

  #  Calculate % of missing / empty values
  missing_percentage <- round((missing_counts / total_rows) * 100, 4)

  # Create a summary of missing / empty values
  summary_sales <- data.frame(
    Column_Name = names(missing_counts),
    Missing_Count = missing_counts,
    Missing_Percentage = paste0(missing_percentage, "%")
  )

  print(summary_sales)
}

missing_values_summary(sales)

##                       Column_Name Missing_Count Missing_Percentage
## ORDERNUMBER           ORDERNUMBER             0                 0%
## QUANTITYORDERED   QUANTITYORDERED             0                 0%
## PRICEEACH               PRICEEACH             0                 0%
## ORDERLINENUMBER   ORDERLINENUMBER             0                 0%
## SALES                       SALES             0                 0%
## ORDERDATE               ORDERDATE             0                 0%
## STATUS                     STATUS             0                 0%
## QTR_ID                     QTR_ID             0                 0%
## MONTH_ID                 MONTH_ID             0                 0%
## YEAR_ID                   YEAR_ID             0                 0%
## PRODUCTLINE           PRODUCTLINE             0                 0%
## MSRP                         MSRP             0                 0%
## PRODUCTCODE           PRODUCTCODE             0                 0%
## CUSTOMERNAME         CUSTOMERNAME             0                 0%
## PHONE                       PHONE             0                 0%
## ADDRESSLINE1         ADDRESSLINE1             0                 0%
## ADDRESSLINE2         ADDRESSLINE2          2521           89.3022%
## CITY                         CITY             0                 0%
## STATE                       STATE          1486            52.639%
## POSTALCODE             POSTALCODE            76            2.6922%
## COUNTRY                   COUNTRY             0                 0%
## TERRITORY               TERRITORY          1074           38.0446%
## CONTACTLASTNAME   CONTACTLASTNAME             0                 0%
## CONTACTFIRSTNAME CONTACTFIRSTNAME             0                 0%
## DEALSIZE                 DEALSIZE             0                 0%

# Drop irrelevant columns
## Dropping identifiers (PII)
df1 <- sales[, !(names(sales) %in% c('PHONE','ADDRESSLINE1','ADDRESSLINE2','STATE','POSTALCODE','TERRITORY','PRODUCTCODE','CONTACTFIRSTNAME','CONTACTLASTNAME','ORDERLINENUMBER'
))]

# Check for missing / empty values after filling missing / empty / null values
missing_values_summary(df1)

##                     Column_Name Missing_Count Missing_Percentage
## ORDERNUMBER         ORDERNUMBER             0                 0%
## QUANTITYORDERED QUANTITYORDERED             0                 0%
## PRICEEACH             PRICEEACH             0                 0%
## SALES                     SALES             0                 0%
## ORDERDATE             ORDERDATE             0                 0%
## STATUS                   STATUS             0                 0%
## QTR_ID                   QTR_ID             0                 0%
## MONTH_ID               MONTH_ID             0                 0%
## YEAR_ID                 YEAR_ID             0                 0%
## PRODUCTLINE         PRODUCTLINE             0                 0%
## MSRP                       MSRP             0                 0%
## CUSTOMERNAME       CUSTOMERNAME             0                 0%
## CITY                       CITY             0                 0%
## COUNTRY                 COUNTRY             0                 0%
## DEALSIZE               DEALSIZE             0                 0%

Step 2: Convert order date to date time format

# Convert order date to date time format in R programming
df1$ORDERDATE <- mdy_hm(df1$ORDERDATE)
invalid_dates <- df1$ORDERDATE[is.na(df1$ORDERDATE)]

Step 3: Mutate PRICEEACH field

## Priceeach field does not seem to be accurate if the value is 100, replace the column values by dividing sales by quantityordered
df1$PRICEEACH <- df1$SALES / df1$QUANTITYORDERED

Step 4: Creating RFM table

# RFM part
sales_data <- df1

# Select relevant columns
rfm_data <- sales_data[, c('CUSTOMERNAME', 'ORDERNUMBER', 'ORDERDATE', 'SALES')]

# Calculate Recency, Frequency, and Monetary Value
NOW <- max(as.Date(rfm_data$ORDERDATE))  # Most recent date
RFM_table <- rfm_data %>%
  group_by(CUSTOMERNAME) %>%
  summarize(
    Recency = as.numeric(difftime(NOW, max(as.Date(ORDERDATE)), units = "days")),
    Frequency = n(),
    Monetary_value = sum(SALES)
  )

# Dividing into segments
RFM_table <- RFM_table %>%
  mutate(
    r_quartile = cut(Recency, breaks = quantile(Recency, probs = 0:4/4), labels = c(4:1)),
    f_quartile = cut(Frequency, breaks = quantile(Frequency, probs = 0:4/4), labels = c(1:4)),
    m_quartile = cut(Monetary_value, breaks = quantile(Monetary_value, probs = 0:4/4), labels = c(1:4))
  )

# Calculate RFM Score
RFM_table <- RFM_table %>%
  mutate(
    RFM_Score = as.numeric(r_quartile) + as.numeric(f_quartile) + as.numeric(m_quartile)
  )

# Assign RFM Value to Customers
RFM_table <- RFM_table %>%
  mutate(
    RFM_Value = case_when(
      RFM_Score >= 10 ~ 'High Value Customer',
      RFM_Score < 10 & RFM_Score >= 6 ~ 'Mid Value Customer',
      TRUE ~ 'Low Value Customer'
    )
  )

# Filtered for non-NA RFM_Score
RFM_table <- RFM_table %>%
  filter(!is.na(RFM_Score))

# Calculate Q1 (25th percentile) and Q3 (75th percentile)
Q1 <- quantile(RFM_table$Monetary_value, 0.25)
Q3 <- quantile(RFM_table$Monetary_value, 0.75)

# Calculate Interquartile Range (IQR)
IQR <- Q3 - Q1

# Define lower and upper bounds for outliers
lower_bound <- Q1 - 1.5 * IQR
upper_bound <- Q3 + 1.5 * IQR

# Filter the RFM_table to exclude outliers
RFM_table <- RFM_table %>%
  filter(Monetary_value >= lower_bound & Monetary_value <= upper_bound)

# Remove corresponding records in df1
df1 <- df1 %>%
  filter(CUSTOMERNAME %in% RFM_table$CUSTOMERNAME)
str(df1)

## 'data.frame':    2225 obs. of  15 variables:
##  $ ORDERNUMBER    : int  10107 10121 10134 10145 10159 10168 10180 10188 10201 10211 ...
##  $ QUANTITYORDERED: int  30 34 41 45 49 36 29 48 22 41 ...
##  $ PRICEEACH      : num  95.7 81.4 94.7 83.3 106.2 ...
##  $ SALES          : num  2871 2766 3884 3747 5205 ...
##  $ ORDERDATE      : POSIXct, format: "2003-02-24" "2003-05-07" ...
##  $ STATUS         : Factor w/ 6 levels "Cancelled","Disputed",..: 6 6 6 6 6 6 6 6 6 6 ...
##  $ QTR_ID         : int  1 2 3 3 4 4 4 4 4 1 ...
##  $ MONTH_ID       : int  2 5 7 8 10 10 11 11 12 1 ...
##  $ YEAR_ID        : int  2003 2003 2003 2003 2003 2003 2003 2003 2003 2004 ...
##  $ PRODUCTLINE    : Factor w/ 7 levels "Classic Cars",..: 2 2 2 2 2 2 2 2 2 2 ...
##  $ MSRP           : int  95 95 95 95 95 95 95 95 95 95 ...
##  $ CUSTOMERNAME   : Factor w/ 92 levels "Alpha Cognac",..: 47 68 48 87 24 81 27 42 58 9 ...
##  $ CITY           : Factor w/ 73 levels "Aaarhus","Allentown",..: 49 57 53 54 60 13 29 5 60 53 ...
##  $ COUNTRY        : Factor w/ 19 levels "Australia","Austria",..: 19 7 7 19 19 19 7 12 19 7 ...
##  $ DEALSIZE       : Factor w/ 3 levels "Large","Medium",..: 3 3 2 2 2 2 3 2 3 2 ...

Exploratory Data Analysis

Univariate Analysis

### Plotting Distribution for All Quantitative Variables
# Line charts
quantitative_variable <- c('QUANTITYORDERED', 'PRICEEACH', 'SALES', 'MSRP')
par(mfrow = c(2, 2))
for (i in 1:length(quantitative_variable)) {
  density_values <- density(sales_data[[quantitative_variable[i]]])
  plot(density_values, main = quantitative_variable[i], xlab = "", ylab = "Density", col = viridis(4)[i], lwd = 3)
}

par(mfrow = c(1, 1))

• QUANTITYORDERED: we can see value between 30 to 50 has most order frequency.
• PRICEEACH : value at 60-70 having the highest density and gradually decrease until 250
• SALES : value at 2500 having the highest density and gradually decrease until 10000
• MSRP : 60 and 100 having the highest density, and regulary decrease every 25 until 175.

# Boxplots
quantitative_variable <- c('QUANTITYORDERED', 'PRICEEACH', 'SALES', 'MSRP')
par(mfrow = c(2, 2))
for (i in 1:length(quantitative_variable)) {
  boxplot(sales_data[[quantitative_variable[i]]], main = quantitative_variable[i], col = viridis(4)[i])
}

par(mfrow = c(1, 1))

• QUANTITYORDERED: having median of 35 and there are plenty of outliers after 65.
• PRICEEACH : having median of 100 and there are huge amount of outliers after 220.
• SALES : having median of 2500 and there are huge amount of outliers after 8000.
• MSRP : having median of 100 and there is only one outliers after 200.

# Frequency distribution of status
status <- table(df1$STATUS) / nrow(df1)  # Calculate relative frequencies
pie(status,
    main = "Pie Chart for Status of Orders",
    labels = paste(names(status), ": ", round(status * 100, 1), "%", sep = ""),
    col = viridis_pal()(length(status)),  # Use rainbow colors
    cex = 0.8,  # Adjust label size
)

• We can see from the pie chart, there are 94.1% of orders being shipped, other status is around 0.9% to 1.8%.

# Checking for time frame of the data
df1 %>% group_by(YEAR_ID) %>% summarise(num_unique_months = n_distinct(MONTH_ID))

## # A tibble: 3 × 2
##   YEAR_ID num_unique_months
##     <int>             <int>
## 1    2003                12
## 2    2004                12
## 3    2005                 5

#Year Frequency
yearly_orders <- df1 %>%
  group_by(YEAR_ID) %>%
  summarise(count = n())

# Create the bar chart
ggplot(yearly_orders, aes(x = YEAR_ID, y = count)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = count), vjust = -0.3, color = "black", size = 3.5) +
  labs(title = "Number of Orders by Year",
       x = "Year",
       y = "Frequency") +
  theme_minimal() +
  scale_y_continuous(labels = scales::comma)

• Year 2004 has the highest orders in total, given that 2005’s data is incomplete with only 5 months.

#Quarter Frequency
quarterly_orders <- df1 %>%
  group_by(YEAR_ID, QTR_ID) %>%
  summarise(count = n(), .groups = "drop") %>%
  ungroup()

qtr_names <- c("QTR 1", "QTR 2", "QTR 3", "QTR 4")

quarterly_orders$QTR_NAME <- qtr_names[quarterly_orders$QTR_ID]

# Create the bar chart
ggplot(quarterly_orders, aes(x = QTR_NAME, y = count, fill = as.factor(YEAR_ID))) +
  geom_bar(stat = "identity", position = position_dodge()) +
    geom_text(aes(label = count),
            position = position_dodge(width = 0.9),
            vjust = -0.5,
            size = 3.5) +
  labs(x = "Quarter", y = "Frequency", title = "Number of Orders by Quarter") +
  scale_fill_viridis_d(name = "Year") +
  theme_minimal() +
  scale_y_continuous(labels = comma) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

• Quarter 1 to 3 of 2004 show increasing trend from previous year, while quarter 4 orders in 2004 slightly declined. The orders of first two quarters in 2005 decreases in year on year basis as well.

#Month Frequency
monthly_orders <- df1 %>%
  group_by(YEAR_ID, MONTH_ID) %>%
  summarise(count = n(), .groups = "drop") %>%
  ungroup()

# Create a vector with month names
month_names <- c("January", "February", "March", "April", "May", "June",
                 "July", "August", "September", "October", "November", "December")

# Map MONTH_ID to month names for plotting
monthly_orders$MONTH_NAME <- factor(month_names[monthly_orders$MONTH_ID], levels = month_names)

# Create the bar chart
ggplot(monthly_orders, aes(x = MONTH_NAME, y = count, fill = as.factor(YEAR_ID))) +
  geom_bar(stat = "identity", position = position_dodge()) +
    geom_text(aes(label = count),
            position = position_dodge(width = 0.9),
            vjust = -0.5,
            size = 3.5) +
  labs(x = "Month", y = "Frequency", title = "Number of Orders by Month") +
  scale_fill_viridis_d(name = "Year") +
  theme_minimal() +
  scale_y_continuous(labels = comma) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

• Checking on monthly orders, we can observe that 2025 orders actually improves for each month (Jan - May) except for February. June 2003 shows the lowest order amount while November 2003 and 2004 shows the highest order amount.

# Get the hour for each sale timestamp
df1$dayofweek <- weekdays(df1$ORDERDATE)
day_order <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
df1$dayofweek <- factor(df1$dayofweek, levels = day_order)
par(mfrow = c(1, 1))
par(mar = c(5, 5, 4, 4))
barplot(table(df1$dayofweek),
        main = "Count of Orders by Day of Week",
        xlab = "Day of Week",
        ylab = "Number of Orders",
        col = viridis(length(unique(df1$dayofweek))),
        ylim = c(0, 700),
        las = 2)
par(mfrow = c(1, 1))
grid(nx = 0, ny = 10, col = "black", lty = "dotted")

• Most sales happen on Wednesday, closely followed by Friday. So if the retailer is going to advertise effectively to increase the likelihood of more sales, they should advertise more on between Tuesday and Friday when they have more customer traffic.

## EDA for RFM Table (boxplots)
quantitative_variable2 <- c('Recency', 'Frequency', 'Monetary_value')
par(mfrow = c(2, 2))
for (i in 1:length(quantitative_variable2)) {
    boxplot(RFM_table[[quantitative_variable2[i]]], main = quantitative_variable2[i], col = viridis(3)[i])
}
par(mfrow = c(1, 1))

• From recency, we can know that the customers will order or engage again around 200 days. Total number of transactions would be around 25 and the value of the transactions will be around 100k.

Bivariate Analysis

Sales Table Bivariate Analysis

## SCATTER PLOTS
# 2 continuous variable
# QUANTITYORDERED & SALES
ggplot(df1, aes(x = QUANTITYORDERED, y = SALES)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x) +
  ggtitle("QUANTITYORDERED vs SALES") +
  xlab("QUANTITYORDERED") +
  ylab("SALES")

• Data points spread away and scattered hence weaker relationship is observed. Confidence interval appeared narrow, the trendline suggests that as the quantity ordered increases, the sales amount tends to increase as well.

# PRICEEACH & SALES
ggplot(df1, aes(x = PRICEEACH, y = SALES)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x) +
  ggtitle("PRICEEACH vs SALES") +
  xlab("PRICEEACH") +
  ylab("SALES")

• Data points focused at the middle of the graph, confidence interval is not observed. As the price of each item increases, sales also tend to increase.

# MSRP & SALES
ggplot(df1, aes(x = MSRP, y = SALES)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ x) +
  ggtitle("MSRP vs SALES") +
  xlab("MSRP") +
  ylab("SALES")

• Data points scattered throughout the graph, a few outliers can be observed. The positive trend suggests that as the MSRP increases, the sales figures also tend to increase, implying that higher-priced items might be selling well.

## BARPLOTS

# Productline Sales
par(mar = c(10, 12, 4, 2))
sales_per_city <- aggregate(SALES ~ PRODUCTLINE, data = df1, FUN = "sum")
sales_per_city <- sales_per_city[order(-sales_per_city$SALES), ]
top_cities <- head(sales_per_city, 10)
par(mfrow = c(1, 1), mar = c(9, 9, 4, 2), las = 2)
par(mgp = c(8, 1, 0))
max_sales <- max(top_cities$SALES)
barplot(rev(top_cities$SALES),
        names.arg = rev(top_cities$PRODUCTLINE),
        horiz = TRUE,
        col = viridis(10),
        main = "Productline Sales",
        xlab = "Total Sales",
        ylab = "Product",
        xlim = c(0, max_sales * 1.1))

• Classic cars, vintage cars and motorcycles are the top 3 products with most sales, which classic cars having almost double of vintage cars’ sales.

# Country Sales
par(mar = c(5, 10, 4, 2))
sales_per_country <- aggregate(SALES ~ COUNTRY, data = df1, FUN = sum)
sales_per_country <- sales_per_country[order(-sales_per_country$SALES), ]
top_countries <- head(sales_per_country, 10)
par(mfrow = c(1, 1), mar = c(5, 10, 4, 2), las = 2)
barplot(rev(top_countries$SALES),
        names.arg = rev(top_countries$COUNTRY),
        horiz = TRUE,
        col = viridis(10),
        main = "Top 10 Countries with Most Sales",
        xlab = "Total Sales",
        ylab = "Country")

• USA, France and UK are the top 3 countries with most sales.

# City Sales
par(mar = c(5, 10, 4, 2))
sales_per_city <- aggregate(SALES ~ CITY, data = df1, FUN = sum)
sales_per_city <- sales_per_city[order(-sales_per_city$SALES), ]
top_cities <- head(sales_per_city, 10)
par(mfrow = c(1, 1), mar = c(5, 10, 4, 2), las = 2)
barplot(rev(top_cities$SALES),
        names.arg = rev(top_cities$CITY),
        horiz = TRUE,
        col = viridis(10),
        main = "Top 10 Cities with Most Sales",
        xlab = "Total Sales",
        ylab = "City")

• NYC, Singapore and Paris are the top 3 cities with most sales.

# DEALSIZE & SALES
par(mar = c(5, 4, 4, 2))
ggplot(df1, aes(x = DEALSIZE, y = SALES, fill = DEALSIZE)) +
  geom_bar(stat ="identity") +
  labs(title = "Deal Size vs Sales", x = "Deal Size" , y = "Sales")

• Majority of the sales are contributed by “Medium” dealsize.

#FORMATTING
qtr_labels <- c("Q1","Q2","Q3","Q4")
df1$QTR_ID <- factor(df1$QTR_ID, labels = qtr_labels)

month_labels <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
df1$MONTH_ID <- factor(df1$MONTH_ID, labels = month_labels)

year_labels <- c("2003","2004","2005")
df1$YEAR_ID <- factor(df1$YEAR_ID, labels = year_labels)

# QTR & SALES
ggplot(df1, aes(x = as.factor(QTR_ID) , y = SALES, fill = QTR_ID)) +
  geom_bar(stat ="identity") +
  labs(title = "Plot of Sales per Quarter", x = "Quarter" , y = "Sales")

# Quarterly Revenue
quarterly_revenue <- df1 %>%
  group_by(YEAR_ID, QTR_ID) %>%
  summarise(total_sales = sum(SALES), .groups = "drop") %>%
  ungroup()
ggplot(quarterly_revenue, aes(x = QTR_ID, y = total_sales, color = as.factor(YEAR_ID), group = YEAR_ID)) +
  geom_line(linewidth = 1.2) +
  labs(x = "Quarter", y = "Sales", title = "Quarterly Revenue") +
  scale_color_viridis_d() +
  theme_minimal() +
  scale_y_continuous(labels = scales::comma_format())

• Quarter 4 contribute most sales throughout 3 years. The sales figures could go higher if data in 2005 is included.

# MONTH & SALES
ggplot(df1, aes(x = MONTH_ID, y = SALES, fill = MONTH_ID)) +
  geom_bar(stat ="identity") +  theme_minimal() +
  labs(title = "Plot of Sales per Month", x = "Month" , y = "Sales")

• November is the month that the store hit highest sales, there is significant sales drop after May and November.

# Monthly Revenue
monthly_revenue <- df1 %>%
  group_by(YEAR_ID, MONTH_ID) %>%
  summarise(total_sales = sum(SALES), .groups = 'drop')
ggplot(monthly_revenue, aes(x = MONTH_ID, y = total_sales, color = as.factor(YEAR_ID),group = YEAR_ID)) +
  geom_line(size = 1.2) +
  labs(x = "Month", y = "Sales", title = "Monthly Revenue") +
  scale_color_viridis_d() +
  theme_minimal() +
  scale_y_continuous(labels = scales::comma_format())

• The data shows that for both 2003 and 2004 sales peaked around November, this might be due to seasonal promotion around that time(Thanksgiving, Christmas, Black Friday, et al).
• We dont have enough data for 2005 but the available data shows the average sales had increased compared to first few months in 2003 and 2004.

# YEAR & SALES
ggplot(df1, aes(x = YEAR_ID, y = SALES, fill = YEAR_ID)) +
  geom_bar(stat ="identity") +  theme_minimal() +
  labs(title = "Plot of Sales per Year", x = "Year" , y = "Sales")

• 2004 achieved the highest sales for period of 3 years. Heads up, 2005 only included 5 months of sales data.

RFM Table Bivariate Analysis

# Barchart
RFM_table$RFM_Value <- factor(RFM_table$RFM_Value, levels = c("Low Value Customer","Mid Value Customer","High Value Customer"))

# Calculate average Recency, average Frequency, average Monetary Value for each group
RFM_AVG <- RFM_table %>%
  group_by(RFM_Value) %>%  # Group by the value column (high, medium, low)
  summarize(avg_Recency = mean(Recency),avg_Frequency = mean(Frequency),avg_Monetary = mean(Monetary_value))

DF_RFM<-data.frame(RFM_AVG)

print(DF_RFM)

##             RFM_Value avg_Recency avg_Frequency avg_Monetary
## 1  Low Value Customer     94.4000      17.20000     59731.72
## 2  Mid Value Customer    212.0877      24.96491     88809.85
## 3 High Value Customer    196.0714      38.85714    137096.62

# RECENCY VS RFM VALUE
ggplot(DF_RFM, aes(x = RFM_Value, y = avg_Recency, fill = RFM_Value)) +
  geom_bar(stat ="identity") +
  labs(title = "Average Recency vs RFM Value", x = "RFM Value" , y = "Recency")

# FREQUENCY VS RFM VALUE
ggplot(DF_RFM, aes(x = RFM_Value, y = avg_Frequency, fill = RFM_Value)) +
  geom_bar(stat ="identity") +
  labs(title = "Average Frequency vs RFM Value", x = "RFM Value" , y = "Frequency")

# Monetary VALUE VS RFM VALUE
ggplot(DF_RFM, aes(x = RFM_Value, y = avg_Monetary, fill = RFM_Value)) +
  geom_bar(stat ="identity") +
  labs(title = "Average Monetary Value vs RFM Value", x = "RFM Value" , y = "Monetary Value")

# R QUARTILE VS RFM VALUE
RFM_table$r_quartile <- factor(RFM_table$r_quartile, levels = c("1", "2", "3", "4"))
ggplot(RFM_table, aes(x = r_quartile , y = "Count" , fill = RFM_Value)) +
  geom_bar(stat ="identity") +
  labs(title = "R_Quartile vs RFM Value", x = "R Quartile" , y = "RFM Value")

# F QUARTILE VS RFM VALUE
RFM_table$f_quartile <- factor(RFM_table$f_quartile, levels = c("1", "2", "3", "4"))
ggplot(RFM_table, aes(x = f_quartile , y = "Count" , fill = RFM_Value)) +
  geom_bar(stat ="identity") +
  labs(title = "F_Quartile vs RFM Value", x = "F Quartile" , y = "RFM Value")

# M QUARTILE VS RFM VALUE
RFM_table$m_quartile <- factor(RFM_table$m_quartile, levels = c("1", "2", "3", "4"))
ggplot(RFM_table, aes(x = m_quartile , y = "Count" , fill = RFM_Value)) +
  geom_bar(stat ="identity") +
  labs(title = "M_Quartile vs RFM Value", x = "M Quartile" , y = "RFM Value")

• Customers who have recently made a purchase tend to have a higher customer value.
• Customers who have made high amount of purchases tend to have a higher customer value.
• Customers who have spend more tend to have a higher customer value.

# 3D scatter plot
plot_ly(data = RFM_table, 
        x = ~Recency, 
        y = ~Monetary_value, 
        z = ~Frequency, 
        color = ~RFM_Value, 
        type = 'scatter3d', 
        mode = 'markers') %>%
  layout(title = '3D Scatter Plot of RFM Table',
         scene = list(
           xaxis = list(title = 'Recency'),
           yaxis = list(title = 'Monetary Value'),
           zaxis = list(title = 'Frequency')
         ))

• Most customers have low recency, moderate purchase frequency and monetary value.
• A smaller group of data points at the edge suggests that there are a few customers who have high purchase frequency and high monetary value.

Multivariate Analysis

Sales Table Multivariate Analysis

# Select numeric columns and calculate correlation matrix
numeric_columns <- df1 %>%
  select_if(is.numeric)

correlation_matrix <- cor(numeric_columns, use = "complete.obs")

melted_corr_matrix <- melt(correlation_matrix)

# Create the numeric heatmap
heatmap_plot <- ggplot(data = melted_corr_matrix, aes(x = Var1, y = Var2, fill = value)) +
  geom_tile(color = "white") +
  geom_text(aes(label = round(value, 2)), size = 3) +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white",
                       midpoint = 0, limit = c(-1, 1), space = "Lab",
                       name = "Correlation") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1,
                                   size = 12, hjust = 1)) +
  coord_fixed() +
  ggtitle("Correlation Heatmap for Numeric Variables") +
  theme(plot.title = element_text(hjust = 0.5))

# Print heatmap plot
print(heatmap_plot)

• High correlations are observed between PRICEEACH, SALES, and MSRP. This indicates that the price per unit and MSRP significantly impact sales.
• QUANTITYORDERED has a moderate correlation with SALES, suggesting that higher quantities ordered contribute to increased sales but not as strongly as the price per unit.
• ORDERNUMBER does not show significant correlations with any other variables, indicating that it does not play a major role in the relationships between the other variables.

# Select categorical columns and calculate Cramér's V matrix
categorical_columns <- df1 %>%
  select_if(is.factor)

cramers_v <- function(x, y) {
  tbl <- table(x, y)
  chisq <- chisq.test(tbl)
  n <- sum(tbl)
  phi2 <- chisq$statistic / n
  k <- min(dim(tbl)) - 1
  v <- sqrt(phi2 / k)
  return(v)
}

categorical_vars <- colnames(categorical_columns)
n <- length(categorical_vars)
cramers_v_matrix <- matrix(0, n, n, dimnames = list(categorical_vars, categorical_vars))

for (i in 1:n) {
  for (j in i:n) {
    if (i == j) {
      cramers_v_matrix[i, j] <- 1
    } else {
      cramers_v_matrix[i, j] <- cramers_v(categorical_columns[[i]], categorical_columns[[j]])
      cramers_v_matrix[j, i] <- cramers_v_matrix[i, j]
    }
  }
}

cramers_v_df <- as.data.frame(as.table(cramers_v_matrix))

# Create the categorical heatmap
categorical_heatmap_plot <- ggplot(data = cramers_v_df, aes(Var1, Var2, fill = Freq)) +
  geom_tile(color = "white") +
  geom_text(aes(label = round(Freq, 2)), size = 3) +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white",
                       midpoint = 0.5, limit = c(0, 1), space = "Lab",
                       name = "Cramer's V") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, size = 12, hjust = 1)) +
  coord_fixed() +
  ggtitle("Cramér's V Heatmap for Categorical Variables") +
  theme(plot.title = element_text(hjust = 0.5))

# Print categorical heatmap plot
print(categorical_heatmap_plot)

• Time-related variables (QTR_ID, MONTH_ID, YEAR_ID) show strong associations among themselves and with STATUS.
• Geographical variables (COUNTRY, CITY) have a moderate association with each other, which is expected.
• Day of the week and deal size variables generally show weak associations with other variables, indicating that these factors do not have strong relationships with other categorical variables in this dataset.

# Calculate correlations with SALES for numeric variables
correlation_with_sales <- cor(numeric_columns, use = "complete.obs")[, "SALES"]

# Convert to data frame for plotting
correlation_with_sales_df <- data.frame(Variable = names(correlation_with_sales), Correlation = correlation_with_sales)
correlation_with_sales_df <- correlation_with_sales_df %>% filter(Variable != "SALES")

# Create bar chart for numeric correlations
bar_chart_plot <- ggplot(data = correlation_with_sales_df, aes(x = reorder(Variable, Correlation), y = Correlation)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  ggtitle("Correlation with SALES for Numeric Variables") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5)) +
  xlab("Variable") +
  ylab("Correlation")

# Print bar chart plot
print(bar_chart_plot)

• In summary, pricing variables (PRICEEACH and MSRP) are the most influential on sales, followed by the quantity ordered, while the order number has negligible impact.

RFM Table Multivariate Analysis

# Select numeric columns and calculate correlation matrix
numeric_columns <- RFM_table %>%
  select_if(is.numeric)

correlation_matrix <- cor(numeric_columns, use = "complete.obs")

# Melt the correlation matrix for visualization
melted_corr_matrix <- melt(correlation_matrix)

# Create the heatmap using ggplot2
heatmap_plot <- ggplot(data = melted_corr_matrix, aes(x = Var1, y = Var2, fill = value)) +
  geom_tile(color = "white") +
  geom_text(aes(label = round(value, 2)), size = 3) +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white",
                       midpoint = 0, limit = c(-1, 1), space = "Lab",
                       name = "Correlation") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1,
                                   size = 12, hjust = 1)) +
  coord_fixed() +
  ggtitle("Correlation Heatmap for RFM Variables") +
  theme(plot.title = element_text(hjust = 0.5))

# Print the heatmap
print(heatmap_plot)

• Monetary value and frequency of purchases are the most influential factors in determining the overall RFM score, with strong positive correlations.
• Recency has a moderate negative correlation with both frequency and monetary value, indicating that more recent purchases are associated with higher frequency and spending.
• Recency does not impact significantly on the overall RFM score, showing weak correlation.

#categorical
RFM_table$RFM_Score <- as.factor(RFM_table$RFM_Score)
RFM_table$RFM_Value <- as.factor(RFM_table$RFM_Value)
RFM_table$CUSTOMERNAME <- as.character(RFM_table$CUSTOMERNAME)

# Select categorical columas.character()# Select categorical columns and calculate Cramér's V matrix
categorical_columns <- RFM_table %>%
  select_if(is.factor)

categorical_vars <- colnames(categorical_columns)
n <- length(categorical_vars)
cramers_v_matrix <- matrix(0, n, n, dimnames = list(categorical_vars, categorical_vars))

for (i in 1:n) {
  for (j in i:n) {
    if (i == j) {
      cramers_v_matrix[i, j] <- 1
    } else {
      cramers_v_matrix[i, j] <- cramers_v(categorical_columns[[i]], categorical_columns[[j]])
      cramers_v_matrix[j, i] <- cramers_v_matrix[i, j]
    }
  }
}

cramers_v_df <- as.data.frame(as.table(cramers_v_matrix))

# Create the categorical heatmap
categorical_heatmap_plot <- ggplot(data = cramers_v_df, aes(Var1, Var2, fill = Freq)) +
  geom_tile(color = "white") +
  geom_text(aes(label = round(Freq, 2)), size = 3) +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white",
                       midpoint = 0.5, limit = c(0, 1), space = "Lab",
                       name = "Cramer's V") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, size = 12, hjust = 1)) +
  coord_fixed() +
  ggtitle("Cramér's V Heatmap for Categorical Variables") +
  theme(plot.title = element_text(hjust = 0.5))

# Print categorical heatmap plot
print(categorical_heatmap_plot)

• RFM_Score show strong association with f_quartile and m_quartile, same goes to f_quartile with m_quartile.
• r_quartile with f_quartile and m_quartile, these three variables show weak relationships.

Modelling

Regression Prediction (Sales Prediction)

# Import library
library(caret)  # for modeling
library(gbm)  # for Gradient Boosting
library(rpart)  # for Decision Tree
library(e1071)  # for SVM
library(reshape2)

# Specify the columns to encode
columns_to_encode <- c("STATUS", "QTR_ID", "MONTH_ID", "PRODUCTLINE", "DEALSIZE", "CITY", "COUNTRY", "dayofweek")

# Perform one-hot encoding
encoded_data <- model.matrix(~ . - 1, data = df1[, columns_to_encode])

# Combine the encoded data with the SALES column
df1_encoded <- cbind(df1["SALES"], encoded_data)

# Split data into training and testing sets
set.seed(123)  # for reproducibility
train_index <- createDataPartition(df1_encoded$SALES, p = 0.8, list = FALSE)
train_data <- df1_encoded[train_index, ]
test_data <- df1_encoded[-train_index, ]

# Function to calculate evaluation metrics
evaluate_model <- function(true_values, predictions) {
  rmse <- sqrt(mean((true_values - predictions)^2))
  mae <- mean(abs(true_values - predictions))
  r2 <- cor(true_values, predictions)^2
  mape <- mean(abs((true_values - predictions) / true_values)) * 100
  return(c(RMSE = rmse, MAE = mae, R2 = r2, MAPE = mape))
}

# Build and evaluate models
# Multiple Regression model
lm_model <- lm(SALES ~ ., data = train_data)
lm_predictions <- predict(lm_model, newdata = test_data)
lm_metrics <- evaluate_model(test_data$SALES, lm_predictions)

# Decision Tree model
dt_model <- rpart(SALES ~ ., data = train_data)
dt_predictions <- predict(dt_model, newdata = test_data)
dt_metrics <- evaluate_model(test_data$SALES, dt_predictions)

# Support Vector Machine (SVM) model
svm_model <- svm(SALES ~ ., data = train_data)
svm_predictions <- predict(svm_model, newdata = test_data)
svm_metrics <- evaluate_model(test_data$SALES, svm_predictions)

# Gradient Boosting model
gbm_model <- gbm(SALES ~ ., data = train_data, distribution = "gaussian", n.trees = 100)
gbm_predictions <- predict(gbm_model, newdata = test_data, n.trees = 100)
gbm_metrics <- evaluate_model(test_data$SALES, gbm_predictions)

# Create a summary table of metrics
model_performance <- data.frame(
  Model = c("Multiple Regression", "Decision Tree", "Support Vector Machine", "Gradient Boosting"),
  RMSE = c(lm_metrics["RMSE"], dt_metrics["RMSE"], svm_metrics["RMSE"], gbm_metrics["RMSE"]),
  MAE = c(lm_metrics["MAE"], dt_metrics["MAE"], svm_metrics["MAE"], gbm_metrics["MAE"]),
  R2 = c(lm_metrics["R2"], dt_metrics["R2"], svm_metrics["R2"], gbm_metrics["R2"]),
  MAPE = c(lm_metrics["MAPE"], dt_metrics["MAPE"], svm_metrics["MAPE"], gbm_metrics["MAPE"])
)

# Print the summary table
print(model_performance)

##                    Model      RMSE       MAE        R2     MAPE
## 1    Multiple Regression  883.3190  711.6334 0.7688384 24.75773
## 2          Decision Tree  870.4328  697.1713 0.7754687 23.90577
## 3 Support Vector Machine 1870.4091 1397.5743 0.3997581 47.53081
## 4      Gradient Boosting 1009.9271  779.3114 0.7200052 26.09811

# Visualize model performance
model_performance_melt <- melt(model_performance, id.vars = "Model")

ggplot(model_performance_melt, aes(x = Model, y = value, fill = Model)) +
  geom_bar(stat = "identity", position = "dodge") +
  facet_wrap(~ variable, scales = "free_y") +
  theme_minimal() +
  ggtitle("Model Performance Comparison") +
  ylab("Metric Value") +
  xlab("Model") +
  theme(axis.text.x = element_blank())

• From the graph we could conclude that Decision Tree Models has the best performance in predicting the sales, following by Multiple Regression Model, Gradient Boosting Model and Support Vector Machine Model.

Segmentation Prediction (Customer Segmentation Prediction)

library(dplyr)
library(caret)
library(e1071)
library(rpart)
library(nnet)
library(kernlab)

# Features and target variable
features <- c("Recency", "Frequency", "Monetary_value", "r_quartile", "f_quartile", "m_quartile", "RFM_Score")
X <- RFM_table[features]
y <- RFM_table$RFM_Value

# Split the data into training and testing sets
set.seed(42)
split <- 0.7
trainIndex <- createDataPartition(y, p = split, list = FALSE)
X_train <- X[trainIndex,]
X_test <- X[-trainIndex,]
y_train <- y[trainIndex]
y_test <- y[-trainIndex]

# Print the size of training and test sets
cat("Size of training set:", nrow(X_train), "\n")

## Size of training set: 61

cat("Size of test set:", nrow(X_test), "\n")

## Size of test set: 25

# Set up cross-validation
cv_control <- trainControl(method = "cv", number = 10)

# Train the Decision Tree model with cross-validation
dt_model_cv <- train(RFM_Value ~ ., data = data.frame(X_train, RFM_Value = y_train),
                     method = "rpart",
                     trControl = cv_control)
print(dt_model_cv)

## CART 
## 
## 61 samples
##  7 predictor
##  3 classes: 'Low Value Customer', 'Mid Value Customer', 'High Value Customer' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 55, 55, 55, 55, 55, 55, ... 
## Resampling results across tuning parameters:
## 
##   cp         Accuracy   Kappa    
##   0.0000000  0.6404762  0.2288889
##   0.1666667  0.6904762  0.1536508
##   0.3333333  0.6571429  0.0000000
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.1666667.

# Train the SVM model with cross-validation
svm_model_cv <- train(RFM_Value ~ ., data = data.frame(X_train, RFM_Value = y_train),
                      method = "svmRadial",
                      trControl = cv_control)

## Warning in .local(x, ...): Variable(s) `' constant. Cannot scale data.
## Warning in .local(x, ...): Variable(s) `' constant. Cannot scale data.
## Warning in .local(x, ...): Variable(s) `' constant. Cannot scale data.

print(svm_model_cv)

## Support Vector Machines with Radial Basis Function Kernel 
## 
## 61 samples
##  7 predictor
##  3 classes: 'Low Value Customer', 'Mid Value Customer', 'High Value Customer' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 55, 55, 55, 55, 54, 55, ... 
## Resampling results across tuning parameters:
## 
##   C     Accuracy   Kappa    
##   0.25  0.6571429  0.0000000
##   0.50  0.9023810  0.7530769
##   1.00  0.9523810  0.8730769
## 
## Tuning parameter 'sigma' was held constant at a value of 0.02948147
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were sigma = 0.02948147 and C = 1.

# Train the K-Nearest Neighbors model with cross-validation
knn_model_cv <- train(RFM_Value ~ ., data = data.frame(X_train, RFM_Value = y_train),
                      method = "knn",
                      trControl = cv_control)
print(knn_model_cv)

## k-Nearest Neighbors 
## 
## 61 samples
##  7 predictor
##  3 classes: 'Low Value Customer', 'Mid Value Customer', 'High Value Customer' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 54, 55, 55, 55, 55, 55, ... 
## Resampling results across tuning parameters:
## 
##   k  Accuracy   Kappa      
##   5  0.6404762   0.03923077
##   7  0.6380952   0.08833333
##   9  0.6071429  -0.02666667
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 5.

# Decision Tree predictions and evaluation
dt_predictions_cv <- predict(dt_model_cv, newdata = X_test)
dt_confusion_matrix_cv <- confusionMatrix(dt_predictions_cv, y_test)
print(dt_confusion_matrix_cv)

## Confusion Matrix and Statistics
## 
##                      Reference
## Prediction            Low Value Customer Mid Value Customer High Value Customer
##   Low Value Customer                   1                  0                   0
##   Mid Value Customer                   3                 17                   4
##   High Value Customer                  0                  0                   0
## 
## Overall Statistics
##                                           
##                Accuracy : 0.72            
##                  95% CI : (0.5061, 0.8793)
##     No Information Rate : 0.68            
##     P-Value [Acc > NIR] : 0.4253          
##                                           
##                   Kappa : 0.1784          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Low Value Customer Class: Mid Value Customer
## Sensitivity                              0.250                    1.0000
## Specificity                              1.000                    0.1250
## Pos Pred Value                           1.000                    0.7083
## Neg Pred Value                           0.875                    1.0000
## Prevalence                               0.160                    0.6800
## Detection Rate                           0.040                    0.6800
## Detection Prevalence                     0.040                    0.9600
## Balanced Accuracy                        0.625                    0.5625
##                      Class: High Value Customer
## Sensitivity                                0.00
## Specificity                                1.00
## Pos Pred Value                              NaN
## Neg Pred Value                             0.84
## Prevalence                                 0.16
## Detection Rate                             0.00
## Detection Prevalence                       0.00
## Balanced Accuracy                          0.50

# SVM predictions and evaluation
svm_predictions_cv <- predict(svm_model_cv, newdata = X_test)
svm_confusion_matrix_cv <- confusionMatrix(svm_predictions_cv, y_test)
print(svm_confusion_matrix_cv)

## Confusion Matrix and Statistics
## 
##                      Reference
## Prediction            Low Value Customer Mid Value Customer High Value Customer
##   Low Value Customer                   4                  0                   0
##   Mid Value Customer                   0                 17                   0
##   High Value Customer                  0                  0                   4
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.8628, 1)
##     No Information Rate : 0.68       
##     P-Value [Acc > NIR] : 0.00006497 
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: Low Value Customer Class: Mid Value Customer
## Sensitivity                               1.00                      1.00
## Specificity                               1.00                      1.00
## Pos Pred Value                            1.00                      1.00
## Neg Pred Value                            1.00                      1.00
## Prevalence                                0.16                      0.68
## Detection Rate                            0.16                      0.68
## Detection Prevalence                      0.16                      0.68
## Balanced Accuracy                         1.00                      1.00
##                      Class: High Value Customer
## Sensitivity                                1.00
## Specificity                                1.00
## Pos Pred Value                             1.00
## Neg Pred Value                             1.00
## Prevalence                                 0.16
## Detection Rate                             0.16
## Detection Prevalence                       0.16
## Balanced Accuracy                          1.00

# KNN predictions and evaluation
knn_predictions_cv <- predict(knn_model_cv, newdata = X_test)
knn_confusion_matrix_cv <- confusionMatrix(knn_predictions_cv, y_test)
print(knn_confusion_matrix_cv)

## Confusion Matrix and Statistics
## 
##                      Reference
## Prediction            Low Value Customer Mid Value Customer High Value Customer
##   Low Value Customer                   0                  1                   0
##   Mid Value Customer                   4                 15                   4
##   High Value Customer                  0                  1                   0
## 
## Overall Statistics
##                                           
##                Accuracy : 0.6             
##                  95% CI : (0.3867, 0.7887)
##     No Information Rate : 0.68            
##     P-Value [Acc > NIR] : 0.8576          
##                                           
##                   Kappa : -0.1062         
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Low Value Customer Class: Mid Value Customer
## Sensitivity                             0.0000                    0.8824
## Specificity                             0.9524                    0.0000
## Pos Pred Value                          0.0000                    0.6522
## Neg Pred Value                          0.8333                    0.0000
## Prevalence                              0.1600                    0.6800
## Detection Rate                          0.0000                    0.6000
## Detection Prevalence                    0.0400                    0.9200
## Balanced Accuracy                       0.4762                    0.4412
##                      Class: High Value Customer
## Sensitivity                              0.0000
## Specificity                              0.9524
## Pos Pred Value                           0.0000
## Neg Pred Value                           0.8333
## Prevalence                               0.1600
## Detection Rate                           0.0000
## Detection Prevalence                     0.0400
## Balanced Accuracy                        0.4762

# Function to calculate average metrics
calculate_average_metrics <- function(conf_matrix) {
  sensitivity <- mean(conf_matrix$byClass[,"Sensitivity"], na.rm = TRUE)
  specificity <- mean(conf_matrix$byClass[,"Specificity"], na.rm = TRUE)
  return(c(Sensitivity = sensitivity, Specificity = specificity))
}

# Collect evaluation metrics
dt_metrics <- calculate_average_metrics(dt_confusion_matrix_cv)
svm_metrics <- calculate_average_metrics(svm_confusion_matrix_cv)
knn_metrics <- calculate_average_metrics(knn_confusion_matrix_cv)

# Collect evaluation metrics
evaluation_metrics <- data.frame(
  Model = c("Decision Tree", "SVM", "KNN"),
  Accuracy = c(dt_confusion_matrix_cv$overall['Accuracy'], 
               svm_confusion_matrix_cv$overall['Accuracy'], 
               knn_confusion_matrix_cv$overall['Accuracy']),
  Kappa = c(dt_confusion_matrix_cv$overall['Kappa'], 
            svm_confusion_matrix_cv$overall['Kappa'], 
            knn_confusion_matrix_cv$overall['Kappa']),
  Sensitivity = c(dt_metrics['Sensitivity'], 
                  svm_metrics['Sensitivity'], 
                  knn_metrics['Sensitivity']),
  Specificity = c(dt_metrics['Specificity'], 
                  svm_metrics['Specificity'], 
                  knn_metrics['Specificity'])
)

# Print the evaluation metrics
print(evaluation_metrics)

##           Model Accuracy      Kappa Sensitivity Specificity
## 1 Decision Tree     0.72  0.1784038   0.4166667   0.7083333
## 2           SVM     1.00  1.0000000   1.0000000   1.0000000
## 3           KNN     0.60 -0.1061947   0.2941176   0.6349206

# Convert the data to long format for ggplot2
evaluation_metrics_long <- evaluation_metrics %>%
  pivot_longer(cols = -Model, names_to = "Metric", values_to = "Value")

# Plot the comparison of metrics
ggplot(evaluation_metrics_long, aes(x = Model, y = Value, fill = Metric)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Model Performance Comparison", x = "Model", y = "Value") +
  theme_minimal()

• The graph show that SVM model has the best result, following by Decision Tree Model and KNN Model.

Conclusion

Our study on the sales dataset focused on two important fields: sales predicting using regression and customer segmentation using RFM analysis.

• Sales Prediction:
  • Sales prediction is conducted using selected machine learning models, such as multiple linear regression (MLR), decision tree (DT), support vector machine (SVM), and gradient boosting (GBM).
  • Decision Tree exhibits the best model performance based on the evaluation metrics used which are RMSE, MAE, R-squared and MAPE. It has lowest RMSE, MAE, and MAPE values, as well as highest R2 value.
• Customer Segmentation:
  • RFM analysis using decision tree (DT), support vector machine (SVM), and K-Nearest Neighbors (KNN) models classified consumers into high and low-value segments.
  • SVM appears to be the best-performing model overall, with outstanding accuracy, high sensitivity and specificity for all three classes.

Overall, this research offers useful information on the sales performance and customer behavior.

By exploiting these data and adopting the chosen models, marketing activities may be streamlined, resulting in improved consumer engagement and sales growth.