This commit is contained in:
2024-03-07 15:40:49 +01:00
parent f52cc569d9
commit 0d034784b7
6 changed files with 422 additions and 2 deletions

Binary file not shown.

View File

@@ -0,0 +1,155 @@
knitr::opts_chunk$set(echo = TRUE)
autos <- read.table("autos.csv", sep=";",header=TRUE)
rownames(autos)<-autos$Modele
autos$Modele<-NULL
autos<-autos[,c(1:6,8)]
library(FactoMineR)
help(PCA)
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX") )
summary(res.autos, nb.dec=2, nb.elements =Inf, nbind = Inf, ncp=3) #les résultats avec deux décimales, pour tous les individus, toutes les variables, sur les 3 premières CP
eigenvalues <- res.autos$eig # pour faire l'eboulis des valeurs propres
bplt <- barplot(eigenvalues[, 2], names.arg=1:nrow(eigenvalues),
main = "Eboulis des valeurs propres",
xlab = "Principal Components",
ylab = "Percentage of variances",
col ="steelblue",
)
lines(x = bplt, eigenvalues[, 2], type="b", pch=19, col = "red")
alim <- read.table('alimentation.csv', sep=';', header=TRUE)
rownames(alim)<-alim$ROW_LABEL
alim$ROW_LABEL<-NULL
corr <- cor(alim)
corr <- cor(alim)
corr
res.alim<-PCA(alim, scale.unit=TRUE, quanti.sup = c())
summary(res.alim, nb.dec = 2, nbelements = Inf, nbind = Inf, ncp = 3)
help(cor)
corr <- cor(alim)
corr
data(iris)
head(iris)
View(iris)
corr.iris <- cor(iris)
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), quali.sup = c("OUVR"))
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), quali.sup = c("OUVR", "PRIN"))
library(FactoMineR)
help(PCA)
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), ind = c("OUVR", "PRIN"))
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), ind.sup = c("OUVR", "PRIN"))
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), ind.sup = c(3, 7))
summary(res.alim2, nb.dec = 2, nbelements = Inf, nbind = Inf, ncp = 3)
res.iris <- PCA(iris, scale.unit = TRUE)
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
res.iris <- PCA(iris, scale.unit = TRUE, quanti.sup = c('Species'))
res.iris <- PCA(iris, scale.unit = TRUE, ind.sup = c('Species'))
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
summary(res.iris, nbelements = Inf, nbind = Inf, ncp = 3)
knitr::opts_chunk$set(echo = TRUE)
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), ind.sup = c(8))
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(echo = TRUE)
autos <- read.table("autos.csv", sep=";",header=TRUE)
rownames(autos)<-autos$Modele
autos$Modele<-NULL
autos<-autos[,c(1:6,8)]
library(FactoMineR)
help(PCA)
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX") )
summary(res.autos, nb.dec=2, nb.elements =Inf, nbind = Inf, ncp=3) #les résultats avec deux décimales, pour tous les individus, toutes les variables, sur les 3 premières CP
eigenvalues <- res.autos$eig # pour faire l'eboulis des valeurs propres
bplt <- barplot(eigenvalues[, 2], names.arg=1:nrow(eigenvalues),
main = "Eboulis des valeurs propres",
xlab = "Principal Components",
ylab = "Percentage of variances",
col ="steelblue",
)
lines(x = bplt, eigenvalues[, 2], type="b", pch=19, col = "red")
alim <- read.table('alimentation.csv', sep=';', header=TRUE)
rownames(alim)<-alim$ROW_LABEL
alim$ROW_LABEL<-NULL
help(cor)
corr <- cor(alim)
corr
res.alim<-PCA(alim, scale.unit=TRUE, quanti.sup = c())
summary(res.alim, nb.dec = 2, nbelements = Inf, nbind = Inf, ncp = 3)
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), ind.sup = c(8))
summary(res.alim2, nb.dec = 2, nbelements = Inf, nbind = Inf, ncp = 3)
data(iris)
head(iris)
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
summary(res.iris, nbelements = Inf, nbind = Inf, ncp = 3)
knitr::opts_chunk$set(echo = TRUE)
autos <- read.table("autos.csv", sep=";",header=TRUE)
rownames(autos)<-autos$Modele
autos$Modele<-NULL
autos<-autos[,c(1:6,8)]
library(FactoMineR)
help(PCA)
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX"))
plot.CPA(res.iris)
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = none)
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = None)
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = NONE)
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = NULL)
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX"))
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = NULL)
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX"))
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = "None")
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX"))
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = NA)
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX"))
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = "none")
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX"))
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
plot.PCA(res.iris, choix = "ind", habillage = 5)
plot.PCA(res.iris, choix = "ind", habillage = 5, label = "none")
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
plot.PCA(res.iris, choix = "ind", habillage = 5, label = "none")
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
plot.PCA(res.iris, choix = "ind", habillage = 5, label = "none")
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
plot.PCA(res.iris, choix = "ind", habillage = 5, label = "none")
dimdesc(res.iris)
knitr::opts_chunk$set(echo = TRUE)
autos <- read.table("autos.csv", sep=";",header=TRUE)
rownames(autos)<-autos$Modele
autos$Modele<-NULL
autos<-autos[,c(1:6,8)]
library(FactoMineR)
help(PCA)
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX"))
summary(res.autos, nb.dec=2, nb.elements =Inf, nbind = Inf, ncp=3) #les résultats avec deux décimales, pour tous les individus, toutes les variables, sur les 3 premières CP
eigenvalues <- res.autos$eig # pour faire l'eboulis des valeurs propres
bplt <- barplot(eigenvalues[, 2], names.arg=1:nrow(eigenvalues),
main = "Eboulis des valeurs propres",
xlab = "Principal Components",
ylab = "Percentage of variances",
col ="steelblue",
)
lines(x = bplt, eigenvalues[, 2], type="b", pch=19, col = "red")
alim <- read.table('alimentation.csv', sep=';', header=TRUE)
rownames(alim)<-alim$ROW_LABEL
alim$ROW_LABEL<-NULL
help(cor)
corr <- cor(alim)
corr
res.alim<-PCA(alim, scale.unit=TRUE, quanti.sup = c())
summary(res.alim, nb.dec = 2, nbelements = Inf, nbind = Inf, ncp = 3)
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), ind.sup = c(8))
summary(res.alim2, nb.dec = 2, nbelements = Inf, nbind = Inf, ncp = 3)
data(iris)
head(iris)
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
plot.PCA(res.iris, choix = "ind", habillage = 5, label = "none")
dimdesc(res.iris)
summary(res.iris, nbelements = Inf, nbind = Inf, ncp = 3)

