Networks with R

In order to practice with network data with R, we have been playing with the Padgett (1994) Florentine’s wedding dataset (discussed in the lecture). The dataset is available from

> library ( network )
> data(flo)
> nflo plot(nflo, displaylabels = TRUE,
+ boxed.labels =
+ FALSE)

The next step was to move from the network package to igraph. Since we have the adjacency matrix, we can use it

> iflo=graph_from_adjacency_matrix(flo,
+ mode = "undirected")
> plot(iflo)

The good thing is that a lot of functions are available, for instance we can get shortest paths, between two specific nodes. And we can give appropriate colors to the nodes that we’ll cross

> AP=all_shortest_paths(iflo,
+ from="Peruzzi",
+ to="Ginori")
> L=AP$res[[1]]
> V(iflo)$color="yellow"
> V(iflo)$color[L[2:4]]="light blue"
> V(iflo)$color[L[c(1,5)]]="blue"
> plot(iflo)

We can also visualize edges, but I found it slightly more complicated (to extract edges from the output)

> liens=c(paste(as.character(L)[1:4],
+ "--",
+ as.character(L)[2:5],sep=""),
+ paste(as.character(L)[2:5],
+ "--",
+ as.character(L)[1:4],sep=""))
> df=as.data.frame(ends(iflo,E(iflo)))
> names(df)=c("src","target")
> lstn=sort(unique(c(as.character(df[,1]),as.character(df[,2]),"Pucci")))
> Eliens=paste(as.numeric(factor(df[,1],levels=lstn)),"--",
+ as.numeric(factor(df[,2],levels=lstn)),sep="")
> EU=unlist(lapply(Eliens,function(x) x%in%liens))
> E(iflo)$color=c("grey","black")[1+EU]
> plot(iflo)

But it works. It is also possible to use some D3js visualization

> library( networkD3 )
> simpleNetwork (df)

Then the next question was to add a vertice to the network. The most simple way to do it is probability through the adjacency matrix

> flo2=flo
> flo2["Pucci","Bischeri"]=1
> flo2["Bischeri","Pucci"]=1
> nflo2 plot(nflo2, displaylabels = TRUE,
+ boxed.labels =
+ FALSE)

Then, we’ve been playing with centrality measures.

> plot(iflo,vertex.size=betweenness(iflo))

The goal was to see how related they were. Here, for all of them, “Medici” is the central node. But what about the others?

> B=betweenness(iflo)
> C=closeness(iflo)
> D=degree(iflo)
> E=eigen_centrality(iflo)$vector
> base=data.frame(betw=B,close=C,deg=D,eig=E)
> cor(base)
betw close deg eig
betw 1.0000000 0.5763487 0.8333763 0.6737162
close 0.5763487 1.0000000 0.7572778 0.7989789
deg 0.8333763 0.7572778 1.0000000 0.9404647
eig 0.6737162 0.7989789 0.9404647 1.0000000

Those measures are quite correlated. It is also possible to use a hierarchical graph to visualize how close those centrality measures can be

> H=hclust(dist(t(base)),
+ method="ward")
> plot(H)

Instead of looking at values of centrality measures, it is possible to looks are ranks

> rbase=base
> for(i in 1:4) rbase[,i]=rank(base[,i])
> H=hclust(dist(t(rbase)),
+ method="ward")
> plot(H)

Here the eigenvector measure is very close to the degree of vertices.

Finally, it is possible to seek clusters (in the context of coalition here, in case a war should start between those families)

> kc <- fastgreedy.community ( iflo )

Here we have 3 classes (+1 for the node that is disconnected from the other families)

> V(iflo)$color=c("yellow","orange",
+ "light blue")[membership ( kc )]
> plot(iflo)

> plot(kc,iflo)

C’est normal ! (partie 2) et si la normalité n’existait pas?

Avec un peu de retard, je vais tenter de poursuivre le billet sur la normalité, mis en ligne en avril dernier. Mon point de départ reprenait une discussion autour de la « moyenne » comme outil central pour définir la norme, ainsi que des idées que l’on peut retrouver dans le livre de Todd Rose, The End of Averages. Pour compléter mon précédant billet, je pourrais reprendre un exemple mentionné dans ce livre, revenant sur des problèmes rencontrés par l’Armée Américaine dans les années 1950. Lors de la conception des postes de pilotage des avions de chasse, les ingénieurs avaient utilisé les dimensions de plus de 4000 pilotes pour positionner de manière optimale le siège par rapport aux pédales, le manche à balai, la hauteur du pare-brise, mais aussi la forme du siège, du casque, etc. Ces mesures ont permis de calculer les mensurations du pilote « médian » dans une dizaine de dimensions. Par exemple la taille moyenne des pilotes était de 179cm, ce qui a permis de définir la taille d’un pilote moyen entre 175 et 185cm. Si une majorité des pilotes est de taille moyenne, parmi les 4000 pilotes, aucun (parmi les 4000 !) n’était « moyen » dans toutes les dimensions. Comme l’affirmait Daniels (1952), « concevoir un poste de pilotage pour le pilote moyen revenait en fait à n’en concevoir pour aucun ». Je faisais ensuite le lien avec le concept de malédiction de la dimension. Mais je voulais revenir aujourd’hui sur le sens (plus philosophique) de la « normalité ».

De la normalité statistique à la norme, de la régularité à la règle

D’un point de vue empirique, descriptif, être dans la norme, ne signifie rien d’autre qu’être dans la moyenne, ne pas se détacher trop de cette moyenne. On aura alors tendance à définir la norme comme la fréquence de ce qui se produit le plus souvent, comme l’attitude la plus fréquemment rencontrée ou de la préférence la plus régulièrement manifestée. Mais cette normalité n’est pas la normativité, et « être dans la norme », être exemplaire, relève alors d’une dimension différente, qui se rattache cette fois non plus à une description du réel mais à une identification de ce vers quoi il doit tendre. On passe donc du registre de l’être à celui du devoir-être, du « is » au « ought » pour reprendre la terminologie de Hume (1739). Il est en effet difficile d’envisager le modèle (ou la normalité) sans glisser vers ce second sens qu’on peut trouver au concept de norme, et qui déploie quant à lui une dimension à proprement parler normative. Cette vision mène à une confusion entre normes et lois, même si toute la normativité n’est pas épuisée par les lois. Hume constate ainsi que, dans tous les systèmes de morale, les auteurs passent de constat de faits, c’est-à-dire énonciatifs de type « il y a », à des propositions qui comportent une expression normative, comme « il faut », « on doit ». Ce que Hume conteste, c’est le passage d’un type d’affirmation à un autre : pour lui, ce sont là deux types d’énoncés qui n’ont rien à voir les uns avec les autres, et qu’on ne peut donc pas enchaîner logiquement les uns avec les autres, en particulier d’une norme empirique vers une règle normative. Pour Hume, une affirmation qui ne serait pas normatives ne peut pas donner lieu à une conclusion de type normatif. Cette affirmation de Hume a suscité nombre de commentaires et d’interprétations, en particulier parce qu’énoncé telle quel, elle semble être un obstacle à toute tentative de naturalisation de la morale (comme le détaillent Mc Intyre (1959) ou Rescher (1990)). En ce sens, on trouve la distinction forte entre la norme dans la régularité (normalité) et la règle (normativité).

Les lois statistiques, du micro au macro

