mirror of
https://github.com/ArthurDanjou/ArtStudies.git
synced 2026-01-25 13:52:39 +01:00
243 lines
7.1 KiB
Plaintext
243 lines
7.1 KiB
Plaintext
---
|
||
title: "TP3 : Suite ACP"
|
||
output:
|
||
html_document: default
|
||
pdf_document: default
|
||
---
|
||
|
||
```{r setup, include=FALSE}
|
||
knitr::opts_chunk$set(echo = TRUE)
|
||
```
|
||
|
||
Exercice 1
|
||
----------------------------------------------------------------------------------------
|
||
|
||
```{r}
|
||
Notes<- matrix(c(6,6,5,5.5,8,8,8,8,6,7,11,9.5,14.5,14.5,15.5,15,14,14,12,12.5,11,
|
||
10,5.5,7,5.5,7,14,11.5,13,12.5,8.5,9.5,9,9.5,12.5,12,
|
||
12,11.5,14,12,6,8,8,7,15,16,14,12),nrow=12,byrow=T)
|
||
rownames(Notes) <- c("Rémi","Thomas","Gaëtan","Ahmed","Louise","Kylian",
|
||
"Antoine","Raphaël","Jean","Rayan","Matthieu","Sophie")
|
||
colnames(Notes) <- c("Math","Phys","Fr","Ang")
|
||
```
|
||
|
||
* Effectuer l'analyse ACP
|
||
|
||
```{r}
|
||
library(FactoMineR)
|
||
res.acp <- PCA(Notes, scale.unit=TRUE)
|
||
```
|
||
|
||
```{r}
|
||
summary(res.acp, nbind = Inf, nbelements = Inf)
|
||
```
|
||
|
||
# Individus : Contribution moyenne, Axes 1 et 2, Qualité de représentation
|
||
|
||
```{r}
|
||
mean(res.acp$ind$contrib)
|
||
|
||
indiv_contrib_axe_1 <- sort(res.acp$ind$contrib[,1], decreasing = TRUE)
|
||
head(indiv_contrib_axe_1, 3)
|
||
indiv_contrib_axe_2 <- sort(res.acp$ind$contrib[,2], decreasing = TRUE)
|
||
head(indiv_contrib_axe_2, 3)
|
||
|
||
mal_representes <- rownames(res.acp$ind$cos2)[rowSums(res.acp$ind$cos2[,1:2]) <= mean(res.acp$ind$cos2[,1:2])]
|
||
mal_representes
|
||
```
|
||
|
||
# Variables : Contribution moyenne, Axes 1 et 2, Qualité de représentation
|
||
|
||
```{r}
|
||
mean(res.acp$var$contrib)
|
||
|
||
var_contrib_axe_1 <- sort(res.acp$var$contrib[,1], decreasing = TRUE)
|
||
head(var_contrib_axe_1, 3)
|
||
var_contrib_axe_2 <- sort(res.acp$var$contrib[,2], decreasing = TRUE)
|
||
head(var_contrib_axe_2, 3)
|
||
|
||
mal_representes <- rownames(res.acp$var$cos2[,1:2])[rowSums(res.acp$var$cos2[,1:2]) <= mean(res.acp$var$cos2[,1:2])]
|
||
mal_representes
|
||
```
|
||
|
||
Le premier axe va donc classer les individus selon leur moyenne alors que le second axe va classer les individus selon leur profil : scientifique ou littéraire.
|
||
|
||
----------------------------------------------------------------------------------------
|
||
|
||
Exercice 2
|
||
|
||
Six marques de jus d’orange 100% pur jus présentes dans les supermarchés français ont été évaluées par un panel d’experts selon sept variables sensorielles (intensité de l’odeur, typicité de l’odeur, teneur en pulpe, intensité du goût, acidité, amertume, douceur). Ces 6 marques sont Pampryl amb. (conservation à température ambiante), Tropicana amb., Fruvita amb., Joker amb., Tropicana fr. (conservation au frais), Pampryl fr.
|
||
|
||
1) Importer le jeu de données "jusdorange.csv" et appeler le "jus".
|
||
|
||
```{r}
|
||
jus <- read.table("jusdorange.csv", header = TRUE, sep = ";", row.names = 1)
|
||
```
|
||
|
||
|
||
2) Créer le tableau individus-variables "jus" associé et afficher le. (Deja inclus dans question 1.)
|
||
```{r}
|
||
# jus_table <- jus[-1]
|
||
# rownames(jus_table) <- jus[,1]
|
||
```
|
||
|
||
|
||
3) Afficher le descriptif des variables.
|
||
|
||
```{r}
|
||
summary(jus)
|
||
```
|
||
|
||
4) Afficher les 6 premières lignes de "jus".
|
||
|
||
```{r}
|
||
jus[1:6,]
|
||
```
|
||
|
||
|
||
|
||
5) Afficher la matrice de corrélation associée à ce jeu données "jus" Commenter brièvement les corrélations .
|
||
|
||
```{r}
|
||
cor(jus)
|
||
```
|
||
|
||
|
||
6) Lancer FactoMineR sur ce jeu de données afin de faire l'ACP . On prendra soin d'afficher les résultats de l'ACP avec une décimale seulement, pour les 4 premières composantes principales, toutes les variables et tous les individus .
|
||
|
||
|
||
```{r}
|
||
res.jus <- PCA(jus, scale.unit=TRUE)
|
||
```
|
||
|
||
```{r}
|
||
summary(res.jus, nbelements = Inf, nbind = Inf, ncp = 4, nb.dec = 1)
|
||
```
|
||
|
||
|
||
7) Faîtes l'analyse statistique complète de l'ACP associée . On prendra soin de justifier le nombre d'axes factoriels à retenir, de faire l'analyse des individus, des variables et la synthèse.
|
||
|
||
# Eboulis valeurs propres
|
||
|
||
```{r}
|
||
eigen_values <- res.jus$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)
|
||
```
|
||
|
||
Par le critère de Kaiser, on garde les deux premières valeurs propres, donc on garde deux axes principaux
|
||
|
||
# Individus : Contribution moyenne, Axes, Qualité de représentation
|
||
|
||
```{r}
|
||
mean(res.jus$ind$contrib)
|
||
|
||
indiv_contrib_axe_1 <- sort(res.jus$ind$contrib[,1], decreasing = TRUE)
|
||
head(indiv_contrib_axe_1, 3)
|
||
indiv_contrib_axe_2 <- sort(res.jus$ind$contrib[,2], decreasing = TRUE)
|
||
head(indiv_contrib_axe_2, 3)
|
||
|
||
mal_representes <- rownames(res.acp$ind$cos2)[rowSums(res.jus$ind$cos2[,1:2]) <= mean(res.jus$ind$cos2[,1:2])]
|
||
mal_representes
|
||
```
|
||
|
||
# Variables : Contribution moyenne, Axes, Qualité de représentation
|
||
|
||
```{r}
|
||
mean(res.jus$var$contrib)
|
||
|
||
var_contrib_axe_1 <- sort(res.jus$var$contrib[,1], decreasing = TRUE)
|
||
head(var_contrib_axe_1, 3)
|
||
var_contrib_axe_2 <- sort(res.jus$var$contrib[,2], decreasing = TRUE)
|
||
head(var_contrib_axe_2, 3)
|
||
|
||
mal_representes <- rownames(res.jus$var$cos2[,1:2])[rowSums(res.jus$var$cos2[,1:2]) <= 0.7]
|
||
mal_representes
|
||
```
|
||
Le premier axe décrit l'amertume ou la douceur du jus d'orange.
|
||
|
||
----------------------------------------------------------------------------------------
|
||
|
||
Exercice 3
|
||
|
||
* Importation des données (compiler ce qui est ci-dessous sans le modifier)
|
||
|
||
```{r}
|
||
|
||
library(FactoMineR)
|
||
|
||
data("decathlon")
|
||
decathlon<-decathlon[1:13, 1:10]
|
||
|
||
res.decathlon <- PCA(decathlon, scale.unit = TRUE)
|
||
```
|
||
|
||
```{r}
|
||
summary(res.decathlon, nbelements = Inf, nbind = Inf, ncp = 4, nb.dec = 1)
|
||
```
|
||
|
||
* Effectuer l'analyse ACP de ce jeu de données
|
||
|
||
# Eboulis valeurs propres
|
||
|
||
```{r}
|
||
eigen_values <- res.decathlon$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)
|
||
```
|
||
|
||
Par le critère de Kaiser, on garde les quatre premières valeurs propres, donc on garde quatre axes principaux
|
||
|
||
# Individus : Contribution moyenne, Axes, Qualité de représentation
|
||
|
||
```{r}
|
||
mean(res.decathlon$ind$contrib)
|
||
|
||
indiv_contrib_axe_1 <- sort(res.decathlon$ind$contrib[,1], decreasing = TRUE)
|
||
head(indiv_contrib_axe_1, 3)
|
||
indiv_contrib_axe_2 <- sort(res.decathlon$ind$contrib[,2], decreasing = TRUE)
|
||
head(indiv_contrib_axe_2, 3)
|
||
indiv_contrib_axe_3 <- sort(res.decathlon$ind$contrib[,3], decreasing = TRUE)
|
||
head(indiv_contrib_axe_3, 3)
|
||
indiv_contrib_axe_4 <- sort(res.decathlon$ind$contrib[,4], decreasing = TRUE)
|
||
head(indiv_contrib_axe_4, 3)
|
||
|
||
mal_representes <- rownames(res.decathlon$ind$cos2)[rowSums(res.decathlon$ind$cos2[,1:4]) <= 0.8] # mean(res.decathlon$ind$cos2[,1:4]
|
||
mal_representes
|
||
```
|
||
|
||
# Variables : Contribution moyenne, Axes, Qualité de représentation
|
||
|
||
```{r}
|
||
mean(res.decathlon$var$contrib)
|
||
|
||
var_contrib_axe_1 <- sort(res.decathlon$var$contrib[,1], decreasing = TRUE)
|
||
head(var_contrib_axe_1, 3)
|
||
var_contrib_axe_2 <- sort(res.decathlon$var$contrib[,2], decreasing = TRUE)
|
||
head(var_contrib_axe_2, 3)
|
||
var_contrib_axe_3 <- sort(res.decathlon$var$contrib[,3], decreasing = TRUE)
|
||
head(var_contrib_axe_3, 3)
|
||
var_contrib_axe_4 <- sort(res.decathlon$var$contrib[,4], decreasing = TRUE)
|
||
head(var_contrib_axe_4, 3)
|
||
|
||
mal_representes <- rownames(res.decathlon$var$cos2[,1:4])[rowSums(res.decathlon$var$cos2[,1:4]) <= 0.8]
|
||
mal_representes
|
||
``` |