View File

@@ -59,7 +59,7 @@ help(PCA)
```{r,echo=FALSE}
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX") )
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = c("PRIX"))
```
```{r}
summary(res.autos, nb.dec=2, nb.elements =Inf, nbind = Inf, ncp=3) #les résultats avec deux décimales, pour tous les individus, toutes les variables, sur les 3 premières CP
@@ -134,7 +134,7 @@ summary(res.alim, nb.dec = 2, nbelements = Inf, nbind = Inf, ncp = 3)
* Relancez l'ACP en prenant en compte cette modification
```{r}
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), ind.sup = c(3, 7))
res.alim2 <- PCA(alim, scale.unit=TRUE, quanti.sup = c(), ind.sup = c(8))
```
```{r}
@@ -151,6 +151,8 @@ head(iris)
```
```{r}
res.iris <- PCA(iris, scale.unit = TRUE, quali.sup = c('Species'))
plot.PCA(res.iris, choix = "ind", habillage = 5, label = "none")
dimdesc(res.iris)
```
```{r}
summary(res.iris, nbelements = Inf, nbind = Inf, ncp = 3)

View File

@@ -0,0 +1,243 @@
---
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 dorange 100% pur jus présentes dans les supermarchés français ont été évaluées par un panel dexperts selon sept variables sensorielles (intensité de lodeur, typicité de lodeur, 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
```

View File

@@ -0,0 +1,13 @@
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX

View File

@@ -0,0 +1,7 @@
;intensite-odeur;typicite-odeur;pulpe;intensite-gout;acidite;amertume;douceur
Pampryl amb.;2.82;2.53;1.66;3.46;3.15;2.97;2.6
Tropicana amb.;2.76;2.82;1.91;3.23;2.55;2.08;3.32
Fruvita amb.;2.83;2.88;4;3.45;2.42;1.76;3.38
Joker amb.;2.76;2.59;1.66;3.37;3.05;2.56;2.8
Tropicana fr.;3.2;3.02;3.69;3.12;2.33;1.97;3.34
Pampryl fr. ;3.07;2.73;3.34;3.54;3.31;2.63;2.9
1 intensite-odeur typicite-odeur pulpe intensite-gout acidite amertume douceur
2 Pampryl amb. 2.82 2.53 1.66 3.46 3.15 2.97 2.6
3 Tropicana amb. 2.76 2.82 1.91 3.23 2.55 2.08 3.32
4 Fruvita amb. 2.83 2.88 4 3.45 2.42 1.76 3.38
5 Joker amb. 2.76 2.59 1.66 3.37 3.05 2.56 2.8
6 Tropicana fr. 3.2 3.02 3.69 3.12 2.33 1.97 3.34
7 Pampryl fr. 3.07 2.73 3.34 3.54 3.31 2.63 2.9