exploration.Rmd

---
title: "Exploration des données"
author: Arnaud Vanholderbeke, Benjamin Loriot et Natan Danous
date: 11 Mai 2019
output:
  pdf_document:
    toc: true
  html_document: default
classoption: twocolumn
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(tidyverse)
library(knitr)
library(reshape2)
library(gridExtra)
library(class)
library(ggfortify)
library("plot3D")
library("scatterplot3d")
bf <- read.csv("dataset.csv", header=T)
```

## Description
Ces données sont les ventes provenant d'un seul magasin lors du Black Friday.
Le magasin veut mieux comprendre le comportement des consommateur sur différents produits.
Selon Kaggle, le problème principal est un problème de regression. On essaie de prédire la variable quantité d'achat à l'aide des autres variables. Ce problème peut également être vu comme un problème de régression.

## Types et granularité

```{r types_table}
types_table <- data.frame(
  Champ = c("Purchase", "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"),
  Type = c("Quantitative", "Ordinal", "Nominal", "Nominal", "Ordinal", "Nominal", "Nominal", "Ordinal", "Nominal", "Nominal", "Nominal", "Nominal"),
  Modalités = c("", "", "", "F, M", "0-17 -> ... -> 51-55 -> 55+", "0 -> 20", "A, B, C", "0, 1, 2, 3, 4+", "0, 1", "1 -> 18", "2 -> 18 (avec NA)", "3 -> 18 (avec NA)")
)
kable(types_table, caption = "Dictionnaire des données")
```

Remarque :

- Un produit a obligatoirement une catégorie (Product_Category_1 ne contient pas de NA). Il n'a pas obligatoirement de 2ème et 3ème catégorie.

```{r types}
bf$Occupation <- factor(bf$Occupation, levels = c('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11', '12', '13', '14', '15', '16', '17', '18', '19', '20'))
bf$Marital_Status <- factor(bf$Marital_Status, levels = c('0', '1'))
bf$Product_Category_1 <- factor(bf$Product_Category_1, levels = c('1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11', '12', '13', '14', '15', '16', '17', '18'))
bf$Product_Category_2 <- factor(bf$Product_Category_2, levels = c('2', '3', '4', '5', '6', '7', '8', '9', '10', '11', '12', '13', '14', '15', '16', '17', '18'))
bf$Product_Category_3 <- factor(bf$Product_Category_3, levels = c('3', '4', '5', '6', '7', '8', '9', '10', '11', '12', '13', '14', '15', '16', '17', '18'))
```

## Distribution

### Sexe

```{r}
options(scipen=10000)
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Gender, y = ..count.., fill = Gender)) +
  labs(title = 'Sexe des clients')
```

### Age

```{r}
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Age, y = ..count.., fill = Age)) +
  labs(title = 'Age des clients')
```

La distribution de l'age dans une population suit habituellement une loi normale. On observe ici que ce n'est pas le cas. Il apparait que la tranche d'âge des 26-35 effectue le plus d'achats lors du Black Friday.

```{r}
purchase_sum = aggregate(
  bf$Purchase,
  list(User_ID = bf$User_ID, Gender = bf$Gender, City_Category = bf$City_Category, Age = bf$Age),
  sum
)

ggplot(purchase_sum, aes(x = Age, y = x, fill=Age)) +
  geom_bar(stat = "summary", fun.y = "mean") +
  labs(title = 'Dépenses total selon l\'âge')
```

### Métier

```{r}
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Occupation, y = ..count.., fill = Occupation)) +
  labs(title = 'Métier des clients')
```

### Type de ville

```{r}
ggplot(data = bf) +
  geom_bar(mapping = aes(x = City_Category, y = ..count.., fill = City_Category)) +
  labs(title = 'Type de ville des clients')
```

### Ancienneté dans la ville

```{r}
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Stay_In_Current_City_Years, y = ..count.., fill = Stay_In_Current_City_Years)) +
  labs(title = 'Ancienneté dans la ville des clients')
```

### Situation conjugale

```{r}
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Marital_Status, y = ..count.., fill = Marital_Status)) +
  labs(title = 'Situation conjugale des clients')
```

### Catégories des produits

```{r}
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Product_Category_1, y = ..count.., fill = Product_Category_1)) +
  labs(title = 'Catégorie de produit 1')

```{r}
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Product_Category_2, y = ..count.., fill = Product_Category_2)) +
  labs(title = 'Catégorie de produit 2')

```{r}
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Product_Category_3, y = ..count.., fill = Product_Category_3)) +
  labs(title = 'Catégorie de produit 3')
```

### Performance des produits

```{r}
bf.by_product_id <- bf %>% group_by(Product_ID) %>% summarise(Quantity = n()) %>% arrange(desc(Quantity))
ggplot(data = bf.by_product_id[1:25,], aes(x = reorder(Product_ID, -Quantity), y = Quantity)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1,
                                   size = 12, hjust = 1)) +
  labs(title = 'Classement des 25 meilleurs produits selon le nombre de ventes', x = 'Product ID', y = 'Quantité vendue')
```

Le premier produit se détache du reste.

Commercial

- Performance des produit (via ID)
- Catégorie de produit qui se vendent le mieux

## Visu

```{r gender}
bf_gender = bf %>% select(User_ID, Gender) %>% group_by(User_ID) %>% distinct()
summary(bf_gender)
ggplot(data = bf) +
  geom_bar(mapping = aes(x = Age, y = ..count.., fill = Age), position=position_dodge()) +
  labs(title = 'Age and gender of Customers')
