Predição de Deputados Eleitos
Valter Lucena
20 de novembro de 2018
library(tidyverse)
library(here)
library(caret)
library(ROSE)
theme_set(theme_minimal())Introdução
Nesta análise iremos construir modelos de classificação para a predição da eleição dos candidatos à Câmara Federal de Deputados. Anteriormente, nesta análise, buscamos predizer o total de votos recebidos utilizando técnicas de regressão.
train <- read.csv(here("data/train.csv"))
train %>% names()## [1] "ano"
## [2] "sequencial_candidato"
## [3] "nome"
## [4] "uf"
## [5] "partido"
## [6] "quantidade_doacoes"
## [7] "quantidade_doadores"
## [8] "total_receita"
## [9] "media_receita"
## [10] "recursos_de_outros_candidatos.comites"
## [11] "recursos_de_pessoas_fisicas"
## [12] "recursos_de_pessoas_juridicas"
## [13] "recursos_proprios"
## [14] "recursos_de_partido_politico"
## [15] "quantidade_despesas"
## [16] "quantidade_fornecedores"
## [17] "total_despesa"
## [18] "media_despesa"
## [19] "cargo"
## [20] "sexo"
## [21] "grau"
## [22] "estado_civil"
## [23] "ocupacao"
## [24] "situacao"Perguntas
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? Como você poderia tratar isso?
eleitos <- train %>%
filter(situacao == "eleito") %>%
count(situacao)
nao_eleitos <- train %>%
filter(situacao == "nao_eleito") %>%
count(situacao)
frame = rbind(eleitos, nao_eleitos)
frame %>%
mutate(proporcao = n / (train %>% nrow())) %>%
ggplot(aes(x = situacao,
y = n,
colour = situacao,
label = paste(n,"(",round(proporcao * 100, 2),"%)"))) +
geom_point(size = 2) +
geom_segment(aes(x = situacao,
xend = situacao,
y = 0,
yend = n)) +
geom_text(hjust = 1,
vjust = -1) +
guides(colour = FALSE) +
labs(x = "Situação",
y = "Quantidade de deputados") +
theme() +
coord_flip()
Como podemos observar no gráfico, existe uma grande diferença entre a quantidade de deputados eleitos e não eleitos na base de dados de treino, ou seja, há sim desbalanceamento entre as classes. Nestes dados, 86.54% são da classe nao_eleito e 13.46% são da classe eleito. Um efeito desse desbalanceamento é que as predições realizadas utilizando um modelo que foi treinado com esses dados podem ser enviesadas para a classe majoritária. A solução mais comum para este tipo de problema é realizar uma reamostragem nos dados utilizando undersampling ou oversampling.
- Undersampling: são retiradas aleatoriamente amostras da classe majoritária de forma a igualar a quantidade de observações desta com a classe minoritária. Uma desvantagem dessa abordagem é a perda de informação.
- Oversampling: as observações da classe minoritária são aleatoriamente duplicadas ou são geradas novas observações para se igualar a quantidade de observações da classe majoritária. Nesta abordagem não há risco de perda de informação, mas aumenta-se o risco de que ocorra um overfitting, uma vez que as mesmas amostras podem ser retiradas. Com isto, a capacidade de generalização do modelo seria prejudicada.
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.
Vamos, inicialmente, retirar dos dados as variáveis de identificação de um deputado, e as categóricas de apenas um nível.
train <- train %>%
select(-sequencial_candidato,
-nome,
-cargo,
-uf,
-ocupacao,
-partido,
-estado_civil,
-grau,
-ocupacao)Para obtermos uma estimativa honesta do desempenho de cada modelo, utilizaremos ambas as abordagens para desbalanceamento de forma independente a cada fold da validação cruzada.
Observação: Os códigos para o treinamento dos modelos estão comentados para que não sejam reexecutados durante a geração do html deste relatório.
Modelo de Regressão Logística
# reglogControl <- trainControl(method = "repeatedcv",
# sampling = "smote",
# number = 5,
# repeats = 5,
# verboseIter = TRUE,
# classProbs = TRUE)
#
# regLog <- train(situacao ~ .,
# train,
# method = "regLogistic",
# trControl = reglogControl,
# preProcess = c('scale', 'center', 'nzv'))
# saveRDS(regLog, file = "regLog.rds")
regLog <- readRDS(file = "regLog.rds")
regLog## Regularized Logistic Regression
##
## 7622 samples
## 15 predictor
## 2 classes: 'eleito', 'nao_eleito'
##
## Pre-processing: scaled (15), centered (15)
## Resampling: Cross-Validated (5 fold, repeated 5 times)
## Summary of sample sizes: 6097, 6098, 6098, 6097, 6098, 6098, ...
## Addtional sampling using SMOTE prior to pre-processing
##
## Resampling results across tuning parameters:
##
## cost loss epsilon Accuracy Kappa
## 0.5 L1 0.001 0.9080304 0.6494364
## 0.5 L1 0.010 0.9067178 0.6452874
## 0.5 L1 0.100 0.9065869 0.6392161
## 0.5 L2_dual 0.001 0.9072428 0.6474826
## 0.5 L2_dual 0.010 0.9059046 0.6442057
## 0.5 L2_dual 0.100 0.9075844 0.6470546
## 0.5 L2_primal 0.001 0.9068496 0.6460715
## 0.5 L2_primal 0.010 0.9059567 0.6440351
## 0.5 L2_primal 0.100 0.9088436 0.6457221
## 1.0 L1 0.001 0.9092895 0.6524268
## 1.0 L1 0.010 0.9067707 0.6452842
## 1.0 L1 0.100 0.9084238 0.6431952
## 1.0 L2_dual 0.001 0.9061929 0.6440931
## 1.0 L2_dual 0.010 0.9062719 0.6446972
## 1.0 L2_dual 0.100 0.9064028 0.6449045
## 1.0 L2_primal 0.001 0.9062457 0.6429621
## 1.0 L2_primal 0.010 0.9061405 0.6436491
## 1.0 L2_primal 0.100 0.9091850 0.6476547
## 2.0 L1 0.001 0.9069805 0.6474122
## 2.0 L1 0.010 0.9061144 0.6449711
## 2.0 L1 0.100 0.9082400 0.6428996
## 2.0 L2_dual 0.001 0.9062202 0.6434799
## 2.0 L2_dual 0.010 0.9074001 0.6478712
## 2.0 L2_dual 0.100 0.9066391 0.6467705
## 2.0 L2_primal 0.001 0.9074791 0.6468437
## 2.0 L2_primal 0.010 0.9070593 0.6465582
## 2.0 L2_primal 0.100 0.9089750 0.6459918
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were cost = 1, loss = L1 and epsilon
## = 0.001.plot(regLog)
Modelo KNN (K-Nearest Neighbours)
# knnGrid <- expand.grid(k = seq(1, 25, length=25))
#
# knnControl <- trainControl(method = "repeatedcv",
# sampling = "smote",
# number = 5,
# repeats = 5,
# verboseIter = TRUE,
# classProbs = TRUE)
# knn <- train(situacao ~ .,
# data = train,
# method = "knn",
# trControl = knnControl,
# preProcess = c('scale', 'center', 'nzv'),
# tuneGrid = knnGrid)
#
# saveRDS(knn, file = 'knnModel.rds')
knn <- readRDS(file = 'knnModel.rds')
knn## k-Nearest Neighbors
##
## 7622 samples
## 15 predictor
## 2 classes: 'eleito', 'nao_eleito'
##
## Pre-processing: scaled (15), centered (15)
## Resampling: Cross-Validated (5 fold, repeated 5 times)
## Summary of sample sizes: 6097, 6098, 6098, 6097, 6098, 6098, ...
## Addtional sampling using SMOTE prior to pre-processing
##
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 1 0.8791927 0.5630882
## 2 0.8797694 0.5682332
## 3 0.8824457 0.5871799
## 4 0.8809244 0.5831803
## 5 0.8853327 0.6037881
## 6 0.8843874 0.6027220
## 7 0.8848599 0.6064239
## 8 0.8865131 0.6128691
## 9 0.8854899 0.6118642
## 10 0.8862766 0.6140935
## 11 0.8869854 0.6180154
## 12 0.8860666 0.6157830
## 13 0.8862242 0.6181786
## 14 0.8872741 0.6207073
## 15 0.8858832 0.6181954
## 16 0.8861194 0.6174199
## 17 0.8859094 0.6174503
## 18 0.8859616 0.6190964
## 19 0.8873266 0.6223299
## 20 0.8868543 0.6220977
## 21 0.8868802 0.6216215
## 22 0.8871693 0.6221404
## 23 0.8864868 0.6208397
## 24 0.8858305 0.6194665
## 25 0.8873791 0.6240014
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 25.plot(knn)
Árvore de Decisão
# arvore decisao
# dtControl <- trainControl(method = "repeatedcv",
# number = 5,
# repeats = 5,
# sampling = "smote",
# verboseIter = TRUE,
# classProbs = TRUE)
#
# dtree <- train(situacao ~ .,
# data = train,
# method = "rpart",
# trControl = dtControl,
# preProcess = c('scale', 'center', 'nzv'),
# cp = 0.001)
#
# saveRDS(dtree, 'dtree.rds')
dtree <- readRDS(file = "dtree.rds")
dtree## CART
##
## 7622 samples
## 15 predictor
## 2 classes: 'eleito', 'nao_eleito'
##
## Pre-processing: scaled (15), centered (15)
## Resampling: Cross-Validated (5 fold, repeated 5 times)
## Summary of sample sizes: 6098, 6096, 6098, 6098, 6098, 6098, ...
## Addtional sampling using SMOTE prior to pre-processing
##
## Resampling results across tuning parameters:
##
## cp Accuracy Kappa
## 0.02631579 0.8697459 0.5919826
## 0.04434698 0.8697459 0.5919826
## 0.26315789 0.8697459 0.5919826
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.2631579.library(rpart.plot)## Loading required package: rpartrpart.plot(dtree$finalModel)
Adaboost
# adaboost
# adaGrid <- expand.grid(nIter = seq(1, 25, length = 25),
# method = c("Adaboost.M1", "Real adaboost"))
#
# adaControl <- trainControl(method = "repeatedcv",
# sampling = "smote",
# number = 5,
# repeats = 5,
# verboseIter = TRUE,
# classProbs = TRUE)
#
# adaboost <- train(situacao ~ .,
# train,
# method = "adaboost",
# trControl = adaControl,
# preProcess = c("scale", "center", "nzv"),
# tuneGrid = adaGrid)
#
# saveRDS(adaboost, file = "adaboost.rds")
adaboost <- readRDS(file = "adaboost.rds")
adaboost## AdaBoost Classification Trees
##
## 7622 samples
## 15 predictor
## 2 classes: 'eleito', 'nao_eleito'
##
## Pre-processing: scaled (15), centered (15)
## Resampling: Cross-Validated (5 fold, repeated 5 times)
## Summary of sample sizes: 6098, 6098, 6098, 6097, 6097, 6097, ...
## Addtional sampling using SMOTE prior to pre-processing
##
## Resampling results across tuning parameters:
##
## nIter method Accuracy Kappa
## 1 Adaboost.M1 0.8821827 0.5837685
## 1 Real adaboost 0.8833373 0.5802539
## 2 Adaboost.M1 0.8932293 0.5554477
## 2 Real adaboost 0.8784569 0.5797449
## 3 Adaboost.M1 0.8855159 0.5946930
## 3 Real adaboost 0.8827863 0.5861693
## 4 Adaboost.M1 0.8952768 0.5935230
## 4 Real adaboost 0.8825496 0.5897908
## 5 Adaboost.M1 0.8865120 0.6001275
## 5 Real adaboost 0.8860137 0.6011555
## 6 Adaboost.M1 0.8921016 0.5990891
## 6 Real adaboost 0.8859874 0.6026205
## 7 Adaboost.M1 0.8894246 0.6059423
## 7 Real adaboost 0.8874045 0.6098793
## 8 Adaboost.M1 0.8891355 0.6058299
## 8 Real adaboost 0.8879560 0.6130600
## 9 Adaboost.M1 0.8924685 0.6173202
## 9 Real adaboost 0.8874836 0.6110666
## 10 Adaboost.M1 0.8938597 0.6178342
## 10 Real adaboost 0.8871679 0.6141540
## 11 Adaboost.M1 0.8889528 0.6066790
## 11 Real adaboost 0.8881915 0.6176244
## 12 Adaboost.M1 0.8935712 0.6130248
## 12 Real adaboost 0.8884280 0.6170411
## 13 Adaboost.M1 0.8908421 0.6155074
## 13 Real adaboost 0.8890838 0.6211169
## 14 Adaboost.M1 0.8926790 0.6105323
## 14 Real adaboost 0.8906580 0.6256088
## 15 Adaboost.M1 0.8907377 0.6144705
## 15 Real adaboost 0.8902120 0.6253627
## 16 Adaboost.M1 0.8955914 0.6206552
## 16 Real adaboost 0.8887166 0.6212757
## 17 Adaboost.M1 0.8895297 0.6104140
## 17 Real adaboost 0.8905536 0.6252103
## 18 Adaboost.M1 0.8944105 0.6213767
## 18 Real adaboost 0.8904741 0.6262107
## 19 Adaboost.M1 0.8926524 0.6219089
## 19 Real adaboost 0.8891366 0.6229902
## 20 Adaboost.M1 0.8944634 0.6230453
## 20 Real adaboost 0.8887691 0.6222254
## 21 Adaboost.M1 0.8933346 0.6234762
## 21 Real adaboost 0.8894518 0.6251653
## 22 Adaboost.M1 0.8932033 0.6213388
## 22 Real adaboost 0.8902125 0.6270193
## 23 Adaboost.M1 0.8932298 0.6223495
## 23 Real adaboost 0.8904228 0.6266227
## 24 Adaboost.M1 0.8928624 0.6217640
## 24 Real adaboost 0.8900283 0.6269234
## 25 Adaboost.M1 0.8927314 0.6214274
## 25 Real adaboost 0.8904747 0.6276452
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were nIter = 16 and method
## = Adaboost.M1.plot(adaboost)
Reporte precision, recall e f-measure no treino e validação. Há uma grande diferença de desempenho no treino/validação? Como você avalia os resultados? Justifique sua resposta.
Todas essas medidas são calculadas em termos de Verdadeiros Positivos (TP), Verdadeiros Negativos (TN), Falsos Positivos (FP) e Falsos Negativos (FN), ou seja, na quantidade de observações onde um candidato previsto como eleito ou não eleito realmente se elegeu ou não se elegeu. Cada medida representa o seguinte:
- Precision: razão entre observações previstas como positivas corretamente (TP) e o total de observações previstas como positivas (TP + FP)
precision <- function(TP, FP) {
result <- TP / (TP + FP)
return(result)
}- Recall: proporção de observações previstas como positivas corretamente (TP) entre todas as observações da classe atual (TP + FN)
recall <- function(TP,FN) {
result <- TP / (TP + FN)
return(result)
}- F-measure: média ponderada entre precision e recall. Leva em consideração tanto os falso positivos como os falsos negativos
fmeasure <- function(precision, recall) {
result <- 2 * (precision * recall) / (precision + recall)
}Pra o modelo de Regressão Logística, temos:
matriz.regLog <- confusionMatrix(regLog)
regLog.precision <- precision(matriz.regLog$table[1], matriz.regLog$table[3])
regLog.recall <- recall(matriz.regLog$table[1], matriz.regLog$table[2])
regLog.fmeasure <- fmeasure(regLog.precision, regLog.recall)
regLog.precision## [1] 0.6270697regLog.recall## [1] 0.8046784regLog.fmeasure## [1] 0.7048579Pra o modelo KNN, temos:
matriz.knn <- confusionMatrix(knn)
knn.precision <- precision(matriz.knn$table[1], matriz.knn$table[3])
knn.recall <- recall(matriz.knn$table[1], matriz.knn$table[2])
knn.fmeasure <- fmeasure(knn.precision, knn.recall)
knn.precision## [1] 0.5488459knn.recall## [1] 0.9177388knn.fmeasure## [1] 0.6868982Pra a árvore de decisão, temos:
matriz.dtree <- confusionMatrix(dtree)
dtree.precision <- precision(matriz.dtree$table[1], matriz.dtree$table[3])
dtree.recall <- recall(matriz.dtree$table[1], matriz.dtree$table[2])
dtree.fmeasure <- fmeasure(dtree.precision, dtree.recall)
dtree.precision## [1] 0.5086297dtree.recall## [1] 0.9536062dtree.fmeasure## [1] 0.663412Para o modelo de Adaboost, temos:
matriz.adaboost <- confusionMatrix(adaboost)
adaboost.precision <- precision(matriz.adaboost$table[1], matriz.adaboost$table[3])
adaboost.recall <- recall(matriz.adaboost$table[1], matriz.adaboost$table[2])
adaboost.fmeasure <- fmeasure(adaboost.precision, adaboost.recall)
adaboost.precision## [1] 0.578588adaboost.recall## [1] 0.8259259adaboost.fmeasure## [1] 0.6804786Interprete as saídas dos modelos. Quais atributos parecem ser mais importantes de acordo com cada modelo?
ggplot(varImp(dtree))
Para a árvore de decisão, as variáveis mais importantes foram total_receita, total_despesa, recursos_de_pessoas_juridicas, quantidade_despesas e quantidade_fornecedores.
Envie seus melhores modelos à competição do Kaggle. Faça pelo menos uma submissão. Sugestões para melhorar o modelo:
# best.model.grid <- expand.grid(adaboost$bestTune)
# best.model <- train(situacao ~ .,
# train,
# method = "adaboost",
# trControl = trainControl(verboseIter = TRUE),
# tuneGrid = best.model.grid)
# saveRDS(best.model, file="bestModel.rds")
best.model <- readRDS(file="bestModel.rds")
best.model## AdaBoost Classification Trees
##
## 7622 samples
## 15 predictor
## 2 classes: 'eleito', 'nao_eleito'
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 7622, 7622, 7622, 7622, 7622, 7622, ...
## Resampling results:
##
## Accuracy Kappa
## 0.904791 0.5785824
##
## Tuning parameter 'nIter' was held constant at a value of 16
##
## Tuning parameter 'method' was held constant at a value of Adaboost.M1Primeiramente vamos aplicar todas as modificações do modelo de treino no modelo de teste.
test <- read.csv(here("data/test.csv"))
submission <- test %>% select(sequencial_candidato)
test <- test %>%
select(-sequencial_candidato,
-nome,
-cargo,
-uf,
-ocupacao,
-partido,
-estado_civil,
-grau,
-ocupacao)
predictions <- predict(best.model, test)
submission$situacao <- predictions
submission <- submission %>%
select(Id = sequencial_candidato,
Predicted = situacao)
write.csv(x = submission,
file = "sample_submission.csv",
row.names = FALSE)