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)
#################################BASE ORANGE TELMOB ET TELECEL
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$publicitesProjet Text Mining
Projet1: Analyse de texte dans un corpus
Etape1: Selection du Dataset
Le travail 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
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 \U0001d412\U0001d412\U0001d412\U000…
2 doc10 "bureau rangement disponible f cfer lieu f cfer \U0001d412\U0001d412…
3 doc11 "table manger marbre disponible f cfa lieu f cfa \U0001d412\U0001d41…
4 doc12 "salon turc place disponible f cfer lieu f cfer \U0001d412\U0001d412…
5 doc13 "commode vêtement disponible f cfer lieu f cfer \U0001d412\U0001d412…
6 doc14 "noël arriver grand c être moment faire achat \U0001f381 \U0001f389 \…
7 doc15 "noël arriver grand c être moment faire achat \U0001f381 \U0001f389 \…
8 doc16 "profiter weekend découvrir cuisine complet moderne élégant faire mai…
9 doc17 "\U0001d40e\U0001d40e\U0001d40e\U0001d40e\U0001d40e \U0001d42c\U0001d…
10 doc18 "\U0001d40e\U0001d40e\U0001d40e\U0001d40e\U0001d40e \U0001d42c\U0001d…
# ℹ 77 more rowsEtape 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")
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: 762)>>
Non-/sparse entries: 5073/61221
Sparsity : 92%
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:
- 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,] "🗗" "intérieur" "fasotech" "être"
[2,] "𝗗𝗗𝗗𝗗" "maison" "juste" "📰"
[3,] "télé" "être" "après" "intérieur"
[4,] "" "situer" "gauche" "maison"
[5,] "syinix" "whatsapp" "erimetal" "𝗕𝗕𝗕𝗕"
[6,] "𝗗𝗗" "kalgondin" "aéroport" "𝗕𝗕𝗕𝗕𝗕𝗕"
[7,] "tecno" "wwwinterieurmaisonbf" "shell" "𝗕𝗕"
[8,] "🝭" "gauche" "quand" "𝖲𝖲𝖲𝖲"
[9,] "tecnomobilebf" "route" "tourner" "🃰"
[10,] "opter" "ouagadougou" "où" "whatsapp" Identification et interprétation des thèmes principaux
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# Visualisation des termes par thème
ggplot(top_terms_by_topic_services, aes(x = reorder(term, beta), y = beta, fill = factor(topic))) +
geom_bar(stat = "identity") +
coord_flip() +
facet_wrap(~ topic, scales = "free", ncol = 2) + # Un graphique par thème
theme_minimal() +
labs(title = "Termes dominants par thème",
x = "Termes",
y = "Probabilité β",
fill = "Thème")
- Biens
# Récupération des probabilités d'occurence de chaque mots par thème
topics_biens <- tidy(lda_model_biens, matrix = "beta")
topics_biens# A tibble: 3,048 × 3
topic term beta
<int> <chr> <dbl>
1 1 alimentation 1.49e-11
2 2 alimentation 8.42e- 3
3 3 alimentation 2.88e-87
4 4 alimentation 6.96e- 3
5 1 aller 2.68e- 3
6 2 aller 5.70e- 3
7 3 aller 3.50e-14
8 4 aller 6.96e- 3
9 1 ameublement 2.81e- 7
10 2 ameublement 6.01e- 3
# ℹ 3,038 more rows# Sélection des termes les plus récurrents par thème
top_terms_by_topic_biens <- topics_biens %>%
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_biens)# A tibble: 40 × 3
topic term beta
<int> <chr> <dbl>
1 1 "\U0001f5d7" 0.0363
2 1 "\U0001d5d7\U0001d5d7\U0001d5d7\U0001d5d7" 0.0272
3 1 "télé" 0.0257
4 1 "\U0001f1d7" 0.0242
5 1 "syinix" 0.0212
6 1 "\U0001d5d7\U0001d5d7" 0.0212
7 1 "tecno" 0.0195
8 1 "\U0001f76d" 0.0181
9 1 "tecnomobilebf" 0.0136
10 1 "opter" 0.0136
# ℹ 30 more rows# Visualisation des termes par thème
ggplot(top_terms_by_topic_biens, aes(x = reorder(term, beta), y = beta, fill = factor(topic))) +
geom_bar(stat = "identity") +
coord_flip() +
facet_wrap(~ topic, scales = "free", ncol = 2) + # Un graphique par thème
theme_minimal() +
labs(title = "Termes dominants par thème",
x = "Termes",
y = "Probabilité β",
fill = "Thème")
- 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
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.5, color = "random-light")
cloud_biens- 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)
- 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)
- 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)