Autour du NPS : du texte au modèle de Kano
cb
19/10/2021
modèle de Kano
Objectifs
Comprendre quels sont les facteurs qui sont associés à une faible ou une forte recommandation. Le cas est celui d’une chaine de jardinerie et d’une enquête menée sur sa clientèle dans les années 2010.
On utilise deux questions principalement :
- une échelle de recommandation (de 0 à 10)
- une question ouverte sur les raison de la note.
Sur la recommandation, c’est la technique du NPS qui est employée. On pourra lire la synthèse de Daniel Ray. On lira ici l’article original.
les packages utilisés
On utilise principalement les ressources de quanteda et l’analyse factorielle des correspondances avec Factominer
knitr::opts_chunk$set(echo = TRUE,include=TRUE, warning=FALSE, message=FALSE)
library(tidyverse)
library(lubridate)
library(quanteda)
library(quanteda.textplots)
library(quanteda.textstats)
library(ggwordcloud)
library(ggmosaic)
library(rcompanion)
library(cowplot)
library ("FactoMineR")
library(factoextra)
library(seededlda)
library(gam)
df<-read_csv("nps.csv", locale = locale(encoding = "WINDOWS-1252"))
#palette de couleur
col<-c("firebrick","Gold3","Darkgreen")
theme_set(theme_minimal())Distribution du NPS
Notre tableau de données rend compte de près de 14000 évaluations en terme de NPS de la relation à une enseigne de jardinage.
foo1<-df %>%
mutate(NPS=ifelse(nps<7, "Détracteurs",
ifelse(nps>6 & nps<9,"Passifs", "Promoteurs")),
p=ifelse(NPS=="Promoteurs", 1, 0),
d=ifelse(NPS=="Détracteurs", 1, 0))
#calcul du score NPS
d<- mean(foo1$d, na.rm=TRUE)
p<-mean(foo1$p, na.rm=TRUE)
score_nps<- round((p-d)*100,1)
g<-ggplot(foo1, aes(x=nps))+
geom_histogram(binwidth = 1,aes(fill=NPS))+
labs( title= " Distribution des scores NPS",
subtitle = paste0("Score NPS = ", score_nps),
caption = "n=13954",
y = "Fréquence")+
scale_fill_manual(values=col)+
scale_x_discrete(name="Note NPS",
breaks=c("1","2","3","4","5","6","7", "8", "9", 10),
limits=c("1","2","3","4","5","6","7", "8", "9", 10))
g 
ggsave("NPS1.jpg", plot=last_plot(), width = 20, height = 20, units = "cm")Comme nous allons traiter du texte et que celui n’est présent que dans une partie des réponses, on peut se demander s’il y a un biais.
#library(ggmosaic)
#library(rcompanion)
#recodons les répondants
foo1 <- foo1 %>%
mutate(reponse=ifelse(is.na(explication), "Pas de réponse", "Réponse"))
t<-table(foo1$NPS,foo1$reponse)
chi2<-chisq.test(t)
chi<-round(chi2$statistic,2)
p<-round(chi2$p.value,3)
V<-cramerV(t, digit=3)
g1 <- ggplot(data = foo1) +
geom_mosaic(aes(x=product(NPS ,reponse), fill = NPS))+
theme(axis.text.x = element_text(angle = 45, hjust = -0.1, vjust = -0.2))+
theme(legend.position = "none")+
labs(title="Un biais négatif de réponse",
subtitle=paste0("chi2 =",chi, " p = ", p, " - V : ", V))+
scale_fill_manual(values=col)
g1
Structure des corrélations
On peut examiner la corrélation de cet indicateurs à quelques autres variables : d’autres jugements, et les comportements antérieurs.
foo2<-foo1 %>% select(3,4,5,7,8,9) %>% drop_na()
r<- round(cor(foo2),3)
library(ggcorrplot)
ggcorrplot(r, hc.order = TRUE, type = "lower",
outline.col = "white",
colors = c("#6D9EC1", "white", "#E46726"),
lab=TRUE)
library(GGally)
ggpairs(foo2, lower = list(continuous = "smooth_loess", combo = ggally_dot_no_facet),title="correlogram with ggpairs()") 
Un petit modèle linéaire
#ggplot(foo1,aes(CaTicket))+geom_histogram(binwidth = 1)
#ggplot(foo1,aes(CaTicket, nps))+geom_point()+geom_smooth() +scale_x_log10()
#ggplot(foo1,aes(NbPassageKS, nps))+geom_point()+geom_smooth() +scale_x_log10()
#ggplot(foo1,aes(t, nps))+geom_point()+geom_smooth() +scale_x_log10()
foo1<- foo1%>%mutate(CaTicket=ifelse(CaTicket<0,0,CaTicket),
CaTicket_l=log10(CaTicket+1))
fit<- lm(nps~log(NbPassageKS)+log(CaTicket+1)+log(t+1), foo1)
summary(fit)##
## Call:
## lm(formula = nps ~ log(NbPassageKS) + log(CaTicket + 1) + log(t +
## 1), data = foo1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.0501 -0.7427 0.3692 1.2375 1.9769
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.09391 0.06535 123.851 < 2e-16 ***
## log(NbPassageKS) 0.20481 0.01713 11.954 < 2e-16 ***
## log(CaTicket + 1) 0.07898 0.01322 5.975 2.35e-09 ***
## log(t + 1) -0.03950 0.01799 -2.195 0.0282 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.605 on 13590 degrees of freedom
## (360 observations deleted due to missingness)
## Multiple R-squared: 0.0116, Adjusted R-squared: 0.01139
## F-statistic: 53.18 on 3 and 13590 DF, p-value: < 2.2e-16library(jtools)
effect_plot(fit, pred=CaTicket, interval = TRUE)#scale_x_log10()
effect_plot(fit, pred=NbPassageKS, interval = TRUE) #+scale_x_log10()
effect_plot(fit, pred=t, interval = TRUE)#scale_x_log10()
Corpus
On utilise quanteda .
# 1 définir le corpus
corpus<-corpus(foo1,text_field ="explication")
# 2 tokeniser le corpus
toks <- tokens(corpus, remove_punct = TRUE) %>%
tokens_remove(pattern = stopwords("fr"))%>%
tokens_remove(pattern="Botanic.*") %>%
tokens_group(groups = NPS)
# 3 construire le dfm
dfm <- dfm(toks) %>%
dfm_trim(min_termfreq = 40, verbose = FALSE)
# 4 afficher le wordcloud
textplot_wordcloud(dfm,comparison = TRUE, color = col)
toks <- tokens(corpus, remove_punct = TRUE) %>%
tokens_remove(pattern = stopwords("fr"))%>%
tokens_remove(pattern="Botanic.*")Un autre wordcloud
Une autre méthode avec meilleure préparation du texte. et surtout de la collocation
pour le détail voir : https://quanteda.io/reference/textstat_collocations.html
toks <- tokens(corpus, remove_punct = TRUE) %>%
tokens_group(groups = NPS)
coloc <- textstat_collocations(toks, size = 2:4, min_count = 10) %>% filter(z>10)
head(coloc, 20)## collocation count count_nested length lambda z
## 1 un peu 262 262 2 5.348520 45.67674
## 2 les prix 239 239 2 3.460110 39.85398
## 3 la carte 157 157 2 4.669984 36.42423
## 4 le personnel 157 157 2 3.493441 34.16533
## 5 il y 87 87 2 5.251938 33.20647
## 6 bons conseils 69 69 2 5.940169 33.11318
## 7 bon accueil 74 74 2 5.785804 32.88838
## 8 y a 90 90 2 5.038816 32.35185
## 9 prix sont 118 118 2 3.602525 31.94199
## 10 en caisse 104 104 2 4.404127 31.53996
## 11 votre magasin 86 86 2 4.293482 30.07066
## 12 du magasin 105 105 2 3.494184 29.71740
## 13 chez vous 62 62 2 4.991237 29.62499
## 14 personnel est 98 98 2 3.527588 29.08215
## 15 aux caisses 48 48 2 6.149972 28.49342
## 16 très agréable 86 86 2 4.177950 28.49024
## 17 pas assez 96 96 2 4.716878 28.35137
## 18 trop cher 58 58 2 4.604763 27.65177
## 19 très bien 94 94 2 3.408625 27.35743
## 20 chez botanic 49 49 2 4.873511 26.91241toks2 <- tokens_compound(toks, pattern = coloc) %>%
tokens_remove(pattern = stopwords("fr") )
dfm <-toks2 %>%
tokens_group(groups = NPS)%>%
dfm()
stat<- dfm %>%
textstat_frequency(n = 50, groups = NPS)
g_b<-ggplot(stat, aes(label = feature)) +
geom_text_wordcloud(aes(size=log(frequency), color=group)) +
theme_minimal()+
facet_wrap(vars(group))+
scale_color_manual(values=col)+
labs(title="Nuage des 50 mots les plus fréquents(Par groupes",
caption = "La taille des mots est proportionnelle au log de leurs fréquences")
g_b
ggsave("NPS3.jpg", plot=last_plot(), width = 20, height = 20, units = "cm")Pour comparer les segments, le Keyness index est particulièrement utile
Il est calculé en comparant un groupe cible à l’ensemble des autres groupes par une mesure d’association : un chi², ou un point.wise correlation.
# Create a dfm per group
dfm <-toks2 %>%
tokens_group(groups = NPS) %>%
dfm()
# Calculate keyness and determine "Promoteurs" as target group againts all other categories
result_keyness <- textstat_keyness(dfm, target = "Promoteurs") %>% filter (n_target>20)
# Plot estimated word keyness
g1<-textplot_keyness(result_keyness, n = 30L, labelsize = 3, show_legend = FALSE,
show_reference = FALSE, color = c("Darkgreen", "gray"))+
xlim(0,80) +
labs(x=NULL)
g1
result_keyness <- textstat_keyness(dfm, target = "Détracteurs" )
g2<-textplot_keyness(result_keyness, n = 30L, labelsize = 3, show_legend = FALSE,
show_reference = FALSE, color = c("firebrick", "gray"))+
xlim(0,80)+
labs(x=NULL)
result_keyness <- textstat_keyness(dfm, target = "Passifs")
g3<-textplot_keyness(result_keyness, n = 30L, labelsize = 3, show_legend = FALSE, show_reference = FALSE, color = c("gold2", "gray"))+xlim(0,80)+ labs(x=NULL)
p<- plot_grid(g2, g3 ,g1, labels = c('Détracteurs', 'Passifs', 'Promoteurs'), label_size = 12, ncol=3)
p
title <- ggdraw() + draw_label("NPS : Les raisons qui conduisent à la recommandation (keyness)", fontface='bold')
note <- ggdraw()+ draw_text("Les valeurs représentent le keyness des termes.\nIl mesure leur caractère distinctif par une statistique du chi²", size=8,x = 0.5, y = 0.5)
plot_grid(title, p,note, ncol=1, rel_heights=c(0.1, 1)) # rel_heights values control title margins
ggsave("NPS4.jpg", plot=last_plot(), width = 20, height = 20, units = "cm")
# pour une comparaison deux à deux
# pres_corpus <- corpus_subset(corpus, NPS %in% c("Détracteurs", "Promoteurs"))
#plot_grid(g ,p,d, labels = c("", "", "", ""), label_size = 12, ncol = 2, nrow = )
#ggsave("NPS5.jpg", plot=last_plot(), width = 20, height = 20, units = "cm")Un peu de topic analysis
La structure du modèle
“modèle LDA”
source : https://arxiv.org/pdf/1003.0783.pdf
preparation des données
# pre processing :
foo1<- foo1 %>%
filter(!is.na(explication))
corpus<-corpus(foo1,text_field ="explication")
toks <- tokens(corpus, remove_punct = TRUE)
cols <- textstat_collocations(toks, size = 2:4, min_count = 10) %>% filter(z>15)
toks2 <- tokens_compound(toks, pattern = cols) %>%
tokens_remove(pattern = stopwords("fr") )
dfm<-dfm(toks2)estimation du modèle
#library(seededlda)
set.seed(123)
tmod_lda <- textmodel_lda(dfm, k = 7)
#lister les mots les plus associés
terms(tmod_lda, 25)
dfm$topic <- topics(tmod_lda)
saveRDS(tmod_lda,"lda.rds")
saveRDS(topic,"topic.rds")On sauvegarde les résultats pour se prémunir de l’instabilité des solutions ( en dépit du set seed) dans un format rds
Une bonne vieille analyse des correspondances pour associer les segments aux thèmes du discours
pour plus de détails sur l’analyse des correspondances regarder par exemple Anne B Dufour.
dfm<-readRDS("topic.rds")
#un peu de recodage
table(dfm$topic)##
## topic1 topic2 topic3 topic4 topic5 topic6 topic7
## 479 417 543 832 483 415 668#on recode pour une meilleure lecture
dfm$topic2[dfm$topic=="topic1"]<-"Caisse"
dfm$topic2[dfm$topic=="topic2"]<-"Magasin"
dfm$topic2[dfm$topic=="topic3"]<-"bioplantes"
dfm$topic2[dfm$topic=="topic4"]<-"Personnel"
dfm$topic2[dfm$topic=="topic5"]<-"Cartedefid"
dfm$topic2[dfm$topic=="topic6"]<-"Achat"
dfm$topic2[dfm$topic=="topic7"]<-"prix"
table(dfm$topic2)##
## Achat bioplantes Caisse Cartedefid Magasin Personnel prix
## 415 543 479 483 417 832 668#le tableau croisé
ca<- table(dfm$topic2, dfm$NPS)
prop.table(ca, 2)##
## Détracteurs Passifs Promoteurs
## Achat 0.15273312 0.11996251 0.08858361
## bioplantes 0.11254019 0.17150890 0.13548081
## Caisse 0.13987138 0.14807873 0.10658456
## Cartedefid 0.16559486 0.14620431 0.10326859
## Magasin 0.07877814 0.09465792 0.12316438
## Personnel 0.05787781 0.09653233 0.32638560
## prix 0.29260450 0.22305530 0.11653245#library ("FactoMineR")
#library(factoextra)
res.ca <- CA (ca, graph = FALSE)
fviz_ca_biplot (res.ca, repel = TRUE)
Régression gam pour mesurer les non-linéarités
elles sont non linéaires donc adaptées à détecter une structure type kano (pour certais attributs l’absence conduit à l’insatisfaction, mais leur présence ne conduit pas à plus d’information, et pour d’autres leur absence ne conduit pas à l’insatisfaction alors que leur présence renforce la satisfaction)
Dans l’idée celà correspond à la théorie bifactorielle de herzberg.
Avec cette application on mesure la présence dans le discours d’un attribut. Ce degré de présence est simplement le paramètre theta du topic k pour texte i. Ce dont les consommateurs parlent peut a priori être aussi bien associés à une bonne ou une mauvaise opinion. Si la corrélation (linéaire est positive) c’est qu’on a affaire à un argument attractif qui ajoute aux attributs de base qui restent transparent pour le locuteur. Si elle est négative c’est qu’on à affaire à un une besoin de base, plus il pose problème et plus on en parle. D’autres attributs peuvent se caractériser par une courbe en U, il sont associé positivement quand on en parle modéremment, ou en compagnie d’un autre attribut. On observe pas la configuration d’un U inversé.
inspiré de https://rpubs.com/apierucci/lm-gam
tmod_lda<- readRDS("lda.rds")
theta<-tmod_lda$theta
topic<-cbind(foo1,theta)
#on recode pour une meilleure lecture
topic <- topic %>%
rename(
Caisse = topic1,
Magasin = topic2,
Bioplantes= topic3,
Personnel=topic4,
Cartedefid= topic5,
Achat= topic6,
Prix =topic7)
library(gam)
mod1 <- gam(nps ~ s(Caisse) +s(Bioplantes)+s(Cartedefid)+s(Magasin)+s(Personnel)+s(Prix),
data = topic, family = gaussian)
summary(mod1)##
## Call: gam(formula = nps ~ s(Caisse) + s(Bioplantes) + s(Cartedefid) +
## s(Magasin) + s(Personnel) + s(Prix), family = gaussian, data = topic)
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -8.6663 -0.7370 0.3912 1.3421 3.0125
##
## (Dispersion Parameter for gaussian family taken to be 3.5739)
##
## Null Deviance: 15277.08 on 3801 degrees of freedom
## Residual Deviance: 13498.76 on 3777 degrees of freedom
## AIC: 15659.01
## 37 observations deleted due to missingness
##
## Number of Local Scoring Iterations: NA
##
## Anova for Parametric Effects
## Df Sum Sq Mean Sq F value Pr(>F)
## s(Caisse) 1 31.1 31.09 8.6977 0.003206 **
## s(Bioplantes) 1 6.9 6.92 1.9357 0.164220
## s(Cartedefid) 1 134.8 134.76 37.7063 9.074e-10 ***
## s(Magasin) 1 21.2 21.23 5.9412 0.014837 *
## s(Personnel) 1 1278.7 1278.73 357.7934 < 2.2e-16 ***
## s(Prix) 1 19.0 18.95 5.3034 0.021338 *
## Residuals 3777 13498.8 3.57
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Anova for Nonparametric Effects
## Npar Df Npar F Pr(F)
## (Intercept)
## s(Caisse) 3 2.4614 0.06077 .
## s(Bioplantes) 3 2.6208 0.04910 *
## s(Cartedefid) 3 0.7900 0.49936
## s(Magasin) 3 3.2169 0.02189 *
## s(Personnel) 3 2.9134 0.03308 *
## s(Prix) 3 8.0422 2.435e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1par(mfrow = c(2, 3))
termplot(mod1,rug = TRUE, se = TRUE, terms = c("s(Caisse)", "s(Bioplantes)", "s(Magasin)", "s(Cartedefid)", "s(Prix)", "s(Personnel)"))