Classificação de Deputados Eleitos - 2014 utilizando caret package
Julie Pessoa
March 3, 2018
Comparação de Modelos de classificação, utilizados para prever se um canditato vai ser eleito ou não, de acordo com os dados de 2014.
Carregando os dados
library(readr)
library(dplyr)
library(caret)
train <- read_csv("train.csv")
train$nome <- as.factor(train$nome)
train$UF <- as.factor(train$UF)
train$partido <- as.factor(train$partido)
train$setor_economico_receita <- as.factor(train$setor_economico_receita)
train$setor_economico_despesa <- as.factor(train$setor_economico_despesa)
train$sexo <- as.factor(train$sexo)
train$grau <- as.factor(train$grau)
train$estado_civil <- as.factor(train$estado_civil)
train$descricao_ocupacao <- as.factor(train$descricao_ocupacao)
train$descricao_cor_raca <- as.factor(train$descricao_cor_raca)
train$situacao_final <- as.factor(train$situacao_final)
trainS <- subset(train, select=c("UF", "partido", "quantidade_doacoes", "quantidade_doadores", "total_receita", "media_receita", "quantidade_despesas", "quantidade_fornecedores", "total_despesa", "media_despesa", "idade", "sexo", "estado_civil", "despesa_max_campanha", "situacao_final"))Há desbalanceamento das classes (isto é, uma classe tem muito mais instâncias que outra)? Em que proporção? Quais efeitos colaterais o desbalanceamento de classes pode causar no classificador?
summary(trainS$situacao_final)## eleito nao_eleito
## 416 3719Podemos observar que a classe está absolutamente desbalanceada, 10% dos dados são categorizados como eleitos e 90% como não eleitos. Isso pode prejudicar o treino, pois os modelos podem presumir que 90% é categorizado como não eleito, sem aprender efetivamente nada sobre os dados. O caso ideal seria que fossem 50% de cada categoria. Para resolver esse problema há duas técnicas, o oversampling que resumidamente é adicionar objetos da categoria que está em desvantagem até que os dados fiquem balanceados, e há o undersampling que é remover os objetos da categoria de maior quantidade, até que as categorias estejam na mesma quantidade. É possível lidar com isso no pacote caret, utilizando sampling="down" ou sampling="up" como parametro da função trainControl.
Treine: um modelo de regressão logística, uma árvore de decisão e um modelo de adaboost. Tune esses modelos usando validação cruzada e controle overfitting se necessário, considerando as particularidades de cada modelo.
Definindo colunas e particionando os dados em treino e validação
#Particionando os dados, 70% para treino e 30% para validação
split <- createDataPartition(y = trainS$situacao_final, p = 0.70, list = FALSE)
treino <- trainS[split,]
validacao <- trainS[-split,]
# Selecionando as colunas para utilizar no treino dos modelos
formula = as.formula(situacao_final ~ .)
# Função de controle
controle <- trainControl(method = "repeatedcv", number = 5, repeats=5, classProbs = TRUE, sampling = 'down', search='random')Treinando os modelos
# Regressão logística
regressao_log <- train(formula,data = treino,
method = "glm",
trControl = controle,
tuneLength=5,
family="binomial")
# Arvore de Decisão
arvore_decisao <- train(formula, data = treino,
method = "rpart",
parms = list(split = "gini"),
trControl= controle,
tuneLength = 5)
#RandomForest
tunegrid <- expand.grid(.mtry=c(1:15))
random_Forest <- train(formula, data=treino,
method="rf",
tunegrid=tunegrid,
trControl=controle)
# Stochastic Gradient Boosting
sgb <- train(formula, data=treino, method="gbm", trControl=controle, verbose=FALSE, tuneLength=3)Reporte acurácia, precision, recall e f-measure no treino e validação. Como você avalia os resultados? Justifique sua resposta.
Regressão Logística
predRL <- predict(regressao_log, newdata=validacao)
cmRL <- confusionMatrix(data=predRL, validacao$situacao_final)## Reference
## Prediction eleito nao_eleito
## eleito 111 116
## nao_eleito 13 999## Accuracy
## 0.8958838## Precision
## 0.4889868## Recall
## 0.8951613## F1
## 0.6324786Arvore de decisão
predAD <- predict(arvore_decisao, newdata=validacao)
cmAd <- confusionMatrix(data=predAD, validacao$situacao_final)## Reference
## Prediction eleito nao_eleito
## eleito 114 120
## nao_eleito 10 995## Accuracy
## 0.8950767## Precision
## 0.4871795## Recall
## 0.9193548## F1
## 0.6368715Random Forest
predRF <- predict(random_Forest, newdata=validacao)
cmRF <- confusionMatrix(data=predRF, validacao$situacao_final)## Reference
## Prediction eleito nao_eleito
## eleito 115 127
## nao_eleito 9 988## Accuracy
## 0.8902341## Precision
## 0.4752066## Recall
## 0.9274194## F1
## 0.6284153Stochastic Gradient Boosting
predSGB <- predict(arvore_decisao, newdata=validacao)
cmSGB <- confusionMatrix(data=predSGB, validacao$situacao_final)## Reference
## Prediction eleito nao_eleito
## eleito 114 120
## nao_eleito 10 995## Accuracy
## 0.8950767## Precision
## 0.4871795## Recall
## 0.9193548## F1
## 0.6368715Interprete as saídas dos modelos. Quais atributos parecem ser mais importantes de acordo com cada modelo? Crie pelo menos um novo atributo que não está nos dados originais e estude o impacto desse atributo.
Regressão Logística
varImp(regressao_log)## glm variable importance
##
## only 20 most important variables shown (out of 71)
##
## Overall
## `estado_civilSOLTEIRO(A)` 100.00
## quantidade_despesas 96.04
## quantidade_doacoes 95.20
## media_receita 90.07
## media_despesa 86.35
## quantidade_fornecedores 82.83
## despesa_max_campanha 76.49
## UFSE 67.70
## UFRR 61.73
## UFAP 57.67
## UFMA 56.91
## UFPE 50.91
## UFPB 50.43
## idade 45.71
## UFES 45.55
## UFAL 45.55
## UFSC 44.24
## UFPR 43.90
## sexoMASCULINO 40.23
## UFRN 39.81As varáveis mais importantes da Regressão logística estão em sua maioria associadas aos partidos. Pode fazer sentido, visto que nos partidos que tem menos candidatos fica mais fácil de saber a porcentagem dos que foram eleitos ou não do que os partidos maiores. Também é levado em consideração a quantidade de despesas que é sempre um ponto crucial de uma campanha. Podemos notar que a importância das variáveis são bem distribuídas o queleva a acreditar que o modelo está complexo, levando em conta várias variáveis para o resultado.
Árvore de Decisão
varImp(arvore_decisao)## rpart variable importance
##
## only 20 most important variables shown (out of 72)
##
## Overall
## total_despesa 100.00
## total_receita 100.00
## quantidade_despesas 82.45
## quantidade_fornecedores 76.58
## media_receita 72.36
## partidoPROS 0.00
## UFMA 0.00
## partidoPT 0.00
## partidoPMN 0.00
## partidoPPL 0.00
## partidoPRP 0.00
## partidoPV 0.00
## quantidade_doadores 0.00
## UFBA 0.00
## partidoPSL 0.00
## UFSC 0.00
## partidoPDT 0.00
## despesa_max_campanha 0.00
## `estado_civilDIVORCIADO(A)` 0.00
## partidoSD 0.00Já na árvore de decisão podemos notar que há bem menos variáveis importantes do que o modelo anterior. E praticamente todas elas são relacionadas as despesas e receitas da campanha. Novamente o “dinheiro” se destacando na definição do modelo, e parece retratar a realidade.
Random Forest
varImp(random_Forest)## rf variable importance
##
## only 20 most important variables shown (out of 72)
##
## Overall
## total_receita 100.0000
## total_despesa 91.1694
## quantidade_despesas 48.5557
## quantidade_fornecedores 26.7309
## media_receita 25.2994
## quantidade_doadores 21.4598
## quantidade_doacoes 16.7798
## media_despesa 10.9278
## despesa_max_campanha 5.4194
## idade 4.2423
## partidoPMN 1.1748
## UFPR 1.1214
## sexoMASCULINO 0.9934
## partidoPSC 0.9910
## partidoPEN 0.9207
## partidoPSDB 0.7763
## UFSP 0.6928
## estado_civilDIVORCIADO(A) 0.6523
## partidoPHS 0.5847
## partidoPDT 0.5421Novamente, assim como no modelo de Árvore de decisão, as variaveis relacionadas a dinheiro são mais importantes.
Random Forest
head(summary(sgb))
## var rel.inf
## total_receita total_receita 66.251465
## quantidade_despesas quantidade_despesas 5.640988
## media_receita media_receita 5.309507
## media_despesa media_despesa 5.181066
## quantidade_doadores quantidade_doadores 4.944599
## idade idade 3.250585Nesse caso o total de receitas e despesas tem muito mais importância do que as outras variáveis do modelo.
Novo Atributo
novo_treino <- treino
novo_treino$despesaC <- ""
novo_treino$despesaC[novo_treino$total_despesa <= 1000] <- "cem"
novo_treino$despesaC[novo_treino$total_despesa > 1000 & novo_treino$total_despesa <= 10000] <- "mil"
novo_treino$despesaC[novo_treino$total_despesa > 10000 & novo_treino$total_despesa <= 100000] <- "dez mil"
novo_treino$despesaC[novo_treino$total_despesa > 100000 & novo_treino$total_despesa <= 1000000] <- "cem mil"
novo_treino$despesaC[novo_treino$total_despesa > 1000000] <- "milhao"
novo_treino$despesaC <- as.factor(novo_treino$despesaC)
nova_validacao <- validacao
nova_validacao$despesaC <- ""
nova_validacao$despesaC[nova_validacao$total_despesa <= 1000] <- "cem"
nova_validacao$despesaC[nova_validacao$total_despesa > 1000 & nova_validacao$total_despesa <= 10000] <- "mil"
nova_validacao$despesaC[nova_validacao$total_despesa > 10000 & nova_validacao$total_despesa <= 100000] <- "dez mil"
nova_validacao$despesaC[nova_validacao$total_despesa > 100000 & nova_validacao$total_despesa <= 1000000] <- "cem mil"
nova_validacao$despesaC[nova_validacao$total_despesa > 1000000] <- "milhao"
nova_validacao$despesaC <- as.factor(nova_validacao$despesaC)# Regressão logística
regressao_log2 <- train(formula,data = novo_treino,
method = "glm",
trControl = controle,
tuneLength=5,
family="binomial")
# Arvore de Decisão
arvore_decisao2 <- train(formula, data = novo_treino,
method = "rpart",
parms = list(split = "gini"),
trControl= controle,
tuneLength = 5)
#RandomForest
random_Forest2 <- train(formula, data=novo_treino,
method="rf",
tunegrid=tunegrid,
trControl=controle)
# Stochastic Gradient Boosting
sgb2 <- train(formula, data=novo_treino, method="gbm", trControl=controle, verbose=FALSE, tuneLength=3)Avaliando os modelos com a nova variável
predRL2 <- predict(regressao_log2, newdata=nova_validacao)
confusionMatrix(data=predRL2, validacao$situacao_final)## Confusion Matrix and Statistics
##
## Reference
## Prediction eleito nao_eleito
## eleito 116 134
## nao_eleito 8 981
##
## Accuracy : 0.8854
## 95% CI : (0.8663, 0.9026)
## No Information Rate : 0.8999
## P-Value [Acc > NIR] : 0.9579
##
## Kappa : 0.5617
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.93548
## Specificity : 0.87982
## Pos Pred Value : 0.46400
## Neg Pred Value : 0.99191
## Prevalence : 0.10008
## Detection Rate : 0.09362
## Detection Prevalence : 0.20178
## Balanced Accuracy : 0.90765
##
## 'Positive' Class : eleito
## varImp(regressao_log2)## glm variable importance
##
## only 20 most important variables shown (out of 76)
##
## Overall
## partidoPTN 100.00
## partidoPTC 92.01
## partidoPSC 86.87
## partidoPR 85.84
## partidoPHS 84.97
## partidoPTB 83.46
## quantidade_fornecedores 83.15
## partidoPMDB 77.63
## partidoPRB 76.39
## partidoPSDB 71.55
## `partidoPC do B` 71.17
## partidoPSOL 68.37
## partidoPEN 66.63
## partidoPSB 66.33
## media_receita 63.96
## despesa_max_campanha 60.67
## partidoPRP 59.80
## partidoPPS 58.40
## partidoSD 56.97
## partidoPDT 56.89predAD2 <- predict(arvore_decisao2, newdata=nova_validacao)
confusionMatrix(data=predAD2, validacao$situacao_final)## Confusion Matrix and Statistics
##
## Reference
## Prediction eleito nao_eleito
## eleito 114 122
## nao_eleito 10 993
##
## Accuracy : 0.8935
## 95% CI : (0.8749, 0.9101)
## No Information Rate : 0.8999
## P-Value [Acc > NIR] : 0.7908
##
## Kappa : 0.578
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.91935
## Specificity : 0.89058
## Pos Pred Value : 0.48305
## Neg Pred Value : 0.99003
## Prevalence : 0.10008
## Detection Rate : 0.09201
## Detection Prevalence : 0.19048
## Balanced Accuracy : 0.90497
##
## 'Positive' Class : eleito
## varImp(arvore_decisao2)## rpart variable importance
##
## only 20 most important variables shown (out of 76)
##
## Overall
## total_despesa 100.00
## total_receita 100.00
## quantidade_despesas 82.06
## quantidade_fornecedores 77.20
## media_receita 75.25
## partidoPSB 0.00
## UFMG 0.00
## `partidoPC do B` 0.00
## `partidoPT do B` 0.00
## partidoPSOL 0.00
## partidoPRTB 0.00
## UFSP 0.00
## UFBA 0.00
## UFAM 0.00
## `estado_civilSOLTEIRO(A)` 0.00
## UFPE 0.00
## UFRN 0.00
## partidoPCB 0.00
## UFPI 0.00
## partidoPSDB 0.00predRF2 <- predict(random_Forest2, newdata=nova_validacao)
confusionMatrix(data=predRF2, validacao$situacao_final)## Confusion Matrix and Statistics
##
## Reference
## Prediction eleito nao_eleito
## eleito 116 121
## nao_eleito 8 994
##
## Accuracy : 0.8959
## 95% CI : (0.8775, 0.9123)
## No Information Rate : 0.8999
## P-Value [Acc > NIR] : 0.7019
##
## Kappa : 0.5886
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.93548
## Specificity : 0.89148
## Pos Pred Value : 0.48945
## Neg Pred Value : 0.99202
## Prevalence : 0.10008
## Detection Rate : 0.09362
## Detection Prevalence : 0.19128
## Balanced Accuracy : 0.91348
##
## 'Positive' Class : eleito
## varImp(random_Forest2)## rf variable importance
##
## only 20 most important variables shown (out of 76)
##
## Overall
## total_receita 100.0000
## total_despesa 95.0577
## media_despesa 6.2297
## quantidade_fornecedores 5.3511
## quantidade_despesas 4.6880
## media_receita 4.6170
## quantidade_doacoes 4.2717
## idade 3.6759
## quantidade_doadores 3.6277
## despesa_max_campanha 2.2131
## partidoPSC 1.4004
## partidoPHS 1.3278
## UFSC 0.9226
## UFMG 0.8664
## partidoPEN 0.8617
## partidoPT do B 0.8361
## UFRJ 0.7649
## partidoPR 0.6597
## partidoPC do B 0.6575
## UFAL 0.6550predSGB2 <- predict(sgb2, newdata=nova_validacao)
confusionMatrix(data=predSGB2, validacao$situacao_final)## Confusion Matrix and Statistics
##
## Reference
## Prediction eleito nao_eleito
## eleito 102 89
## nao_eleito 22 1026
##
## Accuracy : 0.9104
## 95% CI : (0.8931, 0.9257)
## No Information Rate : 0.8999
## P-Value [Acc > NIR] : 0.1172
##
## Kappa : 0.5989
## Mcnemar's Test P-Value : 3.742e-10
##
## Sensitivity : 0.82258
## Specificity : 0.92018
## Pos Pred Value : 0.53403
## Neg Pred Value : 0.97901
## Prevalence : 0.10008
## Detection Rate : 0.08232
## Detection Prevalence : 0.15416
## Balanced Accuracy : 0.87138
##
## 'Positive' Class : eleito
## head(summary(sgb2), n=10)
## var rel.inf
## total_receita total_receita 73.713083
## quantidade_doacoes quantidade_doacoes 4.862358
## media_receita media_receita 4.600101
## media_despesa media_despesa 4.165663
## quantidade_despesas quantidade_despesas 2.749619
## quantidade_doadores quantidade_doadores 2.583523
## quantidade_fornecedores quantidade_fornecedores 2.017010
## idade idade 1.609720
## total_despesa total_despesa 1.442431
## despesa_max_campanha despesa_max_campanha 1.207464Não houve nenhuma alteração significante nos modelos com essa nova variável.
Comparando os modelos
A diferença entre os modelos, em relação a Acuracia, precision, recall e F-measure é bem pequena. Tanto que analisando os Scores do kaggle de cada modelo, tivemos:
- Modelo SGB: 0.8932
- Modelo RL: 0.87747
- Modelo AD e RF: 0.87154
Portanto, nesse caso o modelo de Stochastic Gradient Boosting teve um desempenho melhor em coparação aos outros modelos.