Projet Text Mining: Analyse de texte dans un corpus

Author

BAYILI Pema COMPAORE Jovite P-Jean B NIKIEMA W.F.Tayirou SAWADOGO Boniface

Etape1: Selection du Dataset

Ce projet a été effectué avec des données de textes publicitaires de différentes entreprises productrices du Burkina Faso à savoir Orange, Moov et Telecel d’une part, et d’autre part Interieur Maison, Tecno et Fasotech. Ces données ont directement été recueillies de leurs pages facebook respectives.

Importation des données

library(tm)
library(tidytext)
library(dplyr)
library(ggplot2)
library(topicmodels)
library(wordcloud)
library(tidyr)
library(stringr)
library(readr)
library(readxl)
library(tidyverse)
library(sentimentr)
library(plotly)

library(readxl)
data_service<- read_excel("C:/Users/USER/Desktop/LPAS3/DATA_MINING/Projet_data_mining/Texte publicitaire.xlsx")
View(data_service)

###############INTERIEUR MAISON, TECHNO ET INFINIX 


library(readxl)
data_bien<- read_excel("C:/Users/USER/Desktop/LPAS3/DATA_MINING/Projet_data_mining/interieur maison pub.xlsx")
View(data_bien)



# # On extrait les textes de la colonne Texte publicitaire
texts <- data_service$`Texte publicitaire`
texts1<-data_bien$`Texte publicitaire`

Etape 2: Prétraitement des textes

Prétraitement des textes d’entreprises de téléphonies (Entreprises produisant des services)

library(udpipe)
library(dplyr)
library(stopwords)

# Télécharger un modèle préentraîné pour le français
model <- udpipe_download_model(language = "french")
ud_model <- udpipe_load_model(file = model$file_model)

# Analyse linguistique avec udpipe
output_services <- udpipe_annotate(ud_model, x = texts)
output_df_services <- as.data.frame(output_services)

# Liste des mots vides pour le français
stopwords_fr <- stopwords::stopwords("fr")

# Prétraitement ajusté
cleaned_text_services <- output_df_services %>%
    filter(!upos %in% c("PUNCT", "NUM"),        # Supprimer ponctuation et nombres
           !lemma %in% stopwords_fr) %>%       # Supprimer les mots vides
    mutate(lemma = tolower(lemma),             # Mettre les lemmes en minuscule
           lemma = gsub("[[:digit:]]", "", lemma),  # Supprimer les chiffres
           lemma = gsub("[[:punct:]]", "", lemma),
           lemma = ifelse(is.na(lemma), "", lemma)) 


# Regrouper les textes nettoyés
processed_texts_services <- cleaned_text_services %>%
  group_by(doc_id) %>%
  summarize(text = paste(lemma, collapse = " ")) 


# %>% # Supprimer toutes les ponctuations et caractères spéciaux
#     group_by(doc_id) %>%                       
#     summarize(text = paste(lemma, collapse = " ")) # Recréer les textes nettoyés

# Afficher les résultats
print(processed_texts_services)

# A tibble: 229 × 2
   doc_id text                                                                  
   <chr>  <chr>                                                                 
 1 doc1   "max fête règle être serein course fête orange money via max it"      
 2 doc10  "giga sim procurez giga sim orange bénéficier go offrir ainsi autre a…
 3 doc100 "faire comme rabiga reman composer  ok créer aujourdhui compte telece…
 4 doc101 " bonus telecel money faire plein bonus profiter fond journée telecel…
 5 doc102 " bonus internet tout forfait internet taper  souscrire nb bonus être…
 6 doc103 "gigas gogo promo go f mercredi composer  ok profiter  max g  telecel…
 7 doc104 "l image zougnanzaguemda officiel légende musique traditionnel burkin…
 8 doc105 " bonus telecel money faire plein bonus profiter fond journée telecel…
 9 doc106 "gigas valide jour f taper  choisir forfait promo giga être valide jo…
10 doc107 "profite  forfait nuire moins cher  marché mb  sms f mb  sms f gb  sm…
# ℹ 219 more rows

Prétraitement des textes d’entreprises de vente d’appareils electroniques et de meubles (Entreprises de biens)

library(udpipe)
library(dplyr)
library(stopwords)

