Predição de Eleição de Deputados

Introdução

Esta análise será feita utilizando conhecimentos sobre classificação para prever quais candidatos à Câmara de Deputados serão eleitos nas eleições de 2014. Logo abaixo será respondido 5 perguntas propostas pela organização da cadeira de Análise de Dados 2, tomando como base os dados fornecidos.

Antes de tudo será importado as nossas bibliotecas que serão utilizadas para a plotagem das análises para responder as questões.

Logo após, será importado a nossa base de dados, sendo elas: train.csv (conjunto de treino que contém dados das eleições do ano de 2014), test.csv (conjunto de teste que contém dados das eleições de 2014). Assim como:

• Modificar três novos campos para auxiliar na criação do modelo. Esses campos serão nomeados de “isHomem”, “isDeputado” e “isSuperior”, esses campos será derivados dos campos “sexo”, “ocupacao” e “grau”, respectivamente. O motivo dessa derivação é que os três campos mencionados anteriormente possuem muitos fatores, e isso demanda uma maior parte de tempo para a produção do modelo. Desse modo, modificando elas, terá uma redução de tempo significativa na geração do modelo.

• Remover informações que tem pouca relevância, nome, partido, uf, total_despesa, estado_civil, ocupacao, sexo, grau que iriam demandar um custo elevado de tempo e atrapalhar no processo de tunagem.

treino <- read.csv("~/Downloads/AD2/Lab03/all/train.csv")
teste <- read.csv("~/Downloads/AD2/Lab03/all/test.csv")

treino <- treino %>%
  mutate(isHomem = ifelse (sexo=="HOMEM", TRUE, FALSE),
         isDeputado = ifelse (ocupacao=="DEPUTADO", TRUE, FALSE),
         isSuperior = ifelse (grau=="SUPERIOR COMPLETO", TRUE, FALSE)
         )
teste <- teste %>%
  mutate(isHomem = ifelse(sexo=="MASCULINO", TRUE, FALSE),
         isDeputado = ifelse (ocupacao=="DEPUTADO", TRUE, FALSE),
         isSuperior = ifelse(grau=="SUPERIOR COMPLETO", TRUE, FALSE)
         )

treino <- treino %>%
  select(-c(nome, partido, uf, total_despesa, estado_civil, ocupacao, sexo, grau))

teste <- teste%>%
  select(-c(nome, partido, uf, total_despesa, estado_civil, ocupacao, sexo, grau))

treino[is.na(treino)] <- 0
teste[is.na(teste)] <- 0

Antes de partir para as perguntas, é necessário entender o que cada coluna presente nos nossos dados significa:

• ano: Ano da eleição;
• sequencial_candidato: O identificador do candidato. Corresponde à coluna Id do arquivo de submissão;
• nome: Nome do candidato;
• uf: Sigla do estado do candidato;
• partido: Partido do candidato;
• quantidade_doacoes: Número de doações que um candidato recebeu;
• quantidade_doadores: Numero de doadores que um candidato teve;
• total_receita: Total de receita de um candidato;
• media_receita: Média da receita de um candidato;
• recursos_de_outros_candidatos.comites: Total de receita proveniente de outros candidatos e * comitês;
• recursos_de_pessoas_fisicas: Total de receita proveniente de pessoas físicas;
• recursos_de_pessoas_juridicas: Total de receita proveniente de pessoas juridicas;
• recursos_proprios:Total de receita proveniente dos próprios candidatos;
• recursos_de_partido_politico: Total de receita proveniente do partido do candidato;
• quantidade_despesas: Número de despesas que um candidato teve;
• quantidade_fornecedores: Número de fornecedores que um candidato teve;
• total_despesa: Total de depesa de um candidato;
• media_despesa: Média da despesa de um candidato;
• cargo: Cargo ao qual o candidato está concorrendo;
• sexo: Sexo do candidato;
• grau: Grau de escolaridade do candidato;
• estado_civil: Estado civil do candidato;
• ocupacao: Ocupação do candidato;
• situacao: Situação final do candidato. Corresponde à coluna Predict do arquivo de submissão;

Perguntas

1 - 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?

Para responder essa pergunta utilizaremos um gráfico de barras que vai exibir o número de deputados eleitos e não eleitos.

situacaoParlamentares <-treino %>% 
  group_by(situacao) %>% 
    summarise(total = n())
situacaoParlamentares %>%
  plot_ly(y = ~total, type = "bar", color = ~situacao) %>%
  layout(title = "Número de Deputados eleitos ou não eleitos",
         yaxis = list(title = "Total de Parlamentares"),
         xaxis = list (title = "Eleito ou não eleito"))

