mirror of
https://github.com/ArthurDanjou/ArtStudies.git
synced 2026-01-14 15:54:13 +01:00
383 lines
12 KiB
Plaintext
383 lines
12 KiB
Plaintext
---
|
||
title: "DM Statistique exploratoire multidimensionelle - Arthur DANJOU"
|
||
output:
|
||
pdf_document: default
|
||
html_document:
|
||
df_print: paged
|
||
editor_options:
|
||
markdown:
|
||
wrap: 72
|
||
---
|
||
|
||
------------------------------------------------------------------------
|
||
|
||
Ce devoir maison est à rendre individuellement au plus tard le 1er mars
|
||
2024 sous format RMarkdown (.Rmd) à l'adresse mail de votre chargé de
|
||
TD. Vous veillerez à respecter la structure du document en répondant aux
|
||
questions directement dans celui-ci. Des cellules vides de code ont été
|
||
ajoutées en dessous de chaque question, libre à vous d'en rajouter
|
||
d'autres si vous voulez segmenter vos réponses. Vous renommerez votre
|
||
fichier réponse avec votre NOM et Prénom (ex: NOM_Prénom_DM_ACP.Rmd)
|
||
|
||
------------------------------------------------------------------------
|
||
|
||
```{r setup, include=FALSE}
|
||
knitr::opts_chunk$set(include = FALSE)
|
||
```
|
||
|
||
# PARTIE 1 : Calcul de composantes principales sous R (Sans FactoMineR)
|
||
|
||
- Vide l'environnement de travail, initialise la matrice avec laquelle
|
||
vous allez travailler
|
||
|
||
```{r}
|
||
rm(list=ls())
|
||
```
|
||
|
||
- Importation du jeu de données (compiler ce qui est ci-dessous mais
|
||
NE SURTOUT PAS MODIFIER)
|
||
|
||
```{r}
|
||
library(dplyr)
|
||
notes_MAN <- read.table("notes_MAN.csv", sep=";", dec=",", row.names=1, header=TRUE)
|
||
# on prépare le jeu de données en retirant la colonne des Mentions
|
||
# qui est une variable catégorielle
|
||
notes_MAN_prep <- notes_MAN[,-1]
|
||
|
||
X <- notes_MAN[1:6,]%>%select(c("Probas","Analyse","Anglais","MAN.Stats","Stats.Inférentielles"))
|
||
# on prépare le jeu de données en retirant la colonne des Mentions
|
||
# qui est une variable catégorielle
|
||
# View(X)
|
||
|
||
```
|
||
|
||
```{r}
|
||
X <- scale(X,center=TRUE,scale=TRUE)
|
||
X
|
||
```
|
||
|
||
- Question 1 : que fait la fonction “scale” dans la cellule ci-dessus
|
||
? (1 point)
|
||
|
||
La fonction *scale* permet de normaliser et de réduire notre matrice X.
|
||
|
||
- Question 2: utiliser la fonction eigen afin de calculer les valeurs
|
||
propres et vecteurs propres de la matrice de corrélation de X. Vous
|
||
stockerez les valeurs propres dans un vecteur nommé lambda et les
|
||
vecteurs propres dans une matrice nommée vect (1 point).
|
||
|
||
```{r}
|
||
cor_X <- cor(X)
|
||
eigen_X <- eigen(cor_X, symmetric = TRUE)
|
||
lambda <- eigen_X["values"]$values
|
||
vect <- eigen_X["vectors"]$vectors
|
||
```
|
||
|
||
```{r}
|
||
lambda
|
||
```
|
||
|
||
- Question 3 : quelle est la part d’inertie expliquée par les 2
|
||
premières composantes principales ? (1 point)
|
||
|
||
```{r}
|
||
inertie_total_1 <- sum(diag(cor_X)) # Inertie est égale à la trace de la matrice de corrélation
|
||
inertie_total_1
|
||
inertie_total_2 <- sum(lambda) # Inertie est aussi égale à la somme des valeurs propres
|
||
inertie_total_2
|
||
inertie_axes <- (lambda[1] + lambda[2]) / inertie_total_1 # Inertie expliquée par les deux premières composantes principales
|
||
inertie_axes
|
||
```
|
||
|
||
- Question 4 : calculer les coordonnées des individus sur les deux
|
||
premières composantes principales (1 point)
|
||
|
||
```{r}
|
||
C <- X %*% vect
|
||
C[,1:2]
|
||
```
|
||
|
||
- Question 5 : représenter les individus sur le plan formé par les
|
||
deux premières composantes principales (1 point)
|
||
|
||
```{r}
|
||
colors <- c('blue', 'red', 'green', 'yellow', 'purple', 'orange')
|
||
plot(
|
||
C[,1],C[,2],
|
||
main="Coordonnées des individus par rapport \n aux deux premières composantes principales",
|
||
xlab = "Première composante principale",
|
||
ylab = "Deuxieme composante principale",
|
||
panel.first = grid(),
|
||
col = colors,
|
||
pch=15
|
||
)
|
||
legend(x = 'topleft', legend = rownames(X), col = colors, pch = 15)
|
||
```
|
||
|
||
------------------------------------------------------------------------
|
||
|
||
# PARTIE 2 : ACP avec FactoMineR
|
||
|
||
À partir de maintenant, on considère l'entièreté des notes et des
|
||
étudiants.
|
||
|
||
- Question 1 : Écrire maximum 2 lignes de code qui renvoient le nombre
|
||
d’individus et le nombre de variables.
|
||
|
||
```{r}
|
||
nrow(notes_MAN_prep) # Nombre d'individus
|
||
ncol(notes_MAN_prep) # Nombre de variables
|
||
```
|
||
|
||
```{r}
|
||
dim(notes_MAN_prep) # On peut également utiliser 'dim' qui renvoit la dimension
|
||
```
|
||
|
||
Il y a donc **42** individus et **14** variables. A noter que la
|
||
variable **Mention** n'est pas prise en compte.
|
||
|
||
- Question 2 : Réaliser l’ACP normée.
|
||
|
||
```{r,echo=FALSE}
|
||
library(FactoMineR)
|
||
# help(PCA)
|
||
```
|
||
|
||
```{r}
|
||
# Ne pas oublier de charger la librairie FactoMineR
|
||
|
||
# Indication : pour afficher les résultats de l'ACP pour tous les individus, utiliser la
|
||
# fonction summary en précisant dedans nbind=Inf et nbelements=Inf
|
||
res.notes <- PCA(notes_MAN_prep, scale.unit = TRUE)
|
||
```
|
||
|
||
```{r}
|
||
summary(res.notes, nbind = Inf, nbelements = Inf, nb.dec = 2)
|
||
```
|
||
|
||
- Question 3 : Afficher l’éboulis des valeurs propres.
|
||
|
||
```{r}
|
||
eigen_values <- res.notes$eig
|
||
|
||
bplot <- barplot(
|
||
eigen_values[, 1],
|
||
names.arg = 1:nrow(eigen_values),
|
||
main = "Eboulis des valeurs propres",
|
||
xlab = "Principal Components",
|
||
ylab = "Eigenvalues",
|
||
col = "lightblue"
|
||
)
|
||
lines(x = bplot, eigen_values[, 1], type = "b", col = "red")
|
||
abline(h=1, col = "darkgray", lty = 5)
|
||
```
|
||
|
||
- Question 4 : Quelles sont les coordonnées de la variable MAN.Stats
|
||
sur le cercle des corrélations ?
|
||
|
||
La variable **MAN.Stats** est la **9-ième** variable de notre dataset. Les
|
||
coordonnées de cette variable sont : $(corr(C_1, X_9), corr(C_2, X_9))$
|
||
avec:
|
||
|
||
\* $corr(x,y)$: la corrélation entre x et y
|
||
|
||
\* $C_1$: le vecteur de la composante principale 1
|
||
|
||
\* $C_2$: le vecteur de la composante principale 2
|
||
|
||
\* $X_9$: le vecteur de la 9-ième variable (dans notre cas, *MAN.Stats*)
|
||
|
||
Depuis notre ACP, on peut donc récupérer les coordonnées:
|
||
|
||
```{r}
|
||
coords_man_stats <- res.notes$var$coord["MAN.Stats",]
|
||
coords_man_stats[1:2]
|
||
```
|
||
|
||
Les coordonnées de la variable **MAN.Stats** sont donc environ
|
||
**(0.766,-0.193)**
|
||
|
||
- Question 5 : Quelle est la contribution moyenne des individus ?
|
||
Quelle est la contribution de Thérèse au 3e axe principal ?
|
||
|
||
```{r}
|
||
contribs <- res.notes$ind$contrib
|
||
contrib_moy_ind <- mean(contribs) # 100 * 1/42
|
||
contrib_therese <- res.notes$ind$contrib["Thérèse",3]
|
||
|
||
contrib_moy_ind
|
||
contrib_therese
|
||
```
|
||
|
||
La contribution moyenne est donc environ égale à **2,38%**. La
|
||
contribution de Thérèse au 3e axe principal est environ égal à **5.8%**
|
||
|
||
- Question 6 : Quelle est la qualité de représentation de Julien sur
|
||
le premier plan factoriel (constitué du premier et deuxième axe) ?
|
||
|
||
La qualité de représentation de 'Julien' sur le premier plan factoriel
|
||
est donné par la formule :
|
||
|
||
$cos_{α,β}(x^{(i)})^2 = cos_{α}(x^{(i)})^2 + cos_{β}(x^{(i)})^2$ avec:
|
||
|
||
\* $cos_α(x^{(i)})^2 = \frac{(C^{i}_{α})^2}{||x(i)||^2}$
|
||
|
||
\* $cos_β(x^{(i)})^2 = \frac{(C^{i}_{β})^2}{||x(i)||^2}$
|
||
|
||
```{r}
|
||
quali_julien <- res.notes$ind$cos2["Julien", 1:2]
|
||
quali_julien
|
||
sum(quali_julien * 100)
|
||
```
|
||
|
||
La qualité de représentation de **Julien** sur le plan factoriel est
|
||
donc la somme des carrés des cosinus pour les deux premières composantes
|
||
principales. On a donc une qualité environ égale à **0.95** soit
|
||
**95%.**
|
||
|
||
- Question 7 : Discuter du nombre d’axes à conserver selon les deux
|
||
critères vus en cours. Dans toutes la suite on gardera néanmoins 2
|
||
axes.
|
||
|
||
Nous avons vu deux critères principaux: le critère de Kaiser et le
|
||
critère du coude. Le critère de Kaiser dit de garder uniquement les
|
||
valeurs propres supérieures ou égales à 1. Dans notre cas, il faudrait
|
||
donc garder les **quatre plus grandes valeurs propres** (on peut le voir
|
||
facilement à partir du graphe question 3), c'est à dire conserver
|
||
**quatre axes principaux**. Pour satisfaire le critère du coude, on
|
||
observe également le graphique question 3, et on observe le point de
|
||
“courbure maximale” du diagramme, appelé "coude". On en observe deux :
|
||
un premier coude apparaît au niveau de la valeur propre 2 et un second
|
||
au niveau de la valeur propre 4. Il faut donc garder ou bien **les deux
|
||
plus grandes valeurs propres ou bien les quatre plus grandes**, donc
|
||
conserver ou bien **deux axes principaux, ou bien quatre**.
|
||
|
||
- Question 8 : Effectuer l’étude des individus. Être en particulier
|
||
vigilant aux étudiants mal représentés et commenter.
|
||
|
||
## Contribution moyenne
|
||
|
||
```{r}
|
||
contrib_moy_ind <- mean(res.notes$ind$contrib)
|
||
contrib_moy_ind
|
||
```
|
||
La contribution moyenne est donc environ égale à **2,38%**
|
||
|
||
## Axe 1
|
||
|
||
```{r}
|
||
indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,1], decreasing = TRUE)
|
||
head(indiv_contrib_axe_1, 3)
|
||
```
|
||
|
||
**Geneviève**, **Aimée** et **Céleste** sont les individus les plus
|
||
influents sur l'axe 1. **Geneviève** et **Aimée** sont de coordonnée
|
||
négative sur l'axe 1 tandis que **Céleste** est de coordonnée positive
|
||
sur l'axe 1.
|
||
|
||
## Axe 2
|
||
|
||
```{r}
|
||
indiv_contrib_axe_2 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE)
|
||
head(indiv_contrib_axe_2, 3)
|
||
```
|
||
|
||
**Gilles**, **Guillaume** et **Suzanne** sont les individus les plus
|
||
influents sur l'axe 2. **Guillaume** est de coordonnée positive sur
|
||
l'axe 2 tandis que **Gilles** et **Suzanne** sont de coordonnée négative
|
||
sur l'axe 2.
|
||
|
||
## Qualité de la représentation
|
||
|
||
On regarde les individus mal représentés par rapport aux deux premiers
|
||
axes, c'est à dire ceux qui se distinguent ni par l'axe 1, ni par l'axe
|
||
2.
|
||
|
||
```{r}
|
||
mal_representes <- rownames(res.notes$ind$cos2)[rowSums(res.notes$ind$cos2[,1:2]) <= mean(res.notes$ind$cos2[,1:2])]
|
||
mal_representes
|
||
```
|
||
|
||
- Question 9 : Relancer une ACP en incluant la variable catégorielle
|
||
des mentions comme variable supplémentaire.
|
||
|
||
```{r}
|
||
res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention"))
|
||
plot.PCA(res.notes_sup, choix = "ind", habillage = "Mention")
|
||
```
|
||
|
||
```{r}
|
||
summary(res.notes_sup, nb.dec = 2, nbelements = Inf, nbind = Inf)
|
||
```
|
||
|
||
- Question 10 : Déduire des deux questions précédentes une
|
||
interprétation du premier axe principal.
|
||
|
||
La prise en compte de la variable supplémentaire **Mentions**, montre en outre que la
|
||
première composante principale est liée à la mention obtenue par les étudiants.
|
||
On peut donc interpréter la première composante principale comme étant liée à la
|
||
réussite des étudiants.
|
||
|
||
|
||
- Question 11 : Effectuer l’analyse des variables. Commenter les UE
|
||
mal représentées.
|
||
|
||
## Contribution moyenne
|
||
|
||
```{r}
|
||
contrib_moy_var <- mean(res.notes_sup$var$contrib) # 100 * 1/14
|
||
contrib_moy_var
|
||
```
|
||
|
||
La contribution moyenne est environ égale à **7,14%**
|
||
|
||
## Axe 1
|
||
|
||
Toutes les variables ont à peu près cette contribution, sauf
|
||
l'**Anglais** et les **Options.S5** et **Options.S6** et elles ont
|
||
toutes une coordonnée positive.
|
||
|
||
## Axe 2
|
||
|
||
```{r}
|
||
var_contrib_axe_2 <- sort(res.notes_sup$var$contrib[,2], decreasing = TRUE)
|
||
head(var_contrib_axe_2, 3)
|
||
```
|
||
|
||
Les variables avec la plus grosse contribution sont l'**Anglais** et
|
||
l'**EDO**, corrélées positivement avec la seconde composante principale,
|
||
et **Options.S6**, corrélées négativement.
|
||
|
||
## Qualité de la représentation
|
||
|
||
```{r}
|
||
mal_representes <- rownames(res.notes_sup$var$cos2[,1:2])[rowSums(res.notes_sup$var$cos2[,1:2]) <= 0.6]
|
||
mal_representes
|
||
mal_representes_moy <- rownames(res.notes_sup$var$cos2[,1:2])[rowSums(res.notes_sup$var$cos2[,1:2]) <= mean(res.notes_sup$var$cos2[,1:2])]
|
||
mal_representes_moy
|
||
```
|
||
|
||
Toutes les variables ont une qualité de représentation supérieure à 60%
|
||
sauf 4 variables : l'**Anglais**, **MAN.PPEI.Projet**, **Options.S5** et
|
||
**Options.S6**.
|
||
|
||
On remarque également que l'**Options.S5** est la variable la moins bien représentée dans le plan car sa qualité de représentation dans le plan est inférieure à la moyenne des qualités de représentation des variables dans le plan.
|
||
|
||
- Question 12 : Interpréter les deux premières composantes
|
||
principales.
|
||
|
||
On dira que la première composante principale définit un “facteur de taille” car
|
||
toutes les variables sont corrélées positivement entre elles. Ce phénomène
|
||
correspond à la situation dans laquelle certains individus ont des petites valeurs
|
||
pour l’ensemble des variables d’autres de grandes valeurs pour l’ensemble des
|
||
variables. Il existe en ce cas une structure commune à l’ensemble des variables :
|
||
c’est ce que traduit la première composante principale.
|
||
|
||
Le premier axe principal propre va donc classer les individus selon leur “taille” sur
|
||
cet axe c.à.d selon les valeurs croissantes de l’ensemble des variables (en
|
||
moyenne), c'est à dire selon leur réussite, donc leur moyenne générale de leurs notes.
|
||
|
||
Le deuxième axe définit un “facteur de forme” : il y a deux groupes de variables
|
||
opposées, celles qui contribuent positivement à l’axe, celles qui contribuent
|
||
négativement. Vu les variables en question, la deuxième composante principale
|
||
s’interprète aisément comme opposant les matières du semestre 5 à celles du semestre 6. |