ECF932 : Techniques avancées en évaluation sensorielle

Importation des données

Dans cette expérience, 103 consommateurs ont testé 8 jus d’orange, classés selon trois critères :

• Marque (Jafaden ou Tropicana)
• Pulpe (Avec ou Sans)
• Réfrigéré (Oui ou Non).

Pour chaque test, les consommateurs ont donné une note :

• d’appréciation globale, sur une échelle de 1 à 9;
• d’appréciation sensorielle, sur une échelle de 1 à 5 pour 6 attributs :
  • Nuance de couleur
  • Intensité de l’odeur
  • Goût de sucre
  • Acidité
  • Amertume
  • Caractère pulpeux.

1. Importer le jeu de données orange.csv disponible sur connect. Effectuer un résumé rapide des données, et nettoyer le jeu de donneés si nécessaire (remplacement des valeurs manquantes, transformation des variables…)

library(tidyverse)
orange <- read.csv("orange.csv",sep=";")
summary(orange)
orange <- orange %>% mutate_at(c(1:2,4:9),.funs = as.factor)
sum(is.na(orange)) # Aucune valeur manquante

Cartographie interne des préférences

Avant d’effectuer une analyse JAR, le première chose à faire est de représenter la cartographie interne des préférences.

2. Créer un jeu de données tel que chaque colonne représente les notes hédoniques (liking) données par chaque consommateur.

cart_orange <- orange %>%
  pivot_wider(id_cols = Juice,
              names_from = Consumer,
              values_from = Liking)

3. A l’aide des packages FactoMineRet factoextra, effectuer une Analyse en Composantes Principales (ACP) de ce jeu de données, et faire la carte des préférences.

# Pour que les noms s'affichent correctement sur le graphique
cart_orange <- as.data.frame(cart_orange)
rownames(cart_orange) <- cart_orange$Juice
cart_orange <- select(cart_orange,-Juice)

library(FactoMineR)
library(factoextra)
pca_cart <- PCA(cart_orange,graph=FALSE)
fviz_pca_biplot(pca_cart)

4. Commenter ce graphique.

Représentations graphiques

5. Créer une table répertoriant la note d’appréciation moyenne pour chaque jus d’orange. On pourra s’aider des fonctions group_by()et summarise().

mean_liking <- orange %>%
  group_by(Juice) %>%
  summarise(Mean=mean(Liking)) %>%
  ungroup()

6. A l’aide de la fonction ggplot(), représenter ces notes moyennes par un diagramme en barres.

ggplot(mean_liking)+aes(x=Juice,y=Mean,fill=Mean)+
  geom_bar(stat="identity",width = 0.8,show.legend=FALSE)+
  geom_text(aes(label=round(Mean,2)),position = position_stack(vjust = 0.9))+
  theme_bw()+
  labs(x="Jus d'orange",y="Note moyenne",title = "Note d'appréciation moyenne des jus d'orange")+
  scale_fill_distiller(palette = "RdYlBu")

7. Représenter, pour chaque produit, un boxplot des notes d’appréciation globale données par les consommateurs.

library(RColorBrewer)

ggplot(orange)+aes(x=Juice,y=Liking,fill=Juice)+
  geom_boxplot(show.legend = FALSE)+
  scale_fill_brewer(palette = "Set2")+
  theme_bw()+
  labs(x="Jus d'orange",y="Note hédonique",title = "Distribution des notes hédoniques des jus de fruit")

8. Effectuer un diagramme en barres donnant la répartition des notes JAR des différents attributs. On fera un graphique par produit.

Indications :

• On créera un tableau de données au format long avec la fonction pivot_longer(), où tous les attributs JAR seront mis dans la même colonne, en face desquels on donnera la note JAR donnée par les consommateurs.
• On groupera ensuite les données par produit, attribut et note JAR, afin de compter le nombre de notes attribuées à chaque catégorie
• Pour créer un graphique par produit, on peut utiliser la fonction facet_wrap().

df_graph_JAR_orange <- orange  %>%
  pivot_longer(cols=4:9,names_to = "Attribut",
               values_to = "Note_JAR") %>% group_by(Juice,Attribut,Note_JAR) %>%
  summarise(Effectif = n())
ggplot(df_graph_JAR_orange)+aes(x=Attribut,
                                y=Effectif,
                                fill=Note_JAR)+
  geom_bar(stat = "identity",color="grey20")+
  facet_wrap(~Juice,nrow=2)+
  scale_fill_brewer(palette = "RdYlBu",direction = -1)+
  theme_bw()+
  labs(title="Répartition des notes JAR par produit")+
  theme(axis.text.x = element_text(angle=90))

