Moment R

Statistiques descriptives

Edmond Noack

📊 Introduction

Cette présentation couvre les notions de base en statistiques descriptives avec R :

  • équivalent de la proc freq
  • équivalent de la proc means
  • équivalent de la proc summary

Et la mise forme de tableau ✨

1- 📁 Chargement des packages

library(tidyverse) 

#stat desc
library(gmodels)
library(survey)   
library(questionr)
library(expss)
library(maditr)
library(janitor)
library(srvyr)

#mise en forme
library(gt)

2- 📄 Exemple de jeu de données

Présentation avec une base de l’enquête EFE : Base_efe

glimpse(Base_efe)
Rows: 23,345
Columns: 6
$ poids_2023            <dbl> 10.559322, 1.000000, 6.161765, 114.844828, 1.000…
$ taille7_bds           <chr> "3", "7", "2", "2", "7", "7", "3", "4", "5", "3"…
$ naf_interim           <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ poids2023_taille5_bds <dbl> 18.376865, 1.049252, 13.069110, 170.307136, 1.17…
$ naf_asso              <int> 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, …
$ a2tot                 <dbl> 20, 1065, 14, 10, 532, 1714, 20, 104, 350, 29, 2…

3- 📊 Tableaux croisés simples sans package spécifique

⚠️ Attention ici on n’est pas en Dplyr

 table(Base_efe$taille7_bds, Base_efe$naf_interim)
   
       0    1
  1 7507    5
  2 3987   23
  3 3065   21
  4 4688   83
  5 1599   12
  6  877    5
  7 1448   25

✅ Ecriture en Dplyr

⚠️ Attention pas hyper lisible car deux colonnes il faut pivoter la base

Tab2 <- Base_efe |> 
  count(taille7_bds, naf_interim)

Tab2
# A tibble: 14 × 3
   taille7_bds naf_interim     n
   <chr>             <int> <int>
 1 1                     0  7507
 2 1                     1     5
 3 2                     0  3987
 4 2                     1    23
 5 3                     0  3065
 6 3                     1    21
 7 4                     0  4688
 8 4                     1    83
 9 5                     0  1599
10 5                     1    12
11 6                     0   877
12 6                     1     5
13 7                     0  1448
14 7                     1    25

✅ Ecriture en Dplyr

✅ Format tableau croisé

➡️ Utilisation de pivot_wider

Base_efe |> 
  count(taille7_bds, naf_interim) |> 
  pivot_wider(
    names_from = naf_interim, # nom des futures colonnes
    values_from = n, # valeurs des futures colonnes
    values_fill = 0 # si croisement n'existe pas mettre 0
  )
# A tibble: 7 × 3
  taille7_bds   `0`   `1`
  <chr>       <int> <int>
1 1            7507     5
2 2            3987    23
3 3            3065    21
4 4            4688    83
5 5            1599    12
6 6             877     5
7 7            1448    25

✅ Pourcentage colonne

Base_efe |>
  group_by(naf_interim) |> # regroupe par colonne
  count(naf_interim, taille7_bds) |>
  mutate(pct = round(100 * n / sum(n), 1)) |> # calcul des %
  select(-n) |> # suppression variable inutile 
  pivot_wider(
    names_from = naf_interim,
    values_from = pct,
    values_fill = 0
  )
# A tibble: 7 × 3
  taille7_bds   `0`   `1`
  <chr>       <dbl> <dbl>
1 1            32.4   2.9
2 2            17.2  13.2
3 3            13.2  12.1
4 4            20.2  47.7
5 5             6.9   6.9
6 6             3.8   2.9
7 7             6.2  14.4

✅ Pourcentage ligne

Base_efe |>
  group_by(taille7_bds) |> # on regroupe par ligne (ici taille)
  count(taille7_bds, naf_interim) |> # on compte les occurrences de croisement
  mutate(pct=round(100 * n / sum(n),1)) |> # on calcul le %
  select(-n)  |>   # on enlève les effectifs 
  pivot_wider(names_from = naf_interim, # on pivote
              values_from = pct,
              values_fill = 0)
