Lab05

Leitura dos dados

data <- read.csv("data/train.csv")
test <- read.csv("data/test.csv")

Primeiras questões

1. Há desbalanceamento das classes (isto é, uma classe tem muito mais instâncias que outra)?

Para responder essa pergunta, basta compararmos a quantidade de ocorrências de eleito e de nao_eleito

summary(data$situacao_final)

##     eleito nao_eleito 
##        416       3719

Podemos notar que a quantidade de nao_eleito é bastante superior à quantidade de eleito. Assim sendo, é plausivel afirmar que está sim ocorrendo um desbalanceamento.

2. Em que proporção?

totalEleitos <- length(which(data$situacao_final == "eleito"))
totalNaoEleitos <- length(which(data$situacao_final == "nao_eleito"))
total <- totalEleitos + totalNaoEleitos

propEleitos <- totalEleitos / total
propNaoEleitos <- totalNaoEleitos / total

## [1] "Eleitos: 10.06%      Não eleitos: 89.94%"

3. Quais efeitos colaterais o desbalanceamento de classes pode causar no classificador?

Grande parte dos algoritmos de classificação em Machine Learning são afetados por desbalanceamentos em classes preditoras. O principal efeito colateral causado por um desbalanceamento em um classificador é o seu enviesamento, tendo em vista que este irá inclinar-se a escolher a classe mais comum.

Tratamento dos dados

É possível que existam classes que sejam pouco explicativas ou redundantes. Vamos agora analisar algumas possíveis candidatas a serem removidas.

c1 = cor(data$total_despesa, data$quantidade_despesa)
c2 = cor(data$total_despesa, data$despesa_max_campanha)
c3 = cor(data$quantidade_despesas, data$media_despesa)
c4 = cor(data$quantidade_doacoes, data$quantidade_doadores)
c5 = cor(data$quantidade_despesas, data$quantidade_fornecedores)
c6 = cor(data$total_despesa, data$total_receita)

## [1] "0.807287 - Correlação entre total_despesa e quantidade_despesa"

## [1] "0.224068 - Correlação entre total_despesa e despesa_max_campanha"

## [1] "0.079812 - Correlação entre media_despesa e quantidade_despesa"

## [1] "0.861684 - Correlação entre quantidade_doacoes e quantidade_doadores"

## [1] "0.933668 - Correlação entre quantidade_despesas e quantidade_fornecedores"

## [1] "0.994337 - Correlação entre total_receita e total_despesa"

Podemos ver que existe grande correlação entre algumas variáveis, chegando a atingir 0.99. O que indica redundância, e, assim sendo, podemos desconsiderá-las do modelo com segurança.

formula <- as.formula(situacao_final ~ UF + partido + quantidade_doacoes + total_despesa + idade + sexo + grau + descricao_cor_raca + despesa_max_campanha)

Construindo modelos

Agora com os dados tratados podemos dar início à criação dos modelos. Começaremos pelo modelo de regressão logística. Como vimos antes, pelo fato dos dados estarem desbalanceados, vamos usar a técnica de undersampling para lidar com este problema.

Regressão Logística

ctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 3, sampling = "up")
logitModel <- caret::train(formula, data=training, method="glm", family="binomial",
                 trControl = ctrl, tuneLength = 10)

Árvore de decisão

ctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 3, sampling = "up")
set.seed(3333)
decisionTreeModel <- train(formula, data=training, method = "rpart",
                   parms = list(split = "information"),
                   trControl=ctrl,
                   tuneLength = 10)

Adaboost

control <- rpart.control(cp = -1, maxdepth = 14, maxcompete = 1, xval = 0)
adaboostModel <- ada(formula, data = training, type = c("discrete", "real", "gentle"), control = control, iter = 70)

Medindo o desempenho dos modelos

Regressão Logística

pred = predict(logitModel, newdata=testing)
confMatrix <- confusionMatrix(data=pred, testing$situacao_final)

acc  <- confMatrix$overall['Accuracy']
rec  <- recall(confMatrix$table, relevant = "eleito")
pre  <- precision(confMatrix$table, relevant = "eleito")
fmes <- F_meas(confMatrix$table, relevant = "eleito")

##             Reference
## Prediction   eleito nao_eleito
##   eleito        135        108
##   nao_eleito     31       1379

## 
## Accuracy: 0.9159    Recall: 0.8133    Precision: 0.5556    F-Measure:    0.6601

Árvore de Decisão

pred = predict(decisionTreeModel, newdata=testing)
confMatrix <- confusionMatrix(data=pred, testing$situacao_final)

acc  <- confMatrix$overall['Accuracy']
rec  <- recall(confMatrix$table, relevant = "eleito")
pre  <- precision(confMatrix$table, relevant = "eleito")
fmes <- F_meas(confMatrix$table, relevant = "eleito")

##             Reference
## Prediction   eleito nao_eleito
##   eleito        120         85
##   nao_eleito     46       1402

## 
## Accuracy: 0.9208    Recall: 0.7229    Precision: 0.5854    F-Measure:    0.6469

Adaboost

pred = predict(adaboostModel, newdata=testing)
confMatrix <- confusionMatrix(data=pred, testing$situacao_final)

