{"word_count": 1249, "character_count": 12627}
La Vie des Idées a mis en ligne, ce matin, un court texte, écrit par Baptiste Coulmont (a.k.a. @coulmont) et Joël Gombin (a.k.a. @joelgombin), auquel j'ai très modestement contribué, intitulé "Un homme, deux voix. Le vote par procuration".Alors que sur son blog, Baptiste a rajouté pas mal d'information sur le vote par procuration en France (et le contexte général, en particulier pourquoi autant de partis courtisent certaines personnes en les incitant à voter par procuration), et sur les bases de données, je voulais en profiter pour mettre en ligne quelques codes utilisés dans l'article, et en particulier, mentionner des graphiques non-utilisés car plus difficile à interpréter, mais à mon avis plus juste en terme de modèle (comme les conclusions étaient les mêmes, on a retenu des graphiques plus classiques). Rappelons tout d'abord qu'on analyse non pas le vote à partir de données individuelles (ceci ne peut s'obtenir, le vote étant encore secret en France), mais à partir des résultats des différents bureaux de vote (c'est la notion de corrélation écologique évoquée dans le texte, à cause du problème potentiel d'ecological fallacy). Moyennant toutes ces précautions d'usage, on a essayé d'analyser les données à notre disposition. Modèle de régression, et recherche de variables explicationsPour faire une régression, et expliquer le taux de procurations dans un bureau de vote, ma première idée était de dire que  où  est le nombre de procurations dans le bureau de vote , et où  est (au choix) le nombre d'électeurs inscrits ou le nombre d'électeurs ayant voté. On suppose ici que , la proportion d'électeurs qui a voté par procuration peut être fonction de divers variables explicatives. Les variables, elles sont dans la base suivante (je renvoie vers le blog de Baptiste pour les bases que l'on utilise, en particulier à partir des données de insee.fr et d'opendata.paris.fr)&#62; bt1=read.table("paris2007-pres-t1.csv",header=TRUE,sep=";")&#62; bt2=read.table("paris2007-pres-t2.csv",header=TRUE,sep=";")&#62; bv=read.table("paris-bv-insee-07.csv",header=TRUE,sep=";")&#62; bv$BV=bv$BVCOM&#62; baset1=merge(bt1,bv,by="BV")&#62; baset2=merge(bt2,bv,by="BV")&#62; baset1$LOGEMENT=baset1$PROPRIO+baset1$LOCNONHLM+baset1$LOCHLM+baset1$GRATUIT&#62; baset2$LOGEMENT=baset2$PROPRIO+baset2$LOCNONHLM+baset2$LOCHLM+baset2$GRATUITSi on suppose que  est fonction  le taux de logements occupés par leur propriétaire, dans le quartier (associé à un bureau de vote),&#62; variable="PROPRIO"&#62; reference="LOGEMENT"&#62; baset1$taux=baset1[,variable]/baset1[,reference]&#62; baset2$taux=baset2[,variable]/baset2[,reference]il est légitime de tenter une régression logistique,voire un lissage par splines, si on pense que le lien peut ne pas être linéaire,Ceci se fait à l'aide du code suivant, pour la version lissée (par splines cubiques)&#62; b=hist(baset1$taux,plot=FALSE)&#62; library(splines)&#62; regt1=glm(PROCURATIONS/INSCRITS~bs(taux,6),family=binomial,weights=INSCRITS,data=baset1)&#62; regt2=glm(PROCURATIONS/INSCRITS~bs(taux,6),family=binomial,weights=INSCRITS,data=baset2)&#62; u=seq(min(baset1$taux)+.015,max(baset1$taux)-.015,by=.001)&#62; ND=data.frame(taux=u)&#62; ug=seq(0,max(baset1$taux)+.05,by=.001)&#62; pt1=predict(regt1,newdata=ND,se=TRUE,type="response")&#62; pt2=predict(regt2,newdata=ND,se=TRUE,type="response")&#62; library(RColorBrewer)&#62; CL=brewer.pal(6, "RdBu")&#62; plot(ug,ug*1,col="white",xlab=nom,ylab="Taux de procuration",+ ylim=c(0,.1))&#62; for(i in 1:(length(b$breaks)-1)){+ polygon(b$breaks[i+c(0,0,1,1)],c(0,b$counts[i],b$counts[i],0)+ /max(b$counts)*.05,col="light yellow",border=NA)}&#62; polygon(c(u,rev(u)),c(pt1$fit+2*pt1$se.fit,rev(pt1$fit-2*pt1$se.fit)),+ border=NA,density=30,col=CL[4])et, pour la régression logistique standard (linéaire)&#62; lines(u,pt1$fit,col=CL[6],lwd=2)&#62; polygon(c(u,rev(u)),c(pt2$fit+2*pt2$se.fit,rev(pt2$fit-2*pt2$se.fit)),+ border=NA,density=30,col=CL[3])&#62; lines(u,pt2$fit,col=CL[1],lwd=2)&#62; regt1l=glm(PROCURATIONS/INSCRITS~taux,family=binomial,weights=INSCRITS,data=baset1)&#62; regt2l=glm(PROCURATIONS/INSCRITS~taux,family=binomial,weights=INSCRITS,data=baset2)&#62; ND=data.frame(taux=ug)&#62; pt1l=predict(regt1l,newdata=ND,se=TRUE,type="response")&#62; pt2l=predict(regt2l,newdata=ND,se=TRUE,type="response")&#62; lines(ug,pt1l$fit,col=CL[5],lty=2)&#62; lines(ug,pt2l$fit,col=CL[2],lty=2)&#62; legend(0,.1,c("Second Tour","Premier Tour"),col=CL[c(1,6)],+ lwd=2,lty=1,border=NA)(en rajoutant une petite légende, avec une visualisation pour les deux tours de l'élection présidentielle, avec un intervalle de confiance sur la prévision de mon taux de procuration).On peut faire la même chose sur le taux de logement HLM, dans le quartier,Les dessins sont parlant, mais dans la sortie du modèle de régression, l’interprétation de  laisse à désirer (toute suggestion est la bienvenue !).&#62; summary(regt1l)Call:glm(formula = PROCURATIONS/INSCRITS ~ taux, family = binomial,     data = baset1, weights = INSCRITS)Deviance Residuals:      Min        1Q    Median        3Q       Max  -12.9549   -1.5722    0.0319    1.6292   13.1303  Coefficients:            Estimate Std. Error z value Pr(&#62;|z|)    (Intercept) -3.70811    0.01516  -244.6   &#60;2e-16 ***taux         1.49666    0.04012    37.3   &#60;2e-16 ***---Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1(Dispersion parameter for binomial family taken to be 1)    Null deviance: 12507  on 836  degrees of freedomResidual deviance: 11065  on 835  degrees of freedomAIC: 15699Number of Fisher Scoring iterations: 4&#62; summary(regt2l)Call:glm(formula = PROCURATIONS/INSCRITS ~ taux, family = binomial,     data = baset2, weights = INSCRITS)Deviance Residuals:      Min        1Q    Median        3Q       Max  -15.4872   -1.7817   -0.1615    1.6035   12.5596  Coefficients:            Estimate Std. Error z value Pr(&#62;|z|)    (Intercept) -3.24272    0.01230 -263.61   &#60;2e-16 ***taux         1.45816    0.03266   44.65   &#60;2e-16 ***---Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1(Dispersion parameter for binomial family taken to be 1)    Null deviance: 9424.7  on 836  degrees of freedomResidual deviance: 7362.3  on 835  degrees of freedomAIC: 12531Number of Fisher Scoring iterations: 4&#160;On a alors voulu comparer avec un modèle qui me semble moins juste, mais qui est plus simple à interpréter, où on suppose que le taux de procuration (par bureau) est expliqué par un modèle linéaire(que l'on peut aussi lisser, pour vérifier que le lien est effectivement linéaire). Le code est ici&#62; regt1=lm(PROCURATIONS/INSCRITS~bs(taux,6),weights=INSCRITS,data=baset1)&#62; regt2=lm(PROCURATIONS/INSCRITS~bs(taux,6),weights=INSCRITS,data=baset2)&#62; u=seq(min(baset1$taux)+.015,max(baset1$taux)-.015,by=.001)&#62; ND=data.frame(taux=u)&#62; ug=seq(0,max(baset1$taux)+.05,by=.001)&#62; pt1=predict(regt1,newdata=ND,se=TRUE,type="response")&#62; pt2=predict(regt2,newdata=ND,se=TRUE,type="response")&#62; library(RColorBrewer)&#62; CL=brewer.pal(6, "RdBu")&#62; plot(ug,ug*1,col="white",xlab=nom,ylab="Taux de procuration",+ ylim=c(0,.1))&#62; for(i in 1:(length(b$breaks)-1)){+ polygon(b$breaks[i+c(0,0,1,1)],c(0,b$counts[i],b$counts[i],0)+ /max(b$counts)*.05,col="light yellow",border=NA)}&#62; polygon(c(u,rev(u)),c(pt1$fit+2*pt1$se.fit,rev(pt1$fit-2*pt1$se.fit)),+ border=NA,density=30,col=CL[4])&#62; lines(u,pt1$fit,col=CL[6],lwd=2)&#62; polygon(c(u,rev(u)),c(pt2$fit+2*pt2$se.fit,rev(pt2$fit-2*pt2$se.fit)),+ border=NA,density=30,col=CL[3])&#62; lines(u,pt2$fit,col=CL[1],lwd=2)&#62; regt1l=lm(PROCURATIONS/INSCRITS~taux,weights=INSCRITS,data=baset1)&#62; regt2l=lm(PROCURATIONS/INSCRITS~taux,weights=INSCRITS,data=baset2)&#62; ND=data.frame(taux=ug)&#62; pt1l=predict(regt1l,newdata=ND,se=TRUE,type="response")&#62; pt2l=predict(regt2l,newdata=ND,se=TRUE,type="response")&#62; lines(ug,pt1l$fit,col=CL[5],lty=2)&#62; lines(ug,pt2l$fit,col=CL[2],lty=2)&#62; legend(0,.1,c("Second Tour","Premier Tour"),col=CL[c(1,6)],+ lwd=2,lty=1,border=NA)(j'ai tout mis d'un coup cette fois, les modèles lissés et linéaires, l'un à la suite de l'autre)Cette fois, on a une sortie de régression plus classique,&#62; summary(regt1l)Call:lm(formula = PROCURATIONS/INSCRITS ~ taux, data = baset1, weights = INSCRITS)Weighted Residuals:    Min      1Q  Median      3Q     Max -1.9994 -0.2926  0.0011  0.3173  3.2072 Coefficients:            Estimate Std. Error t value Pr(&#62;|t|)    (Intercept) 0.021268   0.001739   12.23   &#60;2e-16 ***taux        0.054371   0.004812   11.30   &#60;2e-16 ***---Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Residual standard error: 0.646 on 835 degrees of freedomMultiple R-squared:  0.1326,Adjusted R-squared:  0.1316 F-statistic: 127.7 on 1 and 835 DF,  p-value: &#60; 2.2e-16&#62; summary(regt2l)Call:lm(formula = PROCURATIONS/INSCRITS ~ taux, data = baset2, weights = INSCRITS)Weighted Residuals:    Min      1Q  Median      3Q     Max -2.9029 -0.4148 -0.0338  0.4029  3.4907 Coefficients:            Estimate Std. Error t value Pr(&#62;|t|)    (Intercept) 0.033909   0.001866   18.17   &#60;2e-16 ***taux        0.079749   0.005165   15.44   &#60;2e-16 ***---Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Residual standard error: 0.6934 on 835 degrees of freedomMultiple R-squared:  0.2221,Adjusted R-squared:  0.2212 F-statistic: 238.4 on 1 and 835 DF,  p-value: &#60; 2.2e-16On note plusieurs choses de ces graphiques. (i) les deux types de régression donnent des modèles pour les taux de procuration très très proches. Donc autant prendre le plus simple à interpréter. (ii) le lissage n'apporte rien, et le modèle linéaire semble pertinent. On a ainsi regardé plusieurs variables, et on en a retenu un certain nombre, pour tenter un modèle multiple. Avant de parler des résidus de notre modèle, je devrais peut être prendre quelques lignes pour parler un peu de cartographie (une nouvelle fois, Baptiste m'a fait découvrir de belles fonctions). Visualiser les bureaux de vote à ParisPour récupérer le fond de carte, avec les bureaux de vote, on utilise (là encore, je renvoie au blog de Baptiste, qui explique l'utilisation de données de cartelec.net)&#62; library(maptools)&#62; library(rgdal)&#62; library(classInt)&#62; paris=readShapeSpatial("paris-cartelec.shp")Si on veut visualiser, par exemple, le taux de procuration (disons la moyenne entre les deux tours), on utilise les données suivantes&#62; elec=data.frame()&#62; elec=cbind(bt1$BV,(bt1$PROCURATIONS+bt2$PROCURATIONS),(bt1$EXPRIMES+bt2$EXPRIMES))&#62; colnames(elec)=c("BV","PROCURATIONS","EXPRIMES")&#62; elec=as.data.frame(elec)&#62; elec$BV=bt1$BVEnsuite, viennent les fonctions graphiques, où on va passer d'un taux à une classe et d'une classe à une couleur,&#62; m=match(paris$BUREAU,elec$BV)&#62; plotvar=100*elec$PROCURATIONS/elec$EXPRIMES&#62; nclr=7&#62; plotclr=brewer.pal(nclr,"RdYlBu")[nclr:1] &#62; class=classIntervals(plotvar[m], nclr, style="fisher",dataPrecision=1)&#62; colcode=findColours(class, plotclr)Reste à conclure, en faisant une visualisation graphique de nos données&#62; par(mar=c(1,1,1,1))&#62; plot(paris,col=colcode,border=colcode)&#62; legend(656274.9, 6867308,legend=names(attr(colcode,"table")), + fill=attr(colcode, "palette"), cex=1, bty="n",+ title="Frequence procurations (%)")Histoire de conclure, on peut regarder un peu nos résidus, obtenus sur un modèle linéaire. Considérons un modèle sur seulement trois variables explicatives,&#62; regt1=lm(PROCURATIONS/INSCRITS~I(POP65P/POP)++ I(PROPRIO/LOGEMENT)+I(CS3/POP1564),weights=INSCRITS,data=baset1)Dans ce cas, la visualisation des résidus donne&#62; m=match(paris$BUREAU,elec$BV)&#62; plotvar=100*residuals(regt1)&#62; nclr=7&#62; plotclr=brewer.pal(nclr,"RdYlBu")[nclr:1] &#62; class=classIntervals(plotvar[m], nclr, style="fisher",dataPrecision=1)&#62; colcode=findColours(class, plotclr)&#62; par(mar=c(1,1,1,1))&#62; plot(paris,col=colcode,border=colcode)&#62; legend(656274.9, 6867308,legend=names(attr(colcode,"table")), + fill=attr(colcode, "palette"), cex=1, bty="n",title="Residus")Idéalement, il faudrait avoir un beau bruit (spatial), c'est à dire avoir des couleurs réparties aléatoirement sur Paris. Il reste encore pas mal de régions dont les voisins sont de la même couleurs, et on repère quelques quartiers atypiques, avec soit des résidus importants négativement, ou positivement. Comme toujours, en modélisation, on pourrait passer des heures pour essayer de capturer tous les effets, mais aucun modèle avec les variables à notre disposition nous a permis de faire réellement mieux.