--- title: "Analyse de sentiments avec sentometrics" author: "François Pelletier" format: pdf --- > **Note :** Ce document combine les quatre fichiers Rmd originaux. Les packages R `RSQLite` et `sentometrics` sont nécessaires pour exécuter le code, mais ne sont pas installés dans l'environnement actuel. Tout le code R est donc présenté avec `eval: false` à titre de référence. # Préparation des données Sentometrics ```{r} #| eval: false knitr::opts_chunk$set(echo = TRUE) ``` ```{r} #| eval: false library("jsonlite") library("tidyverse") library("RSQLite") library("DBI") library("lubridate") ``` ```{r} #| eval: false blog_exemple <- jsonlite::read_json("google_news_blogs/blogs/blogs_0000001.json") ``` - Identifiant ```{r} #| eval: false blog_exemple$uuid ``` - Date ```{r} #| eval: false blog_exemple$published ``` - Contenu ```{r} #| eval: false blog_exemple$text ``` - Features - Persons ```{r} #| eval: false blog_exemple$entities$persons %>% sapply(FUN = function(x) x$name) ``` - Organizations ```{r} #| eval: false blog_exemple$entities$organizations %>% sapply(FUN = function(x) x$name) ``` - Locations ```{r} #| eval: false blog_exemple$entities$locations %>% sapply(FUN = function(x) x$name) ``` ## Dataframes Core ```{r} #| eval: false extract_names <- function(list_entities){ name_entities <- list_entities %>% sapply(FUN = function(x) x$name) if (length(name_entities) > 0) return(name_entities) else return(NA) } generer_core_df <- function(json_contents){ tibble(uuid = json_contents$uuid %>% coalesce(""), site = json_contents$thread$site %>% coalesce(""), site_type = json_contents$thread$site_type %>% coalesce(""), country = json_contents$thread$country %>% coalesce(""), published = lubridate::as_datetime(json_contents$thread$published) %>% coalesce(ISOdate(1900,1,1)), title_full = json_contents$thread$title_full %>% coalesce(""), text = json_contents$text %>% coalesce("")) } generer_entities_df <- function(json_contents){ this_df <- bind_rows(tibble(uuid = json_contents$uuid, entity_type="persons", entity=json_contents$entities$persons %>% extract_names) , tibble(uuid = json_contents$uuid, entity_type="organizations", entity=json_contents$entities$organizations %>% extract_names), tibble(uuid = json_contents$uuid, entity_type="locations", entity=json_contents$entities$locations %>% extract_names)) this_df <- na.omit(this_df) } ``` ```{r} #| eval: false core_df <- generer_core_df(blog_exemple) core_df %>% glimpse ``` ```{r} #| eval: false entities_df <- generer_entities_df(blog_exemple) entities_df %>% glimpse ``` ## Création des schémas de la base de données ```{r} #| eval: false if(file.exists("google_news.sqlite")) file.remove("google_news.sqlite") con = dbConnect(drv = RSQLite::SQLite(), dbname="google_news.sqlite") dbCreateTable(con,"core",core_df) dbCreateTable(con,"entities",entities_df) ``` ## Importation des données ```{r} #| eval: false file_blogs <- list.files(path = "google_news_blogs/blogs",pattern = "*.json",full.names = TRUE) file_news <- list.files(path = "google_news_blogs/news",pattern = "*.json",full.names = TRUE) ``` ```{r} #| eval: false traiter_json <- function(file_path){ json_contents <- jsonlite::read_json(file_path) core_df <- generer_core_df(json_contents) entities_df <- generer_entities_df(json_contents) dbAppendTable(con,"core",core_df) dbAppendTable(con,"entities",entities_df) } ``` ## Traitement des fichiers ```{r} #| eval: false i <- 0 # itérateur for (file_blog in file_blogs){ if(!(i %% 1000)){ print(paste0(i,": Traitement de ",file_blog)) } traiter_json(file_blog) i <- i+1 } ii <- 0 # itérateur for (file_article in file_news){ if(!(ii %% 1000)){ print(paste0(ii,": Traitement de ",file_article)) } traiter_json(file_article) ii <- ii+1 } ``` # Formatage des données ```{r} #| eval: false library("tidyverse") library("RSQLite") library("DBI") library("sentometrics") ``` ```{r} #| eval: false con = dbConnect(drv = RSQLite::SQLite(), dbname="google_news.sqlite") ``` ## Aperçu ```{r} #| eval: false tbl(con,"core") %>% head(10) %>% collect() %>% glimpse() ``` ## Top 10 de modalités ```{r} #| eval: false top_10_sites <- tbl(con,"core") %>% select(site) %>% group_by(site) %>% count() %>% arrange(desc(n)) %>% head(10) %>% collect() saveRDS(top_10_sites,"top_10_sites.RDS") top_10_sites ``` ```{r} #| eval: false top_10_country <- tbl(con,"core") %>% select(country) %>% mutate(country = ifelse(country=="","XX",country)) %>% group_by(country) %>% count() %>% arrange(desc(n)) %>% head(10) %>% collect() saveRDS(top_10_country,"top_10_country.RDS") top_10_country ``` ## Entities features ### Compteurs ```{r} #| eval: false entities_count <- tbl(con,"entities") %>% group_by(uuid,entity_type) %>% count %>% collect() ``` ```{r} #| eval: false entities_count_t <- entities_count %>% reshape2::dcast(uuid~paste0("entity_",entity_type),fun.aggregate = sum, value.var = "n") entities_count_t %>% head(10) %>% glimpse() ``` ### Aperçu ```{r} #| eval: false tbl(con,"entities") %>% group_by(entity_type, entity) %>% count() %>% arrange(desc(n)) %>% head(100) %>% collect() ``` ## Core features ```{r} #| eval: false core_features_corpus <- tbl(con,"core") %>% collect() %>% transmute( id=uuid, date=lubridate::as_datetime(published), texts=paste(title_full,text,sep = "\n"), # Site site_01 = ifelse(site==top_10_sites$site[1],1,0), site_02 = ifelse(site==top_10_sites$site[2],1,0), site_03 = ifelse(site==top_10_sites$site[3],1,0), site_04 = ifelse(site==top_10_sites$site[4],1,0), site_05 = ifelse(site==top_10_sites$site[5],1,0), site_06 = ifelse(site==top_10_sites$site[6],1,0), site_07 = ifelse(site==top_10_sites$site[7],1,0), site_08 = ifelse(site==top_10_sites$site[8],1,0), site_09 = ifelse(site==top_10_sites$site[9],1,0), site_10 = ifelse(site==top_10_sites$site[10],1,0), # Site type is_blog = ifelse(site_type=="blogs",1,0), # Country country_01 = ifelse(country==top_10_country$country[1],1,0), country_02 = ifelse(country==top_10_country$country[2],1,0), country_03 = ifelse(country==top_10_country$country[3],1,0), country_04 = ifelse(country==top_10_country$country[4],1,0), country_05 = ifelse(country==top_10_country$country[5],1,0), country_06 = ifelse(country==top_10_country$country[6],1,0), country_07 = ifelse(country==top_10_country$country[7],1,0), country_08 = ifelse(country==top_10_country$country[8],1,0), country_09 = ifelse(country==top_10_country$country[9],1,0), country_10 = ifelse(country==top_10_country$country[10],1,0) ) %>% left_join(entities_count_t,by=c("id"="uuid")) %>% sento_corpus() ``` ```{r} #| eval: false saveRDS(core_features_corpus,file = "core_features_corpus.RDS") ``` # Analyse BD ```{r} #| eval: false knitr::opts_chunk$set(echo = TRUE) ``` ```{r} #| eval: false library("sentometrics") library("tidyverse") library("plotly") ``` ```{r} #| eval: false core_features_corpus.RDS <- readRDS("core_features_corpus.RDS") top_10_country <- readRDS("top_10_country.RDS") top_10_sites <- readRDS("top_10_sites.RDS") corpusSample <- quanteda::corpus_sample(core_features_corpus.RDS, size = 200) ``` ## Définition des lexiques ```{r} #| eval: false data("list_valence_shifters", package = "sentometrics") data("list_lexicons", package = "sentometrics") lexIn <- list_lexicons[c("FEEL_en_tr")] valIn <- list_valence_shifters[["en"]] l1 <- sento_lexicons(lexIn,valIn) ``` ## Calcul des sentiments ```{r} #| eval: false c_sentiments_sample <- compute_sentiment(x = corpusSample, lexicons = l1, how = "counts", nCore = 8) c_sentiments_sample ``` ```{r} #| eval: false c_control_compute <- ctr_agg(howWithin = "proportional", howDocs = "equal_weight", howTime = "equal_weight", lag = 7, by = "day") c_sentiments <- sento_measures(sento_corpus = core_features_corpus.RDS, lexicons = l1, ctr = c_control_compute) ``` ```{r} #| eval: false c_measures <- as.data.table(c_sentiments) ``` ```{r} #| eval: false c_measures_g <- measures_global(c_sentiments) ``` ## Sentiment par site ```{r} #| eval: false c_measures_melt <- c_measures %>% select(date,starts_with("FEEL_en_tr--site")) %>% `colnames<-`(c("date",top_10_sites$site)) %>% melt(id="date",variable.name = "site") plot_site <- ggplot(data=c_measures_melt, aes(x=date, y=value, colour=site))+ geom_line() ggplotly(plot_site) ``` ## Sentiment par pays ```{r} #| eval: false c_measures_melt <- c_measures %>% select(date,starts_with("FEEL_en_tr--country")) %>% `colnames<-`(c("date",top_10_country$country)) %>% melt(id="date",variable.name = "country") plot_country <- ggplot(data=c_measures_melt, aes(x=date, y=value, colour=country))+ geom_line() ggplotly(plot_country) ``` ## Sentiment par compteur d'entités ```{r} #| eval: false c_measures_melt <- c_measures %>% select(date,starts_with("FEEL_en_tr--entity")) %>% melt(id="date",variable.name = "entity") plot_entity <- ggplot(data=c_measures_melt, aes(x=date, y=value, colour=entity))+ geom_line() ggplotly(plot_entity) ``` # Sentometrics — Présentation CAAMD ```{r} #| eval: false knitr::opts_chunk$set(echo = FALSE) ``` ## Sentometrics Présentation basée sur un atelier présenté par Keven Bluteau à **R à Québec 2019**. D'où vient le nom ? - Mélange d'analyse de sentiments et d'économétrie - Type d'analyse de plus en plus fréquent en finance, en marketing et en politique. Quelle forme prend le produit ? - Package R - Services conseils ($) ## Article de référence [The R Package sentometrics to Compute, Aggregate and Predict with Textual Sentiment](https://ssrn.com/abstract=3067734) ## Pourquoi ? Les données qualitatives sont de plus en plus utilisées pour raffiner les analyses prédictives, car elle donnent une rétroaction sur la passé et le futur, contrairement aux données numériques qui donnent toujours une image passée ou présente d'une réalité. ## Historique des packages R - [tm](https://cran.r-project.org/web/packages/tm/index.html) (2008) - [openNLP](https://cran.r-project.org/web/packages/openNLP/index.html) (2016) - [quanteda](https://cran.r-project.org/web/packages/quanteda/index.html) (2018) - [tidytext](https://cran.r-project.org/web/packages/tidytext/index.html) (2016) ## Les bases Sentometrics est construit sur `quanteda` et `data.table`. Les modèles sont estimés avec `glmnet` et `caret`. ## Les fonctionnalités ![](images/sentometrics_functionality.png) ## Calcul des sentiments - Unigrammes: somme pondérée des scores pour tous les mots apparaissant dans un lexique - Bigrammes avec décalage de polarité (valence shifting) - Va intégrer l'impact de mots négatifs par exemple (good vs. not good) - Groupements avec décalage de polarité (valence shifting) - Fenêtre mobile avant et après le mot ## Aggrégation des sentiments Les sentiments sont aggrégés en deux phases: - Pour tous les documents durant une période donnée - Pour plusieurs périodes consécutives ## Création des métriques - Aggrégation à l'intérieur du document (howWithin) - Aggrégation à l'intérieur d'un intervalle de temps (howDocs) - Aggrégation au fil du temps (howTime) ## Modélisation - Régression avec Elastic Net - Configuration des hyperparamètres avec `ctr_model()` - Entraînement avec `sento_model()`