# Analyse linguistique avec udpipe
output_biens <- udpipe_annotate(ud_model, x = texts1)
output_df_biens <- as.data.frame(output_biens)

# Liste des mots vides pour le français
stopwords_fr <- stopwords::stopwords("fr")

# Prétraitement ajusté
cleaned_text_biens <- output_df_biens %>%
    filter(!upos %in% c("PUNCT", "NUM"),        # Supprimer ponctuation et nombres
           !lemma %in% stopwords_fr) %>%       # Supprimer les mots vides
    mutate(lemma = tolower(lemma),             # Mettre les lemmes en minuscule
           lemma = gsub("[[:digit:]]", "", lemma),  # Supprimer les chiffres
           lemma = gsub("[[:punct:]]", "", lemma),
           lemma = ifelse(is.na(lemma), "", lemma)) 


# Regrouper les textes nettoyés
processed_texts_biens <- cleaned_text_biens %>%
  group_by(doc_id) %>%
  summarize(text = paste(lemma, collapse = " ")) 


# %>% # Supprimer toutes les ponctuations et caractères spéciaux
#     group_by(doc_id) %>%                       
#     summarize(text = paste(lemma, collapse = " ")) # Recréer les textes nettoyés

# Afficher les résultats
print(processed_texts_biens)

# A tibble: 87 × 2
   doc_id text                                                                  
   <chr>  <chr>                                                                 
 1 doc1   "meuble tv mural disponible f cfa show room kalgondin intérieur maiso…
 2 doc10  "bureau rangement disponible f cfer  lieu f cfer show room kalgondin …
 3 doc11  "table manger marbre disponible f cfa  lieu f cfa show room kalgondin…
 4 doc12  "salon turc place disponible f cfer  lieu f cfer show room kalgondin …
 5 doc13  "commode vêtement disponible f cfer  lieu f cfer show room kalgondin …
 6 doc14  "noël arriver grand c être moment faire achat \U0001f381 \U0001f389 o…
 7 doc15  "noël arriver grand c être moment faire achat \U0001f381 \U0001f389 o…
 8 doc16  "profiter weekend découvrir cuisine complet moderne élégant faire mai…
 9 doc17  "offre spécial \U0001f389 découvrir offre exclusive coiffeuse commode…
10 doc18  "offre spécial \U0001f389 profitez offre spécial offrir bibliothèque …
# ℹ 77 more rows

Etape 3: Analyse des sentiments

sentiment_lexicon<- read.csv("C:/Users/USER/Desktop/LPAS3/DATA_MINING/Projet_data_mining/FEEL.csv", sep=";")
View(sentiment_lexicon )



# Analyse des sentiments pour les services
sentiments_services <- cleaned_text_services %>%
  inner_join(sentiment_lexicon, by = c("lemma" = "word")) %>%  # Associer le lexique
  count(doc_id, polarity) %>%
  mutate(category = "Services")  # Ajouter une colonne "category"

# Analyse des sentiments pour les biens
sentiments_biens <- cleaned_text_biens %>%
  inner_join(sentiment_lexicon, by = c("lemma" = "word")) %>%  # Associer le lexique
  count(doc_id, polarity) %>%
  mutate(category = "Biens")  # Ajouter une colonne "category"

# Combiner les deux dans une seule table
sentiments_combined <- bind_rows(sentiments_services, sentiments_biens)

# Créer un graphique comparatif
gg <- ggplot(sentiments_combined, aes(x = polarity, y = n, fill = polarity)) +
  geom_bar(stat = "identity", position = "dodge") +
  facet_wrap(~ category) +  # Un graphique pour chaque catégorie

  theme_minimal() +
  theme(
    axis.text.x = element_blank(),  # Supprimer les étiquettes de l'axe des x
    axis.ticks.x = element_blank()  # Supprimer les ticks de l'axe des x
  ) +
  labs(
    title = "Analyse de sentiments : Services vs Biens",
    x = "", y = "Fréquence", fill = "Polarité"
  )

# Afficher le graphique
print(gg)

Etape 4: Modélisation thématique

Matrice Document-Term (DTM) et Algorithme de Latent Dirichlet Allocation (LDA) et Détermination du nombre de thèmes

Services

library(topicmodels)

# Création d'une matrice Document-Terme (DTM)
dtm_services <- DocumentTermMatrix(Corpus(VectorSource(processed_texts_services$text)))

