Guten Morgan: December 2016

Team Name: Data Don

Team: V. Dinesh Kumar

Institution: SSN School of Advanced Career Education

Phone: 9962255456

Topic: Next USA President

DPL - Methodology Document

Step 1: Exploring the data sets

In our Scenario the significant data is PRE DEBATE and POST DEBATE of USA election.

· Pre Debate and Post Debate data are filtered according the sources, for instance Twitter, FB, Forum, Blogs spot, Mainstream and other sources respectively.

· Each sources in the data set handled independently to filter using “Text Filter” in “excel” tool.

· I used keywords like “Donald Trump, trump, donald” and “Hillary Clinton, hillary, clinton”.

· One of the option I used for text filter contain “Donald Trump” does not contain “Hillary Clinton” and other combination were carried out to filter the sentiment of Trump and Hillary separately.

· Consolidated all the sources for Trump and Hillary respectively.

· Previous step resulted in giving Trump and Hillary’s pre and post-debate sentiments in separate files.

Step 2: Loading the data sets in R Studio

· Data pulled into R script.

· Identified how many languages are in the data set by using “Textcat” package.

In total 30 languages are present in the given data set.

· Introduced “Natural Language Processing” algorithm” to mark score each sentences.

· Scoring is applied to all the sentences and explored the distribution of the sentiments.

· Summary of the distribution is checked for both Trump and Hillary in the both events of pre and post-debate.

· In both event before debate and post-debate Trump has sound sentiments among the data given comparatively than Hillary.

Step 3: Summary of data for Hillary and Trump

· Hillary pre debate sentiment score range lies between -8 to 6 and median score is 0 which indicates the comments for her is “Neutral”.

· Trump pre debate sentiment score range lies between -7 to 11 whereas the Trumps score have more spread than Hillary both in negative and positive as well, and his median score is 1 which is most of his sentiments from the people are “Positive”.

· Hillary’s score after the debate has actually reduced in positive term -8 to 5 and her median score still continues to be 0.

· Trump’s score has increased in negative score -10 but the positive score has boosted up to 21 and median value continues to 1, where these sign supports the Trump strongly in USA election.

Step 4: Code / Output and Model Validation

file:///C:/Users/ssn/AppData/Local/Temp/Codes_and_Outputs%20(2).html

· The Model accuracy is 54% (500 sentiment samples were considered based on Stratified Random Sampling and scored manually and crossed checked against the predicted score).

Step 5: Tools

· Ms Excel - Data Classification.

· R Studio - Data Cleaning, Sentiments and words for word cloud picked for Trump.

· Adobe Photoshop - Word cloud generated and merged on Trump image.

