CREATING A DECISION TREE FOR CLASSIFICATION MODEL AND VALIDATING USING CONFUSION MATRIX

GIRI PRASATH, DINESH KUMAR, MOHAN KUMAR

As an analyst the most important task would be to predict. With the available data, an analyst would come up with a model to predict a response variable. The response variable may not always be quantitative (for example, height or weight of individuals). Sometimes, the response variable is instead qualitative (Female / Male, Yes/No - are an example of a qualitative data).

When we study approaches for predicting qualitative responses, we study classification problems. Classification because, in these situations, we are in fact classifying an observation, and allocating it to a specific class or category (is it Female or Male?, is it Blue, Red or Green?, Is it a Yes or No etc.).

One of the most common requirement in Analytics is to classify a set of customers into categories. One such example is the analysing various demographic, economic, educational status and the payment behaviour of credit customers to predict if they would default the payment next time.

In this example, we will briefly go through one method used for classification type model building – Decision Trees. There are several packages in R that help building decision trees. We have used C50 package here. Adaptive Boosting by increasing no. of trials used to build the tree and validating using confusion matrix is also touched in this article.

Let’s start by loading the necessary packages and downloading the dataset:

Importing the dataset – Credit_card_client- saved as CSV file

getwd()

## [1] "C:/Users/ssn/Desktop"

setwd("E:/GIRI PRASATH - STATS")
retail_data <- read.csv("credit_card_clients.csv",header = TRUE)

Exploring the variables in the dataset

str(retail_data)

## 'data.frame':    30000 obs. of  25 variables:
##  $ ID                        : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ LIMIT_BAL                 : int  20000 120000 90000 50000 50000 50000 500000 100000 140000 20000 ...
##  $ SEX                       : int  2 2 2 2 1 1 1 2 2 1 ...
##  $ EDUCATION                 : int  2 2 2 2 2 1 1 2 3 3 ...
##  $ MARRIAGE                  : int  1 2 2 1 1 2 2 2 1 2 ...
##  $ AGE                       : int  24 26 34 37 57 37 29 23 28 35 ...
##  $ PAY_0                     : int  2 -1 0 0 -1 0 0 0 0 -2 ...
##  $ PAY_2                     : int  2 2 0 0 0 0 0 -1 0 -2 ...
##  $ PAY_3                     : int  -1 0 0 0 -1 0 0 -1 2 -2 ...
##  $ PAY_4                     : int  -1 0 0 0 0 0 0 0 0 -2 ...
##  $ PAY_5                     : int  -2 0 0 0 0 0 0 0 0 -1 ...
##  $ PAY_6                     : int  -2 2 0 0 0 0 0 -1 0 -1 ...
##  $ BILL_AMT1                 : int  3913 2682 29239 46990 8617 64400 367965 11876 11285 0 ...
##  $ BILL_AMT2                 : int  3102 1725 14027 48233 5670 57069 412023 380 14096 0 ...
##  $ BILL_AMT3                 : int  689 2682 13559 49291 35835 57608 445007 601 12108 0 ...
##  $ BILL_AMT4                 : int  0 3272 14331 28314 20940 19394 542653 221 12211 0 ...
##  $ BILL_AMT5                 : int  0 3455 14948 28959 19146 19619 483003 -159 11793 13007 ...
##  $ BILL_AMT6                 : int  0 3261 15549 29547 19131 20024 473944 567 3719 13912 ...
##  $ PAY_AMT1                  : int  0 0 1518 2000 2000 2500 55000 380 3329 0 ...
##  $ PAY_AMT2                  : int  689 1000 1500 2019 36681 1815 40000 601 0 0 ...
##  $ PAY_AMT3                  : int  0 1000 1000 1200 10000 657 38000 0 432 0 ...
##  $ PAY_AMT4                  : int  0 1000 1000 1100 9000 1000 20239 581 1000 13007 ...
##  $ PAY_AMT5                  : int  0 0 1000 1069 689 1000 13750 1687 1000 1122 ...
##  $ PAY_AMT6                  : int  0 2000 5000 1000 679 800 13770 1542 1000 0 ...
##  $ default.payment.next.month: int  1 1 0 0 0 0 0 0 0 0 ...

By Default all the categorical data have been imported by R as numeric data type. To build classification model, required variables are converted into factor data type.