# A tibble: 7 × 3
# Groups:   taille7_bds [7]
  taille7_bds   `0`   `1`
  <chr>       <dbl> <dbl>
1 1            99.9   0.1
2 2            99.4   0.6
3 3            99.3   0.7
4 4            98.3   1.7
5 5            99.3   0.7
6 6            99.4   0.6
7 7            98.3   1.7

✅ Pourcentage total

Base_efe |>
  # On ne groupe pas
  count(taille7_bds, naf_interim) |> # on compte les occurrences de croisement
  mutate(pct=round(100 * n / sum(n),1)) |> # on calcul le %
  select(-n)  |>   # on enlève les effectifs 
  pivot_wider(names_from = naf_interim, # on pivote
              values_from = pct,
              values_fill = 0)
# A tibble: 7 × 3
  taille7_bds   `0`   `1`
  <chr>       <dbl> <dbl>
1 1            32.2   0  
2 2            17.1   0.1
3 3            13.1   0.1
4 4            20.1   0.4
5 5             6.8   0.1
6 6             3.8   0  
7 7             6.2   0.1

🏋️ Avec Pondération

je rajoute wt = poids et le total par ligne

Base_efe |>
  group_by(naf_interim) |> # groupe par colonne
  count(naf_interim, taille7_bds,  wt = poids2023_taille5_bds) |> 
  mutate(pct = round(100 * n / sum(n), 1)) |> 
   select(-n) |>
  pivot_wider(
    names_from = naf_interim,
    values_from = pct,
    values_fill = 0
   ) 
# A tibble: 7 × 3
  taille7_bds   `0`   `1`
  <chr>       <dbl> <dbl>
1 1            83.6  35.4
2 2             8.6  25.6
3 3             4.9  21  
4 4             2.3  16.9
5 5             0.3   0.4
6 6             0.1   0.2
7 7             0.1   0.5

4- 📊 Tableaux croisés simples avec questionr

Table_questionR <- wtd.table(Base_efe$naf_interim, Base_efe$taille7_bds, weights = Base_efe$poids_2023)

print(Table_questionR)
             1            2            3            4            5            6
0 7.693224e+05 9.684782e+04 5.595101e+04 3.278824e+04 4.030827e+03 1.612305e+03
1 6.417287e+02 1.502753e+03 9.691883e+02 7.650041e+02 1.819056e+01 7.113636e+00
             7
0 1.448000e+03
1 2.500000e+01

⚠️ Attention on obtient une table et non un dataframe

Si on veut repasser en dataframe il faut transformer la table et la pivoter

Df_questionR <- as.data.frame(Table_questionR) |> 
  pivot_wider(
    names_from = Var1,  # Valeurs des colonnes (ici taille7_bds)
    values_from = Freq,        # Valeurs des fréquences pondérées
    values_fill = list(Freq = 0) # Remplacer les NA par 0
  )
print(Df_questionR)
# A tibble: 7 × 3
  Var2      `0`     `1`
  <fct>   <dbl>   <dbl>
1 1     769322.  642.  
2 2      96848. 1503.  
3 3      55951.  969.  
4 4      32788.  765.  
5 5       4031.   18.2 
6 6       1612.    7.11
7 7       1448    25   

Pourcentage ligne margin = 1

Table_questionR <- wtd.table(Base_efe$naf_interim, Base_efe$taille7_bds, weights = Base_efe$poids_2023)

# Convertir en pourcentages par ligne
Table_questionR_pct_ligne <- prop.table(Table_questionR, margin = 1) * 100

# Afficher le tableau avec des pourcentages
print(Table_questionR_pct_ligne)
           1          2          3          4          5          6          7
0 79.9710924 10.0673353  5.8161095  3.4083394  0.4190047  0.1675991  0.1505197
1 16.3332221 38.2479316 24.6676934 19.4708151  0.4629845  0.1810556  0.6362978