· Tableau- Created charts for report.(https://public.tableau.com/profile/dinesh.kumar7575#!/)

· Piktochart – Info graphic Visualization report.

PS: The results are double checked using the artificial intelligence tool provided by IBM (Watson Analytics). The results are coincidental with my analysis.

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.

Clustering

getwd()

setwd("C:/Users/ssn/Documents/Dinesh Analyst/R")

require(xlsx)

seed = read.xlsx("seed.xlsx",sheetName="Sheet1")

seed_train = seed[,c(-8)]

seed_train$Type= NULL

corrplot(cor(seed_train), order = "hclust", addrect = 3)

wssplot <- function(data, nc=15, seed=1234){

wss <- (nrow(data)-1)*sum(apply(data,2,var))

for (i in 2:nc){

set.seed(seed)

wss[i] <- sum(kmeans(data, centers=i)$withinss)}

plot(1:nc, wss, type="b", xlab="Number of Clusters (k)",

ylab="Within groups sum of squares", main="Optimal k with wss")}

wssplot(seed_train)

library("devtools")

install_github("kassambara/factoextra")

library("factoextra")

set.seed(123)

fviz_nbclust(seed_train, kmeans, method = "wss") +

geom_vline(xintercept = 3, linetype = 2)

### Hierarchical clustering

seed_train$Type= NULL

seed.dist = dist(seed_train)

seed.hclust = hclust(seed.dist)

plot(seed.hclust,main='Default from hclust')

rect.hclust(seed.hclust,3)

groups.3 = cutree(seed.hclust,k=3)

table(groups.3)

table(groups.3, seed$Types)

seed[groups.3 == 2,]

library(fpc)

plotcluster(seed_train,groups.3)

table(groups.3,seed$Types)

groups.3 1 2 3

1 52 23 0

2 18 0 71

3 0 47 0

###PAM: Partitioning around Medoids

library(NbClust)

library(cluster)

seed.pam = pam(scale(seed_train),3,FALSE,"euclidean")

seed.pam$medoids

clusplot(seed.pam, main = "Cluster plot, k = 3",color = TRUE)

fviz_cluster(seed.pam)

table(seed$Types,seed.pam$clustering)

fviz_silhouette(silhouette(seed.pam))

## It can be seen that some samples have a negative silhouette. This means that they are not in the right cluster

#We can find the name of these samples and determine the clusters they are closer, as follow:

cluster size ave.sil.width

1 1 71 0.33

2 2 62 0.49

3 3 78 0.39

# Compute silhouette

sil <- silhouette(seed.pam)[, 1:3]

# Objects with negative silhouette

neg_sil_index <- which(sil[, 'sil_width'] < 0)

sil[neg_sil_index, , drop = FALSE]

#######

#### k means cluster analysis

#http://beyondvalence.blogspot.in/2013/12/cluster-analysis-choosing-optimal.html

####determine no. of clusters

library(NbClust)

set.seed(1234)

nc <- NbClust(seed_train, min.nc=2, max.nc=15, method="kmeans")

table(nc$Best.n[1,])

barplot(table(nc$Best.n[1,]),

xlab="Numer of Clusters", ylab="Number of Criteria",

main="Number of Clusters Chosen by 26 Criteria")

set.seed(1234)

fit.km <- kmeans(seed_train, 3)

fit.km$size

fit.km$centers

aggregate(seed_train, by=list(cluster=fit.km$cluster), mean)

sil<-silhouette(fit.km$cluster,seed.dist)

plot(sil,cex.names=0.6,nmax=98,main="Silhouette Plot, k=2", col=c("red","green"))

plot(seed_train, col = fit.km$cluster, pch = 19, frame = FALSE,

main = "K-means with k = 3")

points(fit.km$centers, col = 1:4, pch = 8, cex = 3)

fviz_cluster(fit.km, data = seed_train)

library(flexclust)

#We can check how well the kmeans clusters =3 clustered the data by using the flexclust package.

#See how well the clustering was for channel 1 and 2? Not very well with a low index of 0.152.

0 2 3 4 7 11 12 15

2 7 10 3 1 1 1 1

#library(fpc)

w.table<-table(seed$Types,fit.km$cluster)

w.table

randIndex(w.table)

##############

library(clValid)

intern <- clValid(seed_train, 2:8, clMethods=c("hierarchical","kmeans","pam"),validation=c("internal","stability"))

res <- getRanksWeights(intern)

print(res$ranks[,1:3], quote=FALSE)

optimalScores(intern)

p <- par(no.readonly=TRUE)

par(mfrow=c(2,2),mar=c(4,4,3,1))

plot(intern, legend=FALSE)

par(op)

plot(nClusters(intern),measures(intern,"Dunn")[,,1],type="n",axes=F, xlab="",ylab="")

legend("center", clusterMethods(intern), col=1:9, lty=1:9, pch=paste(1:9))

> print(res$ranks[,1:3], quote=FALSE)

1 2 3

APN pam-3 kmeans-3 pam-2

AD pam-8 kmeans-8 kmeans-7

ADM pam-3 kmeans-3 pam-6

FOM hierarchical-8 kmeans-8 hierarchical-7

Connectivity hierarchical-2 pam-2 kmeans-2

Dunn hierarchical-8 hierarchical-7 hierarchical-6

Silhouette hierarchical-2 kmeans-2 pam-2

> optimalScores(intern)

Score Method Clusters

APN 0.05254478 pam 3

AD 1.54480205 pam 8

ADM 0.21938308 pam 3

FOM 0.46854722 hierarchical 8

Connectivity 8.78611111 hierarchical 2

Dunn 0.11986747 hierarchical 8

Silhouette 0.52534203 hierarchical 2

Guten Morgan

Saturday, 3 December 2016

Blog Archive