BlackFriday.Rmd

---
title: "BlackFriday Analysis"
author: "Nisha Selvarajan"
date: "11/1/2020"
output:
  pdf_document:
      toc: yes
      toc_depth: 4
      latex_engine: lualatex
      #toc_float: true
  word_document:
      toc: yes
      toc_depth: 4
      #toc_float: true
  html_document:
      theme: journal
      toc: yes
      toc_depth: 4
      #toc_float: true
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(message = FALSE)
knitr::opts_chunk$set(warning = FALSE)
```

## BlackFriday - Customer Purchasing Behavior

***Market Basket Analysis /APRIORI - Black Friday Examined***

With the holiday season fast approaching, I found it intriguing to examine a dataset revolving around a hypothetical store and data of its shoppers.Ability to recognize and track patterns in data help businesses shift through the layers of seemingly unrelated data for meaningful relationships. Through this analysis it becomes easy for the online retailers to determine the dimensions that influence the uptake of online shopping and plan effective marketing strategies. This project builds a roadmap for analyzing consumer’s online buying behavior with the help of Apriori algorithm. 


Your client gives you data for all transactions that consists of items bought in the store by several customers over a period of time and asks you to use that data to help boost their business. Your client will use your findings to not only change/update/add items in inventory but also use them to change the layout of the physical store or rather an online store. To find results that will help your client, you will use Market Basket Analysis (MBA) which uses Association Rule Mining on the given transaction data.


## Association Rule Mining##

+ Association Rule Mining is used when you want to find an association between different objects in a set, find frequent patterns in a transaction database, relational databases or any other information repository. The applications of Association Rule Mining are found in Marketing, Basket Data Analysis (or Market Basket Analysis) in retailing, clustering and classification. It can tell you what items do customers frequently buy together by generating a set of rules called Association Rules. In simple words, it gives you output as rules in form if this then that. Clients can use those rules for numerous marketing strategies:

  - Changing the store layout according to trends
  - Customer behavior analysis
  -Catalogue design
  -Cross marketing on online stores
  -What are the trending items customers buy
  -Customized emails with add-on sales
  
+ Association Rule Mining is viewed as a two-step approach:

  -Frequent Itemset Generation: Find all frequent item-sets with support >= pre-determined min_support count. Frequent Itemset Generation is the most computationally expensive step because it requires a full database scan. 

  -Rule Generation: List all Association Rules from frequent item-sets. Calculate Support and Confidence for all rules. Prune rules that fail min_support and min_confidence thresholds.

 
### Challenge

+ Find hidden relationships between the products ,and to analyze purchase behaviors using APRIORI.
+ Look for combinations of items that occur together frequently in transactions, providing information to understand the purchase behavior. The outcome of this type of technique is, in simple terms, a set of rules that can be understood as “if this, then that”

###  Data Description

+ The data used for this particular project is "Black Friday Sales Analysis"(https://www.kaggle.com/mehdidag/black-friday). Detailed description of the variables: 


```{r, message = FALSE, echo=FALSE}

library(knitr)
library(kableExtra)
library(dplyr)
library(DataExplorer)
library(funModeling)
library(tidyverse)
library(class)
library(rpart)
library(rpart.plot)
library(e1071)
library(corrplot)
library(caTools)
library(party)
library(ISLR)
library(readxl)
library(pROC)
library(lattice)
library(e1071) 
library(ggplot2)
library(multiROC)
library(MLeval)
library(AppliedPredictiveModeling)
library(Hmisc)
library(quantmod) 
library(nnet)
library(caret)
library(ggplot2)
library(arules)

theme_set(theme_classic())


blackfriday_raw <- read.csv(file = "/Users/nselvarajan/Desktop/R/Assignment4/Book1.csv", header = T,stringsAsFactors = F)

df <- data.frame(Names = c("User_ID",
                           "Product_ID",
                           "Gender",
                           "Age",
                           "Occupation",
                           "City_Category",
                           "Stay_In_Current_City_Years",
                           "Marital_Status",
                           "Product_Category_1",
                           "Product_Category_2",
                           "Product_Category_3",
                           "Purchase"),
                  Description = c("Categorical - User ID",
                           "Categorical - Product ID",
                           "Categorical - Sex of User",
                           "Categorical - Age in bins",
                           "Categorical - Occupation (Masked)",
                           "Categorical - Category of the City (A,B,C)",
                           "Numerical - Number of years stay in current city",
                           "Categorical - Marital Status",
                           "Categorical - Product Category (Masked)",
                          "Categorical -  Product may belongs to other category also (Masked)",
                          "Categorical - Product may belong to other category also (Masked)",
                          "Numerical - Purchase Amount (Target Variable)"
                  ))
