Italie

Ce script est une exploration de l’intérêt des données sociales pour l’étude des phénomènes humains. Celui qui nous intéresse, l’épidémie de covid19, est à l’évidence majeur. C’est un choc inattendu, un cygne noir.

Ses conséquences sont sanitaires, sociales, politiques et économiques. La manière dont les gens le vivent, du moins en France résulte d’un régime d’exception, largement adopté à travers les pays, qui vise à maintenir au domicile toutes les personnes non nécessaires au traitement de la question sanitaire, de celle de l’approvisionnement alimentaire et pharmaceutiques, et des productions fondamentales.

L’expérience vécue est celle du confinement. Une recommandation devenue obligation à rester chez soi, un dispositif réglementaire qui contrôle, nudge et sanctionne, une privation, espérons temporaire, de liberté de déplacement. Une vie sociale confinée au foyer et aux moyens de communiquer. Les mots du confinement sont bien rendu par autourdumot, et il est utile d’en revenir à sa définition

Un des réseaux où les états d’âmes peuvent s’exprimer librement est naturellement Twitter. Très rapidement a émergé un hashtag #confinementjour1 puis 2 et 3, et voué à de longs jours. Il cristalise les intentions de dire son expérience et de partager ses états d’âmes. L’humour y a une place importante. C’est ce canal que nous allons utiliser pour tester la sensibilité des instruments de mesure du sentiment, et, espérons, mieux comprendre la réaction des populations à un choc anthropologique brutal (le choc c’est la rencontre d’une société avancée et mobile, et d’une contingence naturelle : un virus qui circule de bouche en bouche et se deplace en business class).

Pour les données factuelles, le dashboard de la John Hopskins University restera un cas d’école en matière d’open dat , l’initiative du geg au travers de son site le grand continent est similaire et remarquable. Ils sont notre inspiration pour un processus qui vise à intégrer la collecte, le traitement et la repropagation des données.

Nous nous intéresserons mois au virus et à la maladie, moins au choc économique et social que le confinement va produire, qu’à la manière dont les gens vivent ce choc jour après jour, en capturant l’écume sociale et en tentant d’y mesurer les sentiments, les émotions et les préoccupations.

On va lancer nos filets de pêche dans ce petit courant, en espérant que ce sera un caillou de plus pour retrouver le chemin d’une humanité en bonne santé.

L’approche dans ce script est principalement baromètrique. On cherche simplement à représenter l’évolution des indicateurs dans le temps d’abord à une échelle horaire, puis journalière.

Les outils de l’analyse

Le but de l’exercice est de mesurer le sentiment dans la période de confinement décidée par l’Etat pour lutter contre l’épidémie de covid19, au travers des tweets générés avec le hashtag #confinementjourxx qui signale clairement l’intention de partager son sentiment, son humeur, sa pensée, son expérience, ses états d’âme.

C’est un fil tenu qui nous semble-t-il significatif, moins au sens de la représentation de l’humeur générale que d’une cohérence éditoriale. Il s’inscrit dans un projet expressif assez bien identifiable et se révèlent une convention capable de durer quotidiennent dans les trending-topic de twitter.

A cette fin on utilise les packages suivants.

La collecte des données

On utilise l’API de twitter via le package rtweet pour aller chercher les tweets contenant le hashtag “confinementjour$”

Les limites de l’API free de twitter sont de 15000 requêtes par 15mn, on emploie donc le paramètre retryonratelimit = TRUE pour poursuivre la requête en supportant la latence. Celà représente facilement quelques heures de requêtage. On sauvegarde donc rapidement le résultat dans un fichier fixe, qu’on pourra rappeler plus tard pour analyse, avec la fonction write_rds.

On a commencé à capturer les données le 9ème jour, puis chaque jour sur le jour de la veille. Au 15 jours on est 1, 1 millions de tweet, avec un flux journalier de l’ordre de 50 k.

IMPORTANT : on exclue les retweets, mais il peut être utile de regarder aussi avec le corpus total : il est possible que par un effet de renforcement la tendance de la production primaire ne soit pas celle de la production secondaire. Les suiveurs peuvent selectionner dans le registre de la production certains éléments qui leurs plaisent. Et imposer une sorte de torsion. C’est un sujet d’étude à développer.

L’ évolution quantitative des tweets

On retrace ici la production quotidiennes des tweets, rt quotes et reply. On notera qu’en journée l’échantillon représente plusieurs milliers d’observations à l’heure ce qui assure une grande sensibilité des mesures. On utilise ts_plot.