dtm_services

<<DocumentTermMatrix (documents: 229, terms: 1050)>>
Non-/sparse entries: 5323/235127
Sparsity           : 98%
Maximal term length: 37
Weighting          : term frequency (tf)

matrice_services<-as.matrix(dtm_services)

# Initialiser une plage de valeurs de k (nombre de thèmes)
k_values <- 2:10  # Vous pouvez ajuster la plage selon vos besoins

# Calculer la perplexité pour chaque valeur de k
perplexity_values_services <- sapply(k_values, function(k) {
  lda_model_services <- LDA(dtm_services, k = k, control = list(seed = 1234))  # Ajuster le modèle LDA
  perplexity(lda_model_services, dtm_services)  # Calculer la perplexité pour le modèle
})

# Tracer la perplexité en fonction de k
plot(k_values, perplexity_values_services, type = "b", 
     xlab = "Nombre de thèmes (k)", 
     ylab = "Perplexité", 
     main = "Évaluation de la perplexité pour différents k")

Commentaire: On observe que la perplexité diminue rapidement pour les petites valeurs de k puis commence à diminuer plus lentement à mesure que k augmente.

En utilisant la méthode du coude qui représente le point où l’ajout de nouveaux thèmes apportent des améliorations marginales, on choisit comme valeur de k=4.

Biens

# Création d'une matrice Document-Terme (DTM)
dtm_biens <- DocumentTermMatrix(Corpus(VectorSource(processed_texts_biens$text)))

dtm_biens

<<DocumentTermMatrix (documents: 87, terms: 608)>>
Non-/sparse entries: 5118/47778
Sparsity           : 90%
Maximal term length: 34
Weighting          : term frequency (tf)

matrice_biens<-as.matrix(dtm_biens)

# Initialiser une plage de valeurs de k (nombre de thèmes)
k_values <- 2:10  # Vous pouvez ajuster la plage selon vos besoins

# Calculer la perplexité pour chaque valeur de k
perplexity_values_biens <- sapply(k_values, function(k) {
  lda_model_biens <- LDA(dtm_biens, k = k, control = list(seed = 1234))  # Ajuster le modèle LDA
  perplexity(lda_model_biens, dtm_biens)  # Calculer la perplexité pour le modèle
})

# Tracer la perplexité en fonction de k
plot(k_values, perplexity_values_biens, type = "b", 
     xlab = "Nombre de thèmes (k)", 
     ylab = "Perplexité", 
     main = "Évaluation de la perplexité pour différents k")

Commentaire: En utilisant la méthode du coude qui représente le point où l’ajout de nouveaux thèmes apporte des améliorations marginales, on choisit comme valeur de k=5.

Modélisation

Services

# Application de l'algorithme LDA
lda_model_services <- LDA(dtm_services, k = 4, control = list(seed = 120125))  # k = nombre de thèmes
lda_terms_services <- terms(lda_model_services, 10)  # Les 10 termes les plus associés à chaque thème
# Affichage des thèmes
print(lda_terms_services)

      Topic 1    Topic 2             Topic 3      Topic 4   
 [1,] "telecel"  "moov"              "money"      "offre"   
 [2,] "money"    "africa"            "telecel"    "jour"    
 [3,] "bonus"    "nouveau"           "être"       "orange"  
 [4,] "jour"     "whatsapp"          "tout"       "fcfa"    
 [5,] "être"     "monde"             "rapide"     "composer"
 [6,] "numéro"   "appeler"           "aujourdhui" "valide"  
 [7,] "recharge" "contact"           "composer"   "numéro"  
 [8,] "via"      "burkina"           "orange"     "gagner"  
 [9,] "compte"   "être"              "simple"     "sim"     
[10,] "tout"     "moovafricaburkina" "plus"       "promo"

Identification et interprétation des thèmes principaux

Thème 1:Mobile Money et Telecom

Le mot “telecel” qui a une forte occurence renvoie à un opérateur telecom bien connu.

“Money” et “compte” font référence à des services mobiles, tels que le mobile money.

Thème 2:Nouveaux Services Télécoms

“Nouveau” et “Whatsapp” impliquent l’émergence de nouvelles offres ou applications de communication.

Le terme « afrique » positionne ces services dans un contexte géographique régional.