Pourcentage colonne margin = 2

Table_questionR_pct_col <- prop.table(Table_questionR, margin = 2) * 100

print(Table_questionR_pct_col)
            1           2           3           4           5           6
0 99.91665472 98.47204462 98.29728567 97.72002975 99.55074144 99.56072888
1  0.08334528  1.52795538  1.70271433  2.27997025  0.44925856  0.43927112
            7
0 98.30278344
1  1.69721656

Pourcentage total

Table_questionR_pct_tot <- prop.table(Table_questionR) * 100

print(Table_questionR_pct_tot)
             1            2            3            4            5            6
0 79.645805024 10.026385754  5.792452068  3.394475794  0.417300345  0.166917407
1  0.066436392  0.155575830  0.100337370  0.079198746  0.001883218  0.000736455
             7
0  0.149907415
1  0.002588181

Avec somme ligne colonne addmargins

Table_questionR_with_margins <- addmargins(Table_questionR_pct_ligne)
print(Table_questionR_with_margins)
              1           2           3           4           5           6
0    79.9710924  10.0673353   5.8161095   3.4083394   0.4190047   0.1675991
1    16.3332221  38.2479316  24.6676934  19.4708151   0.4629845   0.1810556
Sum  96.3043145  48.3152669  30.4838028  22.8791545   0.8819892   0.3486548
              7         Sum
0     0.1505197 100.0000000
1     0.6362978 100.0000000
Sum   0.7868174 200.0000000

5- 📊 Tableaux croisés simples avec janitor

tableau ➡️ tabyl
ligne ➡️adorn_percentages("row")
pourcentage ➡️adorn_pct_formatting()
Base_efe  |> 
  tabyl(naf_interim, naf_asso)  |> 
  adorn_percentages("row") |> 
  adorn_pct_formatting()
 naf_interim     0     1
           0 83.9% 16.1%
           1 98.9%  1.1%

Pourcentage colonne

tableau ➡️ tabyl
colonne ➡️adorn_percentages("col")
pourcentage ➡️adorn_pct_formatting()
Base_efe |>
  tabyl(naf_interim, naf_asso)  |> 
  adorn_percentages("col") |> 
  adorn_pct_formatting()
 naf_interim     0     1
           0 99.1% 99.9%
           1  0.9%  0.1%

Pourcentage colonne avec somme

tableau ➡️ tabyl

somme ligne ➡️ adorn_totals("row")

somme colonne ➡️ adorn_totals("col")

% colonne ➡️ adorn_percentages("row")

pourcentage ➡️ adorn_pct_formatting()

Base_efe |>
  tabyl(naf_interim, naf_asso) |>
  adorn_totals("row") |>
  adorn_totals("col") |>
  adorn_percentages("col") |>
  adorn_pct_formatting()
 naf_interim      0      1  Total
           0  99.1%  99.9%  99.3%
           1   0.9%   0.1%   0.7%
       Total 100.0% 100.0% 100.0%

Pourcentage ligne avec somme

table_pct <- Base_efe |>
  tabyl(naf_interim, naf_asso) |>  # Création du tableau croisé
  adorn_totals("row") |>           # Ajouter les totaux par ligne
  adorn_totals("col") |>           # Ajouter les totaux par colonne
  adorn_percentages("row") |>      # Calculer les pourcentages par ligne
  adorn_pct_formatting()            # Appliquer le format pourcentage

table_pct
 naf_interim     0     1  Total
           0 83.9% 16.1% 100.0%
           1 98.9%  1.1% 100.0%
       Total 84.0% 16.0% 100.0%

Pourcentage ligne avec somme pondérée 🏋

Table_pour_gt <- Base_efe |>
  count(naf_interim, taille7_bds, wt = poids_2023) |>  # pondération ici
  pivot_wider(names_from = taille7_bds, values_from = n, values_fill = 0) |> 
  adorn_totals("col") |> 
    adorn_totals("row") |> 
  adorn_percentages("row") |> 
  adorn_pct_formatting(digits = 0) # chiffres après la virgule