9. Effectuer une représentation semblable, mais en faisant un graphique par attribut.

ggplot(df_graph_JAR_orange)+aes(x=Juice,
                                y=Effectif,
                                fill=Note_JAR)+
  geom_bar(stat = "identity",color="grey20")+
  facet_wrap(~Attribut,nrow=2)+
  scale_fill_brewer(palette = "RdYlBu",direction = -1)+
  theme_bw()+
  labs(title = "Répartition des notes JAR par attribut",
       x="Produit")+
  theme(axis.text.x = element_text(angle=90))

Analyse des pénalités (tous produits confondus)

10. Ecrire une fonction cat3() permettant de transformer un vecteur factoriel (comprenant des niveaux JAR de 1 à 5), en un nouveau vecteur factoriel codé comme suit :

• La catégorie “Pas assez” est codée 1;
• La catégorie “JAR” est codée 2;
• La catégorie “Trop” est codée 3.

cat3 <- function(x){
  y <- as.numeric(x)
  res <- 1*(y<3)+2*(y==3)+3*(y>3)
  return(as.factor(res))
}

11. Appliquer la fonction cat3() à tous les attributs JAR du jeu de données orange. On stockera le nouveau jeu de données dans un data-frame orange3cat.

orange3cat <- orange %>%
  mutate_at(4:9,.funs = cat3)

12. Recoder les niveaux des modalités JAR (ici 1,2, 3) avec le nom du descripteur sous la forme NomDescripteur_NoteJAR, par exemple Nc_2

for(i in 4:9){
  levels(orange3cat[,i]) <- paste(colnames(orange3cat)[i],1:3,sep="_")
}

13. Avec la fonction JAR() du package SensoMineR, déterminer les pénalités des différentes catégories pour les attributs JAR.

library(SensoMineR)

jar_orange <- JAR(orange3cat,col.p = 2,col.j = 1,col.pref = 3,jarlevel = 2)

14. Quels sont les effets sur la note d’appréciation globale qui vous semblent pertinent de retenir ? Justifier.

15. Avec le code suivant, représenter graphiquement les pénalités en fonction de la fréquence de l’attribut JAR considéré. Faire un graphique par produit.

par(mfrow=c(2,4))
for (i in 1:nlevels(orange3cat$Juice)){
  plot(jar_orange,name.prod=levels(orange3cat$Juice)[i],model=1, 
       ylab="mean drops (all products")
  points(jar_orange$Frequency[,i],jar_orange$penalty1[,1],
         pch=19, col=rep(c("skyblue","tomato")))
}
par(mfrow=c(1,1))

Quels semblent être les inconvénients de cette fonction ?

16. On se propose à présent d’effectuer “manuellement” cette analyse des pénalités. Cela aura l’inconvénient d’être un peu plus long, mais cela possède aussi différents avantages :

• on explore plus en détails les données;
• on peut faire des graphiques beaucoup plus soignés;
• on pourra alors conduire nos analyses par produit.

Créer tout d’abord, à partir du data-frame orange, un data-frame df_penalty, ou on retire les colonnes Juice et Consumer (elles ne présentent pas d’intérêt si on mène une analyse tous produits confondus).

Recoder ensuite les attributs JAR avec la fonction cat3().

df_penalty <- orange %>% select(-Juice,-Consumer) %>%
  mutate_if(.predicate = is.factor,.funs = cat3)

17. Transformer df_penaltyen format long, comme on avait pu le faire précédemment.

df_penalty <- df_penalty %>%
  pivot_longer(cols=2:7,names_to = "Attribut",values_to = "Note_JAR") %>%
  arrange(Attribut,Note_JAR)

18. Grouper les lignes du data-frame par attribut et évaluation JAR, puis calculer la moyenne et l’écart-type des appréciations globales par groupe, ainsi que les effectifs de chaque groupe.

df_penalty <- df_penalty %>%
  group_by(Attribut,Note_JAR) %>%
  summarise(Mean_Liking = mean(Liking),
         Sd_Liking = sd(Liking),
         Nb_cat = n()) %>%
  ungroup()

19. Calculer les pénalités pour chaque catégorie, ainsi que les degrés de liberté pour chaque catégorie dans le test de comparaison de moyennes de Student.

df_penalty <- df_penalty %>%
  group_by(Attribut) %>%
  mutate(Mean_Drop = Mean_Liking[2]-Mean_Liking,
         DDL = Nb_cat+Nb_cat[2]-2) %>%
  ungroup()

20. Créer une fonction T_calc() qui prendra comme paramètres :

• la pénalité de moyenne;
• les effectifs des catégories “JAR” et “Trop”/“Pas assez”“;
• les écart-types de ces catégories,