“Appeler” renforce l’idée de services télécoms classiques intégrés à des innovations.

Thème 3:Transaction Rapides et Simples

Les mots “rapide”, “simple” et “composer” proposent des services faciles et rapides à exécuter, probablement des transactions financières ou télécoms.

“Money” relève ce thème aux paiements ou transferts.

“Aujourd’hui” et “plus” évoquent une disponibilité immédiate et des avantages supplémentaires.

Thème 4:Promotions commerciales

“Offre” et “promo” indiquant des campagnes marketing.

“Orange” fait référence à un opérateur spécifique.

“Gagner” et “valide” sont typiques des messages promotionnels où les clients sont invités à profiter d’offres limitées.

Biens

# Application de l'algorithme LDA
lda_model_biens <- LDA(dtm_biens, k = 4, control = list(seed = 120125))  # k = nombre de thèmes
lda_terms_biens <- terms(lda_model_biens, 10)  # Les 10 termes les plus associés à chaque thème
# Affichage des thèmes
print(lda_terms_biens)

      Topic 1     Topic 2                Topic 3    Topic 4        
 [1,] "fasotech"  "maison"               "fasotech" "tecno"        
 [2,] "après"     "être"                 "juste"    "tecnomobilebf"
 [3,] "gauche"    "intérieur"            "gauche"   "être"         
 [4,] "juste"     "kalgondin"            "après"    "tout"         
 [5,] "facebook"  "situer"               "whatsapp" "tablette"     
 [6,] "orange"    "room"                 "vevoir"   "plus"         
 [7,] "livraison" "show"                 "tourner"  "megapad"      
 [8,] "avoir"     "whatsapp"             "total"    "cadeau"       
 [9,] "aéroport"  "ouagadougou"          "station"  "promo"        
[10,] "erimetal"  "wwwinterieurmaisonbf" "shell"    "moment"

Note: Nous avons plutôt opté pour 4 thèmes. Ce choix se justifie par le fait que à cinq topic les mots contribuant à chacun d’eux se répète le plus souvent. Preuve que les topics auront des noms similaires. Pourtant lorsqu’on réduit ce nombre à quatre les topics seront uniques c’est-à-dire qu’il y aura peu de similarité.

Identification et interprétation des thèmes principaux

Thème 1:Publicité et services digitaux

Les mots-clés comme “fasotech”, “facebook”, “orange”, et “livraison” montrent un lien avec des services numériques, les réseaux sociaux, et la communication en ligne.

Thème 2: Communication et lieux.

Les mots clés commes “wwwinterieurmaisonbf”, “whatsapp” font allusion aux moyen de communication utiliser par les entreprises d’offre de biens. Les mots comme Ouagoudou, kalgondin au lieu d’installations des entreprises de biens selectionnées.

Thème 3:Localisation.

Les mots comme “juste”, “gauche”, “après”, “tourme”, “station” montrent les directives pour trouver l’entreprises c’est à dire sa localisation.

Thème 4:Promotions et produits électroniques

Les mots “tecno”, “tablette”, “megapad”, “cadeau”, “promo” et “moment” orientent vers un thème autour des promotions sur des produits électroniques et des campagnes commerciales.

Etape 5: Visualisations

Termes les plus récurrents par thèmes

Services

# Récupération des probabilités d'occurence de chaque mots par thème

topics_services <- tidy(lda_model_services, matrix = "beta")
topics_services

# A tibble: 4,200 × 3
   topic term        beta
   <int> <chr>      <dbl>
 1     1 course 1.92e-111
 2     2 course 1.25e-109
 3     3 course 7.31e- 12
 4     4 course 3.58e-  3
 5     1 fête   5.69e- 99
 6     2 fête   7.87e-  4
 7     3 fête   5.85e-  3
 8     4 fête   2.59e-  3
 9     1 max    9.48e-  3
10     2 max    9.51e-  7
# ℹ 4,190 more rows

# Sélection des termes les plus récurrents par thème
top_terms_by_topic_services <- topics_services %>%
  group_by(topic) %>%
  slice_max(beta, n = 10) %>%  # Les 10 mots les plus représentatifs par thème
  ungroup()

# Affichage des résultats
print(top_terms_by_topic_services)