La loi statistique relève de ce qui est « est » parce qu’on l’a observé ainsi (par exemple « les hommes sont plus grands que les chiens »). La loi humaine (divine, ou judiciaire) relève de ce qui est « est » parce qu’on l’a décrété, et donc « doit être » (« les hommes sont libres et égaux » ou « l’homme est bon »). Enfin, la loi physique relève de ce qui « est » parce qu’on peut le montrer (« les planètes sont attirées entre eux »), souvent dans le cadre d’hypothèses. On voit que les trois concepts peuvent être liés. Par exemple la « loi de Kepler » a été établie historiquement à l’aide d’observations (et rentrait historiquement dans la première catégorie), avant d’être démontrée dans le cadre du modèle Copernicien (et de passer alors dans la troisième). On peut d’ailleurs associer un concept d’équilibre à cette loi, cette « norme ». Toutefois, comme le souligne Hilpinen (1971), les lois probabilistes posent toutefois bon nombre de questions, il suffit de penser aux lancers de dés, ou aux attentes : que signifie « il est normal d’attendre 5 minutes le bus à l’arrêt », ou plus dérangeant d’un point de vue éthique, « il est normal qu’une personne placée en détention provisoire soit emprisonnée 18 mois » ?

On peut voir la « norme » comme une régularité de cas, observée à l’aide de fréquences (ou de moyennes), par exemple, sur la taille des individus, la durée du sommeil, autrement dit des données qui constituent la description d’individus. Les données anthropométriques ont ainsi permis de définir par exemple une taille moyenne des individus dans une population donnée, en fonction de leur âge ; par rapport à cette taille moyenne, un écart de 20% en plus ou en moins détermine le gigantisme ou le nanisme. Si l’on pense aux accidents de la route, il peut être considéré comme « anormal » d’avoir un accident de la route une année donné, à un niveau individuel (micro), car la majorité des conducteurs n’ont pas d’accident. Néanmoins, du point de vue de l’assureur (macro), la norme est que 10 % des conducteurs aient un accident. Il serait donc anormal que personne n’ait d’accident. C’est l’argument que l’on retrouve dans Durkheim (1897). De l’acte singulier qu’est le suicide, s’il est considéré du point de vue de l’individu qui le commet, Durkheim tente de le voir comme un acte social, relevant alors d’une réelle régularité, au sein d’une société donnée. Dès lors, le suicide devient, selon Durkheim, un phénomène « normal ». Les statistiques permettent alors de quantifier la tendance au suicide dans une société donnée, dès lors que l’on observe non plus l’irrégularité qui apparaît dans la singularité d’une histoire individuelle, mais une « normalité sociale » du suicide.

Norme, convention et aspects éthiques

Si on prend un point de vue évolutionniste, ce qui est « normal » est ce qui est le plus capable de s’adapter, de répondre aux besoins, de fournir un modèle pour la résolution des situations (la nature faisant disparaître l’anormalité), et la normalité tend vers la normativité, et il devient difficile de faire la distinction entre les deux aspects. En fait, David Hume aborde ce point dans l’exemple bien connu des rameurs, qui montent dans le même bateau pour traverser un fleuve et qui rament en cadence (cet exemple est longuement discuté dans Mackie (1980)). Les deux rameurs ajustent peu à peu leurs coups de rame, l’un par rapport à l’autre, et il n’est pas nécessaire d’obtenir un accord explicite (qui formulerait la « norme ») qu’ils respecteraient. La loi, qui consiste à imposer une norme peut être utile en cas de conflit (si un des rameurs refuse de ramer, ou deux rameurs de capacités physiques très différentes), mais bien souvent, il n’est pas nécessaire de formuler explicitement cette norme inhérente à leur conduite. L’observateur extérieur observera une régularité (lorsque le rythme de croisière sera atteinte) qu’il pourra modéliser, mais ce rythme « normal » observé n’est pas forcément imposé par une loi. Dans le cas de rameurs, on retrouve la notion d’équilibre évoquée précédemment. Construire un modèle, c’est extraire le signal du bruit (pour reprendre la distinction de Silver (2015)), c’est chercher une norme, au sens statistique. Mais cela va plus loin s’il l’on construit un modèle prédictif, la réalité devant alors se conformer au modèle, comme l’espèrent souvent les économètres (et autre modélisateurs).

I Got The Feelin’

Last week, I’ve been going through my CD collection, trying to find records I haven’t been listing for a while. And I got the feeling that music I listen to nowadays is slower than the one I was listening to in my 20’s. I was wondering if that was an age issue, or it was simply the fact that music in the 90s was “faster” than the one released in 2015. So I tried to scrap the BPM database to get a more appropriate answer about this “feeling” I have. I did extract two information: the BPM (beat per minute) and the year (of release).

Here is a function to extract information from the website,

> library(XML)
> extractbpm = function(VBP,P){
+ url=paste("https://www.bpmdatabase.com/music/search/?artist=&title=&bpm=",VBP,"&genre=&page=",P,sep="")
+ download.file(url,destfile = "page.html")
+ tables=readHTMLTable("page.html")
+ return(tables)}

For instance

> extractbpm(115,13)
$`track-table`
Artist Title
1 Eros Ramazzotti y Claudio Guidetti Dimelo A Mi
2 Everclear Volvo Driving Soccer Mom
3 Evils Toy Dear God
4 Expose In Walked Love
5 Fabolous ft. 2 Chainz When I Feel Like It
6 Fabolous ft. 2 Chainz When I Feel Like It
7 Fabolous ft. 2 Chainz When I Feel Like It
8 Fanny Lu Fanfarron
9 Featurecast Ain't My Style
10 Fem 2 Fem Obsession
11 Fernando Villalona Mi Delito
12 Fever Ray Triangle Walks
13 Firstlove Freaky
14 Fito Blanko Pegadito Suavecito
15 Flechazo Del Norte Mariposa Traicionera
16 Fluke Switch/Twitch
17 Flyleaf Something Better
18 FM Static The Next Big Thing
19 Fonseca Eres Mi Sueno
20 Fonseca ft. Maffio & Nayer Eres Mi Sueno
21 Francesca Battistelli Have Yourself A Merry Little Christmas
22 Frankie Ballard Young & Crazy
23 Frankie J. More Than Words
24 Frank Sinatra The Hucklebuck
25 Franz Ferdinand The Dark Of The Matinée
Mix BPM Genre Label Year
1 — 115 — Sony 2009
2 — 115 — Capitol Records 2003
3 — 115 — — —
4 — 115 — Arista Records 1994
5 Explicit 115 Urban Def Jam/Island Def Jam 2013
6 — 115 Urban Def Jam/Island Def Jam 2013
7 Radio Edit 115 Urban Def Jam/Island Def Jam 2013
8 — 115 Latin Pop Universal Latino 2011
9 Psychemagik Dub 115 — Jalapeno 2012
10 — 115 — Critique Records 1993
11 — 115 — Mt&vi Records/caminante Records 2001
12 Rex The Dog Remix 115 — Little Idiot/Mute 2012
13 — 115 — Jwp Music 2000
14 — 115 Merengue Mambo Crown Loyalty 2012
15 — 115 — Hacienda 2010
16 Album Version 115 — One Little Indian Records 2004
17 — 115 Alternative A&M/Octone 2013
18 — 115 — Tooth & Nail Records 2007
19 — 115 Merengue Mambo 10 2012
20 Urban Version 115 — 10 2012
21 — 115 — Word/Fervent/Warner Bros 2009
22 — 115 Country Warner Bros 2015
23 Mynt Rocks Radio Edit 115 — Columbia 2005
24 — 115 Jazz Columbia 1950
25 — 115 New Wave — 2004

We have here one of the few old songs, a 1950 tune by Frank Sinatra. If we scrap the website, with a simple loop (where the bpm is from 40 to 200). Start with

BASE=NULL
> vbp=40
> p=1

and then, a loop based on

