[Etude de marché - Article 6]


Dans le précédent article, nous avons redressé notre échantillon pour que ce dernier soit représentatif de notre population cible. Dans cette article, nous allons construire un tris croisé pour voir s’il y a des différences sgnificatives entre les sous populations (femmes/hommes, 18-25 ans/26-35 ans, …)


5. Traitement Statistique.


5.3. Le tris croisé

Un tris-croisé (ou tableau de contingence) est le résultat d’un croisement des réponses obtenues à deux questions d’un questionnaire.

Les tris croisés permettent de mettre en évidence des différences de comportement sur les sous-populations étudiées, l’existence de variables explicatives et/ou de corrélations entre deux variables.

Par exemple, nous avons demandé aux répondants sur quels réseaux sociaux ils étaient inscrits. Avec le tris-croisé, nous allons voir s’il y a des différences significatives entre les plus jeunes et les plus anciens et/ou entre les hommes et les femmes.


5.3.1. Création de la table

La première étape du tris-croisé est de définir les colonnes. Pour cela, il faut utiliser la fonction “tab_cols”. 2 arguments sont à ajouter :

  • total() : cet argument permet d’avoir une colonne avec le pourcentage au global.
  • les questions à mettre en colonne : ici dans cet exemple –> les questions de signalétique (le genre - Q1 et l’âge - Q2).

Ce qui donne :

