Ce script succède au script LdC_annotation_V01_bc destiné à calculer les core de sentiments par différentes méthodes. On en explore ici la fiabilité par analyse des corrélation, puis la fabrication d’un indice synthètique.

Les outils de l’analyse

Le but de l’exercice est de mesurer le sentiment dans la période covid19 au travers des twits générés avec le hashtag #confinementjourxx qui signale clairement l’intention de donner son sentiment, son humeur, sa pensée, son expérience.

knitr::opts_chunk$set(echo = TRUE,include=TRUE, cache=TRUE, message=FALSE,warning=FALSE)
library(tidyverse) #l'environnement de base : données et visus

## -- Attaching packages ------------------------------------------------------------- tidyverse 1.3.0 --

## v ggplot2 3.3.0     v purrr   0.3.3
## v tibble  2.1.3     v dplyr   0.8.5
## v tidyr   1.0.2     v stringr 1.4.0
## v readr   1.3.1     v forcats 0.5.0

## Warning: package 'ggplot2' was built under R version 3.6.3

## Warning: package 'tidyr' was built under R version 3.6.3

## Warning: package 'dplyr' was built under R version 3.6.3

## Warning: package 'forcats' was built under R version 3.6.3

## -- Conflicts ---------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(rtweet) #extraction twitter

## 
## Attaching package: 'rtweet'

## The following object is masked from 'package:purrr':
## 
##     flatten

library(gridExtra) #associer des ggplot

## 
## Attaching package: 'gridExtra'

## The following object is masked from 'package:dplyr':
## 
##     combine

library(ggrepel) #pour une belle labelisation des xy

## Warning: package 'ggrepel' was built under R version 3.6.3

library(igraph) #pour l'analyse de réseau

## 
## Attaching package: 'igraph'

## The following objects are masked from 'package:dplyr':
## 
##     as_data_frame, groups, union

## The following objects are masked from 'package:purrr':
## 
##     compose, simplify

## The following object is masked from 'package:tidyr':
## 
##     crossing

## The following object is masked from 'package:tibble':
## 
##     as_data_frame

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

library(wesanderson)
library(scales) #pour les échelles de temps et de date

## Warning: package 'scales' was built under R version 3.6.3

## 
## Attaching package: 'scales'

## The following object is masked from 'package:purrr':
## 
##     discard

## The following object is masked from 'package:readr':
## 
##     col_factor

library(syuzhet)     # ncr

## 
## Attaching package: 'syuzhet'

## The following object is masked from 'package:scales':
## 
##     rescale

## The following object is masked from 'package:rtweet':
## 
##     get_tokens

library(tm)

## Loading required package: NLP

## 
## Attaching package: 'NLP'

## The following object is masked from 'package:ggplot2':
## 
##     annotate

library(quanteda) #with quanteda

## Warning: package 'quanteda' was built under R version 3.6.3

## Package version: 2.0.0

## Parallel computing: 2 of 8 threads used.

## See https://quanteda.io for tutorials and examples.

## 
## Attaching package: 'quanteda'

## The following objects are masked from 'package:tm':
## 
##     as.DocumentTermMatrix, stopwords

## The following objects are masked from 'package:NLP':
## 
##     meta, meta<-

## The following object is masked from 'package:igraph':
## 
##     as.igraph

## The following object is masked from 'package:utils':
## 
##     View

library(ggridges)
library(corrplot)

## corrplot 0.84 loaded

library(psych)

## Warning: package 'psych' was built under R version 3.6.3

## 
## Attaching package: 'psych'

## The following object is masked from 'package:syuzhet':
## 
##     rescale

## The following objects are masked from 'package:scales':
## 
##     alpha, rescale

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

library(reshape2)

## 
## Attaching package: 'reshape2'

## The following object is masked from 'package:tidyr':
## 
##     smiths

Lecture du fichier annoté.

df<- readRDS(file = "df_lsd.rds")

Analyse de la corrélation des indicateurs de sentiment

Nous disponsons de 3 méthodes ( ou trois dictionnaires) dont la caractéristique est de mesurer de manière distincte la valence positive et la valence négative.