> while(vbp<=2017){
+ F=extractbmp(vbp,p)
+ if(length(F)==1){
+ BASE=rbind(BASE,F[[1]][,c("Artist","Title","BPM","Year")])
+ p=p+1}
+ if(length(F)==0){
+ vbp=vbp+1
+ p=1}}

Then we should clean the dataset

BASE=BASE[-duplicated(BASE),]
BASE=BASE[-which(BASE$Year=="—"),]
BASE$y=as.numeric(as.character(BASE$Year))
BASE$bpm=as.numeric(as.character(BASE$BPM))
BASE=BASE[BASE$y>=1940,]

and we end up with almost 50,000 tunes.

boxplot(BASE$bpm~as.factor(BASE$y),
col="light blue")

Over the past 20 years, it looks like speed of tunes has declined (let us forget tunes of 2017, clearly we have a problem here…)

library(mgcv)
plot(BASE$y,BASE$bpm)
reg=gam(bpm~s(y),data=BASE)
B=data.frame(y=1950:2017)
p=predict(reg,newdata=B)
lines(B$y,p,lwd=3,col="red")

which is confirmed with a (smoothed) regression

p2=predict(reg,newdata=B,se.fit=TRUE)
plot(B$y,p2$fit,lwd=3,col="red",type="l",ylim=c(90,140))
lines(B$y,p2$fit+p2$se.fit)
lines(B$y,p2$fit-p2$se.fit)

even when incorporating the confidence band. Bumps are probably related to smoothing parameters, but indeed, it looks like the average speed of music tune has decreased, from 110-115 in the 90’s to less than 100 nowadays. Now to be honest, I would love to have access to personal information from itunes, deezer or spotify, to get a better understanding (eg when in the week, in the day, do we like to listen to faster music for instance). But so far, I could not have access to such data. Too bad…

In the Alps, for a break

Last week, I was in France, after almost a month in Canada and in the U.S. Unfortunately, the university was closed… yes, closed, no way to get in. So I had to work from home, to finish (and submit) some papers, write some codes to get simulations to work on when I’ll get back… But now, it’s time for a 10 day break, in the Alps…

I will then get back to work a little bit (yes, even if the university is still closed in the beginning of August – French style), and then, there will be another week off…

 

 

Matching, Optimal Transport and Statistical Tests

To explain the “optimal transport” problem, we usually start with Gaspard Monge’s “Mémoire sur la théorie des déblais et des remblais“, where the the problem of transporting a given distribution of matter (a pile of sand for instance) into another (an excavation for instance). This problem is usually formulated using distributions, and we seek the “optimal” transport from one distribution to the other one. The formulation, in the context of distributions has been formulated in the 40’s by Leonid Kantorovich, e.g. from the distribution on the left to the distribution on the right.

Consider now the context of finite sets of points. We want to transport mass from points https://latex.codecogs.com/gif.latex?%5C%7BA_1%2C%5Ccdots%2CA_4%5C%7D to points https://latex.codecogs.com/gif.latex?\{B_1,\cdots,B_4\}. It is a complicated combinatorial problem. For 4 points, there are only 24 possible transfer to consider, but it exceeds 20 billions with 15 points (on each side). For instance, the following one is usually seen as inefficient

while the following is usually seen as much better

Of course, it depends on the cost of the transport, which depends on the distance between the origin and the destination. That cost is usually either linear or quadratic.

There are many application of optimal transport in economics, see eg Alfred’s book Optimal Transport Methods in Economics. And there are also applications in statistics, that what I’ve seen while I was discussing with Pierre while I was in Boston, in June. For instance if we want to test whether some sample were drawn from the same distribution,

set.seed(13)
npoints <- 25
mu1 <- c(1,1)
mu2 <- c(0,2)
Sigma1 <- diag(1, 2, 2)
Sigma2 <- diag(1, 2, 2)
Sigma2[2,1] <- Sigma2[1,2] <- -0.5
Sigma1 <- 0.4 * Sigma1
Sigma2 <- 0.4 *Sigma2
library(mnormt)
X1 <- rmnorm(npoints, mean = mu1, Sigma1)
X2 <- rmnorm(npoints, mean = mu2, Sigma2)
plot(X1[,1], X1[,2], ,col="blue")
points(X2[,1], X2[,2], col = "red")

Here we use a parametric model to generate our sample (as always), and we might think of a parametric test (testing whether mean and variance parameters of the two distributions are equal).

or we might prefer a nonparametric test. The idea Pierre mentioned was based on optimal transport. Consider some quadratic loss

ground_p <- 2
p <- 1
w1 <- rep(1/npoints, npoints)
w2 <- rep(1/npoints, npoints)
C <- cost_matrix_Lp(t(X1), t(X2), ground_p)
library(transport)
library(winference)
a <- transport(w1, w2, costm = C^p, method = "shortsimplex")

then it is possible to match points in the two samples

nonzero <- which(a$mass != 0)
from_indices <- a$from[nonzero]
to_indices <- a$to[nonzero]
for (i in from_indices){
segments(X1[from_indices[i],1], X1[from_indices[i],2], X2[to_indices[i], 1], X2[to_indices[i],2])
}

Here we can observe two things. The total cost can be seen as rather large

> cost=function(a,X1,X2){
nonzero <- which(a$mass != 0)
naa=a[nonzero,]
d=function(i) (X1[naa$from[i],1]-X2[naa$to[i],1])^2+(X1[naa$from[i],2]-X2[naa$to[i],2])^2
sum(Vectorize(d)(1:npoints))
}
> cost(a,X1,X2)
[1] 9.372472

and the angle of the transport direction is alway in the same direction (more or less)

> angle=function(a,X1,X2){
nonzero <- which(a$mass != 0)
naa=a[nonzero,]
d=function(i) (X1[naa$from[i],2]-X2[naa$to[i],2])/(X1[naa$from[i],1]-X2[naa$to[i],1])
atan(Vectorize(d)(1:npoints))
}
> mean(angle(a,X1,X2))
[1] -0.3266797

> library(plotrix)
> ag=(angle(a,X1,X2)/pi)*180
> ag[ag<0]=ag[ag<0]+360
> dag=hist(ag,breaks=seq(0,361,by=1)-.5)
> polar.plot(dag$counts,seq(0,360,by=1),main=”Test Polar Plot”,lwd=3,line.col=4)

(actually, the following plot has been obtain by generating a thousand of sample of size 25)

In order to have a decent test, we need to see what happens under the null assumption (when drawing samples from the same distribution), see

Here is the optimal matching

Here is the distribution of the total cost, when drawing a thousand samples,

