Neste laboratório realizaremos uma análise exploratória sobre a votação que candidatos à Câmara Federal dos Deputados receberam em 2014. A nossa tarefa é tentar explicar a quantidade de votos de um candidato por uma série de atributos (variáveis) e conhecer quais são os atributos que mais influenciam no número de votos de um candidato.

Os dados foram coletados do TSE, sendo tratados e contemplam informações sobre aproximadamente 5.000 candidatos, os dados podem ser baixados neste link.


Lendo e Filtrando os Dados

Nos dados existem algumas variáveis qualitativas que possuem muitos níveis qualitativos como UF, Partido, Setor Econômico de Receitas, Setor Econômico de Despesas, e para facilitar nossas análise vamos retirá-las e assumir que essas variáveis não são importantes para explicar a quantidade de votos de um candidato.

Além disso, vamos assumir que os valores NAs nas colunas quantitativas significam o valor 0, pois, se excluírmos todas as observações que possuem pelo menos uma ocorrência de NA, ficaremos com poucas observações para analisar.

observations <- read.csv("~/Documentos/AD2/lab3/eleicoes2014.csv", encoding="latin1", stringsAsFactors=FALSE) %>% 
  subset(select = c(quantidade_doacoes, quantidade_doadores, total_receita, media_receita, recursos_de_outros_candidatos.comites, recursos_de_partidos, recursos_de_pessoas_físicas, recursos_de_pessoas_juridicas, recursos_proprios, votos, quantidade_despesas, quantidade_fornecedores, total_despesa, media_despesa, idade, sexo, grau, estado_civil)) %>%
  filter(!is.na(votos))

observations$quantidade_doacoes[is.na(observations$quantidade_doacoes)] <- 0
observations$quantidade_doadores[is.na(observations$quantidade_doadores)] <- 0
observations$total_receita[is.na(observations$total_receita)] <- 0
observations$media_receita[is.na(observations$media_receita)] <- 0
observations$recursos_de_outros_candidatos.comites[is.na(observations$recursos_de_outros_candidatos.comites)] <- 0
observations$recursos_de_partidos[is.na(observations$recursos_de_partidos)] <- 0
observations$recursos_de_pessoas_físicas[is.na(observations$recursos_de_pessoas_físicas)] <- 0
observations$recursos_de_pessoas_juridicas[is.na(observations$recursos_de_pessoas_juridicas)] <- 0
observations$recursos_proprios[is.na(observations$recursos_proprios)] <- 0
observations$quantidade_despesas[is.na(observations$quantidade_despesas)] <- 0
observations$quantidade_fornecedores[is.na(observations$quantidade_fornecedores)] <- 0
observations$total_despesa[is.na(observations$total_despesa)] <- 0
observations$media_despesa[is.na(observations$media_despesa)] <- 0


Será que é possível explicar bem a quantidade de votos por todas as variáveis que filtramos nos dados?

Certamente todas as variáveis não serão necessárias para explicar a quantidade de votos pelo fato de existirem claramente variáveis correlacionadas como Quantidade de Doações e Quantidade de Doadores, Quantidade de Despesas e Quantidade de Fornecedores. Então vamos mostrar que nossa desconfiança parece ter evidências amostrais.

Primeiro vamos construir o modelo.

model <- lm(votos ~ quantidade_doacoes + quantidade_doadores + total_receita + media_receita + recursos_de_outros_candidatos.comites + recursos_de_partidos + recursos_de_pessoas_físicas + recursos_de_pessoas_juridicas + recursos_proprios + quantidade_despesas + quantidade_fornecedores + total_despesa + media_despesa + idade + sexo + grau + estado_civil, data = observations)

