---
title: "Elo Merchant Category Recommendation"
author: "Bruce Wayne"
date: "Jan 09, 2019"
output:
  html_document:
    fig_height: 4
    fig_width: 8
    theme: cosmo
    highlight: tango
    number_sections: true
    fig_caption: true
    toc: true
---

#Introduction

The purpose of this kernel is to provide an exploratory data analysis using R (there are too many python kernels out there) and to build a preliminary model. The following is version 1 of the notebook so it is still in a very raw form. Please upvote if you like this kernel

Loading the Libararies
```{r loadlib, message=FALSE, warning=FALSE, results='hide'}
library(data.table)
library(dplyr)
library(lubridate)
library(caret)
library(plyr)
library(ggplot2)
library(tibble)
library(gridExtra)
```

Loading the functions
```{r functions, message=FALSE, warning=FALSE,}
#Function to change index to column
index_to_col <- function(data, Column_Name){
          data <- cbind(newColName = rownames(data), data)
          rownames(data) <- 1:nrow(data)
          colnames(data)[1] <- Column_Name
          return (data)
}

#Missing Values Functions
missing_values <- function(data){
  mv <- as.data.frame(apply(data, 2, function(col)sum(is.na(col))/length(col)))
  colnames(mv)[1] <- "missing_values"
  mv <- index_to_col(mv,'Column')
  mv <- setDT(mv)[order (missing_values, decreasing = TRUE)]
}

#Loading all the plotting functions
plotHist <- function(data_in, i) {
  data <- data.frame(x=data_in[[i]])
  p <- ggplot(data=data, aes(x=x)) + geom_histogram(bins=100, fill="#0072B2", alpha = .9) + xlab(colnames(data_in)[i]) + theme_light() + 
    theme(axis.text.x = element_text(angle = 90, hjust =1))
  return (p)
}

plotBar <- function(data_in, i) {
  data <- data.frame(x=data_in[[i]])
  p <- ggplot(data=data, aes(x=x)) + geom_bar(fill="steelblue",color = 'black') + xlab(colnames(data_in)[i]) + theme_light() + theme(axis.text.x = element_text(angle = 90, hjust =1))
  return (p)
}

plotCorr <- function(data_in, list1,list2,i){
  data <- data.frame(x = data_in[[list1[i]]], y = data_in[[list2[i]]])
  p <- ggplot(data, aes(x = x, y = y)) + geom_smooth(method = lm ) + geom_point(aes(x = x, y = y)) +
  geom_jitter(width = 0.1, height = 0.1)  + xlab(paste0(list1[i], '\n', 'R-Squared: ', round(cor(data_in[[list1[i]]], data_in[[list2[i]]], use = 'pairwise.complete.obs'), 3))) + theme_light() + ylab(paste0(list2[i]))
  return(suppressWarnings(p))
}

doPlotsCorr <- function(data_in, fun, list1,list2,ii, ncol=3) {
  pp <- list()
  for (i in ii) {
    p <- fun(data_in=data_in, list1,list2,i=i)
    pp <- c(pp, list(p))
  }
  do.call("grid.arrange", c(pp, ncol=ncol))
}

plotDen <- function(data_in, i) {
  data <- data.frame(x=data_in[[i]])
  p <- ggplot(data=data, aes(x=x)) + geom_density(aes(group=as.factor(dt1_tran$TARGET),color=as.factor(dt1_tran$TARGET),fill=as.factor(dt1_tran$TARGET), alpha=0.2)) + xlab(colnames(data_in)[i]) + theme_light() + 
    theme(axis.text.x = element_text(angle = 90, hjust =1)) + theme(legend.position='none')
  return (p)
}

doPlots <- function(data_in, fun, ii, ncol=3) {
  pp <- list()
  for (i in ii) {
    p <- fun(data_in=data_in, i=i)
    pp <- c(pp, list(p))
  }
  do.call("grid.arrange", c(pp, ncol=ncol))
}

```

Loading the data
```{r loaddata, message=FALSE, warning=FALSE,}
tr <- fread("../input/train.csv")
te <- fread("../input/test.csv")
htrans <- fread("../input/historical_transactions.csv") 
ntrans <- fread("../input/new_merchant_transactions.csv")
merchants <- fread("../input/merchants.csv")
subm <- fread("../input/sample_submission.csv")
```

#Preview of the data

Looking at the variables and dimensions in each of the tables

```{r glimpse}
glimpse(tr)
glimpse(te)
glimpse(htrans)
glimpse(ntrans)
glimpse(merchants)
```

Changing date fields from char to date format

```{r}
htrans$purchase_date <- ymd_hms(htrans$purchase_date)
```

#Target Variable

Lets first look at the distribution of the target variable. Seems like there is an outlier. We will look into it more going forward