nrc
Lsd fr
liwc

L’inspection visuelle de la matrice de corrélation montre que globalement les indicateurs de négativité sont intercorrélés, de même ceux de la positivité.

M<-subset(df, select=c(negative,émonég,Neg_lsdfr, positive,émopos,Pos_lsdfr))
R <- cor(M)
corrplot.mixed(R, order="hclust",number.cex=0.75, tl.cex=0.75)

Une analyse factorielle à deux composantes et rotation oblique, confirme la structure évidence : les trois méthodes vont dans le même sens. Mais les dimensions négative et positive sont largement indépendantes, seulement faiblement corrélées. Les opinions ne sont pas ou positive, ou négative ( négativement corrélée), elle peuvent l’être l’une et l’autre.

On peut donc envisager d’autres indicateurs :

un indicateur d’expressivité ( la somme des négatif et des positifs : Pos+Neg)
un indicateur de polarité (la différence des deux indicateurs : Pos-Neg)

# Maximum Likelihood Factor Analysis
# entering raw data and extracting 3 factors,
# with varimax rotation
fit <- factanal(M,2, rotation="promax")
print(fit, digits=2, sort=TRUE)

## 
## Call:
## factanal(x = M, factors = 2, rotation = "promax")
## 
## Uniquenesses:
##  negative    émonég Neg_lsdfr  positive    émopos Pos_lsdfr 
##      0.59      0.72      0.34      0.73      0.76      0.39 
## 
## Loadings:
##           Factor1 Factor2
## negative   0.63          
## émonég     0.54          
## Neg_lsdfr  0.81          
## Pos_lsdfr          0.77  
## positive           0.50  
## émopos             0.50  
## 
##                Factor1 Factor2
## SS loadings       1.35    1.11
## Proportion Var    0.22    0.18
## Cumulative Var    0.22    0.41
## 
## Factor Correlations:
##         Factor1 Factor2
## Factor1    1.00   -0.17
## Factor2   -0.17    1.00
## 
## Test of the hypothesis that 2 factors are sufficient.
## The chi square statistic is 2986.79 on 4 degrees of freedom.
## The p-value is 0

Un alpha de conbach montre le faible valeur au regard des standard psychométriques. Mais demande une réévaluation par la nature des données et l’échelle. Les valeurs standardisée sont de 0,68 et de 0.60.

alpha<-alpha(M[,1:3])
#t(alpha[["total"]])
t(alpha[["alpha.drop"]])

##             negative      émonég   Neg_lsdfr
## raw_alpha 0.42056074 0.664841331 0.407450548
## std.alpha 0.59308576 0.683935562 0.495045176
## G6(smc)   0.42155075 0.519682428 0.328943546
## average_r 0.42155075 0.519682428 0.328943546
## S/N       1.45752026 2.163911786 0.980375180
## alpha se  0.00135895 0.001248684 0.001776869
## var.r             NA          NA          NA
## med.r     0.42155075 0.519682428 0.328943546

alpha<-alpha(M[,4:6])
#t(alpha[["total"]])
t(alpha[["alpha.drop"]])

##              positive      émopos   Pos_lsdfr
## raw_alpha 0.284901608 0.552446203 0.244465012
## std.alpha 0.550125570 0.570450449 0.393888612
## G6(smc)   0.379429804 0.399042096 0.245243646
## average_r 0.379429804 0.399042096 0.245243646
## S/N       1.222842495 1.328020129 0.649861759
## alpha se  0.001159307 0.001675861 0.001657614
## var.r              NA          NA          NA
## med.r     0.379429804 0.399042096 0.245243646

Elargissons l’analyse aux émotions qui sont elles-mêmes certainement polarisées, à l’exception de la surprise et de l’anticipation qui sont aussi corrélés positivement aux émotions négative.

M<-subset(df, select=c(Neg_lsdfr,émonég,negative,anger, disgust, fear, sadness,surprise,anticipation,trust,joy,positive,émopos,Pos_lsdfr))
R <- cor(M)
corrplot.mixed(R, order="hclust",number.cex=0.75, tl.cex=0.75)