summary(model)
## 
## Call:
## lm(formula = votos ~ quantidade_doacoes + quantidade_doadores + 
##     total_receita + media_receita + recursos_de_outros_candidatos.comites + 
##     recursos_de_partidos + recursos_de_pessoas_físicas + recursos_de_pessoas_juridicas + 
##     recursos_proprios + quantidade_despesas + quantidade_fornecedores + 
##     total_despesa + media_despesa + idade + sexo + grau + estado_civil, 
##     data = observations)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -315851   -6004   -2267    1468 1238461 
## 
## Coefficients:
##                                         Estimate Std. Error t value
## (Intercept)                           -6.834e+03  3.442e+03  -1.986
## quantidade_doacoes                    -1.399e+00  2.673e+01  -0.052
## quantidade_doadores                    2.759e+02  3.924e+01   7.031
## total_receita                          1.699e-01  1.399e-01   1.214
## media_receita                          4.391e-01  5.134e-02   8.552
## recursos_de_outros_candidatos.comites -3.647e-02  1.399e-01  -0.261
## recursos_de_partidos                  -1.331e-01  1.400e-01  -0.951
## recursos_de_pessoas_físicas           -1.268e-01  1.401e-01  -0.905
## recursos_de_pessoas_juridicas         -1.212e-01  1.399e-01  -0.866
## recursos_proprios                     -1.447e-01  1.399e-01  -1.034
## quantidade_despesas                    5.187e+01  4.287e+00  12.098
## quantidade_fornecedores               -5.844e+01  6.181e+00  -9.455
## total_despesa                         -2.832e-02  7.484e-03  -3.784
## media_despesa                          2.378e+00  3.944e-01   6.029
## idade                                  5.161e+01  4.795e+01   1.076
## sexoMASCULINO                          3.033e+03  1.188e+03   2.552
## grauENSINO FUNDAMENTAL INCOMPLETO      2.164e+03  3.906e+03   0.554
## grauENSINO MÉDIO COMPLETO              2.042e+03  2.416e+03   0.845
## grauENSINO MÉDIO INCOMPLETO            1.101e+03  3.938e+03   0.280
## grauLÊ E ESCREVE                       6.851e+02  7.645e+03   0.090
## grauSUPERIOR COMPLETO                  5.018e+03  2.300e+03   2.182
## grauSUPERIOR INCOMPLETO                2.573e+02  2.694e+03   0.095
## estado_civilDIVORCIADO(A)             -1.198e+03  1.677e+03  -0.714
## estado_civilSEPARADO(A) JUDICIALMENTE -4.964e+03  3.737e+03  -1.328
## estado_civilSOLTEIRO(A)               -1.223e+03  1.262e+03  -0.969
## estado_civilVIÚVO(A)                  -6.927e+03  3.752e+03  -1.846
##                                       Pr(>|t|)    
## (Intercept)                           0.047123 *  
## quantidade_doacoes                    0.958269    
## quantidade_doadores                   2.38e-12 ***
## total_receita                         0.224805    
## media_receita                          < 2e-16 ***
## recursos_de_outros_candidatos.comites 0.794349    
## recursos_de_partidos                  0.341586    
## recursos_de_pessoas_físicas           0.365595    
## recursos_de_pessoas_juridicas         0.386546    
## recursos_proprios                     0.301080    
## quantidade_despesas                    < 2e-16 ***
## quantidade_fornecedores                < 2e-16 ***
## total_despesa                         0.000157 ***
## media_despesa                         1.80e-09 ***
## idade                                 0.281831    
## sexoMASCULINO                         0.010740 *  
## grauENSINO FUNDAMENTAL INCOMPLETO     0.579529    
## grauENSINO MÉDIO COMPLETO             0.398081    
## grauENSINO MÉDIO INCOMPLETO           0.779874    
## grauLÊ E ESCREVE                      0.928604    
## grauSUPERIOR COMPLETO                 0.029172 *  
## grauSUPERIOR INCOMPLETO               0.923925    
## estado_civilDIVORCIADO(A)             0.475204    
## estado_civilSEPARADO(A) JUDICIALMENTE 0.184153    
## estado_civilSOLTEIRO(A)               0.332550    
## estado_civilVIÚVO(A)                  0.064949 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 32700 on 4126 degrees of freedom
## Multiple R-squared:  0.4816, Adjusted R-squared:  0.4785 
## F-statistic: 153.3 on 25 and 4126 DF,  p-value: < 2.2e-16