On observe un effet d’usure, un rebond le dimanche, et un cycle quotidien. Aux premiers jours il semble qu’on postait plus le matin que le soir, après quelques jours la tendance s’est renversée.

## plot time series of tweets
ts_plot(df_nrc, "1 hours", color="darkblue") +
  ggplot2::theme_minimal() +
  ggplot2::theme(plot.title = ggplot2::element_text(face = "bold")) +
  ggplot2::labs(
    x = NULL, y = NULL,
    title = "Fréquence des posts twitters sur #confinementjour",
    subtitle = "Nombre de tweets par 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())

Annotations

L’analyse du sentiment peut se faire avec plusieurs outils, nous employons ceux-ci :

  • le NCR avec le package syuzhet
  • le liwc via quanteda
  • le lsdfr

voir le script calcul pour le détail de la mise en oeuvre de ces procédures.

Un des objectifs est de faire une analyse de fiabilité des indicateurs de sentiments.On complète avec les émotion et les sujets de préoccupation.

L’unité de temps est l’heure dans un premier temps, et la journée. Des échelles intermédiaires pourront être développées.

Un contrôle pour les calcul intermédiaires en échantillonnant.

Analyse des résultats du NRC

On commence par l’analyse du sentiment simple, puis à celui des émotions.

La distribution des sentiments positifs et négatifs

Avec l’outil NCR deux indicateurs sont fournis: la densité de termes positifs et de termes négatifs, exprimé en nombre de mots d’un texte qui ont une valence ou positive, ou negative. Ce sont donc comme deux séries distinctes.

Examinons d’abord la distribution des émotions négatives et positives. On examine dans la foulée leur distribution conjointe.

https://a-little-book-of-r-for-time-series.readthedocs.io/en/latest/src/timeseries.html

par convention le zero est partagé entre les positive et les negatifs

#statistiques : moyenne et ecartype
s_mean1<-round(mean(df_nrc$negative),2)
s_mean2<-round(mean(df_nrc$positive),2)

s_std1<-round(sd(df_nrc$negative),2)
s_std2<-round(sd(df_nrc$positive),2)

#histogram
g1<-ggplot(df_nrc, aes(x=negative))+
  geom_histogram(binwidth=1,fill="red")+
  theme_minimal()+ scale_x_reverse()+
  ggplot2::annotate("text", x=7, y=200000, label= paste0("moyenne=",s_mean1," \n ecart type",s_std1))

g2<-ggplot(df_nrc, aes(x=positive))+
  geom_histogram(binwidth=1,fill="darkgreen")+
  theme_minimal()+xlim(-1,15)+
  ggplot2::annotate("text", x=7, y=200000, label= paste0("moyenne=",s_mean2," \n ecart type",s_std2))
grid.arrange(g1,g2,ncol=2)

ggplot(df_nrc,aes(x=positive, y=negative))+geom_point(position="jitter")+theme_minimal()+geom_smooth(method="gam")

L’évolution au cours du temps

On represente ici l’évolution des scores de positivité et de négativité, ainsi que leur différence qui donne le sentiment moyen si on pense que les points négatifs éffacent les points positifs. On garde en tête l’idée de ce carré magique que le négatif n’est pas que l’antonyme du positif.

sentevol<-df_nrc %>% group_by(month,day,hour) %>% mutate(n=1) %>%summarise(positive=mean(positive, na.rm=TRUE),negative=mean(negative, na.rm=TRUE), n=sum(n))
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 %>% ungroup %>%select(date2, negative,positive) %>% mutate(negative=-1*negative, sentiment=positive+negative)

library(reshape2)
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 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())

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


df_nrc<- df_nrc %>% mutate(Jour=ifelse(month == 3,day-16 ,ifelse(month==4,day+15,0) ))

ggplot(df_nrc,aes(x=Jour))+
  geom_bar(fill="gold4")+ 
  theme_minimal()+ 
  labs(title="# de tweets par jour")+
  facet_wrap(vars(is_retweet),ncol=1,scales="free")

sentevol<-df_nrc %>% group_by(Jour) %>% mutate(n=1) %>%summarise(positive=mean(positive, na.rm=TRUE),negative=mean(negative, na.rm=TRUE), n=sum(n))

foo<-sentevol %>% ungroup %>%select(Jour, negative,positive) %>% mutate(negative=-1*negative, sentiment=positive+negative)