Mais c’est finalement une solution à deux facteurs qui ressort. ( la solution à 3 facteurs est " dégénérée")

# Maximum Likelihood Factor Analysis
# entering raw data and extracting 3 factors,
# with varimax rotation
fit <- factanal(M,2, rotation="promax", scores = "regression")
print(fit, digits=2, sort=TRUE)

## 
## Call:
## factanal(x = M, factors = 2, scores = "regression", rotation = "promax")
## 
## Uniquenesses:
##    Neg_lsdfr       émonég     negative        anger      disgust         fear 
##         0.73         0.86         0.19         0.30         0.50         0.28 
##      sadness     surprise anticipation        trust          joy     positive 
##         0.38         0.63         0.59         0.53         0.34         0.33 
##       émopos    Pos_lsdfr 
##         0.89         0.82 
## 
## Loadings:
##              Factor1 Factor2
## Neg_lsdfr     0.51          
## negative      0.90          
## anger         0.85          
## disgust       0.72          
## fear          0.86          
## sadness       0.79          
## anticipation          0.63  
## trust                 0.69  
## joy          -0.11    0.84  
## positive              0.83  
## émonég        0.39          
## surprise      0.28    0.46  
## émopos                0.34  
## Pos_lsdfr             0.42  
## 
##                Factor1 Factor2
## SS loadings       3.92    2.78
## Proportion Var    0.28    0.20
## Cumulative Var    0.28    0.48
## 
## Factor Correlations:
##         Factor1 Factor2
## Factor1    1.00   -0.28
## Factor2   -0.28    1.00
## 
## Test of the hypothesis that 2 factors are sufficient.
## The chi square statistic is 164328.8 on 64 degrees of freedom.
## The p-value is 0

les alphas de cronbach remontent en flèche, on est à 0.81 et 0,89 pour le négatif soit d’exellent score pour des mesures multiméthodes. Le sentiment standard doivent donc être construit de manière synthétique.

alpha<-alpha(M[,1:7])
t(alpha[["total"]])

##                     
## raw_alpha 0.75198273
## std.alpha 0.87653087
## G6(smc)   0.88339402
## average_r 0.50351760
## S/N       7.09919070
## ase       0.00071059
## mean      0.60290500
## sd        0.88982904
## median_r  0.51968243

alpha[["alpha.drop"]]

##           raw_alpha std.alpha   G6(smc) average_r      S/N     alpha se
## Neg_lsdfr 0.7119968 0.8758323 0.8771080 0.5403576 7.053626 0.0008468634
## émonég    0.8769220 0.8920696 0.8903044 0.5793970 8.265234 0.0003228147
## negative  0.6630349 0.8345246 0.8361001 0.4566789 5.043193 0.0009117991
## anger     0.7050637 0.8455259 0.8477082 0.4770594 5.473578 0.0008248729
## disgust   0.7300115 0.8586684 0.8665516 0.5031286 6.075560 0.0007880859
## fear      0.7029142 0.8465958 0.8470871 0.4791090 5.518725 0.0008193283
## sadness   0.7105752 0.8516148 0.8585803 0.4888927 5.739218 0.0008130091
##                var.r     med.r
## Neg_lsdfr 0.03749541 0.6142990
## émonég    0.02091091 0.6142990
## negative  0.02550413 0.3881408
## anger     0.02863775 0.4215508
## disgust   0.03612574 0.4215508
## fear      0.02625294 0.4215508
## sadness   0.03192819 0.4215508

alpha<-alpha(M[,8:14])
t(alpha[["total"]])

##                      
## raw_alpha 0.559617331
## std.alpha 0.800919297
## G6(smc)   0.805720897
## average_r 0.364969267
## S/N       4.023088539
## ase       0.001081396
## mean      0.755142112
## sd        0.871273475
## median_r  0.360735411

alpha[["alpha.drop"]]

