---
title: 'What Fashion Looks Like - EDA H&M'
date: '`r Sys.Date()`'
output:
  html_document:
    number_sections: true
    fig_caption: true
    toc: true
    fig_width: 7
    fig_height: 4.5
    theme: cosmo
    highlight: tango
    code_folding: hide
---

```{r setup, include=FALSE, echo=FALSE}
knitr::opts_chunk$set(echo=TRUE, error=TRUE)
knitr::opts_chunk$set(out.width="100%", fig.height = 4.5, split=FALSE, fig.align = 'default')
```

<div 
    style="background-image: url('https://images.unsplash.com/photo-1568026348520-336cecdf6057?ixlib=rb-1.2.1&ixid=MnwxMjA3fDB8MHxwaG90by1wYWdlfHx8fGVufDB8fHx8&auto=format&fit=crop&w=1170&q=80'); 
    width:100%; 
    height:400px; 
    background-position:center;">&nbsp;
</div>

*Photo by Kishor (@shorstudio) on Unsplash.*

# Introduction
Welcome to my **humble** EDA notebook on H&M competition! I will be trying here to explore and create interesting insights about this competition data.

**If you find any information here useful, consider giving me a upvote!**

*Note*: This notebook is heavily inspired in this other [work](https://www.kaggle.com/headsortails/back-to-predict-the-future-interactive-m5-eda) from [Heads or Tails](https://www.kaggle.com/headsortails).

**Why am I using Rmarkdown?** R has great data manipulation and data visualization packages that I wish to use. Also, this competition data is big, manipulation on pandas would be slow, and other manipulation packages are not very memory efficient. 

**Some insight in this competition:** H&M Group is a family of brands and businesses with 53 online markets and approximately 4,850 stores. To enhance the shopping experience, product recommendations are key. More importantly, helping customers make the right choices also has a positive implications for sustainability, as it reduces returns, and thereby minimizes emissions from transportation. 

Data:
There are four csv files:

- `articles.csv`: A dictionary of each of every product sold by H&M with its characteristics.
- `train.csv`: Our main data file, which showcases all of training relevant data.
- `customers.csv`: A dictionary related to each customer. (like articles, but with customer related info)
- `submission.csv`: A sample on how to make a submission format.

They relate to each other on:

* `Articles`: Relate to `train` on **article_id**.
* `Train`: Relate to `customers` on **customer_id** and to **articles** on **article_id**.
* `Customers` Relate to `train` on **customer_id**.
* `Submission`: Relate to `customers` on **customer_id**.

Metrics:

- Long Tail Plot: used to explore popularity patterns in user-item interaction data such as clicks, ratings, or purchases.
- MAP@K and MAR@K: MAP@K gives insight into how relevant the list of recommended items are, whereas MAR@K gives insight into how well the recommender is able to recall all the items the user has rated positively in the test set. **MAP@12 is the official metric for the competition** [click here to see official page](https://www.kaggle.com/c/h-and-m-personalized-fashion-recommendations/overview/evaluation)
- Coverage: is the percent of items in the training data the model is able to recommend on a test set.
- Personalization: It is the dissimilarity (1- cosine similarity) between user’s lists of recommendations.
- Intra-list Similarity: is the average cosine similarity of all items in a list of recommendations.

[Metrics material reference here.](https://towardsdatascience.com/evaluation-metrics-for-recommender-systems-df56c6611093)

# Preparations {.tabset .tabset-fade .tabset-pills}

## Imports
```{r imports, message = FALSE}
#Data manipulation
library(data.table)
library(dplyr)

#Data visualization
library(ggplot2)
library(ggthemes)
library(wordcloud)
library(RColorBrewer)

#HTML related
library(kableExtra) #tabular display options to html format
library(plotly) #better options to ggplot in html

#Text mining
library(tm) 
library(SnowballC)

```

## Load data
```{r path, echo=FALSE}
#Note for future readers of my .RMD script: I do this here to avoid having to commit my notebook to kaggle everytime I wish to see my html file.
#This way, I'll be able to just simply copy and paste my script from my pc to kaggle not having to change this bit everytime.
if (dir.exists("/kaggle")){
  path <- "/kaggle/input/h-and-m-personalized-fashion-recommendations/"
} else {
  path <- ""
  Sys.setlocale("LC_TIME", "en_US.UTF-8")
}
```

```{r reading, message = FALSE}
articles = fread(paste0(path,'articles.csv'))
train = fread(paste0(path,'transactions_train.csv'))
customers = fread(paste0(path,'customers.csv'))
submission = fread(paste0(path,'sample_submission.csv'))

```

# Quick Look: data head and structure {.tabset .tabset-fade .tabset-pills}
**note: currently there is no description of what each column mean in this competition, so some things down here will be based on my personal assumption.**

## Articles
```{r articles_head, message = FALSE}
articles %>%
  head(5) %>%
  kbl() %>%
  kable_material() %>%
  scroll_box(width = "800px", height = "350px")

str(articles, vec.len=1)
```
We find:

1. article_id: article identifier id;
2. product_code: product identifier id;
3. prod_name: product name;
4. product_type_no: product type;
5. product_type_name: product type name;
6. product_group_name: product group name;
7. graphical_appearance_no: number related to graphical apparence;
8. graphical_appearance_name: name related to graphical apparence;
9. colour_group_code: colour group code;
10. colour_group_name: color group name;
11. perceived_colour_value_id: product colour id;
12. perceived_colour_value_name: product colour name;
13. perceived_colour_master_id: ?
14. perceived_colour_master_name: ?
15. department_no: department number;
16. department_name: department name;
17. index_code: index code;
18. index_name: index name;
19. index_group_no: index group number;
20. index_group_name: index group name;
21. section_no: section number;
22. section_name: section name;
23. garment_group_no: garment group number;
24. garment_group_name: garment group name;
25. detail_desc: description of product.

## train
```{r train_head, message = FALSE}
train %>%
  head(5) %>%
  kbl() %>%
  kable_material() %>%
  scroll_box(width = "800px", height = "350px")

str(train, vec.len=1)
```

We find:

1. t_dat: date of purchace;
2. customer_id: customer id;
3. article_id: article id;
4. price: price sold;
5. sales_channel_id: 2 is online and 1 store.

## customers
```{r customers_head, message = FALSE}
customers %>%
  head(5) %>%
  kbl() %>%
  kable_material() %>%
  scroll_box(width = "800px", height = "350px")

str(customers, vec.len=1)
```

We find:

1. customer_id: customer id;
2. FN: FN is if a customer get Fashion News newsletter;
3. Active: if the customer is active for communication;
4. club_member_status: if customer is a club member;
5. fashion_news_frequency: frequency which customer gets FN;
6. age: age;
7. postal_code: postal code;

## submission
```{r submission_head, message = FALSE}
submission %>%
  head(5) %>%
  kbl() %>%
  kable_material()

str(submission, vec.len=1)
```

We find:

1. customer_id: customer id;
2. prediction: output of recommendation model.


# Initial Exploratory Data Analysis

In this section I'll be tinkering with data in order to understand and visualize key concepts behind some variables.

## EDA data
Here I'll join all data into train data. And plot it's head. To navigate on this window, press shift + mouse scroll.

```{r joining, message = FALSE}
eda_data <- articles[,
    c(
    'article_id',
    'product_code',
    'prod_name',
    #'product_type_no',
    'product_type_name',
    'product_group_name',
    #'graphical_appearance_no',
    'graphical_appearance_name',
    #'colour_group_code',
    'colour_group_name',
    #'perceived_colour_value_id',
    'perceived_colour_value_name',
    #'perceived_colour_master_id',
    'perceived_colour_master_name',
    #'department_no',
    'department_name',
    #'index_code',
    'index_name',
    #'index_group_no',
    'index_group_name',
    #'section_no',
    'section_name',
    #'garment_group_no',
    'garment_group_name',
    'detail_desc'
  )
]

eda_data <- merge(
  train,
  eda_data,
  by = 'article_id',
  how = 'left'
)

eda_data <- merge(
  eda_data,
  customers,
  by = 'customer_id',
  how = 'left'
)

eda_text <- eda_data[
  ,
  c(
    'prod_name',
    'detail_desc'
  )
]

eda_data[, detail_desc := NULL]
eda_data[, sales_channel_id := ifelse(sales_channel_id == 1, "Store", "Online")]
eda_data[, sales_channel_id := as.factor(sales_channel_id)]

rm(
  train,
  customers,
  articles,
  submission
)
invisible(gc())

eda_data %>%
  head(5) %>%
  kbl() %>%
  kable_material() %>%
  scroll_box(width = "800px", height = "350px")

```

## General insights. (Data description)

```{r describing, response=FALSE}
response = data.table()
for (column in names(eda_data)){
  has_null = eda_data[, any(is.na(get(column)))]
  unique_count <- eda_data[, length(unique(get(column)))]
  values_count <- eda_data[, sum(!is.na(get(column)))]
  missing_values_count <- eda_data[, sum(is.na(get(column)))]
  temp <- data.table(column, has_null, unique_count, values_count, missing_values_count)
  response = rbind(response, temp)
  rm(temp)
}

invisible(gc())

names(response) = c('Column', 'Has Null Values', 'Count of unique values', 'Total values', 'Total Missing values')

response %>%
  kbl() %>%
  kable_material() %>%
  scroll_box(width = "800px", height = "400px")
rm(response)

```
We find that:

- Some ages are missing.
- Some values in FN and Active are missing. It could be the case for inputing some values in these columns, but it makes sense to leave it as missing. Maybe we can't affirm for sure that this customer is active for communication. Or if he is subscribed to a Fashion Newsletter. I'll return here in case someone find something interesting about this.

## Visual Overview:

### Barplot - Sales Channel

```{r sales_channel_plot,fig.cap ="Fig. 1"}
gg <- eda_data %>% 
  ggplot(aes(sales_channel_id)) +
  geom_bar(position = position_dodge(), fill="steelblue") +
  theme_hc() +
  labs(x = "sales_channel_id", title = "Number of entries in data for each purchase") +
  scale_x_discrete() +
  scale_y_continuous(labels = scales::comma)

ggplotly(gg, width = 800, height = 550)
rm(list=setdiff(ls(), c("eda_data", "eda_text")))
invisible(gc())
```
We find that:

- Online is the main channel for selling products in this data.

### Barplot - Club member status

```{r club_member_plot,fig.cap ="Fig. 2"}
gg <- eda_data %>% 
  ggplot(aes(club_member_status)) +
  geom_bar(position = position_dodge(), fill="steelblue") +
  theme_hc() +
  labs(x = "club_member_status", title = "Number of entries in data for each purchase") +
  scale_x_discrete() +
  scale_y_continuous(labels = scales::comma)

ggplotly(gg, width = 800, height = 550)
rm(list=setdiff(ls(), c("eda_data", "eda_text")))
invisible(gc())
```
We find that:

- Most of customers are active club members.
- There is no data of customers that left a club membership and bought something during train data.
- There are some redundant data entries.

### Barplot - Fashion news frequency

```{r fashion_news_frequency_plot,fig.cap ="Fig. 3"}
gg <- eda_data %>% 
  ggplot(aes(fashion_news_frequency)) +
  geom_bar(position = position_dodge(), fill="steelblue") +
  theme_hc() +
  labs(x = "fashion_news_frequency", title = "Number of entries in data for each purchase") +
  scale_x_discrete() +
  scale_y_continuous(labels = scales::comma)

ggplotly(gg, width = 800, height = 550)
rm(list=setdiff(ls(), c("eda_data", "eda_text")))
invisible(gc())
```
We find that:

- There are some redundant data entries.
- Most of these customers regularly check fashion news.

### Barplot - Product group name

```{r product_name_plot, fig.cap ="Fig. 4"}
gg <- eda_data %>% 
  ggplot(aes(product_group_name, fill=product_group_name)) +
  geom_bar(position = position_dodge()) +
  theme_hc() +
  labs(title = "Number of entries in data for each purchase") +
  scale_x_discrete() +
  scale_y_continuous(labels = scales::comma) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size=8))

ggplotly(gg, width = 800, height = 550)
rm(list=setdiff(ls(), c("eda_data", "eda_text")))
invisible(gc())

```
As we are exploring over train data, it makes sense that some groups weren't sold during training period. Also, we find that:

- Garment upper and lower body are top sellers during test data.

### Barplot - Index name

```{r index_name_plot, fig.cap ="Fig. 5"}
gg <- eda_data %>% 
  ggplot(aes(index_name, fill=index_name)) +
  geom_bar(position = position_dodge()) +
  theme_hc() +
  labs(title = "Number of entries in data for each purchase") +
  scale_x_discrete() +
  scale_y_continuous(labels = scales::comma) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size=8))

ggplotly(gg, width = 800, height = 550)
rm(list=setdiff(ls(), c("eda_data", "eda_text")))
invisible(gc())

```
We find that:

- Ladieswear is the most popular category in index name during train data, followed by divided and Lingeries/Tights.


```{r garment_group_name_plot, fig.cap ="Fig. 6"}
gg <- eda_data %>% 
  ggplot(aes(garment_group_name, fill=garment_group_name)) +
  geom_bar(position = position_dodge()) +
  theme_hc() +
  labs(title = "Number of entries in data for each purchase") +
  scale_x_discrete() +
  scale_y_continuous(labels = scales::comma) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size=8))

ggplotly(gg, width = 800, height = 550)
rm(list=setdiff(ls(), c("eda_data", "eda_text")))
invisible(gc())

```
We find that:

- Jerseys and accessories are the most popular garment, although categories seem more distributed in this variable.

### Histogram - Age distribution

```{r, warning=FALSE,  fig.cap ="Fig. 7"}
mean_value <- eda_data[, mean(age, na.rm=TRUE)]

gg <- eda_data %>% 
  ggplot(aes(age)) +
  geom_histogram(position = "identity", binwidth=.5, fill = "steelblue") +
  theme_hc() +
  labs(title = "Age histogram", y="") +
  scale_x_continuous() +
  geom_vline(xintercept = mean_value,
                 color = "gray", linetype = "dashed", size = 1)
ggplotly(gg, width = 800, height = 550)

rm(list=setdiff(ls(), c("eda_data", "eda_text")))
invisible(gc())

```


We find that:

- Age mean looks like a center in values, but it is not where most values are found.
- Most customers are in theirs 23-27 in the most common age range, and in the second most are those in theirs 48-53 age range.

# Transactions sale.

## Density plot for price by channel id
Sampling code below
```{r sampling, message=FALSE}

set.seed(42)
eda_data_samples <- copy(eda_data[,.(price, sales_channel_id, t_dat)] %>%
                        sample_n(100000))

rm(list=setdiff(ls(), c("eda_data", "eda_text", "eda_data_samples")))
invisible(gc())

```
*Note*: It's nearly impossible to plot all data without having some bad memory allocation problems, with that in mind, I'll be sampling data and analyzing over it. 

*(100k observations, 8.3% of all data)*
```{r density_prices_plot, warning=FALSE,  fig.cap ="Fig. 8"}

gg <- eda_data_samples %>%
  ggplot(aes(x=log1p(price), group=sales_channel_id, fill=sales_channel_id)) +
  geom_density(alpha=.35) +
  theme_hc() +
  labs(title = "Distribution of price by channel id", y="Density", x="Logarithmized price value") +
  scale_x_continuous(limits = c(0, 0.1)) +
  NULL

ggplotly(gg, width = 800, height = 550)


rm(list=setdiff(ls(), c("eda_data", "eda_text", "eda_data_samples")))
invisible(gc())
```
We find that:

- It seems that online shopping tends to have higher prices than in store prices. Also, as we have seem before, there is a higher concentration of purchases in online channel.

## Transactions per day of week
Actually it is a simple frequency plot, but as it's transaction data I'll leave it here.
```{r frequency_sold_dow_plot, warning=FALSE,  fig.cap ="Fig. 9"}
eda_data[, t_dat := as.Date(t_dat)]
eda_data[, dow := weekdays(t_dat)]

gg <- eda_data %>%
  ggplot(aes(factor(dow, level = c(
    "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")))) +
  geom_bar(position = position_dodge()) +
  geom_bar(aes(fill = sales_channel_id)) +
  theme_hc() +
  labs(title = "Distribution of price by channel id", y="Entries", x="Day of Week") +
  scale_x_discrete() +
  scale_y_continuous(labels = scales::comma)

ggplotly(gg, width = 800, height = 550)


rm(list=setdiff(ls(), c("eda_data", "eda_text", "eda_data_samples")))
invisible(gc())
```

# String column analysis
This section in dedicated to generate insights on the most purchase related character in two columns. Again, I'll be sampling in order to avoid bad memory allocation.
```{r sampling_text_eda, message=FALSE}
eda_text_samples <- copy(eda_text %>%
                        sample_n(50000))

rm(list=setdiff(ls(), c("eda_text_samples")))
invisible(gc())
```
## Wordcloud: description column

```{r wordcloud1, warning=FALSE, fig.cap ="Fig. 10, 50k sample"}
docs <- Corpus(VectorSource(eda_text_samples$detail_desc))

# Convert the text to lower case
docs <- tm_map(docs, content_transformer(tolower))

# Remove numbers
docs <- tm_map(docs, removeNumbers)

# Remove english common stopwords
docs <- tm_map(docs, removeWords, stopwords("english"))

# Remove punctuations
docs <- tm_map(docs, removePunctuation)

# Eliminate extra white spaces
docs <- tm_map(docs, stripWhitespace)

#Stemming document
docs <- tm_map(docs, stemDocument)

dtm <- TermDocumentMatrix(docs)
v <- sort(rowSums(as.matrix(dtm)), decreasing=TRUE)
dt <- data.table(word = names(v),freq=v)

#Note: seed was set in above code chunks
wordcloud(words = dt$word, freq = dt$freq, min.freq = 500,
          max.words=200, random.order=FALSE, rot.per=0.35, 
          colors=brewer.pal(8, "Dark2"))

rm(list=setdiff(ls(), c("eda_text_samples")))
invisible(gc())
```

## Wordcloud: Prod name

```{r wordcloud2, warning=FALSE, fig.cap ="Fig. 11, 50k sample"}
rm(list=setdiff(ls(), c("eda_text_samples")))
invisible(gc())



docs <- Corpus(VectorSource(eda_text_samples$prod_name))

# Convert the text to lower case
docs <- tm_map(docs, content_transformer(tolower))

# Remove numbers
docs <- tm_map(docs, removeNumbers)

# Remove english common stopwords
docs <- tm_map(docs, removeWords, stopwords("english"))

# Remove punctuations
docs <- tm_map(docs, removePunctuation)

# Eliminate extra white spaces
docs <- tm_map(docs, stripWhitespace)

#Stemming document
docs <- tm_map(docs, stemDocument)

invisible(gc())

dtm <- TermDocumentMatrix(docs)
v <- sort(rowSums(as.matrix(dtm)), decreasing=TRUE)
dt <- data.table(word = names(v),freq=v)

invisible(gc()) # Kaggle has some serious problems dealing with this part.

#Note: seed was set in above code chunks
wordcloud(words = dt$word, freq = dt$freq, min.freq = 100,
          max.words=200, random.order=FALSE, rot.per=0.35, 
          colors=brewer.pal(8, "Dark2"))

```
Those last plots are without comments as there is really nothing much to say. There are some most common words that are interesting to see in this kind of visualization. 

note: I had so many troubles with memory in this (huge) dataset, that I don't think there is much to do without having to work with (minimal) sampled data. If you think something is missing in this report, feel free to comment!
                                   
**If you liked this report, or if it was useful for you somehow, please upvote!**