library(reshape2)
foo<-melt(foo, id=c("Jour")) %>%filter(Jour<33)
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 = "Valence par heure",
    caption = "\nSource: Data collected by Benavent C. from Twitter's REST API via rtweet"
  )

un peu d’analyse des auto-corrélations et des corrélations croisées ou comment analyser les relations de la peine et du bonheur. IL nous faut deux grilles théoriques.

  • grille 1 : plus on est heureux moins on est négatif : une logique de balance ou de compensation qui se justifie par une logique d’effort, pour un niveau d’éffort donné on reparti sont expression entre l’affirmation de l’espoir et la distillation de rancoeur.
  • grille 2 : plus on est heureux plus on est négatif (moins on est heureux et moins on se plaint) : une logique d’expression ou de verbalisation qui oppose le silence à la protestation pour reprendre les catégories de Hisrchman. Ce qui prosteste ne sont pas forcement ceux qui souffre le plus.

Pour des idées de code :

http://r-statistics.co/Time-Series-Analysis-With-R.html

https://a-little-book-of-r-for-time-series.readthedocs.io/en/latest/src/timeseries.html

#tt <- ts(foo$sentiment,start=c(2020,firstHour),frequency=24*365)

l’analyse des émotions (NCR):

On se concentre sur les 8 facettes de l’émotion telle que conceptualisée par Plutchik (@plutchik_psychoevolutionary_1982), on reprend les définitions en anglais :

  • "trust goes from acceptance to admiration
  • fear goes from timidity to terror
  • surprise goes from uncertainty to amazement
  • sadness goes from gloominess to grief
  • disgust goes from dislike to loathing
  • anger goes from annoyance to fury
  • anticipation goes from interest to vigilance
  • joy goes from serenity to ecstasy"

et en francais

  • "la confiance va de l’acceptation à l’admiration
  • la peur va de la timidité à la terreur
  • la surprise va de l’incertitude à l’étonnement
  • la tristesse va de la morosité au chagrin
  • le dégoût va de l’aversion à la répugnance
  • la colère va de l’agacement à la fureur
  • l’anticipation va de l’intérêt à la vigilance
  • La joie va de la sérénité à l’extase".

Elle est mesurée sur la base des textes par l’outil NCR élaborée par Mohammad Saif, pour le français voir.

On peut raisonner en part relative des émotions dans le mesure où l’outil NCR compte les éléments probables de chacune des émotions. Un même texte peut être sujet à plusieurs émotions. Certains ne le seront à aucune et seront donc neutre. La somme des scores d’émotion mesure d’une certaine manière l’expressivité des textes, leur écart à une langue de type administrative qui tente de liquider tout terme expressif et émotionnel. Nous utiliserons cette propriété.

emoevol<-df_nrc %>% group_by(month,day,hour) %>% mutate(n=1) %>% 
  summarise(anger=mean(anger,na.rm=TRUE), 
            anticipation=mean(anticipation, na.rm=TRUE),
            disgust=mean(disgust, na.rm=TRUE),
            fear=mean(fear, na.rm=TRUE),
            joy=mean(joy, na.rm=TRUE),
            sadness=mean(sadness, na.rm=TRUE),
            surprise=mean(surprise, na.rm=TRUE),
            trust=mean(trust, na.rm=TRUE),
            n=sum(n))
emoevol$date<-paste0("2020","-",emoevol$month,"-",emoevol$day," ",emoevol$hour,":00:00")
emoevol$date2 <- as.POSIXct(strptime(emoevol$date, "%Y-%m-%d %H:%M:%S"))

foo<-emoevol %>% ungroup %>%select(date2, anger,fear,disgust, sadness ,surprise,anticipation,trust, joy )

emocol<-c("red3","orangered1","purple3","royalblue3","chartreuse","olivedrab3","green4","yellow") #en respectant des codes mais il faudra adoucir.
#la distribution des émotions
  

foo<-melt(foo, id=c("date2"))

#foo$variable2<-factor(foo$variable, ordered = TRUE,levels = c("joy","trust","anticipation","surprise","sadness","disgust","fear","anger"))