```{r, message=FALSE, warning=FALSE,}
ggplot(data=tr, aes(x=target)) + geom_histogram(color = 'black', fill = 'steelblue') + theme_bw()
```

Lets look at all the numeric variables in the train dataset

```{r train, fig.height = 7, fig.width = 10, message=FALSE, warning=FALSE,}
doPlots(tr, plotHist, 3:6)
```

```{r test, fig.height = 4, fig.width = 10, message=FALSE, warning=FALSE,}
doPlots(te, plotHist, 3:5)
```

#Historical Transactions dataset

Lets look at the features of the historical transactions dataset

Selecting a sample size for the dataset

```{r}
samplesize <- 0.50
```

```{r, message=FALSE, warning=FALSE,}
mv <- missing_values(setDT(htrans)[sample(nrow(htrans), round(nrow(htrans)*samplesize,0)),])

ggplot (mv[1:10,], aes (reorder(Column, missing_values), missing_values)) + geom_bar (position = position_dodge(), stat = "identity", color = 'black', fill = 'steelblue') + coord_flip () + xlab('Columns') + ylab('Missing Value %') + theme_classic()
```

**Findings:**There are not many variables with missing values. We can remove the rows which have missing values for now.

```{r, message=FALSE, warning=FALSE,}
numeric_list <- unlist(lapply(htrans, is.numeric))
htrans_num <- setDT(htrans)[sample(nrow(htrans), round(nrow(htrans)*samplesize,0)),][,..numeric_list]

doPlots(htrans_num, plotHist, 1:ncol(htrans_num))
ggplot(data=htrans_num, aes(x=log(purchase_amount))) + geom_histogram(color = 'black', fill = 'steelblue') + theme_bw()

htrans_num[,. (count = .N), by = merchant_category_id][order (-count)][1:5,]
htrans_num[,. (count = .N), by = city_id][order (-count)][1:5,]
```

**Findings:** There is a spike on the city_id, merchant category id and state id. Also in city_id there is a peak that is referred to as -1. My guess is that these were originally NAs

```{r, message=FALSE, warning=FALSE,}
non_numeric_list <- unlist(lapply(htrans, is.character))
htrans_non_num <- setDT(htrans)[sample(nrow(htrans_num), round(nrow(htrans_num)*samplesize,0)),][,..non_numeric_list]

sapply(htrans_non_num, uniqueN)
unique_var <- as.data.frame(sapply(htrans_non_num, uniqueN))
colnames(unique_var)[1] <- "Counts"
unique_var <- index_to_col(unique_var,'Variable')
unique_col <- setDT(unique_var)[Counts <=10]$Variable

htrans_non_num <- htrans_non_num[,..unique_col]

doPlots(htrans_non_num, plotBar, 1:ncol(htrans_non_num))
```

Looking at the date features for the table

```{r ,fig.height = 7, fig.width = 10}
date_list <- c('purchase_date')
htrans_date_sample <- setDT(htrans)[sample(nrow(htrans_num), round(nrow(htrans_num)*samplesize,0)),][,..date_list]
htrans_date_sample$purchase_date <- ymd_hms(htrans_date_sample$purchase_date)
htrans_date_sample$year <- format(htrans_date_sample$purchase_date, "%Y")
htrans_date_sample$month <- format(htrans_date_sample$purchase_date, "%m")
htrans_date_sample$day <- format(htrans_date_sample$purchase_date, "%d")
htrans_date_sample$Weekday <- weekdays(as.Date(format(htrans_date_sample$purchase_date, "%Y/%m/%d")))
doPlots(htrans_date_sample, plotBar, 2:ncol(htrans_date_sample))
```

#New Transactions dataset

Running the same analysis for the new merchants

```{r, message=FALSE, warning=FALSE,}
mv <- missing_values(setDT(ntrans)[sample(nrow(ntrans), round(nrow(ntrans)*samplesize,0)),])

ggplot (mv[1:10,], aes (reorder(Column, missing_values), missing_values)) + geom_bar (position = position_dodge(), stat = "identity", color = 'black', fill = 'steelblue') + coord_flip () + xlab('Columns') + ylab('Missing Value %') + theme_classic()
```

**Findings:** There are not many variables with missing values. We can remove the rows which have missing values for now.

```{r, message=FALSE, warning=FALSE,}
numeric_list <- unlist(lapply(ntrans, is.numeric))
ntrans_num <- setDT(ntrans)[sample(nrow(ntrans), round(nrow(ntrans)*samplesize,0)),][,..numeric_list]

doPlots(ntrans_num, plotHist, 1:ncol(ntrans_num))
ggplot(data=ntrans_num, aes(x=log(purchase_amount))) + geom_histogram(color = 'black', fill = 'steelblue') + theme_bw()

ntrans_num[,. (count = .N), by = merchant_category_id][order (-count)][1:5,]
ntrans_num[,. (count = .N), by = city_id][order (-count)][1:5,]
```