No gráfico acima, pode-se enxergar que há uma grande discrepância entre o número de canditados eleitos e o número de candidatos não eleitos, ou seja, as classes são desbalanceadas em uma proporção de que o número de candidatos não eleitos é 6 vezes maior que o número de candidatos eleitos. Desse modo, isso pode prejudicar a análise tornando o seu resultado enviezado. Sendo assim, é necessário que haja um balanceamento entre as classes fornecidas. Para isso existem 3 modos eficazes:

• Over

treinoOver <- ovun.sample(situacao~., data=treino,p=0.5, seed=1,method="over")$data

plotOver <- treinoOver %>% 
  group_by(situacao) %>% 
    summarise(total = n())

plotOver %>%
  plot_ly(y = ~total, type = "bar", color = ~situacao) %>%
  layout(title = "Número de Deputados eleitos ou não eleitos",
         yaxis = list(title = "Total de Parlamentares"),
         xaxis = list (title = "Eleito ou não eleito"))

Como pode ser visto no gráfico acima o método “over”, aumenta o parâmetro que está em menor vigor, elevando o número de candidatos eleitos para 6542.

• Under

treinoUnder <- ovun.sample(situacao~., data=treino,p=0.5, seed=1,method="under")$data

plotUnder <- treinoUnder %>% 
  group_by(situacao) %>% 
    summarise(total = n())

plotUnder %>%
  plot_ly(y = ~total, type = "bar", color = ~situacao) %>%
  layout(title = "Número de Deputados eleitos ou não eleitos",
         yaxis = list(title = "Total de Parlamentares"),
         xaxis = list (title = "Eleito ou não eleito"))

Observando o gráfico acima vemos que o “under”, diminui o parâmetro que está em maior vigor, diminuindo o número de para 982.

• Both

treinoBoth <- ovun.sample(situacao~., data=treino,p=0.5, seed=1,method="both")$data

plotBoth <- treinoBoth %>% 
  group_by(situacao) %>% 
    summarise(total = n())

plotBoth %>%
  plot_ly(y = ~total, type = "bar", color = ~situacao) %>%
  layout(title = "Número de Deputados eleitos ou não eleitos",
         yaxis = list(title = "Total de Parlamentares"),
         xaxis = list (title = "Eleito ou não eleito"))

E por fim o gráfico acima retrata o “both”, que vai mesclar os dois métodos anteriores. Alterando o número tanto de candidatos eleitos quanto o de não eleitos, deixando com 3842 e 3780, respectivamente.

Na análise, foi optado por usar o “both”, baseado no fato de que se utilizasse o método “over”, vários outros dados teriam que ser criados e isso poderia afetar no resultado final e se utilizasse o método “under” sobraria poucos dados para executar a análise. Sendo assim, o método “both” iria ser um meio termo entre o “over” e o “under”.

2 - Treine: um modelo de KNN, 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.

Para a criação da nossa fórmula, vamos utilizar o modelo “KNN” visto que foi considerado o melhor modelo pelo laboratório anterior da disciplina.

controleFit <- trainControl(method = "repeatedcv",
                            number = 20,
                            repeats = 20)

valoresPreProcessados <- c("center", "scale", "nzv")

formula = as.formula(situacao ~  total_receita + quantidade_despesas + recursos_de_pessoas_juridicas + quantidade_doacoes + quantidade_fornecedores + media_receita + quantidade_doadores)

Após definir o controle e os valores pré-processados, podemos definir nossa fórmula para os modelos de knn, regressáo logística e árvore de Decisão.

• KNN

Gerando o modelo KNN com o treino balanceado:

modeloKNN <- train(formula,
                   data = treinoBoth,
                   trControl = controleFit,
                   method = "knn",
                   preProcess = valoresPreProcessados,
                   tuneLength = 15)

modeloKNN

• Regressão Logística

A regressão logística é um técnica que utiliza conceitos semelhantes ao modelo de regressão linear, no entanto, ele utiliza a variável dependente é uma variável discreta.

regressaoLogistica <- train(formula,
                 data = treinoBoth,
                 method="glm",
                 trControl = controleFit
                 )

regressaoLogistica

Após observar a regressão logística gerada, pode-se observar que a acurácia é de 0.8745014. Podendo enfatizar a importância da acurácia encontrada pois ela vai dizer a precisão que as observações estão classificadas corretamente.

• Árvore Decisão

A árvore de decisão é um modelo que gera resultados a partir de parâmetros que demostram se o valor de tal parâmetro leva a um resultado positivo ou negativo.

arvoreDecisao <- train(formula,
                data= treinoBoth, 
                method = "rpart",
                trControl = controleFit,
                preProcess = valoresPreProcessados,
                tuneLength = 15)
arvoreDecisao