ggplot(foo, aes(x=date2,y=value,group=variable))+
  geom_line(size=1,aes(color=variable),show.legend = FALSE)+
  theme(axis.text.x=element_text(angle = 90, vjust = 0.5))+ 
  theme_minimal()+ stat_smooth(method = "gam", aes(color=variable)  )+
  labs(title="Les émotions des tweets #ConfinementJour", y="Intensité moyenne (par heure)",x=NULL,caption= "Définitions Plutchik (82) - operationalisation via NRC - lissage GAM:
 - la confiance va de l'acceptation à l'admiration
 - la peur passe de la timidité à la terreur
 - la surprise va de l'incertitude à l'étonnement
 - la tristesse passe de la morosité au chagrin
 - le dégoût va de l'aversion à la répugnance
 - la colère passe de l'agacement à la fureur
 - l'anticipation va de l'intérêt à la vigilance
 - La joie passe de la sérénité à l'extase
 \n \nSource: Data collected by Benavent C. from Twitter's REST API via rtweet")+
  facet_wrap(vars(variable),ncol=4)+
  scale_color_manual(values=emocol)+  scale_x_datetime(date_breaks = "1 day", labels = scales::label_date_short())

##################
emoevol<-df_nrc %>% group_by(Jour) %>% mutate(n=1) %>% 
  summarise(anger=mean(anger,na.rm=TRUE), 
            anticipation=mean(anticipation, na.rm=TRUE),
            disgust=mean(disgust, na.rm=TRUE),
            fear=mean(fear, na.rm=TRUE),
            joy=mean(joy, na.rm=TRUE),
            sadness=mean(sadness, na.rm=TRUE),
            surprise=mean(surprise, na.rm=TRUE),
            trust=mean(trust, na.rm=TRUE),
            n=sum(n))

foo<-emoevol %>% ungroup %>%select(Jour, anger,fear,disgust, sadness ,surprise,anticipation,trust, joy )
foo<-melt(foo, id=c("Jour")) %>% filter(Jour<33)

ggplot(foo, aes(x=Jour,y=value,group=variable))+
  geom_line(size=1,aes(color=variable),show.legend = FALSE)+
  theme(axis.text.x=element_text(angle = 90, vjust = 0.5))+ 
  theme_minimal()+ stat_smooth(method = "loess",size=2, aes(color=variable)  )+
  labs(title="Les émotions des tweets #ConfinementJour", y="Intensité moyenne (par heure)",x=NULL,caption= "Définitions Plutchik (82) - operationalisation via NRC - lissage GAM:
 - la confiance va de l'acceptation à l'admiration
 - la peur passe de la timidité à la terreur
 - la surprise va de l'incertitude à l'étonnement
 - la tristesse passe de la morosité au chagrin
 - le dégoût va de l'aversion à la répugnance
 - la colère passe de l'agacement à la fureur
 - l anticipation va de l'intérêt à la vigilance
 - La joie passe de la sérénité à l'extase \n \nSource: Data collected by Benavent C. from Twitter's REST API via rtweet")+  scale_color_manual(values=emocol)

#  facet_wrap(vars(variable),ncol=4)+

et sous une autre forme.

emocol<-c("red3","orangered1","purple3","royalblue3","chartreuse","olivedrab3","green4","gold") #ern respectant des codes mais il faudra adoucir.

ggplot(foo, aes(x=Jour,y=value,group=variable))+
  geom_area(stat="identity",size=5,aes(fill=variable),show.legend = TRUE, position="stack")+
  theme(axis.text.x=element_text(angle = 90, vjust = 0.5))+ 
  theme_minimal()+
  labs(title="Les émotions des tweets #ConfinementJour", y="Intensité moyenne (par heure)",x=NULL,caption= "Définitions Plutchik (82) - operationalisation via NRC - lissage GAM:
 - la confiance va de l'acceptation à l'admiration
 - la peur passe de la timidité à la terreur
 - la surprise va de l'incertitude à l'étonnement
 - la tristesse passe de la morosité au chagrin
 - le dégoût va de l'aversion à la répugnance
 - la colère passe de l'agacement à la fureur
 - l'anticipation va de l'intérêt à la vigilance
 - La joie passe de la sérénité à l'extase
 \n \nSource: Data collected by Benavent C. from Twitter's REST API via rtweet")+
  scale_fill_manual(values=emocol)

Une représentation moins brute peut être fournie. On va recalculer les score de manière relative en sommant les scores bruts. et en rapportant cette somme au score.

emocol<-c("red3","orangered1","purple3","royalblue3","chartreuse","olivedrab3","green4","gold") #en respectant des codes mais il faudra adoucir.

foo<-emoevol %>% ungroup %>%select(Jour, anger,fear,disgust, sadness ,surprise,anticipation,trust, joy ) %>% filter(Jour<33)

emo<-subset(foo,select=-c(Jour))
emo$tot<-rowSums(emo, na.rm = FALSE, dims = 1)
emo$tot[is.na(emo$tot)]<-0.000001
emo$p_anger<-emo$anger/emo$tot
emo$p_anticipation<-emo$anticipation/emo$tot
emo$p_disgust<-emo$disgust/emo$tot
emo$p_fear<-emo$fear/emo$tot
emo$p_joy<-emo$joy/emo$tot
emo$p_sadness<-emo$sadness/emo$tot
emo$p_surprise<-emo$surprise/emo$tot
emo$p_trust<-emo$trust/emo$tot

foo2<-emo %>%
  select(p_anger,p_anticipation,p_disgust, p_fear,p_joy, p_sadness ,p_surprise,p_trust)
date<-foo %>%select(Jour)

foo2<-cbind(date,foo2)
foo2<-melt(foo2, id=c("Jour"))

ggplot(foo2, aes(x=Jour,y=value,group=variable))+
  geom_area(stat="identity",size=5,aes(fill=variable),show.legend = TRUE, position="fill")+
  theme_minimal()+theme(axis.text.x = element_text(size=11, angle=45))+
  labs(title="Spectre des émotions #confinementjour", y="Proportion",x=NULL)+  
  scale_fill_manual(values=emocol)+
  scale_color_manual(values=emocol)

La somme des émotions moyennes, elles peuvent d’additionner car elle ne sont pas exclusive dans les textes ( on peut avoir en même temps de la trisesse et de la joie), représente en quelque sorte l’“émotionnalité” de la production textuelle quelqu’en soit la couleur.

Apres une première montée, une seconde semble s’observer. Est-ce un changement du sentiment moyen dans la population ou l’effet de l’engagement sur le hashtag?

foo3<-emo %>%  select(tot)
date<-foo %>%select(Jour)

foo3<-cbind(date,foo3)

ggplot(foo3, aes(x=Jour,y=tot))+
  geom_line(stat="identity",size=1,show.legend = TRUE,color="gold2")+
  theme_minimal()+theme(axis.text.x = element_text(size=11, angle=45))+
  labs(title="Intensité des émotions #confinementjour", subtitle="par heure", y="Somme des émotions",x=NULL)+  geom_smooth(method="loess", color="orange3")

Nos séries sont-elles corrélées ? Si elles le sont de manière instantanée c’est qu’elle partagent une cause commune.

Une structure bifactorielle avec la surprise associée aux deux pôles positifs et négatifs : heureux/malheureux, joyeux/triste …

M1<-subset(df_nrc, select=c( anger,disgust, fear, sadness ,surprise,anticipation,trust,joy))
cor1 <- cor(M1)
library(corrplot)
corrplot.mixed(cor1)

# Maximum Likelihood Factor Analysis
# entering raw data and extracting 3 factors,
# with varimax rotation

fit <- factanal(M1, 2, rotation="promax")
print(fit, digits=2, cutoff=.3, sort=TRUE)
## 
## Call:
## factanal(x = M1, factors = 2, rotation = "promax")
## 
## Uniquenesses:
##        anger      disgust         fear      sadness     surprise anticipation 
##         0.23         0.55         0.24         0.44         0.53         0.53 
##        trust          joy 
##         0.65         0.29 
## 
## Loadings:
##              Factor1 Factor2
## anger         0.90          
## disgust       0.69          
## fear          0.88          
## sadness       0.74          
## surprise              0.54  
## anticipation          0.69  
## trust                 0.59  
## joy                   0.88  
## 
##                Factor1 Factor2
## SS loadings       2.72    1.90
## Proportion Var    0.34    0.24
## Cumulative Var    0.34    0.58
## 
## Factor Correlations:
##         Factor1 Factor2
## Factor1    1.00   -0.32
## Factor2   -0.32    1.00
## 
## Test of the hypothesis that 2 factors are sufficient.
## The chi square statistic is 23228.59 on 13 degrees of freedom.
## The p-value is 0
# plot factor 1 by factor 2
load <- fit$loadings[,1:2]
plot(load,type="n") # set up plot
text(load,labels=names(M1),cex=.7) # add variable names

Avec le LIWC

Le sentiment du LIWC

la tendance

et la corrélation avec le NRC

Les topics de liwcs à l’heure

On va analyser trois groupes de variables : celles liées aux proches ( ami, famille, humains), celles liée à la physiologie (alimentation, corps,sexualité,santé ) et enfin celle liée à la dimension saptiotemporelle.

#library(scales)
foo<-df_nrc %>% group_by(month,day,hour) %>% mutate(n=1) %>%   summarise(ami=mean(ami,na.rm=TRUE),famille=mean(famille,na.rm=TRUE),humain=mean(humain,na.rm=TRUE))
foo$date<-paste0("2020","-",foo$month,"-",foo$day," ",foo$hour,":00:00")
foo$date2 <- as.POSIXct(strptime(foo$date, "%Y-%m-%d %H:%M:%S"))

foo<-foo %>% ungroup %>%select(date2,ami, famille, humain )
foo<-melt(foo,id="date2")

emocol<-c("red3","orangered1","olivedrab3", "chartreuse","royalblue3","green4","yellow","purple3") #en respectant des codes mais il faudra adoucir.

ggplot(foo, aes(x=date2,y=value,group=variable))+
  geom_line(size=1,show.legend = FALSE,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 90, vjust = 0.5))+ 
  theme_minimal()+ stat_smooth(method = "gam" , aes(color=variable))+
  labs(title="Les thématiques des proches #ConfinementJour", y="Intensité moyenne (par heure)",x=NULL,caption= " \nSource: Data collected by Benavent C. \n from Twitter's REST API via rtweet \n and processed with Liwc & tidyverse")+  
  scale_color_manual(values=emocol)+facet_wrap(vars(variable),ncol=3)+ 
  scale_x_datetime(date_breaks = "1 day", labels = scales::label_date_short())

foo<-df_nrc %>% group_by(month,day,hour) %>% mutate(n=1) %>% summarise(alimentation=mean(alimentation,na.rm=TRUE),sexualité=mean(sexualité,na.rm=TRUE),santé=mean(santé,na.rm=TRUE),corps=mean(corps,na.rm=TRUE))
foo$date<-paste0("2020","-",foo$month,"-",foo$day," ",foo$hour,":00:00")
foo$date2 <- as.POSIXct(strptime(foo$date, "%Y-%m-%d %H:%M:%S"))

foo<-foo %>% ungroup %>%select(date2, alimentation,sexualité, santé,corps )
foo<-melt(foo,id="date2")

emocol<-c("green4","red3","royalblue2","orangered1","purple3","chartreuse","olivedrab3","yellow") #en respectant des codes mais il faudra adoucir.

ggplot(foo, aes(x=date2,y=value,group=variable))+
  geom_line(size=1,show.legend = FALSE,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 45))+
  theme_minimal()+ stat_smooth(method = "gam" , aes(color=variable))+
  labs(title="Thématiques alimentation, sexualité, santé des tweets #ConfinementJour", y="Intensité moyenne (par heure)",x=NULL,caption= " \nSource: Data collected by Benavent C. \n from Twitter's REST API via rtweet \n and processed with Liwc & tidyverse")+
  scale_color_manual(values=emocol)+facet_wrap(vars(variable),ncol=2)+  scale_x_datetime(date_breaks = "1 day", labels = scales::label_date_short())

foo<-df_nrc %>% group_by(month, day,hour) %>% mutate(n=1) %>% summarise(sentir=mean(sentir,na.rm=TRUE),voir=mean(voir,na.rm=TRUE),entendre=mean(entendre,na.rm=TRUE),mouvement=mean(corps,na.rm=TRUE),espace=mean(espace,na.rm=TRUE),temps=mean(temps,na.rm=TRUE))
foo$date<-paste0("2020","-",foo$month,"-",foo$day," ",foo$hour,":00:00")
foo$date2 <- as.POSIXct(strptime(foo$date, "%Y-%m-%d %H:%M:%S"))

foo<-foo %>% ungroup %>%select(date2, mouvement, espace, temps)
foo<-melt(foo,id="date2")

emocol<-c("green4","red3","royalblue2","orangered1","purple3","chartreuse","olivedrab3","yellow") #en respectant des codes mais il faudra adoucir.

ggplot(foo, aes(x=date2,y=value,group=variable))+
  geom_line(size=1,show.legend = FALSE,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 45))+
  theme_minimal()+ stat_smooth(method = "gam" , aes(color=variable))+
  labs(title="Thématiques alimentation, sexualité, santé des tweets #ConfinementJour", y="Intensité moyenne (par heure)",x=NULL,caption= " \nSource: Data collected by Benavent C. \n from Twitter's REST API via rtweet \n and processed with Liwc & tidyverse")+
  scale_color_manual(values=emocol)+facet_wrap(vars(variable),ncol=3)+  scale_x_datetime(date_breaks = "1 day", labels = scales::label_date_short())

