Retail churn.Rmd

---
title: "Modelling Customer Churn When Churns are not Explicitly Observed"
output: html_document
editor_options: 
  chunk_output_type: console
---

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

```{r}
options(java.parameters = "-Xmx8000m")
```


```{r}
library(tidyverse)
library(lubridate)
library(XLConnect)
library(dplyr)
library(ggplot2)
theme_set(theme_minimal())
```

```{r}
raw.data <- readWorksheet(loadWorkbook("Online_Retail.xlsx"), sheet=1)
```

```{r}
data <- raw.data
```

```{r}
data$Total <- data$Quantity * data$UnitPrice
```


```{r}
txns <- data %>% 
  mutate(CustomerID = as.factor(CustomerID),
         InvoiceDate = InvoiceDate) %>%
  group_by(CustomerID, InvoiceNo, InvoiceDate) %>% 
  summarise(Spend = sum(Total)) %>%
  ungroup() %>% 
  filter(Spend>0)
```

```{r}
time_between <- txns %>% 
  arrange(CustomerID, InvoiceDate) %>% 
  group_by(CustomerID) %>% 
  mutate(dt = as.numeric(InvoiceDate - lag(InvoiceDate), unit=  'days')) %>% 
  ungroup() %>% 
  na.omit()
```

```{r}
Ntrans = txns %>% 
  group_by(CustomerID) %>% 
  summarise(N = n()) %>%
  filter(N>20)
```

```{r}
sample_n_groups = function(tbl, size, replace = FALSE, weight = NULL) {
  grps = tbl %>% groups %>% lapply(as.character) %>% unlist
  keep = tbl %>% summarise() %>% ungroup() %>% sample_n(size, replace, weight)
  tbl %>% right_join(keep, by=grps) %>% group_by_(.dots = grps)
}
```

```{r}
ecdf_df <- time_between %>% group_by(CustomerID) %>% arrange(dt) %>% mutate(e_cdf = 1:length(dt)/length(dt))
sample_users <- ecdf_df %>% inner_join(Ntrans) %>% sample_n_groups(20)

ggplot(data = time_between %>% inner_join(Ntrans) %>% filter(CustomerID %in% sample_users$CustomerID), aes(dt)) + 
  geom_histogram(aes(y = ..count../sum(..count..)), bins = 15) + 
  facet_wrap(~CustomerID) +
  labs(x = 'Time Since Last Purchase (Days)',y = 'Frequency')
```

```{r}
ggplot(data = ecdf_df %>% inner_join(Ntrans) %>% filter(CustomerID %in% sample_users$CustomerID), aes(dt,e_cdf) ) + 
  geom_point(size =0.5) +
  geom_line() + 
  geom_hline(yintercept = 0.9, color = 'red') + 
  facet_wrap(~CustomerID) +
  labs(x = 'Time Since Last Purchase (Days)')
```

```{r}
getq <- function(x,a = 0.9){
  
  #Little function to get the alphath quantile
  if(a>1|a<0){
    print('Check your quantile')
  }
  
  X <- sort(x)
  
  e_cdf <- 1:length(X) / length(X)
  
  aprx = approx(e_cdf, X, xout = c(0.9)) #use linear interpolation to approx 90th percentile
  
  return(aprx$y)
}
```

```{r}
quantiles = time_between %>% 
  inner_join(Ntrans) %>% 
  filter(N>5) %>% 
  group_by(CustomerID) %>% 
  summarise(percentile.90= getq(dt)) %>% 
  arrange(percentile.90)
```

```{r}
quantiles[ which(quantiles$CustomerID==12748), ]
```

```{r}
this_customer<- txns[ which(txns$CustomerID==12748), ]
```

```{r}
quantiles[ which(quantiles$CustomerID==13102), ]
```

```{r}
that_customer <- txns[ which(txns$CustomerID==13102), ]
```

```{r}
head(quantiles,10)
```