#Changing column to factors
retail_data$SEX<-as.factor(retail_data$SEX)
retail_data$EDUCATION<-as.factor(retail_data$EDUCATION)
retail_data$MARRIAGE<-as.factor(retail_data$MARRIAGE)
retail_data$PAY_0<-as.factor(retail_data$PAY_0)
retail_data$PAY_2<-as.factor(retail_data$PAY_2)
retail_data$PAY_3<-as.factor(retail_data$PAY_3)
retail_data$PAY_4<-as.factor(retail_data$PAY_4)
retail_data$PAY_5<-as.factor(retail_data$PAY_5)
retail_data$PAY_6<-as.factor(retail_data$PAY_6)
retail_data$default.payment.next.month<-as.factor(retail_data$default.payment.next.month)

Exploring the dataset to understand customer segmentation

#pie chart to show customer classification
library(plotrix)
mytable <- table(retail_data$default.payment.next.month)
lbls <- paste(c("Non-defaulters","Defaulters"), "\n", mytable, sep="")
pie3D(mytable, labels = lbls, explode=0.1,
    main="Pie Chart of Customer Classification")

# Subset defaulters and non defaulters

defaulters<-subset(retail_data, default.payment.next.month=='1')
non_defaulters<-subset(retail_data, default.payment.next.month=='0')

# Explore the distribution of defaulters & Non defaulters based on gender(1=Male , 2=female)

table(defaulters$AGE)

##
##  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38
##  14 169 247 300 302 253 313 286 313 274 229 225 215 231 226 254 229 194
##  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56
## 199 187 185 185 150 162 116 157 120 104 119 101  88  78  74  56  57  49
##  57  58  59  60  61  62  63  64  65  66  67  68  69  70  72  73  75
##  27  31  21  23  21   7   8   9   5   7   5   1   3   2   1   3   1

Plotting histogram would bring more clarity in understanding the distribution of age across defaulters and non-defaulters

#distribution of age in each category
colors = c("red", "yellow", "green", "violet", "orange","blue", "pink", "cyan")
hist(defaulters$AGE,  # apply the hist function
     right=FALSE,    # intervals closed on the left
     col=colors,     # set the color palette
     main="Age Distribution of Defaulters", # the main title
     xlab="AGE",  labels=TRUE)   

hist(non_defaulters$AGE,  # apply the hist function
     right=FALSE,    # intervals closed on the left
     col=colors,     # set the color palette
     main="Age Distribution of Non-Defaulters", # the main title
     xlab="AGE", abels=TRUE)

# Explore the distribution of defaulters & Non defaulters based on gender(1=Male , 2=female)

table(defaulters$SEX)

##
##    1    2
## 2873 3763

# Gender distribution in each category
mytable <- table(defaulters$SEX)
lbls <- paste(c("Male","Female"), "\n", mytable, sep="")
pie3D(mytable, labels = lbls, explode=0.1,
      main="Defaulters Classification Based On Gender")

mytable <- table(non_defaulters$SEX)
lbls <- paste(c("Male","Female"), "\n", mytable, sep="")
pie3D(mytable, labels = lbls, explode=0.1,
      main="Non-Defaulters Classification Based On Gender")

With this much of trying to understand the data categories, let us now build a model for predicting the defaulters based on all the other independent columns.

Let’s create a train and test set for this data so we can train our model and then test on previously unseen data. For this simple classification example, we’ll keep only default.payment.next.month as our response variable

#model building starts – sampling
set.seed(1234)
ind <- sample(2, nrow(retail_data), replace=TRUE, prob=c(0.7, 0.3))

#train Data Table(70%)
trainData <- retail_data[ind==1,]

#test Data table(30%)
testData <- retail_data[ind==2,]

#Tree Building Using C5.0 function C50 Package
library(C50)
creditmodel<-C5.0(trainData[-25],trainData$default.payment.next.month)

# Check summary of the model tree built
summary(creditmodel)