##les topics par jour

On exploite ici les ressources du #Liwc pour apprécier la nature de l’expérience partagée sur #confinement jour.

on y examine

  • la dimension sociale

la dimension sociale

# les proches

foo<- df_nrc %>% group_by(Jour) %>% mutate(n=1) %>%   summarise(ami=mean(ami,na.rm=TRUE),famille=mean(famille,na.rm=TRUE),humain=mean(humain,na.rm=TRUE))


foo<-foo %>% ungroup %>%select(Jour,ami, famille, humain )
foo<-melt(foo,id=c("Jour")) %>%filter(Jour<33)


ggplot(foo, aes(x=Jour,y=value,group=variable))+
  geom_line(size=1,show.legend = FALSE,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 90, vjust = 0.5))+ 
  theme_minimal()+ stat_smooth(method = "loess" , aes(color=variable), size=1.5)+
  labs(title="La thématique des proches des tweets #ConfinementJour", y="Intensité moyenne (par 24h)",x="Jour de confinement",caption= " \nSource: Data collected by 'labo du Confinement' \n from Twitter's REST API via rtweet \n and processed with Liwc & tidyverse \n=911959")+  
  scale_color_manual(values=emocol)+facet_wrap(vars(variable),ncol=3)

Cette production primaire doit être comparé à la production de la population totale, celle qui a retweeté et répét les message corrigeant la production en terme d’impression. C’est à dire la totalité des contenus exposés aux followers. Donc avec l’effet de réberbération