**Findings:** There is a spike on the city_id and state id but the merchant category id does not show the same peak as in the htrans dataset

```{r, message=FALSE, warning=FALSE,}
non_numeric_list <- unlist(lapply(ntrans, is.character))
ntrans_non_num <- setDT(ntrans)[sample(nrow(ntrans_num), round(nrow(ntrans_num)*samplesize,0)),][,..non_numeric_list]

sapply(ntrans_non_num, uniqueN)
unique_var <- as.data.frame(sapply(ntrans_non_num, uniqueN))
colnames(unique_var)[1] <- "Counts"
unique_var <- index_to_col(unique_var,'Variable')
unique_col <- setDT(unique_var)[Counts <=10]$Variable

ntrans_non_num <- ntrans_non_num[,..unique_col]

doPlots(ntrans_non_num, plotBar, 1:ncol(ntrans_non_num))
```

Looking at the date features for the table

```{r, fig.height = 7, fig.width = 10}
date_list <- c('purchase_date')
ntrans_date_sample <- setDT(ntrans)[sample(nrow(ntrans_num), round(nrow(ntrans_num)*samplesize,0)),][,..date_list]
ntrans_date_sample$purchase_date <- ymd_hms(ntrans_date_sample$purchase_date)
ntrans_date_sample$year <- format(ntrans_date_sample$purchase_date, "%Y")
ntrans_date_sample$month <- format(ntrans_date_sample$purchase_date, "%m")
ntrans_date_sample$day <- format(ntrans_date_sample$purchase_date, "%d")
ntrans_date_sample$Weekday <- weekdays(as.Date(format(ntrans_date_sample$purchase_date, "%Y/%m/%d")))
doPlots(ntrans_date_sample, plotBar, 2:ncol(ntrans_date_sample))
```

#Merchants dataset

Running the same analysis for the merchants dataset

```{r, message=FALSE, warning=FALSE,}
mv <- missing_values(setDT(merchants)[sample(nrow(merchants), round(nrow(merchants)*samplesize,0)),])

ggplot (mv[1:10,], aes (reorder(Column, missing_values), missing_values)) + geom_bar (position = position_dodge(), stat = "identity", color = 'black', fill = 'steelblue') + coord_flip () + xlab('Columns') + ylab('Missing Value %') + theme_classic()
```

**Findings:**There are not many variables with missing values. We can remove the rows which have missing values for now.

```{r fig.height = 15, fig.width = 10, message=FALSE, warning=FALSE,}
numeric_list <- unlist(lapply(merchants, is.numeric))
merchants_num <- setDT(merchants)[sample(nrow(merchants), round(nrow(merchants)*samplesize,0)),][,..numeric_list]

doPlots(merchants_num, plotHist, 1:ncol(merchants_num))
```

It looks like there are a lot of variables with extreme values. I am going to try BoxCox transformation to see if it automatically picks the variables which I need to transform

```{r, message=FALSE, warning=FALSE,}
merchants_num[is.na(merchants_num)] <- 0
sapply(merchants_num, function(x) sum(is.infinite(x)))
merchants_num <- do.call(data.frame,lapply(merchants_num, function(x) replace(x, is.infinite(x),NA)))
sapply(merchants_num, function(x) sum(is.infinite(x)))
preProcValues <- preProcess(merchants_num, method = "BoxCox")
cols_preProc <- preProcValues$method$BoxCox
merchants_num <- predict(preProcValues, merchants_num)
setDT(merchants_num)
doPlots(merchants_num[,..cols_preProc], plotHist, 1:ncol(merchants_num[,..cols_preProc]))
```

**Findings:** Seems like the Box-Cox transformation did not work for all the variables. I would have to transform the variables manually

```{r, message=FALSE, warning=FALSE,}
non_numeric_list <- unlist(lapply(merchants, is.character))
merchants_non_num <- setDT(merchants)[sample(nrow(merchants_num), round(nrow(merchants_num)*samplesize,0)),][,..non_numeric_list]

sapply(merchants_non_num, uniqueN)
unique_var <- as.data.frame(sapply(merchants_non_num, uniqueN))
colnames(unique_var)[1] <- "Counts"
unique_var <- index_to_col(unique_var,'Variable')
unique_col <- setDT(unique_var)[Counts <=10]$Variable

merchants_non_num <- merchants_non_num[,..unique_col]

doPlots(merchants_non_num, plotBar, 1:ncol(merchants_non_num))
```

More to come.....

1) Feature Engineering
2) Preliminary Model