Problema5: AD2
Introdução
O Impeachment da Presidente da República votada na câmara no dia X despertou a curiosidade de muitos sobre os reais motivos pelo voto de cada deputado. Durante a sessão, que durou mais de 10 horas, muitos utilizaram dos argumentos mais diversos que incluíam família, trabalhadores e Deus, só não houve beijo para xuxa. Muitos eleitores especularam que os deputados votaram por interesse particular, raiva e por pressão mesmo dos outros deputados.
O Problema
Uma vez que torna-se bastante cansativo pesquisar a vida de cada político para saber os interesses pessoais de cada um, como também a sua relação com o palácio do planalto e seus aliados, alguns dados podem contribuir para descobrir o que faz um deputado votar SIM ou NÃO pelo Impeachment e consequentemente prever o voto de cada deputado.
Os dados
Os dados são referentes aos votos de cada deputado em um conjunto de projetos de leis, como também o estado do qual ele foi eleito, o partido a qual é filiado e sua votação no Impeachment. Votos de abstenção e ausencia foram considerados como NÃO
Os projetos de lei utilizados como objeto de estudo na análise são
cobrança de cursos de pós-graduação lato sensu em universidades públicas?
tributação de serviços de internet (novas regras do ISS)?
definição aprovada do crime de terrorismo?
combate ao infanticídio indígena?
redução da maioridade penal (1ª votação)?
redução da maioridade penal (2ª votação - excluindo tráfico de drogas e roubo qualificado)?
financiamento privado de campanhas só para partidos políticos?
financiamento privado de campanhas para partidos políticos e candidatos?
emenda da terceirização?
sistema de voto Distritão?
retirada das embalagens o aviso de produto transgênico?
fim da reeleição?
cota para mulheres no legislativo?
restrição de acesso a pensão por morte?
endurecimento do acesso ao seguro-desemprego?
tempo de mandato de 5 anos?
voto facultativo?
voto impresso?
coincidência da eleição?
Análise Descritiva
Bibliotecas utilizadas
require(dplyr)## Loading required package: dplyr##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionrequire(rCharts)## Loading required package: rChartsrequire(knitr)## Loading required package: knitrrequire(tidyr)## Loading required package: tidyrrequire(igraph)## Loading required package: igraph##
## Attaching package: 'igraph'## The following objects are masked from 'package:tidyr':
##
## %>%, crossing## The following objects are masked from 'package:dplyr':
##
## %>%, as_data_frame, groups, union## The following objects are masked from 'package:stats':
##
## decompose, spectrum## The following object is masked from 'package:base':
##
## unionrequire(networkD3)## Loading required package: networkD3require(reshape)## Loading required package: reshape##
## Attaching package: 'reshape'## The following object is masked from 'package:tidyr':
##
## expand## The following object is masked from 'package:dplyr':
##
## renameLeitura dos dados
imp.votacao <- read.csv("~/Dropbox/UFCG/AD2/MT5/imp-votacao.csv")
deputados_temas_e_impeachment <- read.csv("~/Dropbox/UFCG/AD2/MT5/deputados_temas_e_impeachment.csv", sep=";")Abaixo um breve resumo dos dados
summary(deputados_temas_e_impeachment)## id_dep nome deputado
## Min. : 4930 AlessandroMolon: 2 Alessandro Molon: 2
## 1st Qu.: 74784 AlielMachado : 2 Aliel Machado : 2
## Median :160553 CiceroAlmeida : 2 Cícero Almeida : 2
## Mean :139077 ElizeuDionizio : 2 Elizeu Dionizio : 2
## 3rd Qu.:178873 ElizianeGama : 2 Eliziane Gama : 2
## Max. :191923 JHC : 2 (Other) :467
## (Other) :521 NA's : 56
## partido UF tema_1 tema_2 tema_3 tema_4
## pmdb : 67 SP : 72 nao:217 nao:240 nao:171 nao:172
## pt : 66 MG : 53 sim:316 sim:293 sim:362 sim:361
## psdb : 54 RJ : 48
## pp : 40 BA : 39
## psd : 36 RS : 33
## pr : 34 PR : 32
## (Other):236 (Other):256
## tema_5 tema_6 tema_7 tema_8 tema_9 tema_10 tema_11
## nao:230 nao:210 nao:203 nao:269 nao:209 nao:323 nao:213
## sim:303 sim:323 sim:330 sim:264 sim:324 sim:210 sim:320
##
##
##
##
##
## tema_12 tema_13 tema_14 tema_15 tema_16 tema_17 tema_18
## nao: 81 nao:240 nao:256 nao:281 nao:185 nao:399 nao:100
## sim:452 sim:293 sim:277 sim:252 sim:348 sim:134 sim:433
##
##
##
##
##
## tema_19 IMPEACHMENT
## nao:313 ABST : 6
## sim:220 AUSEN: 2
## NAO :133
## SIM :359
## NA's : 33
##
## Como cada partido votou no Impeachment
Abaixo temos um gráfico interativo que mostra como cada partido votou no impeatchment. O comprimento da barra refere-se a porcentagem dos votantes. No eixo y temos os estados e no eixo x temos a porcentagem de votantes.
Como podemos observar, há partidos que votaram itegralmente no NÃO, PC do B PSOL e PT, partidos que votaram integralmente no SIM,DEM,PSDB,PPS,PSC e SD, e os partidos que ficaram em cima do muro,PEN,REDE,PROS,PTdoB e PDT
Clicando nos botões é possível selecionar por grupos de votantes, SIM, NÃO, ABSTENÇÃO e AUSENCIA. Para visualizar a porcentagem é necessário passar o mouse pelas barras.
deputados_por_partido <- select(imp.votacao,partido,voto)
deputados_por_partido <- data.frame(prop.table(table(deputados_por_partido),1))
deputados_por_partido <- filter(deputados_por_partido,Freq>0)
deputados_por_partido <- deputados_por_partido[deputados_por_partido$partido != 'SIM',]
deputados_por_partido <- deputados_por_partido[deputados_por_partido$voto != '',]
deputados_por_partido <- deputados_por_partido[deputados_por_partido$voto != 'PP',]
deputados_por_partido$Freq <- deputados_por_partido$Freq *100
n1 <- nPlot(Freq ~ partido, group = "voto", data = deputados_por_partido[order(-deputados_por_partido$Freq),],
type = 'multiBarHorizontalChart', height = 800, width = 800
, bounds = list( x = 100, y = 100, width = 300, height = 600))
n1$print("iframesrc2")Como cada estado votou no Impeachment
Abaixo temos um gráfico no mesmo estilo do apresentado anteriormente, mas por estado. Podemos observar que o voto de abstenção e ausência é maior presente nos estados em que a proporção de votantes SIM foi menor. Em apenas 2 estados todos os deputados votaram pelo SIM Amazonas e Rondônia, enquanto em apenas 3 estados a maioria votou pelo nao Ceará, Bahia e Amapá
deputados_por_estado <- select(imp.votacao,estado,voto)
deputados_por_estado <- data.frame(prop.table(table(deputados_por_estado),1))
deputados_por_estado <- filter(deputados_por_estado,Freq>0)
deputados_por_estado <- deputados_por_estado[deputados_por_estado$estado != 'SIM',]
deputados_por_estado <- deputados_por_estado[deputados_por_estado$estado != '',]
deputados_por_estado$Freq <- deputados_por_estado$Freq *100
n2 <- nPlot(Freq ~ estado, group = "voto", data = deputados_por_estado[order(-deputados_por_estado$Freq),],
type = 'multiBarHorizontalChart', height = 800, width = 800
, bounds = list( x = 100, y = 100, width = 300, height = 600))
n2$print("iframesrc3",include_assets=TRUE)Temas de projetos
Foi realizado a análise descritiva dos temas. No entanto, não foi possível mostrar nesta páginas, por problemas que eu não consegui resolver a tempo de posta-los juntos. O link pode ser acessado aqui
Abaixo é apresentado a distribuição de votos por tema
É percepitível a correlação entre o resultado da votação de alguns temas com a votação do impeachment a exemplo dos temas: Tempo de mandato, infanticidio e definicao de terrorismo. No entanto, veremos no gráfico logo abaixo que apenas o tema infanticidio tem correlacao com impeachment.
deputados_ti <- melt(na.omit(deputados_temas_e_impeachment))## Using nome, deputado, partido, UF, tema_1, tema_2, tema_3, tema_4, tema_5, tema_6, tema_7, tema_8, tema_9, tema_10, tema_11, tema_12, tema_13, tema_14, tema_15, tema_16, tema_17, tema_18, tema_19, IMPEACHMENT as id variables#deputados_ti <- data.frame(data.matrix(deputados_ti)) #Remove omissao de NAS
deputados_ti <- select(deputados_ti,partido:IMPEACHMENT)
par(mfrow=c(2,4))
colnames_deputados = c('Partido','UF','Cobranca_Latus_Sensu','Tributacao_Internet','Terrorismo_Definicao','Infanticidio_Indigena','Maioridade_1','Maioridade_2','Financiamento_Partido','Financiamento_Politico','Terceirizacao','Distritao','Trangenico','Fim_da_reeleicao','Cota_Mulheres','Restrincao_Pensao','Seguro_Desemprego','Tempo_Mandato','Voto_Facultativo','Voto_Impresso','Coincidencia_reeleicao','Impeachment')
colnames(deputados_ti) <-colnames_deputados
for (i in 3:22){
variavel <- colnames_deputados[i]
plot(main=variavel,deputados_ti[i])
}
Correlação entre variáveis
Podemos perceber que existe um grupo em é correlacionado entre si como também correlacionado com impeachment que são os temas: Infanticidio Indigena, Maioridade 1, Maioridade 2, Financiamento Partido, Financiamento Político e Terceirização.
Estas variáveis serão objetos de estudo na classsificação.
library(corrplot)
c <- deputados_ti
for (i in 1:22){
c[i] <- as.numeric(unlist(c[i]))
}
par(cex = 1)
M <- cor(c)
corrplot(M,type="lower")
Treinamento
As variáveis descritas acima como correlacionadas com impeachment mais as variáveis Partido, UF, Trangenico e Seguro Desemprego serão utilizadas na fase de treinamento. Serão realizados 3 treinamentos. O primeiro com todas as variaveis, o segundo com as variáveis selecionadas e o último com as variáveis selecionadas removendo apenas partido e UF, que apesarem de não apresentarem correlação com a votação no mundo real, elas aparentemente são correlacionadas.
Criando partições de treino e teste
deputados_ti$Impeachment <- as.character(deputados_ti$Impeachment)
deputados_ti$Impeachment[deputados_ti$Impeachment=='ABST'] <- 'NAO'
deputados_ti$Impeachment[deputados_ti$Impeachment=='AUSEN'] <- 'NAO'
deputados_ti$Impeachment <- as.factor(deputados_ti$Impeachment)
train_idx = createDataPartition(y=deputados_ti$Impeachment, p=.9,list=FALSE)
train = deputados_ti[train_idx,]
test = deputados_ti[-train_idx,]
names(train) = names(deputados_ti) #adicionando cabeçalho aos dados de treino e test
names(test) = names(deputados_ti)Testando as proporções de instâncias em cada classe no treino e teste
prop.table(table(train$Impeachment))##
## NAO SIM
## 0.2860465 0.7139535prop.table(table(test$Impeachment))##
## NAO SIM
## 0.2765957 0.7234043Treinamento 1: Todos os dados
grid = expand.grid(.winnow=c(TRUE,FALSE),.trials=c(1,5,10,20,30,40,50,60,70,80,90,100),.model="tree")
fitControl = trainControl(method="repeatedcv",number=10,repeats=10,returnResamp="all")
labels = as.factor(train$Impeachment)
model = train(x=train[-22],y=labels,tuneGrid=grid,trControl=fitControl,method="C5.0")## Loading required package: plyr## -------------------------------------------------------------------------## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)## -------------------------------------------------------------------------##
## Attaching package: 'plyr'## The following objects are masked from 'package:reshape':
##
## rename, round_any## The following objects are masked from 'package:dplyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarizeplot(model)
Avaliando modelo no teste
test_labels = as.factor(test$Impeachment)
predictions = predict(model,newdata=test)
confusionMatrix(data = predictions, test_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction NAO SIM
## NAO 9 2
## SIM 4 32
##
## Accuracy : 0.8723
## 95% CI : (0.7426, 0.9517)
## No Information Rate : 0.7234
## P-Value [Acc > NIR] : 0.01254
##
## Kappa : 0.6651
## Mcnemar's Test P-Value : 0.68309
##
## Sensitivity : 0.6923
## Specificity : 0.9412
## Pos Pred Value : 0.8182
## Neg Pred Value : 0.8889
## Prevalence : 0.2766
## Detection Rate : 0.1915
## Detection Prevalence : 0.2340
## Balanced Accuracy : 0.8167
##
## 'Positive' Class : NAO
## No gráfico acima temos duas linhas referentes a No Winnowing e **Winnowing*. A primeira representa o desempenho do algoritmo sem a seleção dos preditores e Winnowing seleção dos preditores.
O resultado do treinamento usando todos os dados mostrou uma acurácia muito boa, mas uma sensitividade muito baixa.
Treinamento 2: Variáveis selecionadas
deputados_ti <- select(deputados_ti,Partido,UF,Trangenico,Infanticidio_Indigena,Maioridade_1,Maioridade_2,Financiamento_Partido,Financiamento_Politico,Terceirizacao,Seguro_Desemprego,Impeachment)
train_idx = createDataPartition(y=deputados_ti$Impeachment, p=.9,list=FALSE)
train = deputados_ti[train_idx,]
test = deputados_ti[-train_idx,]
names(train) = names(deputados_ti) #adicionando cabeçalho aos dados de treino e test
names(test) = names(deputados_ti)
grid = expand.grid(.winnow=c(TRUE,FALSE),.trials=c(1,5,10,20,30,40,50,60,70,80,90,100),.model="tree")
fitControl = trainControl(method="repeatedcv",number=10,repeats=10,returnResamp="all")
labels = as.factor(train$Impeachment)
model = train(x=train[-11],y=labels,tuneGrid=grid,trControl=fitControl,method="C5.0")
plot(model)
Avaliando modelo no teste
test_labels = as.factor(test$Impeachment)
predictions = predict(model,newdata=test)
confusionMatrix(data = predictions, test_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction NAO SIM
## NAO 8 3
## SIM 5 31
##
## Accuracy : 0.8298
## 95% CI : (0.6919, 0.9235)
## No Information Rate : 0.7234
## P-Value [Acc > NIR] : 0.06636
##
## Kappa : 0.5534
## Mcnemar's Test P-Value : 0.72367
##
## Sensitivity : 0.6154
## Specificity : 0.9118
## Pos Pred Value : 0.7273
## Neg Pred Value : 0.8611
## Prevalence : 0.2766
## Detection Rate : 0.1702
## Detection Prevalence : 0.2340
## Balanced Accuracy : 0.7636
##
## 'Positive' Class : NAO
## O resultado do treinamento as variáveis selecionadas apresentou uma acurácia identica em relação ao primeiro treinamento, mas uma sensitividade consideravelmente maior.
Treinamento 3: Partido e UF removidos do treinamento 2
deputados_ti <- select(deputados_ti,Trangenico,Infanticidio_Indigena,Maioridade_1,Maioridade_2,Financiamento_Partido,Financiamento_Politico,Terceirizacao,Seguro_Desemprego,Impeachment)
train_idx = createDataPartition(y=deputados_ti$Impeachment, p=.9,list=FALSE)
train = deputados_ti[train_idx,]
test = deputados_ti[-train_idx,]
names(train) = names(deputados_ti) #adicionando cabeçalho aos dados de treino e test
names(test) = names(deputados_ti)
grid = expand.grid(.winnow=c(TRUE,FALSE),.trials=c(1,5,10,20,30,40,50,60,70,80,90,100),.model="tree")
fitControl = trainControl(method="repeatedcv",number=10,repeats=10,returnResamp="all")
labels = as.factor(train$Impeachment)
model = train(x=train[-9],y=labels,tuneGrid=grid,trControl=fitControl,method="C5.0")
plot(model)
Avaliando modelo no teste
test_labels = as.factor(test$Impeachment)
predictions = predict(model,newdata=test)
confusionMatrix(data = predictions, test_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction NAO SIM
## NAO 9 3
## SIM 4 31
##
## Accuracy : 0.8511
## 95% CI : (0.7169, 0.938)
## No Information Rate : 0.7234
## P-Value [Acc > NIR] : 0.03102
##
## Kappa : 0.6188
## Mcnemar's Test P-Value : 1.00000
##
## Sensitivity : 0.6923
## Specificity : 0.9118
## Pos Pred Value : 0.7500
## Neg Pred Value : 0.8857
## Prevalence : 0.2766
## Detection Rate : 0.1915
## Detection Prevalence : 0.2553
## Balanced Accuracy : 0.8020
##
## 'Positive' Class : NAO
## Por fim, no último treinamento removendo as variáveis Partido e UF do segundo treinamento foi possivel ter uma melhora considerável tanto em acurácia quanto em sensitividade.Mostrando que, partido e UF tem rúido que prejudica a classificação por meio de árvores de decisão.
Conclusão
Podemos concluir temas de projetos de lei contribuem para prever o voto de um deputado muito mais do que o partido a qual ele está filiado e o estado do qual ele foi eleito. Analisando os temas com base nos gráficos apresentados e os resultados da classificação acima é possível hipotetizar que a ideologia político-ecônomica, esquerda e direita, do deputado contribui ainda mais para prever o voto de um deputado. O insight vem do grupo de temas correlacionados no gráfico de correlação são tipicamente de direita que são eles: Infanticidio, Maioridade 1 e 2, Financiamento para políticos e partidos, terceirização(empresariado) e trangênicos(grandes latifundiarios)