Usando Regressão Linear para Explicar a votação de Deputados
Gustavo Monteiro
October 3, 2018
A base de dados que será usada nesse estudo consiste em dados sobre as votações que candidatos à Câmara Federal de Deputados receberam nos anos de 2006 e 2010 (fonte: http://www.tse.jus.br), além de informações sobre arreadação de campanha, partido, escolaridade, etc.. dos mesmos.
Descrição dos dados
A seguir uma breve decrição sobre os campos disponiveis para cada registro na base de dados.
eleicoes_data <- read_csv(
here('./eleicoes_2006_e_2010.csv'),
local= locale("br"),
col_types = cols(
ano = col_integer(), # ano de referencia
sequencial_candidato = col_character(), # id do candidato
quantidade_doacoes = col_integer(),
quantidade_doadores = col_integer(), # número de doadores diferentes
total_receita = col_double(), # soma em R$ das doações
media_receita = col_double(), # média das doações
recursos_de_outros_candidatos.comites = col_double(), # quantia em R$ das doações provenientes de outros candidatos ou comite partidário
recursos_de_pessoas_fisicas = col_double(), # quantia em R$ das doações provenientes de outros CPFs
recursos_de_pessoas_juridicas = col_double(), # quantia em R$ das doações provenientes de outros CNPJ
recursos_proprios = col_double(), # quantia em R$ das doações provenientes do próprio candidato
`recursos_de_partido_politico` = col_double(), # quantia em R$ das doações provenientes do partido político do candidato
quantidade_despesas = col_integer(),
quantidade_fornecedores = col_integer(), # número de fornecedores/despesas diferentes
total_despesa = col_double(), # soma em R$ das despesas de campanha
media_despesa = col_double(), # média das despesas de campanha
votos = col_integer(), # variável alvo. Se refere ao número de votos na campanha de 2006 ou 2010
.default = col_character()))Uma breve amostra sobre os dados:
eleicoes_data %>%
glimpse()## Observations: 7,476
## Variables: 24
## $ ano <int> 2006, 2006, 2006, 2006, ...
## $ sequencial_candidato <chr> "10001", "10002", "10002...
## $ nome <chr> "JOSÉ LUIZ NOGUEIRA DE S...
## $ uf <chr> "AP", "RO", "AP", "MS", ...
## $ partido <chr> "PT", "PT", "PT", "PRONA...
## $ quantidade_doacoes <int> 6, 13, 17, 6, 48, 6, 14,...
## $ quantidade_doadores <int> 6, 13, 16, 6, 48, 6, 7, ...
## $ total_receita <dbl> 16600.00, 22826.00, 1581...
## $ media_receita <dbl> 2766.67, 1755.85, 9301.2...
## $ recursos_de_outros_candidatos.comites <dbl> 0.00, 6625.00, 2250.00, ...
## $ recursos_de_pessoas_fisicas <dbl> 9000.00, 15000.00, 34150...
## $ recursos_de_pessoas_juridicas <dbl> 6300.00, 1000.00, 62220....
## $ recursos_proprios <dbl> 1300.00, 201.00, 59500.0...
## $ recursos_de_partido_politico <dbl> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ quantidade_despesas <int> 14, 24, 123, 8, 133, 9, ...
## $ quantidade_fornecedores <int> 14, 23, 108, 8, 120, 9, ...
## $ total_despesa <dbl> 16583.60, 20325.99, 1460...
## $ media_despesa <dbl> 1184.54, 846.92, 1187.09...
## $ cargo <chr> "DEPUTADO FEDERAL", "DEP...
## $ sexo <chr> "MASCULINO", "FEMININO",...
## $ grau <chr> "ENSINO MÉDIO COMPLETO",...
## $ estado_civil <chr> "CASADO(A)", "SOLTEIRO(A...
## $ ocupacao <chr> "VEREADOR", "SERVIDOR PÚ...
## $ votos <int> 8579, 2757, 17428, 1193,...sample_n(eleicoes_data %>% select(ano, nome, uf, partido), 7)Para uma melhor descrição dos tipos das colunas:
sapply(eleicoes_data , class)## ano
## "integer"
## sequencial_candidato
## "character"
## nome
## "character"
## uf
## "character"
## partido
## "character"
## quantidade_doacoes
## "integer"
## quantidade_doadores
## "integer"
## total_receita
## "numeric"
## media_receita
## "numeric"
## recursos_de_outros_candidatos.comites
## "numeric"
## recursos_de_pessoas_fisicas
## "numeric"
## recursos_de_pessoas_juridicas
## "numeric"
## recursos_proprios
## "numeric"
## recursos_de_partido_politico
## "numeric"
## quantidade_despesas
## "integer"
## quantidade_fornecedores
## "integer"
## total_despesa
## "numeric"
## media_despesa
## "numeric"
## cargo
## "character"
## sexo
## "character"
## grau
## "character"
## estado_civil
## "character"
## ocupacao
## "character"
## votos
## "integer"Agora separamos os conjuntos de dados das duas eleições.
data_2006 = eleicoes_data %>%
filter(ano == 2006)
data_2010 = eleicoes_data %>%
filter(ano == 2010)Com os dados separados vamos uma exploração inicial de alguns pontos quanto aos dados que estão sendo tema de discussão atualmente, como por exemplo, participação femininina, escolaridade e ocupação dos candidatos além da origem da verba de suas campanhas.
Primeiramente vamos falar da participação feminina, com os numeros gerais das eleições.
eleicoes_data %>%
group_by(sexo, ano) %>%
summarize(n = n()) %>%
ggplot(aes(reorder(sexo,n), n)) +
geom_bar(stat = "identity") +
labs(x="Gender",
y="Absolute Count") +
facet_grid(. ~ano)
E agora por cada um dos pricipais partidos também em esfera nacional.
parties_with_more_candidates_2006 = data_2006 %>%
group_by(partido) %>%
summarise(num = n()) %>%
top_n(5, num)
data_2006 %>%
filter(partido %in% parties_with_more_candidates_2006$partido) %>%
group_by(partido, sexo) %>%
summarise(num = n()) %>%
ggplot(aes(reorder(sexo, num), num)) +
geom_col(stat = "identity") +
labs(x="Gender",
y="Absolute Count") +
facet_grid(. ~partido)## Warning: Ignoring unknown parameters: stat
Como podemos ver, tanto em números gerais quanto para todos os partidos apresentados
Agora falando sobre o grau de escolaridade dos candidatos, em numeros gerais da eleição.
# escolaridade
schooling = data_2006 %>%
group_by(grau) %>%
summarise(num = n())
schooling %>%
ggplot(aes(x = reorder(grau, num), y = num)) +
geom_col() +
labs(x="Degree of schooling",
y="Absolute Count") +
coord_flip()
Vemos que maioria dos candidatos estão em um nível de entre ensino médio completo e ensino superior completo, o que pode parecer até uma noticia animadora.
Agora vemos as mais comuns ocupações dos cadidatos.
accupation = data_2006 %>%
filter(ocupacao != "OUTROS") %>%
group_by(ocupacao) %>%
summarise(num = n()) %>%
top_n(10, num)
accupation %>%
ggplot(aes(x = reorder(ocupacao, num), y = num)) +
geom_col() +
labs(x="Occupation",
y="Absolute Count") +
coord_flip()
Vemos que maioria dos cadidatos são advogados ou empresários, remetendo a uma dominancia das classes mais bem afortunadas da sociedade, além de uma grande participação de politicos que já se declaram estritamente politicos.
Uma visão das várias fontes das cifras dos partidos
parties_with_more_money_2006 = data_2006 %>%
group_by(partido) %>%
summarise(
total = sum(total_receita),
self = sum(recursos_proprios) + sum(recursos_de_partido_politico),
donations = sum(recursos_de_pessoas_fisicas) + sum(recursos_de_pessoas_juridicas),
by_people = sum(recursos_de_pessoas_fisicas),
by_companies = sum(recursos_de_pessoas_juridicas)) %>%
top_n(5, total)
p1 <- parties_with_more_money_2006 %>%
ggplot(aes(x = reorder(partido, total), y = total)) +
geom_col() +
labs(x="Party",
y="Amount") +
labs(title = "Parties with more money") +
coord_flip()
p2 <- parties_with_more_money_2006 %>%
ggplot(aes(x = reorder(partido, self), y = self)) +
geom_col() +
labs(x="Party",
y="Amount") +
labs(title = "Parties with more own money") +
coord_flip()
p3 <- parties_with_more_money_2006 %>%
ggplot(aes(x = reorder(partido, donations), y = donations)) +
geom_col() +
labs(x="Party",
y="Amount") +
labs(title = "Parties with more money donated") +
coord_flip()
p4 <- parties_with_more_money_2006 %>%
ggplot(aes(x = reorder(partido, by_people), y = by_people)) +
geom_col() +
labs(x="Party",
y="Amount") +
labs(title = "Parties with more money donated by people") +
coord_flip()
p5 <- parties_with_more_money_2006 %>%
ggplot(aes(x = reorder(partido, by_companies), y = by_companies)) +
geom_col() +
labs(x="Party",
y="Amount") +
labs(title = "Parties with more money donated by companies") +
coord_flip()
grid.arrange(p1, p2, p3, p4, p5, nrow = 3)
Por ultimo vamos ter uma visualização da correlação entre as variáveis.
data_2006 %>%
select(-partido,
-uf,-nome,
-estado_civil,
-ocupacao,-ano,
-cargo,-grau,-sexo,
-sequencial_candidato) %>%
na.omit() %>%
ggcorr(palette = "RdBu",
color = "grey50",
label = TRUE, hjust = 1,
label_size = 3, size = 4,
nbreaks = 5, layout.exp = 7) +
ggtitle("Correlation plot for 2006 elections")
data_2010 %>%
select(-partido,
-uf,-nome,
-estado_civil,
-ocupacao,-ano,
-cargo,-grau,-sexo,
-sequencial_candidato) %>%
na.omit() %>%
ggcorr(palette = "RdBu",
color = "grey50",
label = TRUE, hjust = 1,
label_size = 3, size = 4,
nbreaks = 5, layout.exp = 7) +
ggtitle("Correlation plot for 2010 elections")
Agora, apresentados os dados, vamos tabalhar em uma regressão linear para explicar o numero de votos que o candidato conseguiu, e atráves disso, responder a uma série de perguntas que serão apresentadas no decorrer desse estudo.
Como primeira pergunta proposta
Um modelo de regressão múltipla com todas as variáveis é plausível para explicar a variação em y (número de votos) em 2006? Mesma pergunta para 2010.
Para responder essa pergunta
Passaremos não somente pela criação e simples avaliação de um modelo, mas também pela análise de residuas e validação, nesse caminho, algumas outras questões serão respondidas, serão destacadas para o leitor, para que não hajam dúvidas.
Primeiramente vamos transformar todas as variáveis qualitativas em fatores, e depois novamente separar os dados em dois conjuntos, um para cada uma das eleições.
eleicoes_data = eleicoes_data %>%
mutate(uf = as.factor(uf),
nome = as.factor(nome),
sexo = as.factor(sexo),
grau = as.factor(grau),
nome = as.factor(nome),
cargo = as.factor(cargo),
partido = as.factor(partido),
ocupacao = as.factor(ocupacao),
estado_civil = as.factor(estado_civil),
sequencial_candidato = as.numeric(sequencial_candidato))
data_2006 = eleicoes_data %>%
filter(ano == 2006)
data_2010 = eleicoes_data %>%
filter(ano == 2010)Agora temos os conjuntos de dados com os seguintes datatypes em suas colunas
data_2006 %>%
glimpse()## Observations: 3,436
## Variables: 24
## $ ano <int> 2006, 2006, 2006, 2006, ...
## $ sequencial_candidato <dbl> 10001, 10002, 10002, 100...
## $ nome <fct> JOSÉ LUIZ NOGUEIRA DE SO...
## $ uf <fct> AP, RO, AP, MS, RO, PI, ...
## $ partido <fct> PT, PT, PT, PRONA, PT, P...
## $ quantidade_doacoes <int> 6, 13, 17, 6, 48, 6, 14,...
## $ quantidade_doadores <int> 6, 13, 16, 6, 48, 6, 7, ...
## $ total_receita <dbl> 16600.00, 22826.00, 1581...
## $ media_receita <dbl> 2766.67, 1755.85, 9301.2...
## $ recursos_de_outros_candidatos.comites <dbl> 0.00, 6625.00, 2250.00, ...
## $ recursos_de_pessoas_fisicas <dbl> 9000.00, 15000.00, 34150...
## $ recursos_de_pessoas_juridicas <dbl> 6300.00, 1000.00, 62220....
## $ recursos_proprios <dbl> 1300.00, 201.00, 59500.0...
## $ recursos_de_partido_politico <dbl> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ quantidade_despesas <int> 14, 24, 123, 8, 133, 9, ...
## $ quantidade_fornecedores <int> 14, 23, 108, 8, 120, 9, ...
## $ total_despesa <dbl> 16583.60, 20325.99, 1460...
## $ media_despesa <dbl> 1184.54, 846.92, 1187.09...
## $ cargo <fct> DEPUTADO FEDERAL, DEPUTA...
## $ sexo <fct> MASCULINO, FEMININO, FEM...
## $ grau <fct> ENSINO MÉDIO COMPLETO, S...
## $ estado_civil <fct> CASADO(A), SOLTEIRO(A), ...
## $ ocupacao <fct> VEREADOR, SERVIDOR PÚBLI...
## $ votos <int> 8579, 2757, 17428, 1193,...Treino, teste, e validação
Agora vamos criar o conjunto de treino, para iniciarmos a modelagem da função linear, criando primeiramente uma semente para que o estudo possa ser reproduzido com os mesmo resultados.
set.seed(1) # for reproducible example
data_2006$id <- 1:nrow(data_2006)E também um conjunto de testes e outro de validação, com o de treino com 60% dos dados, os outros 40% serão usados para geração dos conjuntos de validação e testes.
training_data_2006 = data_2006 %>%
sample_frac(.6)
encoding <- build_encoding(dataSet = training_data_2006,
cols = c("uf","sexo","grau",
"partido","estado_civil"),
verbose = F)
training_data_2006 <- one_hot_encoder(dataSet = training_data_2006,
encoding = encoding,
drop = TRUE,
verbose = F)
remaining_2006 = anti_join(data_2006, training_data_2006, by = 'id')
testing_data_2006 = remaining_2006 %>%
sample_frac(.5)
testing_data_2006 <- one_hot_encoder(dataSet = testing_data_2006,
encoding = encoding,
drop = TRUE,
verbose = F)
validate_data_2006 = anti_join(remaining_2006, testing_data_2006, by = 'id')
validate_data_2006 <- one_hot_encoder(dataSet = validate_data_2006,
encoding = encoding,
drop = TRUE,
verbose = F)
rm(remaining_2006)E agora criando um modelo com todas as variáveis.
model_2006 = lm(votos ~ partido.PSDB + partido.PT + quantidade_doacoes + quantidade_doadores + total_receita + media_receita
+ recursos_de_outros_candidatos.comites + recursos_de_pessoas_fisicas + recursos_de_pessoas_juridicas
+ recursos_proprios + recursos_de_partido_politico + quantidade_despesas + quantidade_fornecedores
+ total_despesa + media_despesa + sexo.MASCULINO + `grau.SUPERIOR COMPLETO` + sexo.FEMININO
+ `grau.ENSINO FUNDAMENTAL COMPLETO` + `grau.ENSINO FUNDAMENTAL INCOMPLETO` + `grau.ENSINO MÉDIO COMPLETO`
+ `grau.ENSINO MÉDIO INCOMPLETO` + `grau.LÊ E ESCREVE` + `grau.SUPERIOR INCOMPLETO` + partido.DEM
+ `partido.PC do B` + `partido.PDT` + partido.PHS + partido.PMDB + partido.PP + partido.PPS + partido.PR
+ partido.PSB + partido.PSL + partido.PSOL + partido.PTB + partido.PV + estado.civil.CASADO.A. + estado.civil.DIVORCIADO.A.
+ `estado.civil.SEPARADO.A. JUDICIALMENTE` + `estado.civil.SOLTEIRO.A.` + `estado.civil.VIÚVO.A.`,
data = testing_data_2006)Agora que temos o modelo pronto, famos fazeer uma pequena análise de suas significancia.
glance(model_2006)Nossa estatistica de R² mostra ser moderada, explicando cerca de 54% da variação dos dados, e tendo um diferença mínima para o R² ajustado, o que é muito pouco satisfatória, tendo em vista a quantidade de variáveis usadas, existe o risco de uma estar atrapalhando outra.
Agora fazemos o mesmo processo para os dados de 2010
data_2010$id <- 1:nrow(data_2010)
training_data_2010 = data_2010 %>%
sample_frac(.6)
encoding <- build_encoding(dataSet = training_data_2010,
cols = c("uf","sexo","grau",
"partido","estado_civil"),
verbose = F)
training_data_2010 <- one_hot_encoder(dataSet = training_data_2010,
encoding = encoding,
drop = TRUE,
verbose = F)
remaining_2010 = anti_join(data_2010, training_data_2010, by = 'id')
testing_data_2010 = remaining_2010 %>%
sample_frac(.5)
testing_data_2010 <- one_hot_encoder(dataSet = testing_data_2010,
encoding = encoding,
drop = TRUE,
verbose = F)
validate_data_2010 = anti_join(remaining_2010, testing_data_2010, by = 'id')
validate_data_2010 <- one_hot_encoder(dataSet = validate_data_2010,
encoding = encoding,
drop = TRUE,
verbose = F)
rm(remaining_2010)
model_2010 = lm(votos ~ partido.PSDB + partido.PT + quantidade_doacoes + quantidade_doadores + total_receita + media_receita
+ recursos_de_outros_candidatos.comites + recursos_de_pessoas_fisicas + recursos_de_pessoas_juridicas
+ recursos_proprios + recursos_de_partido_politico + quantidade_despesas + quantidade_fornecedores
+ total_despesa + media_despesa + sexo.MASCULINO + `grau.SUPERIOR COMPLETO` + sexo.FEMININO
+ `grau.ENSINO FUNDAMENTAL COMPLETO` + `grau.ENSINO FUNDAMENTAL INCOMPLETO` + `grau.ENSINO MÉDIO COMPLETO`
+ `grau.ENSINO MÉDIO INCOMPLETO` + `grau.LÊ E ESCREVE` + `grau.SUPERIOR INCOMPLETO` + partido.DEM
+ `partido.PC do B` + `partido.PDT` + partido.PHS + partido.PMDB + partido.PP + partido.PPS + partido.PR
+ partido.PSB + partido.PSL + partido.PSOL + partido.PTB + partido.PV + estado.civil.CASADO.A. + estado.civil.DIVORCIADO.A.
+ `estado.civil.SEPARADO.A. JUDICIALMENTE` + `estado.civil.SOLTEIRO.A.` + `estado.civil.VIÚVO.A.`,
data = testing_data_2010)
glance(model_2010)Vemos que, para os dados de 2010, o modelo com todas as variáveis se torna um pouco mais representativo, explicando cerca de 64% da mudança nos dados, e com um R² ajustado bem próximo disso, então acho que podemos considerar que o modelo com todas as variáveis não seria válido para esses dados.
Pórem, uma análise embasada somento no R² e R² ajustado pode estar nos levando a uma opinião muito inocente sobre o modelo, então, a seguir, faremos uma série de outras análises em cima do modelo, para podermos ter uma opinião mais fortemente embasado sobre sua eficacia.
Então, vamos ter um breve visão para uma das nossas perguntas.
Quais variáveis conseguem explicar melhor o número de votos? Compare essas variáveis entre os modelos. Mesma coisa para as variáveis menos explicativas.
Primeiro vamos ver quais variáveis tiveram um p-valor mais alto, ou seja, os que se mostram menos confiáveis.
# preditores com p valor alto
tidy(model_2006,
conf.int = TRUE,
conf.level = .97) %>%
top_n(3, p.value) %>%
ggplot(aes(reorder(term, p.value), p.value)) +
geom_point() +
labs(x = "Variable",
y = "Estimation (97% of confidence)")
E agora, no extremo contrário, as variáveis com p-valor mais baixo.
# preditores com um p valor baixo
tidy(model_2006,
conf.int = TRUE,
conf.level = 0.97) %>%
arrange(p.value) %>%
slice(1:3) %>%
ggplot(aes(reorder(term, p.value), p.value)) +
geom_hline(yintercept = 0.05) +
geom_point(size = 3.5) +
labs(x = "Variable",
y = "Estimated value (97% of confidence)")
E agora para os dados de 2010, primeiramente para p-valor alto
tidy(model_2010,
conf.int = TRUE,
conf.level = .97) %>%
top_n(3, p.value) %>%
ggplot(aes(reorder(term, p.value), p.value)) +
geom_point() +
labs(x = "Variable",
y = "Estimation (97% of confidence)")
e agora, p-valor baixo
tidy(model_2010,
conf.int = TRUE,
conf.level = 0.97) %>%
arrange(p.value) %>%
slice(1:3) %>%
ggplot(aes(reorder(term, p.value), p.value)) +
geom_hline(yintercept = 0.05) +
geom_point(size = 3.5) +
labs(x = "Variable",
y = "Estimated value (97% of confidence)")
Nos gráficos acima, podemos perceber em linhas gerais que variáveis ligadas ao montante de dinheiro que os partidos investem eu suas campanhas parecem mais seguramente relacionadas ao número de vostos adquiridos em ambas as campanhas, com a excessão da presensa da variável partido-PR para 2010, e como variáveis suspeitas de não terem relação com o número de votos estão as relacionadas com qual o partido politico e escolaridade do cadidato, juntamente com seu estado civil, que se torna menos importante ainda, nas eleições de 2010.
Análise de resíduos
Residual vs Fitted
model_2006 %>%
ggplot(aes(.fitted, .resid)) +
geom_point() +
stat_smooth(method="loess") +
geom_hline(col="red",
yintercept = 0,
linetype="dashed") +
labs(y="Residuals",
x="Fitted values",
title="Residual vs Fitted Plot (2006)")
E agora para os dados de 2010
model_2010 %>%
ggplot(aes(.fitted, .resid)) +
geom_point() +
stat_smooth(method="loess") +
geom_hline(col="red",
yintercept = 0,
linetype="dashed") +
labs(y="Residuals",
x="Fitted values",
title="Residual vs Fitted Plot (2010)")
Para ambos os conjuntos de dados, vemos que a distribuição dos pontos não é aleatoria nem igualmente distribuida ao longo do eixo x, o que pode mostrar que o modelo pode não estar considerando relações não lineares, ou indicar que variáveis que seriam importantes ao modelo não foram incluidas.
Standardized residuals
model_2006 %>%
ggplot(aes(.fitted,
sqrt(abs(.stdresid)))) +
geom_point(na.rm=TRUE) +
stat_smooth(method="loess",
na.rm = TRUE) +
labs(title = "Scale-Location (2006)",
x= "Fitted Value",
y = expression(sqrt("|Standardized residuals|")))
model_2010 %>%
ggplot(aes(.fitted,
sqrt(abs(.stdresid)))) +
geom_point(na.rm=TRUE) +
stat_smooth(method="loess",
na.rm = TRUE) +
labs(title = "Scale-Location (2010)",
x= "Fitted Value",
y = expression(sqrt("|Standardized residuals|")))
Novamente, ambos o modelos não mostram homocedasticidade e mostrarem um certo padrão, pode não estar considerando variáveis que são as reais responsáveis pela votação de um candidato, ou o excesso de variáveis que podem estar atrapalhando o modelo, além do erro irredutivel.
Cook’s Distance
model_2006 %>%
ggplot(aes(.hat, .stdresid)) +
geom_point(aes(size=.cooksd), na.rm=TRUE) +
stat_smooth(method="loess", na.rm=TRUE) +
xlab("Leverage")+ylab("Standardized Residuals") +
ggtitle("Residual vs Leverage Plot (2006)") +
scale_size_continuous("Cook's Distance", range=c(1,5)) +
theme(legend.position="bottom")
model_2010 %>%
ggplot(aes(.hat, .stdresid)) +
geom_point(aes(size=.cooksd), na.rm=TRUE) +
stat_smooth(method="loess", na.rm=TRUE) +
xlab("Leverage") +
ylab("Standardized Residuals") +
ggtitle("Residual vs Leverage Plot (2010)") +
scale_size_continuous("Cook's Distance", range=c(1,5)) +
theme(legend.position="bottom")
Para ambas as eleições vemos muitos valores com distancias de cook muito altas, o que mostra o o modelo é distoante com muitos dos valores, o que pode nos dizer que o modelo é bom, pois existem muitos dados que se mostram grandes influenciadores do modelo, mesmo quando a modelagem pode os ver como ouliers.
Validação 2006
predictions <- model_2006 %>% predict(validate_data_2006)## Warning in predict.lm(., validate_data_2006): prediction from a rank-
## deficient fit may be misleadingdata.frame( R2 = R2(predictions, validate_data_2006$votos),
RMSE = RMSE(predictions, validate_data_2006$votos),
MAE = MAE(predictions, validate_data_2006$votos),
ERR = RMSE(predictions, validate_data_2006$votos)/
mean(validate_data_2006$votos))O modelo conseguiu um R² de 0,57, isso significa que esse modelo explica aproximadamente 57% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 28340,5 issod quer dizer que o modelo erraria aproximadamente 28340, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 28340 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 15924.48. A taxa de erro de previsão (ERR) foi de 1.109683.
Teste 2006
predictions <- model_2006 %>% predict(testing_data_2006)## Warning in predict.lm(., testing_data_2006): prediction from a rank-
## deficient fit may be misleadingdata.frame( R2 = R2(predictions, testing_data_2006$votos),
RMSE = RMSE(predictions, testing_data_2006$votos),
MAE = MAE(predictions, testing_data_2006$votos),
ERR = RMSE(predictions, testing_data_2006$votos)/
mean(testing_data_2006$votos))O modelo conseguiu um R² de 0,54, isso significa que esse modelo explica aproximadamente 54% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 28056.78 isso quer dizer que o modelo erraria aproximadamente 28056, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 28056 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 13190.14. A taxa de erro de previsão (ERR) foi de 1.304018.
Validação 2010
predictions <- model_2010 %>% predict(validate_data_2010)## Warning in predict.lm(., validate_data_2010): prediction from a rank-
## deficient fit may be misleadingdata.frame( R2 = R2(predictions, validate_data_2010$votos),
RMSE = RMSE(predictions, validate_data_2010$votos),
MAE = MAE(predictions, validate_data_2010$votos),
ERR = RMSE(predictions, validate_data_2010$votos)/
mean(validate_data_2010$votos))O modelo conseguiu um R² de 0,44, isso significa que esse modelo explica aproximadamente 56% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 31995.79 issod quer dizer que o modelo erraria aproximadamente 31995, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 31995 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 14931.24. A taxa de erro de previsão (ERR) foi de 1.399707.
Teste 2010
predictions <- model_2010 %>% predict(testing_data_2010)## Warning in predict.lm(., testing_data_2010): prediction from a rank-
## deficient fit may be misleadingdata.frame( R2 = R2(predictions, testing_data_2010$votos),
RMSE = RMSE(predictions, testing_data_2010$votos),
MAE = MAE(predictions, testing_data_2010$votos),
ERR = RMSE(predictions, testing_data_2010$votos)/
mean(testing_data_2010$votos))O modelo conseguiu um R² de 0,56, isso significa que esse modelo explica aproximadamente 56% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 29604.97 issod quer dizer que o modelo erraria aproximadamente 29604, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 29604 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 14371.57. A taxa de erro de previsão (ERR) foi de 1.399707.
Um novo modelo para 2006
Agora vamos construir um modelo apenas com as variáveis que foram jugadas como importantes pela análise de correlação e medição do p-valor.
mod_2006 <- lm(votos ~ total_receita * total_despesa * recursos_de_pessoas_juridicas,
data = training_data_2006)
glance(mod_2006)Nossa estatistica de R² émoderada/baixa, explicando cerca de 50% da variação dos dados, e tendo um diferença mínima para o R² ajustado, o que é pouco satisfatória, porém mais análises podem ser feitas.
Aplicando a ele os mesmos processos de análise de qualidade que aplicamos aos anteriores
Residual vs Fitted
mod_2006 %>%
ggplot(aes(.fitted, .resid)) +
geom_point() +
stat_smooth(method="loess") +
geom_hline(col="red",
yintercept=0,
linetype="dashed") +
labs(y="Residuals",
x="Fitted values",
title="Residual vs Fitted Plot (2006)")
Vemos que o novo modelo acomoda melhor a distribuição dos dados em tono do eixo x, mais ainda não de forma não tão satisfatória, tendo mais pontos para um lado que para outro, e um lado mais espalhado que o outro, isso pode indicar a falta de alguma variável importante no modelo.
Standardized residuals
mod_2006 %>%
ggplot(aes(.fitted,
sqrt(abs(.stdresid)))) +
geom_point(na.rm=TRUE) +
stat_smooth(method="loess",
na.rm = TRUE) +
labs(title = "Scale-Location (2006)",
x= "Fitted Value",
y = expression(sqrt("|Standardized residuals|")))
Novamente, o modelo mostra certa homocedasticidade mas tem também os problemas coma aleatoriedade, tendo em vista que os pontos não são distribuidos igualmente, algo que pode estar não só atrelado ao erro irredutivel, mas ainda sim, mostra uma melhora significativa se comparado ao modelo com todas as variáveis.
Cook’s Distance
mod_2006 %>%
ggplot(aes(.hat, .stdresid)) +
geom_point(aes(size=.cooksd), na.rm=TRUE) +
stat_smooth(method="loess", na.rm=TRUE) +
xlab("Leverage") +
ylab("Standardized Residuals") +
ggtitle("Residual vs Leverage Plot (2006)") +
scale_size_continuous("Cook's Distance", range=c(1,5)) +
theme(legend.position="bottom")
Vemos também valores bem menores para distancia de cook e para bem menos pontos distoantes, o que pode nos dizer que o modelo se encontra em conformidade considerável com a variação os dados.
Validação 2006
predictions <- mod_2006 %>% predict(validate_data_2006)
data.frame( R2 = R2(predictions, validate_data_2006$votos),
RMSE = RMSE(predictions, validate_data_2006$votos),
MAE = MAE(predictions, validate_data_2006$votos),
ERR = RMSE(predictions, validate_data_2006$votos)/
mean(validate_data_2006$votos))O modelo conseguiu um R² de 0,71, isso significa que esse modelo explica aproximadamente 71% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 23389.79 issod quer dizer que o modelo erraria aproximadamente 29604, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 29326 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 12379.08 A taxa de erro de previsão (ERR) foi de 0.9158357.
Teste 2006
predictions <- mod_2006 %>% predict(testing_data_2006)
data.frame( R2 = R2(predictions, testing_data_2006$votos),
RMSE = RMSE(predictions, testing_data_2006$votos),
MAE = MAE(predictions, testing_data_2006$votos),
ERR = RMSE(predictions, testing_data_2006$votos)/
mean(testing_data_2006$votos))O modelo conseguiu um R² de 0,48, isso significa que esse modelo explica aproximadamente 48% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 30105.75 issod quer dizer que o modelo erraria aproximadamente 30105, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 30105 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 12779.06. A taxa de erro de previsão (ERR) foi de 1.399249.
Um novo modelo para 2010
mod_2010 <- lm(votos ~ total_receita * total_despesa * recursos_de_pessoas_juridicas,
data = training_data_2010)
glance(mod_2010)Nossa estatistica de R² baixa, explicando cerca de 46% da variação dos dados, e tendo um diferença mínima para o R² ajustado, o que é pouco satisfatória, porém por ser bem mais simples do que a com todas as variáveis alguma diminuição era esperanda, vamos fazer análises de residuos então.
Residual vs Fitted Plot
mod_2010 %>%
ggplot(aes(.fitted, .resid)) +
geom_point() +
stat_smooth(method="loess") +
geom_hline(col="red",
yintercept=0,
linetype="dashed") +
labs(y="Residuals",
x="Fitted values",
title="Residual vs Fitted Plot (2010)")
Vemos que o novo modelo acomoda muito melhor a distribuição dos dados em tono do eixo x, mais ainda não de forma não tão satisfatória, tendo mais pontos para um lado que para outro, e um lado um pouco mais espalhado que o outro, mostrando que o modelo não se ajusta totalmente.
Standardized residuals
mod_2010 %>%
ggplot(aes(.fitted,
sqrt(abs(.stdresid)))) +
geom_point(na.rm=TRUE) +
stat_smooth(method="loess",
na.rm = TRUE) +
labs(title = "Scale-Location (2010)",
x= "Fitted Value",
y = expression(sqrt("|Standardized residuals|")))
O modelo mostra certa homocedasticidade mas tem também os problemas coma aleatoriedade, tendo em vista que os pontos não são distribuidos igualmente, algo que pode estar não só atrelado ao erro irredutivel, mas ainda sim, mostra uma melhora significativa se comparado ao modelo com todas as variáveis.
Cook’s Distance
mod_2010 %>%
ggplot(aes(.hat, .stdresid)) +
geom_point(aes(size=.cooksd), na.rm=TRUE) +
stat_smooth(method="loess", na.rm=TRUE) +
xlab("Leverage") +
ylab("Standardized Residuals") +
ggtitle("Residual vs Leverage Plot (2006)") +
scale_size_continuous("Cook's Distance", range=c(1,5)) +
theme(legend.position="bottom")
Vemos também valores extremamente menores para distancia de cook e para bem menos pontos distoantes, o que pode nos dizer que o modelo se encontra em conformidade considerável com os a variação dos dados.
Validação 2010
predictions <- mod_2010 %>% predict(validate_data_2010)
data.frame( R2 = R2(predictions, validate_data_2010$votos),
RMSE = RMSE(predictions, validate_data_2010$votos),
MAE = MAE(predictions, validate_data_2010$votos),
ERR = RMSE(predictions, validate_data_2010$votos)/
mean(validate_data_2010$votos))O modelo conseguiu um R² de 0.55, isso significa que esse modelo explica aproximadamente 48% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 28410.54 issod quer dizer que o modelo erraria aproximadamente 28410, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 28410 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 11804.81. A taxa de erro de previsão (ERR) foi de 1.428713.
Teste 2010
predictions <- mod_2010 %>% predict(testing_data_2010)
data.frame( R2 = R2(predictions, testing_data_2010$votos),
RMSE = RMSE(predictions, testing_data_2010$votos),
MAE = MAE(predictions, testing_data_2010$votos),
ERR = RMSE(predictions, testing_data_2010$votos)/
mean(testing_data_2010$votos))O modelo conseguiu um R² de 0,57, isso significa que esse modelo explica aproximadamente 57% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 29194.57 isso quer dizer que o modelo erraria aproximadamente 29194, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 29194 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 11922.71.
A taxa de erro de previsão (ERR) foi de 1.380304.
Um modelo conjunto
Construindo conjuntos de treino teste e validação
eleicoes_data$id <- 1:nrow(eleicoes_data)
training_data = eleicoes_data %>%
sample_frac(.6)
encoding <- build_encoding(dataSet = training_data,
cols = c("uf","sexo","grau",
"partido","estado_civil"),
verbose = F)
training_data <- one_hot_encoder(dataSet = training_data,
encoding = encoding,
drop = TRUE,
verbose = F)
remaining = anti_join(eleicoes_data, training_data, by = 'id')
testing_data = remaining %>%
sample_frac(.5)
testing_data <- one_hot_encoder(dataSet = testing_data,
encoding = encoding,
drop = TRUE,
verbose = F)
validate_data = anti_join(remaining, testing_data, by = 'id')
validate_data <- one_hot_encoder(dataSet = validate_data,
encoding = encoding,
drop = TRUE,
verbose = F)
rm(remaining)Constuindo o modelo
mod <- lm(votos ~ total_receita * total_despesa * recursos_de_pessoas_juridicas,
data = training_data)
glance(mod)A estatistica de R² está um pouco baixa, explicando cerca de 48% da variação dos dados, e tendo um diferença mínima para o R² ajustado, o que é pouco satisfatória, vamos agora a análise de residuos para termos um panorama mais completos
Residual vs Fitted
mod %>%
ggplot(aes(.fitted, .resid)) +
geom_point() +
stat_smooth(method="loess") +
geom_hline(col="red",
yintercept=0,
linetype="dashed") +
labs(y="Residuals",
x="Fitted values",
title="Residual vs Fitted Plot")
Vemos que o novo modelo acomoda bem a distribuição dos dados em tono do eixo x,mesmo que só ocupando a parte central do gráfico a dispersão parae aleatória, o que é um bom sinal.
Standardized residuals
mod %>%
ggplot(aes(.fitted,
sqrt(abs(.stdresid)))) +
geom_point(na.rm=TRUE) +
stat_smooth(method="loess",
na.rm = TRUE) +
labs(title = "Scale-Location",
x= "Fitted Value",
y = expression(sqrt("|Standardized residuals|")))
Nesta análise ele também mostra ter um dispersão parcialmente aleatória, muito concentrada no meio pra cima do gráfico
Cook’s Distance
mod %>%
ggplot(aes(.hat, .stdresid)) +
geom_point(aes(size=.cooksd), na.rm=TRUE) +
stat_smooth(method="loess", na.rm=TRUE) +
xlab("Leverage") +
ylab("Standardized Residuals") +
ggtitle("Residual vs Leverage Plot") +
scale_size_continuous("Cook's Distance", range=c(1,5)) +
theme(legend.position="bottom")
Vemos também valores um pouco altos para distancia de cookmas para poucos pontos, o que pode nos dizer que o modelo se encontra em conformidade considerável com os a variação dos dados.
Validação
predictions <- mod %>% predict(validate_data)
data.frame( R2 = R2(predictions, validate_data$votos),
RMSE = RMSE(predictions, validate_data$votos),
MAE = MAE(predictions, validate_data$votos),
ERR = RMSE(predictions, validate_data$votos)/
mean(validate_data$votos))O modelo conseguiu um R² de 0,52, isso significa que esse modelo explica aproximadamente 52% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 32477.57 isso quer dizer que o modelo erraria aproximadamente 32477, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 32477 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 13833.14.
A taxa de erro de previsão (ERR) foi de
Teste
predictions <- mod %>% predict(testing_data)
data.frame( R2 = R2(predictions, testing_data$votos),
RMSE = RMSE(predictions, testing_data$votos),
MAE = MAE(predictions, testing_data$votos),
ERR = RMSE(predictions, testing_data$votos)/
mean(testing_data$votos))O modelo conseguiu um R² de 0,45, isso significa que esse modelo explica aproximadamente 57% da variabilidade da variável resposta. A diferença média entre os valores de resultados conhecidos observados e os valores previstos pelo modelo (RMSE) foi de aproximadamente 37515.32 isso quer dizer que o modelo erraria aproximadamente 37515, ou seja, se o candidato tivesse um milhão de votos, nós preveríamos até 37515 mais/menos do que deveríamos A diferença absoluta média entre os resultados observados e previstos (MAE) foi de aproximadamente 13578.44.
A taxa de erro de previsão (ERR) foi de 1.686544.
Com base nesses dados posso afirmar que o modelo não é muito satisfátório, porem pode ser bastante melhorado, principalmente porque algumas das suas estatisticas de residuos mostram problemas e seu R² ainda pode ser considerado muito baixo, pois foi um pouco inferior aos encontrados nos modelos com todas as variáveis, mas muito mais simples.