library("dplyr")
library("tidyr")
library("ggplot2")
library("ROCR")
library("rpart")
library("rpart.plot")
library("caret")
library("randomForest")
library("tidyverse")
library("tm")
library("SnowballC")
library("softImpute")
library("glmnet")
library("Hmisc")
library("dummies")
library('tinytex')
library('GGally')
library('gplots')
library('FNN')
library("dplyr")
library("tidyr")
library("caTools")
library("ggpubr")
library("reshape2")
library("e1071")
rm(list=ls())
setwd("/Users/kayhanbabakan/OneDrive/MIT/Data Mining/Data_export")
The working directory was changed to /Users/kayhanbabakan/OneDrive/MIT/Data Mining/Data_export inside a notebook chunk. The working directory will be reset when the chunk is finished running. Use the knitr root.dir option in the setup chunk to change the working directory for notebook chunks.
bank = read.csv("UniversalBank.csv")
bank$Personal.Loan = as.factor(bank$Personal.Loan)
bank$Online = as.factor(bank$Online)
bank$CreditCard = as.factor(bank$CreditCard)
set.seed(1)
train.index <- sample(row.names(bank), 0.6*dim(bank)[1])  
test.index <- setdiff(row.names(bank), train.index) 
train.df <- bank[train.index, ]
test.df <- bank[test.index, ]
train <- bank[train.index, ]
test = bank[train.index,]

<0>a. Create a pivot table for the training data with Online as a column variable, CC as a row variable, and Loan as a secondary row variable. The values inside the table should convey the count. In R use functions melt() and cast(), or function table().

melted.bank = melt(train,id=c("CreditCard","Personal.Loan"),variable= "Online")
recast.bank=dcast(melted.bank,CreditCard+Personal.Loan~Online)
recast.bank[,c(1:2,14)]

b. Consider the task of classifying a customer who owns a bank credit card and is actively using online banking services. Looking at the pivot table, what is the probability that this customer will accept the loan offer? [This is the probability of loan acceptance (Loan = 1) conditional on having a bank credit card (CC = 1) and being an active user of online banking services (Online = 1)].

Probability of Loan acceptance given having a bank credit card and user of online services is 77/3000 = 2.6%



c. Create two separate pivot tables for the training data. One will have Loan (rows) as a function of Online (columns) and the other will have Loan (rows) as a function of CC.

melted.bankc1 = melt(train,id=c("Personal.Loan"),variable = "Online")
attributes are not identical across measure variables; they will be dropped
melted.bankc2 = melt(train,id=c("CreditCard"),variable = "Online")
attributes are not identical across measure variables; they will be dropped
recast.bankc1=dcast(melted.bankc1,Personal.Loan~Online)
recast.bankc2=dcast(melted.bankc2,CreditCard~Online)
Loanline=recast.bankc1[,c(1,13)]
LoanCC = recast.bankc2[,c(1,14)]

Loanline
LoanCC
d. Compute the following quantities [P (A | B) means “the probability of A given B”]:
    1. P (CC = 1 | Loan = 1) (the proportion of credit card holders among the loan acceptors)
    1. P(Online=1|Loan=1)
    1. P (Loan = 1) (the proportion of loan acceptors)
    1. P(CC=1|Loan=0)
    1. P(Online=1|Loan=0)
    1. P(Loan=0)
table(train[,c(14,10)])
          Personal.Loan
CreditCard    0    1
         0 1924  198
         1  801   77
table(train[,c(13,10)])
      Personal.Loan
Online    0    1
     0 1137  109
     1 1588  166
table(train[,c(10)])

   0    1 
2725  275 
i. 77/(77+198)=28%
ii. 166/(166+109)= 60.3%
iii.275/(275+2725)=9.2%
iv. 801/(801+1924)=29.4%
v. 1588/(1588+1137) = 58.3%
vi. 2725/(2725+275) = 90.8%



e. Use the quantities computed above to compute the naive Ba1 probability P(Loan = 1 | CC = 1, Online = 1).