perceptions

foo<-df_nrc %>% group_by(Jour) %>% mutate(n=1) %>% summarise(sentir=mean(sentir,na.rm=TRUE),voir=mean(voir,na.rm=TRUE),entendre=mean(entendre,na.rm=TRUE),mouvement=mean(corps,na.rm=TRUE),espace=mean(espace,na.rm=TRUE),temps=mean(temps,na.rm=TRUE))
foo<-foo %>% ungroup %>%select(Jour, mouvement, espace, temps)
foo<-melt(foo,id="Jour") %>%filter(Jour<33)

emocol<-c("green4","firebrick","royalblue3","orangered1","purple3","chartreuse","olivedrab3","yellow") #en respectant des codes mais il faudra adoucir.

ggplot(foo, aes(x=Jour,y=value,group=variable))+
  geom_line(size=1,show.legend = FALSE,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 45))+
  theme_minimal()+ stat_smooth(method = "gam" , aes(color=variable),size=1.5)+
  labs(title="Thématiques du temps, de l'espace et du mouvement -tweets #ConfinementJour", y="Intensité moyenne (par heure)",x=NULL,caption= " \nSource: Data collected by Benavent C. \n from Twitter's REST API via rtweet \n and processed with Liwc & tidyverse")+
  scale_color_manual(values=emocol)+facet_wrap(vars(variable),ncol=3)