# A tibble: 40 × 3
   topic term       beta
   <int> <chr>     <dbl>
 1     1 telecel  0.0585
 2     1 money    0.0549
 3     1 bonus    0.0432
 4     1 jour     0.0323
 5     1 être     0.0297
 6     1 numéro   0.0296
 7     1 recharge 0.0288
 8     1 via      0.0271
 9     1 compte   0.0255
10     1 tout     0.0249
# ℹ 30 more rows

library(ggwordcloud)
topics_services<-tidy(lda_model_services,matrix="beta")
# Sélectionner les termes les plus probables par topic
top_terms_by_topic_services <- topics_services %>%
  group_by(topic) %>%
  slice_max(beta, n = 30) %>%  # Sélection des 30 termes les plus représentatifs par thème
  ungroup()

# Pivot pour créer une table avec un Topic par colonne
term_matrix <- top_terms_by_topic_services %>%
  mutate(topic = paste0("Topic ", topic)) %>%  # Renommer les topics avec "Topic" et leur numéro
  group_by(topic) %>%
  mutate(term_rank = row_number()) %>%  # Ajouter un rang pour chaque terme dans chaque topic
  pivot_wider(names_from = topic, values_from = term) %>%  # Pivot pour avoir un Topic par colonne
  select(-term_rank)  # Supprimer la colonne de rang si non nécessaire



# Assurez-vous que 'term_matrix' contient à la fois 'beta' et les colonnes de 'Topic'

# Exemple de structure si votre data frame contient 'beta' et les Topics
# Préparation des données pour la visualisation du nuage de mots
term_matrix %>%
  rownames_to_column("id") %>%
  mutate(id = as.numeric(id)) %>%
  pivot_longer(cols = starts_with("Topic"), names_to = "topic", values_to = "term") %>%
  filter(!is.na(term)) %>%  # Filtrer les valeurs NA
  ggplot(aes(label = term, size = beta, color = factor(topic), alpha = beta)) +
  geom_text_wordcloud(seed = 123) +  # Génération du nuage de mots
  facet_wrap(~topic, scales = "free") +  # Un nuage de mots par topic
  scale_alpha_continuous(range = c(0.4, 1)) +  # Ajustement de la transparence
  scale_color_manual(values = c("dodgerblue4", "firebrick4", "darkgreen", "darkorange3")) +  # Couleurs personnalisées
  theme_minimal() +  # Thème minimal
  theme(strip.background = element_rect(fill = "firebrick"),  # Style des étiquettes
        strip.text.x = element_text(colour = "white"))

Biens

topics_biens<-tidy(lda_model_biens,matrix="beta")

# Sélectionner les termes les plus probables par topic
top_terms_by_topic_biens <- topics_biens %>%
  group_by(topic) %>%
  slice_max(beta, n = 30) %>%  # Sélection des 30 termes les plus représentatifs par thème
  ungroup()

# Pivot pour créer une table avec un Topic par colonne
term_matrix_biens <- top_terms_by_topic_biens %>%
  mutate(topic = paste0("Topic ", topic)) %>%  # Renommer les topics avec "Topic" et leur numéro
  group_by(topic) %>%
  mutate(term_rank = row_number()) %>%  # Ajouter un rang pour chaque terme dans chaque topic
  pivot_wider(names_from = topic, values_from = term) %>%  # Pivot pour avoir un Topic par colonne
  select(-term_rank)  # Supprimer la colonne de rang si non nécessaire



# Assurez-vous que 'term_matrix' contient à la fois 'beta' et les colonnes de 'Topic'

# Exemple de structure si votre data frame contient 'beta' et les Topics
# Préparation des données pour la visualisation du nuage de mots
term_matrix_biens %>%
  rownames_to_column("id") %>%
  mutate(id = as.numeric(id)) %>%
  pivot_longer(cols = starts_with("Topic"), names_to = "topic", values_to = "term") %>%
  filter(!is.na(term)) %>%  # Filtrer les valeurs NA
  ggplot(aes(label = term, size = beta, color = factor(topic), alpha = beta)) +
  geom_text_wordcloud(seed = 123) +  # Génération du nuage de mots
  facet_wrap(~topic, scales = "free") +  # Un nuage de mots par topic
  scale_alpha_continuous(range = c(0.4, 1)) +  # Ajustement de la transparence
  scale_color_manual(values = c("dodgerblue4", "firebrick4", "darkgreen", "darkorange3")) +  # Couleurs personnalisées
  theme_minimal() +  # Thème minimal
  theme(strip.background = element_rect(fill = "firebrick"),  # Style des étiquettes
        strip.text.x = element_text(colour = "white"))