VC=rep(NA,1000)
VA=rep(NA,1000*npoints)
for(s in 1:1000){
X1a <- rmnorm(npoints, mean = mu1, Sigma1)
X1b <- rmnorm(npoints, mean = mu1, Sigma2)
ground_p <- 2
p <- 1
w1 <- rep(1/npoints, npoints)
w2 <- rep(1/npoints, npoints)
C <- cost_matrix_Lp(t(X1a), t(X1b), ground_p)
ab <- transport(w1, w2, costm = C^p, method = "shortsimplex")
VC[s]=cout(ab,X1a,X1b)
VA[s*npoints-(0:(npoints-1))]=angle(ab,X1a,X1b)
}
plot(density(VC)

So our cost of 9 obtained initially was not that high. Observe that when drawing from the same distribution, there is now no pattern in the optimal transport

ag=(VA/pi)*180
ag[ag<0]=ag[ag<0]+360
dag=hist(ag,breaks=seq(0,361,by=1)-.5)
polar.plot(dag$counts,seq(0,360,by=1),main="Test Polar Plot",lwd=3,line.col=4)

 

Nice isn’t it? I guess I will spend some time next year working on those transport algorithm, since we have great R packages, and hundreds of applications in economics…

De la symbolique des grandeurs statistiques

Ce matin, je suis suis un peu emporté sur Twitter, alors que d’ordinaire je préfère éviter…

Il faut dire que j’étais tombé sur un article dans les Echos qui m’a énervé…

J’ai ensuite passé beaucoup de temps à essayer de comprendre pourquoi j’avais été autant énervé par ce titre, cet article… car il n’apprenait rien de bien nouveau… Je pense que c’est vraiment la forme qui m’a agacé, et la symbolique du” temps” y joue (je pense) pour beaucoup. Pourtant, utiliser l’année calendaire comme métaphore pour expliquer des statistiques n’est pas nouveau.

Je pense que la première fois que je ai vu cette idée, je devais avoir dix ans, quand on nous parlait de l’histoire de l’univers, de la terre et l’humanité. Parce que mine de rien, manipuler des grands chiffres n’aide pas à avoir une représentation (ce qui est le cas quand on parle du budget de l’Etat). Oui, le big-bang a eu lieu il y a un peu moins de 15 milliards d’années, Lucy date d’environ 3,2 millions d’années, et le Christ est né il y a 2000 ans. Mais jongler entre les milliers, les millions et les milions est compliqué. Alors dans les cours d’histoire, on utilise une image basée sur le calendrier. Le Big Bang a eu lieu le 1er janvier à zéro heure et nous sommes aujourd’hui le 31 décembre à minuit, autrement dit chaque seconde équivaut à un peu plus de 400 années. Début septembre la terre se forme, les poissons et les premières plantes terrestres arrivent juste avant l’hiver, vers le 20 décembre. Lucy se met debout à 22h30, les Pyramides d’Égypte datent de minuit moins dix secondes, et le Christ naît à minuit moins cinq secondes. Voilà en gros pour l’image. En 90 minutes (sur une année) on a l’histoire de l’humanité, et en 10 secondes, l’histoire telle qu’on l’apprend à l’école. Mais dans cette image, on transforme du temps en un autre temps. Un peu comme dans la métaphone du système solaire, où notre soleil aurait le diamètre d’un ballon de Basket-Ball, la Terre serait à 27 mètres et aurait la taille d’une toute petite bille, de 2.3 millimètres de diamètre), on utilise des distances (et des volumes, qui proposer de représenter des distances par d’autres distances, bien plus petites.

Ici, l’exercice est, je pense, différent: on utilise le temps pour avoir une représentation d’une grandeur monétaire. Certes, un vieil adage prétend que le temps c’est de l’argent, mais je pense que la symbolique est vraiment forte ici. Si les décodeurs du Monde revenaient sur le calcul de cette grandeur (la “date de libération fiscale”) en le questionnant, personnellement c’est la symbolique attachée qui me fait m’interroger.

Les statistiques cachées derrière cette date du 29 juillet comme “date de libération fiscale”, ce sont

  • la dépense publique (ratio entre dépense publique et richesse créée) qui est de l’ordre de 57% en France (mais on ne voit pas vraiement le lien avec la fiscalité ici)
  • le “taux de taxation réel du salarié moyen” utilisé par certains, qui est aussi de l’ordre de 57% en France

Et 57% d’une année, c’est (en gros) entre le 1er janvier et fin juillet, d’où la date mentionnée dans l’article. Symboliquement, que lit-on, avec cette seconde statistique ? Qu’entre le 1er janvier et le 29 juillet on travaille “pour l’état”, pour payer ses impôts, et qu’ensuite, on peut (enfin) travailler “pour soi”. Au début, on travaille pour “les autres” par opposition à la fin où on travaille pour “soi”. Avec cette représentation calendaire, on se dit qu’on perd son temps, probablement. Mais à y regarder de plus près, est-ce que je travaille vraiment pour moi ensuite ? Personnellement, je pense que je passe aussi quelques jours à travailler pour ma banque, pour payer les intérêts du crédit que je rembourse tous les mois pour avoir acheté mon logement il y a quelques temps. Parce que mine de rien, des charges, il y en a beaucoup, il n’y a pas que l’Etat. Pour avoir cotisé pour ma retraite lorsque je travaillais au Canada, puis pour une assurance maladie, j’ai bien vu qu’à l’époque, je travaillais peut-être moins pour payer ces “charges fiscales”, mais je devais travailler plusieurs jours par an (voire semaines) pour payer l’assurance maladie qui couvrait la famille. Bref, le “pour moi” me dérange. Et que dire du “pour les autres” ? La base de la fiscalité, c’est la redistribution, non ? C’est la solidarité… Je ne paye pas des impôts pour les autres, mais “pour nous”, non ?

Bref, cette séparation binaire du temps me paraît fallacieuse et dangereuse car au lieu d’éclairer, elle n’a qu’une visée idéologique…. et c’est dommage.

Les votes à l’assemblée nationale

Un dernier petit billet basé sur les projets de R que j’avais donnés pour la formation Data Science pour l’Actuariat. Aujourd’hui, je reviens sur des codes tirés du projet de Raphaël qui a scrapé les données de l’Assemblée Nationale. On commence par charger les librairies qui nous seront utiles,

require(xml2)
require(downloader)
require(stringr)
require(classInt)
require(plotrix)
require(FactoMineR)
require(sp)

La première partie de l’importation des données vise à importer l’ensemble des députés, c’est à dire l’ensemble des personnes  (compris entre 1 et 248) dont le mandat est à l’ASSEMBLEE. Pour chacun de ces députés, on récupére le numéro de circonscription et de département, afin de pouvoir construire le code IDEN, identifiant unique de chaque circonscription (DDCC, deux chiffres pour le département, deux pour la circonscription), la référence acteur (acteurRef) et la référence mandat (uid) afin de pouvoir construire un identifiant pour chaque député du type (PA???XXXPMXXXXXX, chaque X representant un chiffre, les ? representant un chiffre ou l’absence de caractères – les PA n’ont pas tous le même nombre de caractères). On va ensuite créer des variables qui serviront par la suite : le nombre de vote total, le nombre de vote POUR, CONTRE, ABSTENTION et le nom de l’organe (groupe auquel appartient le deputé à l’assemblée).

path="http://data.assemblee-nationale.fr/static/openData/repository/AMO/deputes_senateurs_ministres_legislature/AMO20_dep_sen_min_tous_mandats_et_organes_XIV.csv.zip"
dest="deputes.zip"
download(path,destfile=dest,mode="wb")
loc=paste(getwd(),"/",dest,sep="" )
unzip(loc)
dest="acteurs.csv"
loc=paste(getwd(),"/",dest,sep="" )
t2=read.csv(loc,sep=";")
res=NULL
for (i in 1:248){
test=str_c("mandats.1..mandat.",i,"..typeOrgane.1.")
j=which(colnames(t2) == test)
#Je ne récupère que les personnes dont le i ème mandat est un mandat de député i.e siegeant à l'Assemblée Nationale
t3=subset(t2,t2[,j]=="ASSEMBLEE")
if(nrow(t3)!=0){
#Nom des différentes variables en concatenant les chaines
circo=str_c("mandats.1..mandat.",i,"..election.1..lieu.1..numCirco.1.")
dept=str_c("mandats.1..mandat.",i,"..election.1..lieu.1..numDepartement.1.")
acteur=str_c("mandats.1..mandat.",i,"..acteurRef.1.")
mandat=str_c("mandats.1..mandat.",i,"..uid.1.")
# Récupération du numero de la colonne du data frame dont le nom correspond a chacune des variable voulues
k=which(colnames(t3) == circo)
l=which(colnames(t3) == dept)
m=which(colnames(t3) == acteur)
n=which(colnames(t3) == mandat)
#Je cree un data frame correspondant "au numero de mandat"
t4=data.frame(as.numeric(as.character(t3[,k])),as.numeric(as.character(t3[,l])),str_c(t3[,m],t3[,n]))
colnames(t4)=c("circo","dept","identifiant")
#Et j'ajoute l'ensemble des députés
res=rbind(res,t4)
}
}
res$iden=str_c(res$dept,res$circo)
res$nbVote=0
res$oui=0
res$non=0
res$abst=0
res$nomOrgane=0

Ensuite, pour récupérer les votes de chacun des députés à chaque scrutin, on récupére le fichier XML du site data.assemblee-nationale.fr.

path="http://data.assemblee-nationale.fr/static/openData/repository/LOI/scrutins/Scrutins_XIV.xml.zip"
dest="Scrutins_XIV.xml.zip"
download(path,destfile=dest,mode="wb")
loc=paste(getwd(),"/",dest,sep="" )
unzip(loc)
dest="Scrutins_XIV.xml"
loc=paste(getwd(),"/",dest,sep="" )

En parcourant la hiérarchie du fichier XML (à l’aide de la fonction xml_children) on obtient les différents fils d’un noeud.

t=read_xml(loc)
liste=xml_children(t)

Le premier niveau de noeud correspond à l’ensemble des scrutins. En bouclant sur chacun d’eux, on récupéree dans les fils le résultat du vote de chaque scrutin pour chaque député. On va se limiter aux scrutins dont le mode de publication scrutin (14ème fils) est “Decompte nominatif” : en effet, pour les scrutins par “Decompte Dissident”, il n’y avait que les votes des députés qui n’avaient pas voté dans le sens la majorité, ce qui introduirait un biais ensuite.

Le 16ème fils correspond à la variable ventilation du vote. Ce noeud recense toutes les données concernant le résultat du vote.
Pour chacun des groupes représentés à l’Assemblée présent dans le fils ventilation vote, on récupère le vote de chaque député du groupe dont les modalités sont : “Non Votant”, “Pour”, “Contre” et “Abstention”.
En bouclant sur l’ensemble des scrutins on comptabilise également le nombre de vote réalisé pour chaque député et le nom de son groupe (organeRef).

for (a in liste){
if(xml_text(xml_children(a)[14])=="DecompteNominatif"){
numero=xml_text(xml_children(a)[2])
ventil=xml_children(a)[16]
groupe=xml_children(xml_children(xml_children(ventil)))
tempDataFrame=data.frame(res$identifiant,NA)
colnames(tempDataFrame)=c("identifiant",str_c("scrutin",numero))
for (b in groupe){
intermediaire=xml_children(xml_children(b))
nomGroupe=xml_text(xml_children(b)[1])
for (i in 1:4){
df3=data.frame(xml_text(xml_children(xml_children(intermediaire[3])[i])))
if(nrow(df3)!=0){
for (j in df3[,]){
if (i==1){
j=strsplit(strsplit(strsplit(j,"MG")[[1]],"PSE")[[1]],"PAN")[[1]]
}
res[res$identifiant==j,]$nomOrgane=as.character(nomGroupe)
if(i!=1)
res[res$identifiant==j,]$nbVote=res[res$identifiant==j,]$nbVote+1
if (i==1)
tempDataFrame[tempDataFrame$identifiant==j,2]="NV"
if (i==2){
res[res$identifiant==j,]$oui=res[res$identifiant==j,]$oui+1
tempDataFrame[tempDataFrame$identifiant==j,2]="POUR"
}
if (i==3){
res[res$identifiant==j,]$non=res[res$identifiant==j,]$non+1
tempDataFrame[tempDataFrame$identifiant==j,2]="CTRE"
}
if (i==4){
res[res$identifiant==j,]$abst=res[res$identifiant==j,]$abst+1
tempDataFrame[tempDataFrame$identifiant==j,2]="ABST"
}}}}}
res=data.frame(res, tempDataFrame[,2])
}}
res2=subset(res,res$dept<96)
res2$circo=ifelse(nchar(res2$circo)==1, str_c("0",res2$circo) , str_c("",res2$circo))
res2$dept=ifelse(nchar(res2$dept)==1, str_c("0",res2$dept) , str_c("",res2$dept))
res2$iden=str_c(res2$dept,res2$circo)
res2=subset(res2,!is.na(iden))
res2=res2[order(res2$iden),]
parIden=aggregate(res2$nbVote, by=list(res2$iden), sum)

Par soucis de visualisation, on va se limiter ici à la France métropolitaine. Il a fallu uniformiser le code IDEN de chaque département pour qu’il corresponde au format utilisé par la carte de France utilisé (DDCC, deux chiffres pour le département, deux pour la circonscription). Le fond de carte est le suivant

path="http://www.laspic.eu/data/documents/circosshp_v3.zip"
dest="circosshp_v3.zip"
download(path,destfile=dest,mode="wb")
loc=paste(getwd(),"/",dest,sep="" )
unzip(loc)
dest="circosSHP_v3.RData"
loc=paste(getwd(),"/",dest,sep="" )
load(loc)

On agrége enfin par par député afin d’obtenir un nombre de vote par circonscription. Notons que dans certaines circonscriptions, le député démissionait ou mourrait et était donc remplacé par un autre député. J’ai donc choisi de sommer le vote de l’ensemble des députés ayant représenté une circonscription pour le représenter graphiquement : on raisonne par circonscription, et par par représentant.

nuancier <- findColours(classIntervals(parIden$x, 6, style = "quantile"), smoothColors("white",98,"#0C3269"))
plot(fdc, col=nuancier)
leg <- findColours(classIntervals( round(parIden$x), 6, style="quantile"), smoothColors("white",98,"#0C3269"), under="moins de", over="plus de", between="–",cutlabels=FALSE)
legend("bottomleft",fill=attr(leg, "palette"), legend=names(attr(leg,"table")),title = "Nombre de Votes",bty="n")
title( main="Nombre de votes par circonscription",cex.main=1.5)

parIdenScrutin=aggregate(res2[,9:ncol(res2)], by=list(res2$iden),na.omit)
for (i in 1:nrow(parIdenScrutin))
parIdenScrutin$nomOrgane[i]=ifelse(parIdenScrutin$nomOrgane[i][[1]][1]!="0",as.character(parIdenScrutin$nomOrgane[i][[1]][1]),as.character(parIdenScrutin$nomOrgane[i][[1]][2]))
for (i in 3:ncol(parIdenScrutin))
parIdenScrutin[,i]=as.factor(levels(parIdenScrutin[,i][[1]])[as.numeric(parIdenScrutin[,i])])
parIdenScrutin=replace(parIdenScrutin,is.na(parIdenScrutin),"NV")
for (i in 1:nrow(parIdenScrutin)) {
if (parIdenScrutin$nomOrgane[i]=="PO656014" || parIdenScrutin$nomOrgane[i]=="PO713077" || parIdenScrutin$nomOrgane[i]=="PO656002")
parIdenScrutin$nomOrgane[i] <- "SER"
if (parIdenScrutin$nomOrgane[i] == "PO656006" || parIdenScrutin$nomOrgane[i] =="PO707869")
parIdenScrutin$nomOrgane[i] <- "LR"
if (parIdenScrutin$nomOrgane[i] == "PO656022")
parIdenScrutin$nomOrgane[i] <- "RRDP"
if (parIdenScrutin$nomOrgane[i] == "PO656010")
parIdenScrutin$nomOrgane[i] <- "UDI"
if (parIdenScrutin$nomOrgane[i] == "PO656018")
parIdenScrutin$nomOrgane[i] <- "GDR"
if (parIdenScrutin$nomOrgane[i] == "PO645633")
parIdenScrutin$nomOrgane[i] <- "NI"
}
parIdenScrutin$Group.1 <- as.factor(parIdenScrutin$Group.1)
parIdenScrutin$nomOrgane <- as.factor(as.character(parIdenScrutin$nomOrgane))

On peut finir par une petite analyse des correspondances : les députés ont voté a 644 scrutins (en colonne). Pour chaque scrutin, un député peut avoir voté pour (POUR), contre (CTRE), s’être abstenu (ABST) ou ne pas s’être présenté. Si on ne garde que les deux premiers axes pricinpaux, on obtient

acm <- MCA(parIdenScrutin, quali.sup=2, graph=FALSE)
head(acm$eig,5)
plot(acm$ind$coord[, 1:2], type= "n", xlab=paste0("Axe 1 (" , round(acm$eig[1,2], 1), " %)"), ylab=paste0("Axe 2 (", round(acm$eig[2,2], 1), " %) "), main= "Nuage des individus selon les partis", cex.main=1, cex.axis=1, cex.lab=1, font.lab=3)
abline(h=0, v=0, col= "grey", lty=3, lwd=1)
points(acm$ind$coord[,1:2], col=as.numeric(parIdenScrutin$nomOrgane), pch=19, cex=0.5)
legend("topleft", legend=levels(parIdenScrutin$nomOrgane), bty= "o", text.col=1:10, col=1:10, pch=18, cex=0.8)
text(acm$ind$coord[,1:2], labels=rownames(acm$ind$coord), col=as.numeric(parIdenScrutin$nomOrgane), cex=0.7, pos=4)

On a ici le nuage des individus. Ces derniers sont placés en fonction de leur tendance de votes. Les individus les plus proches sont ceux qui votent sensiblement de la même façon tandis que les individus éloignés votent différemment à chaque scrutin. Les couleurs représente le parti auquel appartient le député. Elles sont présentent à titre indicatif pour valider ou non l’hypothèse de “vote en groupes“. Sur ce graphique, parmi les groupes représentés, deux sont très nets à gauche et à droite. Un 3ème se remarque dans la partie centre haute du graphique et enfin un 4e groupe dans la supérieure droite du graphique.

Si on se limite aux couleurs (les partis), les deux groupes très nets qui s’opposent sont Les Républicains (LR – Droite, à gauche sur la projection) et le groupe Socialiste, Ecologiste et Républicain (SER – Gauche, à droite sur la projection). Le 3ème groupe qui se distingue représente le groupe d’extrème Gauche GDR (Gauche démocrate et républicaine). Ces trois groupes sont disctinct car ils votent de façon opposé. Ensuite en regardant toujours les partis, on remarque que l’Union des Démocrates et Indépendants (UDI – Droite) ont des votes proches de ceux du groupe LR. Le groupe Radical, Républicain, démocrate et progressiste ont une façon de voter similaire à SER. Les votes des députés non inscrits varient énormément entre les scrutins, ils ne se rapporchent d’aucun parti.

Accidents de voiture et de deux roues à Paris

Il y a quelques mois, j’avais commencé à reprendre des codes que j’avais vu passer dans les projets de R que j’avais donnés pour la formation Data Science pour l’Actuariat. J’avais commencé avec un billet sur sur cartographier le vote pour le Brexit (qui avait été repris – et amélioré – sur le site des voisins de rgeomatic). Aujourd’hui, en rangeant un peu mon ordinateur, je suis tombé sur un code de Quentin sur les acccidents de la route à Paris.

Comme toujours on charge quelques packages

require(downloader)
require(ggmap)
require(stringr)
options(encoding = "UTF-8")

et on récupère les données, en ligne sur https://opendata.paris.fr

path="https://opendata.paris.fr/explore/dataset/accidentologie/download/?format=csv&timezone=Europe/Berlin&use_labels_for_header=true"
dest="test"
download(path,destfile=dest,mode="wb")
loc=paste(getwd(),"/",dest,sep="" )
obj <- read.csv(file = loc, stringsAsFactor = FALSE,sep=";")
file.remove(dest)

On peut commencer par regarder quand on eu lieu les accidents, quelle jour et à quelle heure. On va alors agréger les données

t=data.frame(obj,counter=1)
parJour=aggregate(t$counter, by=list(format(as.Date(t$Date),"%A")), sum)

et créer une base qui contient toutes les informations

vec_dat=data.frame();
vec_dat[ (1:3),1]=parJour$Group.1[3:5]
vec_dat[ (1:3),2]=parJour$x[3:5]
vec_dat[ 4,1]=parJour$Group.1[2]
vec_dat[ 4,2]=parJour$x[2]
vec_dat[ 5,1]=parJour$Group.1[7]
vec_dat[ 5,2]=parJour$x[7]
vec_dat[ 6,1]=parJour$Group.1[6]
vec_dat[ 6,2]=parJour$x[6]
vec_dat[ 7,1]=parJour$Group.1[1]
vec_dat[ 7,2]=parJour$x[1]

on va rajouter un nom, pour que ce soit plus clair

names(vec_dat)[1]="Jour";names(vec_dat)[2]="Nbsinistre"

On choisit éventuellement une palette de couleurs

Palette<-colorRampPalette(c("lightblue","darkblue"))

et on fait un barplot, pour compter le nombre d’accidents, par jour de la semaine, sur Paris

barplot(vec_dat$Nbsinistre,names.arg=vec_dat$Jour,main="Répartition du nombre d'accidents par jour de la semaine ", col=Palette(10), xlab="jour de la semaine", ylab="nombre d'accidents")

On peut ensuite regarder par heure de la journée (en données brutes, sans lissage)

parHeure=aggregate(t$counter, by=list(format(strptime(t$Heure,format="%H:%M"),"%H")), sum)
plot(parHeure,type="l", col=c("blue"), main=" Répartition du nombre d'accidents par heure de la journée", xlab="heure de la journee", ylab="nombre d'accidents")

Passons maintenant à de la géolocalisation

t2 = subset(t, Coordonnées!= "")
coord=data.frame(t(matrix(as.numeric(unlist(strsplit(t2$Coordonnées,"[,]"))),nrow=2)))
t2$lat=coord[,1]
t2$lon=coord[,2]
t2 = subset(t2, (
(48.81 <= lat) & (lat<=48.90) & (2.25<=lon) &(lon<=2.43) ) )

On peut regarder sur une carte où ont eu lieu les accidents

map<-get_map(location = "Paris", zoom=12, maptype="roadmap", color="bw")
vis <- ggmap(map) + geom_point(data = t2, aes(x=lon, y=lat, color=1)) + theme( legend.position="none") + labs(title="Cartographie des accidents à Paris")
vis

On peut tenter une densité (brute, non corrigée d’une densité de routes, ou de population)

overlay<-stat_density2d(data=t2, aes(x=lon, y=lat, fill=..level.., alpha=..level..), contour=T, n=100, geom="polygon")
densi<- ggmap(map) + overlay + scale_fill_gradient("Accident Density") +scale_alpha(range=c(0.4,0.75),guide=FALSE) + guides(fill=guide_colorbar(barwidth=1.5, barheight = 10))
densi = densi + labs(title="Densite des accidents à Paris")
densi

et non-corrigée ici d’effets de bords (ce qui donne l’illusion qu’il y a plus d’accidents intra-muros que sur le boulevard périphérique par exemple). On peut également regarder en fonction de variables explicatives, comme le type de véhicules impliqués, ou la gravité

densi_byGravUs<- densi + facet_wrap(~ Usager.1.Grav, nrow=2)
densi_byGravUs = densi_byGravUs + labs(title="Densité des accidents à Paris par gravité d'accident")
densi_byGravUs

Bref, on peut faire facilement plein de chose à partir de ces données.

Les marchés prédictifs comme technique de prévision

Les dernières élections présidentielles ont remis en avant l’importance des soudages, utilisés comme outils de prévision, même si les sondeurs s’en défendent. Comme l’ont dit Niels Bohr et Pierre Dac, « la prévision est difficile surtout lorsqu’elle concerne l’avenir », et des solutions alternatives ont été envisagées. Comme c’est la mode, le « big data » a été mentionné (deviner les intentions de vote à partir des tweets ou des informations publiées sur une page Facebook), mais les marchés prédictifs (et les sites de paris) ont aussi été largement utilisés. Mais est-il si simple d’utiliser les prix (ou les cotes) sur ces marchés prédictifs pour en déduire des probabilités ? Et peut-on vraiment les utiliser ?

Sur quoi parie-t-on ?

Comme le rappelle Rhode & Strumpf (2008) utiliser les paris pour connaître les croyances et donc les probabilités qu’un évènement se réalise n’est pas nouveau. Par exemple lors des élections papales au Vatican. En 1549, Matteo Dandolo (ambassadeur de Vénitie) notait (raconté dans Baumgartner (2003)) que « it is therefore more than clear that the merchants are very well informed about the state of the poll, and that the Cardinals’ attendants in Conclave (i conclavisti) go partners with them in the wagers, which thus causes many tens of thousands of crowns to change hands ». Et les marchés de paris lors des élections ont été populaires aux Etats-Unis, jusqu’à la seconde guerre mondiale. Rhode & Strumpf (2008) avance plusieurs raisons pour la perte d’intérêt au cours de la seconde moitié du XXème siècle : les améliorations des techniques de sondages et la légalisation des paris sur chevaux (avec pour conséquence la disparition du marché illégal des paris).

Plus récemment, avec le développement des sites et donc d’un marché des paris, on a vu apparaître des paris (contrats vendus sur le marché en ligne intrade.com, liquidé en 2015) sur la survenance de tremblement de terre de magnitude dévastatrice (plus de 9 sur l’échelle de Richter), le vainqueur de la cérémonie des Oscars, la diminution de la couverture de la glace en Arctique entre deux années, ou encore l’observation du boson de Higgs. Polgreen et al. (2007) évoquent des paris sur la survenance d’épidémies de grippe. Un autre exemple – que l’on va détailler un peu – est celui du passage d’une loi sur l’énergie (et l’instauration de mesures contraignantes de limitation des émissions de gaz à effet de serre) aux Etats-Unis. Le titre permettant de toucher 1USD en cas d’adoption du projet de loi a été lancé en mai 2009. Le 26 juin 2009, la Chambre des Représentants a adopté (à une courte majorité) le projet de loi (avec pour objectif de réduire de 17 % d’ici à 2020 par rapport à 2005 et de 80 % d’ici à 2050 les émissions de CO2). A ce moment, le titre était échangé pour 50¢, comme le montre le Graphique 1. Il restait à faire approuver la loi par le Sénat. Six mois plus tard, en signant l’accord de la conférence de Copenhague en décembre 2009, les Etats-Unis s’étaient davantage engagés, et un an plus tard (début 2011), le Sénat serait renouvelé lors des élections de mi-mandat. Le gouvernement de Barack Obama espérait faire approuver la session “lame duck” du congrès, les élections de mi-mandat devant probablement renforcer la majorité Républicaine. Mais le jeudi 22 juillet, le chef de file Démocrate au Sénat Harry Reid a annoncé le retrait du projet de loi, faute de majorité pour l’approuver. Ce jour-là, le titre s’échangeait pour 10¢.

Figure 1 : Evolution du prix du passage du contrat sur le passage du ‘American Clean Energy and Security Act’ devant le Sénat (2009-2010)

Source : auteur, données Meng (2017)

Voir un prix comme une probabilité

Avant toutes choses, rappelons qu’une propriété fondamentale des probabilités est la somme des probabilités d’un évènement et de son complémentaire doivent sommer à un. C’est assez logique si les probabilités sont vues comme des « fréquences », correspondant au nombre de cas favorables sur le nombre de cas possibles. Cette interprétation devient plus délicate quand on imagine le cas de variables aléatoires continues, et un passage par la théorie de la mesure s’impose (en particulier pour admettre qu’un « évènement de probabilité nulle » puisse malgré tout survenir). Mais historiquement, d’autres définitions des probabilités avaient été proposées, en particulier par Jacques Bernoulli, qui avait introduit une notion de « probabilité morale » (comme le rappelle Johnson (2017)) que l’on verra réapparaître dans les travaux de de Finetti sous le nom de « probabilité subjective », ou à la même époque, dans les travaux de Frank Ramsey. Pour ce dernier, une probabilité mesure un degré de croyance – « a degree of belief », qui pouvait se mesurer au travers de paris – « through betting odds » – et les prix que les joueurs sont disposés à payer donnent une information quant à ces croyances. Il devient alors possible de déduire des probabilités à partir de prix.

L’idée n’était pas nouvelle, puisqu’elle avait été émise par dans Van Rekeningh in Spelen van Gelucken publié par Christiaan Huyghens en 1655 (en latin sous le titre ‘De Ratiociniis in Aleæ Ludo‘), et utilisée quelques années plus tard, en 1671 par Wilhelmina de Witt dans le contexte d’annuités. Le prix d’un contrat versant une rente jusqu’au décès pouvant être vu à comme une moyenne pondérée d’annuités (à maturité fixe), en observant les prix des différents contrats d’assurance, on pouvait extraire des probabilités interprétées comme des probabilités de survie. Ces mesures de probabilités n’étaient plus construites à partir de fréquences observées, mais construites à partir de prix historiques observés. On retrouvera cette idée en mathématique financière presque trois siècles plus tard, avec le théorème fondamental de valorisation, et les prix d’Arrow-Debreu. Cette littérature est riche et abondante (on peut renvoyer à Charpentier (2014)), mais il existe également des résultats moins connus, sur la création d’un consensus à partir de probabilités, et les applications pour les paris.

Travaillant sur le marché de pari hippique, Eisenberg & Gale (1959) ont obtenu des résultats relativement généraux, qui peuvent se formaliser ainsi : considérons un individu  qui a la possibilité de parier sur un cheval  lors d’une course. Chaque joueur possède une somme totale  (que l’on normalise de telle sorte que  ), et qu’il place la somme  sur le cheval . Ces montants vérifient la contrainte   , et on note  la somme total placée sur le cheval , de telle sorte que . Compte tenu de la contrainte de budget, notons que , de telle sorte que les montants  peuvent être interprétés comme des probabilités. Supposons maintenant que chaque joueur ait des croyances  (que chaque cheval gagne) matérialisées par un vecteur de probabilités . Eisenberg & Gale (1959) définissent alors une situation d’équilibre, dès lors que si   alors on doit avoir

Il monte qu’un tel équilibre existe, et qu’il est unique. On retrouve ici un résultat connu en mathématique financières sous le nom de loi du prix unique, même si les croyances ne sont pas explicitement mentionnées. Et c’est ce résultat qui permet d’interpréter les prix sur un marché prédictif comme des probabilités.

En s’inspirant du modèle de Eisenberg & Gale (1959), Manski (2005) obtient une interprétation sur un marché prédictif. Dans ces marchés, on ne peut pas parier sur un cheval dans une course, mais sur la survenance d’un évènement. Considérons un contrat offrant 1$ si un évènement  survient (élection d’un nouveau pape, départ d’un pays de la zone euro, etc), proposé au prix . S’il existe un contrat sur l’évènement complémentaire  (on va supposer ici que c’est le cas), il devrait être proposé au prix , sinon un arbitrage serait possible[i]. Considérons maintenant un agent croyant avec probabilité  que l’évènement  va survenir. Si , cette personne a intérêt à investir tout son argent pour acheter son titre, sinon, il a intérêt à investir dans l’autre titre, associé à . Au niveau agrégé la demande pour les titres de type et  sera respectivement

 et

et on aura un équilibre si

Si on suppose que les croyances et les richesses  sont indépendantes, on peut interpréter les prix  et  comme des probabilités,

 et

Wolfers & Zitzewitz (2007) propose une interprétation différente, plus économique, dans le contexte d’agents ayant une utilité logarithmique.

Marché et pari en ligne

La situation que nous venons de décrire est celle d’un marché parfait, où un équilibre se fait entre les parieurs, et cet équilibre donne des prix interprétables comme des probabilités de gain (on parle éventuellement de « pari mutuel »). Mais la pratique des paris en ligne est souvent différente, car les prix sont proposés par un bookmaker. Comme le nom l’indique, ces personnes – à la base – enregistrent les paiements, mais en pratique, ce sont aussi eux qui fixent les prix. Par exemple lors des dernières élections présidentielles en France, plusieurs sites proposaient de parier sur l’issue du second tour.

Tableau 1 : côtes lors des élections présidentielles de 2017

côtes (sites de paris en ligne) Intention de votes (instituts de sondage)
bet365 comeon betsafe FT Bloomberg BBC
Macron 1/8 1/8 1/7 64% 60.5% 61%
Le Pen 5/1 9/2 9/2 36% 39.5% 39%

Source : http://www.onlinebettingsites.com/2017-french-election/ (données fin avril 2017)

Comme le montre le Tableau 1, les côtes offertes par les bookmakers sont différentes entre les sites de paris. Une cote de 1/8 signifie qu’en pariant 8€, mon gain net sera de 1€ si le candidat l’emporte le jour de l’élection (et je perds ma mise si le candidat perd). La « probabilité » associée est ici  pour E. Macron (mon gain brut étant de 9/8€ pour 1€ misé) et. Le soucis – on retrouve ici la discussion initié par Jacques Bernoulli – est que ces « probabilités »  ne somment pas à 1, puisque . La différence vient du fait qu’il ne s’agit pas un « juste » prix, le bookmaker s’assurant un rendement certain (de l’ordre de 5,5% de la mise initiale, quel que soit le site choisi). Les vraies probabilités induites par ces cotes sont ici respectivement  et . Les sites de paris en ligne donneraient une probabilité de gain pour Emmanuel Macron de 84%, alors que les sondages indiquent une intention de vote de 62%, pour les instituts de sondage.

A-t-on réellement une probabilité, ou une fourchette ?

On le voit, les grandeurs données ne sont pas identiques, l’une indiquant une croyance sur une probabilité de gagner, et l’autre une proportion de votes que devrait avoir un candidat. Dans le modèle de Manski, les probabilités induites par la moyenne des croyances et les prix coïncident si on suppose que les agents ont une utilité logarithmique. Comme le montre Wolfers & Zitzewitz (2006), si on suppose que les agents ont une aversion au risque, ça ne sera plus le cas. En particulier, l’article suggère de considérer des bornes pour  de la forme , représentées sur la Figure 2, où  est appelé « prix de marché » pour reprendre une notation proche de la Figure 1.

Figure 2 : Bornes  sur les croyances moyennes

Faut-il utiliser les prédictions des marchés prédictifs ?

On l’a vu lors de la dernière élection en France, beaucoup s’interrogent sur la place pris par les sondages, en particulier en notant qu’il ne s’agissait pas d’une photographie neutre, mais que les électeurs pouvaient choisir leur candidat précisément à la lecture des sondages (la fameuse théorie du « vote utile » en particulier). Le danger à utiliser les marchés prédictifs comme outils de prévision est que ces dangers sont manipulables, comme l’a montré Schröder (2008). Un autre danger – et cela a été noté lors de la dernière élection présidentielle aux Etats-Unis – les côtes sur les sites en ligne de pari reflètent les croyances d’une certaine « élite » (disons les personnes souvent relativement éduquées, et la classe supérieure, suivant la politique), contrairement aux sondages, qui sont supposés être conduits sur un échantillon représentatif des électeurs, et sont supposer refléter les choix du « peuple » (et non pas une opinion ou une croyance). Si les parieurs tiennent comptent de ces sondages, les prix reflètent leurs croyances. Une dernière critique que l’on peut faire est que la majorité des marchés prédictifs représentent des volumes de transactions très faibles.

Les sondages traditionnels font face aujourd’hui à une défiance croissante. Il devient difficile de constituer un échantillon représentatif, le taux de non-réponse atteint des proportions jamais atteint (et nul ne sait si cette non-réponse est corrélée avec des choix électoraux). Et la confusion règne, entre les sondages classiques, et les « sondages en lignes » hébergés sur divers sites d’information. Mais pour reprendre l’anecdote raconté par Scott Armstrong dans Knowledge@Wharton en 2004, si dans une réunion du conseil exécutif d’une grande entreprise on demande à tous les participants de faire des prévisions quant aux résultats pour l’année prochaine, ou si on demande aux participants de parier sur les résultats de l’année prochaine, quels prévisions seront les plus crédibles ?

Références

Arrow, K.J. & Debreu, G. Existence of an equilibrium for a competitive economy, Econometrica, vol. 22,‎ 1954

Baumgartner, F. Behind locked doors: a history of papal elections. 2003

Charpentier, A. L’efficience des marchés : hypothèse de modèle ou fait stylisé ? Risques, 96. 2014

Frank, E., Verbeek, E. & Nüesch, S. Inter-Market Arbitrage in Betting. Economica, 2012.

Johnson, T. Ethics in Quantitative Finance: a pragmatic theory of markets. Wiley, 2017.

Knowledge@Wharton, How Credible Are Polls? Is There a Better Way to Predict Outcomes in Politics and Business, 3 Novembre 2004,

Manski, C.F. Interpreting the Predictions of Prediction Markets. Working Paper 10359, 2004

Meng, K.C. Using a Free Permit Rule to Forecast the Marginal Abatement Cost of Proposed Climate Policy. American Economic Review vol 107, 2017

Polgreen. Use of Prediction Markets to Forecast Infectious Disease Activity. Healthcare Epidemiology, 2007

Ramsey, F.P. Truth and probability, dans The Foundations of Mathematics and other Logical Essays, 1931 .

Rhode, P.W. & Strumpf, K. (2008) Historical Election Betting Markets: an International Perspective.

Schröder, J. Manipulations in Prediction Markets. Universitätsverlag Karlsruhe, 2009.

The Economist, The Future of Futurology, 15 Novembre 2007

Wolfers, J. & Zitzewitz, E. Interpreting Prediction Market Prices as Probabilities. Working Paper 12200, 2006

Wood, T. Do betting markets outperform election polls? Hardly. The Washington Post, Août 2016

[i] Comme l’a montré Franck et al. (2012), comme il existe aujourd’hui plusieurs sites de paris (plusieurs marchés), il peut exister des arbitrages entre les marchés, rarement au sein d’un marché.

 

An Open Lab-Notebook Experiment