la physiologie

#l'organique
foo<- df_nrc%>% group_by(Jour) %>% mutate(n=1) %>% summarise(alimentation=mean(alimentation,na.rm=TRUE),sexualité=mean(sexualité,na.rm=TRUE),santé=mean(santé,na.rm=TRUE),corps=mean(corps,na.rm=TRUE))

foo<-foo %>% ungroup %>%select(Jour, alimentation,sexualité, santé,corps )
foo<-melt(foo,id="Jour")%>%filter(Jour<33)

emocol<-c("green4","red3","royalblue2","orangered1","purple3","chartreuse","olivedrab3","yellow") #en respectant des codes mais il faudra adoucir.

ggplot(foo, aes(x=Jour,y=value,group=variable))+
  geom_line(size=1,show.legend = FALSE,aes(color=variable))+
  theme(axis.text.x=element_text(angle = 45))+
  theme_minimal()+ stat_smooth(method = "gam" , aes(color=variable))+
  labs(title="Thématiques : alimentation, sexualité, santé des tweets #ConfinementJour", y="Intensité moyenne (par heure)",x=NULL,caption= " \nSource: Data collected by Benavent C. \n from Twitter's REST API via rtweet \n and processed with Liwc & tidyverse")+
  scale_color_manual(values=emocol)+facet_wrap(vars(variable),ncol=4)

# l’analyse des résultats du lexicoder

Etude de la convergence des indicateurs

Les indicateurs de sentiment construits sur des dictionnaires et a fortiori traduits posent des questions de validité de mesure : - validité de contenu - validité convergente - validité discriminante - fiabilité et consistance interne - sensibilité