et qui calcule la statistique de test associé au test de Student.

T_calc <- function(mdrop,n1,n2,s1,s2){
  sqrt(n1+n2-2)*mdrop/sqrt(((n1-1)*s1^2+(n2-1)*s2^2)*(1/n1+1/n2))
}

21. Créer également des fonctions borne_inf() et borne_sup() permettant de calculer les bornes d’un intervalle de confiance de la pénalité dans ce dernier cas.

borne_inf <- function(mdrop,n1,n2,s1,s2){
  mdrop-qt(0.975,n1+n2-2)*sqrt(((n1-1)*s1^2+(n2-1)*s2^2)*(1/n1+1/n2))/sqrt(n1+n2-2)
}

borne_sup <- function(mdrop,n1,n2,s1,s2){
  mdrop+qt(0.975,n1+n2-2)*sqrt(((n1-1)*s1^2+(n2-1)*s2^2)*(1/n1+1/n2))/sqrt(n1+n2-2)
}

22. Calculer ensuite les statistiques de test pour chaque attribut, ainsi que les bornes des intervalles de confiance associés à chaque pénalité. Calculer également la fréquence (par attribut) associée à chaque catégorie

df_penalty <- df_penalty %>%
  group_by(Attribut) %>%
  mutate(T_stat = T_calc(Mean_Drop,Nb_cat,Nb_cat[2],Sd_Liking,Sd_Liking[2]),
         Borne_Inf=borne_inf(Mean_Drop,Nb_cat,Nb_cat[2],Sd_Liking,Sd_Liking[2]),
         Borne_Sup=borne_sup(Mean_Drop,Nb_cat,Nb_cat[2],Sd_Liking,Sd_Liking[2]),
         Freq = Nb_cat/sum(Nb_cat)) %>%
  ungroup()

23. Ajouter les p-values associées aux statistiques calculées.

df_penalty <- df_penalty %>%
  mutate(p_value = 1-pt(T_stat,DDL))

24. Enfin, ajouter deux variables qualitatives précisant si :

• les pénalités doivent être prises en compte;
• les pénalités sont significatives.

df_penalty <- df_penalty %>%
  mutate(Comm = Freq >=0.2 & Nb_cat >=15,
         Signif = p_value <0.05) %>%
  mutate(Signif = factor(Signif,
         levels=c(TRUE,FALSE),
         labels=c("Oui","Non")))

25. Retirer enfin les catégories “JAR”.

df_penalty <- df_penalty %>%
  filter(Note_JAR !=2)

26. Réaliser le graphique croisé des pénalités et des fréquences des attributs. On ajoutera :

• Une ligne verticale à la fréquence 0.2;
• les intervalles de confiance;
• une couleur indiquant si la pénalité est significative.

ggplot(df_penalty)+aes(x=Freq,y=Mean_Drop,colour=Signif)+
  geom_point()+
  geom_errorbar(aes(ymin = Borne_Inf,ymax = Borne_Sup),width = 0.02)+
  geom_vline(xintercept = 0.2,color="skyblue",
             linetype="dashed",linewidth=1)+
  geom_text(aes(label=paste(Attribut,Note_JAR,sep="_")),show.legend = FALSE)+
  theme_bw()+
  labs(x="Fréquence",y="Pénalité",title = "Graphique croisé des pénalités")+
  guides(colour=guide_legend(title = "Significatif"))

Pénalités pondérées

27. Ajouter une colonne Penalite_W au data-frame df_penalty, calculant les pénalités pondérées. On fixera à 0 l’ensemble des pénalités qui ne sont pas pertinentes.

df_penalty <- df_penalty %>%
  mutate(Penalite_W = Freq*Mean_Drop*Comm) 

28. Réaliser alors un diagramme en barres des pénalités pondérées, et tracer un seuil déterminant si les défauts sont majeurs ou non.

df_penalty <-df_penalty %>%
  mutate(Attribut=paste(Attribut,Note_JAR,sep="_"))

ggplot(df_penalty)+aes(x=Attribut,y = Penalite_W)+
  geom_bar(stat="identity",color="grey20",fill="tomato")+
  geom_hline(yintercept = 1,color="skyblue",
             linetype="dashed",linewidth=1)+
  theme_bw()+
    labs(y="Pénalité pondérée",title = "Graphique des pénalités pondérées")+
  theme(axis.text.x = element_text(angle=90))

Analyse exploratoire

29. Après avoir créer un individu fictif idéal, réaliser une Analyse en Composantes Principales (ACP) des évaluations JAR du jeu de données. Interpréter.

df_orange_pca <- orange %>%
  mutate_at(.vars = 4:9,.funs=as.numeric) %>%
  select(-Consumer) %>%
  mutate(Juice=as.character(Juice))