##              raw_alpha std.alpha   G6(smc) average_r      S/N     alpha se
## surprise     0.5375966 0.7881882 0.7884063 0.3827905 3.721173 0.0011272913
## anticipation 0.5186547 0.7710933 0.7737172 0.3595623 3.368592 0.0011254078
## trust        0.4973437 0.7632772 0.7653357 0.3495476 3.224349 0.0011532288
## joy          0.5037188 0.7440412 0.7403826 0.3263634 2.906879 0.0011628024
## positive     0.4561518 0.7434163 0.7358436 0.3256430 2.897364 0.0011613737
## émopos       0.7978198 0.8105087 0.8055325 0.4161883 4.277286 0.0005598397
## Pos_lsdfr    0.4963618 0.7964283 0.7925559 0.3946898 3.912273 0.0012421639
##                   var.r     med.r
## surprise     0.02499211 0.3794298
## anticipation 0.02456443 0.3296494
## trust        0.02522015 0.3607354
## joy          0.01945253 0.3296494
## positive     0.01870871 0.3186152
## émopos       0.02157372 0.4211725
## Pos_lsdfr    0.02690379 0.4211725

La stabilité des corrélations dans le temps

Pour tester la stabilité de la structure dans le temps, on examine simplement les corrélations à trois moments : au 2ème , 8 ème et 20èmes jours. Elles ne bougent quasiment pas, la structure de corrélation est extrêmement stable.

df$day<-as.numeric(format(df$created_at, "%d")) # jour
df$month<-as.numeric(format(df$created_at, "%m")) # mois
df$hour<-as.numeric(format(df$created_at, "%H")) # heure
df$year<-2020 # heure


df<- df %>% mutate(Jour=ifelse(month == 3,day-16 ,ifelse(month==4,day+15,0) ))
Jour2 <- c(2,8,20)
for (val in Jour2) {
  M<-df %>% filter(Jour==val)%>%select(negative,émonég,Neg_lsdfr, positive,émopos,Pos_lsdfr)
  R <- cor(M)
  print(R)
  corrplot.mixed(R, order="hclust",number.cex=0.75, tl.cex=0.75)
}

##             negative       émonég  Neg_lsdfr    positive       émopos
## negative  1.00000000 3.073505e-01 0.51397276 0.181997062 2.500837e-02
## émonég    0.30735045 1.000000e+00 0.42176482 0.004453558 1.960396e-05
## Neg_lsdfr 0.51397276 4.217648e-01 1.00000000 0.148015397 2.159458e-02
## positive  0.18199706 4.453558e-03 0.14801540 1.000000000 2.593458e-01
## émopos    0.02500837 1.960396e-05 0.02159458 0.259345849 1.000000e+00
## Pos_lsdfr 0.13073447 1.280499e-02 0.16789386 0.398593652 3.941966e-01
##            Pos_lsdfr
## negative  0.13073447
## émonég    0.01280499
## Neg_lsdfr 0.16789386
## positive  0.39859365
## émopos    0.39419660
## Pos_lsdfr 1.00000000

##             negative      émonég Neg_lsdfr    positive     émopos  Pos_lsdfr
## negative  1.00000000 0.347148985 0.5239372 0.162926925 0.03255581 0.14304078
## émonég    0.34714899 1.000000000 0.4398696 0.006980741 0.01184466 0.01792159
## Neg_lsdfr 0.52393724 0.439869604 1.0000000 0.147769569 0.02713440 0.16473233
## positive  0.16292692 0.006980741 0.1477696 1.000000000 0.26028787 0.40204519
## émopos    0.03255581 0.011844657 0.0271344 0.260287872 1.00000000 0.39279216
## Pos_lsdfr 0.14304078 0.017921591 0.1647323 0.402045192 0.39279216 1.00000000

##            negative       émonég  Neg_lsdfr  positive       émopos  Pos_lsdfr
## negative  1.0000000  0.340911889 0.52042819 0.1641661  0.028369000 0.14830321
## émonég    0.3409119  1.000000000 0.44873995 0.0132782 -0.009214886 0.03069551
## Neg_lsdfr 0.5204282  0.448739953 1.00000000 0.1293492  0.035548611 0.20787526
## positive  0.1641661  0.013278199 0.12934921 1.0000000  0.231851618 0.40552779
## émopos    0.0283690 -0.009214886 0.03554861 0.2318516  1.000000000 0.39402762
## Pos_lsdfr 0.1483032  0.030695506 0.20787526 0.4055278  0.394027615 1.00000000

