Skip to content
Snippets Groups Projects
Commit c98254ce authored by Thomas Soubiran's avatar Thomas Soubiran
Browse files

Ajout module 1 + màj jmorel

parent d01f3f24
No related branches found
No related tags found
No related merge requests found
Showing
with 8618 additions and 23 deletions
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml" lang="" xml:lang="">
<head>
<meta charset="utf-8" />
<meta name="generator" content="pandoc" />
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes" />
<title>README</title>
<style type="text/css">
code{white-space: pre-wrap;}
span.smallcaps{font-variant: small-caps;}
span.underline{text-decoration: underline;}
div.column{display: inline-block; vertical-align: top; width: 50%;}
</style>
</head>
<body>
<h1 id="dépôt-quantilille-2021">Dépôt Quantilille 2021</h1>
<p>Ce dépôt rassemble les supports, scripts, données et autres ressources utilisées lors de <a href="https://ceraps.univ-lille.fr/quantilille/">l’École d’été méthodes quantitatives en sciences sociales</a> 2021.</p>
<p>Nous remercions les intervenantes et intervenants de nous avoir permis de mettre leurs supports en ligne.</p>
<p>Ces contenus sont diffusés sous licence XXX sauf mention contraire dans le répertoire correspondant.</p>
<h2 id="module-nᵒ-1-traitement-quantitatif-de-données-textuelles-nettoyage-exploration-analyse">Module nᵒ 1 : Traitement quantitatif de données textuelles : nettoyage, exploration, analyse</h2>
<p>Module organisé par <a href="https://pro.univ-lille.fr/julien-boelaert">Julien Boelaert</a> et <a href="https://www.centre-max-weber.fr/Samuel-Coavoux">Samuel Coavoux</a></p>
<table>
<tbody>
<tr class="odd">
<td><em>Note :</em> les données utilisées se trouvent dans le répertoire <a href="analyse-textuelle/données/">données</a></td>
</tr>
</tbody>
</table>
<h3 id="lundi-28-juin">Lundi 28 juin</h3>
<p><strong>Présentation de Progedo et de la PUDL (9h-12h)</strong><br />
PUDL</p>
<p><strong>Introduction à R, importation de données (14h-17h)</strong><br />
Julien Boelaert<br />
<a href="analyse-textuelle/jboelaert/TD/TD1-Intro.R">script R</a></p>
<h3 id="mardi-29-juin">Mardi 29 juin :</h3>
<p><strong>Enjeux et évolutions récentes du traitement quantitatif des données textuelles (9h-12h)</strong><br />
<a href="https://sylvainparasie.org">Sylvain Parasie</a><br />
<a href="analyse-textuelle/sparaisie/Parasie_Enjeux%20et%20évolutions%20récentes%20du%20traitement%20quantitatif%20des%20données%20textuelles%20(29juin21).pdf">présentation</a></p>
<p><strong>Expressions régulières : recherche, nettoyage, mise en forme de corpus (14h-17h)</strong><br />
Julien Boelaert<br />
<a href="">présentation</a><br />
<a href="analyse-textuelle/jboelaert/TD/TD2-Regex-énoncé.R">script R</a> <a href="analyse-textuelle/jboelaert/TD/TD2-Regex.R">script R</a></p>
<h3 id="mercredi-30-juin">Mercredi 30 juin :</h3>
<p><strong>Introduction à l’analyse textuelle sous R (9h-12h)</strong><br />
Julien Boelaert<br />
<a href="analyse-textuelle/jboelaert/TD/TD3-demo-lemmatisation.R">script R</a> <a href="analyse-textuelle/jboelaert/TD/TD3-matrice-doc-termes.R">script R</a></p>
<p><strong>Lexicométrie : analyse factorielle (14h-17h)</strong><br />
Julien Boelaert<br />
<a href="analyse-textuelle/jboelaert/TD/TD4-analyse-factorielle.R">script R</a></p>
<h3 id="jeudi-1er-juillet">Jeudi 1er juillet :</h3>
<p><strong>Classification de textes : la méthode Reinert (9h-12h)</strong><br />
<a href="https://www.centre-max-weber.fr/Julien-Barnier">Julien Barnier</a> (<a href="https://github.com/juba">github</a>)<br />
<a href="analyse-textuelle/jbarnier/">présentation &amp; scripts R</a></p>
<p><strong>Détection automatique de thèmes : le topic model et ses extensions (14h-17h)</strong><br />
<a href="https://cessp.cnrs.fr/-BELLON-Anne-">Anne Bellon</a><br />
<a href="analyse-textuelle/abellon/Quantilille%202021_topicmodel.pdf">présentation</a><br />
<a href="analyse-textuelle/abellon/R/">scripts R</a></p>
<h3 id="vendredi-2-juillet">Vendredi 2 juillet :</h3>
<p><strong>Méthodes supervisées : classification, enrichissement de corpus (9h-12h)</strong><br />
Julien Boelaert<br />
<a href="analyse-textuelle/jboelaert/active-learning">scripts R</a></p>
<p><strong>Au-delà du « sac de mots » : plongement de mots, transfert d’apprentissage / Introduction au nettoyage de données simples avec openRefine. (14h-17h)</strong><br />
Julien Boelaert</p>
<h2 id="module-nᵒ-2-cartographie">Module nᵒ 2 : Cartographie</h2>
<p>Module organisé par <a href="https://pro.univ-lille.fr/thomas-soubiran/">Thomas Soubiran</a> (<a href="https://github.com/tsoubiran">github</a>) et <a href="https://pro.univ-lille.fr/cecile-rodrigues/">Cécile Rodrigues</a> (<a href="https://github.com/grisoudre">github</a>)</p>
<h3 id="lundi-28-juin-1">Lundi 28 juin</h3>
<p><strong>Présentation de PROGEDO et de la PUDL (9h-12h)</strong><br />
PUDL</p>
<p><strong>Sources de données géographiques (14h-17h)</strong></p>
<p><em>Avanies et organisation administrative française</em> Thomas Soubiran<br />
<a href="cartographie/table-ronde/qtll2021--orga-fr.pdf">présentation</a></p>
<p><em>La Base adresse nationale</em> Jérôme Desboeufs (etalab)<br />
<a href="cartographie/table-ronde/ban.pdf">présentation</a></p>
<p><em>API Géo</em><br />
<a href="cartographie/table-ronde/API-Géo.pdf">présentation</a></p>
<h3 id="mardi-29-juin-1">Mardi 29 juin :</h3>
<p><strong>Introduction à la cartographie (9h-12h)</strong><br />
<a href="https://www.laburba.com/membres/juliette-morel/">Juliette Morel</a><br />
<a href="">présentation</a></p>
<p><strong>Introduction à R (14h-17h)</strong><br />
Cécile Rodrigues<br />
<a href="">scripts R</a></p>
<h3 id="mercredi-30-juin-1">Mercredi 30 juin :</h3>
<p><strong>Nettoyage de données, géo-encodage (9h-12h)</strong><br />
<a href="github.com/antuki">Kim Antunez</a> (<a href="https://github.com/">github</a>) et <a href="">Étienne Côme</a> (<a href="https://github.com/comeetie">github</a>)<br />
scripts R : <a href="cartographie/ecka/installations_packages.R">installation</a> <a href="cartographie/ecka/lecture/lecture.Rmd">cours</a></p>
<p><strong>Manipulation de données spatiales, présentations cartographiques (14h-17h)</strong> Kim Antunez et Étienne Côme<br />
<a href="cartographie/ecka/lecture/lecture.Rmd">script R</a></p>
<h3 id="jeudi-1er-juillet-1">Jeudi 1er juillet :</h3>
<p><strong>Exercices de mise en pratique sur R (9h-12h)</strong><br />
<a href="cartographie/ecka/exercises/exercises.Rmd">script R</a></p>
<p><strong>Utilisation d’un logiciel de SIG : QGIS (14h-17h)</strong><br />
Juliette Morel<br />
<a href="présentation" class="uri">présentation</a> <a href="">données</a></p>
<h3 id="vendredi-2-juillet-1">Vendredi 2 juillet :</h3>
<p><strong>Introduction au module PostGIS de PostgreSQL (9h-12h)</strong><br />
Thomas Soubiran<br />
<a href="cartographie/postgis/postgis.pdf">présentation</a> <a href="cartographie/postgis/R/">scripts R</a></p>
<p><strong>Visualisation dynamique de données spatiales(14h-17h)</strong><br />
<a href="https://bmericskay.github.io/portfolio/about.html">Boris Mericskay</a><br />
<a href="">présentation</a></p>
</body>
</html>
# Dépôt Quantilille 2021
Ce dépôt rassemble les supports, scripts, données et autres ressources utilisées lors de [l’École d'été méthodes quantitatives en sciences sociales](https://ceraps.univ-lille.fr/quantilille/) 2021.
Nous remercions les intervenantes et intervenants de nous avoir permis de mettre leurs supports en ligne.
Ces contenus sont diffusés sous licence XXX sauf mention contraire dans le répertoire correspondant.
## Module nᵒ 1 : Traitement quantitatif de données textuelles : nettoyage, exploration, analyse
Module organisé par Julien Boelaert et Samuel Coavoux
Module organisé par [Julien Boelaert](https://pro.univ-lille.fr/julien-boelaert) et [Samuel Coavoux](https://www.centre-max-weber.fr/Samuel-Coavoux)
----
*Note :* les données utilisées se trouvent dans le répertoire [données](analyse-textuelle/données/)
----
### Lundi 28 juin
......@@ -12,43 +22,53 @@ PUDL
**Introduction à R, importation de données (14h-17h)**
Julien Boelaert
[script R](analyse-textuelle/jboelaert/TD/TD1-Intro.R)
### Mardi 29 juin :
**Enjeux et évolutions récentes du traitement quantitatif des données textuelles (9h-12h)**
Sylvain Parasie
[Sylvain Parasie](https://sylvainparasie.org)
[présentation](analyse-textuelle/sparaisie/Parasie_Enjeux et évolutions récentes du traitement quantitatif des données textuelles (29juin21).pdf)
**Expressions régulières : recherche, nettoyage, mise en forme de corpus (14h-17h)**
Julien Boelaert
[présentation]()
[script R](analyse-textuelle/jboelaert/TD/TD2-Regex-énoncé.R) [script R](analyse-textuelle/jboelaert/TD/TD2-Regex.R)
### Mercredi 30 juin :
**Introduction à l’analyse textuelle sous R (9h-12h)**
Julien Boelaert
[script R](analyse-textuelle/jboelaert/TD/TD3-demo-lemmatisation.R) [script R](analyse-textuelle/jboelaert/TD/TD3-matrice-doc-termes.R)
**Lexicométrie : analyse factorielle (14h-17h)**
Julien Boelaert
[script R](analyse-textuelle/jboelaert/TD/TD4-analyse-factorielle.R)
### Jeudi 1er juillet :
**Classification de textes : la méthode Reinert (9h-12h)**
Julien Barnier
[Julien Barnier](https://www.centre-max-weber.fr/Julien-Barnier) ([github](https://github.com/juba))
[présentation & scripts R](analyse-textuelle/jbarnier/)
**Détection automatique de thèmes : le topic model et ses extensions (14h-17h)**
Anne Bellon
[Anne Bellon](https://cessp.cnrs.fr/-BELLON-Anne-)
[présentation](analyse-textuelle/abellon/Quantilille 2021_topicmodel.pdf)
[scripts R](analyse-textuelle/abellon/R/)
### Vendredi 2 juillet :
**Méthodes supervisées : classification, enrichissement de corpus (9h-12h)**
Julien Boelaert
[scripts R](analyse-textuelle/jboelaert/active-learning)
**Au-delà du « sac de mots » : plongement de mots, transfert d’apprentissage / Introduction au nettoyage de données simples avec openRefine. (14h-17h)**
Julien Boelaert
## Module nᵒ 2 : Module Caratographie
## Module nᵒ 2 : Cartographie
Module organisé par Thomas Soubiran et Cécile Rodrigues
Module organisé par [Thomas Soubiran](https://pro.univ-lille.fr/thomas-soubiran/) ([github](https://github.com/tsoubiran)) et [Cécile Rodrigues](https://pro.univ-lille.fr/cecile-rodrigues/) ([github](https://github.com/grisoudre))
### Lundi 28 juin
......@@ -69,7 +89,7 @@ _API Géo_
### Mardi 29 juin :
**Introduction à la cartographie (9h-12h)**
Juliette Morel
[Juliette Morel](https://www.laburba.com/membres/juliette-morel/)
[présentation]()
**Introduction à R (14h-17h)**
......@@ -79,17 +99,17 @@ Cécile Rodrigues
### Mercredi 30 juin :
**Nettoyage de données, géo-encodage (9h-12h)**
Kim Antunez et Étienne Côme
[scripts R]()
[Kim Antunez](github.com/antuki) ([github](https://github.com/)) et [Étienne Côme]() ([github](https://github.com/comeetie))
scripts R : [installation](cartographie/ecka/installations_packages.R) [cours](cartographie/ecka/lecture/lecture.Rmd)
### Manipulation de données spatiales, présentations cartographiques (14h-17h)
**Manipulation de données spatiales, présentations cartographiques (14h-17h)**
Kim Antunez et Étienne Côme
[scripts R]()
[script R](cartographie/ecka/lecture/lecture.Rmd)
### Jeudi 1er juillet :
**Exercices de mise en pratique sur R (9h-12h)**
[scripts R]()
[script R](cartographie/ecka/exercises/exercises.Rmd)
**Utilisation d’un logiciel de SIG : QGIS (14h-17h)**
Juliette Morel
......@@ -99,8 +119,8 @@ Juliette Morel
**Introduction au module PostGIS de PostgreSQL (9h-12h)**
Thomas Soubiran
[présentation]() [scripts R]()
[présentation](cartographie/postgis/postgis.pdf) [scripts R](cartographie/postgis/R/)
**Visualisation dynamique de données spatiales(14h-17h)**
Boris Mericskay
[Boris Mericskay](https://bmericskay.github.io/portfolio/about.html)
[présentation]()
File added
File added
######## Quantilille 2021 ####
####### Topic models #########
##Manipulation de données
library(dplyr)
library(stringr)## manipulation de chaînes de caractères
library(tibble)
#Lexicométrie
library(quanteda)
library(quanteda.textstats)
#Topic models
library(topicmodels)
library(ldatuning)### une librairie pour trouver le bon nombre de topics
library(LDAvis) ### une librairie pour la visualisation des topics
#Visualisation
library(FactoMineR)
library(Factoshiny)
library(ggpubr)
####
setwd("votre chemin")
popu<-read.csv("populisme.csv")
#### 1. Prétravail de création du corpus
popu$texte<-as.character(popu$texte)
popu$Titre<-as.character(popu$Titre)
# Enlever les doublons
doublons <- which(duplicated(popu$Titre))
popu<-popu[-doublons,]
# Pour la suite enlever les apostrophes
popu$texte<-str_replace_all(popu$texte,"'"," ")
## Création du corpus avec quanteda
cp <- corpus(popu$texte,
docvars = select(popu,journal, auteurs, media),
docnames = popu$Titre)
toremove<-c(stopwords("french"),"a", "comme", "d", "aussi", "fait",
"être", "c", "l" ,"ans", "faire", "si", "il",
"où", "tout", "plu", "encore", "déjà", "depuis",
"an", "entre", "n", "peut", "dont", "donc",
"ainsi", "faut","va", "donc", "tous", "alor",
"chez", "fois", "quand", "également", "plus", "y",
"celui", "celle", "hui", "aujourd", "l","qu","or","ici", "à", "dès",
"dit","pu","six","autres","font","ceux","peut",
"j","ni","là", "alors", "lors", "puis", "etc", "tel",
"chaque", "ca", "veut", "toute", "qu",
"peu", "moins", "très", "bien", "deux", "trois", "après",
"avant", "h", "s", "notamment","tant","peuvent",
"selon", "quelque", "toujours", "avoir", "car", "beaucoup",
"sous", "non", "autre", "contre", "plusieurs",
"autre", "toute", "fin", "heure",
"lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche",
"dans", "pas", "me", "nos", "nous", "de", "vous", "sans", "mais"
)
#Tokenisation
tk <- tokens(cp, remove_punct = TRUE, remove_numbers = TRUE)
dfm <- dfm(tk)
dfm <- dfm_remove(dfm, toremove)
topfeatures(dfm, n=100)
slice(arrange(textstat_collocations(tk, min_count = 20, size = 3L), desc(count)),1:30)
# Réduction de la matrice term/document
dfm2<-dfm_trim(dfm, min_termfreq = 10)
###### 2. Modèle Thématique
dtm <- quanteda::convert(dfm2, to = "topicmodels")
### 2.1 Paramétrage : trouver le bon nombre de thèmes
tp_nb<-FindTopicsNumber(dtm, topics = seq (5, 20,1),
metrics = c("Griffiths2004", "CaoJuan2009",
"Arun2010", "Deveaud2014"), method = "Gibbs",
control = list(alpha = 0.6))
#pdf ("meilleurtopic.pdf")
FindTopicsNumber_plot(tp_nb)
#dev.off()
#### 2.2 Lancement de la modélisation
res_lda <- LDA(dtm, k = 13, method = "Gibbs",
control = list(seed = 1979, alpha = 0.6))
#### 2.3 Explorer les résultats du topic model
terms(res_lda, 10)
#Intégrer les variables topics à notre base de données
base_topic<-as.data.frame(posterior(res_lda)$topic)
base_topic<-as.data.frame(lapply(base_topic, function(x) as.numeric(as.character(x))))
base_topic<-rename_all(base_topic,funs(paste0("tp",1:13)))
base_topic$max<-colnames(base_topic)[apply(base_topic, 1, which.max)]
base_topic$id<-rownames(posterior(res_lda)$topic)
colnames(popu)<-c("id","media","date","auteurs",
"soustitre", "texte", "journal", "presse")
popu_FULL<-right_join(popu,base_topic, by="id")
# Interpréter les thèmes et proposition de titres :
terms(res_lda,15)
select(slice(arrange(base_topic,desc(base_topic$tp2)),1:30),id)
## Tableau synthétique des thèmes
tt<-matrix(NA,13,7)
colnames(tt)<-c("Topic","Nom", "Moyenne","Ecart type", "Sup10", "Sup20", "Sup30")
for(i in 1:13) {
tt[i,"Topic"]<-paste0("Topic ",i)
tt[i,"Nom"]<-NomsTopics[i]
tt[i,"Moyenne"]<-round(mean(unlist(popu[,i+3]), na.rm=T),3)
tt[i,"Ecart type"]<-round(sd(unlist(popu[,i+3]),na.rm=T),3)
tt[i,"Sup10"]<-as.numeric(length(which(popu[,i+3]>=0.1)))
tt[i,"Sup20"]<-as.numeric(length(which(popu[,i+3]>=0.2)))
tt[i,"Sup30"]<-as.numeric(length(which(popu[,i+3]>=0.3)))
}
terms<-apply(terms(res_lda, 5), 2, paste, collapse = ", ")
tt<-as.data.frame(tt)
tt<-cbind(tt,terms)
#### 2.4 Analyse et visualisation
# La librairie LDAvis
topicmodels2LDAvis <- function(x, ...){
post <- topicmodels::posterior(x)
if (ncol(post[["topics"]]) < 3) stop("The model must contain > 2 topics")
mat <- x@wordassignments
LDAvis::createJSON(
phi = post[["terms"]],
theta = post[["topics"]],
vocab = colnames(post[["terms"]]),
doc.length = slam::row_sums(mat, na.rm = TRUE),
term.frequency = slam::col_sums(mat, na.rm = TRUE)
)
}
lda_js <- topicmodels2LDAvis(res_lda)
serVis(lda_js)
# PCA
popu.ca<-popu_FULL[,7:21]
Factoshiny(popu.ca)
### MDS
# à partir de la matrice termes / thèmes
post <-posterior(res_lda)
cor_mat <- cor(t(post[["terms"]]))
colnames(cor_mat)<-NomsTopics
rownames(cor_mat)<-NomsTopics
md2<-dist(cor_mat, method="manhattan")
fit <- cmdscale(md2,eig=TRUE, k=2)
fit
# plot solution
x <- fit$points[,1]
y <- fit$points[,2]
plot(x, y, xlab="Coordinate 1", ylab="Coordinate 2",
main="Metric MDS", type="n")
text(x, y, labels = row.names(cor_mat), cex=.7)
##Amélioration graphique
mds2<-cmdscale(md2)%>%
as.tibble
colnames(mds2) <- c("Dim.1", "Dim.2")
ggscatter(mds2, x = "Dim.1", y = "Dim.2",
label = rownames(cor_mat),
size = 1,
repel = TRUE)
######## Quantilille 2021 ####
####### Topic models #########
rm(list=ls())
##Manipulation de données
library(dplyr)
library(stringr)## manipulation de chaînes de caractères
#Lexicométrie
library(quanteda)
library(quanteda.textstats)
#Topic models
library(topicmodels)
library(ldatuning)### une librairie pour trouver le bon nombre de topics
library(LDAvis) ### une librairie pour la visualisation des topics
#Visualisation
library(FactoMineR)
library(Factoshiny)
library(ggpubr)
####
setwd("votre chemin")
popu<-read.csv("populisme.csv")
#### 1. Prétravail de création du corpus
popu$texte<-as.character(popu$texte)
popu$Titre<-as.character(popu$Titre)
# Enlever les doublons
doublons <- which(duplicated(popu$Titre))
popu<-popu[-doublons,]
# Pour la suite enlever les apostrophes
popu$texte<-str_replace_all(popu$texte,"'"," ")
## Création du corpus avec quanteda
cp <- corpus(popu$texte,
docvars = select(popu,journal, auteurs, media),
docnames = popu$Titre)
cp
stopwords("french")
toremove<-c(stopwords("french"),"a", "comme", "d", "aussi", "fait",
"être", "c", "l" ,"ans", "faire", "si", "il",
"où", "tout", "plu", "encore", "déjà", "depuis",
"an", "entre", "n", "peut", "dont", "donc",
"ainsi", "faut","va", "donc", "tous", "alor",
"chez", "fois", "quand", "également", "plus", "y",
"celui", "celle", "hui", "aujourd", "l","qu","or","ici", "à", "dès",
"dit","pu","six","autres","font","ceux","peut",
"j","ni","là", "alors", "lors", "puis", "etc", "tel",
"chaque", "ca", "veut", "toute", "qu",
"peu", "moins", "très", "bien", "deux", "trois", "après",
"avant", "h", "s", "notamment","tant","peuvent",
"selon", "quelque", "toujours", "avoir", "car", "beaucoup",
"sous", "non", "autre", "contre", "plusieurs",
"autre", "toute", "fin", "heure",
"lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche",
"dans", "pas", "me", "nos", "nous", "de", "vous", "sans", "mais"
)
#Tokenisation
tk <- tokens(cp, remove_punct = TRUE, remove_numbers = TRUE)
dfm <- dfm(tk)
dfm <- dfm_remove(dfm, toremove)
topfeatures(dfm, n=100)
slice(arrange(textstat_collocations(tk, min_count = 20, size = 3L), desc(count)),1:30)
# Réduction de la matrice term/document
dfm2<-dfm_trim(dfm, min_termfreq = 10)
###### 2. Modèle Thématique
dtm <- quanteda::convert(dfm2, to = "topicmodels")
### 2.1 Paramétrage : trouver le bon nombre de thèmes
tp_nb<-FindTopicsNumber(dtm, topics = seq (5, 20,1),
metrics = c("Griffiths2004", "CaoJuan2009",
"Arun2010", "Deveaud2014"), method = "Gibbs",
control = list(alpha = 0.6))
pdf ("meilleurtopic.pdf")
FindTopicsNumber_plot(tp_nb)
dev.off()
#### 2.2 Lancement de la modélisation
res_lda <- LDA(dtm, k = 13, method = "Gibbs",
control = list(seed = 1979, alpha = 0.6))
#### 2.3 Explorer les résultats du topic model
terms(res_lda, 15)
#Intégrer les variables topics à notre base de données
base_topic<-as.data.frame(posterior(res_lda)$topic)
summary(base_topic)
base_topic<-as.data.frame(lapply(base_topic, function(x) as.numeric(as.character(x))))
base_topic<-rename_all(base_topic,funs(paste0("tp",1:13)))
base_topic$max<-colnames(base_topic)[apply(base_topic, 1, which.max)]
base_topic$id<-rownames(posterior(res_lda)$topic)
colnames(popu)<-c("id","media","date","auteurs",
"soustitre", "texte", "journal", "presse")
popu_FULL<-right_join(popu,base_topic, by="id")
# Interpréter les thèmes et proposition de titres :
terms(res_lda,15)
select(slice(arrange(base_topic,desc(base_topic$tp12)),1:10),id)
NomsTopics<-c("ElectionsINTER", "Misc.Suisse", "Jeu.Pol","Elites", "US",
"Reforme.justice", "Misc.pol", "Pol.inter", "Democratie", "Geopol", "Misc.culture", "Europe", "Crise.demo")
## Tableau synthétique des thèmes
tt<-matrix(NA,13,7)
colnames(tt)<-c("Topic","Nom", "Moyenne","Ecart type", "Sup10", "Sup20", "Sup30")
for(i in 1:13) {
tt[i,"Topic"]<-paste0("Topic ",i)
tt[i,"Nom"]<-NomsTopics[i]
tt[i,"Moyenne"]<-round(mean(unlist(popu_FULL[,i+8]), na.rm=T),3)
tt[i,"Ecart type"]<-round(sd(unlist(popu_FULL[,i+8]),na.rm=T),3)
tt[i,"Sup10"]<-as.numeric(length(which(popu_FULL[,i+8]>=0.1)))
tt[i,"Sup20"]<-as.numeric(length(which(popu_FULL[,i+8]>=0.2)))
tt[i,"Sup30"]<-as.numeric(length(which(popu_FULL[,i+8]>=0.3)))
}
terms<-apply(terms(res_lda, 5), 2, paste, collapse = ", ")
tt<-as.data.frame(tt)
tt<-cbind(tt,terms)
#### 2.4 Analyse et visualisation
# La librairie LDAvis
topicmodels2LDAvis <- function(x, ...){
post <- topicmodels::posterior(x)
if (ncol(post[["topics"]]) < 3) stop("The model must contain > 2 topics")
mat <- x@wordassignments
LDAvis::createJSON(
phi = post[["terms"]],
theta = post[["topics"]],
vocab = colnames(post[["terms"]]),
doc.length = slam::row_sums(mat, na.rm = TRUE),
term.frequency = slam::col_sums(mat, na.rm = TRUE)
)
}
lda_js <- topicmodels2LDAvis(res_lda)
serVis(lda_js)
# PCA
popu.ca<-popu_FULL[,7:21]
Factoshiny(popu.ca)
### MDS
# à partir de la matrice termes / thèmes
post <-posterior(res_lda)
cor_mat <- cor(t(post[["terms"]]))
colnames(cor_mat)<-NomsTopics
rownames(cor_mat)<-NomsTopics
md2<-dist(cor_mat, method="manhattan")
fit <- cmdscale(md2,eig=TRUE, k=2)
fit
# plot solution
x <- fit$points[,1]
y <- fit$points[,2]
plot(x, y, xlab="Coordinate 1", ylab="Coordinate 2",
main="Metric MDS", type="n")
text(x, y, labels = row.names(cor_mat), cex=.7)
##Amélioration graphique
mds2<-cmdscale(md2)%>%
as.tibble
colnames(mds2) <- c("Dim.1", "Dim.2")
ggscatter(mds2, x = "Dim.1", y = "Dim.2",
label = rownames(cor_mat),
size = 1,
repel = TRUE)
Source diff could not be displayed: it is too large. Options to address this: view the blob.
This diff is collapsed.
"annee","physique"
"1901
","Röntgen, Wilhelm Wilhelm Röntgen
"
"1902
","Lorentz, Hendrik Hendrik Lorentz ;Zeeman, Pieter Pieter Zeeman
"
"1903
","Becquerel, Henri Henri Becquerel ;Curie, Pierre Pierre Curie ;Curie, Marie Marie Curie
"
"1904
","Rayleigh, Lord Lord Rayleigh
"
"1905
","Lenard, Philipp Philipp Lenard
"
"1906
","Thomson, Joseph John Joseph John Thomson
"
"1907
","Michelson, Albert Abraham Albert Abraham Michelson
"
"1908
","Lippmann, Gabriel Gabriel Lippmann
"
"1909
","Braun, Karl Ferdinand Karl Ferdinand Braun ;Marconi, Guglielmo Guglielmo Marconi
"
"1910
","Waals, Johannes Diderik van der Johannes Diderik van der Waals
"
"1911
","Wien, Wilhelm Wilhelm Wien
"
"1912
","Dalén, Gustaf Gustaf Dalén
"
"1913
","Kamerlingh Onnes, Heike Heike Kamerlingh Onnes
"
"1914
","von Laue, Max Max von Laue
"
"1915
","Bragg, William Henry William Henry Bragg ;Bragg, William Lawrence William Lawrence Bragg
"
"1916
","
"
"1917
","Barkla, Charles Glover Charles Glover Barkla
"
"1918
","Planck, Max Max Planck
"
"1919
","Stark, Johannes Johannes Stark
"
"1920
","Guillaume, Charles Édouard Charles Édouard Guillaume
"
"1921
","Einstein, Albert Albert Einstein
"
"1922
","Bohr, Niels Niels Bohr
"
"1923
","Millikan, Robert Andrews Robert Andrews Millikan
"
"1924
","Siegbahn, Manne Manne Siegbahn
"
"1925
","Franck, James James Franck ;Hertz, Gustav Ludwig Gustav Ludwig Hertz
"
"1926
","Perrin, Jean Baptiste Jean Baptiste Perrin
"
"1927
","Compton, Arthur Arthur Compton ;Wilson, Charles Thomson Rees Charles Thomson Rees Wilson
"
"1928
","Richardson, Owen Willans Owen Willans Richardson
"
"1929
","Broglie, Louis de Louis de Broglie
"
"1930
","Raman, C. V. C. V. Raman
"
"1931
","
"
"1932
","Heisenberg, Werner Werner Heisenberg
"
"1933
","Schrödinger, Erwin Erwin Schrödinger ;Dirac, Paul Paul Dirac
"
"1934
","
"
"1935
","Chadwick, James James Chadwick
"
"1936
","Hess, Victor Francis Victor Francis Hess ;Anderson, Carl David Carl David Anderson
"
"1937
","Davisson, Clinton Clinton Davisson ;Thomson, George Paget George Paget Thomson
"
"1938
","Fermi, Enrico Enrico Fermi
"
"1939
","Lawrence, Ernest Ernest Lawrence
"
"1940
","
"
"1941
","
"
"1942
","
"
"1943
","Stern, Otto Otto Stern
"
"1944
","Rabi, Isidor Isaac Isidor Isaac Rabi
"
"1945
","Pauli, Wolfgang Wolfgang Pauli
"
"1946
","Bridgman, Percy Williams Percy Williams Bridgman
"
"1947
","Appleton, Edward Victor Edward Victor Appleton
"
"1948
","Blackett, Patrick Patrick Blackett
"
"1949
","Yukawa, Hideki Hideki Yukawa
"
"1950
","Powell, Cecil Frank Cecil Frank Powell
"
"1951
","Cockcroft, John John Cockcroft ;Walton, Ernest Ernest Walton
"
"1952
","Bloch, Felix Felix Bloch ;Purcell, Edward Mills Edward Mills Purcell
"
"1953
","Zernike, Frederik Frederik Zernike
"
"1954
","Born, Max Max Born ;Bothe, Walther Walther Bothe
"
"1955
","Lamb, Willis Willis Lamb ;Kusch, Polykarp Polykarp Kusch
"
"1956
","Bardeen, John John Bardeen ;Brattain, Walter Houser Walter Houser Brattain ;Shockley, William William Shockley
"
"1957
","Yang, Chen Ning Chen Ning Yang ;Lee, Tsung-Dao Tsung-Dao Lee
"
"1958
","Cherenkov, Pavel Pavel Cherenkov ;Frank, Ilya Ilya Frank ;Tamm, Igor Igor Tamm
"
"1959
","Segrè, Emilio G. Emilio G. Segrè ;Chamberlain, Owen Owen Chamberlain
"
"1960
","Glaser, Donald A. Donald A. Glaser
"
"1961
","Hofstadter, Robert Robert Hofstadter ;Mössbauer, Rudolf Rudolf Mössbauer
"
"1962
","Landau, Lev Lev Landau
"
"1963
","Wigner, Eugene Eugene Wigner ;Goeppert-Mayer, Maria Maria Goeppert-Mayer ;Jensen, J. Hans D. J. Hans D. Jensen
"
"1964
","Townes, Charles Hard Charles Hard Townes ;Basov, Nikolay Nikolay Basov ;Prokhorov, Alexandre Mikhaïlovitch Alexandre Mikhaïlovitch Prokhorov
"
"1965
","Tomonaga, Sin-Itiro Sin-Itiro Tomonaga ;Schwinger, Julian Julian Schwinger ;Feynman, Richard Richard Feynman
"
"1966
","Kastler, Alfred Alfred Kastler
"
"1967
","Bethe, Hans Hans Bethe
"
"1968
","Alvarez, Luis Walter Luis Walter Alvarez
"
"1969
","Gell-Mann, Murray Murray Gell-Mann
"
"1970
","Alfvén, Hannes Hannes Alfvén ;Néel, Louis Louis Néel
"
"1971
","Gabor, Dennis Dennis Gabor
"
"1972
","Bardeen, John John Bardeen ;Cooper, Leon Leon Cooper ;Schrieffer, John Robert John Robert Schrieffer
"
"1973
","Esaki, Leo Leo Esaki ;Giaever, Ivar Ivar Giaever ;Josephson, Brian David Brian David Josephson
"
"1974
","Ryle, Martin Martin Ryle ;Hewish, Antony Antony Hewish
"
"1975
","Bohr, Aage Aage Bohr ;Mottelson, Ben Roy Ben Roy Mottelson ;Rainwater, James James Rainwater
"
"1976
","Richter, Burton Burton Richter ;Ting, Samuel C. C. Samuel C. C. Ting
"
"1977
","Anderson, Philip Warren Philip Warren Anderson ;Mott, Nevill Francis Nevill Francis Mott ;van Vleck, John Hasbrouck John Hasbrouck van Vleck
"
"1978
","Kapitsa, Pyotr Pyotr Kapitsa ;Penzias, Arno Allan Arno Allan Penzias ;Wilson, Robert Woodrow Robert Woodrow Wilson
"
"1979
","Glashow, Sheldon Lee Sheldon Lee Glashow ;Salam, Abdus Abdus Salam ;Weinberg, Steven Steven Weinberg
"
"1980
","Cronin, James James Cronin ;Fitch, Val Logsdon Val Logsdon Fitch
"
"1981
","Bloembergen, Nicolaas Nicolaas Bloembergen ;Schawlow, Arthur Leonard Arthur Leonard Schawlow ;Siegbahn, Kai Kai Siegbahn
"
"1982
","Wilson, Kenneth G. Kenneth G. Wilson
"
"1983
","Chandrasekhar, Subrahmanyan Subrahmanyan Chandrasekhar ;Fowler, William Alfred William Alfred Fowler
"
"1984
","Rubbia, Carlo Carlo Rubbia ;van der Meer, Simon Simon van der Meer
"
"1985
","von Klitzing, Klaus Klaus von Klitzing
"
"1986
","Ruska, Ernst Ernst Ruska ;Binnig, Gerd Gerd Binnig ;Rohrer, Heinrich Heinrich Rohrer
"
"1987
","Bednorz, Johannes Georg Johannes Georg Bednorz ;Müller, Karl Alexander Karl Alexander Müller
"
"1988
","Lederman, Leon M. Leon M. Lederman ;Schwartz, Melvin Melvin Schwartz ;Steinberger, Jack Jack Steinberger
"
"1989
","Ramsey, Norman Foster Norman Foster Ramsey ;Dehmelt, Hans Georg Hans Georg Dehmelt ;Paul, Wolfgang Wolfgang Paul
"
"1990
","Friedman, Jerome Isaac Jerome Isaac Friedman ;Kendall, Henry Way Henry Way Kendall ;Taylor, Richard E. Richard E. Taylor
"
"1991
","Gennes, Pierre-Gilles de Pierre-Gilles de Gennes
"
"1992
","Charpak, Georges Georges Charpak
"
"1993
","Hulse, Russell Alan Russell Alan Hulse ;Taylor, Joseph Hooton Joseph Hooton Taylor
"
"1994
","Brockhouse, Bertram Bertram Brockhouse ;Shull, Clifford Clifford Shull
"
"1995
","Perl, Martin Lewis Martin Lewis Perl ;Reines, Frederick Frederick Reines
"
"1996
","Lee, David Morris David Morris Lee ;Osheroff, Douglas Douglas Osheroff ;Richardson, Robert Coleman Robert Coleman Richardson
"
"1997
","Chu, Steven Steven Chu ;Cohen-Tannoudji, Claude Claude Cohen-Tannoudji ;Phillips, William Daniel William Daniel Phillips
"
"1998
","Laughlin, Robert B. Robert B. Laughlin ;Störmer, Horst Ludwig Horst Ludwig Störmer ;Tsui, Daniel C. Daniel C. Tsui
"
"1999
","Hooft, Gerard 't Gerard 't Hooft ;Veltman, Martinus Martinus Veltman
"
"2000
","Alferov, Zhores Zhores Alferov ;Kroemer, Herbert Herbert Kroemer ;Kilby, Jack Jack Kilby
"
"2001
","Cornell, Eric Allin Eric Allin Cornell ;Ketterle, Wolfgang Wolfgang Ketterle ;Wieman, Carl Carl Wieman
"
"2002
","Davis Jr., Raymond Raymond Davis Jr. ;Koshiba, Masatoshi Masatoshi Koshiba ;Giacconi, Riccardo Riccardo Giacconi
"
"2003
","Abrikossov, Alekseï Alekseï Abrikossov ;Ginzburg, Vitaly Vitaly Ginzburg ;Leggett, Anthony James Anthony James Leggett
"
"2004
","Gross, David David Gross ;Politzer, Hugh David Hugh David Politzer ;Wilczek, Frank Frank Wilczek
"
"2005
","Glauber, Roy J. Roy J. Glauber ;Hall, John L. John L. Hall ;Hänsch, Theodor W. Theodor W. Hänsch
"
"2006
","Mather, John C. John C. Mather ;Smoot, George George Smoot
"
"2007
","Fert, Albert Albert Fert ;Grünberg, Peter Peter Grünberg
"
"2008
","Nambu, Yoichiro Yoichiro Nambu ;Kobayashi, Makoto Makoto Kobayashi ;Maskawa, Toshihide Toshihide Maskawa
"
"2009
","Kao, Charles K. Charles K. Kao ;Boyle, Willard S. Willard S. Boyle ;Smith, George E. George E. Smith
"
"2010
","Geim, Andre Andre Geim ;Novoselov, Konstantin Konstantin Novoselov"
"2011
","Perlmutter, Saul Saul Perlmutter ;Riess, Adam G. Adam G. Riess ;Schmidt, Brian Brian Schmidt
"
"2012
","Haroche, Serge Serge Haroche ; J. Wineland, David David J. Wineland
"
"2013
","Englert, François François Englert ;Higgs, Peter W. Peter W. Higgs
"
"2014
","Akasaki, Isamu Isamu Akasaki ;Amano, Hiroshi Hiroshi Amano ;Nakamura, Shuji Shuji Nakamura
"
"2015
","Kajita, Takaaki Takaaki KajitaMcDonald, Arthur B. Arthur B. McDonald
"
"2016
","David J. Thouless ;
Duncan Haldane ;
John M. Kosterlitz
"
"2017
","Rainer WeissBarry C. BarishKip Thorne
"
"2018
","Arthur AshkinGérard MourouDonna Strickland
"
"2019
","James PeeblesMichel MayorDidier Queloz
"
"2020
","Roger PenroseReinhard GenzelAndrea Ghez
"
This diff is collapsed.
## Méthode Reinert de classification
##
## Allocine french movie reviews : https://www.kaggle.com/djilax/allocine-french-movie-reviews
## Échantillon aléatoire de 2000 commentaires
## Chargement des extensions
library(quanteda)
library(rainette)
## Importation du corpus
## Sous Windows, ajouter encoding = "UTF-8"
d <- read.csv("allocine.csv")
This diff is collapsed.
## Méthode Reinert de classification
##
## Allocine french movie reviews : https://www.kaggle.com/djilax/allocine-french-movie-reviews
## Échantillon aléatoire de 2000 commentaires
## Chargement des extensions
library(quanteda)
library(rainette)
## Importation du corpus
## Sous Windows, ajouter encoding = "UTF-8"
d <- read.csv("allocine.csv")
## Création du corpus
corp <- corpus(d, text_field = "review")
## Longueur des commentaires
summary(nchar(corp))
## On filtre les commentaires selon leur longueur
corp <- corpus_subset(corp, nchar(corp) > 200)
## Segmentation
corp <- split_segments(corp, segment_size = 15)
## PREMIER ESSAI
## On n'enlève pas la ponctuation ni les mots-outils
tok <- tokens(corp, remove_punct = FALSE)
tok <- tokens_tolower(tok)
dtm <- dfm(tok)
dtm <- dfm_trim(dtm, min_docfreq = 20)
dtm
res <- rainette(dtm, k = 8)
rainette_explor(res, dtm, corp)
## DEUXIÈME ESSAI
## On enlève la ponctuation et les mots-outils
tok <- tokens(corp, remove_punct = TRUE)
tok <- tokens_tolower(tok)
tok <- tokens_replace(tok, "œuvre", "oeuvre")
tok <- tokens_replace(tok, "d'œuvre", "d'oeuvre")
tok <- tokens_remove(tok, stopwords("fr"))
dtm <- dfm(tok)
dtm <- dfm_trim(dtm, min_docfreq = 20)
dtm
res <- rainette(dtm, k = 8)
rainette_explor(res, dtm, corp)
## TROISIÈME ESSAI
## On splitte sur l'apostrophe
tok <- tokens(corp, remove_punct = TRUE)
tok <- tokens_tolower(tok)
tok <- tokens_split(tok, "'")
tok <- tokens_replace(tok, "œuvre", "oeuvre")
tok <- tokens_replace(tok, "d'œuvre", "d'oeuvre")
tok <- tokens_remove(tok, stopwords("fr"))
dtm <- dfm(tok)
dtm <- dfm_trim(dtm, min_docfreq = 20)
dtm
res <- rainette(dtm, k = 8)
rainette_explor(res, dtm, corp)
## QUATRIÈME ESSAI
## On rajoute un min_segment_size
tok <- tokens(corp, remove_punct = TRUE)
tok <- tokens_tolower(tok)
tok <- tokens_split(tok, "'")
tok <- tokens_replace(tok, "œuvre", "oeuvre")
tok <- tokens_replace(tok, "d'œuvre", "d'oeuvre")
tok <- tokens_remove(tok, stopwords("fr"))
dtm <- dfm(tok)
dtm <- dfm_trim(dtm, min_docfreq = 20)
dtm
res <- rainette(dtm, k = 8, min_segment_size = 10)
rainette_explor(res, dtm, corp)
## CINQUIÈME ESSAI
## On remplace le split apostrophe par une liste manuelle
tok <- tokens(corp, remove_punct = TRUE)
tok <- tokens_tolower(tok)
tok <- tokens_replace(tok, "œuvre", "oeuvre")
tok <- tokens_replace(tok, "d'œuvre", "d'oeuvre")
tok <- tokens_replace(tok, "l'homme", "homme")
tok <- tokens_replace(tok, "d'action", "action")
remove <- c(stopwords("fr"), "d'une", "d'un", "n'y", "qu'il", "m'a")
tok <- tokens_remove(tok, remove)
dtm <- dfm(tok)
dtm <- dfm_trim(dtm, min_docfreq = 20)
dtm
res <- rainette(dtm, k = 8, min_segment_size = 10)
rainette_explor(res, dtm, corp)
## SIXIÈME ESSAI : cooccurrences manuelles
tok <- tokens(corp, remove_punct = TRUE)
tok <- tokens_tolower(tok)
tok <- tokens_replace(tok, "œuvre", "oeuvre")
tok <- tokens_replace(tok, "d'œuvre", "d'oeuvre")
tok <- tokens_replace(tok, "l'homme", "homme")
tok <- tokens_replace(tok, "d'action", "action")
remove <- c(stopwords("fr"), "d'une", "d'un", "n'y", "qu'il", "m'a")
tok <- tokens_remove(tok, remove)
tok <- tokens_compound(tok, list(c("chef", "d'oeuvre")))
tok <- tokens_compound(tok, list(c("effets", "spéciaux")))
tok <- tokens_compound(tok, list(c("série", "b")))
tok <- tokens_compound(tok, list(c("mise", "scène")))
dtm <- dfm(tok)
dtm <- dfm_trim(dtm, min_docfreq = 20)
dtm
res <- rainette(dtm, k = 8, min_segment_size = 10)
rainette_explor(res, dtm, corp)
## SEPTIÈME ESSAI : cooccurrences "automatiques"
tok <- tokens(corp, remove_punct = TRUE, padding = TRUE)
tok <- tokens_tolower(tok)
tok <- tokens_replace(tok, "œuvre", "oeuvre")
tok <- tokens_replace(tok, "d'œuvre", "d'oeuvre")
tok <- tokens_replace(tok, "l'homme", "homme")
tok <- tokens_replace(tok, "d'action", "action")
remove <- c(stopwords("fr"), "d'une", "d'un", "n'y", "qu'il", "m'a")
tok <- tokens_remove(tok, remove, padding = TRUE)
coll <- quanteda.textstats::textstat_collocations(tok, min_count = 10)
coll
tok <- tokens_compound(tok, coll)
tok <- tokens_remove(tok, "")
tok <- tokens_compound(tok, list(c("mise", "scène")))
dtm <- dfm(tok)
dtm <- dfm_trim(dtm, min_docfreq = 20)
dtm
res <- rainette(dtm, k = 8, min_segment_size = 10)
rainette_explor(res, dtm, corp)
# Etc., etc.
## Méthode Reinert de classification
##
## Données issues du "Grand débat".
## Source : https://www.kaggle.com/jlesuffleur/granddebat
##
## Table DEMOCRATIE_ET_CITOYENNETE.csv dont on a conservé que deux colonnes et
## tiré un échantillon de 3000 lignes :
## - participation_elections : "Que pensez-vous de la participation des
## citoyens aux élections et comment les inciter à y participer davantage ?"
## - confiance_representation : "En qui faites-vous le plus confiance pour vous
## faire représenter dans la société et pourquoi ?"
## Chargement des extensions
library(quanteda)
library(rainette)
## IMPORT DES DONNÉES ----------------------------------
## Sous Windows, rajouter encoding = "UTF-8"
d <- read.csv("DEMOCRATIE_ET_CITOYENNETE_sample.csv")
## Méthode Reinert de classification
##
## Données issues du "Grand débat".
## Source : https://www.kaggle.com/jlesuffleur/granddebat
##
## Table DEMOCRATIE_ET_CITOYENNETE.csv dont on a conservé que deux colonnes et
## tiré un échantillon de 3000 lignes :
## - participation_elections : "Que pensez-vous de la participation des
## citoyens aux élections et comment les inciter à y participer davantage ?"
## - confiance_representation : "En qui faites-vous le plus confiance pour vous
## faire représenter dans la société et pourquoi ?"
## Chargement des extensions
library(quanteda)
library(rainette)
## IMPORT DES DONNÉES ----------------------------------
## Sous Windows, rajouter encoding = "UTF-8"
d <- read.csv("DEMOCRATIE_ET_CITOYENNETE_sample.csv")
## Liste des variables du tableau d
names(d)
## Création du corpus
corp <- corpus(d, text_field = "participation_elections")
## CORPUS NON SEGMENTÉ ---------------------------------
## Tokenization
tok <- tokens(corp, remove_punct = TRUE)
tok <- tokens_tolower(tok)
tok <- tokens_remove(tok, stopwords("fr"))
## Création de la DTM
dtm <- dfm(tok)
## Filtrage des termes apparaissant au moins dans 20 documents
dtm <- dfm_trim(dtm, min_docfreq = 20)
## Aperçu de la DTM et de ses dimensions
dtm
## Classification
res <- rainette(dtm, k = 8)
## Exploration des résultats
rainette_explor(res, dtm, corp)
## Génération du graphique en 6 classes
rainette_plot(res, dtm, k = 6)
## Récupération du groupe de chaque document en 6 classes
corp$groupe <- cutree(res, k = 6)
table(corp$groupe)
## Renommage des groupes
corp$groupe[corp$groupe == 1] <- "bonne_chose"
corp$groupe[corp$groupe == 2] <- "divers"
corp$groupe[corp$groupe == 3] <- "confiance"
corp$groupe[corp$groupe == 4] <- "éducation"
corp$groupe[corp$groupe == 5] <- "blancs"
corp$groupe[corp$groupe == 6] <- "obligatoire"
table(corp$groupe)
## Récupération des documents d'un groupe
corpus_education <- corpus_subset(corp, groupe == "éducation")
## CORPUS SEGMENTÉ ------------------------------------
## Découpage en segments
corp_seg <- split_segments(corp, segment_size = 10)
## Tokenisation
tok_seg <- tokens(corp_seg, remove_punct = TRUE)
tok_seg <- tokens_tolower(tok_seg)
tok_seg <- tokens_remove(tok_seg, stopwords("fr"))
## Calcul de la DTM
dtm_seg <- dfm(tok_seg)
dtm_seg <- dfm_trim(dtm_seg, min_docfreq = 10)
dtm_seg
## Classification sur les segments sans regroupement
res_seg <- rainette(dtm_seg, k = 8)
rainette_explor(res_seg, dtm_seg, corp_seg)
## Classification sur les segments avec regroupement
res_seg <- rainette(dtm_seg, k = 8, min_segment_size = 8)
rainette_explor(res_seg, dtm_seg, corp_seg)
## Récupération des groupes d'appartenance
corp_seg$groupe <- cutree(res_seg, k = 8)
table(corp_seg$groupe)
## Table du nombre de segments de chaque groupe pour chaque document
## d'origine
clusters_by_doc_table(corp_seg, "groupe")
clusters_by_doc_table(corp_seg, "groupe", prop = TRUE)
## Nombre de documents ayant au moins un segment de chaque classe
docs_by_cluster_table(corp_seg, "groupe")
## CDH DOUBLE --------------------------------------
## Première classification simple sur les segments
res8 <- rainette(dtm_seg, k = 8, min_segment_size = 8)
rainette_plot(res8, dtm_seg, k = 8)
## Deuxième classification simple sur les segments
res15 <- rainette(dtm_seg, k = 8, min_segment_size = 15)
rainette_plot(res15, dtm_seg, k = 8)
## Classification double
res_seg2 <- rainette2(dtm_seg, min_segment_size1 = 8, min_segment_size2 = 15, max_k = 8)
## Exploration des résultats
rainette2_explor(res_seg2, dtm_seg, corp_seg)
## Récupération des groupes d'appartenance
corp_seg$groupe2 <- cutree(res_seg2, k = 8)
## Nombre de documents ayant au moins un segment de chaque classe
docs_by_cluster_table(corp_seg, "groupe2")
## Méthode Reinert de classification
##
## "Robinson Crusoé - Tome I" de Daniel Defoe (1719), trad. fr. Petrus Borel (1836)
## Source : https://fr.feedbooks.com/book/5028/robinson-cruso%C3%A9-tome-i
## Chargement des extensions
library(quanteda)
library(rainette)
## Import des données
## Sous Windows, ajouter encoding = "UTF-8"
txt <- readLines("robinson_crusoe_t1.txt")
txt <- paste(txt, collapse = "\n")
## Méthode Reinert de classification
##
## "Robinson Crusoé - Tome I" de Daniel Defoe (1719), trad. fr. Petrus Borel (1836)
## Source : https://fr.feedbooks.com/book/5028/robinson-cruso%C3%A9-tome-i
## Chargement des extensions
library(quanteda)
library(rainette)
## Import des données
## Sous Windows, ajouter encoding = "UTF-8"
txt <- readLines("robinson_crusoe_t1.txt")
txt <- paste(txt, collapse = "\n")
cat(txt)
## Création du corpus
corp <- corpus(txt)
## Découpage du texte en segments
corp <- split_segments(corp, segment_size = 20)
## Tokenization
tok <- tokens(corp, remove_punct = TRUE, remove_numbers = TRUE, remove_symbols = TRUE)
tok <- tokens_tolower(tok)
tok <- tokens_split(tok, "'")
to_remove <- c(stopwords("fr"), "a", "ai")
## Création de la DTM
dtm <- dfm(tok)
dtm <- dfm_trim(dtm, min_docfreq = 5)
dtm
## Classification en 8 classes
res <- rainette(dtm, k = 8, min_segment_size = 20)
rainette_plot(res, dtm)
## Récupération des groupes en 8 classes
docvars(corp)$groupe <- cutree(res, k = 8)
## Graphique de la position des différentes classes dans le texte
docvars(corp)$groupe <- factor(docvars(corp)$groupe)
docvars(corp)$position <- seq_len(nrow(docvars(corp)))
library(ggplot2)
ggplot(docvars(corp)) +
geom_density(aes(x = position, fill = groupe), bw = 10) +
scale_fill_brewer(palette = "Set1") +
facet_grid(groupe~., scales = "free_y")
This diff is collapsed.
## Installation de la version de développement de rainette
options(repos = c(
juba = 'https://juba.r-universe.dev',
CRAN = 'https://cloud.r-project.org'))
install.packages('rainette')
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please to comment