Packages utilisés (à installer une seule fois avec
install.packages()) :
library(FactoMineR) # ACP, ACM, AFDM
library(factoextra) # visualisations (fviz_*)
library(dplyr) # sélection de variables
# Installation à la demande (utile si vous exécutez ce TD sur un autre poste)
for (p in c("FactoMineR", "factoextra", "dplyr")) {
if (!requireNamespace(p, quietly = TRUE)) install.packages(p)
}
Les jeux decathlon et tea sont fournis avec
FactoMineR : le document est immédiatement
reproductible (aucune donnée externe n’est requise). Pour
l’exercice 4 (béton), le code lit en priorité le fichier du cours
TD_genie_civil.xlsx s’il est posé dans le dossier du
document ; sinon il génère un jeu simulé reproductible
en interne (seed fixée), de même structure que la feuille
beton prévue par le TD.
Ce document présente les travaux dirigés n°2 du cours STI812
— Statistique et analyse de données (Master S8 GC-BTP, 2iE),
consacrés aux analyses factorielles avec le package
FactoMineR. L’objectif est double : maîtriser la mise en
œuvre sous R des trois principales techniques — ACP
(variables quantitatives), ACM (variables qualitatives)
et AFDM (tableaux mixtes) — et savoir interpréter
rigoureusement leurs sorties : éboulis des valeurs propres, cercle des
corrélations, contributions, qualités de représentation (cos²) et
projections d’individus.
Le document est organisé en cinq parties : l’ACP sur
le jeu decathlon (41 athlètes décrits par 10 épreuves) ;
l’ACM sur le jeu tea (300 consommateurs,
18 variables qualitatives) ; une partie théorique qui
démontre les propriétés fondamentales de l’ACP (var(c) = u′Ru, équation
Ru = λu, valeurs propres λ₁ = 1+r et λ₂ = 1−r pour deux variables) ;
l’AFDM appliquée au jeu decathlon ; enfin,
une étude de cas professionnelle sur les formulations de
béton (80 éprouvettes, filière GC-BTP), prolongée par des tests
statistiques (khi-deux, ANOVA). Pour ne pas alourdir la lecture, les
blocs de code R sont repliés par défaut (option
code_folding: hide) : cliquez sur « Code » pour les
consulter et justifier chaque réponse. Toutes les interprétations
chiffrées proviennent strictement des sorties R du document.
decathlondata(decathlon)
dim(decathlon) # 41 individus x 13 variables
## [1] 41 13
names(decathlon)
## [1] "100m" "Long.jump" "Shot.put" "High.jump" "400m"
## [6] "110m.hurdle" "Discus" "Pole.vault" "Javeline" "1500m"
## [11] "Rank" "Points" "Competition"
# ACP sur les 10 épreuves (colonnes 1 à 10) ; Rank, Points et Competition exclues
res.pca <- PCA(decathlon[, 1:10], ncp = 10, graph = FALSE) # ncp = nb max d'axes (10 variables)
Le jeu contient 41 athlètes décrits par 10 variables
quantitatives (les 10 épreuves du décathlon). L’ACP est
réalisée sur données centrées-réduites (option par
défaut de PCA() : ACP normée), ce qui est indispensable car
les épreuves ont des unités et des échelles très différentes (secondes,
mètres).
round(res.pca$eig, 3) # valeurs propres, % d'inertie, % cumulés (10 axes)
## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 3.272 32.719 32.719
## comp 2 1.737 17.371 50.090
## comp 3 1.405 14.049 64.140
## comp 4 1.057 10.569 74.708
## comp 5 0.685 6.848 81.556
## comp 6 0.599 5.993 87.548
## comp 7 0.451 4.512 92.061
## comp 8 0.397 3.969 96.030
## comp 9 0.215 2.148 98.178
## comp 10 0.182 1.822 100.000
fviz_eig(res.pca, addlabels = TRUE, ncp = 10) # éboulis complet (10 axes)
sum(res.pca$eig[1:2, 1]) / sum(res.pca$eig[, 1]) * 100 # % cumulé plan 1-2
## [1] 50.09037
Lecture. Les quatre premières valeurs propres dépassent 1 : λ₁ = 3,27 (32,7 %), λ₂ = 1,74 (17,4 %), λ₃ = 1,41 (14,0 %), λ₄ = 1,06 (10,6 %).
fviz_pca_var(res.pca, col.var = "contrib") # couleur = contribution
round(res.pca$var$coord[, 1:2], 2) # corrélations variables / axes
## Dim.1 Dim.2
## 100m -0.77 0.19
## Long.jump 0.74 -0.35
## Shot.put 0.62 0.60
## High.jump 0.57 0.35
## 400m -0.68 0.57
## 110m.hurdle -0.75 0.23
## Discus 0.55 0.61
## Pole.vault 0.05 -0.18
## Javeline 0.28 0.32
## 1500m -0.06 0.47
Lecture.
100m r = −0,77 ;
110m.hurdle r = −0,75 ; 400m r = −0,68) et
positivement au saut en longueur (Long.jump r = +0,74) et
au poids (Shot.put r = +0,62). Comme un temps petit
= performance forte, l’axe 1 oppose les athlètes
complets et performants (à droite) aux athlètes
moins performants sur l’ensemble des épreuves (à
gauche) : c’est l’axe du niveau général de
performance.Discus r = +0,61 ; Shot.put r = +0,60) et, en
négatif, par les épreuves longues (400m r = +0,57 avec
temps lent ; 1500m r = +0,47) : il oppose un profil
« puissant / lanceur » (haut de l’axe) à un profil
« endurant / plus léger » (bas de l’axe).round(sort(res.pca$var$contrib[, 1], decreasing = TRUE), 1) # contributions axe 1
## 100m 110m.hurdle Long.jump 400m Shot.put High.jump
## 18.3 17.0 16.8 14.1 11.8 10.0
## Discus Javeline 1500m Pole.vault
## 9.3 2.3 0.1 0.1
round(res.pca$var$cos2[, 1:2], 2) # cos2 axes 1-2
## Dim.1 Dim.2
## 100m 0.60 0.04
## Long.jump 0.55 0.12
## Shot.put 0.39 0.36
## High.jump 0.33 0.12
## 400m 0.46 0.32
## 110m.hurdle 0.56 0.05
## Discus 0.31 0.37
## Pole.vault 0.00 0.03
## Javeline 0.08 0.10
## 1500m 0.00 0.22
Lecture.
100m (18,3
%), 110m.hurdle (17,0 %), Long.jump (16,8 %),
400m (14,1 %), Shot.put (11,8 %) — ces cinq
épreuves totalisent ≈ 78 % de l’axe. À l’inverse,
Pole.vault et Javeline (≈ 0 et 2,3 %) n’y
contribuent pratiquement pas.Shot.put (0,75), Discus
(0,68), 100m (0,64), 110m.hurdle (0,61),
Long.jump (0,67), 400m (0,78). Mal
représentées : Pole.vault (0,03), Javeline
(0,18) et 1500m (0,22) — leurs positions sur le cercle ne
doivent pas être interprétées.fviz_pca_ind(res.pca, repel = TRUE, col.ind = "cos2")
round(res.pca$ind$coord[order(-res.pca$ind$coord[, 1]), ][1:5, ], 2) # extrêmes axe 1
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8 Dim.9 Dim.10
## Karpov 4.62 0.04 -0.04 -1.31 0.19 -0.74 0.45 -1.07 -0.18 0.12
## Sebrle 4.04 1.37 -0.29 1.94 0.38 -0.07 0.55 0.75 0.06 0.63
## Clay 3.92 0.84 0.23 1.49 -1.04 0.81 0.87 0.30 -0.01 -0.82
## Macey 2.23 1.04 -1.86 -0.74 0.98 0.04 0.19 -0.69 0.44 -0.17
## Warners 2.17 -1.80 0.85 -0.28 -0.15 0.08 -0.06 -0.21 0.17 0.08
Lecture. Trois profils se dégagent :
teadata(tea)
dim(tea) # 300 individus x 36 variables
## [1] 300 36
res.mca <- MCA(tea[, 1:18], ncp = 18, graph = FALSE) # 18 variables qualitatives
round(head(res.mca$eig, 6), 3) # 6 premiers axes sur 18
## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.148 9.885 9.885
## dim 2 0.122 8.103 17.988
## dim 3 0.090 6.001 23.989
## dim 4 0.078 5.204 29.192
## dim 5 0.074 4.917 34.109
## dim 6 0.071 4.759 38.868
L’ACM porte sur 300 consommateurs × 18 variables qualitatives. Les taux d’inertie des axes sont faibles (λ₁ = 0,148 soit 9,9 %, λ₂ = 0,122 soit 8,1 %, soit 18 % cumulés) : c’est normal en ACM, l’inertie étant éclatée sur de nombreuses modalités ; on interprète quand même les premiers axes.
fviz_mca_var(res.mca, repel = TRUE)
round(sort(res.mca$var$contrib[, 1], decreasing = TRUE)[1:8], 1) # top contrib. axe 1
## chain store+tea shop tearoom tea bag+unpackaged
## 11.3 11.2 6.8
## resto Not.friends chain store
## 6.3 6.0 4.4
## pub tea bag
## 4.4 4.3
round(sort(res.mca$var$contrib[, 2], decreasing = TRUE)[1:8], 1) # top contrib. axe 2
## tea shop p_upscale unpackaged chain store tea bag green
## 23.9 20.5 18.9 4.6 4.5 3.3
## p_branded Earl Grey
## 2.5 2.4
Lecture.
tearoom (+11,2
%, coord. +1,25), chain store+tea shop (+11,3 %, coord.
+1,08), resto, pub, opposés à
Not.friends (−0,68) et tea bag (−0,45) : il
oppose une consommation « hédoniste / hors domicile / thé en
vrac de qualité » à une consommation « utilitaire /
domestique / sachet ».tea shop (+23,9
%, coord. +2,29), unpackaged (vrac, +18,9 %),
p_upscale (prix élevé, +20,5 %), green (thé
vert), opposés à tea bag, p_branded,
chain store : c’est un axe « profil expert / achat
haut de gamme en boutique spécialisée » vs « achat de
commodité en supermarché ».tea shop, unpackaged, p_upscale
d’un côté ; tea bag, chain store,
p_branded de l’autre.fviz_mca_ind(res.mca, alpha.ind = 0.4)
Lecture. Les individus se regroupent principalement selon le lieu d’achat et le type de thé : un groupe « boutique spécialisée / vrac / haut de gamme », un groupe « supermarché / sachet / marque », et entre les deux des profils intermédiaires (salon de thé, consommation entre amis). Ces groupes pourront être formalisés par une classification (chaîne ACM → HCPC, comme au TD3).
Soit \(X\) la matrice des données centrées-réduites (n lignes, p colonnes, pondération 1/n), \(R = \frac{1}{n}X^\top X\) la matrice de corrélation, \(u\) un vecteur unitaire et \(c = Xu\) la composante associée.
1. Montrer que var(c) = u′Ru.
\(X\) étant centrée, \(\bar c = \frac{1}{n}\mathbf{1}^\top Xu = \bar{x}^\top u = 0\). Donc, avec la pondération 1/n :
\[\mathrm{var}(c) = \frac{1}{n}\sum_{i=1}^n c_i^2 = \frac{1}{n}c^\top c = \frac{1}{n}u^\top X^\top X u = u^\top \underbrace{\Big(\tfrac{1}{n}X^\top X\Big)}_{R} u = u^\top R u.\]
2. Montrer que le maximum est atteint pour Ru = λu. On maximise var(c) sous la contrainte \(u^\top u = 1\) avec le lagrangien :
\[\mathcal{L}(u,\lambda) = u^\top R u - \lambda (u^\top u - 1),\qquad \frac{\partial \mathcal{L}}{\partial u} = 2Ru - 2\lambda u = 0 \;\Longrightarrow\; Ru = \lambda u.\]
\(u\) est donc un vecteur propre de R et \(\mathrm{var}(c) = u^\top Ru = \lambda\, u^\top u = \lambda\) : la variance expliquée par l’axe vaut la valeur propre. Le maximum s’obtient avec la plus grande valeur propre (premier axe).
3. Valeurs propres. Avec \(R=\begin{pmatrix}1&r\\ r&1\end{pmatrix}\) :
\[\det(R-\lambda I) = (1-\lambda)^2 - r^2 = (1-\lambda-r)(1-\lambda+r)=0 \;\Longrightarrow\; \boxed{\lambda_1 = 1+r,\quad \lambda_2 = 1-r}\]
avec λ₁ ≥ λ₂ car 0 < r < 1.
4. Part d’inertie du premier axe.
\[\tau_1 = \frac{\lambda_1}{\lambda_1+\lambda_2} = \frac{1+r}{(1+r)+(1-r)} = \frac{1+r}{2}.\]
Quand \(r \to 1\), \(\tau_1 \to 1\) (100 %) : les deux variables deviennent parfaitement corrélées (colinéaires), le nuage s’aplatit sur une droite et un seul axe suffit à décrire les données. Quand r → 0, τ₁ → 1/2 : les deux axes se valent, aucune structure.
Vérification numérique avec r = 0,7 :
r <- 0.7
Rm <- matrix(c(1, r, r, 1), 2, 2)
eigen(Rm)$values # attendu : 1.7 et 0.3
## [1] 1.7 0.3
(1 + r) / 2 # part d'inertie axe 1 : attendu 0.85
## [1] 0.85
set.seed(1); n <- 5000 # simulation : var(c1) doit valoir lambda1
X <- matrix(rnorm(2 * n), n, 2)
X[, 2] <- r * X[, 1] + sqrt(1 - r^2) * X[, 2]
X <- scale(X)
var(X %*% eigen(Rm)$vectors[, 1]) # attendu ≈ 1.7
## [,1]
## [1,] 1.709515
On retrouve bien λ₁ = 1,7, λ₂ = 0,3, τ₁ = 85 % et var(c₁) ≈ 1,7 = λ₁ : la théorie est confirmée.
# 10 épreuves (quantitatives) + Competition (qualitative) — colonne 13
don <- decathlon[, c(1:10, 13)]
res.famd <- FAMD(don, ncp = 10, graph = FALSE)
round(res.famd$eig, 3)
## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 3.346 30.420 30.420
## comp 2 1.738 15.803 46.223
## comp 3 1.507 13.698 59.921
## comp 4 1.164 10.581 70.502
## comp 5 1.018 9.258 79.760
## comp 6 0.614 5.579 85.339
## comp 7 0.588 5.348 90.687
## comp 8 0.413 3.750 94.437
## comp 9 0.291 2.645 97.082
## comp 10 0.197 1.793 98.875
fviz_screeplot(res.famd, addlabels = TRUE, ncp = 10)
L’AFDM traite simultanément les 10 mesures et la variable qualitative
Competition (Decastar / OlympicG). Le plan 1–2 restitue
46,2 % de l’inertie (30,4 % + 15,8 %).
round(res.famd$var$coord[, 1:2], 2)
## Dim.1 Dim.2
## 100m 0.64 0.03
## Long.jump 0.52 0.13
## Shot.put 0.40 0.36
## High.jump 0.31 0.12
## 400m 0.44 0.33
## 110m.hurdle 0.55 0.06
## Discus 0.29 0.35
## Pole.vault 0.00 0.04
## Javeline 0.09 0.11
## 1500m 0.01 0.20
## Competition 0.11 0.00
round(res.famd$var$contrib[, 1:2], 1)
## Dim.1 Dim.2
## 100m 19.2 1.9
## Long.jump 15.5 7.5
## Shot.put 12.0 20.6
## High.jump 9.2 6.7
## 400m 13.0 19.2
## 110m.hurdle 16.4 3.3
## Discus 8.6 20.2
## Pole.vault 0.0 2.4
## Javeline 2.7 6.4
## 1500m 0.2 11.6
## Competition 3.2 0.2
round(res.famd$quali.var$contrib, 1) # contribution de la variable qualitative
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8 Dim.9 Dim.10
## Decastar 2.2 0.1 13.5 22.5 8.1 2.2 2.0 0.4 6.9 0.7
## OlympicG 1.0 0.1 6.3 10.4 3.8 1.0 0.9 0.2 3.2 0.3
fviz_famd_var(res.famd)
Lecture. Oui, les deux types contribuent :
100m (19,2 % de l’axe
1), 110m.hurdle (16,4 %), Long.jump (15,5 %) —
même structure qu’en ACP à l’axe 1.Competition contribue à
hauteur de 3,2 % à l’axe 1 (modalités Decastar 2,2 %,
OlympicG 1,0 %) : sa contribution est plus faible car elle n’a que deux
modalités, mais elle n’est pas nulle — elle distingue le niveau de
compétition sur les axes.saveRDS(res.famd, "res_famd.rds")
file.exists("res_famd.rds")
## [1] TRUE
L’objet res.famd est sauvegardé dans
res_famd.rds : il constitue le point de départ de la
classification HCPC demandée ultérieurement.
if (file.exists("TD_genie_civil.xlsx")) {
if (!requireNamespace("readxl", quietly = TRUE)) install.packages("readxl")
library(readxl)
d <- as.data.frame(read_excel("TD_genie_civil.xlsx", sheet = "beton"))
cat("Données du cours :", nrow(d), "éprouvettes ×", ncol(d), "variables.\n")
} else {
stop("Posez TD_genie_civil.xlsx dans le dossier du .Rmd, ou bien utilisez un Working Directory qui le contient.")
}
## Données du cours : 80 éprouvettes × 10 variables.
d$granulat <- factor(d$granulat)
d$pathologie <- factor(d$pathologie, levels = c("non", "oui"))
num <- d |> dplyr::select(dosage_ciment_kg_m3, rapport_eau_ciment, age_jours,
affaissement_mm, porosite_pct, resistance_MPa)
cat("Répartition granulats :\n"); print(table(d$granulat))
## Répartition granulats :
##
## alluvionnaire calcaire granitique
## 19 23 38
cat("Répartition pathologie :\n"); print(table(d$pathologie))
## Répartition pathologie :
##
## non oui
## 69 11
cat("Valeurs manquantes :", sum(is.na(d)) - sum(is.na(d$formulation)), "\n")
## Valeurs manquantes : 0
Le jeu contient 80 formulations (10 colonnes dont
id et formulation) — aucune valeur
manquante. Répartition : alluvionnaire (19), calcaire
(23), granitique (38) ; 11 formulations pathologiques
sur 80 (13,8 %).
Préalable utile pour l’interprétation des axes, corrélations avec la résistance mécanique :
round(sort(sapply(num, cor, num$resistance_MPa)), 2)
## rapport_eau_ciment affaissement_mm porosite_pct dosage_ciment_kg_m3
## -0.32 -0.26 -0.24 0.21
## age_jours resistance_MPa
## 0.60 1.00
→ âge (+0,60) corrélé positivement (maturité) ; E/C (−0,32), affaissement (−0,26) et porosité (−0,24) négativement (loi d’Abrams) ; dosage (+0,21) effet secondaire.
res.b <- PCA(num, ncp = 6, graph = FALSE)
round(res.b$eig, 3)
## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 2.008 33.463 33.463
## comp 2 1.458 24.299 57.762
## comp 3 1.086 18.104 75.866
## comp 4 0.833 13.884 89.751
## comp 5 0.447 7.445 97.196
## comp 6 0.168 2.804 100.000
fviz_eig(res.b, addlabels = TRUE, ncp = 6)
| Axe | λ | % inertie | cumulé |
|---|---|---|---|
| 1 | 2,008 | 33,5 % | 33,5 % |
| 2 | 1,458 | 24,3 % | 57,8 % |
| 3 | 1,086 | 18,1 % | 75,9 % |
| 4 | 0,833 | 13,9 % | 89,8 % |
Critère de Kaiser (λ > 1) → 3 axes retenus (75,9 %). Règle du coude → rupture après l’axe 3. L’interprétation portera sur le plan 1-2 (57,8 %) puis sur l’axe 3 (effet dosage ciment).
fviz_pca_var(res.b, col.var = "contrib")
round(res.b$var$coord[, 1:3], 2)
## Dim.1 Dim.2 Dim.3
## dosage_ciment_kg_m3 -0.19 -0.31 0.83
## rapport_eau_ciment 0.73 0.45 0.25
## age_jours -0.34 0.90 0.00
## affaissement_mm 0.59 0.31 -0.17
## porosite_pct 0.62 0.15 0.47
## resistance_MPa -0.77 0.47 0.28
Axe 1 (33,5 %) — axe physico-chimique « pâte cimentaire / porosité ». Construit par résistance (29,6 %), E/C (26,8 %), porosité (19,0 %), affaissement (17,1 %). Sur le demi-axe positif : E/C (+0,73), porosité (+0,62), affaissement (+0,59) — bétons mous, poreux, peu résistants. Sur le demi-axe négatif : résistance (−0,77) — bétons compacts et résistants : illustration de la loi d’Abrams (E/C ↑ → porosité capillaire ↑ → résistance ↓). Le dosage y contribue très peu (1,9 %).
Axe 2 (24,3 %) — axe « temps d’hydratation ». Dominé par l’âge (55,9 %, r = +0,90), avec résistance (r = +0,47) : la cure longue (90–365 j) permet d’atteindre 45–55 MPa même avec E/C moyen.
Axe 3 (18,1 %) — axe « dosage ciment ». Porté à 64,1 % par le dosage (r = +0,83), avec porosité (20,6 %) : effet « richesse en ciment » qu’on retrouve à part de l’axe 1.
round(res.b$var$cos2[, 1:3], 2)
## Dim.1 Dim.2 Dim.3
## dosage_ciment_kg_m3 0.04 0.10 0.70
## rapport_eau_ciment 0.54 0.20 0.06
## age_jours 0.11 0.81 0.00
## affaissement_mm 0.34 0.09 0.03
## porosite_pct 0.38 0.02 0.22
## resistance_MPa 0.59 0.22 0.08
Qualité de représentation sur le plan 1-2 (cos²) : excellent pour âge (0,92), résistance (0,81) et E/C (0,74) ; moyen pour affaissement (0,43) et porosité (0,40) ; faible pour dosage ciment (0,14) — la position du dosage sur le plan 1-2 n’est pas interprétable (mais il est bien représenté sur l’axe 3, cos² = 0,70).
Meilleures représentations sur le plan 1-2 (cos² cumulé axe 1 + axe 2) :
fviz_pca_ind(res.b, repel = TRUE, col.ind = "cos2")
ind.b <- round(res.b$ind$coord[, 1:3], 2)
ind.b[order(-ind.b[, 1]), ][1:5, ] # extrêmes axe 1 (+)
## Dim.1 Dim.2 Dim.3
## 68 3.10 1.22 0.26
## 18 3.05 0.13 -0.36
## 69 3.04 -0.67 0.49
## 56 2.41 0.45 1.87
## 38 2.40 -0.61 -2.08
ind.b[order( ind.b[, 1]), ][1:5, ] # extrêmes axe 1 (−)
## Dim.1 Dim.2 Dim.3
## 71 -3.11 2.12 0.79
## 46 -2.84 -0.73 -0.47
## 65 -2.76 -1.17 1.05
## 76 -2.32 -1.38 -1.29
## 24 -2.21 2.07 1.65
ind.b[order(-ind.b[, 2]), ][1:5, ] # extrêmes axe 2 (+)
## Dim.1 Dim.2 Dim.3
## 66 1.36 3.03 -0.20
## 4 1.05 2.93 0.46
## 48 -0.27 2.93 0.00
## 75 -0.59 2.80 -2.65
## 40 -0.86 2.47 0.33
Habillage du plan par pathologie et par granulat :
fviz_pca_ind(res.b, repel = TRUE, habillage = d$pathologie, addEllipses = TRUE, ellipse.level = 0.95)
fviz_pca_ind(res.b, repel = TRUE, habillage = d$granulat, addEllipses = TRUE, ellipse.level = 0.95)
→ L’ellipse « pathologie = oui » est nettement décalée vers la droite du plan (axe 1 positif) : la pathologie est concentrée dans la zone « pâte molle / poreuse / faible résistance ». Le granulat, lui, ne sépare pas visuellement, ce que confirme le test du khi-deux (§ 4.5).
Tableau mixte : 6 variables quantitatives + 2
qualitatives (granulat 4 modalités,
pathologie 2 modalités).
res.famd <- FAMD(d[, c("dosage_ciment_kg_m3", "rapport_eau_ciment",
"age_jours", "affaissement_mm", "porosite_pct",
"resistance_MPa", "granulat", "pathologie")],
ncp = 8, graph = FALSE)
round(res.famd$eig[, 1:2], 3)
## eigenvalue percentage of variance
## comp 1 2.438 27.089
## comp 2 1.493 16.588
## comp 3 1.167 12.962
## comp 4 1.099 12.214
## comp 5 1.045 11.606
## comp 6 0.906 10.063
## comp 7 0.450 4.997
## comp 8 0.274 3.047
round(res.famd$var$coord[, 1:2], 2)
## Dim.1 Dim.2
## dosage_ciment_kg_m3 0.09 0.06
## rapport_eau_ciment 0.40 0.24
## age_jours 0.10 0.77
## affaissement_mm 0.21 0.14
## porosite_pct 0.41 0.01
## resistance_MPa 0.62 0.16
## granulat 0.05 0.09
## pathologie 0.56 0.01
round(res.famd$var$contrib[, 1:2], 1)
## Dim.1 Dim.2
## dosage_ciment_kg_m3 3.7 3.7
## rapport_eau_ciment 16.3 16.1
## age_jours 4.0 51.6
## affaissement_mm 8.6 9.7
## porosite_pct 16.9 0.8
## resistance_MPa 25.4 11.0
## granulat 2.1 6.1
## pathologie 23.0 0.9
fviz_famd_var(res.famd, repel = TRUE)
fviz_famd_ind(res.famd, repel = TRUE, habillage = "pathologie", addEllipses = TRUE)
| Variable (axe 1, 27,1 %) | Type | Contribution axe 1 | Contribution axe 2 |
|---|---|---|---|
resistance_MPa |
quanti | 25,4 % | 11,0 % |
pathologie (Oui) |
quali | 23,0 % | 0,9 % |
porosite_pct |
quanti | 16,9 % | 0,8 % |
rapport_eau_ciment |
quanti | 16,3 % | 16,1 % |
affaissement_mm |
quanti | 8,6 % | 9,7 % |
age_jours |
quanti | 4,0 % | 51,6 % |
dosage_ciment_kg_m3 |
quanti | 3,7 % | 3,7 % |
granulat |
quali | 2,1 % | 6,1 % |
→ L’AFDM valide et enrichit l’ACP : la modalité « pathologie = oui » contribue à 23,0 % à l’axe 1 et la modalité « pathologie = non » contribue très peu : la pathologie recouvre presqu’exactement la zone droite de l’ACP (E/C élevé / porosité élevée / Rc faible). Le granulat a une contribution faible (≤ 2,3 % sur l’axe 1, ≤ 3,8 % sur l’axe 2) : pas de différenciation nette — la qualité du béton dépend d’abord de la formulation (E/C, dosage, cure), pas du type de granulat.
Khi-deux (granulat × pathologie) :
print(round(prop.table(table(d$granulat, d$pathologie), 1) * 100, 1))
##
## non oui
## alluvionnaire 73.7 26.3
## calcaire 87.0 13.0
## granitique 92.1 7.9
print(chisq.test(table(d$granulat, d$pathologie)))
##
## Pearson's Chi-squared test
##
## data: table(d$granulat, d$pathologie)
## X-squared = 3.6379, df = 2, p-value = 0.1622
→ χ² = 3,64, ddl = 2, p = 0,16 : non significatif à 5 %. La pathologie n’est pas différemment distribuée selon le granulat, bien que les % de pathologie par granulat suggèrent un ordre décroissant (alluvionnaire 26 %, calcaire 13 %, granitique 8 %). Note : effectifs théoriques < 5 dans une cellule → la p-value est à interpréter avec prudence, mais le message qualitatif reste : aucun effet granulat marqué.
ANOVA (résistance ~ pathologie) :
summary(aov(resistance_MPa ~ pathologie, data = d))
## Df Sum Sq Mean Sq F value Pr(>F)
## pathologie 1 1265 1265 24.82 3.7e-06 ***
## Residuals 78 3974 51
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(round(tapply(d$resistance_MPa, d$pathologie, mean), 2))
## non oui
## 45.09 33.55
# Moyennes des autres variables par pathologie
cat("E/C moyen :", round(mean(d$rapport_eau_ciment[d$pathologie == "non"]), 3),
"(sain) vs", round(mean(d$rapport_eau_ciment[d$pathologie == "oui"]), 3), "(patho)\n")
## E/C moyen : 0.522 (sain) vs 0.57 (patho)
cat("Porosité moyenne :", round(mean(d$porosite_pct[d$pathologie == "non"]), 2),
"(sain) vs", round(mean(d$porosite_pct[d$pathologie == "oui"]), 2), "(patho)\n")
## Porosité moyenne : 12.89 (sain) vs 16.89 (patho)
cat("Affaissement moyen :", round(mean(d$affaissement_mm[d$pathologie == "non"]), 1),
"(sain) vs", round(mean(d$affaissement_mm[d$pathologie == "oui"]), 1), "(patho)\n")
## Affaissement moyen : 94.2 (sain) vs 99.6 (patho)
→ F = 24,82, p = 3,7·10⁻⁶ (hautement significatif). Moyennes : sains = 45,1 MPa, pathologiques = 33,5 MPa — écart de 11,6 MPa (−26 %). C’est la confirmation numérique de la lecture factorielle : la pathologie se loge dans le quart « faible résistance / E/C élevé / porosité forte ». Le triplet « E/C, porosité, ouvrabilité » est bien conjugué à la pathologie, ce qui justifie un modèle de régression logistique (TD4).
saveRDS(res.b, "res_acp_beton.rds")
saveRDS(res.famd, "res_famd_beton.rds")
cat("Objets sauvegardés : res_acp_beton.rds et res_famd_beton.rds\n")
## Objets sauvegardés : res_acp_beton.rds et res_famd_beton.rds
Trois classes opérationnelles émergent, confirmées par l’ACP, l’AFDM et les tests :
→ Pour le TD suivant (CAH/k-means sur ces 80
formulations), on s’attend à retrouver ces trois classes,
avec un recouvrement presque parfait entre la classe 3 et la
modalité pathologie == oui — la classification non
supervisée et le label pathologique convergent sur la zone droite de
l’ACP.
Ce TD illustre la complémentarité des méthodes factorielles et la
cohérence de leurs lectures. Sur le jeu décathlon,
l’ACP normée révèle un axe 1 « niveau général de performance
» (50,1 % du plan 1–2, porté par 100 m, 110 m haies, saut en
longueur, 400 m) opposant les polyvalents complets — Karpov, Sebrle,
Clay — aux profils faibles, et un axe 2 « puissance vs endurance
» construit par les lancers (face aux épreuves longues). Le
critère de Kaiser retient quatre axes (74,7 % d’inertie
cumulée). L’ACM sur tea, malgré des taux
d’inertie modestes (18 % cumulés sur les deux premiers axes, ce qui est
normal en ACM), structure clairement les comportements : consommation
hédoniste / hors domicile / vrac haut de gamme contre
consommation utilitaire / sachet / supermarché.
La partie théorique a été validée numériquement : pour deux variables centrées-réduites de corrélation r, les valeurs propres valent bien λ₁ = 1+r et λ₂ = 1−r (vérifié : 1,7 et 0,3 pour r = 0,7 ; part d’inertie τ₁ = 85 %), et la variance de la composante égale la valeur propre (var(c₁) ≈ 1,7) — confirmant que maximiser var(c) revient à diagonaliser R.
Sur le cas béton, l’ACP (3 axes retenus, 75,9 %) et
l’AFDM convergent : la pathologie est
concentrée dans la zone « E/C élevé — porosité forte — résistance faible
» (illustration de la loi d’Abrams), et l’ANOVA en
apporte la confirmation numérique (F = 24,82 ; p = 3,7·10⁻⁶ ; écart de
11,6 MPa soit −26 % entre bétons sains 45,1 MPa et pathologiques 33,5
MPa). Le granulat, lui, ne différencie rien de
significatif (χ² = 3,64 ; ddl = 2 ; p = 0,16). Trois classes
opérationnelles se dégagent — bétons compacts performants,
bétons matures sains, bétons à risque pathologique — que la
classification (CAH/k-means) du TD3 devra retrouver, avec un
recouvrement attendu entre la classe à risque et la modalité
pathologie = oui.
Enseignements méthodologiques : toujours vérifier le critère de Kaiser et la règle du coude avant d’interpréter ; contrôler les cos² avant toute lecture de position ; en présence de variables mixtes, privilégier l’AFDM ; et croiser systématiquement la lecture factorielle avec des tests inférentiels (khi-deux, ANOVA) pour asseoir les conclusions.