O algortmo escolhe a melhor acurácia, e o resultado que obtemos no nosso modelo de árvore foi de cp = 0.0003968254. Esse modelo nos retornou uma acurácia melhor do que a regressão logística, indicando que os valores podem ser melhor classificados.

• Adaboost

O adaboost, tem o seu diferencial que é o seu poder de predizer, tomando como base o estudo da predição e o aumento dos pesos das variáveis que tem um maior grau de importância. No entanto, é um modelo que demanda uma parte muito grande de tempo, desse modo, foi decidido que é mais benéfico diminuir o número de variáveis presentes na fórmula utilizada.

formulaAdaboost = as.formula(situacao ~ media_receita + quantidade_doacoes)


adaboost <- train(formulaAdaboost,
                data=treinoBoth,
                trControl = controleFit,
                method = "adaboost")

adaboost

Após observar o resultado do modelo Adaboost, podemos confirmar que o modelo gerado explica 96%, o que é um ótimo resultado.

3 - 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.

Antes de começar a responder a pergunta, vamos defirnir o que é cada termo solicitado na questão: * Precision Precision é a proporção do acerto, ou seja, ele verifica se os que o modelo classificou como certo realmente são certos. * Recall Recall é a frequência dada pelas vezes que o classificador encontrou exemplos em uma classe, ou seja, ele diz quantas das observações preditas como verdadeiras realmente são positivas. * F-Measure F-Measure é a média ponderada da precision e do recall, levando em conta falsos positivos (FP) e falsos negativos (FN) que serão explicados posteriormente, ou seja, ele é o balanço entre o FP e o FN.

Os parâmetros mecionados acima são calculados baseados nos seguintes temos: Verdadeiros Positivos (TP) Verdadeiros Negativos (TN) Falsos Positivos (FP) Falsos Negativos (FN).

\[Precision = TP / (TP + FP)\] \[Recall = TP / (TP + FN)\] \[F-measure = 2*(Recall + Precision)/(Recall + Precision)\] Decidimos analisar cada modelo em particular e tirar conclusões sobre o seu: Precision, Recal e F-Measure.

• KNN

treino$predicaoKNN <- predict(modeloKNN, treino)

treinoKNNTP <- treino %>%
  filter(situacao == "eleito", predicaoKNN == "eleito") %>% 
  nrow()
treinoKNNTN <- treino %>% 
  filter(situacao == "nao_eleito" , predicaoKNN == "nao_eleito" ) %>% 
  nrow()
treinoKNNFP <- treino %>% 
  filter(situacao == "nao_eleito" , predicaoKNN == "eleito") %>% 
  nrow()
treinoKNNFN <- treino %>% 
  filter(situacao == "eleito", predicaoKNN == "nao_eleito" ) %>% 
  nrow()

treinoKNNPrecision <- treinoKNNTP / (treinoKNNTP + treinoKNNFP)
treinoKNNRecall <- treinoKNNTP / (treinoKNNTP + treinoKNNFN)
treinoKNNFMeasure <- 2*(treinoKNNRecall*treinoKNNPrecision)/(treinoKNNRecall+treinoKNNPrecision)

treinoKNNPrecision
treinoKNNRecall
treinoKNNFMeasure

No modelo KNN o nível de precisão foi de aproximadamente apenas 50% o que não é um número muito elevado. No entanto, o recall obtido na análise mostra que 96% das vezes uma variável predita como positiva realmente era positiva, aproximadamente e por fim o seu F-Measure resultou em cerca de 67%.

• Regressão Logística

treino$predicaoRegressao <- predict(regressaoLogistica, treino)

treinoRegressaoTP <- treino %>% 
  filter(situacao == "eleito", predicaoRegressao == "eleito") %>% 
  nrow()
treinoRegressaoTN <- treino %>% 
  filter(situacao == "nao_eleito" , predicaoRegressao == "nao_eleito" ) %>% 
  nrow()
treinoRegressaoFP <- treino %>% 
  filter(situacao == "nao_eleito" , predicaoRegressao == "eleito") %>% 
  nrow()
treinoRegressaoFN <- treino %>% 
  filter(situacao == "eleito", predicaoRegressao == "nao_eleito" ) %>% 
  nrow()

treinoRegressaoPrecision <- treinoRegressaoTP / (treinoRegressaoTP + treinoRegressaoFP)
treinoRegressaoRecall <- treinoRegressaoTP / (treinoRegressaoTP + treinoRegressaoFN)
treinoRegressaoFMeasure <- 2*(treinoRegressaoRecall*treinoRegressaoPrecision)/(treinoRegressaoRecall+treinoRegressaoPrecision)

treinoRegressaoPrecision
treinoRegressaoRecall
treinoRegressaoFMeasure