##
## Call:
## C5.0.default(x = trainData[-25], y = trainData$default.payment.next.month)
##
##
## C5.0 [Release 2.07 GPL Edition]      Thu Sep 15 22:02:22 2016
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 20972 cases (25 attributes) from undefined.data
##
## Decision tree:
##
## PAY_0 in {2,3,4,6,7,8}:
## :...EDUCATION = 0: 1 (0)
## :   EDUCATION in {4,5,6}:
## :   :...PAY_AMT2 <= 7588: 0 (13)
## :   :   PAY_AMT2 > 7588: 1 (4/1)
## :   EDUCATION in {1,2,3}:
## :   :...PAY_3 in {0,1,2,3,4,5,6,7,8}: 1 (2019/563)
## :       PAY_3 in {-2,-1}:
## :       :...BILL_AMT1 <= 778: 0 (46/10)
## :           BILL_AMT1 > 778: 1 (84/36)
## PAY_0 in {-2,-1,0,1,5}:
## :...PAY_2 in {-2,-1,0,1,6,7,8}: 0 (17174/2434)
##     PAY_2 in {2,3,4,5}:
##     :...PAY_2 = 3: 1 (113/47)
##         PAY_2 = 5:
##         :...ID <= 21930: 1 (6)
##         :   ID > 21930: 0 (2)
##         PAY_2 in {2,4}:
##         :...PAY_6 = 3: 1 (25/7)
##             PAY_6 in {-2,-1,0,4,5,6,7,8}: 0 (1109/391)
##             PAY_6 = 2:
##             :...SEX = 2: 0 (203/89)
##                 SEX = 1:
##                 :...PAY_5 = 0: 0 (34/13)
##                     PAY_5 in {-2,3,4,5,6,7,8}: 1 (12/3)
##                     PAY_5 = -1:
##                     :...ID <= 12140: 1 (2)
##                     :   ID > 12140: 0 (2)
##                     PAY_5 = 2:
##                     :...MARRIAGE in {0,1,3}: 1 (54/16)
##                         MARRIAGE = 2:
##                         :...EDUCATION in {1,2}: 1 (56/18)
##                             EDUCATION in {0,3,4,5,6}: 0 (14/3)
##
##
## Evaluation on training data (20972 cases):
##
##      Decision Tree  
##    ---------------- 
##    Size      Errors 
##
##      19 3631(17.3%)   <<
##
##
##     (a)   (b)    <-classified as
##    ----  ----
##   15657   691    (a): class 0
##    2940  1684    (b): class 1
##
##
##  Attribute usage:
##
##  100.00% PAY_0
##   89.67% PAY_2
##   10.66% EDUCATION
##   10.25% PAY_3
##    7.20% PAY_6
##    1.80% SEX
##    0.83% PAY_5
##    0.62% BILL_AMT1
##    0.59% MARRIAGE
##    0.08% PAY_AMT2
##    0.06% ID
##
##
## Time: 1.4 secs

From the above summary we observe that first month payment behavior (PAY_0) and second month payment behavior (PAY_2), Play the most important role in predicting the defaulters

With the model generated, we can now use the predict() function to classify the customers as defaulters and non-defaulters:

#Test Model with TestData Table
credit_pred <- predict(creditmodel, testData)

Model validation using confusion matrix

#Confusion Matrix for the Test data prediction

library(gmodels)
CrossTable(testData$default.payment.next.month, credit_pred,
           prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE,
           dnn = c('actual default', 'predicted default'))

##
## 
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
##
## 
## Total Observations in Table:  9028
##
## 
##                | predicted default
## actual default |         0 |         1 | Row Total |
## ---------------|-----------|-----------|-----------|
##              0 |      6682 |       334 |      7016 |
##                |     0.740 |     0.037 |           |
## ---------------|-----------|-----------|-----------|
##              1 |      1315 |       697 |      2012 |
##                |     0.146 |     0.077 |           |
## ---------------|-----------|-----------|-----------|
##   Column Total |      7997 |      1031 |      9028 |
## ---------------|-----------|-----------|-----------|
##
##

·         The model credit_pred has come out with (74.0 + 7.7 =) 81.7% accuracy

·         In our case, we cannot afford to have False Negatives, meaning a regular on time paying non defaulter customer should not be classified as a defaulter. This would lead to discontent and in turn loss of customer. Let us try adaptive boosting strategy by building model based on 10 trial runs and see if a better result is obtained.

#Adaptive Boosting by increasing trial
credit_boost10 <- C5.0(trainData[-25],trainData$default.payment.next.month,
                       trials = 10)

credit_boost_pred10 <- predict(credit_boost10, testData)

CrossTable(testData$default, credit_boost_pred10,
           prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE,
           dnn = c('actual default', 'predicted default'))

##
## 
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
##
## 
## Total Observations in Table:  9028
##
## 
##                | predicted default
## actual default |         0 |         1 | Row Total |
## ---------------|-----------|-----------|-----------|
##              0 |      6652 |       364 |      7016 |
##                |     0.737 |     0.040 |           |
## ---------------|-----------|-----------|-----------|
##              1 |      1282 |       730 |      2012 |
##                |     0.142 |     0.081 |           |
## ---------------|-----------|-----------|-----------|
##   Column Total |      7934 |      1094 |      9028 |
## ---------------|-----------|-----------|-----------|
##
##

The boosted model has come out with the accuracy of (73.7+8.1) 81.8%.  Also the False Negatives has actually gone up to 364 (4%) from 334 (3.7%).

The model 1- credit_pred without adaptive boosting seems better.