```

```{r total}
purchase_sum = aggregate(bf$Purchase,
          list(User_ID = bf$User_ID, Gender = bf$Gender, City_Category = bf$City_Category, Age = bf$Age),
          sum)

summary(purchase_sum)
ggplot(purchase_sum, aes(x = Age, y = x, fill=Age)) +
  geom_bar(stat = "summary", fun.y = "mean") +
  labs(title = 'Avg total purchase depending on the age of Customers')
```


## Corrélation entre les variables

## Mesure de l'entropie et du gain d'entropie

TODO: A expliquer et justifier et synthétiser.


```{r entropy}
library(entropy)

global_sells = bf %>%
  select(Product_ID) %>%
  group_by(Product_ID) %>%
  summarise(count=n())
global_sells_sum = sum(global_sells$count)
global_sells$prob = global_sells$count / global_sells_sum

sapply(c('Age', 'Gender', 'Stay_In_Current_City_Years', 'Occupation', 'Marital_Status', 'City_Category'), function(test){
  discriminators = levels(bf[,test])
  sells_city = sapply(discriminators, function(category){
    sells = bf[bf[,test] == category,] %>%
      select(Product_ID) %>%
      group_by(Product_ID) %>%
      summarise(count=n())
    s <- sum(sells$count)
    sells$prob = sells$count / sum(sells$count)
    return(list(prob=sells$prob, sum=s))
  })

  entropy_sum <- function(acc,cur) {
    acc + entropy(sells_city[,cur]$prob) *  sells_city[, cur]$sum / global_sells_sum #
  }

  entropy_gain = entropy(global_sells$prob) - Reduce(entropy_sum, discriminators, 0)
  entropy_gain
})
```

Deux catégories importantes : Age et Occupation.

## Embedding des client (+ clustering)

```{r}
categories =  c('1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11', '12', '13', '14', '15', '16', '17', '18')
user_pc <- sapply(unique(bf$User_ID), function(user){
  user_data <- bf[bf$User_ID == user,]
  cat_count <- matrix(0, length(categories), 1, dimnames = list(categories, c(user)))
  #print(as.numeric(rownames(user_data)))
  for (line in as.numeric(rownames(user_data))){
    PC_1 <- as.numeric(bf[line,]$Product_Category_1)
    cat_count[PC_1] <- cat_count[PC_1] + 1
    if (! is.na(bf[line,]$Product_Category_2)){
      PC_2 <- as.numeric(bf[line,]$Product_Category_2)
      cat_count[PC_2] <- cat_count[PC_2] + 1
    }
    if (! is.na(bf[line,]$Product_Category_3)){
      PC_3 <- as.numeric(bf[line,]$Product_Category_3)
      cat_count[PC_3] <- cat_count[PC_3] + 1
    }
  }
  #cat_count[length(categories) + 1] = user
  cat_count
})
```
```{r}
X <- bf %>% group_by(User_ID, Product_Category_1) %>% summarise(Purchase = sum(Purchase)) %>% spread(key = Product_Category_1, value = Purchase, fill = 0)
# Remove User_ID
X <- X[,-1]
# Scale
#X <- scale(X, T, T)
```

```{r}
# Get amount and quantity purchased per users.
X <- bf %>% group_by(User_ID) %>% summarise(Purchase = sum(Purchase))
# Remove User_ID
X <- X[,-1]
# Scale
X <- scale(X, T, T)



# Find number of clusters
inerties_min = c()
for (k in 1:10) {
  inerties <- c()
  #for (iter in 1:100) {
    #centering <- kmeans(x = iris.scaled, centers=k)
    #inerties[iter] <- centering$tot.withinss
  #}
  inerties_min[k] <- kmeans(X, k, nstart = 100)$tot.withinss
  # min(inerties)
}
barplot(inerties_min)

# Avec la méthode du coude, on prend k = 4 classes.
# bf.kmeans <- kmeans(X, 4)

# plot(data.frame(X, 1), col=bf.kmeans$cluster, type = 'b')

# bf.pca <- princomp(scale(X, T, T))
# plot(bf.pca$scores[,1:2], col=bf.kmeans$cluster)
```

### Classificatin supervisée

```{r}
# Get amount purchased per users for each category of product.
X <- bf %>% group_by(User_ID, Occupation, Product_Category_1) %>% summarise(Purchase = sum(Purchase)) %>% spread(key = Product_Category_1, value = Purchase, fill = 0)
# Remove User_ID
X <- X[,-1]

# Generate a random number that is 90% of the total number of rows in the dataset.
ran <- sample(1:nrow(X), 0.9 * nrow(X))

# Normalization function
nor <- function(x) { (x - min(x)) / (max(x) - min(x)) }

# Run nor on every column except Gender
X_norm <- as.data.frame(lapply(X[, 2:19], nor))

# Extract training set
Xapp <- X_norm[ran,]

# Extract test set
Xtst <- X_norm[-ran,]

# Extract the first column of train dataset
X_target_category <- X_norm[ran, 1]

# Extract the first column of test dataset to measure accuracy
X_test_category <- X_norm[-ran, 1]

pr <- knn(Xapp, Xtst, cl = X_target_category, k = 13)

tab <- table(pr, X_test_category)

accuracy <- function(x) { sum(diag(x) / (sum(rowSums(x)))) * 100}
accuracy(tab)
```

### Régression logistique

```{r}
# On veut trouver le prochain produit OU la prochaine catégorie que l'utilisateur va acheter.
# Cela dépend de ses facteurs socio-cultu. 

library(caret)
library(nnet)

# bf$Product_Category_1 <- relevel(bf$Product_Category_1, ref="1")
# test <- multinom(Product_Category_1 ~ Age + Purchase, data = bf)
```