kbl(df)%>%
 kable_paper(full_width = F) %>%
 column_spec(2, width = "30em")
```

###  Data Analysis & Clean up

+ Black Friday data set is further cleaned by changing the format of each variable. This included changing Product_ID, Gender, Age, City_Category, Marital_Status and Product_Category from character variables to factors. 

+ Product Category 2 & Product Category 3 has many missing values. Input 0 for Product Category 2/
Product Category 3.


```{r, message = FALSE, echo=FALSE}

#Imputing 0 for NA in Product_Category_2
blackfriday_raw$Product_Category_2 <- as.numeric(blackfriday_raw$Product_Category_2)
blackfriday_raw[is.na(blackfriday_raw$Product_Category_2), "Product_Category_2"] <- 0

#Imputing 0 For NA in Product_Category_3
blackfriday_raw$Product_Category_3 <- as.numeric(blackfriday_raw$Product_Category_3)
blackfriday_raw[is.na(blackfriday_raw$Product_Category_3), "Product_Category_3"] <- 0


blackfriday_raw$User_ID <- as.factor(blackfriday_raw$User_ID)
blackfriday_raw$Product_ID <- as.factor(blackfriday_raw$Product_ID)
blackfriday_raw$Marital_Status <- as.factor(ifelse(blackfriday_raw$Marital_Status == 1, 'Married', 'Single'))
blackfriday_raw$Age <- as.factor(blackfriday_raw$Age)
blackfriday_raw$Gender <- as.factor(ifelse(blackfriday_raw$Gender=='M', 'Male', 'Female'))
blackfriday_raw$Occupation <- as.factor(blackfriday_raw$Occupation)
blackfriday_raw$City_Category <- as.factor(blackfriday_raw$City_Category)
blackfriday_raw$Stay_In_Current_City_Years <- as.factor(blackfriday_raw$Stay_In_Current_City_Years)
```


### Exploratory Data Analysis


```{r, message = FALSE, echo=FALSE}

library(ggplot2)
ggplot(data=blackfriday_raw, aes(x = Gender,y = Purchase, fill = Gender)) +
  geom_bar(stat="identity")+theme_minimal()+
  scale_fill_manual("legend",values = c("Female"= "#c4d8ba","Male"="#d8ceba"))+
  labs(x = 'Gender') +
  labs(y = 'Purchase') +
  ggtitle("Gender vs Purchase")

#Occupation vs purchase barplot
ggplot(data=blackfriday_raw, aes(x = Occupation,y = (..count..), fill = Purchase)) +
  geom_bar(position = "dodge",width = .5,fill="#c4d8ba") +
  labs(x = 'Ocupation') +
  labs(y = 'Purchase') +
  ggtitle("Occupation vs Purchase")

#Buyers according to Occupation, Marital Status and Age
ggplot(data=blackfriday_raw,aes(x=Occupation, fill=Age))+
  geom_bar(position = "stack")+
  facet_grid(Gender~Marital_Status)+
  labs(y="Number of buyers")+
  ggtitle("Buyers according to Occupation, Marital Status and Age")


#city category vs purchase barplot
table(blackfriday_raw$City_Category,blackfriday_raw$Stay_In_Current_City_Years)

ggplot(data=blackfriday_raw, aes(x = City_Category,y = Purchase, fill = City_Category)) +
  geom_bar(stat="identity")+theme_minimal()+
  scale_fill_manual("legend",values = c("A"= "#FF3333","B"="#3366FF","C"="#CCFF00"))+
  labs(x = 'City Category') +
  labs(y = 'Purchase') +
  ggtitle("City Category vs Purchase")

ggplot(data=blackfriday_raw,aes(x=Stay_In_Current_City_Years,fill=City_Category,col=Marital_Status))+
  geom_bar()+
  scale_fill_manual("City Category",values = c("A"= "lightpink","B"="lightblue","C"="lightgreen"))+
  scale_color_manual("Marital Status",values = c("darkgreen","red"))+
  ggtitle("Number of people staying in Current city according to Marital Status")+
  labs(x="Stay in Current City")+
  labs(y="Number of people")

#Marital status vs purchase barplot
ggplot(data=blackfriday_raw, aes(x = Marital_Status,y = Purchase, fill = Marital_Status)) +
  geom_bar(stat="identity")+theme_minimal()+
  scale_fill_manual("legend",values = c("Married"= "blue","Unmarried"="orange"))+
  labs(x = 'Marital Status') +
  labs(y = 'Purchase') +
  ggtitle("Marital Status vs Purchase")

