Move all files

L3/Analyse Multidimensionnelle/TP5/TP5.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

L3/Analyse Multidimensionnelle/TP5/TP5_Enonce.Rmd

@@ -0,0 +1,249 @@
+---
+title: "TP5_Enonce"
+author: ''
+date: ''
+output:
+  pdf_document: default
+  html_document: default
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+```{r}
+rm(list=ls())
+library(FactoMineR)
+```
+
+----------------------------------------------------------------------------------------
+
+Exercice 1
+
+AFC sur le lien entre couleur des cheveux et ceux des yeux 
+
+```{r}
+data("HairEyeColor")
+```
+
+```{r}
+HairEyeColor
+```
+```{r}
+data <- apply(HairEyeColor, c(1, 2), sum)
+n <- sum(data)
+data
+```
+```{r}
+barplot(data,beside=TRUE,legend.text =rownames(data),main="Effectifs observés",col=c("black","brown","red","yellow"))
+```
+
+  1) Commentez le barplot ci-dessus ? S'attend on à une situation d'indépendance ?
+  
+On voit que la couleur des yeux a une incidence sur la couleur des cheveux car il n'y a pas la même proportion de blond pour les yeux bleus que pour les autres couleurs de yeux. On peut donc s'attendre à une situation de dépendance entre ces deux variables.
+  
+  2) Etudiez cette situation par un test du chi-deux d'indépendance
+  
+```{r}
+test <- chisq.test(data)
+test
+```
+  3) Affichez le tableau des effectifs théoriques et la contribution moyenne
+```{r}
+test$expected
+
+n_cases <- ncol(data) * nrow(data)
+contrib_moy <- 100/n_cases
+contrib_moy
+```
+  4) Calculer le tableau des contributions au khi-deux  
+  
+```{r}
+contribs <- (test$observed - test$expected)**2 / test$expected * 100/test$statistic
+contribs 
+```
+  5) Calculer le tableau des probabilités associé au tableau de contingence.
+  
+```{r}
+prob <- data/sum(data)
+prob
+```
+  6) Calculer le tableau des profils lignes et le profil moyen associé.
+  
+-> Le profil ligne est une probabilité conditionnelle.
+  
+```{r}
+marginale_ligne <- apply(prob, 1, sum)
+profil_ligne <- prob / marginale_ligne
+profil_ligne_moyen <- apply(prob, 2, sum)
+
+marginale_ligne
+profil_ligne
+profil_ligne_moyen
+```
+
+  7) Calculer le tableau des profils colonnes et le profil moyen associé.
+```{r}
+marginale_colonne <- apply(prob, 2, sum)
+profil_colonne <- t(t(prob) / marginale_colonne)
+profil_colonne_moyen <- apply(prob, 1, sum)
+
+marginale_colonne
+profil_colonne
+profil_colonne_moyen
+```
+ 
+  8) Que vaut l’inertie du nuage des profils lignes ? Celle du nuage des profils colonnes ?
+
+-> inertie : la variance des profils par rapport au profil moyen. l'inertie des lignes et la même que celle des colonnes. I = chi2/Nombre d'individus
+
+```{r}
+inertie <- test$statistic/sum(data)
+inertie
+```
+
+  9) Lancer une AFC avec FactoMineR
+  
+```{r}
+library(FactoMineR)
+res.afc<-CA(data)
+
+summary(res.afc)
+
+plot(res.afc, invisible = "row")
+plot(res.afc, invisible = "col")
+
+```
+```{r}
+
+```
+  
+  
+  10) Faire la construcution des éboulis des valeurs propres
+  
+```{r}
+eigen_values <- res.afc$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)
+```
+  11) Effectuer l'analyse des correspondances 
+  
+  ----------------------------------------------------------------------------------------
+
+Exercice 2
+
+AFC sur la répartition des tâches ménagères dans un foyer
+
+```{r}
+data<-read.table("housetasks.csv",sep=";",header = TRUE)
+data
+```
+
+```{r}
+
+barplot(as.matrix(data),beside=TRUE,legend.text=rownames(data),main="Effectifs observés",col=rainbow(length(rownames(data))))
+```
+
+  1) Commentez le barplot ci-dessus ? S'attend on à une situation d'indépendance ?
+  
+On voit que la place dans la famille a une incidence sur les taches de la famille car il n'y a pas la même proportion de Laundry chez la femme que pour les autres membres de la famille. On peut donc s'attendre à une situation de dépendance entre ces deux variables.
+  
+  
+  2) Etudiez cette situation par un test du chi-deux d'indépendance
+  
+```{r}
+data_house <- apply(data, c(1, 2), sum)
+test_house <- chisq.test(data_house)
+test_house
+```
+  3) Affichez le tableau des effectifs théoriques et la contribution moyenne
+```{r}
+test_house$expected
+
+n_cases <- ncol(data_house) * nrow(data_house)
+contrib_moy_house <- 100/n_cases
+contrib_moy_house
+```
+  4) Calculer le tableau des contributions au khi-deux  
+  
+```{r}
+contrib_house <- (test_house$observed - test_house$expected)**2 / test_house$expected * 100/test_house$statistic
+contrib_house
+```
+  5) Calculer le tableau des probabilités associé au tableau de contingence.
+  
+```{r}
+proba_house <- data_house / sum(data_house)
+proba_house
+```
+  6) Calculer le tableau des profils lignes et le profil moyen associé.
+  
+```{r}
+marginale_ligne <- apply(proba_house, 1, sum)
+profil_ligne <- proba_house / marginale_ligne
+profil_ligne_moyen <- apply(proba_house, 2, sum)
+
+marginale_ligne
+profil_ligne
+profil_ligne_moyen
+```
+  7) Calculer le tableau des profils colonnes et le profil moyen associé.
+```{r}
+marginale_colonne <- apply(proba_house, 2, sum)
+profil_colonne <- t(t(proba_house) / marginale_colonne)
+profil_colonne_moyen <- apply(proba_house, 1, sum)
+
+marginale_colonne
+profil_colonne
+profil_colonne_moyen
+```
+  8) Que vaut l’inertie du nuage des profils lignes ? Celle du nuage des profils colonnes ?
+
+
+```{r}
+inertie <- test_house$statistic / sum(data_house)
+inertie
+```
+
+  9) Lancer une AFC avec FactoMineR
+  
+```{r}
+res.afc<-CA(data)
+
+summary(res.afc,nbelements = Inf)
+
+plot(res.afc, invisible = "row")
+plot(res.afc, invisible = "col")
+
+```
+  
+  
+  10) Faire la construcution des éboulis des valeurs propres
+  
+```{r}
+eigen_values <- res.afc$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)
+```
+  
+  11) Effectuer l'analyse des correspondances 
+Axe 1 : taches pour les femmes a gauche et les maris a droite
+Axe 2 : taches individuelles en haut, taches collectives au milieu et en bas

L3/Analyse Multidimensionnelle/TP5/housetasks.csv

@@ -0,0 +1,14 @@
+"Wife";"Alternating";"Husband";"Jointly"
+"Laundry";156;14;2;4
+"Main_meal";124;20;5;4
+"Dinner";77;11;7;13
+"Breakfeast";82;36;15;7
+"Tidying";53;11;1;57
+"Dishes";32;24;4;53
+"Shopping";33;23;9;55
+"Official";12;46;23;15
+"Driving";10;51;75;3
+"Finances";13;13;21;66
+"Insurance";8;1;53;77
+"Repairs";0;3;160;2
+"Holidays";0;1;6;153