((77/(77+198))*(166/(166+109))*(275/(275+2725)))/(((77/(77+198))*(166/(166+109))*(275/(275+2725)))+((801/(801+1924))*(1588/(1588+1137))*2725/(2725+275)))
[1] 0.09055758

f. Compare this value with the one obtained from the pivot table in (b). Which is a more accurate estimate? 9.05% are very similar to the 9.7% the difference between the exact method and the naive-baise method is the exact method would need the the exact same independent variable classifications to predict, where the naive bayes method does not.

g. Which of the entries in this table are needed for computing P (Loan = 1 | CC = 1, Online = 1)? In R, run naive Bayes on the data. Examine the model output on training data, and find the entry that corresponds to P (Loan = 1 | CC = 1, Online = 1). Compare this to the number you obtained in (e).

naive.train = train.df[,c(10,13:14)]
naive.test = test.df[,c(10,13:14)]
naivebayes = naiveBayes(Personal.Loan~.,data=naive.train)
naivebayes

Naive Bayes Classifier for Discrete Predictors

Call:
naiveBayes.default(x = X, y = Y, laplace = laplace)

A-priori probabilities:
Y
         0          1 
0.90833333 0.09166667 

Conditional probabilities:
   Online
Y           0         1
  0 0.4172477 0.5827523
  1 0.3963636 0.6036364

   CreditCard
Y          0        1
  0 0.706055 0.293945
  1 0.720000 0.280000

the naive bayes is the exact same output we recieved in the previous methods. (.280)(.603)(.09)/(.280.603.09+.29.58.908) = .09 which is the same response provided as above.

