TP_Global_Fouilles_BUT2
JACQUIER Jean-Emmanuel
2025-11-25
Partie 1 - Importation, typologie des variables
Q1.1 Importation des données
On importe les données :
library(readxl)
data <- read_excel("data.xlsx",
sheet = "Feuil1")
data$Taille <- as.numeric(data$Taille)
data$BMI <- as.numeric(data$BMI)
str(data)## tibble [144 × 14] (S3: tbl_df/tbl/data.frame)
## $ Age : num [1:144] 15 17 20 20 18 13 13 14 20 17 ...
## $ Nomination: chr [1:144] "GR" "GR" "GR" "GR" ...
## $ Taille : num [1:144] 1.56 1.63 1.67 1.67 1.69 1.64 1.63 1.56 1.67 1.72 ...
## $ Poids : num [1:144] 47 44 52 61 54 47 44 47 52 57 ...
## $ BMI : num [1:144] 19.3 16.5 18.6 21.8 18.9 17.4 16.5 19.3 18.6 19 ...
## $ ES : num [1:144] 28 21 32 32 31 31 28 28 30 30 ...
## $ BES : num [1:144] 46 40 56 43 51 60 63 63 69 53 ...
## $ BEApp : num [1:144] 23 19 24 19 24 26 29 26 33 27 ...
## $ BEPoi : num [1:144] 16 14 21 12 18 26 26 28 25 19 ...
## $ BEAtt : num [1:144] 7 7 11 12 9 8 8 9 11 7 ...
## $ EAT : num [1:144] 2 5 1 31 31 1 18 5 8 11 ...
## $ Diete : num [1:144] 2 4 1 23 23 1 17 1 7 4 ...
## $ Boulimie : num [1:144] 0 0 0 4 5 0 1 0 0 0 ...
## $ Control : num [1:144] 0 1 0 4 3 0 0 4 1 7 ...head(data)## # A tibble: 6 × 14
## Age Nomination Taille Poids BMI ES BES BEApp BEPoi BEAtt EAT Diete
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 15 GR 1.56 47 19.3 28 46 23 16 7 2 2
## 2 17 GR 1.63 44 16.5 21 40 19 14 7 5 4
## 3 20 GR 1.67 52 18.6 32 56 24 21 11 1 1
## 4 20 GR 1.67 61 21.8 32 43 19 12 12 31 23
## 5 18 GR 1.69 54 18.9 31 51 24 18 9 31 23
## 6 13 GR 1.64 47 17.4 31 60 26 26 8 1 1
## # ℹ 2 more variables: Boulimie <dbl>, Control <dbl>On remarque qu’il y a 144 lignes et 14 variables dans le tableau.
Q1.2 Typologie des variables
On fait un tableau récapitulatif des variables :
tableau_coches <- data.frame(
Variable = c("Age", "Nomination", "Taille", "Poids", "BMI", "ES", "BES", "BEApp", "BEPoi", "BEAtt", "EAT", "Diete", "Boulimie", "Control"),
Qual_Nom = c("", "X", "", "", "", "", "", "", "", "", "", "", "", ""),
Qual_Ord = c("", "", "", "", "", "", "", "", "", "", "", "", "", ""),
Quant_Disc = c("X", "", "", "", "", "X", "X", "X", "X", "X", "X", "X", "X", "X"),
Quant_Cont = c("", "", "X", "X", "X", "", "", "", "", "", "", "", "", ""),
Regroup = c("", "X", "", "", "", "", "", "", "", "", "", "", "", ""),
Explic = c("X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X"),
Reponse = c("", "", "", "", "X", "X", "X", "X", "X", "X", "X", "X", "X", "X")
)
print(tableau_coches)## Variable Qual_Nom Qual_Ord Quant_Disc Quant_Cont Regroup Explic Reponse
## 1 Age X X
## 2 Nomination X X X
## 3 Taille X X
## 4 Poids X X
## 5 BMI X X X
## 6 ES X X X
## 7 BES X X X
## 8 BEApp X X X
## 9 BEPoi X X X
## 10 BEAtt X X X
## 11 EAT X X X
## 12 Diete X X X
## 13 Boulimie X X X
## 14 Control X X XQ1.3 Recodage et valeurs manquantes
On transforme la variable “Nomination” en variable qualitative :
library(dplyr)
data <- data %>%
mutate(Nomination = factor(Nomination))
summary(data)## Age Nomination Taille Poids BMI
## Min. :13.00 GR:61 Min. :1.480 Min. :38.00 Min. :16.20
## 1st Qu.:15.00 GT:41 1st Qu.:1.610 1st Qu.:47.00 1st Qu.:17.88
## Median :16.00 NS:42 Median :1.650 Median :52.00 Median :18.90
## Mean :16.17 Mean :1.647 Mean :51.89 Mean :19.07
## 3rd Qu.:17.00 3rd Qu.:1.690 3rd Qu.:56.00 3rd Qu.:19.80
## Max. :22.00 Max. :1.790 Max. :70.00 Max. :24.20
## ES BES BEApp BEPoi
## Min. :16.00 Min. :12.00 Min. : 3.00 Min. : 1.00
## 1st Qu.:26.00 1st Qu.:35.75 1st Qu.:13.00 1st Qu.: 9.00
## Median :29.00 Median :46.00 Median :17.00 Median :15.50
## Mean :28.57 Mean :45.90 Mean :18.17 Mean :15.03
## 3rd Qu.:32.00 3rd Qu.:56.00 3rd Qu.:24.25 3rd Qu.:21.00
## Max. :39.00 Max. :79.00 Max. :40.00 Max. :30.00
## BEAtt EAT Diete Boulimie
## Min. : 3.00 Min. : 1.00 Min. : 1.000 Min. : 0.000
## 1st Qu.: 8.75 1st Qu.: 5.00 1st Qu.: 2.000 1st Qu.: 0.000
## Median :11.00 Median :10.00 Median : 6.000 Median : 1.000
## Mean :12.70 Mean :12.73 Mean : 7.875 Mean : 2.167
## 3rd Qu.:18.00 3rd Qu.:17.00 3rd Qu.:11.000 3rd Qu.: 4.000
## Max. :20.00 Max. :45.00 Max. :33.000 Max. :11.000
## Control
## Min. : 0.000
## 1st Qu.: 0.000
## Median : 2.000
## Mean : 2.694
## 3rd Qu.: 4.000
## Max. :13.000colSums(is.na(data))## Age Nomination Taille Poids BMI ES BES
## 0 0 0 0 0 0 0
## BEApp BEPoi BEAtt EAT Diete Boulimie Control
## 0 0 0 0 0 0 0Il ne manque aucune valeur dans le tableau transformé mais s’il y en avait il faudrait calculer/déduire les valeurs manquantes à partir des autres. Par exemple si il manquait une valeur mais que nous avions la moyenne finale, nous pourrions, grâce aux autres valeurs, calculer celle qui manque.
Partie 2 - Analyse des variables qualitatives
Q2.1 Tableau d’effectifs et mode
On construit un tableau d’effectifs et de fréquences pour la variable Nomination en identifiant le mode de cette dernière :
effectifs <- table(data$Nomination)
frequences <- round(100 * effectifs / sum(effectifs), 2)
tableau_nom <- data.frame(
Nomination = names(effectifs),
Effectif = as.vector(effectifs),
Frequence_percent = as.vector(frequences)
)
mode_nom <- names(effectifs)[which.max(effectifs)]
tableau_nom$Mode <- ""
tableau_nom$Mode[tableau_nom$Nomination == mode_nom] <- "X"
print(tableau_nom)## Nomination Effectif Frequence_percent Mode
## 1 GR 61 42.36 X
## 2 GT 41 28.47
## 3 NS 42 29.17Q2.2 Diagramme en barres
On représente graphiquement la distribution de Nomination avec un diagramme en barres :
library(ggplot2)
ggplot(data, aes(x = Nomination)) +
geom_bar(fill = "#2171b5") +
labs(title = "Distribution de la variable Nomination",
x = "Nomination",
y = "Effectif") +
theme_minimal()
Q2.3 Diagramme en camembert
On représente graphiquement la distribution de Nomination avec un diagramme en camembert en indiquant les pourcentages pour chaque nomination :
library(scales)
data_pie <- data %>%
count(Nomination) %>%
mutate(
prop = n / sum(n),
labels = scales::percent(prop, 0.1)
)
ggplot(data_pie, aes(x = "", y = prop, fill = Nomination)) +
geom_col(width = 1) +
geom_text(
aes(label = labels),
position = position_stack(vjust = 0.5),
size = 4
) +
coord_polar("y", start = 0) +
labs(
title = "Répartition des nominations",
fill = "Nomination"
) +
theme_void() +
scale_fill_brewer(palette = "Set2")
Partie 2bis - Création de nouvelles variables qualitatives
Q2B.1 Classe d’IMC
On crée une variable qualitative BMI_class à partir de BMI selon les classes suivantes :
- “Insuffisance pondérale” si BMI < 18,5 ;
- “Corpulence normale” si 18,5 ≤ BMI < 25 ;
- “Surpoids/obésité” si BMI ≥ 25.
data <- data %>%
mutate(
BMI_classe = cut(
BMI,
breaks = c(-Inf, 18.5, 22, Inf),
labels = c("Insuffisance pondérale",
"Corpulence normale",
"Surpoids/obésité")
)
)
str(data$BMI_classe)## Factor w/ 3 levels "Insuffisance pondérale",..: 2 1 2 2 2 1 1 2 2 2 ...table(data$BMI_classe)##
## Insuffisance pondérale Corpulence normale Surpoids/obésité
## 53 80 11Q2B.2 Classe d’âge
On crée de manière similaire la variable qualitative Age_classe à partir de âge selon les critères suivants :
- “13 - 15 ans” ;
- “16 - 18 ans” ;
- “19 - 22 ans”.
data <- data %>%
mutate(
Age_classe = cut(
Age,
breaks = c(13, 16, 19, 23),
labels = c("13 - 15 ans", "16 - 18 ans", "19 - 22 ans"),
right = FALSE
)
)
str(data$Age_classe)## Factor w/ 3 levels "13 - 15 ans",..: 1 2 3 3 2 1 1 1 3 2 ...table(data$Age_classe)##
## 13 - 15 ans 16 - 18 ans 19 - 22 ans
## 57 76 11Q2B.3 Catégorisation du score EAT
On crée similairement EAT_cat à partir de EAT selon les critères :
- “Score bas” si EAT < 10 ;
- “Score modéré” si 10 ≤ EAT < 20 ;
- “Score élevé” si EAT ≥ 20.
data <- data %>%
mutate(
EAT_cat = cut(
EAT,
breaks = c(-Inf, 10, 20, Inf),
labels = c("Score bas", "Score modéré", "Score élevé")
)
)
table(data$EAT_cat)##
## Score bas Score modéré Score élevé
## 73 45 26prop.table(table(data$EAT_cat))##
## Score bas Score modéré Score élevé
## 0.5069444 0.3125000 0.1805556Q2B.4 Analyse univariée des nouvelles variables qualitatives
On réalise pour chaque variable qualitative :
- un tableau d’effectifs et de fréquences ;
- l’identification de la modalité la plus fréquente (mode) ;
- un diagramme en barres ;
- un diagramme en camembert.
1) BMI_classe
eff_BMI <- table(data$BMI_classe)
freq_BMI <- round(100 * eff_BMI / sum(eff_BMI), 2)
tab_BMI <- data.frame(
BMI_classe = names(eff_BMI),
Effectif = as.vector(eff_BMI),
Frequence_percent = as.vector(freq_BMI)
)
mode_BMI <- names(eff_BMI)[which.max(eff_BMI)]
tab_BMI$Mode <- ""
tab_BMI$Mode[tab_BMI$BMI_classe == mode_BMI] <- "X"
print(tab_BMI)## BMI_classe Effectif Frequence_percent Mode
## 1 Insuffisance pondérale 53 36.81
## 2 Corpulence normale 80 55.56 X
## 3 Surpoids/obésité 11 7.64ggplot(data, aes(x = BMI_classe)) +
geom_bar(fill = "#2171b5") +
labs(title = "Classe d'IMC", x = "Classe", y = "Effectif") +
theme_minimal()
data_pie_BMI <- data %>%
count(BMI_classe) %>%
mutate(
prop = n / sum(n),
labels = percent(prop, 0.1)
)
ggplot(data_pie_BMI, aes(x = "", y = prop, fill = BMI_classe)) +
geom_col(width = 1) +
geom_text(aes(label = labels),
position = position_stack(vjust = 0.5),
size = 4) +
coord_polar("y", start = 0) +
labs(title = "Répartition des classes d'IMC",
fill = "Classe d'IMC") +
theme_void() +
scale_fill_brewer(palette = "Set2")
2) Age_classe
eff_Age <- table(data$Age_classe)
freq_Age <- round(100 * eff_Age / sum(eff_Age), 2)
tab_Age <- data.frame(
Age_classe = names(eff_Age),
Effectif = as.vector(eff_Age),
Frequence_percent = as.vector(freq_Age)
)
mode_Age <- names(eff_Age)[which.max(eff_Age)]
tab_Age$Mode <- ""
tab_Age$Mode[tab_Age$Age_classe == mode_Age] <- "X"
print(tab_Age)## Age_classe Effectif Frequence_percent Mode
## 1 13 - 15 ans 57 39.58
## 2 16 - 18 ans 76 52.78 X
## 3 19 - 22 ans 11 7.64ggplot(data, aes(x = Age_classe)) +
geom_bar(fill = "#2171b5") +
labs(title = "Classe d'âge", x = "Classe", y = "Effectif") +
theme_minimal()
data_pie_Age <- data %>%
count(Age_classe) %>%
mutate(
prop = n / sum(n),
labels = percent(prop, 0.1)
)
ggplot(data_pie_Age, aes(x = "", y = prop, fill = Age_classe)) +
geom_col(width = 1) +
geom_text(aes(label = labels),
position = position_stack(vjust = 0.5),
size = 4) +
coord_polar("y", start = 0) +
labs(title = "Répartition des classes d'âge",
fill = "Classe d'âge") +
theme_void() +
scale_fill_brewer(palette = "Set2")
3) EAT_cat
eff_EAT <- table(data$EAT_cat)
freq_EAT <- round(100 * eff_EAT / sum(eff_EAT), 2)
tab_EAT <- data.frame(
EAT_cat = names(eff_EAT),
Effectif = as.vector(eff_EAT),
Frequence_percent = as.vector(freq_EAT)
)
mode_EAT <- names(eff_EAT)[which.max(eff_EAT)]
tab_EAT$Mode <- ""
tab_EAT$Mode[tab_EAT$EAT_cat == mode_EAT] <- "X"
print(tab_EAT)## EAT_cat Effectif Frequence_percent Mode
## 1 Score bas 73 50.69 X
## 2 Score modéré 45 31.25
## 3 Score élevé 26 18.06ggplot(data, aes(x = EAT_cat)) +
geom_bar(fill = "#2171b5") +
labs(title = "Score EAT (categories)", x = "Catégorie", y = "Effectif") +
theme_minimal()
data_pie_EAT <- data %>%
count(EAT_cat) %>%
mutate(
prop = n / sum(n),
labels = percent(prop, 0.1)
)
ggplot(data_pie_EAT, aes(x = "", y = prop, fill = EAT_cat)) +
geom_col(width = 1) +
geom_text(aes(label = labels),
position = position_stack(vjust = 0.5),
size = 4) +
coord_polar("y", start = 0) +
labs(title = "Répartition des catégories de score EAT",
fill = "Score EAT") +
theme_void() +
scale_fill_brewer(palette = "Set2")
Q2B.5 Tableaux croisés et test du χ²
On construit les tableaux croisés suivants :
- BMI_classe × Nomination
- EAT_cat × Nomination
- EAT_cat × BMI_classe
Pour chaque tableau, on :
- donne les effectifs et les fréquences (en % lignes ou colonnes)
- réalise un test du χ² d’indépendance
- formule clairement l’hypothèse H0 (variables indépendantes) ou H1 (variables dépendantes)
- conclut en langage courant (au seuil de 5%)
1) BMI_classe × Nomination
tab_BMI_Nom <- table(data$BMI_classe, data$Nomination)
tab_BMI_Nom ##
## GR GT NS
## Insuffisance pondérale 26 13 14
## Corpulence normale 35 20 25
## Surpoids/obésité 0 8 3prop.table(tab_BMI_Nom, margin = 1) ##
## GR GT NS
## Insuffisance pondérale 0.4905660 0.2452830 0.2641509
## Corpulence normale 0.4375000 0.2500000 0.3125000
## Surpoids/obésité 0.0000000 0.7272727 0.2727273chisq_BMI_Nom <- chisq.test(tab_BMI_Nom)
chisq_BMI_Nom$p.value ## [1] 0.008237198p.value < 0.05 donc on rejette H0 et on conclut que les variables ne sont pas indépendantes. Cela signifie que la répartition des classes d’IMC n’est pas la même selon les groupes de Nomination, certains groupes comportant proportionnellement plus d’élèves en insuffisance pondérale ou en surpoids que d’autres.
2) EAT_cat × Nomination
tab_EAT_Nom <- table(data$EAT_cat, data$Nomination)
tab_EAT_Nom ##
## GR GT NS
## Score bas 22 36 15
## Score modéré 16 5 24
## Score élevé 23 0 3prop.table(tab_EAT_Nom, margin = 1)##
## GR GT NS
## Score bas 0.3013699 0.4931507 0.2054795
## Score modéré 0.3555556 0.1111111 0.5333333
## Score élevé 0.8846154 0.0000000 0.1153846chisq_EAT_Nom <- chisq.test(tab_EAT_Nom)
chisq_EAT_Nom$p.value## [1] 8.294902e-11p.value < 0.05 donc on rejette H0 et on conclut que les variables ne sont pas indépendantes. On met donc en évidence des différences de profils de score EAT entre les groupes de Nomination, certains groupes présentant davantage de scores élevés ou modérés que d’autres.
3) EAT_cat × BMI_classe
tab_EAT_BMI <- table(data$EAT_cat, data$BMI_classe)
tab_EAT_BMI ##
## Insuffisance pondérale Corpulence normale Surpoids/obésité
## Score bas 26 39 8
## Score modéré 14 28 3
## Score élevé 13 13 0prop.table(tab_EAT_BMI, margin = 1)##
## Insuffisance pondérale Corpulence normale Surpoids/obésité
## Score bas 0.35616438 0.53424658 0.10958904
## Score modéré 0.31111111 0.62222222 0.06666667
## Score élevé 0.50000000 0.50000000 0.00000000chisq_EAT_BMI <- chisq.test(tab_EAT_BMI)
chisq_EAT_BMI$p.value## [1] 0.2566082p.value >= 0.05 donc on ne rejette pas H0 et les variables sont donc indépendantes. Dans cet échantillon, les catégories de BMI et les catégories de score EAT apparaissent donc indépendantes, ce qui suggère qu’un BMI plus élevé n’est pas forcément associé à un score EAT plus élevé.
Partie 3 - Analyse univariée des variables quantitatives
3.1 Indicateurs de position et de dispersion
Q3.1 Indicateurs de position et de dispersion
Pour chacune des variables Age, Taille, Poids, BMI, EAT, on calcule :
- la moyenne,
- la médiane,
- le mode (valeur la plus fréquente ou approximation),
- les quartiles (Q1, Q3),
- la variance et l’écart-type,
- le minimum et le maximum
vars_quanti <- c("Age", "Taille", "Poids", "BMI", "EAT")
resume_quanti <- data %>%
select(all_of(vars_quanti)) %>%
summarise(
across(
everything(),
list(
moy = ~mean(. , na.rm = TRUE),
med = ~median(. , na.rm = TRUE),
var = ~var(. , na.rm = TRUE),
sd = ~sd(. , na.rm = TRUE),
q1 = ~quantile(., 0.25, na.rm = TRUE),
q3 = ~quantile(., 0.75, na.rm = TRUE),
min = ~min(. , na.rm = TRUE),
max = ~max(. , na.rm = TRUE)
)
)
)
t(resume_quanti)## [,1]
## Age_moy 16.173611111
## Age_med 16.000000000
## Age_var 3.640977078
## Age_sd 1.908134450
## Age_q1 15.000000000
## Age_q3 17.000000000
## Age_min 13.000000000
## Age_max 22.000000000
## Taille_moy 1.647152778
## Taille_med 1.650000000
## Taille_var 0.003461067
## Taille_sd 0.058830837
## Taille_q1 1.610000000
## Taille_q3 1.690000000
## Taille_min 1.480000000
## Taille_max 1.790000000
## Poids_moy 51.888888889
## Poids_med 52.000000000
## Poids_var 35.260295260
## Poids_sd 5.938037998
## Poids_q1 47.000000000
## Poids_q3 56.000000000
## Poids_min 38.000000000
## Poids_max 70.000000000
## BMI_moy 19.075000000
## BMI_med 18.900000000
## BMI_var 2.795874126
## BMI_sd 1.672086758
## BMI_q1 17.875000000
## BMI_q3 19.800000000
## BMI_min 16.200000000
## BMI_max 24.200000000
## EAT_moy 12.729166667
## EAT_med 10.000000000
## EAT_var 97.877185315
## EAT_sd 9.893289914
## EAT_q1 5.000000000
## EAT_q3 17.000000000
## EAT_min 1.000000000
## EAT_max 45.000000000Globalement, les indicateurs de position et de dispersion obtenus sont cohérents avec le contexte de l’étude (adolescents) et ne mettent pas en évidence de valeurs complètement aberrantes.
Q3.2 Histogrammes et forme de la distribution
Pour Age, BMI et EAT, on trace les histogrammes adaptés (nombre de classes raisonnable). Pour chaque histogramme, on commente :
- la forme de la distribution (symétrique, asymétrique à droite / à gauche),
- la présence éventuelle de valeurs extrêmes,
- la cohérence avec les indicateurs (moyenne vs médiane).
ggplot(data, aes(x = Age)) +
geom_histogram(color = "black", fill = "#2171b5", bins = 10) +
labs(title = "Histogramme de l'âge", x = "Age", y = "Effectif") +
theme_minimal()
ggplot(data, aes(x = BMI)) +
geom_histogram(color = "black", fill = "#fb9a99", bins = 10) +
labs(title = "Histogramme du BMI", x = "BMI", y = "Effectif") +
theme_minimal()
ggplot(data, aes(x = EAT)) +
geom_histogram(color = "black", fill = "#6a3d9a", bins = 10) +
labs(title = "Histogramme du score EAT", x = "EAT", y = "Effectif") +
theme_minimal()
Les histogrammes permettent de visualiser la forme des distributions de Age, BMI et EAT et de repérer d’éventuelles asymétries ou valeurs extrêmes, en cohérence avec les indicateurs calculés à la question précédente.
Q3.3 Boîtes à moustaches (boxplots)
On trace des boîtes à moustaches pour BMI et EAT (boxplots simples, sans groupe). Puis on rappelle ce que représentent :
- la ligne centrale (médiane),
- les bords de la boîte (Q1 et Q3),
- les moustaches,
- les points isolés (valeurs aberrantes). Enfin on commente la dispersion et les éventuels outliers.
ggplot(data, aes(y = BMI)) +
geom_boxplot(fill = "#2171b5") +
labs(title = "Boxplot du BMI", y = "BMI") +
theme_minimal()
ggplot(data, aes(y = EAT)) +
geom_boxplot(fill = "#fb9a99") +
labs(title = "Boxplot du score EAT", y = "EAT") +
theme_minimal()
Les boxplots montrent que la dispersion de BMI reste modérée autour de la médiane, tandis que les scores EAT peuvent présenter une variabilité plus importante et quelques valeurs atypiques.
3.2 Groupement en classes (Yule, Sturges)
Q3C.1 Choix du nombre de classes
x <- data$BMI
x <- x[!is.na(x)]
n <- length(x)
xmin <- min(x)
xmax <- max(x)
k_yule <- 2.5 * n^(1/4)
k_sturges <- 1 + 3.3 * log10(n)
k_yule## [1] 8.660254k_sturges## [1] 8.122596Ces deux règles donnent des valeurs proches pour le nombre de classes ; on retient un nombre entier de classes k en s’appuyant sur ces approximations.
Q3C.2 Largeur de classe et bornes
k <- round(k_sturges)
L <- xmax - xmin
h <- L / k
bornes <- seq(from = xmin, to = xmax, length.out = k + 1)
bornes## [1] 16.2 17.2 18.2 19.2 20.2 21.2 22.2 23.2 24.2On obtient ainsi une largeur de classe constante et un système de bornes qui couvre l’ensemble des valeurs observées de BMI.
Q3C.3 Tableau de fréquences par classes
classes <- cut(x, breaks = bornes, right = FALSE, include.lowest = TRUE)
tab_eff <- table(classes)
tab_freq <- prop.table(tab_eff)
tab_freq_cum <- cumsum(tab_freq)
tab_classes <- data.frame(
Classe = names(tab_eff),
Effectif = as.vector(tab_eff),
Frequence = round(100 * as.vector(tab_freq), 2),
Frequence_cumulee = round(100 * as.vector(tab_freq_cum), 2)
)
tab_classes## Classe Effectif Frequence Frequence_cumulee
## 1 [16.2,17.2) 13 9.03 9.03
## 2 [17.2,18.2) 33 22.92 31.94
## 3 [18.2,19.2) 37 25.69 57.64
## 4 [19.2,20.2) 33 22.92 80.56
## 5 [20.2,21.2) 10 6.94 87.50
## 6 [21.2,22.2) 9 6.25 93.75
## 7 [22.2,23.2) 6 4.17 97.92
## 8 [23.2,24.2] 3 2.08 100.00Le tableau de fréquences par classes permet de voir dans quelles classes de BMI se concentrent la majorité des sujets et comment se répartissent les fréquences cumulées.
Q3C.4 Histogramme basé sur les classes
df_bmi <- data.frame(BMI = x)
ggplot(df_bmi, aes(x = BMI)) +
geom_histogram(
breaks = bornes,
color = "black",
fill = "#2171b5",
closed = "left"
) +
labs(title = "Histogramme du BMI (classes Yule/Sturges)",
x = "BMI", y = "Effectif") +
theme_minimal()
L’histogramme basé sur ces classes spécifiques de BMI est globalement cohérent avec l’histogramme “par défaut” mais rend explicite le choix du nombre de classes et de leurs bornes.
Partie 4 - Variables quantitatives conditionnellement à une qualitative
Q4.1 Boxplots par groupe
On représente graphiquement la distribution de BMI et de EAT en fonction de Nomination à l’aide de boîtes à moustaches, afin de comparer les médianes, la dispersion et les valeurs extrêmes entre groupes.
ggplot(data, aes(x = Nomination, y = BMI)) +
geom_boxplot(fill = "#2171b5") +
labs(title = "BMI selon la nomination",
x = "Nomination", y = "BMI") +
theme_minimal()
ggplot(data, aes(x = Nomination, y = EAT)) +
geom_boxplot(fill = "#fb9a99") +
labs(title = "EAT selon la nomination",
x = "Nomination", y = "Score EAT") +
theme_minimal()
Q4.2 Moyennes par groupe
descr_nom <- data %>%
group_by(Nomination) %>%
summarise(
moy_BMI = mean(BMI, na.rm = TRUE),
sd_BMI = sd(BMI, na.rm = TRUE),
moy_EAT = mean(EAT, na.rm = TRUE),
sd_EAT = sd(EAT, na.rm = TRUE),
.groups = "drop"
)
descr_nom## # A tibble: 3 × 5
## Nomination moy_BMI sd_BMI moy_EAT sd_EAT
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 GR 18.5 1.25 17.2 12.4
## 2 GT 19.7 2.04 5.95 4.29
## 3 NS 19.2 1.58 12.9 4.71Ce tableau récapitule, pour chaque groupe de Nomination, les moyennes et écarts‑types de BMI et de EAT, ce qui permet de comparer les niveaux moyens et la variabilité des scores entre groupes.
Partie 5 - Relations entre variables quantitatives : corrélation et régression
5.1 Corrélation
Q5.1 Nuage de points et corrélation BMI-EAT
On étudie la relation entre BMI et EAT à l’aide d’un nuage de points et du coefficient de corrélation de Pearson.
ggplot(data, aes(x = BMI, y = EAT)) +
geom_point(color = "#2171b5") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = "Relation entre BMI et EAT",
x = "BMI", y = "Score EAT") +
theme_minimal()
cor_BMI_EAT <- cor(data$BMI, data$EAT, use = "complete.obs")
cor_BMI_EAT## [1] -0.1394908Q5.2 Matrice de corrélation
vars_corr <- data %>%
select(BMI, EAT, Diete, Boulimie, Control)
cor_matrix <- cor(vars_corr, use = "complete.obs")
cor_matrix## BMI EAT Diete Boulimie Control
## BMI 1.00000000 -0.1394908 -0.0585915 -0.05368277 -0.2931693
## EAT -0.13949077 1.0000000 0.9201260 0.71505627 0.6260825
## Diete -0.05859150 0.9201260 1.0000000 0.51038527 0.3359026
## Boulimie -0.05368277 0.7150563 0.5103853 1.00000000 0.3956766
## Control -0.29316931 0.6260825 0.3359026 0.39567657 1.0000000La matrice de corrélation permet d’identifier les paires de variables les plus associées (positivement ou négativement) parmi BMI, EAT, Diete, Boulimie et Control. On observe notamment une corrélation positive marquée entre EAT et Diete, ainsi qu’entre EAT et Boulimie, ce qui reflète la proximité de ces dimensions de comportement alimentaire.
5.2 Régression linéaire
Q5.3 Régression simple : EAT - BMI
On ajuste un modèle de régression linéaire simple de EAT en fonction de BMI et on interprète les paramètres estimés et le R².
mod1 <- lm(EAT ~ BMI, data = data)
summary(mod1)##
## Call:
## lm(formula = EAT ~ BMI, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -13.937 -7.590 -1.667 4.531 31.053
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 28.4723 9.4143 3.024 0.00296 **
## BMI -0.8253 0.4917 -1.679 0.09542 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.831 on 142 degrees of freedom
## Multiple R-squared: 0.01946, Adjusted R-squared: 0.01255
## F-statistic: 2.818 on 1 and 142 DF, p-value: 0.09542Ce modèle permet juste de voir s’il y a une tendance linéaire entre BMI et EAT et combien de variabilité de EAT est expliquée par BMI.
Q5.4 Régression multiple : EAT - BMI + Diete + Boulimie + Control
Ce modèle ajoute Diete, Boulimie et Control à BMI pour mieux prendre en compte les différents aspects du comportement alimentaire.
mod2 <- lm(EAT ~ BMI + Diete + Boulimie + Control, data = data)
summary(mod2)##
## Call:
## lm(formula = EAT ~ BMI + Diete + Boulimie + Control, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.96351 -0.00396 0.00804 0.01687 0.03902
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.164255 0.085660 -1.918 0.0572 .
## BMI 0.007595 0.004367 1.739 0.0842 .
## Diete 1.000676 0.001192 839.361 <2e-16 ***
## Boulimie 1.001083 0.003529 283.703 <2e-16 ***
## Control 1.001769 0.002749 364.446 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.08326 on 139 degrees of freedom
## Multiple R-squared: 0.9999, Adjusted R-squared: 0.9999
## F-statistic: 5.048e+05 on 4 and 139 DF, p-value: < 2.2e-16Le modèle multiple prend en compte simultanément plusieurs dimensions du comportement alimentaire et améliore généralement l’ajustement par rapport au modèle simple. Dans ce cadre, les variables Diete et Boulimie ressortent comme les prédicteurs les plus fortement associés au score EAT, tandis que l’effet de BMI devient plus faible une fois ces dimensions contrôlées.
Q5.5 Diagnostic du modèle
par(mfrow = c(2, 2))
plot(mod2)
par(mfrow = c(1, 1))
shapiro.test(residuals(mod2))##
## Shapiro-Wilk normality test
##
## data: residuals(mod2)
## W = 0.16103, p-value < 2.2e-16Les graphiques de diagnostic et le test de Shapiro-Wilk permettent de vérifier que les hypothèses du modèle linéaire multiple sont raisonnablement satisfaites.
Partie 6 - Comparaison de groupes (ANOVA simple)
Q6.1 ANOVA à un facteur
On réalise une ANOVA à un facteur pour tester si le score EAT diffère selon les groupes de Nomination.
anova_mod <- aov(EAT ~ Nomination, data = data)
summary(anova_mod)## Df Sum Sq Mean Sq F value Pr(>F)
## Nomination 2 3102 1550.9 20.07 2.14e-08 ***
## Residuals 141 10895 77.3
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Q6.2 Comparaisons multiples (si NOVA significative)
TukeyHSD(anova_mod)## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = EAT ~ Nomination, data = data)
##
## $Nomination
## diff lwr upr p adj
## GT-GR -11.245502 -15.450399 -7.0406047 0.0000000
## NS-GR -4.339578 -8.514431 -0.1647256 0.0395993
## NS-GT 6.905923 2.334677 11.4771694 0.0013703Le test de Tukey précise quelles paires de groupes de Nomination présentent des différences significatives de score EAT. On met ainsi en évidence que certains groupes de Nomination ont un score EAT moyen significativement plus élevé ou plus faible que d’autres, ce qui confirme l’existence de différences de comportements alimentaires entre groupes.
Partie 7 - Analyse en composantes principales (ACP) et classification
7.1 Préparation des données pour l’ACP
Q7.1 Création de la matrice de travail
vars_acp <- data %>%
select(BMI, EAT, Diete, Boulimie, Control) %>%
na.omit()
X <- scale(vars_acp)
cor(vars_acp)## BMI EAT Diete Boulimie Control
## BMI 1.00000000 -0.1394908 -0.0585915 -0.05368277 -0.2931693
## EAT -0.13949077 1.0000000 0.9201260 0.71505627 0.6260825
## Diete -0.05859150 0.9201260 1.0000000 0.51038527 0.3359026
## Boulimie -0.05368277 0.7150563 0.5103853 1.00000000 0.3956766
## Control -0.29316931 0.6260825 0.3359026 0.39567657 1.0000000On prépare ainsi une matrice de travail standardisée contenant uniquement les variables quantitatives retenues pour l’ACP.
7.2 ACP (Analyse en composantes principales)
Q7.2 Calcul de l’ACP
acp <- prcomp(X, center = FALSE, scale. = FALSE)
summary(acp)## Importance of components:
## PC1 PC2 PC3 PC4 PC5
## Standard deviation 1.6830 1.0386 0.7684 0.7060 0.006494
## Proportion of Variance 0.5665 0.2157 0.1181 0.0997 0.000010
## Cumulative Proportion 0.5665 0.7822 0.9003 1.0000 1.000000L’ACP sert ici à résumer les cinq variables (BMI, EAT, Diete, Boulimie, Control) sur quelques axes plus faciles à lire.
Q7.3 Scree plot
plot(acp, type = "l", main = "Scree plot ACP")
Q7.4 Cercle des corrélations
library(factoextra)
fviz_pca_var(acp, col.var = "contrib")
Q7.5 Projection des individus
fviz_pca_ind(acp, geom.ind = "point")
Le scree plot, le cercle des corrélations et la carte des individus permettent de voir quels axes sont importants, comment les variables se regroupent et comment les élèves se distribuent sur ces axes.
7.3 Classification (clustering) à partir de l’ACP
Q7C.1 Choix de la base pour le clustering
coords <- acp$x[, 1:3]Q7C.2 Classification ascendante hiérarchique (CAH)
d <- dist(coords)
cah <- hclust(d, method = "ward.D2")
plot(cah, labels = FALSE, main = "Dendrogramme (CAH, Ward)")
K <- 3
cluster_CAH <- cutree(cah, k = K)Q7C.3 Description des groupes obtenus
data_clust <- data %>%
filter(complete.cases(BMI, EAT, Diete, Boulimie, Control)) %>%
mutate(cluster_CAH = factor(cluster_CAH))
descr_clusters <- data_clust %>%
group_by(cluster_CAH) %>%
summarise(
n = n(),
BMI_moy = mean(BMI),
EAT_moy = mean(EAT),
Diete_moy = mean(Diete),
Boulimie_moy = mean(Boulimie),
Control_moy = mean(Control),
.groups = "drop"
)
descr_clusters## # A tibble: 3 × 7
## cluster_CAH n BMI_moy EAT_moy Diete_moy Boulimie_moy Control_moy
## <fct> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 51 18.2 5.04 3.06 0.451 1.55
## 2 2 22 18.4 31.6 20.2 5.41 6
## 3 3 71 19.9 12.4 7.52 2.39 2.49Ce tableau donne, pour chaque cluster, le nombre d’élèves et les moyennes des variables BMI, EAT, Diete, Boulimie et Control. On obtient ainsi des groupes avec des scores plutôt faibles ou plutôt élevés sur ces variables.
Q7C.4 Lien entre les clusters et variables qualitatives
table(data_clust$cluster_CAH, data_clust$Nomination)##
## GR GT NS
## 1 23 21 7
## 2 21 0 1
## 3 17 20 34chisq.test(table(data_clust$cluster_CAH, data_clust$Nomination))##
## Pearson's Chi-squared test
##
## data: table(data_clust$cluster_CAH, data_clust$Nomination)
## X-squared = 46.845, df = 4, p-value = 1.642e-09table(data_clust$cluster_CAH, data_clust$BMI_classe)##
## Insuffisance pondérale Corpulence normale Surpoids/obésité
## 1 29 22 0
## 2 11 11 0
## 3 13 47 11chisq.test(table(data_clust$cluster_CAH, data_clust$BMI_classe))##
## Pearson's Chi-squared test
##
## data: table(data_clust$cluster_CAH, data_clust$BMI_classe)
## X-squared = 27.509, df = 4, p-value = 1.568e-05table(data_clust$cluster_CAH, data_clust$EAT_cat)##
## Score bas Score modéré Score élevé
## 1 46 5 0
## 2 0 0 22
## 3 27 40 4chisq.test(table(data_clust$cluster_CAH, data_clust$EAT_cat))##
## Pearson's Chi-squared test
##
## data: table(data_clust$cluster_CAH, data_clust$EAT_cat)
## X-squared = 154.87, df = 4, p-value < 2.2e-16Les tableaux croisés et tests du χ² permettent d’étudier le lien entre les clusters obtenus et les variables qualitatives Nomination, BMI_classe et EAT_cat.
Q7C.5 Clustering par k-means (optionnel)
set.seed(123)
km <- kmeans(coords, centers = K, nstart = 20)
km$cluster## [1] 3 3 3 2 2 3 3 3 3 3 3 3 2 2 1 3 3 3 3 3 2 3 3 1 1 2 3 3 3 1 3 3 3 3 3 3 2
## [38] 2 2 2 2 2 2 2 2 2 3 3 3 2 2 2 2 2 1 2 2 2 2 2 2 3 3 1 3 1 3 1 1 2 1 3 3 1
## [75] 3 1 1 2 1 3 3 3 3 3 2 3 3 2 1 3 3 3 3 3 2 1 2 2 1 3 1 2 3 3 3 3 3 1 3 3 1
## [112] 1 3 1 3 3 1 1 1 3 3 1 3 1 3 3 3 3 1 1 3 1 3 3 1 3 3 3 1 1 3 3 1 3CONCLUSION FINALE DU TP
Globalement, les élèves ont un BMI dans la zone de corpulence normale, avec peu de surpoids. Les scores EAT, Diete, Boulimie et Control sont en revanche très variables d’un élève à l’autre. Les corrélations et les régressions montrent surtout un lien entre EAT, Diete et Boulimie, alors que BMI explique peu de choses à lui seul. L’ANOVA suggère des différences de score EAT entre certains groupes de Nomination. Enfin, l’ACP et la classification regroupent les élèves en quelques groupes ayant des profils de scores plutôt faibles ou plutôt élevés.