diff --git a/Analyse Multidimensionnelle/TP1/.RData b/Analyse Multidimensionnelle/TP1/.RData new file mode 100644 index 0000000..d9eca24 Binary files /dev/null and b/Analyse Multidimensionnelle/TP1/.RData differ diff --git a/Analyse Multidimensionnelle/TP1/.Rhistory b/Analyse Multidimensionnelle/TP1/.Rhistory new file mode 100644 index 0000000..aa2fb1e --- /dev/null +++ b/Analyse Multidimensionnelle/TP1/.Rhistory @@ -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) diff --git a/Analyse Multidimensionnelle/TP1/TP2_Enonce_2024.Rmd b/Analyse Multidimensionnelle/TP1/TP2_Enonce_2024.Rmd index 8bce920..a783069 100644 --- a/Analyse Multidimensionnelle/TP1/TP2_Enonce_2024.Rmd +++ b/Analyse Multidimensionnelle/TP1/TP2_Enonce_2024.Rmd @@ -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) diff --git a/Analyse Multidimensionnelle/TP3/TP3-Enonce.Rmd b/Analyse Multidimensionnelle/TP3/TP3-Enonce.Rmd new file mode 100644 index 0000000..a79ca60 --- /dev/null +++ b/Analyse Multidimensionnelle/TP3/TP3-Enonce.Rmd @@ -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 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 +``` \ No newline at end of file diff --git a/Analyse Multidimensionnelle/TP3/TP3.Rproj b/Analyse Multidimensionnelle/TP3/TP3.Rproj new file mode 100644 index 0000000..8e3c2eb --- /dev/null +++ b/Analyse Multidimensionnelle/TP3/TP3.Rproj @@ -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 diff --git a/Analyse Multidimensionnelle/TP3/jusdorange.csv b/Analyse Multidimensionnelle/TP3/jusdorange.csv new file mode 100644 index 0000000..a997e9a --- /dev/null +++ b/Analyse Multidimensionnelle/TP3/jusdorange.csv @@ -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 \ No newline at end of file