l’évolution des scores de sentiment

On calcule donc le sentiment à partir d’un simple index sous la forme d’une somme ( score total) (les alternatives sont de retenir les deux premiers facteur, mais on perd de l’information avec la normalisation).

On en calcule les moyennes horaires, tri-quotidiennes, et quotidiennes.

heure par heure

On doit s’interroger sur le caractère stationnaire de la série mesurée à l’échelle de l’heure, même si on semble observé des pics à certain moment. L’aiguille s’affole–t-elle suite à certains évément? La courbe des sentiments positifs est plus heurtée que celle des négatifs. Dans une autre étude, nous aurons à explorer plus en profondeur la structure des auto et cross corrélations.

La stationnarité incite à penser à ce que le processus est dominé par une normes de styles que des chocs extérieurs pertubent le temps de quelques heures avant de retrouver une ligne de base.

sentevol<-df %>% mutate( positif=surprise+anticipation+trust+joy+positive+émopos+Pos_lsdfr , 
                         negatif =Neg_lsdfr+émonég+negative,anger+disgust+fear+sadness ) %>% 
  group_by(year,month,day,hour) %>% 
  mutate(n=1) %>%
  summarise(positif=mean(positif,na.rm=TRUE),negatif=mean(negatif, na.rm=TRUE), n=sum(n)) %>% ungroup()

sentevol$date<-paste0("2020","-",sentevol$month,"-",sentevol$day," ",sentevol$hour,":00:00")

sentevol$date2 <- as.POSIXct(strptime(sentevol$date, "%Y-%m-%d %H:%M:%S"))

foo<-sentevol%>%select(date2, negatif,positif)

foo<-melt(foo, id=c("date2"))
ggplot(foo, aes(x=date2,y=value,group=variable))+
  geom_line(size=1,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 60, vjust = 0.5))+ 
  theme_minimal()+ stat_smooth(  aes(color =variable, fill = variable),  method = "gam")+
  labs(x = NULL, y = NULL,
    title = "Evolution de la valence du sentiment du confinement", y="Valence (+/-)",x="dates (par heures)",
    subtitle = "Valence par heure",
    caption = "\nSource: Data collected by Benavent C. from Twitter's REST API via rtweet"
  )+  scale_x_datetime(date_breaks = "1 day",minor_breaks=NULL, labels = scales::label_date_short())+ facet_wrap(vars(variable),ncol=1)+ theme(axis.title.x = element_text(size = .5, angle = 00))

de 8 h en 8h

A cette échelle il semble qu’un cyclicité se manifeste pour les sentiments positifs.

df$ampm<-0

df$ampm[df$hour<4 | df$hour>19]<-4
df$ampm[df$hour>3 & df$hour<12 ]<-12
df$ampm[df$hour>11 & df$hour<20 ]<-20

ggplot(df, aes(x=ampm))+geom_bar()

sentevol<-df %>% mutate( positif=surprise+anticipation+trust+joy+positive+émopos+Pos_lsdfr , 
                         negatif =Neg_lsdfr+émonég+negative,anger+disgust+fear+sadness ) %>% 
  group_by(year,month,day,ampm) %>% 
  mutate(n=1) %>%
  summarise(positif=mean(positif,na.rm=TRUE),negatif=mean(negatif, na.rm=TRUE), n=sum(n))

sentevol$date<-paste0("2020","-",sentevol$month,"-",sentevol$day," ",sentevol$ampm,":00:00")
sentevol$date2 <- as.POSIXct(strptime(sentevol$date, "%Y-%m-%d %H"))

foo<-sentevol %>%ungroup()%>% select(date2, negatif,positif)

