Wordfish avec R : un exemple
Sophie Balech
Introduction
Ce document présente le modèle wordfish. Développés par des chercheurs en sciences politiques, ce modèle vise à déterminer les oppositions idéologiques des acteurs étudiés. Les premiers travaux utilisant le modèle s’intéressent aux évolutions des positionnements des partis politiques en Allemagne, en Grande-Bretagne, au Japon, en s’appuyant sur les manifestes des partis politiques. Nous trouverons à cette adresse quelques publications des auteurs du modèle. Le modèle permet de comparer les textes entre eux, sur la base des mots employés. Comparé à d’autres modèles de classification/comparaison de documents, celui-ci ne nécessite pas de connaître les positions a priori des acteurs, ni de connaitre les positions de départ. Au contraire, ce modèle se fonde sur la fréquence d’apparition des termes dans un discours pour le comparer aux autres discours et en déterminer sa position relative. Le modèle permet de représenter sur une échelle unidimensionnelle les positions des termes en fonction de leurs occurrences. Il est considéré que le nombre d’occurrence du mot j dans le discours de l’acteur i au temps t est fonction du contexte dans lequel le discours est produit, des effets propres du mot, de l’importance du mot pour discriminer la position de l’acteur et de la position de l’acteur au temps t. D’une manière formelle, nous obtenons : \[y_{i j t} = Poisson (\lambda_{i j t})\\ \lambda_{i j t} = exp(\alpha_{i t} + \psi_{j} + \beta_{j}*\omega_{i t})\] Avec : \(y_{i j t}\) , le nombre d’occurrences du terme j dans le discours d’un acteur i au temps t, \(\alpha_{i t}\), les effets du contexte sur l’acteur i au temps t, \(\psi_{j}\), les effets propres du terme j, \(\beta_{j}\), un estimateur de la spécificité du poids du terme j qui permet d’évaluer l’importance du terme pour discriminer les acteurs entre eux, \(\omega_{i t}\), la position estimée de l’acteur i au temps t.
Nous pouvons utiliser ce modèle pour déterminer les positionnements de différents acteurs entre eux, ainsi que leur évolution dans le temps.
1 Les données
Nous allons utiliser le modèle pour déterminer les positions des acteurs dans le conflit qui a pu opposer Uber à la ville de Paris, aux taxis et aux chauffeurs VTC. Les données collectées représentent les positions publiques, exprimées à travers des communiqués de presse, des posts de blog et des compte-rendus de débats, des différents acteurs identifiés dans le conflit. La période étudiée va de 2013 à 2017. Nous renvoyons les lecteurs intéressés par le détail des données à la thèse bientôt publiée de l’auteur de ce document.
1.1 Les packages utilisés
library(tidyverse) #le langage
library(tidytext) #le langage pour le texte
library(quanteda) #le traitement des corpus
library(lubridate) #la gestion des dates
library(reshape2) #la transformation des données (pour les graphiques notamment)
library(wordcloud) # les nuages de mots1.2 L’import des données
On pourra se référer à cette page pour l’import des données avec le package quanteda.
1.2.1 Le jeu de données
tbl_french <- list.files(pattern = "*.txt",recursive = TRUE, include.dirs = TRUE ) %>%
map_chr(~ read_file(.)) %>%
data_frame(text = .)%>%
mutate(doc=list.files(pattern="*.txt",recursive=TRUE))%>% #on crée une variable d'identification des documents
separate(doc, c("acteur","date"))%>% # variables acteur et date créées à partir de l'identification des documents
mutate(date=ymd(date, truncated=1))%>% # on modifie le format de la date
mutate(year=year(date))%>% #on extrait l'année
mutate(document=paste0("text", c(1:228) )) # on numérote les documents
tbl_french## # A tibble: 228 x 5
## text acteur date year document
## <chr> <chr> <date> <dbl> <chr>
## 1 "Taxi/VTC : AlloCab.com au cœur des né~ Alloc~ 2013-03-13 2013 text1
## 2 "Taxi-VTC : Décret des 15 minutes susp~ Alloc~ 2013-05-02 2013 text2
## 3 "le 12 août 2013\r\n\r\nLes 15 minutes~ Alloc~ 2013-08-12 2013 text3
## 4 " le 17 octobre 2013\r\nTaxis vs VTC :~ Alloc~ 2013-10-17 2013 text4
## 5 "le 18 octobre 2013\r\nLe mouvement le~ Alloc~ 2013-10-18 2013 text5
## 6 "\r\nLes 15 Minutes des VTC : Allocab.~ Alloc~ 2014-01-13 2014 text6
## 7 "Les VTC plébiscités par les francilie~ Alloc~ 2014-04-14 2014 text7
## 8 "Rapport Thévenoud : sur la voie de l’~ Alloc~ 2014-04-24 2014 text8
## 9 "Les VTC exclus des voies réservées su~ Alloc~ 2014-05-28 2014 text9
## 10 "AlloCab.com défend l’activité des VTC~ Alloc~ 2014-09-01 2014 text10
## # ... with 218 more rows1.2.2 Le dictionnaire des stopwords
#on récupère le dictionnaire des stopwords en français
sw<-get_stopwords("fr")
#on ajoute les mots manquants
sw<- bind_rows(data_frame(word = c("ville","l'autorité","a","c'est","n'est","d'un","d'une","n'a", "publié","parnathanaelle","leshem"),
lexicon = c("custom")),
sw)
#on transforme en format dictionnaire
swdic<-rename(sw, sentiment=lexicon)
swdic<-as.dictionary(swdic)1.3 La transformation des données en corpus et traitements préalables
La fonction corpus() permet de transformer les données importées en corpus. Nous pouvons alors extraire les termes utilisés (tokens). Pour alléger le traitement, nous enlevons les stopwords et regroupons les termes qui apparaissent majoritairement ensemble. Nous pouvons ensuite transformer ces données en matrice documents-features, qui croise les documents et les occurrences des tokens.
#corpus
corpus<-corpus(tbl_french)
corpus## Corpus consisting of 228 documents and 4 docvars.#tokens
tok<-corpus%>%
tokens(remove_numbers = TRUE, remove_punct=TRUE, include_docvars = TRUE) %>%
tokens_tolower()%>%
tokens_remove(swdic)
#les mots apparaissant l'un après l'autre fréquemment
cap_toks <- tokens_select(tok, valuetype = 'regex', case_insensitive = FALSE, padding = TRUE)
cap_col <- textstat_collocations(cap_toks, min_count = 3, tolower = FALSE)
head(cap_col, 20)## collocation count count_nested length lambda
## 1 madame maire 102 0 2 7.130781
## 2 mise place 70 0 2 6.492248
## 3 millions d'euros 75 0 2 8.212048
## 4 voie publique 71 0 2 8.639470
## 5 monsieur maire 60 0 2 5.471119
## 6 mme maire 58 0 2 5.420064
## 7 service public 49 0 2 5.982750
## 8 adjoint président 58 0 2 8.516859
## 9 prise charge 68 0 2 9.180832
## 10 président merci 44 0 2 6.276477
## 11 l'application uber 50 0 2 5.435656
## 12 merci madame 43 0 2 5.694768
## 13 transport personnes 47 0 2 5.204435
## 14 organisations professionnelles 51 0 2 8.905848
## 15 député thévenoud 34 0 2 6.538606
## 16 maire chers 45 0 2 6.511380
## 17 réservation préalable 60 0 2 8.499617
## 18 chauffeurs taxis 92 0 2 3.224827
## 19 proposition loi 44 0 2 5.779246
## 20 préfecture police 34 0 2 8.175681
## z
## 1 38.55068
## 2 35.52157
## 3 32.88583
## 4 32.42845
## 5 32.13760
## 6 31.58787
## 7 30.50014
## 8 30.35849
## 9 29.74271
## 10 29.52744
## 11 29.08181
## 12 28.77519
## 13 28.46932
## 14 27.48460
## 15 27.39897
## 16 27.38289
## 17 27.33616
## 18 27.17804
## 19 26.70940
## 20 26.46732tok <- tokens_compound(tok, cap_col[cap_col$count > 10])
rm(cap_toks,cap_col)
head(tok$text101, 20)## [1] "commission" "professionnelle" "taxi_parisien"
## [4] "décembre" "l'incompréhension" "totale"
## [7] "vivons" "tous" "taxi"
## [10] "manière" "préfecture" "vient"
## [13] "encore" "démontrer" "favorisant"
## [16] "création" "nouveaux" "doublages"
## [19] "contexte_économique" "morose"#document-features matrix
dfm<-dfm(tok)
dfm## Document-feature matrix of: 228 documents, 15,969 features (98.3% sparse).1.4 Première visualisation des mots les plus utilisés par chaque acteur
#on groupe le dfm par acteur
dfmgroup<-dfm_group(dfm,groups = "acteur")
dfmgroup## Document-feature matrix of: 8 documents, 15,969 features (77.9% sparse).#on transforme pour ne garder que les 40 les plus importants pour chaque acteur (graphique trop gros sinon)
d<-tidy(dfmgroup)%>%
group_by(document)%>%
top_n(40)%>%
ungroup%>%
acast(term ~ document, value.var = "count", fill = 0)
#wordcloud
comparison.cloud(d,scale=c(2.5,0),
colors = brewer.pal(8,"Set2"),
title.size = 1,
use.r.layout = T,
title.bg.colors = NULL,
title.colors = "black")
2 Le modèle wordfish
2.1 Résultat global
#on groupe en fonction des acteurs et des années
dfmgroup<-dfm_group(dfm,groups = c("acteur","year"))
#le modèle wordfish
wf <- textmodel_wordfish(dfmgroup)
summary(wf)##
## Call:
## textmodel_wordfish.dfm(x = dfmgroup)
##
## Estimated Document Positions:
## theta se
## Allocab.2013 0.253825 0.016934
## AutoritedelaConcurrence.2013 0.569488 0.016336
## CGT.2013 0.525453 0.008220
## UNIT.2013 0.315736 0.022592
## Allocab.2014 0.466104 0.010990
## CGT.2014 0.652792 0.002481
## ConseildeParis.2014 0.108230 0.006949
## UNIT.2014 0.439014 0.023072
## Allocab.2015 0.437370 0.021515
## AutoritedelaConcurrence.2015 0.462915 0.011412
## CFDT.2015 0.033061 0.037161
## CGT.2015 0.549698 0.003782
## ConseildeParis.2015 0.064664 0.007647
## FNAT.2015 0.460088 0.009784
## Uber.2015 -2.367378 0.025675
## UNIT.2015 0.381867 0.031445
## AutoritedelaConcurrence.2016 0.427943 0.022189
## CFDT.2016 -0.178917 0.023628
## CGT.2016 0.537610 0.003914
## ConseildeParis.2016 0.127276 0.010814
## Uber.2016 -3.041858 0.015384
## UNIT.2016 0.538355 0.011718
## CFDT.2017 0.009599 0.016620
## CGT.2017 0.577965 0.006986
## ConseildeParis.2017 0.157221 0.009370
## Uber.2017 -2.508120 0.014060
##
## Estimated Feature Scores:
## taxi vtc allocab.com cœur négociations l'assemblée nationale
## beta 6.0611 5.6418 0.6077 -0.08334 0.656 2.784 4.480
## psi 0.3779 0.8801 -0.3316 -1.31842 -1.446 -2.044 -0.727
## paris mars jour président-fondateur d'allocab.com rend
## beta -0.08235 -0.2996 -0.1714 0.576 0.6462 0.9043
## psi 3.17675 0.2821 0.7963 -1.574 -0.9908 -0.7071
## session travail député thévenoud l'ensemble acteurs première genre
## beta 0.2309 0.3003 8.543 6.171 0.4054 0.3646 -0.2739 0.1282
## psi -3.2776 2.0022 -2.650 -2.743 1.2687 0.9282 1.1718 -0.9607
## table ronde entre taxis l'objectif réconcilier d'échanger
## beta 0.149 0.5797 -0.1048 3.760 -0.008629 0.2309 0.5886
## psi -0.493 -1.9808 1.9637 1.622 0.142846 -3.2776 -1.9837
## paisiblement revendications
## beta 0.2309 1.8344
## psi -3.2776 -0.6276#les étiquettes acteur et années
doclab <- paste(docvars(dfmgroup, "acteur"))
docyear<- paste(docvars(dfmgroup, "year"))
#positionnement des acteurs
textplot_scale1d(wf, doclabels = doclab)
#positionnement des mots
textplot_scale1d(wf, margin = "features",
groups = "acteur",
highlighted = c("taxis","vtc","licences","minutes","uber",
"chauffeur","maraude","ubereats",
"concurrence","emplois","travail","partagez","promotion",
"conseil_constitutionnel"))
2.2 Représentation par année
#positionnement des acteurs
textplot_scale1d(wf, doclabels = doclab, groups=docyear)
#dans l'autre sens
textplot_scale1d(wf, doclabels = docyear, groups=doclab)
2.3 Focus sur la CGT
#on restreint
dfm2<-dfm_subset(dfmgroup,acteur=="CGT")
#petite visualisation
textplot_wordcloud(dfm2)
#le modèle wordfish
wf <- textmodel_wordfish(dfm2)
summary(wf)##
## Call:
## textmodel_wordfish.dfm(x = dfm2)
##
## Estimated Document Positions:
## theta se
## CGT.2013 -0.9995 0.02038
## CGT.2014 -0.1416 0.01161
## CGT.2015 -0.9110 0.01023
## CGT.2016 1.1770 0.01281
## CGT.2017 0.8751 0.02705
##
## Estimated Feature Scores:
## taxi vtc cœur négociations l'assemblée nationale paris
## beta 0.4889 0.1494 -0.7306 -0.8808 1.6862 0.390 -0.2299
## psi 3.8986 4.0505 -1.5355 -1.6109 -0.4961 1.869 2.4797
## mars jour rend travail député thévenoud l'ensemble acteurs
## beta -0.1351 0.2711 0.3049 0.6909 0.983 0.1118 -0.1124 1.118
## psi 0.2977 1.1951 -0.3295 2.4506 2.061 0.6092 1.3331 1.361
## première genre table ronde entre taxis l'objectif d'échanger
## beta 0.4449 -0.09663 0.6406 -0.7306 0.221 0.4589 0.106 -1.77
## psi 1.4278 -0.38585 -0.3500 -1.5355 1.948 3.9263 -0.858 -2.86
## revendications l'issue réunion plusieurs groupes mis place
## beta 0.7007 0.09333 0.4392 0.969 0.2087 0.4472 0.1388
## psi 0.8024 -1.95839 1.0052 1.482 -0.1530 0.3630 1.4490#les étiquettes années
docyear<- paste(docvars(dfm2, "year"))
#positionnement des acteurs
textplot_scale1d(wf, doclabels = docyear)
#positionnement des mots
textplot_scale1d(wf, margin = "features",
groups = "acteur",
highlighted = c("taxis","vtc","licences","minutes","uber",
"chauffeur","maraude",
"concurrence_déloyale", "plateforme",
"emplois","travail","loti","promotion",
"ads", "délégués","marché_maraude"))