print(Table_pour_gt)
 naf_interim   1   2   3   4  5  6  7 Total
           0 80% 10%  6%  3% 0% 0% 0%  100%
           1 16% 38% 25% 19% 0% 0% 1%  100%
       Total 80% 10%  6%  3% 0% 0% 0%  100%

5bis- ✨ Janitor + Gt

# Mise en forme avec gt
gt_table <- gt(Table_pour_gt) |>
  tab_header(
    title = md("<span style='color:#007B8A;'>Répartition des naf_interim par taille</span>"),
    subtitle = "Pourcentage des occurrences dans chaque catégorie, par ligne"
  ) |>
  tab_source_note(
    source_note = "Source : DFC, Base EFE"
  ) |>
  fmt_number(
    columns = where(is.numeric),
    decimals = 1,
    suffix = "%"
  ) |>
  tab_options(
    table.font.size = 12,
    heading.align = "center",
    data_row.padding = px(6),
    column_labels.font.weight = "bold"
  ) |>
  tab_source_note(
    source_note = md("<span style='color:#007B8A;'><em><strong>Note de lecture : 16% des boites d'interim sont de taille 1</strong></em></span>")
  ) |>
  tab_style(
    style = cell_fill(color = "#007B8A"),  # Couleur de surlignage
    locations = cells_body(
  rows = 2,
  columns = 2
    )
  ) |> 
  tab_options(
  table.width = pct(100)  
)

gt_table

5bis- ✨ Janitor + Gt

Répartition des naf_interim par taille
Pourcentage des occurrences dans chaque catégorie, par ligne
naf_interim 1 2 3 4 5 6 7 Total
0 80% 10% 6% 3% 0% 0% 0% 100%
1 16% 38% 25% 19% 0% 0% 1% 100%
Total 80% 10% 6% 3% 0% 0% 0% 100%
Source : DFC, Base EFE
Note de lecture : 16% des boites d’interim sont de taille 1
 gtsave(gt_table, "tableau_freq.html")

Ouvrir le tableau en HTML

6- 📊 Tableaux croisés simples avec gmodels

le plus proche de SAS

CrossTable(Base_efe$naf_interim, Base_efe$naf_asso,
           prop.r = TRUE, prop.c = TRUE, prop.t = TRUE, chisq = TRUE)

6- 📊 Tableaux croisés simples avec gmodels


 
   Cell Contents
|-------------------------|
|                       N |
| Chi-square contribution |
|           N / Row Total |
|           N / Col Total |
|         N / Table Total |
|-------------------------|

 
Total Observations in Table:  23345 

 
                     | Base_efe$naf_asso 
Base_efe$naf_interim |         0 |         1 | Row Total | 
---------------------|-----------|-----------|-----------|
                   0 |     19448 |      3723 |     23171 | 
                     |     0.034 |     0.180 |           | 
                     |     0.839 |     0.161 |     0.993 | 
                     |     0.991 |     0.999 |           | 
                     |     0.833 |     0.159 |           | 
---------------------|-----------|-----------|-----------|
                   1 |       172 |         2 |       174 | 
                     |     4.539 |    23.908 |           | 
                     |     0.989 |     0.011 |     0.007 | 
                     |     0.009 |     0.001 |           | 
                     |     0.007 |     0.000 |           | 
---------------------|-----------|-----------|-----------|
        Column Total |     19620 |      3725 |     23345 | 
                     |     0.840 |     0.160 |           | 
---------------------|-----------|-----------|-----------|

 
Statistics for All Table Factors


Pearson's Chi-squared test 
------------------------------------------------------------
Chi^2 =  28.66078     d.f. =  1     p =  8.623242e-08 

Pearson's Chi-squared test with Yates' continuity correction 
------------------------------------------------------------
Chi^2 =  27.55914     d.f. =  1     p =  1.523635e-07 

 