Já no modelo de Regressão Logística o nível de precisão foi um pouco maior do que no modelo KNN (60%) o que melhora um pouco. No entanto, o recall obtido na análise baixou para 81%, ou seja, melhorou um pouco mais baixou um pouco também, e por fim o seu F-Measure resultou em cerca de 69%.

• Árvore de decisão

treino$predicaoArvore <- predict(arvoreDecisao, treino)

treinoArvoreTP <- treino %>% 
  filter(situacao == "eleito", predicaoArvore == "eleito") %>% 
  nrow()
treinoArvoreTN <- treino %>% 
  filter(situacao == "nao_eleito" , predicaoArvore == "nao_eleito" ) %>% 
  nrow()
treinoArvoreFP <- treino %>% 
  filter(situacao == "nao_eleito" , predicaoArvore == "eleito") %>% 
  nrow()
treinoArvoreFN <- treino %>% 
  filter(situacao == "eleito", predicaoArvore == "nao_eleito" ) %>% 
  nrow()

treinoArvorePrecision <- treinoArvoreTP / (treinoArvoreTP + treinoArvoreFP)
treinoArvoreRecall <- treinoArvoreTP / (treinoArvoreTP + treinoArvoreFN)
treinoArvoreFMeasure <- 2*(treinoArvoreRecall*treinoArvorePrecision)/(treinoArvoreRecall+treinoArvorePrecision)

treinoArvorePrecision
treinoArvoreRecall
treinoArvoreFMeasure

No modelo de Árvore de decisão o nível de precisão foi de 58% o que indica como um meio termo entre os dois últimos modelos analisados. Já em termos do recall obtido na análise foi de 95%, aproximadamente, ou seja, o maior obtido até o momento, assim como o seu F-Measure que foi de 72%.

• Adaboost

treino$predicaoAdaboost <- predict(adaboost, treino)

treinoAdaboostTP <- treino %>% 
  filter(situacao == "eleito", predicaoAdaboost == "eleito") %>% 
  nrow()
treinoAdaboostTN <- treino %>% 
  filter(situacao == "nao_eleito" , predicaoAdaboost == "nao_eleito" ) %>% 
  nrow()
treinoAdaboostFP <- treino %>% 
  filter(situacao == "nao_eleito" , predicaoAdaboost == "eleito") %>% 
  nrow()
treinoAdaboostFN <- treino %>% 
  filter(situacao == "eleito", predicaoAdaboost == "nao_eleito" ) %>% 
  nrow()

treinoAdaboostPrecision <- treinoAdaboostTP / (treinoAdaboostTP + treinoAdaboostFP)
treinoAdaboostRecall <- treinoAdaboostTP / (treinoAdaboostTP + treinoAdaboostFN)
treinoAdaboostFMeasure <- 2*(treinoAdaboostRecall*treinoAdaboostPrecision)/(treinoAdaboostRecall+treinoAdaboostPrecision)

treinoAdaboostPrecision
treinoAdaboostRecall
treinoAdaboostFMeasure

Após observar o resultado obtido, podemos ver uma melhora tendo em vista o modelo Adaboost, pois o nível de precisão foi de 73%, aproximadamente. Também pode ser visto essa mudança analisando o seu Recall que foi de 99%. E finalmente o seu F-Measure que também foi o maior obtido entre os 4 modelos chegando ao número de 84%, aproximadamente.

4 - Interprete as saídas dos modelos. Quais atributos parecem ser mais importantes de acordo com cada modelo?

• KNN

varImp(modeloKNN)

• Regressao Logística

varImp(regressaoLogistica)

• Árvore de Decisão

varImp(arvoreDecisao)

• Adaboost

varImp(adaboost)

Após a utilização da função varImp (função que lista as variáveis do modelo ordenando por sua importância) nos quatro modelos, pode-se afirmar que no geral a variável que tem mais importância é “total_receita” e a que tem menos importância é a de “media_receita”, pois total_receita obteve um overall de 100 em todos os modelos e media_receita teve overall de 0 em quase todos, menos no modelo de Regressão Logística que ainda teve um resultado de 4.105 o que é um número baixo ainda.

5 - Envie seus melhores modelos à competição do Kaggle. Faça pelo menos uma submissão. Sugestões para melhorar o modelo:

regressaoLogisticaKaggle <- train(formula,
                 data = treinoBoth,
                 method="glm",
                 trControl = controleFit, 
                 family="binomial",
                 na.action = na.omit)

predicaoFinalKaggle <- predict(regressaoLogisticaKaggle,teste)
dados <- data.frame(ID = teste$sequencial_candidato, Predicted = predicaoFinalKaggle)
dados$ID <- as.character(dados$ID)
dados %>% 
  write_csv(path = "~/Downloads/AD2/Lab03/all/submissao.csv")