df_orange_pca[849,] <-c("Ideal",9,rep(3,6))

df_orange_pca <- df_orange_pca %>%
  mutate(Juice=as.factor(Juice)) %>%
  mutate_at(2:8,.funs = as.numeric)

pca_orange <- PCA(df_orange_pca,quali.sup = 1,quanti.sup = 2,
                  graph = FALSE)
plot.PCA(pca_orange,choix="var")
plot.PCA(pca_orange,choix="ind",invisible = "ind",
         col.quali = brewer.pal(9,"Paired"))

30. Réaliser cette même ACP, mais cette fois avec les données agrégées.

df_orange_pca_agg <- df_orange_pca %>%
  group_by(Juice) %>%
  mutate_at(2:8,.funs = mean) %>%
  ungroup()%>%
  unique()

pca_orange_agg <- PCA(df_orange_pca_agg,quali.sup = 1,quanti.sup = 2,graph = FALSE)

plot.PCA(pca_orange_agg,choix="var")
plot.PCA(pca_orange_agg,choix="ind",invisible = "ind",
         col.quali = brewer.pal(9,"Paired"))

31. Créer un nouveau data-frame, ou le codage des attributs JAR est dédoublé :

• Une colonne “dummy” pour les attributs “Pas assez”.
• Une colonne “dummy” pour les attributs “Trop”.

Réaliser ensuite l’ACP sur ce dernier jeu de données.

dummy_codage <- function(x){
  y <- as.numeric(x)
  res <- -2*(y==1) + (-1)*(y==2) + 0*(y==3) + 1*(y==4) + 2*(y==5)
  return(res)
}

orange_dummy <- orange %>%
  mutate_at(.vars = 4:9,.funs = dummy_codage)
orange_dummy2 <- matrix(rep(NA,nrow(orange)*(3+2*6)),nrow = nrow(orange)) %>%
  as.data.frame()

for(i in 0:5){
  orange_dummy2[,4+2*i] <- orange_dummy[4+i]*(orange_dummy[4+i]<0)
  orange_dummy2[,5+2*i] <- orange_dummy[4+i]*(orange_dummy[4+i]>0)
  colnames(orange_dummy2)[4+2*i] <- paste(colnames(orange_dummy)[4+i],"-",sep="")
  colnames(orange_dummy2)[5+2*i] <- paste(colnames(orange_dummy)[4+i],"+",sep="")
}

orange_dummy2[,1:3] <- orange_dummy[,1:3]

colnames(orange_dummy2)[1:3] <- colnames(orange_dummy)[1:3]

orange_dummy2 <- orange_dummy2 %>% select(-Consumer)

pca_dummy <- PCA(orange_dummy2,quali.sup = 1,quanti.sup = 2,
                 graph = FALSE)

plot.PCA(pca_dummy,choix="var",
         col.var = rep(brewer.pal(3,"Set2")[1:2],6))
plot.PCA(pca_dummy,choix="ind",invisible = "ind",
         col.quali = brewer.pal(8,"Set2"))

32. Réaliser l’anlyse des correspondances multiples du jeu de données.

df_orange_mca <- orange %>% select(-Consumer)

mca_orange <- MCA(X = df_orange_mca,quali.sup = 1,quanti.sup = 2,graph=FALSE)

plot.MCA(mca_orange,invisible = "ind",
         col.var = rep(brewer.pal(5,"Set2"),6),
         col.quali.sup = "black")

33. Après avoir agréger les données, ré-effectuer enfin une analyse des correspondances.

orange_long <- orange %>%
  select(-Liking,-Consumer) %>%
  pivot_longer(cols=2:7,names_to = "Attribut",values_to = "Note_JAR") %>%
  mutate(Attribut = paste(Attribut,Note_JAR,sep="_"),.keep = "unused")%>%
  mutate(Attribut=as.factor(Attribut)) %>%
  #complete(Juice,Attribut) %>%
  arrange(Juice,Attribut)

df_orange_mca_agg <- orange_long %>%
  group_by(Juice,Attribut) %>%
  summarise(Counts = n()) %>%
  ungroup() %>%
  complete(Juice,Attribut) %>%
  mutate_all(.funs = replace_na,replace=0) %>%
  pivot_wider(names_from = Attribut,values_from = Counts)

ca_orange <- CA(df_orange_mca_agg,quali.sup = 1,graph=FALSE)
windows(width=1200,height=600)
plot.CA(ca_orange,col.quali.sup = "black",
        col.col = rep(brewer.pal(5,"Set2"),6),
        ggoptions = list(size=2.5),label = "col")