Avec Pondération 🏋

# Table pondérée
table_pond <- xtabs(poids_2023 ~ naf_interim + naf_asso, data = Base_efe)

# CrossTable dessus
CrossTable(table_pond,
           prop.r = TRUE, prop.c = TRUE, prop.t = TRUE, chisq = TRUE)

 
   Cell Contents
|-------------------------|
|                       N |
| Chi-square contribution |
|           N / Row Total |
|           N / Col Total |
|         N / Table Total |
|-------------------------|

 
Total Observations in Table:  965929.5 

 
             | naf_asso 
 naf_interim |                0 |                1 |        Row Total | 
-------------|------------------|------------------|------------------|
           0 |           873275 |            88725 |           962000 | 
             |            0.143 |            1.418 |                  | 
             |            0.908 |            0.092 |            0.996 | 
             |            0.996 |            1.000 |                  | 
             |            0.904 |            0.092 |                  | 
-------------|------------------|------------------|------------------|
           1 |             3922 |                6 |             3928 | 
             |           35.116 |          347.152 |                  | 
             |            0.998 |            0.002 |            0.004 | 
             |            0.004 |            0.000 |                  | 
             |            0.004 |            0.000 |                  | 
-------------|------------------|------------------|------------------|
Column Total |           877197 |            88732 |           965929 | 
             |            0.908 |            0.092 |                  | 
-------------|------------------|------------------|------------------|

 
Statistics for All Table Factors


Pearson's Chi-squared test 
------------------------------------------------------------
Chi^2 =  383.8294     d.f. =  1     p =  1.824954e-85 

Pearson's Chi-squared test with Yates' continuity correction 
------------------------------------------------------------
Chi^2 =  382.7458     d.f. =  1     p =  3.141672e-85 

 

7- 📊 Tableaux croisés simples avec survey

des <- svydesign(
  ids = ~1,              # Pas de grappes, donc on met ~1
  data = Base_efe,       # Utilise ton dataframe
  weights = ~poids_2023        # Pondération individuelle pour chaque observation
)

# Table pondérée (comptage des observations pour 'naf_interim' et 'naf_asso')
freq_table <- svytable(~ naf_interim + naf_asso, design = des)

freq_table
           naf_asso
naf_interim            0            1
          0 8.732755e+05 8.872510e+04
          1 3.922026e+03 6.952381e+00
prop.table(freq_table, margin = 2) *100
           naf_asso
naf_interim            0            1
          0 99.552891348 99.992164747
          1  0.447108652  0.007835253
addmargins(prop.table(freq_table, margin = 1) * 100)
           naf_asso
naf_interim           0           1         Sum
        0    90.7770215   9.2229785 100.0000000
        1    99.8230486   0.1769514 100.0000000
        Sum 190.6000702   9.3999298 200.0000000

8- 📊 Tableaux croisés avec expss

SAS friendly

cro_cpct(Base_efe$naf_interim, Base_efe$naf_asso)
 Base_efe$naf_asso 
 0   1 
 Base_efe$naf_interim 
   0  99.1 99.9
   1  0.9 0.1
   #Total cases  19620 3725
# Effectifs bruts
eff <- cro_cases( Base_efe$naf_asso,Base_efe$naf_interim, weight = Base_efe$poids_2023)

# Pourcentages colonne
pct <- cro_cpct( Base_efe$naf_asso,Base_efe$naf_interim,weight = Base_efe$poids_2023)

# Combine les deux en concaténant les lignes
tab_complet <- rbind(eff, pct)

tab_complet
 Base_efe$naf_interim 
 0   1 
 Base_efe$naf_asso 
   0  873275.5 3922
   1  88725.1 7
   #Total cases  23171 174
   0  90.8 99.8
   1  9.2 0.2
   #Total cases  23171 174

9- 📊 summary et tapply pour moyenne, median etc…

summary(Base_efe$a2tot)
     Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
      1.0       5.0      19.0     484.1      93.0 4798211.0 