LS0tCnRpdGxlOiAiMTUuMDYyIEhvbWV3b3JrIDIiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmxpYnJhcnkoImRwbHlyIikKbGlicmFyeSgidGlkeXIiKQpsaWJyYXJ5KCJnZ3Bsb3QyIikKbGlicmFyeSgiUk9DUiIpCmxpYnJhcnkoInJwYXJ0IikKbGlicmFyeSgicnBhcnQucGxvdCIpCmxpYnJhcnkoImNhcmV0IikKbGlicmFyeSgicmFuZG9tRm9yZXN0IikKbGlicmFyeSgidGlkeXZlcnNlIikKbGlicmFyeSgidG0iKQpsaWJyYXJ5KCJTbm93YmFsbEMiKQpsaWJyYXJ5KCJzb2Z0SW1wdXRlIikKbGlicmFyeSgiZ2xtbmV0IikKbGlicmFyeSgiSG1pc2MiKQpsaWJyYXJ5KCJkdW1taWVzIikKbGlicmFyeSgndGlueXRleCcpCmxpYnJhcnkoJ0dHYWxseScpCmxpYnJhcnkoJ2dwbG90cycpCmxpYnJhcnkoJ0ZOTicpCmxpYnJhcnkoImRwbHlyIikKbGlicmFyeSgidGlkeXIiKQpsaWJyYXJ5KCJjYVRvb2xzIikKbGlicmFyeSgiZ2dwdWJyIikKbGlicmFyeSgicmVzaGFwZTIiKQpsaWJyYXJ5KCJlMTA3MSIpCmBgYApgYGB7cn0Kcm0obGlzdD1scygpKQpzZXR3ZCgiL1VzZXJzL2theWhhbmJhYmFrYW4vT25lRHJpdmUvTUlUL0RhdGEgTWluaW5nL0RhdGFfZXhwb3J0IikKYmFuayA9IHJlYWQuY3N2KCJVbml2ZXJzYWxCYW5rLmNzdiIpCmJhbmskUGVyc29uYWwuTG9hbiA9IGFzLmZhY3RvcihiYW5rJFBlcnNvbmFsLkxvYW4pCmJhbmskT25saW5lID0gYXMuZmFjdG9yKGJhbmskT25saW5lKQpiYW5rJENyZWRpdENhcmQgPSBhcy5mYWN0b3IoYmFuayRDcmVkaXRDYXJkKQpzZXQuc2VlZCgxKQp0cmFpbi5pbmRleCA8LSBzYW1wbGUocm93Lm5hbWVzKGJhbmspLCAwLjYqZGltKGJhbmspWzFdKSAgCnRlc3QuaW5kZXggPC0gc2V0ZGlmZihyb3cubmFtZXMoYmFuayksIHRyYWluLmluZGV4KSAKdHJhaW4uZGYgPC0gYmFua1t0cmFpbi5pbmRleCwgXQp0ZXN0LmRmIDwtIGJhbmtbdGVzdC5pbmRleCwgXQp0cmFpbiA8LSBiYW5rW3RyYWluLmluZGV4LCBdCnRlc3QgPSBiYW5rW3RyYWluLmluZGV4LF0KYGBgCjwwPjxpPmEuIENyZWF0ZSBhIHBpdm90IHRhYmxlIGZvciB0aGUgdHJhaW5pbmcgZGF0YSB3aXRoIE9ubGluZSBhcyBhIGNvbHVtbiB2YXJpYWJsZSwgQ0MgYXMgYSByb3cgdmFyaWFibGUsIGFuZCBMb2FuIGFzIGEgc2Vjb25kYXJ5IHJvdyB2YXJpYWJsZS4gVGhlIHZhbHVlcyBpbnNpZGUgdGhlIHRhYmxlIHNob3VsZCBjb252ZXkgdGhlIGNvdW50LiBJbiBSIHVzZSBmdW5jdGlvbnMgbWVsdCgpIGFuZCBjYXN0KCksIG9yIGZ1bmN0aW9uIHRhYmxlKCkuPC9pPgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQptZWx0ZWQuYmFuayA9IG1lbHQodHJhaW4saWQ9YygiQ3JlZGl0Q2FyZCIsIlBlcnNvbmFsLkxvYW4iKSx2YXJpYWJsZT0gIk9ubGluZSIpCnJlY2FzdC5iYW5rPWRjYXN0KG1lbHRlZC5iYW5rLENyZWRpdENhcmQrUGVyc29uYWwuTG9hbn5PbmxpbmUpCnJlY2FzdC5iYW5rWyxjKDE6MiwxNCldCmBgYAo8aT5iLiBDb25zaWRlciB0aGUgdGFzayBvZiBjbGFzc2lmeWluZyBhIGN1c3RvbWVyIHdobyBvd25zIGEgYmFuayBjcmVkaXQgY2FyZCBhbmQgaXMgYWN0aXZlbHkgdXNpbmcgb25saW5lIGJhbmtpbmcgc2VydmljZXMuIExvb2tpbmcgYXQgdGhlIHBpdm90IHRhYmxlLCB3aGF0IGlzIHRoZSBwcm9iYWJpbGl0eSB0aGF0IHRoaXMgY3VzdG9tZXIgd2lsbCBhY2NlcHQgdGhlIGxvYW4gb2ZmZXI/IFtUaGlzIGlzIHRoZSBwcm9iYWJpbGl0eSBvZiBsb2FuIGFjY2VwdGFuY2UgKExvYW4gPSAxKSBjb25kaXRpb25hbCBvbiBoYXZpbmcgYSBiYW5rIGNyZWRpdCBjYXJkIChDQyA9IDEpIGFuZCBiZWluZyBhbiBhY3RpdmUgdXNlciBvZiBvbmxpbmUgYmFua2luZyBzZXJ2aWNlcyAoT25saW5lID0gMSldLjwvaT4KCjx0YWJsZSBib3JkZXIgPSAiMSIgd2lkdGggPSAiMTAwJSIgY2VsbHBhZGRpbmc9IjEwIiBiZ2NvbG9yLSJibGFjayI+Cjx0cj4KPHRkPgpQcm9iYWJpbGl0eSBvZiBMb2FuIGFjY2VwdGFuY2UgZ2l2ZW4gaGF2aW5nIGEgYmFuayBjcmVkaXQgY2FyZCBhbmQgdXNlciBvZiBvbmxpbmUgc2VydmljZXMgaXMgNzcvMzAwMCA9IDIuNiUgPC90YWJsZT4KPGJyPjxicj4KPGk+Yy4gQ3JlYXRlIHR3byBzZXBhcmF0ZSBwaXZvdCB0YWJsZXMgZm9yIHRoZSB0cmFpbmluZyBkYXRhLiBPbmUgd2lsbCBoYXZlIExvYW4gKHJvd3MpIGFzIGEgZnVuY3Rpb24gb2YgT25saW5lIChjb2x1bW5zKSBhbmQgdGhlIG90aGVyIHdpbGwgaGF2ZSBMb2FuIChyb3dzKSBhcyBhIGZ1bmN0aW9uIG9mIENDLjwvaT4KCmBgYHtyIG1lc3NhZ2U9RkFMU0V9Cm1lbHRlZC5iYW5rYzEgPSBtZWx0KHRyYWluLGlkPWMoIlBlcnNvbmFsLkxvYW4iKSx2YXJpYWJsZSA9ICJPbmxpbmUiKQptZWx0ZWQuYmFua2MyID0gbWVsdCh0cmFpbixpZD1jKCJDcmVkaXRDYXJkIiksdmFyaWFibGUgPSAiT25saW5lIikKcmVjYXN0LmJhbmtjMT1kY2FzdChtZWx0ZWQuYmFua2MxLFBlcnNvbmFsLkxvYW5+T25saW5lKQpyZWNhc3QuYmFua2MyPWRjYXN0KG1lbHRlZC5iYW5rYzIsQ3JlZGl0Q2FyZH5PbmxpbmUpCkxvYW5saW5lPXJlY2FzdC5iYW5rYzFbLGMoMSwxMyldCkxvYW5DQyA9IHJlY2FzdC5iYW5rYzJbLGMoMSwxNCldCgpMb2FubGluZQpMb2FuQ0MKYGBgCjxpPmQuIENvbXB1dGUgdGhlIGZvbGxvd2luZyBxdWFudGl0aWVzIFtQIChBIHwgQikgbWVhbnMg4oCcdGhlIHByb2JhYmlsaXR5IG9mIEEgZ2l2ZW4gQuKAnV06CjxsaXN0Pgo8dWw+aS4gUCAoQ0MgPSAxIHwgTG9hbiA9IDEpICh0aGUgcHJvcG9ydGlvbiBvZiBjcmVkaXQgY2FyZCBob2xkZXJzIGFtb25nIHRoZSBsb2FuCmFjY2VwdG9ycyk8L3VsPgo8dWw+aWkuIFAoT25saW5lPTF8TG9hbj0xKTwvdWw+Cjx1bD5paWkuIFAgKExvYW4gPSAxKSAodGhlIHByb3BvcnRpb24gb2YgbG9hbiBhY2NlcHRvcnMpPC91bD4KPHVsPml2LiBQKENDPTF8TG9hbj0wKTwvdWw+Cjx1bD52LiBQKE9ubGluZT0xfExvYW49MCk8L3VsPgo8dWw+dmkuIFAoTG9hbj0wKTwvdWw+PC9pPgpgYGB7cn0KdGFibGUodHJhaW5bLGMoMTQsMTApXSkKdGFibGUodHJhaW5bLGMoMTMsMTApXSkKdGFibGUodHJhaW5bLGMoMTApXSkKCmBgYAo8dGFibGUgYm9yZGVyID0gIjEiIHdpZHRoID0gIjEwMCUiIGNlbGxwYWRkaW5nPSIxMCIgYmdjb2xvci0iYmxhY2siPgo8dHI+Cjx0ZD4KPGZvbnQgY29sb3IgPSAiYmx1ZSI+CmkuICA3Ny8oNzcrMTk4KT0yOCUgPGJyPgppaS4gMTY2LygxNjYrMTA5KT0gNjAuMyU8YnI+CmlpaS4yNzUvKDI3NSsyNzI1KT05LjIlPGJyPgppdi4gODAxLyg4MDErMTkyNCk9MjkuNCU8YnI+CnYuICAxNTg4LygxNTg4KzExMzcpID0gNTguMyU8YnI+CnZpLiAyNzI1LygyNzI1KzI3NSkgPSA5MC44JQo8L3RhYmxlPgo8YnI+PGJyPgoKPGk+ZS4gVXNlIHRoZSBxdWFudGl0aWVzIGNvbXB1dGVkIGFib3ZlIHRvIGNvbXB1dGUgdGhlIG5haXZlIEJhMSBwcm9iYWJpbGl0eSBQKExvYW4gPSAxIHwgQ0MgPSAxLCBPbmxpbmUgPSAxKS48L2k+CmBgYHtyfQooKDc3Lyg3NysxOTgpKSooMTY2LygxNjYrMTA5KSkqKDI3NS8oMjc1KzI3MjUpKSkvKCgoNzcvKDc3KzE5OCkpKigxNjYvKDE2NisxMDkpKSooMjc1LygyNzUrMjcyNSkpKSsoKDgwMS8oODAxKzE5MjQpKSooMTU4OC8oMTU4OCsxMTM3KSkqMjcyNS8oMjcyNSsyNzUpKSkKYGBgCgo8aT5mLiBDb21wYXJlIHRoaXMgdmFsdWUgd2l0aCB0aGUgb25lIG9idGFpbmVkIGZyb20gdGhlIHBpdm90IHRhYmxlIGluIChiKS4gV2hpY2ggaXMgYSBtb3JlIGFjY3VyYXRlIGVzdGltYXRlPzwvaT4KOS4wNSUgYXJlIHZlcnkgc2ltaWxhciB0byB0aGUgOS43JSB0aGUgZGlmZmVyZW5jZSBiZXR3ZWVuIHRoZSBleGFjdCBtZXRob2QgYW5kIHRoZSBuYWl2ZS1iYWlzZSBtZXRob2QgaXMgdGhlIGV4YWN0IG1ldGhvZCB3b3VsZCBuZWVkIHRoZSB0aGUgZXhhY3Qgc2FtZSBpbmRlcGVuZGVudCB2YXJpYWJsZSBjbGFzc2lmaWNhdGlvbnMgdG8gcHJlZGljdCwgd2hlcmUgdGhlIG5haXZlIGJheWVzIG1ldGhvZCBkb2VzIG5vdC4KCjxpPmcuIFdoaWNoIG9mIHRoZSBlbnRyaWVzIGluIHRoaXMgdGFibGUgYXJlIG5lZWRlZCBmb3IgY29tcHV0aW5nIFAgKExvYW4gPSAxIHwgQ0MgPSAxLCBPbmxpbmUgPSAxKT8gSW4gUiwgcnVuIG5haXZlIEJheWVzIG9uIHRoZSBkYXRhLiBFeGFtaW5lIHRoZSBtb2RlbCBvdXRwdXQgb24gdHJhaW5pbmcgZGF0YSwgYW5kIGZpbmQgdGhlIGVudHJ5IHRoYXQgY29ycmVzcG9uZHMgdG8gUCAoTG9hbiA9IDEgfCBDQyA9IDEsIE9ubGluZSA9IDEpLiBDb21wYXJlIHRoaXMgdG8gdGhlIG51bWJlciB5b3Ugb2J0YWluZWQgaW4gKGUpLjwvaT4KYGBge3J9Cm5haXZlLnRyYWluID0gdHJhaW4uZGZbLGMoMTAsMTM6MTQpXQpuYWl2ZS50ZXN0ID0gdGVzdC5kZlssYygxMCwxMzoxNCldCm5haXZlYmF5ZXMgPSBuYWl2ZUJheWVzKFBlcnNvbmFsLkxvYW5+LixkYXRhPW5haXZlLnRyYWluKQpuYWl2ZWJheWVzCgpgYGAKCnRoZSBuYWl2ZSBiYXllcyBpcyB0aGUgZXhhY3Qgc2FtZSBvdXRwdXQgd2UgcmVjaWV2ZWQgaW4gdGhlIHByZXZpb3VzIG1ldGhvZHMuCiguMjgwKSooLjYwMykqKC4wOSkvKC4yODAqLjYwMyouMDkrLjI5Ki41OCouOTA4KSA9IC4wOSB3aGljaCBpcyB0aGUgc2FtZSByZXNwb25zZSBwcm92aWRlZCBhcyBhYm92ZS4KCgoK