Nuage de mots

library(wordcloud2)
library(gridExtra)
library(htmlwidgets)

# Préparer les données (remplace par tes propres données)
word_freq_services <- as.data.frame(as.matrix(dtm_services)) %>%
  colSums() %>%
  sort(decreasing = TRUE)
word_freq_services <- data.frame(
  word = names(word_freq_services),  # Mots des services
  freq = as.numeric(word_freq_services) # Fréquences des services
)

# Nuage de mots pour les services
set.seed(120125)
cloud_services <- wordcloud2(data = word_freq_services, size = 0.5, color = "random-dark")
cloud_services

Commentaire: Les entreprises d’offre de services c’est-à-dire Orange, Moov et Telecel dans leur moyen d’attirer la clientèle à travers les publicités sur l’application Facebook mettent en avant leurs noms et misent sur les offres ( à travers les mots profiter, bonus, valables, forfaits, gagner, via, etc.), les moyens d’accès aux services ( fait allusion aux mots, souscription, appeler, taper, recharger, composer, etc.) et le mode de communication directe avec l’entreprise pour des renseignements.

library(wordcloud2)
library(gridExtra)
library(htmlwidgets)


# Nuage de mots pour les biens
word_freq_biens <- as.data.frame(as.matrix(dtm_biens)) %>%
  colSums() %>%
  sort(decreasing = TRUE)
word_freq_biens <- data.frame(
  word = names(word_freq_biens),  # Mots des biens
  freq = as.numeric(word_freq_biens) # Fréquences des biens
)

set.seed(120125)
cloud_biens <- wordcloud2(data = word_freq_biens, size = 0.2, color = "random-light")
cloud_biens

Le nuage de mot est affiché dans un onglet généré à côté

Commentaire: Pour les entreprises d’offre de biens telles que “Intérieur Maison”, “Fasotech” et “Tecno”, certains d’entre elles mettent en avant le nom de leur de leur entreprise comme Fasotech. En générale ces entreprises mettent plus en avant leurs localisations à travers des indications sur les voies à emprunter et les moyens de communications.

Dominance des émotions suscitées par les textes publicitaires (Biens VS services)

library(tidyverse)
library(gridExtra)

# Associer les mots du corpus des services avec les émotions du fichier FEEL
emotions_analysis_services <- cleaned_text_services %>%
  inner_join(sentiment_lexicon, by = c("lemma" = "word")) %>%
  select(lemma, joy, fear, sadness, anger, surprise, disgust) %>%
  summarize(across(joy:disgust, sum))

# Restructurer les données pour ggplot (services)
emotions_long_services <- emotions_analysis_services %>%
  pivot_longer(cols = everything(), names_to = "emotion", values_to = "count")