Les différentes mesures de sentiment vont-elle dans le même sens?

Faut-il les combiner au travers d’un modèle factoriel?

Comment conserver les nuances?

convergence des indicateurs

Une approche en terme de correlations à trois niveaux : l’unité de texte et son évolution dans le temps; l’echelle de l’heure, l’échelle du jour.

#cor 
#cor 
#cor

Une approche en terme de reliability et finalement ce sont les items d’un score. une approche factorielle.

l’analyse simple des corrélation montre une faible consistance

r_sent<-subset(df_nrc, select=c( negative,émonég,positive, émopos))
cor2 <- cor(r_sent)
corrplot.mixed(cor2)

facettes et sentiments

Regardons les relations entre émotions et expérience via https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html

Il faut optimiser pour aussi monter les évolutions.

Faire un gif jour par jour?

M1<-subset(df_nrc, select=c(negative,anger,disgust, fear, sadness,surprise,anticipation,trust,joy,positive))

M2<-subset(df_nrc, select=c( alimentation,sexualité, santé,corps,ami, famille, humain))
cor2 <- cor(M2)
library(corrplot)
corrplot.mixed(cor2, order = "hclust", addrect = 2)

# Maximum Likelihood Factor Analysis
# entering raw data and extracting 3 factors,
# with oblimin(promax) rotation - factors could be correlated

fit <- factanal(M1,2, rotation="promax")
print(fit, digits=2, cutoff=.3, sort=TRUE)
## 
## Call:
## factanal(x = M1, factors = 2, rotation = "promax")
## 
## Uniquenesses:
##     negative        anger      disgust         fear      sadness     surprise 
##         0.21         0.28         0.51         0.26         0.38         0.61 
## anticipation        trust          joy     positive 
##         0.57         0.55         0.30         0.36 
## 
## Loadings:
##              Factor1 Factor2
## negative      0.89          
## anger         0.86          
## disgust       0.72          
## fear          0.87          
## sadness       0.78          
## anticipation          0.65  
## trust                 0.67  
## joy                   0.86  
## positive              0.81  
## surprise              0.48  
## 
##                Factor1 Factor2
## SS loadings       3.52    2.51
## Proportion Var    0.35    0.25
## Cumulative Var    0.35    0.60
## 
## Factor Correlations:
##         Factor1 Factor2
## Factor1    1.00   -0.29
## Factor2   -0.29    1.00
## 
## Test of the hypothesis that 2 factors are sufficient.
## The chi square statistic is 85343.51 on 26 degrees of freedom.
## The p-value is 0
# plot factor 1 by factor 2
load <- fit$loadings[,1:2]
plot(load,type="n") # set up plot
text(load,labels=names(M1),cex=.7) # add variable names

Jour2 <- c(2,8,20)
for (val in Jour2) {
  M1<-df_nrc %>% filter (Jour ==val) %>% select(negative,anger,disgust, fear, sadness,surprise,anticipation,trust,joy,positive)
  M2<-df_nrc %>% filter (Jour ==val) %>% select( alimentation,sexualité, santé,corps,ami, famille, humain)
  cor3<-cor(x=M1,y=M2)
  cor3 <- melt(cor3)
  g<-ggplot(data = cor3, aes(x=Var1, y=Var2, fill=value)) + 
    geom_tile()+ labs(title="Corrélations entre les domaines de l'expérience et les émotions",x="Sentiments", y="Domaines")+
    scale_fill_gradient2(low = "blue", high = "red", mid = "white",midpoint = 0, limit = c(-0.3,0.3), space = "Lab",
   name="Pearson\nCorrelation")
  g

}
val<-20
M1<-df_nrc %>% filter (Jour ==val) %>% select(negative,anger,disgust, fear, sadness,surprise,anticipation,trust,joy,positive)
M2<-df_nrc %>% filter (Jour ==val) %>% select( alimentation,sexualité, santé,corps,ami, famille, humain)
cor3<-cor(x=M1,y=M2)
cor3 <- melt(cor3)
g<-ggplot(data = cor3, aes(x=Var1, y=Var2, fill=value)) + 
    geom_tile()+ labs(title="Corrélations entre les domaines de l'expérience et les émotions",x="Sentiments", y="Domaines")+
    scale_fill_gradient2(low = "blue", high = "red", mid = "white",midpoint = 0, limit = c(-0.3,0.3), space = "Lab",
   name="Pearson\nCorrelation")
g

Références :