ALGORITMOS DE CLASSIFICAÇÃO - TUTORIAL
INTRODUÇÃO
Sumário
Tutorial com a implementação básica dos principais algoritmos de classificação no R.
Problema
Prever se um cliente comprará um produto bancário (CDB) após uma campanha de marketing.
Classe: 0 se o cliente não comprou; 1 se comprou.
Dataset
Bank Marketing, com dados já pré-processados.
dados <- read.csv("datasets/dados_preprocessados.csv")
# 45211 observações e 43 campos, sendo um deles a classe
str(dados)'data.frame': 45211 obs. of 43 variables:
$ classe : int 0 0 0 0 0 0 0 0 0 0 ...
$ age : num 1.607 0.289 -0.747 0.571 -0.747 ...
$ balance : num 0.2564 -0.4379 -0.4468 0.0472 -0.4471 ...
$ day : num -1.3 -1.3 -1.3 -1.3 -1.3 ...
$ duration : num 0.011 -0.416 -0.707 -0.645 -0.234 ...
$ campaign : num -0.569 -0.569 -0.569 -0.569 -0.569 ...
$ pdays : num -0.411 -0.411 -0.411 -0.411 -0.411 ...
$ previous : num -0.252 -0.252 -0.252 -0.252 -0.252 ...
$ job_blue : int 0 0 0 1 0 0 0 0 0 0 ...
$ job_entrepreneur : int 0 0 1 0 0 0 0 1 0 0 ...
$ job_housemaid : int 0 0 0 0 0 0 0 0 0 0 ...
$ job_management : int 1 0 0 0 0 1 1 0 0 0 ...
$ job_retired : int 0 0 0 0 0 0 0 0 1 0 ...
$ job_self : int 0 0 0 0 0 0 0 0 0 0 ...
$ job_services : int 0 0 0 0 0 0 0 0 0 0 ...
$ job_student : int 0 0 0 0 0 0 0 0 0 0 ...
$ job_technician : int 0 1 0 0 0 0 0 0 0 1 ...
$ job_unemployed : int 0 0 0 0 0 0 0 0 0 0 ...
$ job_unknown : int 0 0 0 0 1 0 0 0 0 0 ...
$ marital_married : int 1 0 1 1 0 1 0 0 1 0 ...
$ marital_single : int 0 1 0 0 1 0 1 0 0 1 ...
$ education_secondary: int 0 1 1 0 0 0 0 0 0 1 ...
$ education_tertiary : int 1 0 0 0 0 1 1 1 0 0 ...
$ education_unknown : int 0 0 0 1 1 0 0 0 0 0 ...
$ default_yes : int 0 0 0 0 0 0 0 1 0 0 ...
$ housing_yes : int 1 1 1 1 0 1 1 1 1 1 ...
$ loan_yes : int 0 0 1 0 0 0 1 0 0 0 ...
$ contact_telephone : int 0 0 0 0 0 0 0 0 0 0 ...
$ contact_unknown : int 1 1 1 1 1 1 1 1 1 1 ...
$ month_aug : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_dec : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_feb : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_jan : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_jul : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_jun : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_mar : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_may : int 1 1 1 1 1 1 1 1 1 1 ...
$ month_nov : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_oct : int 0 0 0 0 0 0 0 0 0 0 ...
$ month_sep : int 0 0 0 0 0 0 0 0 0 0 ...
$ poutcome_other : int 0 0 0 0 0 0 0 0 0 0 ...
$ poutcome_success : int 0 0 0 0 0 0 0 0 0 0 ...
$ poutcome_unknown : int 1 1 1 1 1 1 1 1 1 1 ...# 11.7% dos clientes compraram o produto após a campanha
prop.table(table(dados$classe))
0 1
0.8830152 0.1169848 SPLIT
Os dados serão divididos em 70% para treinamento e 30% para teste. A classe precisa ser uma variável do tipo factor.
set.seed(1234)
amostra <- sample(1:nrow(dados), nrow(dados) * 0.7, replace = FALSE)
dados_treino <- dados[amostra, ]
dados_treino$classe <- as.factor(dados_treino$classe)
dados_teste <- dados[-amostra, ]
dados_teste$classe <- as.factor(dados_teste$classe)ALGORITMOS
Adaboost
Pacotes
library(adabag)Treinamento
# mfinal -> total de iterações coeflearn -> fórmula para o amount of say;
# 'Breiman' a usual 1/2ln((1-err)/err).
mod_adaboost <- boosting(classe ~ ., data = dados_treino, boos = TRUE, mfinal = 30,
coeflearn = "Breiman")Classificações
classificacoes_adaboost <- predict.boosting(mod_adaboost, dados_teste[, -1])
classificacoes_adaboost <- as.factor(classificacoes_adaboost$class)Matriz de confusão
mc_adaboost <- confusionMatrix(classificacoes_adaboost, dados_teste$classe, positive = "1",
mode = "prec_recall")
mc_adaboost$table Reference
Prediction 0 1
0 11518 874
1 452 720Métricas
acuracia_adaboost <- mc_adaboost$overall["Accuracy"]
precisao_adaboost <- mc_adaboost$byClass["Precision"]
recall_adaboost <- mc_adaboost$byClass["Recall"]
f1_adaboost <- mc_adaboost$byClass["F1"]
metricas_adaboost <- c(acuracia_adaboost, precisao_adaboost, recall_adaboost, f1_adaboost)
metricas_adaboost Accuracy Precision Recall F1
0.9022412 0.6143345 0.4516939 0.5206074 Árvores de decisão
Pacotes
library(caret)
library(rpart)
library(rpart.plot)Treinamento
pruneControl = rpart.control(minsplit = 15, minbucket = 5)
mod_arvores = rpart(classe ~ ., data = dados_treino, control = pruneControl)
# Visualização da árvore
prp(mod_arvores)
Classificações
classificacoes_arvores <- predict(mod_arvores, dados_teste[, -1])
classificacoes_arvores <- as.data.frame(classificacoes_arvores)
classificacoes_arvores["classe"] <- ifelse(classificacoes_arvores >= 0.5, 1, 0)Matriz de confusão
mc_arvores <- confusionMatrix(as.factor(classificacoes_arvores$class[, 2]), as.factor(dados_teste[,
1]), positive = "1", mode = "prec_recall")
mc_arvores$table Reference
Prediction 0 1
0 11649 1024
1 321 570Métricas
acuracia_arvores <- mc_arvores$overall["Accuracy"]
precisao_arvores <- mc_arvores$byClass["Precision"]
recall_arvores <- mc_arvores$byClass["Recall"]
f1_arvores <- mc_arvores$byClass["F1"]
metricas_arvores <- c(acuracia_arvores, precisao_arvores, recall_arvores, f1_arvores)
metricas_arvores Accuracy Precision Recall F1
0.9008405 0.6397306 0.3575910 0.4587525 Gradient boosting
Pacotes
library(caret)
library(gbm)Treinamento
# Função gbm precisa da classe com formato character
dados_treino$classe <- as.character(dados_treino$classe)
dados_teste$classe <- as.character(dados_teste$classe)
# Bernoulli para saída binária; 1000 iterações; mínimo 30 observações nas folhas
mod_gb <- gbm(classe ~ ., data = dados_treino, n.trees = 1000, n.minobsinnode = 30,
distribution = "bernoulli")Classificações
classificacoes_gb <- predict.gbm(mod_gb, dados_teste[, -1], type = "response")
classificacoes_gb <- as.data.frame(classificacoes_gb)
classificacoes_gb["classe"] <- ifelse(classificacoes_gb >= 0.5, 1, 0)Matriz de confusão
mc_gb <- confusionMatrix(as.factor(classificacoes_gb$classe), as.factor(dados_teste[,
1]), positive = "1", mode = "prec_recall")
mc_gb$table Reference
Prediction 0 1
0 11620 964
1 350 630Métricas
acuracia_gb <- mc_gb$overall["Accuracy"]
precisao_gb <- mc_gb$byClass["Precision"]
recall_gb <- mc_gb$byClass["Recall"]
f1_gb <- mc_gb$byClass["F1"]
metricas_gb <- c(acuracia_gb, precisao_gb, recall_gb, f1_gb)
metricas_gb Accuracy Precision Recall F1
0.9031259 0.6428571 0.3952321 0.4895105 kNN
Pacotes
library(class)
library(caret)Classificações
# k=sqrt(n)
k <- ifelse(round(sqrt(nrow(dados)), 0)%%2 == 1, round(sqrt(nrow(dados)), 0), round(sqrt(nrow(dados)),
0) + 1)
classificacoes_knn <- knn(dados_treino, dados_teste, cl = dados_treino$classe, k = k)Matriz de confusão
mc_knn <- confusionMatrix(as.factor(classificacoes_knn), as.factor(dados_teste[,
1]), positive = "1", mode = "prec_recall")
mc_knn$table Reference
Prediction 0 1
0 11939 1047
1 31 547Métricas
acuracia_knn <- mc_gb$overall["Accuracy"]
precisao_knn <- mc_gb$byClass["Precision"]
recall_knn <- mc_gb$byClass["Recall"]
f1_knn <- mc_gb$byClass["F1"]
metricas_knn <- c(acuracia_knn, precisao_knn, recall_knn, f1_knn)
metricas_knn Accuracy Precision Recall F1
0.9031259 0.6428571 0.3952321 0.4895105 Naive Bayes
Pacotes
library(e1071)
library(caret)Treinamento
# Com correção de laplace
mod_nb = naiveBayes(classe ~ ., data = dados_treino, laplace = TRUE)Classificações
# type = 'raw' porque o RMarkdown, incompreensivelmente, bugou com type='class'
classificacoes_nb <- predict(mod_nb, dados_teste[, -1], type = "raw")
classificacoes_nb <- as.data.frame(classificacoes_nb)
classificacoes_nb["classe"] <- ifelse(classificacoes_nb[, 2] >= 0.5, 1, 0)Matriz de confusão
mc_nb <- confusionMatrix(as.factor(classificacoes_nb$classe), as.factor(dados_teste[,
1]), positive = "1", mode = "prec_recall")
mc_nb$table Reference
Prediction 0 1
0 11202 1000
1 768 594Métricas
acuracia_nb <- mc_nb$overall["Accuracy"]
precisao_nb <- mc_nb$byClass["Precision"]
recall_nb <- mc_nb$byClass["Recall"]
f1_nb <- mc_nb$byClass["F1"]
metricas_nb <- c(acuracia_gb, precisao_gb, recall_gb, f1_gb)
metricas_nb Accuracy Precision Recall F1
0.9031259 0.6428571 0.3952321 0.4895105 Random forest
Pacotes
library(caret)
library(randomForest)Treinamento
# ntree: número de árvores
mod_rf <- randomForest(as.factor(classe) ~ ., data = dados_treino, ntree = 101)Classificações
classificacoes_rf <- predict(mod_rf, dados_teste[, -1])Matriz de confusão
mc_rf <- confusionMatrix(classificacoes_rf, as.factor(dados_teste[, 1]), positive = "1",
mode = "prec_recall")
mc_rf$table Reference
Prediction 0 1
0 11637 935
1 333 659Métricas
acuracia_rf <- mc_rf$overall["Accuracy"]
precisao_rf <- mc_rf$byClass["Precision"]
recall_rf <- mc_rf$byClass["Recall"]
f1_rf <- mc_rf$byClass["F1"]
metricas_rf <- c(acuracia_rf, precisao_rf, recall_rf, f1_rf)
metricas_rf Accuracy Precision Recall F1
0.9065173 0.6643145 0.4134253 0.5096674 Redes neurais
Pacotes
library(caTools)
library(h2o)
library(caret)Split
# Split usando cartools
set.seed(1234)
divisao <- sample.split(dados$classe, SplitRatio = 0.7)
dados_treinamento <- subset(dados, divisao == TRUE)
dados_teste <- subset(dados, divisao == FALSE)Treinamento
h2o.init()
# Função de ativação ReLU;duas camadas de 22 neurônios;1000 epochs
mod_rn <- h2o.deeplearning(y = "classe", training_frame = as.h2o(dados_treinamento),
activation = "Rectifier", hidden = c(22, 22), epochs = 100)Classificações
h2o.init()
classificacoes_rn <- h2o.predict(mod_rn, newdata = as.h2o(dados_teste[, -1]))
classificacoes_rn = classificacoes_rn > 0.5
classificacoes_rn <- as.vector(classificacoes_rn)Matriz de confusão
mc_rn <- confusionMatrix(as.factor(classificacoes_rn), as.factor(dados_teste[, 1]),
positive = "1", mode = "prec_recall")
mc_rn$table Reference
Prediction 0 1
0 11607 1008
1 370 579Métricas
acuracia_rn <- mc_rn$overall["Accuracy"]
precisao_rn <- mc_rn$byClass["Precision"]
recall_rn <- mc_rn$byClass["Recall"]
f1_rn <- mc_rn$byClass["F1"]
metricas_rn <- c(acuracia_rn, precisao_rn, recall_rn, f1_rn)
metricas_rn Accuracy Precision Recall F1
0.8984075 0.6101159 0.3648393 0.4566246 Regressão logística
Pacotes
library(caret)Treinamento
mod_rl = glm(as.factor(classe) ~ ., data = dados_treino, family = binomial("logit"))Classificações
classificacoes_rl <- predict(mod_rl, dados_teste[2:43], type = "response")
classificacoes_rl <- ifelse(classificacoes_rl > 0.5, 1, 0)
classificacoes_rl <- sapply(classificacoes_rl, as.factor)Matriz de confusão
mc_rl <- confusionMatrix(as.factor(classificacoes_rl), as.factor(dados_teste[, 1]),
positive = "1", mode = "prec_recall")
mc_rl$table Reference
Prediction 0 1
0 11815 1291
1 162 296Métricas
acuracia_rl <- mc_rl$overall["Accuracy"]
precisao_rl <- mc_rl$byClass["Precision"]
recall_rl <- mc_rl$byClass["Recall"]
f1_rl <- mc_rl$byClass["F1"]
metricas_rl <- c(acuracia_rl, precisao_rl, recall_rl, f1_rl)
metricas_rl Accuracy Precision Recall F1
0.8928782 0.6462882 0.1865154 0.2894866 SVM
Pacotes
library(e1071)
library(caret)Treinamento
# kernel: rbf; custo:0.3 e gamma:0.1
mod_svm <- svm(as.factor(classe) ~ ., data = dados_treino, kernel = "radial", cost = 0.3,
gamma = 0.1)Classificações
classificacoes_svm <- predict(mod_svm, dados_teste[, -1])Matriz de confusão
mc_svm <- confusionMatrix(as.factor(classificacoes_svm), as.factor(dados_teste[,
1]), positive = "1", mode = "prec_recall")
mc_svm$table Reference
Prediction 0 1
0 11768 1098
1 209 489Métricas
acuracia_svm <- mc_svm$overall["Accuracy"]
precisao_svm <- mc_svm$byClass["Precision"]
recall_svm <- mc_svm$byClass["Recall"]
f1_svm <- mc_svm$byClass["F1"]
metricas_svm <- c(acuracia_svm, precisao_svm, recall_svm, f1_svm)
metricas_svm Accuracy Precision Recall F1
0.9036420 0.7005731 0.3081285 0.4280088 XGBoost
library(xgboost)
library(caret)Split
# XGBoost precisa do dataset em formato de matriz e de atributos e classe
# separados
set.seed(1234)
amostra <- sample(1:nrow(dados), nrow(dados) * 0.7, replace = FALSE)
dados_treino <- dados[amostra, ]
dados_teste <- dados[-amostra, ]
label_treino <- as.numeric(dados_treino[, 1])
label_treino <- ifelse(label_treino == 1, 1, 0)
label_teste <- as.numeric(dados_teste[, 1])
label_teste <- ifelse(label_teste == 1, 1, 0)
label_teste <- sapply(label_teste, as.factor)
dados_treino <- as.matrix(dados_treino[, -1])
dados_teste <- as.matrix(dados_teste[, -1])Treinamento
# profundidade máxima das árvores:10; taxa de aprendizagem: 0.1; 4 threads para
# processar; 100 iterações; classe binária
mod_xgboost <- xgboost(data = dados_treino, label = label_treino, max.depth = 10,
eta = 0.1, nthread = 4, nrounds = 100, objective = "binary:logistic")[03:24:19] WARNING: amalgamation/../src/learner.cc:1061: Starting in XGBoost 1.3.0, the default evaluation metric used with the objective 'binary:logistic' was changed from 'error' to 'logloss'. Explicitly set eval_metric if you'd like to restore the old behavior.
[1] train-logloss:0.620121
[2] train-logloss:0.560138
[3] train-logloss:0.510011
[4] train-logloss:0.466530
[5] train-logloss:0.429026
[6] train-logloss:0.397094
[7] train-logloss:0.368925
[8] train-logloss:0.344449
[9] train-logloss:0.322770
[10] train-logloss:0.303598
[11] train-logloss:0.286754
[12] train-logloss:0.271805
[13] train-logloss:0.258299
[14] train-logloss:0.246145
[15] train-logloss:0.235085
[16] train-logloss:0.225461
[17] train-logloss:0.216735
[18] train-logloss:0.208905
[19] train-logloss:0.201693
[20] train-logloss:0.194875
[21] train-logloss:0.188897
[22] train-logloss:0.183516
[23] train-logloss:0.178304
[24] train-logloss:0.173588
[25] train-logloss:0.169805
[26] train-logloss:0.165978
[27] train-logloss:0.162682
[28] train-logloss:0.159377
[29] train-logloss:0.156210
[30] train-logloss:0.153590
[31] train-logloss:0.151233
[32] train-logloss:0.148606
[33] train-logloss:0.146528
[34] train-logloss:0.144308
[35] train-logloss:0.142231
[36] train-logloss:0.140434
[37] train-logloss:0.138849
[38] train-logloss:0.137517
[39] train-logloss:0.135869
[40] train-logloss:0.134342
[41] train-logloss:0.132941
[42] train-logloss:0.131590
[43] train-logloss:0.130202
[44] train-logloss:0.128997
[45] train-logloss:0.127563
[46] train-logloss:0.126781
[47] train-logloss:0.125591
[48] train-logloss:0.124887
[49] train-logloss:0.123962
[50] train-logloss:0.123116
[51] train-logloss:0.122318
[52] train-logloss:0.121588
[53] train-logloss:0.120853
[54] train-logloss:0.119852
[55] train-logloss:0.119051
[56] train-logloss:0.118352
[57] train-logloss:0.117625
[58] train-logloss:0.117191
[59] train-logloss:0.116134
[60] train-logloss:0.115067
[61] train-logloss:0.114468
[62] train-logloss:0.113777
[63] train-logloss:0.113094
[64] train-logloss:0.112405
[65] train-logloss:0.111512
[66] train-logloss:0.110826
[67] train-logloss:0.110437
[68] train-logloss:0.110195
[69] train-logloss:0.109397
[70] train-logloss:0.108938
[71] train-logloss:0.108470
[72] train-logloss:0.108253
[73] train-logloss:0.107931
[74] train-logloss:0.107764
[75] train-logloss:0.107250
[76] train-logloss:0.106522
[77] train-logloss:0.105654
[78] train-logloss:0.105250
[79] train-logloss:0.105040
[80] train-logloss:0.104587
[81] train-logloss:0.103956
[82] train-logloss:0.103029
[83] train-logloss:0.102391
[84] train-logloss:0.101889
[85] train-logloss:0.101478
[86] train-logloss:0.101111
[87] train-logloss:0.100868
[88] train-logloss:0.100734
[89] train-logloss:0.100506
[90] train-logloss:0.100388
[91] train-logloss:0.100314
[92] train-logloss:0.100142
[93] train-logloss:0.099945
[94] train-logloss:0.099761
[95] train-logloss:0.099055
[96] train-logloss:0.098092
[97] train-logloss:0.097989
[98] train-logloss:0.097306
[99] train-logloss:0.096803
[100] train-logloss:0.096430 Classificações
classificacoes_xgboost <- predict(mod_xgboost, dados_teste)
classificacoes_xgboost <- ifelse(classificacoes_xgboost > 0.5, 1, 0)
classificacoes_xgboost <- sapply(classificacoes_xgboost, as.factor)Matriz de confusão
mc_xgboost <- confusionMatrix(classificacoes_xgboost, label_teste, positive = "1",
mode = "prec_recall")
mc_xgboost$table Reference
Prediction 0 1
0 11440 796
1 530 798Métricas
acuracia_xgboost <- mc_xgboost$overall["Accuracy"]
precisao_xgboost <- mc_xgboost$byClass["Precision"]
recall_xgboost <- mc_xgboost$byClass["Recall"]
f1_xgboost <- mc_xgboost$byClass["F1"]
metricas_xgboost <- c(acuracia_xgboost, precisao_xgboost, recall_xgboost, f1_xgboost)
metricas_xgboost Accuracy Precision Recall F1
0.9022412 0.6009036 0.5006274 0.5462012 COMPARAÇÃO
row_names <- c("Adaboost", "Árvores de decisão", "Gradient boosting", "kNN", "Naive Bayes",
"Random forest", "Redes neurais", "Regressão logística", "SVM", "XGBoost")
col_names <- c("Acurácia", "Precisão", "Recall", "F1")
data = c(metricas_adaboost, metricas_arvores, metricas_gb, metricas_knn, metricas_nb,
metricas_rf, metricas_rn, metricas_rl, metricas_svm, metricas_xgboost)
tbl_comp <- matrix(ncol = 4, data = data, byrow = TRUE)
dimnames(tbl_comp) <- list(row_names, col_names)library(DT)
DT::datatable(tbl_comp, options = list(dom = "t")) %>% formatPercentage(1:4, digits = 1)PRODUÇÃO
Após escolher o algoritmo que entrará em produção, pode-se salvá-lo no formato .rds para fazer as previsões.
O exemplo abaixo salva o modelo SVM, que teve maior precisão. Assumindo que o banco entrará em contato com todos os clientes classificados como compradores (classe=1), faz sentido escolher o algoritmo que se saiu melhor nessa métrica.
saveRDS(mod_svm, "mod_final.rds")Para carregá-lo:
mod_final <- readRDS("mod_final.rds")Para fazer uma nova classificação:
novo_cliente <- c(-1.124068, -0.07825628, 0.9845124, -0.9015068, -0.5693443, -0.4114486,
-0.2519376, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
nova_classificacao <- predict(mod_final, matrix(novo_cliente, ncol = 42))
paste("Classificação:", as.vector(nova_classificacao))[1] "Classificação: 0"Assim, o algoritmo prevê que esse novo_cliente não comprará o produto bancário.