Vamos observar se o modelo satisfaz o pressuposto da normalidade da distribuição dos resíduos.

plot(model, which = 2)

Podemos observar que o pressuposto de normalidade da distribuição dos resíduos não é safisfeito, pois os resíduos padronizados não se ajustam bem a reta estabelecida para a normalidade, além disso podemos observar alguns outliers na distribuição.

Para assegurar nossa afirmação, vamos realizar o teste de Shapiro.

shapiro.test(model$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  model$residuals
## W = 0.41505, p-value < 2.2e-16

Como o p-valor do teste de Shapiro é menor que 0.05 então rejeitamos a hipótese nula, que é a hipótese dos resíduos seguirem uma distribuição normal, logo, com 95% de confiança podemos concluir que os resíduos não seguem uma distribuição normal.

Mas, se os resíduos não seguem uma distribuição normal, então qual distribuição os resíduos seguem?

plot(model, which = 1)

Não é possível identificar muito bem qual a distribuição os resíduos seguem, porém vamos deixar essa análise para discussões posteriores.

Com nosso modelo inicial podemos observar que o R² ajustado é 0.4785, ou seja, o modelo explica 47.85% dos dados, assim podemos afirmar que este modelo é razoável para explicar a quantidade de votos de um candidato. Porém, o modelo não satisfaz o pressuposto de normalidade na distribuição dos resíduos.


Todas as variáveis são úteis para o modelo de Regressão? Há variáveis redundantes?

Podemos observar que existem diversas variáveis que possuem um p-valor muito alto, ou seja, a chance da relação entre os votos e essas variáveis serem mera coincidência é muito alta, logo, poderíamos ter um modelo com mesma qualidade e mais simples se removêssemos essas variáveis com o p-valor muito alto, em geral maior que 0.05.

Para responder a pergunta sobre a existência ou não de variáveis redundantes vamos plotar o correlograma das variáveis quantitativas, assim teremos o indicativo de quais variáveis independentes estão linearmente correlacionadas.

subset(observations, select = c(votos, quantidade_doacoes, quantidade_doadores, total_receita, media_receita, recursos_de_outros_candidatos.comites, recursos_de_partidos, recursos_de_pessoas_físicas, recursos_de_pessoas_juridicas, recursos_proprios, quantidade_despesas, quantidade_fornecedores, total_despesa, media_despesa, idade)) %>% 
  ggcorr(palette = "RdYlGn", name = "rho", 
       label = TRUE, label_color = "black", hjust = 0.925, size = 3.5, angle = -45)

Com o correlograma podemos observar que existem diversas variáveis linearmente correlacionadas, um par de variáveis que chamou atenção foi total_despesa e total_receita com o coeficiente de correlação linear 1, ou seja, essas duas variáveis são totalmente correlacionadas. Além disso, outros pares de variáveis que apresentam uma linear correlação muito forte:

e entre outras. Normalmente consideramos que duas variáveis possuem uma correlação linear forte quando o coeficiente de correlação linear entre elas é em módulo maior ou igual à 0.7.

Assim, podemos concluir que existem variáveis redundantes, logo, nosso modelo inicial é prejudicado pelo fato de variáveis redundantes explicarem a mesma parcela dos dados da variável dependente, ou seja, não é possível avaliar o que cada variávei redundante explica no modelo.


No caso de haver variáveis pouco explicativas e/ou redudantes, construa um novo modelo sem essas variáveis e o compare ao modelo com todas as variáveis

Não é correto remover as variáveis de qualquer maneira só pelo fato de existirem variáveis pouco explicativas e/ou redundantes, pois, se existirem duas variáveis correlacionadas qual deve ser removida do modelo? Essa pergunta é um pouco controversa, é tanto que existem diversos métodos desenvolvidos para fazer tal tarefa de diferentes maneiras, mas neste caso, por simplicidade, vamos usar os seguintes critérios:

Com isto, vamos construir nosso novo modelo.

resumed_model <- lm(votos ~ total_despesa + recursos_de_outros_candidatos.comites + quantidade_doadores + sexo + media_despesa + grau + estado_civil, data = observations)

summary(resumed_model)
## 
## Call:
## lm(formula = votos ~ total_despesa + recursos_de_outros_candidatos.comites + 
##     quantidade_doadores + sexo + media_despesa + grau + estado_civil, 
##     data = observations)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -240249   -7302   -3090    1144 1295895 
## 
## Coefficients:
##                                         Estimate Std. Error t value
## (Intercept)                           -3.739e+03  2.511e+03  -1.489
## total_despesa                          2.722e-02  1.043e-03  26.087
## recursos_de_outros_candidatos.comites  1.001e-01  6.500e-03  15.395
## quantidade_doadores                    2.724e+02  2.044e+01  13.326
## sexoMASCULINO                          4.324e+03  1.220e+03   3.543
## media_despesa                          2.652e+00  3.426e-01   7.742
## grauENSINO FUNDAMENTAL INCOMPLETO      1.884e+03  4.036e+03   0.467
## grauENSINO MÉDIO COMPLETO              1.640e+03  2.490e+03   0.659
## grauENSINO MÉDIO INCOMPLETO            8.315e+02  4.066e+03   0.205
## grauLÊ E ESCREVE                      -3.259e+02  7.903e+03  -0.041
## grauSUPERIOR COMPLETO                  5.811e+03  2.372e+03   2.450
## grauSUPERIOR INCOMPLETO                7.865e+02  2.755e+03   0.285
## estado_civilDIVORCIADO(A)             -1.022e+03  1.726e+03  -0.592
## estado_civilSEPARADO(A) JUDICIALMENTE -6.166e+03  3.851e+03  -1.601
## estado_civilSOLTEIRO(A)               -1.989e+03  1.251e+03  -1.590
## estado_civilVIÚVO(A)                  -5.859e+03  3.843e+03  -1.525
##                                       Pr(>|t|)    
## (Intercept)                           0.136593    
## total_despesa                          < 2e-16 ***
## recursos_de_outros_candidatos.comites  < 2e-16 ***
## quantidade_doadores                    < 2e-16 ***
## sexoMASCULINO                         0.000401 ***
## media_despesa                         1.23e-14 ***
## grauENSINO FUNDAMENTAL INCOMPLETO     0.640729    
## grauENSINO MÉDIO COMPLETO             0.510094    
## grauENSINO MÉDIO INCOMPLETO           0.837969    
## grauLÊ E ESCREVE                      0.967114    
## grauSUPERIOR COMPLETO                 0.014327 *  
## grauSUPERIOR INCOMPLETO               0.775283    
## estado_civilDIVORCIADO(A)             0.553666    
## estado_civilSEPARADO(A) JUDICIALMENTE 0.109434    
## estado_civilSOLTEIRO(A)               0.111904    
## estado_civilVIÚVO(A)                  0.127433    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 33810 on 4136 degrees of freedom
## Multiple R-squared:  0.4446, Adjusted R-squared:  0.4426 
## F-statistic: 220.7 on 15 and 4136 DF,  p-value: < 2.2e-16
subset(observations, select = c(votos, total_despesa, recursos_de_outros_candidatos.comites, quantidade_doadores, media_despesa)) %>% 
  ggcorr(palette = "RdYlGn", name = "rho", 
       label = TRUE, label_color = "black", hjust = 0.8, size = 3.5, angle = -45)

Com a eliminação das variáveis redundantes e pouco explicativas podemos observar que no caso da variável qualitativa grau o único nível que é importante é se o candidato tem nível superior ou não, já a variável qualitativa estado_civil não parece ser importante, então, vamos remover esses níveis do modelo.

filtered_obs <- observations
filtered_obs$grau[filtered_obs$grau != "SUPERIOR COMPLETO"] <- "SEM ENSINO SUPERIOR"

resumed_model <- lm(votos ~ total_despesa + recursos_de_outros_candidatos.comites + quantidade_doadores + sexo + media_despesa + grau, data = filtered_obs)

summary(resumed_model)
## 
## Call:
## lm(formula = votos ~ total_despesa + recursos_de_outros_candidatos.comites + 
##     quantidade_doadores + sexo + media_despesa + grau, data = filtered_obs)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -239858   -7208   -2932    1125 1296713 
## 
## Coefficients:
##                                         Estimate Std. Error t value
## (Intercept)                           -3.924e+03  1.147e+03  -3.422
## total_despesa                          2.724e-02  1.042e-03  26.135
## recursos_de_outros_candidatos.comites  1.000e-01  6.496e-03  15.394
## quantidade_doadores                    2.748e+02  2.041e+01  13.466
## sexoMASCULINO                          4.823e+03  1.192e+03   4.045
## media_despesa                          2.684e+00  3.417e-01   7.855
## grauSUPERIOR COMPLETO                  4.699e+03  1.079e+03   4.355
##                                       Pr(>|t|)    
## (Intercept)                           0.000628 ***
## total_despesa                          < 2e-16 ***
## recursos_de_outros_candidatos.comites  < 2e-16 ***
## quantidade_doadores                    < 2e-16 ***
## sexoMASCULINO                         5.32e-05 ***
## media_despesa                         5.06e-15 ***
## grauSUPERIOR COMPLETO                 1.36e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 33800 on 4145 degrees of freedom
## Multiple R-squared:  0.4436, Adjusted R-squared:  0.4428 
## F-statistic: 550.9 on 6 and 4145 DF,  p-value: < 2.2e-16

Como podemos observar este novo modelo é mais simples, pois, possui apenas 6 variáveis, diferentemente do modelo inicial que possui 25. Contudo, o R² ajustado do novo modelo é 0.4428 sendo um pouco menor que o R² ajustado do modelo inicial de 0.4785, além disso, o RSE (Residual standard error) é maior do que o RSE do modelo inicial sendo, respectivamente, 33800 e 32700.

Apesar do modelo novo ter um R² ajustado um pouco menor e RSE um pouco maior, pelo fato dele ser mais simples acaba se tornando uma melhor opção em relação ao modelo inicial, pois, não existe uma grande diferença entre o R² e o RSE.


Será que é possível melhorar o novo modelo?

Vamos analisar o plot dos resíduos e verificar se existe alguma tendência nos erros.

plot(resumed_model, which = 1)

No gráfico acima não é possível observar nenhuma tendência na distribuição dos resíduos, pelo fato da escala do gráfico se ajustar aos outliers com os labels (16, 1390, 2034), ou seja, as observações de número 16º, 1390º e 2034º. Essas observações fazem referência aos candidatos (CELSO UBIRAJARA RUSSOMANNO, JAIR MESSIAS BOLSONARO e MARCO ANTONIO FELICIANO), pessoas muito famosas na sociedade brasileira. Sabendo deste fato, vamos eliminar estes outlier das observações para visualizar melhor a distribuição dos resíduos.

obs_without_outliers <- filtered_obs[-c(16, 1390, 2034), ]
resumed_model <- lm(votos ~ total_despesa + recursos_de_outros_candidatos.comites + quantidade_doadores + sexo + media_despesa + grau, data = obs_without_outliers)

summary(resumed_model)
## 
## Call:
## lm(formula = votos ~ total_despesa + recursos_de_outros_candidatos.comites + 
##     quantidade_doadores + sexo + media_despesa + grau, data = obs_without_outliers)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -170616   -6921   -3110     814  258080 
## 
## Coefficients:
##                                         Estimate Std. Error t value
## (Intercept)                           -3.292e+03  8.451e+02  -3.895
## total_despesa                          3.017e-02  7.697e-04  39.199
## recursos_de_outros_candidatos.comites  2.008e-02  5.001e-03   4.014
## quantidade_doadores                    2.955e+02  1.504e+01  19.648
## sexoMASCULINO                          4.637e+03  8.786e+02   5.278
## media_despesa                          2.646e+00  2.520e-01  10.498
## grauSUPERIOR COMPLETO                  4.104e+03  7.952e+02   5.161
##                                       Pr(>|t|)    
## (Intercept)                           9.97e-05 ***
## total_despesa                          < 2e-16 ***
## recursos_de_outros_candidatos.comites 6.07e-05 ***
## quantidade_doadores                    < 2e-16 ***
## sexoMASCULINO                         1.37e-07 ***
## media_despesa                          < 2e-16 ***
## grauSUPERIOR COMPLETO                 2.58e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 24910 on 4142 degrees of freedom
## Multiple R-squared:  0.564,  Adjusted R-squared:  0.5634 
## F-statistic:   893 on 6 and 4142 DF,  p-value: < 2.2e-16

Note que o R² ajustado do modelo aumentou significativamente com a eliminação dos outliers e o RSE (Residual Standard Error) diminuiu significativamente.

Agora vamos analisar os resíduos desse novo modelo sem os outliers.

plot(resumed_model, which = 1)

Note que agora já é possível observar uma tendência na distribuição, parece ter uma tendência de distribuição cúbica.

Vamos testar a transformação da variável votos para a raiz quadrada.

fitted_model <- lm(sqrt(votos) ~ total_despesa + recursos_de_outros_candidatos.comites + quantidade_doadores + sexo + media_despesa + grau, data = obs_without_outliers)

summary(fitted_model)
## 
## Call:
## lm(formula = sqrt(votos) ~ total_despesa + recursos_de_outros_candidatos.comites + 
##     quantidade_doadores + sexo + media_despesa + grau, data = obs_without_outliers)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -432.54  -29.00  -11.71   11.09  397.59 
## 
## Coefficients:
##                                        Estimate Std. Error t value
## (Intercept)                           1.168e+01  2.048e+00   5.705
## total_despesa                         6.955e-05  1.865e-06  37.296
## recursos_de_outros_candidatos.comites 7.395e-05  1.212e-05   6.103
## quantidade_doadores                   9.164e-01  3.645e-02  25.144
## sexoMASCULINO                         2.700e+01  2.129e+00  12.686
## media_despesa                         1.046e-02  6.106e-04  17.122
## grauSUPERIOR COMPLETO                 1.855e+01  1.927e+00   9.630
##                                       Pr(>|t|)    
## (Intercept)                           1.25e-08 ***
## total_despesa                          < 2e-16 ***
## recursos_de_outros_candidatos.comites 1.14e-09 ***
## quantidade_doadores                    < 2e-16 ***
## sexoMASCULINO                          < 2e-16 ***
## media_despesa                          < 2e-16 ***
## grauSUPERIOR COMPLETO                  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 60.35 on 4142 degrees of freedom
## Multiple R-squared:  0.6265, Adjusted R-squared:  0.626 
## F-statistic:  1158 on 6 and 4142 DF,  p-value: < 2.2e-16

Agora nosso R² ajustado aumentou para 0.626 e RSE ficou 60.35, ou seja, houve uma melhora significativa do modelo. Vamos observar novamente o comportamento dos resíduos.

plot(fitted_model, which = 1)

Note que a transformação na variável votos melhorou o modelo, porém, podemos observar que os resíduos ainda seguem um padrão cúbico, reforçando nossa hipótese anterior.


Quais variáveis conseguem explicar melhor o número de votos?

Para responder essa pergunta não é totalmente correto olhar os coeficientes de cada variável na regressão, pois, é preciso avaliar também as escalas das variáveis independentes. Então, vamos responder essa pergunta pela correlação linear entre as variáveis independentes com a variável dependente.

select_obs <- subset(obs_without_outliers, select = c(votos, total_despesa, recursos_de_outros_candidatos.comites, quantidade_doadores, media_despesa))
select_obs$votos <- sqrt(select_obs$votos)

ggpairs(select_obs)

Com o correlograma acima, podemos observar que as variáveis que explicam melhor o número de votos são total_despesa e quantidade_doadores, pois, possuem maior correlação linear com a variável votos.

Essas evidências amostrais possuem apoio real pelo fato de que se um candidato investiu muito na campanha, então, parece ser razoável que ele terá mais votos, além disso, se um candidato recebeu muitas doações, então ele possui muitos apoiadores.