# Adaptation des variables - Recode Age  
val_lab(DataBase$RecodeAge) = num_lab("
    1 Moins de 35 ans
    2 35-49 ans
    3 50-64 ans
    4 65 ans et plus")

DataBase %>% 
  tab_cells(mdset(Q3A1%to%Q3A99)) %>% 
  tab_cols(total(), Q1, RecodeAge) %>% # Colonne. 
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_pivot()


5.3.2. Différence significative

Vous venez de créer un tris-croisé. Il est temps maintenant de faire ressortir les différences significatives. Une différence significative signifie qu’il est peu probable que la différence observée soit du au hasard. Le calcul de la différence significative se fait grâce test du χ2.

IL y a deux types de tests :

  • Test “2 à 2” où chaque colonne est comparée aux autres. Les signes de significativité sont des lettres (généralement rappelées en tête de chaque colonne).

  • Test par rapport à l’ensemble (la première colonne du tableau) : la comparaison se fait entre l’ensemble et le reste de la population (l’ensemble moins la colonne considérée). Les signes sont des “+” ou des “-”.


Test 2 à 2.

Il faut ajouter la fonction “tab_last_sig_cpct()” à notre pipe. Sans autre indication, le test est un test 2 à 2. Ce qui donne :

DataBase %>% 
  tab_cells(mdset(Q3A1%to%Q3A99)) %>% 
  tab_cols(total(), Q1, RecodeAge) %>% # Colonne. 
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_last_sig_cpct() %>% 
  tab_pivot()


Ce test permet de dire que les 35/49 ans sont plus inscrits sur Linkedin ou encore que les hommes sont davantages sur Pinterest ou Reddit.


Test par rapport à l’ensemble.

Pour comparer chaque résultat à la première colonne, il faut ajouter la fonction “tab_significance_options” avec l’argument “compare_type =”first_column".Ce qui donne :

DataBase %>% 
  tab_significance_options (compare_type = "first_column") %>% 
  tab_cells(mdset(Q3A1%to%Q3A99)) %>% 
  tab_cols(total(), Q1, RecodeAge) %>% # Colonne. 
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_last_sig_cpct() %>% 
  tab_pivot()


5.3.3. Tris-croisé Données Brutes / Données redressées.

Lorsque vous envoyez à votre client le TAP, il peut être intéressant d’envoyer également les données redressées (et que ce dernier puisse comparer les données brutes et redressées).

Nous allons donc construire un Tris-Croisé avec un tableau avec une colonne avec les données brutes et une autre avec les données redressées.

Pour cela, il faut jouer une première fois la fonction “tab_stat_cases” avant de la jouer une seconde fois, mais ajouter entre les deux la fonction “tab_weight”. Ce qui donne :

# TC données brutes / données redressées. 

DataBase %>%
  tab_cells(Q1) %>% # Question à jouer.
  tab_stat_cases(label = "Données Brutes") %>% # calculate cases
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cases(label = "Données Redressées") %>% # calculate cases
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_pivot(stat_position = "inside_columns") # Création de la table. 


5.3.4. Conclusion.

Avec le TAP et le TC, vous voilà prêt à pouvoir faire la plus grande partie de votre analyse/rapport. D’autres analyses suivront pour alimenter encore plus votre analyse. C’est ce que nous verrons au prochain article.

Ci-dessous le code complet pour faire votre TAP/TC :

# Packages nécessaires:
library(readxl) # --> importer un fichier .xlsx. 
library(expss) # --> TAP, TC, à la manière de SPSS. 
library(survey) # Pouvoir faire le redressement --> appliquer des poids à chaque répondants. 

# Téléchargement des données : 
DataBase <- read_excel("C:/Users/audava/Pictures/Personnel/Blog/Traitement/DataBase.xlsx")


##### TAP #####

# Adaptation des noms des variables.  
DataBase = apply_labels(DataBase,
                      Q1 = "Q1 : Genre", 
                      Q2 = "Q2 : Age", 
                      Q3A1 = "Q3 : Facebook",
                      Q3A2 = "Q3 : Google +", 
                      Q3A3 = "Q3 : Instagram", 
                      Q3A4 = "Q3 : Linkedin", 
                      Q3A5 = "Q3 : Periscope", 
                      Q3A6 = "Q3 : Pinterest", 
                      Q3A7 = "Q3 : Reddit", 
                      Q3A8 = "Q3 : Snapchat", 
                      Q3A9 = "Q3 : TikTok", 
                      Q3A10 = "Q3 : Tumblr", 
                      Q3A11 = "Q3 : Twitter",
                      Q3A12 = "Q3 : Viadeo", 
                      Q3A99 = "Q3 : Aucun de ces réseaux")


# Adaptation des variables - Q1.  
val_lab(DataBase$Q1) = num_lab("
    1 Homme
    2 Femme ")


# Création de notre première table. 
DataBase %>%
  tab_cells(Q1) %>% # Question à jouer.
  tab_stat_cases() %>% # Effectif
  tab_pivot()


# Ajout des pourcentages sur le côté gauche. 
Q1 = DataBase %>%
  tab_cells(Q1) %>% # Question à traiter
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage 
  tab_pivot(stat_position = "inside_columns") # Création de la table. 

# Question numérique
Q2 = DataBase %>%
  tab_cells(Q2) %>% # Question à traiter
  tab_net_cells("Moins de 35 ans" = 18:34, "35-49 ans" = 35:49, "50-64 ans" = 50:64, "65 ans et plus" = 65:80, position = "top") %>% # Sous-Totaux
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
  tab_pivot(stat_position = "inside_columns") # Création de la table. 

# Moyenne, max, min. 
Q2m = DataBase %>%
  tab_cells(Q2) %>%
  tab_stat_mean() %>%
  tab_stat_max() %>%
  tab_stat_min() %>%
  tab_pivot() #


# Question à choix multiple. 
Q3 = DataBase %>%
  tab_cells(mdset(Q3A1%to%Q3A99)) %>% # Question à traiter
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage 
  tab_pivot(stat_position = "inside_columns") # Création de la table. 


# Ajout d'une colonne qui comptabilise le nombre de Réseaux Sociaux
DataBase <- compute(DataBase, {
  Nombre_RS = sum_row(Q3A1 %to% Q3A12)
})


# Moyenne, max, min. du nombre de réponse 
Q3m = DataBase %>%
  tab_cells(Nombre_RS) %>%
  tab_stat_mean() %>%
  tab_stat_max() %>%
  tab_stat_min() %>%
  tab_pivot() #


# Création d'une fonction pour traiter une question fermée
TAP_QF <- function(DB, Q) {
  
  DB %>%
    tab_cells(Q) %>%
    tab_stat_cases(total_row_position = "above") %>% 
    tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% 
    tab_pivot(stat_position = "inside_columns")}

TAP_QF(DataBase, DataBase$Q1)

# Création d'une fonction pour traiter une question numérique (Age)
TAP_NumA <- function(DB, QQ) {
  
  DB %>%
    tab_cells(Q2) %>% 
    tab_net_cells("Moins de 35 ans" = 18:34, "35-49 ans" = 35:49, "50-64 ans" = 50:64, "65 ans et plus" = 65:80, position = "top") %>% 
    tab_stat_cases(total_row_position = "above") %>% # Effectif
    tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% 
    tab_pivot(stat_position = "inside_columns") }

TAP_NumA(DataBase, DataBase$Q2)


# Création d'un Excel
library(openxlsx)
wb = createWorkbook()
sh = addWorksheet(wb, "Tables")
list_of_datasets <- list(Q1, Q2, Q2m, Q3, Q3m)
xl_write(list_of_datasets, wb, sh)
saveWorkbook(wb, "TAP.xlsx", overwrite = TRUE)


##### Redressement #####

# Téléchargement des données : 
DataBase <- read_excel("C:/Users/audava/Pictures/Personnel/Blog/Traitement/DataBase.xlsx")

# Recode de l'âge en catégorie. 
DataBase <- as.data.table(DataBase)
DataBase[Q2 <=  34, RecodeAge := 1]
DataBase[Q2 >=  35 & Q2 <=  49, RecodeAge := 2]
DataBase[Q2 >=  50 & Q2 <=  64, RecodeAge := 3]
DataBase[Q2 >=  65, RecodeAge := 4]

TAP_QF(DataBase, DataBase$RecodeAge)


# Création d'un objet non redressé. 
library(survey)
data.unweighted <- svydesign(ids=~1, data=DataBase)

# Définition de la structure de la population. 
Q1.dist <- data.frame(Q1 = c("1", "2"),
                       Freq = nrow(DataBase) * c(0.476, 0.524))

RecodeAge.dist <- data.frame(RecodeAge = c("1", "2", "3", "4"),
                       Freq = nrow(DataBase) * c(0.25, 0.243, 0.244, 0.263))



# Lier la strucutre de la pop à l'échantillon --> Calcul des poids 
data.rake <- rake(design = data.unweighted,
                  sample.margins = list(~Q1, ~RecodeAge),
                  population.margins = list(Q1.dist, RecodeAge.dist))


# Ajouter les poids à la database
DataBase$weight <- weights(data.rake)
table(DataBase$weight)


# Adaptation des noms des variables.  
DataBase = apply_labels(DataBase,
                        Q1 = "Q1 : Genre", 
                        Q2 = "Q2 : Age", 
                        Q3A1 = "Q3 : Facebook",
                        Q3A2 = "Q3 : Google +", 
                        Q3A3 = "Q3 : Instagram", 
                        Q3A4 = "Q3 : Linkedin", 
                        Q3A5 = "Q3 : Periscope", 
                        Q3A6 = "Q3 : Pinterest", 
                        Q3A7 = "Q3 : Reddit", 
                        Q3A8 = "Q3 : Snapchat", 
                        Q3A9 = "Q3 : TikTok", 
                        Q3A10 = "Q3 : Tumblr", 
                        Q3A11 = "Q3 : Twitter",
                        Q3A12 = "Q3 : Viadeo", 
                        Q3A99 = "Q3 : Aucun de ces réseaux")


# Adaptation des variables - Q1.  
val_lab(DataBase$Q1) = num_lab("
    1 Homme
    2 Femme ")

# Table sans redressement
DataBase %>%
  tab_cells(Q1) %>% # Question à traiter
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage 
  tab_pivot(stat_position = "inside_columns") # Création de la table. 

# Table redressée
DataBase %>%
  tab_cells(Q1) %>% # Question à traiter
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage 
  tab_pivot(stat_position = "inside_columns") # Création de la table

Q1r = DataBase %>%
  tab_cells(Q1) %>% # Question à traiter
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage 
  tab_pivot(stat_position = "inside_columns") # Création de la table. 
  
# Table sans redressement
DataBase %>%
  tab_cells(Q2) %>% # Question à traiter
  tab_net_cells("Moins de 35 ans" = 18:34, "35-49 ans" = 35:49, "50-64 ans" = 50:64, "65 ans et plus" = 65:80, position = "top") %>% # Sous-Totaux
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
  tab_pivot(stat_position = "inside_columns") # Création de la table. 

# Table redressée
DataBase %>%
  tab_cells(Q2) %>% # Question à traiter
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_net_cells("Moins de 35 ans" = 18:34, "35-49 ans" = 35:49, "50-64 ans" = 50:64, "65 ans et plus" = 65:80, position = "top") %>% # Sous-Totaux
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
  tab_pivot(stat_position = "inside_columns") # Création de la table.

Q2r = DataBase %>%
  tab_cells(Q2) %>% # Question à traiter
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_net_cells("Moins de 35 ans" = 18:34, "35-49 ans" = 35:49, "50-64 ans" = 50:64, "65 ans et plus" = 65:80, position = "top") %>% # Sous-Totaux
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
  tab_pivot(stat_position = "inside_columns") # Création de la table.

Q3r = DataBase %>%
  tab_cells(mdset(Q3A1%to%Q3A99)) %>% # Question à traiter
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cases(total_row_position = "above") %>% # Effectif
  tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage 
  tab_pivot(stat_position = "inside_columns") # Création de la table. 

# Création d'un Excel
library(openxlsx)
wb = createWorkbook()
sh = addWorksheet(wb, "Tables")
list_of_datasets <- list(Q1r, Q2r, Q3r)
xl_write(list_of_datasets, wb, sh)
saveWorkbook(wb, "TAPr.xlsx", overwrite = TRUE)


##### TC #####

# Adaptation des variables - Recode Age  
val_lab(DataBase$RecodeAge) = num_lab("
    1 Moins de 35 ans
    2 35-49 ans
    3 50-64 ans
    4 65 ans et plus")

# Création d'une table croisée - Significativité 2 par 2:
TC1 = DataBase %>% 
  tab_cells(mdset(Q3A1%to%Q3A99)) %>% 
  tab_cols(total(), Q1, RecodeAge) %>% # Colonne. 
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_last_sig_cpct() %>% 
  tab_pivot()


# Création d'une table croisée - Significativité avec la première colonne. 
TC2 = DataBase %>% 
  tab_significance_options (compare_type = "first_column") %>% 
  tab_cells(mdset(Q3A1%to%Q3A99)) %>% 
  tab_cols(total(), Q1, RecodeAge) %>% # Colonne. 
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_last_sig_cpct() %>% 
  tab_pivot()

# Création d'un Excel
library(openxlsx)
wb = createWorkbook()
sh = addWorksheet(wb, "Tables")
list_of_datasets <- list(TC1, TC2)
xl_write(list_of_datasets, wb, sh)
saveWorkbook(wb, "TC.xlsx", overwrite = TRUE)

# TC données brutes / données redressées. 

DataBase %>%
  tab_cells(Q1) %>% # Question à jouer.
  tab_stat_cases(label = "Données Brutes") %>% # calculate cases
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_weight(weight) %>% # Prise en compre des poids.
  tab_stat_cases(label = "Données Redressées") %>% # calculate cases
  tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
  tab_pivot(stat_position = "inside_columns") # Création de la table.