data <- read.csv("data/lab03/train.csv")
#divide treino e teste
set.seed(101)
index <- createDataPartition(data$situacao, p = 0.7, list = FALSE)
train.data <- data[index,]
test.data <- data[-index,]
input.train <- train.data %>%
select(-cargo, -nome, -ocupacao, -ano, -sequencial_candidato, -uf, -sexo, -estado_civil, -grau, -partido)
input.test <- test.data %>%
select(-cargo, -nome, -ocupacao, -ano, -sequencial_candidato, -uf, -sexo, -estado_civil, -grau, -partido)
summary(train.data$situacao)
## eleito nao_eleito
## 719 4618
round((summary(train.data$situacao)/sum(summary(train.data$situacao))), 2)
## eleito nao_eleito
## 0.13 0.87
Podemos observar desbalanceamento das classes, considerando situacao, que é a variável alvo. Há muito mais ocorrências de nao_eleito, cerca de 87%, contra uma proporção bem menor em relação a candidatos que foram eleitos, representando cerca de 13% do conjunto total. Essa situação pode fazer com que os modelos produzidos classifiquem de forma incorreta os dados reais. Isso acontece porque geralmente modelos de classificação são mais sensíveis a classes desbalanceadas, fazendo com que o modelo final tenha uma tendência de predizer a classe com um maior número de ocorrências.
De forma a não afetar tanto o modelo final, uma abordagem possível é balancear as classes. Dessa maneira é possível aproximar o número de instâncias da classe, permitindo que o modelo seja treinado e testado sem ser muito afetado pelo desbalanceamento. Para que isso seja feito, é possível aumentar a frequência da classe minoritária (over-sampling) ou então diminuir o número de ocorrências da classe maioritária (under-sampling), cada uma apresentando vantagens e desvantagens.
Daqui em diante aplicaremos o balanceamento utilizando uma técnica de oversampling chamada SMOTE (Synthetic Minority Over-sampling Technique). Ela basicamente irá realizar oversampling selecionando as instancias da classe minoritária de modo a diminuir o overfitting.
#configuracao da validacao cruzada
ctrl <- trainControl(
sampling = "smote",
method = "cv",
number = 10,
verboseIter = TRUE
)
#knn
knn.range <- expand.grid(k = seq(1, 500, length = 60))
model.knn <- caret::train(
situacao ~.,
data = input.train,
method = "knn",
trControl = ctrl,
tuneGrid = knn.range,
preProcess = c('scale', 'center', 'nzv')
)
model.knn$modelInfo
#configuracao da validacao cruzada
ctrl <- trainControl(
sampling = "smote",
method = "cv",
number = 10,
verboseIter = TRUE
)
#logistic
model.logistic <- caret::train(
situacao ~.,
data = input.train,
method = "glm",
family = "binomial",
trControl = ctrl,
preProcess = c('scale', 'center', 'nzv')
)
model.logistic
#configuracao da validacao cruzada
ctrl <- trainControl(
sampling = "smote",
verboseIter = TRUE
)
#decision tree
model.dt <- caret::train(
situacao ~.,
data = input.train,
method = "rpart",
tuneLength = 10,
trControl = ctrl,
preProcess = c('scale', 'center', 'nzv')
)
model.dt
# rpart.plot::prp(model.dt$finalModel, box.palette="RdBu", shadow.col="gray", nn=TRUE, extra = 1, type = 1, digits = -3)
#configuracao da validacao cruzada
ctrl <- trainControl(
sampling = "smote"
)
#ada boost
model.ada <- caret::train(
situacao ~.,
data = input.train,
method = "adaboost",
trControl = ctrl,
preProcess = c('scale', 'center', 'nzv'),
)
model.ada
Precision e recall são medidas diferentes da acurácia. Para facilitar o entendimento, consideremos a matriz de confusão abaixo. - Acurácia refere-se a proporção dos resultados verdadeiros entre o total de observações. Nesse caso, ele é definido por (TP+TN)/(TP+TN+FP+FN). - Precision diz respeito a uma medida que analisa o modelo em relação as previsões com resultados positivos. - Recall calcula a proporção de observações positivas entre o total que realmente apresenta positivos.
O F1 utiliza os dois valores anteriores e tem como objetivo ser uma medida balanceada. Nesse caso, ela pode ser uma alternativa melhor do que analisar cada um dos outros em separado.
reportMeasures <- function(model, data) {
pred <- predict(model, data)
levels <- c("eleito", "nao_eleito")
xtab <- table(pred, data$situacao)
accuracy <- confusionMatrix(pred, data$situacao, mode = "prec_recall")$overall[1]
precision <- confusionMatrix(pred, data$situacao, mode = "prec_recall")$byClass[5]
recall <- confusionMatrix(pred, data$situacao, mode = "prec_recall")$byClass[6]
f1 <- confusionMatrix(pred, data$situacao, mode = "prec_recall")$byClass[7]
tibble(accuracy, precision, recall, f1)
}
combineReports <- function(df1, df2) {
bind_rows("Treino" = df1, "Validação" = df2, .id = "Treino/Validação")
}
knn.train <- reportMeasures(model.knn, input.train)
knn.test <- reportMeasures(model.knn, input.test)
combineReports(knn.train, knn.test)
## # A tibble: 2 x 5
## `Treino/Validação` accuracy precision recall f1
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Treino 0.896 0.573 0.889 0.697
## 2 Validação 0.892 0.565 0.863 0.683
logistic.train <- reportMeasures(model.logistic, input.train)
## Warning in predict.lm(object, newdata, se.fit, scale = 1, type =
## ifelse(type == : prediction from a rank-deficient fit may be misleading
logistic.test <- reportMeasures(model.logistic, input.test)
## Warning in predict.lm(object, newdata, se.fit, scale = 1, type =
## ifelse(type == : prediction from a rank-deficient fit may be misleading
combineReports(logistic.train, logistic.test)
## # A tibble: 2 x 5
## `Treino/Validação` accuracy precision recall f1
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Treino 0.905 0.614 0.804 0.696
## 2 Validação 0.900 0.601 0.759 0.671
dt.train <- reportMeasures(model.dt, input.train)
dt.test <- reportMeasures(model.dt, input.test)
combineReports(dt.train, dt.test)
## # A tibble: 2 x 5
## `Treino/Validação` accuracy precision recall f1
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Treino 0.891 0.555 0.950 0.701
## 2 Validação 0.891 0.556 0.932 0.697
ada.train <- reportMeasures(model.ada, input.train)
ada.test <- reportMeasures(model.ada, input.test)
combineReports(ada.train, ada.test)
## # A tibble: 2 x 5
## `Treino/Validação` accuracy precision recall f1
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Treino 1 1 1 1
## 2 Validação 1 1 1 1
No geral as medidas diferem pouco em relação aos dados de treino e os de validação. Isso pode acontecer em decorrência da base de dados não ser muito grande, contribuindo para que não exista diferenças significativas entre as medidas. Apesar disso, todos os modelos apresentaram resultados satisfatórios.
varImp(model.knn)
## ROC curve variable importance
##
## Importance
## total_despesa 100.000
## total_receita 99.882
## quantidade_fornecedores 84.898
## quantidade_despesas 84.443
## recursos_de_pessoas_juridicas 84.240
## quantidade_doacoes 78.244
## quantidade_doadores 78.113
## media_receita 72.856
## recursos_de_pessoas_fisicas 70.321
## media_despesa 42.649
## recursos_proprios 22.544
## recursos_de_outros_candidatos.comites 1.741
## recursos_de_partido_politico 0.000
Entre todas as variáveis utilizadas para construção do KNN, a partir de media_despesa todas as variáveis podem deixar de fazer parte do modelo. Talvez selecionando total_despesa, total_receita, quantidade_fornecedores, quantidade_despesas, recursos_de_pessoas_juridicas seja possível a construção de um modelo forte.
varImp(model.logistic)
## glm variable importance
##
## Overall
## recursos_de_pessoas_fisicas 100.000
## media_receita 77.867
## media_despesa 69.403
## recursos_de_pessoas_juridicas 68.660
## quantidade_despesas 41.738
## quantidade_fornecedores 31.938
## quantidade_doadores 24.829
## total_despesa 20.377
## total_receita 8.537
## recursos_de_outros_candidatos.comites 2.807
## quantidade_doacoes 1.932
## recursos_proprios 0.000
Para esse preditor, boa parte dos atributos selecionados não teve grande importância. Selecionar os 4 melhores pode ser suficiente para obter um modelo melhor.
varImp(model.dt)
## rpart variable importance
##
## Overall
## total_receita 100.0000
## total_despesa 99.9114
## recursos_de_pessoas_juridicas 81.7204
## quantidade_despesas 71.3535
## quantidade_fornecedores 70.6641
## quantidade_doacoes 1.2166
## recursos_de_outros_candidatos.comites 0.8898
## media_despesa 0.8458
## recursos_proprios 0.3489
## quantidade_doadores 0.3069
## recursos_de_pessoas_fisicas 0.1813
## recursos_de_partido_politico 0.0709
## media_receita 0.0000
Novamente, muitas variáveis com importância baixíssima para a construção deste modelo.
varImp(model.ada)
## ROC curve variable importance
##
## Importance
## total_despesa 100.00
## total_receita 99.92
## quantidade_fornecedores 85.92
## quantidade_despesas 85.56
## recursos_de_pessoas_juridicas 84.84
## quantidade_doacoes 79.43
## quantidade_doadores 79.18
## media_receita 73.46
## recursos_de_pessoas_fisicas 70.80
## media_despesa 46.88
## recursos_proprios 28.62
## recursos_de_outros_candidatos.comites 8.82
## recursos_de_partido_politico 0.00
No caso do Adaboost, muitas variáveis foram importantes se compararmos com os outros modelos. Isso pode ser por conta de como o modelo é idealizado, explorando cada variável.