#Stay in current city vs purchase barplot
ggplot(data=blackfriday_raw, aes(x = Stay_In_Current_City_Years,y = (..count..), fill = Purchase)) +
  geom_bar(position = "dodge",width = .5,fill="pink") +
  labs(x = 'Stay in city') +
  labs(y = 'Purchase') +
  ggtitle("Stay in current city vs Purchase")

# Age vs Purchase boxplot

table(blackfriday_raw$Marital_Status,blackfriday_raw$Gender,blackfriday_raw$Age)

ggplot(data=blackfriday_raw,aes(x= Age,y=Purchase, fill=Age)) + 
  geom_boxplot() + 
  facet_grid(Gender~Marital_Status) + 
  labs(x="Age",y="Purchase")+
  ggtitle("Age vs Purchase")

#No of buyers according to age,gender and marital status

ggplot(data=blackfriday_raw,aes(x=Age,fill=Gender,col=Marital_Status))+
  geom_bar(position = "dodge")+
  labs(x="Age")+
  labs(y="No of buyers")+
  scale_fill_manual("Gender",values = c("Female"= "pink","Male"="lightblue"))+
  scale_color_manual("Marital Status",values = c("darkgreen","red"))+
  ggtitle("Number of buyers according to age,gender and marital status")


#Number of purcahses made by each user -USER_ID
userIDcount<-as.data.frame(table(blackfriday_raw$User_ID))
names(userIDcount)<-c("User_ID","Number_of_Purchases")
train_BFdata<-as.data.frame(merge(blackfriday_raw,userIDcount,by='User_ID',all.x = TRUE))


# Number of purchases vs Age,gender and occupation

ggplot(data=train_BFdata,aes(x=Age,y=Number_of_Purchases,fill=Occupation))+
  geom_bar(position = "dodge",stat = "identity")+
  facet_grid(Gender~.)+
  scale_fill_discrete("Occupation")+
  ggtitle("")+
  labs(y="Number of purchases")

# Number of purchases vs Age,gender and stay in current city
ggplot(data=train_BFdata,aes(x=Age,y=Number_of_Purchases,fill=Stay_In_Current_City_Years))+
  geom_bar(position = "dodge",stat = "identity")+
  facet_grid(Gender~.)+
  scale_fill_discrete("Stay_In_Current_City_Years")+
  ggtitle("")+
  labs(y="Number of purchases")
```

### Frequency Distribution By Product Category


```{r, message = FALSE, echo=FALSE}

correlated_data <- blackfriday_raw

correlated_data$User_ID <-as.numeric(as.factor(correlated_data$User_ID))
correlated_data$Product_ID <- as.numeric(as.factor(correlated_data$Product_ID))
correlated_data$Marital_Status <- as.numeric(as.factor(correlated_data$Marital_Status ))
correlated_data$Age <- as.numeric(as.factor(correlated_data$Age))
correlated_data$Gender <- as.numeric(as.factor(correlated_data$Gender))
correlated_data$Occupation <- as.numeric(as.factor(correlated_data$Occupation))
correlated_data$Stay_In_Current_City_Years <- as.numeric(as.factor(correlated_data$Stay_In_Current_City_Years))
correlated_data$City_Category <- as.numeric(as.factor(correlated_data$City_Category))                                                                                                                                                                                                     
library(ggplot2)
# counts
p <- ggplot(data.frame(correlated_data$Product_Category_1), aes(x=correlated_data$Product_Category_1)) +
  ggtitle("Frequency distribution by Product Category 1") +
  xlab("Product Category 1") +
  geom_bar(colour="black", fill="#008080")
p + theme(
  plot.title = element_text(color="black", size=10, face="bold.italic"),
  axis.title.x = element_text(color="black", size=10, face="bold.italic"),
)

# counts
p <- ggplot(data.frame(correlated_data$Product_Category_2), aes(x=correlated_data$Product_Category_2)) +
  ggtitle("Frequency distribution by Product Category 2") +
  xlab("Product Category 2") +
  geom_bar(colour="black", fill="#008080")
p + theme(
  plot.title = element_text(color="black", size=10, face="bold.italic"),
  axis.title.x = element_text(color="black", size=10, face="bold.italic"),
)

# counts
p <- ggplot(data.frame(correlated_data$Product_Category_3), aes(x=correlated_data$Product_Category_3)) +
  ggtitle("Frequency distribution by Product Category 3") +
  xlab("Product Category 3") +
  geom_bar(colour="black", fill="#008080")
p + theme(
  plot.title = element_text(color="black", size=10, face="bold.italic"),
  axis.title.x = element_text(color="black", size=10, face="bold.italic"),
)

