Previsão com árvore de decisão
Resumo
Esse documento tem como objetivo criar um classificador de sucesso em campanhas de marketing realizadas por um banco português.
Base de dados
## Pacotes
library(tidyverse)
library(ggthemes)
library(DT)
## Importação de dados
setwd("/cloud/project/Bank_Marketing")
df1 <- read.csv("bank.csv",sep = ";",header = T)A base de dados vem do kaggle, ela é composta por 21 colunas e 40.617 linhas.
Nossa variavel a ser prevista assume valores yes e no, sigficando sucesso ou fracasso na campanha de marketing respectivamente.
Valores NA
Vamos verificar se há muitos valores NA`s, na qual podem complicar nossa análise.
age job marital education default
0 0 0 0 0
housing loan contact month day_of_week
0 0 0 0 0
duration campaign pdays previous poutcome
1 1 1 1 0
emp.var.rate cons.price.idx cons.conf.idx euribor3m nr.employed
1 1 1 1 1
y
0 Balanceamento do dataset
Como temos um problema de classificação binária, temos que verificar se o dataset possui um balanceamento da variavel a ser prevista.
no yes
0.0 0.9 0.1 Notamos que há um problema nas proporçoes, posteriormente iremos lidar com essa situação.
Estrutura dos dados
'data.frame': 40617 obs. of 21 variables:
$ age : int 56 57 37 40 56 45 59 41 24 25 ...
$ job : Factor w/ 12 levels "admin.","blue-collar",..: 4 8 8 1 8 8 1 2 10 8 ...
$ marital : Factor w/ 4 levels "divorced","married",..: 2 2 2 2 2 2 2 2 3 3 ...
$ education : Factor w/ 8 levels "basic.4y","basic.6y",..: 1 4 4 2 4 3 6 8 6 4 ...
$ default : Factor w/ 4 levels "","no","unknown",..: 2 3 2 2 2 3 2 3 2 2 ...
$ housing : Factor w/ 4 levels "","no","unknown",..: 2 2 4 2 2 2 2 2 4 4 ...
$ loan : Factor w/ 4 levels "","no","unknown",..: 2 2 2 2 4 2 2 2 2 2 ...
$ contact : Factor w/ 3 levels "","cellular",..: 3 3 3 3 3 3 3 3 3 3 ...
$ month : Factor w/ 11 levels "","apr","aug",..: 8 8 8 8 8 8 8 8 8 8 ...
$ day_of_week : Factor w/ 6 levels "","fri","mon",..: 3 3 3 3 3 3 3 3 3 3 ...
$ duration : int 261 149 226 151 307 198 139 217 380 50 ...
$ campaign : int 1 1 1 1 1 1 1 1 1 1 ...
$ pdays : int 999 999 999 999 999 999 999 999 999 999 ...
$ previous : int 0 0 0 0 0 0 0 0 0 0 ...
$ poutcome : Factor w/ 4 levels "","failure","nonexistent",..: 3 3 3 3 3 3 3 3 3 3 ...
$ emp.var.rate : num 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 ...
$ cons.price.idx: num 94 94 94 94 94 ...
$ cons.conf.idx : num -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 ...
$ euribor3m : num 4.86 4.86 4.86 4.86 4.86 ...
$ nr.employed : num 5191 5191 5191 5191 5191 ...
$ y : Factor w/ 3 levels "","no","yes": 2 2 2 2 2 2 2 2 2 2 ...Parece que todas as colunas fazem sentido quanto a suas respectivas classes, portanto não há necessidade de transformação.
Dividindo a base de dados
Agora iremos dividir a base de dados em dois, uma parte com as variaveis categóricas e outra parte com as variáveis numéricas.
## Dividindo em categóricas e numéricas
categoricas <- df1 %>% select_if(is.factor)
numericas <- df1 %>% select_if(is.numeric)Variáveis Categóricas
categoricas %>%
gather("Variavel","Valor") %>%
count(Variavel,Valor) %>% filter(Valor != "") %>%
group_by(Variavel) %>%
mutate(Percent = n/sum(n)) %>%
ggplot(aes(reorder(Valor,Percent),Percent)) +
geom_bar(stat = "identity") +
coord_flip() +
labs(x = "",
title = "Porcentagem das variaveis categóricas") +
scale_y_continuous(labels = scales::percent) +
facet_wrap(~Variavel,scales = "free") +
theme_fivethirtyeight() +
theme(axis.text=element_text(size=7))
Variáveis numéricas
### Distribuição de idade
numericas %>%
ggplot(aes(age)) +
geom_histogram(binwidth = 1) +
scale_x_continuous(breaks = seq(from = 0,to = 100,by = 5)) +
theme_fivethirtyeight() +
labs(title = "Distribuição de idade")
## Número de vezes que os clientes foram abordados
numericas %>%
ggplot(aes(campaign)) +
geom_histogram(binwidth = 1) +
scale_x_continuous(breaks = seq(from = 0,to = 15,by = 1)) +
theme_fivethirtyeight() +
labs(title = "Distribuição de n° de campanhas")
Pré - Processamento
Nesta fase iremos descartar duas variáveis que podem viesar nosso modelo. Além, ainda iremos escalonizar nossas variáveis numéricas e juntar a base de dados novamente.
Modelagem parte 1
Como sabemos, nosso dataset é desbalanceado, porém em um primeiro momento iremos rodar o modelo mesmo assim para fins didáticos.
Dividindo a base de dados
## Treinando o modelo
library(caret)
### Árvores de decisão
#### Dividindo os dados
df2 <- df2 %>% filter(y != "")
df2$y <- df2$y %>% as.character()
index <- createDataPartition(df2$y,p = 0.8,list = F)
treino <- df2[index,]
teste <- df2[-index,]
## Recolocando para factor
treino$y <- as.factor(treino$y)
teste$y <- as.factor(teste$y)Criando o modelo
#### criando o modelo
modelo_1 <- train(y ~ .,treino,method = "rpart",
trControl = trainControl(method = "cv"))O modelo foi criado a partir da metodologia de cross validation, onde reparte - se o conjunto de traino em diversas partes mutuamente exclusivas a fim de testar sua capacidade de generalização.
Importancia das variáveis
Nota - se que poucas variáveis são relevantes para o modelo.
Previsão com o modelo
Confusion Matrix
Confusion Matrix and Statistics
Reference
Prediction no yes
no 7141 707
yes 109 165
Accuracy : 0.8995
95% CI : (0.8928, 0.906)
No Information Rate : 0.8926
P-Value [Acc > NIR] : 0.02256
Kappa : 0.2494
Mcnemar's Test P-Value : < 2e-16
Sensitivity : 0.9850
Specificity : 0.1892
Pos Pred Value : 0.9099
Neg Pred Value : 0.6022
Prevalence : 0.8926
Detection Rate : 0.8792
Detection Prevalence : 0.9663
Balanced Accuracy : 0.5871
'Positive' Class : no
O resultado da acurácia da confusion matrix pode levar a argumentos enganosos. Como nosso dataset é desbalanceado, o modelo tende se a viesar para responder quase tudo como a classe de maior proporção, no caso a variavel resposta “não”. Isso leva a ter um baixo índice de especificidade, na qual é a taxa de acerto do modelo em relação aos verdadeiros negativos. No caso em questão, aproximadamente 20%. Para contornar esse problema, iremos fazer uma reamostragem do dataset.
Reamostragem
Para reamostragem, iremos utilizar o método downsample do pacote caret, na qual irá diminuir o nosso dataset para que as variaveis alvo tenham a mesma frequencia.
Concomitantemente iremos usar a técnica SMOTE do pacote DMwR. Nela irá ser criada dados sintéticos para diminuir a diferença de frequencia entre os dados da variavel alvo. Essa técninca é baseado no algoritmo KNN, que busca classificar as variaveis com base na distancia entre elas.
Modelagem parte 2
modelo_down <- train(y ~ .,treino_down,method = "rpart",
trControl = trainControl(method = "cv"))
modelo_smote <- train(y ~ .,treino_smote,method = "rpart",
trControl = trainControl(method = "cv"))Fazendo previsões
Confusion Matrix (Down Sample)
Confusion Matrix and Statistics
Reference
Prediction no yes
no 6321 380
yes 929 492
Accuracy : 0.8388
95% CI : (0.8307, 0.8468)
No Information Rate : 0.8926
P-Value [Acc > NIR] : 1
Kappa : 0.3415
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.8719
Specificity : 0.5642
Pos Pred Value : 0.9433
Neg Pred Value : 0.3462
Prevalence : 0.8926
Detection Rate : 0.7783
Detection Prevalence : 0.8250
Balanced Accuracy : 0.7180
'Positive' Class : no
Confusion Matrix (Smote)
Confusion Matrix and Statistics
Reference
Prediction no yes
no 6321 380
yes 929 492
Accuracy : 0.8388
95% CI : (0.8307, 0.8468)
No Information Rate : 0.8926
P-Value [Acc > NIR] : 1
Kappa : 0.3415
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.8719
Specificity : 0.5642
Pos Pred Value : 0.9433
Neg Pred Value : 0.3462
Prevalence : 0.8926
Detection Rate : 0.7783
Detection Prevalence : 0.8250
Balanced Accuracy : 0.7180
'Positive' Class : no
Resultados
Com o rebalanceamento, a taxa de acurácia cai, porém há um aumento substancial em ambos os casos para a taxa de sensitividade, ou seja, o nosso modelo generaliza melhor para a classe dos verdadeiros negativos.