tapply(Base_efe$a2tot, Base_efe$naf_interim, mean)
        0         1 
 467.9695 2632.8448 
tapply(Base_efe$a2tot, Base_efe$naf_interim,median )
 0  1 
19 91 
tapply(Base_efe$a2tot, Base_efe$naf_interim,function(x) quantile(x, 0.25) )
    0     1 
 5.00 48.75 

10- 📊 Moyenne, Médiane, Quantile sans package spéciques

Base_efe |>
  group_by(naf_interim) |>
  summarise(
    moyenne = mean(a2tot, na.rm = TRUE),     
    mediane = median(a2tot, na.rm = TRUE),  
    q1 = quantile(a2tot, 0.25, na.rm = TRUE), 
    q3 = quantile(a2tot, 0.75, na.rm = TRUE), 
    min = min(a2tot, na.rm = TRUE),           
    max = max(a2tot, na.rm = TRUE)            
  )
# A tibble: 2 × 7
  naf_interim moyenne mediane    q1    q3   min     max
        <int>   <dbl>   <dbl> <dbl> <dbl> <dbl>   <dbl>
1           0    468.      19   5     91      1 4798211
2           1   2633.      91  48.8  253.     1  121336

11- 📊 Moyenne, Médiane, Quantile avec survey

# Créer la conception de l'enquête avec pondération
des <- svydesign(ids = ~1, data = Base_efe, weights = ~poids_2023)

# Moyenne pondérée
svymean(~a2tot, design = des)
       mean     SE
a2tot 49.49 32.417
# Médiane pondérée
svyquantile(~a2tot, design = des, c(0.1, 0.5, 0.9))
$a2tot
    quantile ci.2.5 ci.97.5        se
0.1        1      1       2 0.2550935
0.5        3      3       4 0.2550935
0.9       19     19      20 0.2550935

attr(,"hasci")
[1] TRUE
attr(,"class")
[1] "newsvyquantile"
# Convertir le design survey en srvyr
des_srvyr <- as_survey_design(Base_efe, ids = 1, weights = poids_2023)

# Moyenne et médiane pondérées par naf_asso
resultats <- des_srvyr |>
  group_by(naf_asso) |>
  summarise(
    moyenne = survey_mean(a2tot, na.rm = TRUE),
    mediane = survey_quantile(a2tot, quantiles = c(0.5), na.rm = TRUE)
  )

Mise en forme avec gt

gt_table <- resultats |>
  gt() |>
  tab_header(
    title = md("<span style='color:#007B8A;'>Moyenne et Médiane Pondérées par Activité</span>"),
    subtitle = "Calculées par groupe de naf_asso"
  ) |>
  fmt_number(
    columns = c(moyenne, mediane_q50),  # Applique la mise en forme aux colonnes moyenne et médiane
    decimals = 2,                   # Limite à 2 décimales
    suffix = " %"                   # Ajoute le symbole de pourcentage (si nécessaire)
  ) |>
  tab_source_note(
    source_note = "Source : DFC, Base EFE"
  ) |>
  tab_options(
    table.font.size = 12,
    heading.align = "center",
    data_row.padding = px(6),
    column_labels.font.weight = "bold"
  ) |>
  tab_source_note(
    source_note = md("<span style='color:#007B8A;'><em>Note de lecture : Les moyennes et médianes sont pondérées selon les poids spécifiques à chaque observation.</em></span>")
  ) |> 
  tab_options(
  table.width = pct(100)  
)

gt_table
Moyenne et Médiane Pondérées par Activité
Calculées par groupe de naf_asso
naf_asso moyenne moyenne_se mediane_q50 mediane_q50_se
0 52.59 35.6960953 3.00 0.2550910
1 18.82 0.8615268 3.00 0.2550238
Source : DFC, Base EFE
Note de lecture : Les moyennes et médianes sont pondérées selon les poids spécifiques à chaque observation.
gtsave(gt_table, "tableau_efe.html")

Ouvrir le tableau en HTML