foo<-melt(foo, id=c("date2"))
ggplot(foo, aes(x=date2,y=value,group=variable))+
  geom_line(size=1,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 60, vjust = 0.5))+ 
  theme_minimal()+ 
  stat_smooth( aes(color =variable, fill = variable),  method = "loess")+
  labs(x = NULL, y = NULL,
    title = "Evolution de la valence du sentiment du confinement", y="Valence (+/-)",x="dates (par heures)",
    subtitle = "Valence par 6 heure",
    caption = "\nSource: Data collected by Benavent C. from Twitter's REST API via rtweet"
  )+ scale_x_datetime(date_breaks = "1 day", labels = scales::label_date_short())

De jour en jour

A l’échelle du jour des évolutions de plus long terme semblent se manifester. Pour le sentiment positif après une phase de déclin l’optimisme semble revenir. Le sentiment négatif s’accentue avec le temps même s’il semble se stabiliser depuis le jour 15, voir même légèrement se réduire en intensité. Le bilan est un écart croissant. Il peut rendre compte d’une atmosphère plombée dans laquelle l’accroissement du sentiment positif, n’est peut être que le fruit de l’humour et de la dérision qui règnent en maîtres dans les temps de stress.

Dans cette représentation, les mesures sont les écarts de score par rapport à la première observation. On met en valeur les trajectoires plus que les niveaux.

sentevol<-df %>% mutate( positif=surprise+anticipation+trust+joy+positive+émopos+Pos_lsdfr , negatif =Neg_lsdfr+émonég+negative,anger+disgust+fear+sadness ) %>% 
  group_by(Jour) %>% 
  mutate(n=1) %>%
  summarise(positif=mean(positif,na.rm=TRUE),negatif=mean(negatif, na.rm=TRUE), n=sum(n))

foo<-sentevol %>% ungroup %>%select(Jour, positif,negatif) %>%mutate (positif=positif-first(positif), negatif=negatif-first(negatif))
#expression=positive+negative, polarity=positive-negative
library(reshape2)
foo<-melt(foo, id=c("Jour")) %>%filter(Jour<23)
ggplot(foo, aes(x=Jour,y=value,group=variable))+
  geom_line(size=1,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 60, vjust = 0.5))+ 
  theme_minimal() + #stat_smooth(  aes(color =variable, fill = variable),  method = "loess")+
  labs(x = NULL, y = NULL,
    title = "Evolution de la valence du sentiment du confinement", y="Valence (+/-)",x="dates (par heures)",
    subtitle = "Ecart de Valence relative à J1 : moyennes Journalières",
    caption = "\nSource: Data collected by #LaboduConfinement from Twitter's REST API via rtweet"
  )+geom_smooth(method="loess", aes(color=variable))+ylim(-0.3,+0.8)

Expressivité et polarité

Et pour finir, l’indicateur alternatif qui s’exprime en expressivité et en polarité. Le Jour 3 et le jour 20 ont été particulièrement expressifs. Ces pics correspondent dans un cas à un accroissement de la polarité positive, dans l’autre à une stabilisation voire une diminution.

C’est une grille d’analyse à approfondir. Le sentiment n’est pas tant un jugement durable (une attitude) que la réaction émotionnelle à l’événement et à son commentantaire. Son intensité est peutêtre plus importante que sa polarité, sauf si elle varier considérablement au moemnt où l’expressivité et dans sa pleine acuité. Quand l’evenement est fort on répond autant en se roulant de rire, en branchissant des break events, qu’en pleurant des larmes de rivières, ce que nous apprend l’analyse des émos.

ggplot(foo, aes(x=Jour,y=value,group=1))+
  geom_line(size=1,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 60, vjust = 0.5))+ 
  theme_minimal() + #stat_smooth(  aes(color =variable, fill = variable),  method = "loess")+
  labs(x = NULL, y = NULL,
    title = "Evolution de l'expressivité et de la polarité du sentiment du confinement", y="Valence (+/-)",x="dates (par heures)",
    subtitle = "Intensité par Jour",
    caption = "\nSource: Data collected by #LaboduConfinement \n from Twitter's REST API via rtweet")+
  facet_wrap(vars(variable),ncol=1, scales="free")

Laboratoire du Confinement

Fiabilité du sentiment

CB

12 mars 2020