acc  <- confMatrix$overall['Accuracy']
rec  <- recall(confMatrix$table, relevant = "eleito")
pre  <- precision(confMatrix$table, relevant = "eleito")
fmes <- F_meas(confMatrix$table, relevant = "eleito")

##             Reference
## Prediction   eleito nao_eleito
##   eleito        107         56
##   nao_eleito     59       1431

## 
## Accuracy: 0.9304    Recall: 0.6446    Precision: 0.6564    F-Measure:    0.6505

Considerações sobre os resultados

Podemos notar que os modelos não tiveram um desempenho ótimo, mas razoável. Os recalls, com excessão do modelo adaboost, obtiveram um valor encorajador (pouco acima dos 80%) para tentar melhorias como transformação de atributos dos dados, testar novos parâmetros para os modelos, etc. Com a acurácia em torno dos 90%, somos levados a crer que não está ocorrendo um overfitting, pois é esperado que haja uma certa dificuldade em fazer tais predições com dados desbalanceados. Mesmo que estejamos destinando um tratamento, é díficil dizer com precisão o efeito que as estratégias de sampling estão causando nas predições.

Saída dos modelos

Regressão Logística

logitModel

## Generalized Linear Model 
## 
## 2482 samples
##    9 predictor
##    2 classes: 'eleito', 'nao_eleito' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times) 
## Summary of sample sizes: 2234, 2234, 2234, 2234, 2233, 2234, ... 
## Addtional sampling using up-sampling
## 
## Resampling results:
## 
##   Accuracy  Kappa    
##   0.916061  0.6190068

Árvore de Decisão

decisionTreeModel

## CART 
## 
## 2482 samples
##    9 predictor
##    2 classes: 'eleito', 'nao_eleito' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times) 
## Summary of sample sizes: 2233, 2233, 2234, 2234, 2234, 2234, ... 
## Addtional sampling using up-sampling
## 
## Resampling results across tuning parameters:
## 
##   cp          Accuracy   Kappa    
##   0.00000000  0.9136433  0.5975389
##   0.03511111  0.8998078  0.6079361
##   0.07022222  0.8998078  0.6079361
##   0.10533333  0.8998078  0.6079361
##   0.14044444  0.8998078  0.6079361
##   0.17555556  0.8998078  0.6079361
##   0.21066667  0.8998078  0.6079361
##   0.24577778  0.8998078  0.6079361
##   0.28088889  0.8998078  0.6079361
##   0.31600000  0.8998078  0.6079361
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.

Adaboost

adaboostModel

## Call:
## ada(formula, data = training, type = c("discrete", "real", "gentle"), 
##     control = control, iter = 70)
## 
## Loss: exponential Method: discrete   Iteration: 70 
## 
## Final Confusion Matrix for Data:
##             Final Prediction
## True value   eleito nao_eleito
##   eleito        237         13
##   nao_eleito      6       2226
## 
## Train Error: 0.008 
## 
## Out-Of-Bag Error:  0.016  iteration= 62 
## 
## Additional Estimates of number of iterations:
## 
## train.err1 train.kap1 
##         69         69

Adicionando novos atributos

Quando estamos lidando com com ávores de decisão, por exemplo, atributos categóricos facilitam e melhoram muito o desempenho do modelo, pois agrupando os dados em tais categorias (dependendo da quantidade de categorias e da forma do agrupamento) estaremos reduzindo a complexidade do modelo.

Agrupando pela idade

Como a variável da idade possui vários valores distintos, vamos agrupar cada deputado pela quantidade de décadas vividas.

data$idade <- as.integer(data$idade / 10)

Mesma coisa podemos fazer com a total_despesa, já que esta variável possui muitas observações com valores distintos. Vejamos a distribuição de deputados eleitos conforme suas despesas.

ggplot(data = subset(training, training$situacao_final == 'eleito'), aes(x = "", y = total_despesa)) + 
  theme_bw() + 
  geom_boxplot() + 
  scale_y_continuous(labels=comma, breaks=seq(0, 8000000, by = 500000)) + 
  labs(x = "", y = 'Total despesa')

Pelo boxplot, é possível perceber que para se eleger, é necessário que um deputado gaste uma boa quantia. Sendo assim, vamos agrupar os deputados de acordo com esses valores.

#cut(data$total_despesa, breaks = c(0, 500000, 1000000, 5000000, 8000000))
agrupaDespesa <- function(x) {
  res <- 10000
  if(x > 5000000) {
    res <- 5000000
  }
  else if (x > 1000000) {
    res <- 1000000
  }
  else if (x > 500000) {
    res <- 500000
  }
  
  return (as.integer(res))
}
data$total_despesa <- mapply(agrupaDespesa,data$total_despesa)

Agora veremos o impacto que isso trouxe nos modelos.

Regressão Logística

## 
## Accuracy: 0.9129    Recall: 0.8373    Precision: 0.5430    F-Measure:    0.6588

Árvore de Decisão

## 
## Accuracy: 0.9443    Recall: 0.7651    Precision: 0.7056    F-Measure:    0.7341

Adaboost

## 
## Accuracy: 0.9353    Recall: 0.5482    Precision: 0.7398    F-Measure:    0.6298

Podemos ver que esses novos atributos ajudaram bastante na acurárica dos modelos em geral. Principalmente no modelo de Árvore, pois com variáveis categóricas ela se sai melhor.