---
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()`
