--- title: 'Should I stay or should I go? - KKBox EDA' 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=FALSE) ``` # Introduction This is an initial Exploratory Data Analysis for the [WSDM - KKBox's Churn Prediction Challenge](https://www.kaggle.com/c/kkbox-churn-prediction-challenge) with [tidy R](http://tidyverse.org/) and [ggplot2](http://ggplot2.tidyverse.org/). The aim of this challenge is to predict whether a user of the music streaming service [KKBox](https://www.kkbox.com/) will "churn", i.e. leave this subscription-based service, by analysing the user's behaviour on the website. The [data](https://www.kaggle.com/c/kkbox-churn-prediction-challenge/data) comes in the shape of *five* different files. Four of them contain the user IDs and properties: - In `train.csv` we find the IDs and whether these users have churned or not. - `transactions.csv` gives us details like *payment method* or whether the subscription was cancelled. - `user_logs.csv` contains the listening behaviour of a user in terms of number of songs played. - `members.csv` includes the user's age, city, and such for users that have these membership information. Finally, `sample_submission_zero.csv` serves as the *test* data set for the users for which we are tasked to predict their behaviour. Some of these files are large, with a maximum of about 6.65 GB for the *user\_logs* data in a compressed form. ## Load libraries and helper functions ```{r, message = FALSE} # general visualisation library('ggplot2') # visualisation library('scales') # visualisation library('grid') # visualisation library('gridExtra') # visualisation library('RColorBrewer') # visualisation library('corrplot') # visualisation # general data manipulation library('dplyr') # data manipulation library('readr') # input/output library('data.table') # data manipulation library('tibble') # data wrangling library('tidyr') # data wrangling library('stringr') # string manipulation library('forcats') # factor manipulation # Dates library('lubridate') # date and time # Extra vis library('ggforce') # visualisation ``` We use the *multiplot* function, courtesy of [R Cookbooks](http://www.cookbook-r.com/Graphs/Multiple_graphs_on_one_page_(ggplot2)/) to create multi-panel plots. ```{r} # Define multiple plot function # # ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects) # - cols: Number of columns in layout # - layout: A matrix specifying the layout. If present, 'cols' is ignored. # # If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE), # then plot 1 will go in the upper left, 2 will go in the upper right, and # 3 will go all the way across the bottom. # multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) { # Make a list from the ... arguments and plotlist plots <- c(list(...), plotlist) numPlots = length(plots) # If layout is NULL, then use 'cols' to determine layout if (is.null(layout)) { # Make the panel # ncol: Number of columns of plots # nrow: Number of rows needed, calculated from # of cols layout <- matrix(seq(1, cols * ceiling(numPlots/cols)), ncol = cols, nrow = ceiling(numPlots/cols)) } if (numPlots==1) { print(plots[[1]]) } else { # Set up the page grid.newpage() pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout)))) # Make each plot, in the correct location for (i in 1:numPlots) { # Get the i,j matrix positions of the regions that contain this subplot matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE)) print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col)) } } } ``` ## Load data We use *data.table's* fread function to speed up reading in the data: ```{r warning=FALSE, results=FALSE} train <- as.tibble(fread('../input/train.csv')) test <- as.tibble(fread('../input/sample_submission_zero.csv')) members <- as.tibble(fread('../input/members.csv')) #logs <- as.tibble(fread('../input/user_logs')) ``` ## File structure and content First, we will have an overview of the data sets using the *summary* and *glimpse* tools. First the training data: ```{r} summary(train) ``` ```{r} glimpse(train) ``` We find that *is\_churn* is given as an integer that's either zero or one. It might make sense to choose a different encoding here. The user IDs are rather long character strings. Then the *members* data: ```{r} summary(members) ``` ```{r} glimpse(members) ``` We find: - In total 21 *Cities* are encoded by integers (there's no "2"). A factor encoding would make more sense here. - The *bd* feature is the age of the user (according to the [data description](https://www.kaggle.com/c/kkbox-churn-prediction-challenge/data)) and contains clear outliers. - The *gender* is given by a character string and appears to contain quite a lot of missing entries. - *Registered\_via* is a registration method that can probably also be factor encoded. The minimum is 3 and the maximum is 16. Both features contain values that lie well outside our prediction range. - The *registration_init_time* and *expiration_date* are date columns that should be encoded accordingly. ## Missing values ```{r} sum(is.na(train)) sum(is.na(members)) ``` ## Reformating features ```{r} train <- train %>% mutate(is_churn = factor(is_churn)) members <- members %>% mutate(city = factor(city), gender = factor(gender), reg_via = factor(registered_via), reg_init = ymd(registration_init_time), reg_exp = ymd(expiration_date)) ``` # Individual feature visualisations In a first step, we look at the various data sets individually. Of course, all the data is related and we will study these relations afterwards. But first things first. ## Train and Members data ```{r split=FALSE, fig.align = 'default', warning = FALSE, fig.cap ="Fig. 1", out.width="100%"} p1 <- train %>% ggplot(aes(is_churn, fill = is_churn)) + geom_bar() + theme(legend.position = "none") p2 <- members %>% ggplot(aes(gender, fill = gender)) + geom_bar() + theme(legend.position = "none") p3 <- members %>% ggplot(aes(reg_via, fill = reg_via)) + geom_bar() + theme(legend.position = "none") + scale_y_sqrt() p4 <- members %>% ggplot(aes(city, fill = city)) + geom_bar() + theme(legend.position = "none") + scale_y_sqrt() p5 <- members %>% filter(bd > 0 & bd < 100) %>% ggplot(aes(bd)) + geom_density(fill = "red", bw = 1) layout <- matrix(c(1,1,2,2,3,3,4,4,4,5,5,5),2,6,byrow=TRUE) multiplot(p1, p2, p3, p4, p5, layout=layout) ``` We find: - The vast majority of users didn't churn: ```{r} train %>% group_by(is_churn) %>% summarise(percentage = n()/nrow(train)*100) ``` Only about 6% of users seemed to have left. This looks quite successful, but it also makes for a rather imbalanced classification problem. - The clear majority of users did not provide information on their *gender*. Those who did are pretty evenly split with just a sligthly higher percentage of "male" over "female" users: ```{r} members %>% count(gender) ``` - There are 7 different *registration_via* methods that can be classified in 3 groups (note the square-root axis): method "4" is clearly the most frequent one. Methods "3", "7", and "9" have similar frequencies that are still high. Methods "10", "13", and "16" are not particularly popular. - Of the 21 cities, number "1" is where most users live. Everything else is similarly unpopular. - The age distribution (*bd*), after restricted to sensible values, rises quickly among teenagers and peaks among young adults. Above 25, it declines gradually down toward 60-70. Looking at the *dates of initial registration* we see the following: ```{r split=FALSE, fig.align = 'default', warning = FALSE, fig.cap ="Fig. 2", out.width="100%"} members %>% ggplot(aes(reg_init)) + geom_freqpoly(color = "dark green", binwidth = 1) ``` After a slow start popularity started rising slowly after 2010 and increased strongly after 2015. The last year or two, thogh, have seen a drop in new initial registrations. The time series of the subscription *expiration dates* is a bit odd: ```{r split=FALSE, fig.align = 'default', warning = FALSE, fig.cap ="Fig. 3", out.width="100%"} members %>% ggplot(aes(reg_exp)) + geom_freqpoly(color = "red", binwidth = 5) + facet_zoom(x = (reg_exp > ymd("20140901") & reg_exp < ymd("20180301"))) ``` Ranging originally from 1970 to 2100, we see more of an interesting pattern over the last couple of year until the end of 2018. --- To be continued.