# Créer le graphique des services
plot_services <- ggplot(emotions_long_services, aes(x = reorder(emotion, count), y = count, fill = emotion)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  labs(title = "Émotions dominantes dans les services (Lexique FEEL)",
       x = "Émotion",
       y = "Nombre d'occurrences") +
  theme_minimal()

# Associer les mots du corpus des biens avec les émotions du fichier FEEL
emotions_analysis_biens <- cleaned_text_biens %>%
  inner_join(sentiment_lexicon, by = c("lemma" = "word")) %>%
  select(lemma, joy, fear, sadness, anger, surprise, disgust) %>%
  summarize(across(joy:disgust, sum))

# Restructurer les données pour ggplot (biens)
emotions_long_biens <- emotions_analysis_biens %>%
  pivot_longer(cols = everything(), names_to = "emotion", values_to = "count")

# Créer le graphique des biens
plot_biens <- ggplot(emotions_long_biens, aes(x = reorder(emotion, count), y = count, fill = emotion)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  labs(title = "Émotions dominantes dans les biens (Lexique FEEL)",
       x = "Émotion",
       y = "Nombre d'occurrences") +
  theme_minimal()

# Afficher les deux graphiques (services en haut, biens en bas)
grid.arrange(plot_services, plot_biens, ncol = 1)

Commentaire: Les entreprises offrant des services utilisent plus d’émotions de surprise dans leurs publicités pour avoir plus de clientèles. Par contre les graphiques nous disent que les entreprises d’offres de biens utilisent plus la peur comme émotion ce qui n’est peut être pas vraie dans cette analyse car elle est basée sur le fichier fell.csv qui n’est pas specialisé pour les publicités mais il est plus générale. La contribution de chaque mot pour les différentes émotions nous permettra de trancher afin de conclure en énumerant l’émotion la plus utilisée par ces entreprises.

Mots contribuants à chaque emotions

Services

# Installer et charger les packages nécessaires
library(gridExtra)
library(ggplot2)
library(dplyr)

# Associer les mots avec les émotions à partir du lexique FEEL pour les services
emotions_words_services <- cleaned_text_services %>%
  inner_join(sentiment_lexicon, by = c("lemma" = "word")) %>%  # Associer les mots avec le lexique
  pivot_longer(cols = joy:disgust, names_to = "emotion", values_to = "contribution") %>%  # Restructurer les colonnes d'émotions
  filter(contribution > 0)  # Garder uniquement les mots qui contribuent à une émotion

# Afficher les mots par émotion pour les services
words_by_emotion_services <- emotions_words_services %>%
  group_by(emotion) %>%
  count(lemma, sort = TRUE) %>%  # Compter les occurrences de chaque mot par émotion
  slice_head(n = 10)  # Obtenir les 10 mots les plus fréquents pour chaque émotion

# Graphique des services
graph_services <- ggplot(words_by_emotion_services, aes(x = reorder(lemma, n), y = n, fill = emotion)) +
  geom_bar(stat = "identity", show.legend = FALSE) +
  facet_wrap(~ emotion, scales = "free_y") +
  coord_flip() +
  labs(title = "Top mots contribuant à chaque émotion (Services)",
       x = "Mot",
       y = "Fréquence") +
  theme_minimal()

print(graph_services)

Commentaire: Ces entreprises ont des émotions basées à majorité sur la surprise et cela s’explique par les promotions et offres en faveurs du client.

Biens

# Associer les mots avec les émotions à partir du lexique FEEL pour les biens
emotions_words_biens <- cleaned_text_biens %>%
  inner_join(sentiment_lexicon, by = c("lemma" = "word")) %>%
  pivot_longer(cols = joy:disgust, names_to = "emotion", values_to = "contribution") %>%
  filter(contribution > 0)

# Afficher les mots par émotion pour les biens
words_by_emotion_biens <- emotions_words_biens %>%
  group_by(emotion) %>%
  count(lemma, sort = TRUE) %>%
  slice_head(n = 10)

# Graphique des biens
graph_biens <- ggplot(words_by_emotion_biens, aes(x = reorder(lemma, n), y = n, fill = emotion)) +
  geom_bar(stat = "identity", show.legend = FALSE) +
  facet_wrap(~ emotion, scales = "free_y") +
  coord_flip() +
  labs(title = "Top mots contribuant à chaque émotion (Biens)",
       x = "Mot",
       y = "Fréquence") +
  theme_minimal()

print(graph_biens)

Commentaire: Pour ces entreprises d’offres de biens nous remarquons les 10 mots contribuant le plus à l’émotion peur sont erroner car elle indique les plus sous la direction à emprunter pour trouver l’entreprise ou plus précisement la localisaton. Nous pouvons de la conclure que l’émotion domimante est la suprise.

# Charger les bibliothèques nécessaires
library(wordcloud2)
library(htmlwidgets)

# Préparer les données (remplacez par vos propres données)
word_freq_biens <- as.data.frame(as.matrix(dtm_biens)) %>%
  colSums() %>%
  sort(decreasing = TRUE)
word_freq_biens <- data.frame(
  word = names(word_freq_biens),  # Mots des biens
  freq = as.numeric(word_freq_biens) # Fréquences des biens
)

# Créer le nuage de mots
set.seed(120125)
cloud_biens <- wordcloud2(data = word_freq_biens, size = 0.3, color = "random-light")

# Enregistrer le nuage de mots dans un fichier HTML
output_file <- "nuage_biens.html"
saveWidget(cloud_biens, output_file, selfcontained = TRUE)

# Ouvrir automatiquement le fichier HTML dans le navigateur
browseURL(output_file)