Election présidentielle américaine de 2008
Ana Karina Fermin
Nous travaillons avec la base de données de l’élection présidentielle américaine de 2008. Les variables que nous allons utiser sont :
ethnie : vcf0106a
revenue : vcf0114
sexe : vcf0104
vote : vcf0704
Une question se pose avec ces données : les électeurs de minorités ethniques (vs les Blancs), les gens moins favorisés économiquement (vs les plus favorisés) et les femmes (plus que les hommes) ont plus grande probabilité d’appuyer le candidat démocrate Barack Obama.
Bibliographie : Jean-Herman Guay (voir le site de l’auteur : http://dimension.usherbrooke.ca/dimension/v2ssrcadre.html)
library(tidyverse)Lecture des données brutes
# Lecture des donées
ElectionUSA2008 <- read.table("df2008USAElectionGuay", header=TRUE, encoding="latin1")
dim(ElectionUSA2008)## [1] 2322 949Regardons les réponses de 10 electeurs choisis au hasard
ElectionUSA2008 %>% select(vcf0704,vcf0106a,vcf0104,vcf0114) %>% sample_n(10)## vcf0704 vcf0106a vcf0104 vcf0114
## 1916 2 1 2 2
## 1368 0 5 1 2
## 2117 1 2 2 2
## 2302 1 1 1 2
## 1016 1 2 2 3
## 1892 0 5 2 1
## 2136 1 5 2 0
## 987 0 1 2 2
## 1816 1 2 1 3
## 1071 1 2 2 2summary(ElectionUSA2008 %>% select(vcf0704,vcf0106a,vcf0104,vcf0114))## vcf0704 vcf0106a vcf0104 vcf0114
## Min. :0.0000 Min. :0.000 Min. :1.00 Min. :0.000
## 1st Qu.:0.0000 1st Qu.:1.000 1st Qu.:1.00 1st Qu.:1.000
## Median :1.0000 Median :1.000 Median :2.00 Median :3.000
## Mean :0.8842 Mean :2.147 Mean :1.57 Mean :2.468
## 3rd Qu.:1.0000 3rd Qu.:2.000 3rd Qu.:2.00 3rd Qu.:3.000
## Max. :2.0000 Max. :7.000 Max. :2.00 Max. :5.000Nettoyage des données
Renomer les varaibles et ses valeurs (de facon plus lissible). Par exemple,
ethnie : Blanc et Autre (minorités ethniques)
revenue : R1 = très hauts revenus, R2 = hauts revenus, R3 = bas revenus, R4 = très bas revenus
sexe : F= femmes , H = hommes
vote : Obama ou Autre
Nous allons faire un nettoyer des données (clean data) comme le propose l’auteur Jean-Herman Guay mais avec notre facon de faire …Nous allons adapter le code proposé par Guay (voir ci-dessous).
# Extaction de quelques colonnes du tableau
ElectionUSA2008_A <- ElectionUSA2008 %>% select(sexe = vcf0104,
ethnie = vcf0106a,
revenu = vcf0114,
vote = vcf0704)
#Elimination de la non-réponse pour les variables par, revenu et ethnie
ElectionUSA2008_A <- ElectionUSA2008_A %>% filter(vote>0,revenu>0,ethnie>0)
#Elimination d'autre parties
ElectionUSA2008_A <- ElectionUSA2008_A %>% filter(vote<3)
#Recodage en factor et aggregation à l'aide de fct_collapse
ElectionUSA2008_A <- ElectionUSA2008_A %>%
mutate(sexe = fct_collapse(factor(sexe),"F" = "1","H" = "2"),
vote = fct_collapse(factor(vote), "Obama" = "1","Autre" = "2") %>% fct_relevel("Autre"),
revenu = fct_collapse(factor(revenu),"R1" = c("4","5"), "R2" =c("3"),"R3" = c("2"), "R4" = c("1")),
ethnie = fct_collapse(factor(ethnie), "Blanc" = "1", "Autre" = c("2", "3", "4", "5", "7")))
summary(ElectionUSA2008_A)## sexe ethnie revenu vote
## F:590 Blanc:762 R4:215 Autre:487
## H:851 Autre:679 R3:278 Obama:954
## R2:586
## R1:362Analyse descriptive de données socio-economiques
Dans la suite, utiliser le tableau simplifié ElectionUSA2008_A.
- Présenter les données à l’aide des résumés et graphiques pertinents selon le type de variable (pour quelques variables). Interpréter les représentations graphiques des données. Faire également un analyse d’un point de vue “socio-economique”.
ggplot(ElectionUSA2008_A, aes(x=ethnie,fill=ethnie)) +
geom_bar(aes(y = ..count../sum(..count..))) +
ggtitle("Intention de vote selon l'ethnie ") +
facet_wrap(facets = ~ vote) +
ylab("proportion")
ggplot(ElectionUSA2008_A, aes(x=revenu,fill=revenu)) +
geom_bar(aes(y = ..count../sum(..count..))) +
ggtitle("Intentions de vote selon le revenu") +
facet_wrap(facets = ~ vote) +
ylab("proportion")
ggplot(ElectionUSA2008_A, aes(x=sexe,fill=sexe)) +
geom_bar(aes(y = ..count../sum(..count..))) +
ggtitle("Intentions de vote selon le sex") +
facet_wrap(facets = ~ vote) +
ylab("proportion")
Modèle logit
On cherche à repondre aux questions de notre problème metier :
Est-ce que les électeurs de minorités ethniques (vs les blancs), les gens moins favorisés économiquement (vs les plus favorisés) et les femmes (plus que les hommes) ont plus grande probabilité d’appuyer le candidat démocrate Barack Obama ?.
- Estimer la probabilité de voter pour Obama à partir des variables explicatives
sexe,ethnieetrevenu.
Tout d’abord, on cherche à expliquer le vote en fonction de variables sexe, ethnie et revenu. On va ajuster un modèle de régression logistique
modele_vote <- glm(vote ~ sexe+ethnie+revenu, data=ElectionUSA2008_A,
family=binomial("logit"))
modele_vote##
## Call: glm(formula = vote ~ sexe + ethnie + revenu, family = binomial("logit"),
## data = ElectionUSA2008_A)
##
## Coefficients:
## (Intercept) sexeH ethnieAutre revenuR3 revenuR2
## 0.3161 0.2036 2.2842 -0.2809 -0.5742
## revenuR1
## -1.0881
##
## Degrees of Freedom: 1440 Total (i.e. Null); 1435 Residual
## Null Deviance: 1844
## Residual Deviance: 1455 AIC: 1467- Donner la probabilité pour un individu de sexe feminin (et de sexe masculin) appartenant à une minorité ethnique avec un très bas revenus. Donner Que peut-on déduire ?
xnew <- tribble(
~sexe, ~ethnie, ~revenu,
"F", "Autre", "R4",
"H", "Autre", "R4"
)
pred_xnew<-predict(modele_vote,newdata=xnew,type="response")
pred_xnew## 1 2
## 0.9308788 0.9428834On peut déduire qu’une femme très défavorisée et appartenant à une minorité aurait voté pour Obama avec une proba de 93,1%. La probabilité pour un homme du même profil est de 94,3 %.
- Donner la probabilité pour un individu de sexe feminin (et de sexe masculin) n’appartenant pas à une minorité ethnique et avec un très hauts revenus. Donner Que peut-on déduire ?
On peut remarquer qu’une femme un très hauts revenus et n’appartenant pas à une minorité a probablement voté pour Obama avec une probabilité de 31,6 % , alors que chez les hommes ce n’était plus que 36,1%.
Il semble bien que l’appartenance à une minorité ethnique et à une classe sociale joue un rôle important.
xnew <- tribble(
~sexe, ~ethnie, ~revenu,
"F", "Blanc", "R1",
"H", "Blanc", "R1"
)
pred_xnew<-predict(modele_vote,newdata=xnew,type="response")
pred_xnew## 1 2
## 0.3160453 0.3616004- Ajuster des modèles de regresssions logistiques. Choisir un modèle parmi les modèles proposés.
modele_vote1 <- glm(vote ~ ethnie+revenu, data=ElectionUSA2008_A,
family=binomial("logit"))
modele_vote1##
## Call: glm(formula = vote ~ ethnie + revenu, family = binomial("logit"),
## data = ElectionUSA2008_A)
##
## Coefficients:
## (Intercept) ethnieAutre revenuR3 revenuR2 revenuR1
## 0.4403 2.2819 -0.2694 -0.5776 -1.1101
##
## Degrees of Freedom: 1440 Total (i.e. Null); 1436 Residual
## Null Deviance: 1844
## Residual Deviance: 1458 AIC: 1468summary(modele_vote)##
## Call:
## glm(formula = vote ~ sexe + ethnie + revenu, family = binomial("logit"),
## data = ElectionUSA2008_A)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3928 -0.9474 0.3928 0.6312 1.5178
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.3161 0.2147 1.472 0.14098
## sexeH 0.2036 0.1307 1.558 0.11933
## ethnieAutre 2.2842 0.1490 15.326 < 2e-16 ***
## revenuR3 -0.2809 0.2512 -1.118 0.26342
## revenuR2 -0.5742 0.2178 -2.637 0.00838 **
## revenuR1 -1.0881 0.2284 -4.764 1.9e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1843.5 on 1440 degrees of freedom
## Residual deviance: 1455.3 on 1435 degrees of freedom
## AIC: 1467.3
##
## Number of Fisher Scoring iterations: 4summary(modele_vote1)##
## Call:
## glm(formula = vote ~ ethnie + revenu, family = binomial("logit"),
## data = ElectionUSA2008_A)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3605 -0.9092 0.4063 0.6031 1.4718
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.4403 0.1992 2.210 0.02711 *
## ethnieAutre 2.2819 0.1489 15.328 < 2e-16 ***
## revenuR3 -0.2694 0.2508 -1.074 0.28272
## revenuR2 -0.5776 0.2175 -2.656 0.00791 **
## revenuR1 -1.1101 0.2277 -4.875 1.09e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1843.5 on 1440 degrees of freedom
## Residual deviance: 1457.7 on 1436 degrees of freedom
## AIC: 1467.7
##
## Number of Fisher Scoring iterations: 4Cette question peut être des fois difficile ! A vous de jouer!
- Exercice : Essayer un autre critère que AIC pour le choix entre
modele_voteetmodele_vote1.