```

### Impleentation of APRIORI

+ Step 1: Load the dataset & Clean the dataset.

```{r, message = FALSE, echo=FALSE}
library(arules)
groceries <- read.transactions("/Users/nselvarajan/Desktop/R/Assignment4/Book1.csv", sep = " ")
summary(groceries)
```

+ Step 2: Data cleaning and manipulations using R.

   - Group the transactions by USER ID. The data required for Apriori must be in the  basket format.The basket format must have first column as a unique identifier of each transaction, something like a unique product Id. The second columns consists of the items bought in that transaction, separated by spaces or commas or some other separator.

```{r, message = FALSE, echo=FALSE}
customers_products = blackfriday_raw %>%
  select(User_ID, Product_ID) %>% #selecting the columns
  group_by(User_ID) %>% #grouping by "User_ID"
  arrange(User_ID) %>% #arranging by "User_ID"
  mutate(id = row_number()) %>% #defining a key column for each "Product_ID" and its corresponding "User_ID"
  spread(User_ID, Product_ID) %>% 
  t() #transposing the dataset from columns of "User_ID" to rows of "User_ID"
customers_products = customers_products[-1,]
```

+ APRIORI needs the data in transaction format. Convert grouped customer Id data frame to transaction.
+ read.transactions in R reads a transaction data file from disk and creates a transactions object.

```{r, message = FALSE, echo=FALSE}
write.csv(customers_products, file = 'customers_products4.csv')
customers_products = read.transactions('customers_products4.csv', sep = ',', rm.duplicates = T) 
```

### Item Frequency Plot

```{r, message = FALSE, echo=FALSE}

itemFrequencyPlot(customers_products, topN = 25)
plot(1,1, axes = FALSE)
itemFrequencyPlot(customers_products,topN = 18,type = "relative",col = "#FFFACD",xlab = "Item ID",ylab = "Frequency(relative)")
plot(1,1, axes = FALSE)
itemFrequencyPlot(customers_products, topN=15, type="absolute", col="wheat2",xlab="Item name", 
                  ylab="Frequency (absolute)", main="Absolute Item Frequency Plot")
```

+ Step 3: Find the association rules.

   - Next step is to mine the rules using the APRIORI algorithm. The function apriori() is from package arules.
 
   - Association rules analysis is a technique to uncover how items are associated to each other. There are three common ways to measure association.

   - Measure 1: Support. This says how popular an itemset is, as measured by the proportion of transactions in which an itemset appears. 

   - Measure 2: Confidence. This says how likely item Y is purchased when item X is purchased, expressed as {X -> Y}. This is measured by the proportion of transactions with item X, in which item Y also appears.
  
   - Measure 3: Lift. This says how likely item Y is purchased when item X is purchased, while controlling for how popular item Y is. 

   - Measure 4:minlen is the minimum number of items required in the rule.
  
   - Measure 5:maxlen is the maximum number of items that can be present in the rule.

```{r, message = FALSE, echo=TRUE}

summary(itemFrequency(customers_products))


rules = apriori(data = customers_products, parameter = list(support =
                                                              0.01, confidence = 0.74, minlen = 4))

```

+ Step 5: Print the association rules. To print the association rules, we use a function called inspect().

```{r, message = FALSE, echo=TRUE}
inspect(rules[1:10])

```

+ Sort by Confidence

```{r, message = FALSE, echo=TRUE}
inspect(sort(rules, by = 'confidence'))
```

+ Sort by Lift

```{r, message = FALSE, echo=TRUE}

inspect(sort(rules, by = 'lift'))
```

+ Step 6: Plot a few graphs that can help you visualize the rules

```{r, message = FALSE, echo=TRUE}

 library(arulesViz) 
 library(arules) 
 plot(rules, method = 'grouped', max = 4) 

```


 + Scatter Plot for the rules. 
 
```{r, message = FALSE, echo=TRUE}
 
 plot(rules,measure = c("support","lift"),shading = "confidence",jitter = 2) 
 plot(rules, method="graph",max = 4) 
 
``` 

### What rules lead to consequent?
- This can be done by filtering the rules to see what leads to a particular product

```{r, message = FALSE, echo=TRUE}

filter = 'P00110742'
rules_filtered <- subset(rules, subset = rhs %in% filter)

inspect(rules_filtered)
 
``` 


### CONCLUSION
In conclusion, the market basket analysis is studied in this analysis and it is one of the most popular association rules approach. In this study, “market basket optimization” dataset is analyzed, and results were obtained. “arules” and “arulesViz” packages are mainly used in the analysis. Then, set of transactions are determined and rules for these transactions are analyzed.  Moreover, support, confidence, lift and set of rules are found. After this step, all outputs were sorted for each method. The results are plotted and then the analysis is tested.