library(tidyr)
library(class)
library(gmodels)
# read and clean the data
tele <- read.csv("telemarketing.csv")
TeleName <- c("age","job","marital","education","default","housing","loan","contact","month","day_of_week","duration","campaign","pdays","previous","poutcome","emp.var.rate","cons.price.idx","cons.conf.idx","euribor3m","nr.employed","y")
tele <- separate(data= tele,
col = "age.job.marital.education.default.housing.loan.contact.month.day_of_week.duration.campaign.pdays.previous.poutcome.emp.var.rate.cons.price.idx.cons.conf.idx.euribor3m.nr.employed.y",
sep = ";",into = TeleName)
# change data type of columns
str(tele)
## 'data.frame': 41188 obs. of 21 variables:
## $ age : chr "56" "57" "37" "40" ...
## $ job : chr "housemaid" "services" "services" "admin." ...
## $ marital : chr "married" "married" "married" "married" ...
## $ education : chr "basic.4y" "high.school" "high.school" "basic.6y" ...
## $ default : chr "no" "unknown" "no" "no" ...
## $ housing : chr "no" "no" "yes" "no" ...
## $ loan : chr "no" "no" "no" "no" ...
## $ contact : chr "telephone" "telephone" "telephone" "telephone" ...
## $ month : chr "may" "may" "may" "may" ...
## $ day_of_week : chr "mon" "mon" "mon" "mon" ...
## $ duration : chr "261" "149" "226" "151" ...
## $ campaign : chr "1" "1" "1" "1" ...
## $ pdays : chr "999" "999" "999" "999" ...
## $ previous : chr "0" "0" "0" "0" ...
## $ poutcome : chr "nonexistent" "nonexistent" "nonexistent" "nonexistent" ...
## $ emp.var.rate : chr "1.1" "1.1" "1.1" "1.1" ...
## $ cons.price.idx: chr "93.994" "93.994" "93.994" "93.994" ...
## $ cons.conf.idx : chr "-36.4" "-36.4" "-36.4" "-36.4" ...
## $ euribor3m : chr "4.857" "4.857" "4.857" "4.857" ...
## $ nr.employed : chr "5191" "5191" "5191" "5191" ...
## $ y : chr "no" "no" "no" "no" ...
tele$age = as.numeric(tele$age)
tele$job = as.factor(tele$job)
tele$marital = as.factor(tele$marital)
tele$education = as.factor(tele$education)
tele$default = as.factor(tele$default)
tele$housing = as.factor(tele$housing)
tele$loan = as.factor(tele$loan)
tele$contact = as.factor(tele$contact)
tele$month = as.factor(tele$month)
tele$day_of_week = as.factor(tele$day_of_week)
tele$duration = as.numeric(tele$duration)
tele$campaign = as.numeric(tele$campaign)
tele$pdays = as.numeric(tele$pdays)
tele$previous = as.numeric(tele$previous)
tele$poutcome = as.factor(tele$poutcome)
tele$emp.var.rate = as.numeric(tele$emp.var.rate)
tele$cons.price.idx = as.numeric(tele$cons.price.idx)
tele$cons.conf.idx = as.numeric(tele$cons.conf.idx)
tele$nr.employed = as.numeric(tele$nr.employed)
tele$euribor3m = as.numeric(tele$euribor3m)
tele$y = as.factor(tele$y)
# remove column duration
tele <- tele[-11]
# turn all categoried variables into dummy variables ######
library(dummies)
## dummies-1.5.6 provided by Decision Patterns
tele_dummy <- dummy.data.frame(data = tele[-ncol(tele)], sep = ".")
tele_dummy$y <- tele$y
# normalize data
tele_n<- as.data.frame(scale(tele_dummy[c("age","pdays","previous","emp.var.rate","cons.conf.idx","cons.price.idx","euribor3m","nr.employed","campaign")]))
tele_dummy[c("age","pdays","previous","emp.var.rate","cons.conf.idx","cons.price.idx","euribor3m","nr.employed","campaign")] <- tele_n[c("age","pdays","previous","emp.var.rate","cons.conf.idx","cons.price.idx","euribor3m","nr.employed","campaign")]
# define random 80% as training data and 20% as test data
tele_80_id <- sample(seq_len(nrow(tele_dummy)),floor(0.8*nrow(tele_dummy)))
tele_20_id <- seq_len(nrow(tele_dummy))[-tele_80_id]
tele_dummy_80 <- tele_dummy[tele_80_id,]
tele_dummy_20 <- tele_dummy[tele_20_id,]
tele_train <- tele_dummy_80[-ncol(tele_dummy_80)]
tele_test <- tele_dummy_20[-ncol(tele_dummy_20)]
# define labels
train_labels <- tele_dummy_80$y
test_labels <- tele_dummy_20$y
# check out train set labels and test test labels
summary(train_labels)
## no yes
## 29252 3698
summary(test_labels)
## no yes
## 7296 942
# run knn model
tele_test_knn <- knn(train = tele_train, test = tele_test, cl = train_labels,
k= 202)
summary(tele_test_knn)
## no yes
## 7958 280
CrossTable(x = test_labels, y = tele_test_knn, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 8238
##
##
## | tele_test_knn
## test_labels | no | yes | Row Total |
## -------------|-----------|-----------|-----------|
## no | 7197 | 99 | 7296 |
## | 0.986 | 0.014 | 0.886 |
## | 0.904 | 0.354 | |
## | 0.874 | 0.012 | |
## -------------|-----------|-----------|-----------|
## yes | 761 | 181 | 942 |
## | 0.808 | 0.192 | 0.114 |
## | 0.096 | 0.646 | |
## | 0.092 | 0.022 | |
## -------------|-----------|-----------|-----------|
## Column Total | 7958 | 280 | 8238 |
## | 0.966 | 0.034 | |
## -------------|-----------|-----------|-----------|
##
##
# caculate knn model prediction accuracy
correct.count <- function () {
n <- 0
for (i in 1:nrow(tele_test)) {
if (test_labels[i] == tele_test_knn[i]) {
n <- (n + 1)
}
}
return(n)
}
correct <- correct.count()
accuracy <- as.numeric(correct)/nrow(tele_test) * 100
accuracy <- round(accuracy, digits = 1)
paste("accuracy is: ", accuracy,"%")
## [1] "accuracy is: 89.6 %"
# improve the model by trying different k
tele_test_knn <- knn(train = tele_train, test = tele_test, cl = train_labels,
k= 1)
correct <- correct.count()
accuracy <- as.numeric(correct)/nrow(tele_test) * 100
accuracy1 <- round(accuracy, digits = 1)
paste("when k =1,"," accuracy is: ", accuracy1,"%")
## [1] "when k =1, accuracy is: 84.7 %"
tele_test_knn <- knn(train = tele_train, test = tele_test, cl = train_labels,
k= 10)
correct <- correct.count()
accuracy <- as.numeric(correct)/nrow(tele_test) * 100
accuracy2 <- round(accuracy, digits = 1)
paste("when k =10,"," accuracy is: ", accuracy2,"%")
## [1] "when k =10, accuracy is: 89.2 %"
tele_test_knn <- knn(train = tele_train, test = tele_test, cl = train_labels,
k= 100)
correct <- correct.count()
accuracy <- as.numeric(correct)/nrow(tele_test) * 100
accuracy3 <- round(accuracy, digits = 1)
paste("when k =100,"," accuracy is: ", accuracy3,"%")
## [1] "when k =100, accuracy is: 89.7 %"
tele_test_knn <- knn(train = tele_train, test = tele_test, cl = train_labels,
k= 150)
correct <- correct.count()
accuracy <- as.numeric(correct)/nrow(tele_test) * 100
accuracy4 <- round(accuracy, digits = 1)
paste("when k = 150,"," accuracy is: ", accuracy4,"%")
## [1] "when k = 150, accuracy is: 89.7 %"
tele_test_knn <- knn(train = tele_train, test = tele_test, cl = train_labels,
k= 200)
correct <- correct.count()
accuracy <- as.numeric(correct)/nrow(tele_test) * 100
accuracy5 <- round(accuracy, digits = 1)
paste("when k = 200,"," accuracy is: ", accuracy5,"%")
## [1] "when k = 200, accuracy is: 89.5 %"
tele_test_knn <- knn(train = tele_train, test = tele_test, cl = train_labels,
k= 400)
correct <- correct.count()
accuracy <- as.numeric(correct)/nrow(tele_test) * 100
accuracy6 <- round(accuracy, digits = 1)
paste("when k = 400,"," accuracy is: ", accuracy6,"%")
## [1] "when k = 400, accuracy is: 89.3 %"
# visual the impact of k on accuracy
plot(x = c(1,10,100,150,200,400),
y = c(accuracy1,accuracy2,accuracy3,accuracy4,accuracy5,accuracy6), type = "b")
Conclusion:
the optimal k is between 100 and 200, where prediction accuracy is above 89%