mirror of
https://github.com/ArthurDanjou/ArtStudies.git
synced 2026-01-14 15:54:13 +01:00
Move all files
This commit is contained in:
368
L3/Analyse Matricielle/TP1_Methode_de_Gauss.ipynb
Normal file
368
L3/Analyse Matricielle/TP1_Methode_de_Gauss.ipynb
Normal file
@@ -0,0 +1,368 @@
|
||||
{
|
||||
"cells": [
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"$$\\newcommand{\\nr}[1]{\\|#1\\|}\n",
|
||||
"\\newcommand{\\RR}{\\mathbb{R}}\n",
|
||||
"\\newcommand{\\N}{\\mathbb{N}}\n",
|
||||
"$$\n",
|
||||
"### MEU352 2023/2024 - Analyse numérique matricielle et optimisation\n",
|
||||
"\n",
|
||||
"# TP1 - Résolution de systèmes linéaires triangulaires. Méthode de Gauss.\n",
|
||||
"\n"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"## Exercice 0. Manipulation de vecteurs et de matrices.\n",
|
||||
"\n",
|
||||
"On aura besoin des modules de python ``numpy`` et ``matplotlib.pyplot``. On peut les charger en exécutant les commandes\n",
|
||||
"\n",
|
||||
"``import numpy as np``\n",
|
||||
"\n",
|
||||
"``import matplotlib.pyplot as plt``\n",
|
||||
"\n",
|
||||
"(on désignera alors le module ``numpy`` par ``np`` et ``matplotlib.pyplot`` par ``plt``. \n",
|
||||
"\n",
|
||||
"**Q1.** Executez les commandes suivantes et affichez le résultat. Essayez de comprendre ce que vous avez obtenu.\n",
|
||||
"\n",
|
||||
"``\n",
|
||||
"u = np.array([1,2,3,4,5])\n",
|
||||
"v = np.array([[1,2,3,4,5]])\n",
|
||||
"su=u.shape\n",
|
||||
"sv=v.shape\n",
|
||||
"ut = np.transpose(u)\n",
|
||||
"vt = np.transpose(v)\n",
|
||||
"vt2 = np.array([[1],[2],[3],[4],[5]])\n",
|
||||
"A = np.array([[1,2,0,0,0],[0,0,2,3,1],[0,0,0,2,2],[0,0,0,0,1],[1,1,1,0,0]])\n",
|
||||
"B = np.array([[1,2,3,4,5],[2,3,4,5,6],[3,4,5,6,7],[4,5,6,7,8],[5,6,7,8,9]])\n",
|
||||
"d=np.diag(A)\n",
|
||||
"dd=np.array([np.diag(A)])\n",
|
||||
"dt=np.transpose(d)\n",
|
||||
"ddt=np.transpose(dd)\n",
|
||||
"Ad=np.diag(np.diag(A))``\n",
|
||||
"\n",
|
||||
"**Q2.** Même question pour les commandes suivantes.\n",
|
||||
"\n",
|
||||
"``u*v, u*vt, vt*u, u/v, u/vt, v/v, v/vt, np.vdot(u,v), np.vdot(u,vt)``\n",
|
||||
"\n",
|
||||
"``A*B, np.dot(A,B)``\n",
|
||||
"\n",
|
||||
"``np.dot(A,u), np.dot(A,v), np.dot(v,A), np.dot(A,vt), np.linalg.inv(A), np.dot(np.linalg(inv(A)),A))``"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 31,
|
||||
"metadata": {
|
||||
"tags": []
|
||||
},
|
||||
"outputs": [
|
||||
{
|
||||
"name": "stdout",
|
||||
"output_type": "stream",
|
||||
"text": [
|
||||
"[[1. 0. 0. 0. 0.]\n",
|
||||
" [0. 1. 0. 0. 0.]\n",
|
||||
" [0. 0. 1. 0. 0.]\n",
|
||||
" [0. 0. 0. 1. 0.]\n",
|
||||
" [0. 0. 0. 0. 1.]]\n"
|
||||
]
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
"import numpy as np\n",
|
||||
"%matplotlib inline\n",
|
||||
"import matplotlib.pyplot as plt\n",
|
||||
"\n",
|
||||
"\n",
|
||||
"u = np.array([1,2,3,4,5])\n",
|
||||
"v = np.array([[1,2,3,4,5]])\n",
|
||||
"su=u.shape\n",
|
||||
"sv=v.shape\n",
|
||||
"ut = np.transpose(u)\n",
|
||||
"vt = np.transpose(v)\n",
|
||||
"vt2 = np.array([[1],[2],[3],[4],[5]])\n",
|
||||
"A = np.array([[1,2,0,0,0],[0,2,0,0,0],[0,0,3,0,0],[0,0,0,4,0],[0,0,0,0,5]])\n",
|
||||
"B = np.array([[1,2,3,4,5],[2,3,4,5,6],[3,4,5,6,7],[4,5,6,7,8],[5,6,7,8,9]])\n",
|
||||
"d=np.diag(A)\n",
|
||||
"dd=np.array([np.diag(A)])\n",
|
||||
"dt=np.transpose(d)\n",
|
||||
"ddt=np.transpose(dd)\n",
|
||||
"Ad=np.diag(np.diag(A))\n",
|
||||
"\n",
|
||||
"print(np.dot(np.linalg.inv(A), A))"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"## Exercice 1. Résolution d'un système linéaire triangulaire.\n",
|
||||
"\n",
|
||||
"Soit $A\\in\\mathcal{M}_n(\\RR)$ une matrice triangulaire inférieure inversible, de taille $n\\in\\N,$ et $b\\in\\RR^n$. Comme $A$ est triangulaire inférieure, on peut résoudre le système $Ax=b$ par une technique dite de *descente* : la solution $x=(x_1,\\dots,x_n)$ est obtenue en calculant successivement ses composantes $x_i$ par les formules\n",
|
||||
"$$\n",
|
||||
"\\begin{align}\n",
|
||||
"x_1&=\\frac{b_1}{A_{11}}\\\\\n",
|
||||
"x_2&=\\frac{b_2-A_{21}\\,x_1}{A_{22}}\\\\\n",
|
||||
"&\\vdots\\\\\n",
|
||||
"x_n&=\\frac{b_n-(A_{n1}\\,x_1+\\cdots +A_{n\\,n-1}\\,x_{n-1})}{A_{nn}}\\\\\n",
|
||||
"&\\\\\n",
|
||||
"&\\\\\n",
|
||||
"\\bigg(\\,\\,x_i&=\\frac{b_i-(A_{i1}\\,x_1+\\cdots +A_{i\\,i-1}\\,x_{i-1})}{A_{ii}}\\,\\, \\bigg)\n",
|
||||
"\\end{align}\n",
|
||||
"$$\n",
|
||||
"\n",
|
||||
"**Q1.** Définir une fonction ``descente`` qui prend en argument une matrice $A$ triangulaire inférieure inversible et un vecteur $b$ et qui retourne la solution $x$ du système $Ax=b$. Tester votre fonction sur une matrice $A$ à coefficients aléatoires et un second membre $b$ tel que la solution $x$ de $Ax=b$ soit connue.\n",
|
||||
"\n",
|
||||
"**Q2.** Écrire la solution $x$ du système $Ax=b$ lorsque $A$ est cette fois-ci triangulaire supérieure, en fonction des coefficients de $A$ et de $b$, en résolvant successivement les équations depuis la dernière jusqu'à la première (on dit qu'on résout le système $Ax=b$ par *remontée*).\n",
|
||||
"\n",
|
||||
"**Q3.** Modifier votre fonction ``descente`` en une fonction que vous appelerez ``remonte_descente`` qui permet la résolution du système $Ax=b$ lorsque $A$ est triangulaire inférieure ou triangulaire supérieure. Votre fonction devra tester si la matrice $A$ est triangulaire supérieure ou inférieure.\n",
|
||||
"\n",
|
||||
"*Commandes python : essayez les commandes ``np.tril(A), np.triu(A), np.tril(A,k), np.triu(A,k)``, avec $k=1$ ou $k=-1$, et ``np.random.rand(n,n)``, avec $n\\in\\N$. La somme $(A_{i1}\\,x_1+\\cdots +A_{i\\,i-1}\\,x_{i-1})$ peut être vue comme un produit scalaire entre deux vecteurs, utiliser ``np.vdot`` pour le produit scalaire*. "
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 54,
|
||||
"metadata": {
|
||||
"tags": []
|
||||
},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
"def remontee_descente(A, b):\n",
|
||||
" x = 0 * b\n",
|
||||
" n = len(b)\n",
|
||||
" if np.allclose(A, np.triu(A)):\n",
|
||||
" for i in range(n-1, -1, -1):\n",
|
||||
" x[i] = (b[i] - np.dot(A[i,i+1:], x[i+1:])) / A[i,i]\n",
|
||||
" elif np.allclose(A, np.tril(A)):\n",
|
||||
" for i in range(n):\n",
|
||||
" x[i] = (b[i] - np.dot(A[i,:i], x[:i])) / A[i,i]\n",
|
||||
" else:\n",
|
||||
" raise ValueError(\"A est ni triangulaire supérieure ni triangulaire inférieure\")\n",
|
||||
" return x"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 61,
|
||||
"metadata": {
|
||||
"tags": []
|
||||
},
|
||||
"outputs": [
|
||||
{
|
||||
"name": "stdout",
|
||||
"output_type": "stream",
|
||||
"text": [
|
||||
"1.1093356479670479e-31\n"
|
||||
]
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
"n = 5\n",
|
||||
"A = np.random.rand(n, n)\n",
|
||||
"A = np.tril(A) + np.eye(n) * np.linalg.norm(A)\n",
|
||||
"xe = np.array([1] * n)\n",
|
||||
"b = np.dot(A, xe)\n",
|
||||
"x = remontee_descente(A, b)\n",
|
||||
"\n",
|
||||
"print(np.dot(x - xe, x-xe))"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"## Exercice 2. La méthode de Gauss.\n",
|
||||
"\n",
|
||||
"\n",
|
||||
"On suppose que $A$ est une matrice carrée inversible et qu'il est\n",
|
||||
"possible d'appliquer la méthode de Gauss à la matrice $A$ et donc la transformer en une matrice triangulaire supérieure $U$\n",
|
||||
"à coefficients diagonaux non nuls simplement en effectuant\n",
|
||||
"successivement des opérations élémentaires sur les lignes du type\n",
|
||||
"$L_i$ devient $L_i + \\beta L_j$. On suppose donc que les pivots de\n",
|
||||
"la méthode de Gauss sont tous non nuls. \n",
|
||||
"\n",
|
||||
"**Q1.** Vérifier que l'algorithme suivant permet de transformer une matrice donnée $A$ en une matrice triangulaire supérieure $U$ par la méthode de Gauss :\n",
|
||||
"\n",
|
||||
"\n",
|
||||
"```\n",
|
||||
"U = A # on prend une copie qu'on écrasera\n",
|
||||
"pour j = 0 à n-1\n",
|
||||
" pour i = j + 1 à n - 1\n",
|
||||
" beta = U(i,j)/U(j,j) # U(j,j) est le pivot\n",
|
||||
" pour k = j à n -1\n",
|
||||
" U(i, k) = U(i,k) - beta * U(j,k) # ligne i devient ligne i - beta * ligne j\n",
|
||||
" fin k\n",
|
||||
" fin i\n",
|
||||
"fin j\n",
|
||||
"retourner U\n",
|
||||
"```\n",
|
||||
"\n",
|
||||
"**Q2.** Ecrire une fonction Python de la forme ```met_gauss(A)``` correspondant à cet algorithme.\n",
|
||||
"\n",
|
||||
"*Remarque : vous pouvez écrire les commandes $U(i, k) = U(i,k) - \\beta U(j,k)$, pour $k=j,\\dots,n-1$, sans utiliser de boucle sur $k$, en écrivant le vecteur $(U(i,j),\\dots,U(i,n-1))$ comme ``U[i,j:]``.*\n",
|
||||
"\n",
|
||||
"**Q3.** Appliquer cette fonction aux matrices\n",
|
||||
"$$\n",
|
||||
"A=\\left (\n",
|
||||
"\\begin{array}{ccc}\n",
|
||||
"9 & 8 & 6 \\\\\n",
|
||||
"7 & 6 & 12 \\\\\n",
|
||||
"9 & 3 & 9\n",
|
||||
"\\end{array}\n",
|
||||
"\\right )\n",
|
||||
"\\qquad \\mbox{ et } \\qquad \n",
|
||||
"B=\\left (\n",
|
||||
"\\begin{array}{cccc}\n",
|
||||
"11 & 8 & 3 & 13 \\\\\n",
|
||||
" 2 & 12 & 7 & 10 \\\\\n",
|
||||
" 3 & 3 & 17 & 13 \\\\\n",
|
||||
" 11 & 2 & 12 & 7\n",
|
||||
"\\end{array}\n",
|
||||
"\\right )\n",
|
||||
"$$\n",
|
||||
"\n",
|
||||
"Les réponses attendues sont respectivement\n",
|
||||
"\\begin{equation*}\n",
|
||||
"A=\\left (\n",
|
||||
"\\begin{array}{ccc}\n",
|
||||
"9 & 8 & 6 \\\\\n",
|
||||
"0 & -0.2222222 & 7.3333333 \\\\\n",
|
||||
"0 & 0 & -162\n",
|
||||
"\\end{array}\n",
|
||||
"\\right )\\qquad\n",
|
||||
" \\mbox{ et }\\qquad \n",
|
||||
"B=\\left (\n",
|
||||
"\\begin{array}{cccc}\n",
|
||||
"11 & 8 & 3 & 13 \\\\\n",
|
||||
" 0 & 10.5454545 & 6.45454545 & 7.63636364\\\\\n",
|
||||
" 0 & 0 & 15.6810345 & 8.86206897 \\\\\n",
|
||||
" 0 & 0 & 0 & -8.81693238\n",
|
||||
"\\end{array}\n",
|
||||
"\\right )\n",
|
||||
"\\end{equation*}\n",
|
||||
"\n",
|
||||
"**Q4.** Adapter votre fonction ```met_gauss(A)``` en une fonction ```met_gauss_sys(A,b)``` de façon à que l'on puisse l'utiliser pour résoudre un système $Ax=b$, avec $b\\in\\RR^n$ donné. Pour cela, il faut le long de la méthode de Gauss faire les mêmes opérations sur la matrice $A$ et sur le second membre $b$. Cette fonction retournera la solution $x$ du système $Ax=b$ en écrivant le système triangulaire équivalent obtenu par la méthode de Gauss, et en résolvant ce système triangulaire avec la fonction ```remonte_descente```. La tester avec une matrice $A$ et un vecteur $b$ aléatoires par exemple."
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 124,
|
||||
"metadata": {
|
||||
"tags": []
|
||||
},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
"def met_gauss(A):\n",
|
||||
" U = A\n",
|
||||
" n = len(A)\n",
|
||||
" for j in range(n):\n",
|
||||
" for i in range(j+1, n):\n",
|
||||
" beta = U[i,j]/U[j,j]\n",
|
||||
" U[i,j:] = U[i,j:] - beta * U[j, j:]\n",
|
||||
" return U"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 161,
|
||||
"metadata": {
|
||||
"tags": []
|
||||
},
|
||||
"outputs": [],
|
||||
"source": [
|
||||
"def met_gauss_sys(A, b):\n",
|
||||
" n, m = A.shape\n",
|
||||
" if n != m:\n",
|
||||
" raise ValueError(\"Erreur de dimension : A doit etre carré\")\n",
|
||||
" if n != b.size:\n",
|
||||
" raise valueError(\"Erreur de dimension : le nombre de lignes de A doit être égal au nombr ede colonnes de b\")\n",
|
||||
" U = np.zeros((n, n+1))\n",
|
||||
" U = A\n",
|
||||
" V = b\n",
|
||||
" for j in range(n):\n",
|
||||
" for i in range(j+1, n):\n",
|
||||
" beta = U[i,j]/U[j,j]\n",
|
||||
" U[i,j:] = U[i,j:] - beta * U[j, j:]\n",
|
||||
" V[i] = V[i] - beta * V[j]\n",
|
||||
" return remontee_descente(U, V)"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": 165,
|
||||
"metadata": {
|
||||
"tags": []
|
||||
},
|
||||
"outputs": [
|
||||
{
|
||||
"name": "stdout",
|
||||
"output_type": "stream",
|
||||
"text": [
|
||||
"1.3096323621833204e-32\n"
|
||||
]
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
"n = 5\n",
|
||||
"A = np.random.rand(n, n) + float(n) * np.eye(n)\n",
|
||||
"b = np.random.rand(n)\n",
|
||||
"x = met_gauss_sys(A, b)\n",
|
||||
"\n",
|
||||
"print(np.dot(b - A.dot(x), b - A.dot(x)))"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"## La méthode de Gauss avec stratégie de pivot partiel.\n",
|
||||
"\n",
|
||||
"En pratique, pour des questions de stabilité numérique, on a intérêt à choisir à l'étape $j$ un pivot $A_{k,j}$, avec $k\\geq j$ tel que $|A_{k,j}|$ est maximal (car cela signifie diviser par la quantité la plus grande possible). À l'étape $j$ de la méthode de Gauss, on commence alors par choisir $p$ tel que $|A_{p,j}|=\\max_{k\\geq j}|A_{k,j}|$ et on échange les lignes $p$ et $j$ de $A$.\n",
|
||||
"\n",
|
||||
"**Q5.** Créer une fonction ```met_gauss_pivot(A,b)``` qui permet la résolution du système $Ax=b$ en utilisant cette stratégie de choix de pivot. La tester avec le même exemple que dans la question précédente.\n",
|
||||
"\n",
|
||||
"**Q6. (Comparaison des deux méthodes).** Pour $n=10,20,30,\\dots,200$ :\n",
|
||||
"* construire une matrice $A\\in\\mathcal{M}_n(\\RR)$ aléatoire, un vecteur $x_{ex}\\in\\RR^n$ aléatoire et calculer $b=Ax_{ex}$ ;\n",
|
||||
"* Résoudre le système $Ax=b$ (dont la solution est $x=x_{ex}$) par la méthode de Gauss avec et sans choix de pivot ;\n",
|
||||
"* Calculer la norme $\\|x-x_{ex}\\|$ pour chacune des méthodes.\n",
|
||||
"\n",
|
||||
"Comparer les résultats obtenus pour les deux méthodes. Vous pouvez représenter $\\|x-x_{ex}\\|$, ou, ce qu'est mieux, $\\mathrm{log}(\\|x-x_{ex}\\|)$ en fonction de la taille $n$ de la matrice.\n"
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"execution_count": null,
|
||||
"metadata": {},
|
||||
"outputs": [],
|
||||
"source": []
|
||||
}
|
||||
],
|
||||
"metadata": {
|
||||
"kernelspec": {
|
||||
"display_name": "Python 3 (ipykernel)",
|
||||
"language": "python",
|
||||
"name": "python3"
|
||||
},
|
||||
"language_info": {
|
||||
"codemirror_mode": {
|
||||
"name": "ipython",
|
||||
"version": 3
|
||||
},
|
||||
"file_extension": ".py",
|
||||
"mimetype": "text/x-python",
|
||||
"name": "python",
|
||||
"nbconvert_exporter": "python",
|
||||
"pygments_lexer": "ipython3",
|
||||
"version": "3.10.8"
|
||||
}
|
||||
},
|
||||
"nbformat": 4,
|
||||
"nbformat_minor": 4
|
||||
}
|
||||
2
L3/Analyse Multidimensionnelle/.gitignore
vendored
Normal file
2
L3/Analyse Multidimensionnelle/.gitignore
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
.Rhistory
|
||||
.RData
|
||||
8
L3/Analyse Multidimensionnelle/ADN/ADN.iml
Normal file
8
L3/Analyse Multidimensionnelle/ADN/ADN.iml
Normal file
@@ -0,0 +1,8 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<module type="R_MODULE" version="4">
|
||||
<component name="NewModuleRootManager" inherit-compiler-output="true">
|
||||
<exclude-output />
|
||||
<content url="file://$MODULE_DIR$" />
|
||||
<orderEntry type="sourceFolder" forTests="false" />
|
||||
</component>
|
||||
</module>
|
||||
6
L3/Analyse Multidimensionnelle/ADN/main.rmd
Normal file
6
L3/Analyse Multidimensionnelle/ADN/main.rmd
Normal file
@@ -0,0 +1,6 @@
|
||||
```{r}
|
||||
library(FactoMineR)
|
||||
data(iris)
|
||||
res.test <- PCA(iris[,1:4], scale.unit=TRUE, ncp=4)
|
||||
res.test
|
||||
```
|
||||
13
L3/Analyse Multidimensionnelle/DM ACP/DM ACP.Rproj
Normal file
13
L3/Analyse Multidimensionnelle/DM ACP/DM ACP.Rproj
Normal 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
|
||||
383
L3/Analyse Multidimensionnelle/DM ACP/DM_ACP.Rmd
Normal file
383
L3/Analyse Multidimensionnelle/DM ACP/DM_ACP.Rmd
Normal file
@@ -0,0 +1,383 @@
|
||||
---
|
||||
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.
|
||||
43
L3/Analyse Multidimensionnelle/DM ACP/notes_MAN.csv
Normal file
43
L3/Analyse Multidimensionnelle/DM ACP/notes_MAN.csv
Normal file
@@ -0,0 +1,43 @@
|
||||
Prénom;Mention;Analyse;Algèbre;Probas;EDO;Ana. Hilbertienne;Analyse Matricielle;Calcul Dif;Stats Inférentielles;MAN-Stats;MAN-Méthodes numériques;Anglais;MAN-PPEI-Projet;Option S5;Option S6
|
||||
Juste;Aj;3,8;5,0185;2,4;3,26;0;6,425;5,3125;3,44;11,175;0;11;12,475;14;15
|
||||
Julien;TB;18,5;15,90625;19,58;15,68;19,65;17,2;17,125;16,39;11,98;17,08;15,5;15,375;14;14,5
|
||||
Olivier;Aj;8,35;7,842;10,62;7,95;4,55;6,4;5,09375;7,59;10,48;5,62;13,5;10,65;11;0
|
||||
Marie;Aj;4;3,674;6,44;6,06;6,975;5,35;8,21875;12,95;10,335;8,08;16;11,15;16;17
|
||||
Henri;B;13,5;13,00466667;14,45;13,76;15,175;16,1;14,5625;15,53;17,435;16,31;13,5;14,1;17;14
|
||||
Nicolas;B;11,55;14,442;12,9;14,62;14,2;15,475;10,0625;15,18;14,685;13,42;18,5;16,85;12;20
|
||||
Antoine;Aj;7,8;6,1575;9,7;8,48;6,8;0;9,78125;6,57;0;10,58;13,5;13,1;16;10
|
||||
Georges;AB;15,5;10,56166667;15,2;13,85;14,725;13,95;10,40625;13,54;11,285;11,388;16;15,425;16;14
|
||||
Armand;Aj;6,65;8,457;9,72;10,34;2,45;5,25;10,875;6,93;0;0;17;0;10;0
|
||||
Jolie;Aj;6,6;4,6745;7,8;8,31;0;0;0;4;0;0;16;11,775;14;15
|
||||
Marguerite;Aj;6,75;5,797666667;8,74;7,97;1,4;3,65;4,625;8,06;8,96;1,19;11,5;0;14;0
|
||||
Suzanne;Aj;10;0;5,64;0;4,15;4,275;5,875;3,58;4,04;3,81;2,5;0;16;13
|
||||
Paule;Aj;13,1;0;9,23;0;9,925;9,875;12,9375;10,14;10,615;9,05;16;16;12,25;17,5
|
||||
Lucien;AB;12,25;9,808333333;17,28;8,988888889;11,65;14,2;13,125;15,49;15,34;13,2;10,5;12,025;14;15
|
||||
Thérèse;Aj;11,15;6,573333333;10,1;10,13;0;10,925;11,84375;10,7;11,55;9,03;16,5;15,575;17,5;17
|
||||
Jérôme;Aj;8,75;8,955;9,52;12,1;7,075;7,275;8,03125;12,01;11,67;8,99;14,65;13,875;15,43;15,43
|
||||
Françoise;Aj;12,45;7,348;5,16;9,89;9;4,375;12,75;10,6;0;10,06976744;12,5;9,5;14,5;16,5
|
||||
Hélène;Aj;10,9;10,63233333;13,22;13,56;10,675;15,5;15,625;13,87;13,37;16,64;18;13,9;11;13,5
|
||||
Marc;Aj;7,5;6,6375;6,51;9,27;0;0;0;0;0;0;15;0;17,5;0
|
||||
Lucie;Aj;6,45;3,041;5,56;6,77;2,6;1,525;3,75;5,68;4,96;2,38;13;0;14;16
|
||||
René;AB;13,55;10,611;14,36;10,84;16,85;12,55;13,28125;14,07;13,245;12,62;15;13,6;17;16
|
||||
Sylvie;P;10,8;10,9;14,38;10,07;9,275;9,475;13,90625;14,91;10,865;11,41860465;11;9,05;15;13
|
||||
Urbain;Aj;14,5;15;0;11,6;19,7;18,05;18,875;12,11;10,255;12,6;14;11;0;0
|
||||
Loup;Aj;11,35;6,758;6,06;8,96;6,075;8,9;8,4;11,53;15,395;7,98;12,5;13,675;13;13
|
||||
Juliette;Aj;8,5;0;4,92;7,9;0;4,025;11,5;0,96;0;5,68;12;14,5;10;12
|
||||
Adélaïde;Aj;0;0;0;0;1,725;2,9;6,21875;6,44;7,175;7,49;10,8;10,05;13;0
|
||||
Inès;B;17,5;16,375;16,8;14,52;19,25;15,575;16;15,71;12,555;17,1;16,5;12,975;12;12
|
||||
Guillaume;Aj;12,5;5,8125;14,26;12,05;0;2,425;0;4,59;0;0;12;11,025;0;0
|
||||
Geneviève;Aj;0;0;0;0;0;0;0;0;0;0;3;0;10;0
|
||||
Aimée;Aj;5,25;2,7775;3,5;4,64;0;0;0;0;0;0;13,5;0;14;0
|
||||
Josette;AB;15,5;9,402;13,78;13,5;8,125;11,7;15,575;12,47;12,01;10,64;16;14,65;17,33;0
|
||||
Édouard;AB;11,25;12,823;11,68;13,23;15,45;13,15;13,5;12,66;16,03;15,62;11,5;12,75;11;14
|
||||
Christophe;Aj;16,1;9,1875;10,9;12,74;14,825;13,75;17,1375;12,4;8,18;8,12;4,5;0;19,5;12
|
||||
Céleste;TB;17,2;17,78125;13,24;16,56;17,6;18,275;17;16,61;15,375;18,36;14,5;15,825;18,5;19
|
||||
Véronique;TB;18,75;17,22333333;17,9;14,3;20;19,225;19;13,84;9,455;16,3;12;16,25;12,7;15
|
||||
Aurore;Aj;7,75;6,75;10,78;10,04444444;7,4;9,2;8,6;11,36;11,37;11,38;16;11,375;13;13
|
||||
Étienne;AB;9,45;11,06366667;15,32;12,27;7,225;12,275;11,54375;14,8;11,21;9,33;12,5;14,175;17;18,5
|
||||
Serge;B;13;14,28033333;16,8;11,17777778;16,425;14,025;16,5625;16,24;12,57;10,69;14,5;13,975;5;12
|
||||
Hervé;Aj;13,75;8,304;7,83;10;0;0;0;12,24;11,59;0;18,5;12,5;18;10
|
||||
Gaston;B;12,85;10,63833333;16,4;14,2;15,525;13,975;15,2875;14,01;13,57;13,18;14,5;14,175;16;18
|
||||
Arnaud;P;10,75;6,910666667;10,33;10,34;9,2;8,8;9,8375;11,8;13,855;10,33;15,5;14,525;13,5;13
|
||||
Gilles;Aj;10,58;0;0;0;18,325;14,65;14,875;15,3;9,47;17,3;9,5;13;12;15
|
||||
|
13
L3/Analyse Multidimensionnelle/TP1/TP1.Rproj
Normal file
13
L3/Analyse Multidimensionnelle/TP1/TP1.Rproj
Normal 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
|
||||
160
L3/Analyse Multidimensionnelle/TP1/TP2_Enonce_2024.Rmd
Normal file
160
L3/Analyse Multidimensionnelle/TP1/TP2_Enonce_2024.Rmd
Normal file
@@ -0,0 +1,160 @@
|
||||
---
|
||||
title: "TP2 : ACP "
|
||||
output:
|
||||
pdf_document: default
|
||||
html_document: default
|
||||
output: rmarkdown::html_vignette
|
||||
---
|
||||
|
||||
```{r setup, include=FALSE}
|
||||
knitr::opts_chunk$set(echo = TRUE)
|
||||
```
|
||||
|
||||
### Objectifs du TP
|
||||
|
||||
|
||||
* Rappel méthodologique
|
||||
* ACP avec le package FactoMineR sur les données "voitures anciennes"
|
||||
* ACP avec le package FactoMineR sur les données "Habitudes alimentaires de certaines CSP"
|
||||
* ACP sur le jeu de données "iris" : quantifier les variations de morphologie des fleurs d'iris de trois espèces
|
||||
|
||||
|
||||
# Modèle type de rédaction
|
||||
|
||||
* Exploration de la structure du jeu de données
|
||||
|
||||
* Inertie expliquée et choix du nombre d'axes à retenir
|
||||
|
||||
* Analyse des contributions et interprétation des individus axes par axes sur le modèle du cours $I^{+}$ et $I^{-}$
|
||||
|
||||
* Analyse des corrélations et interprétation des variables par axe
|
||||
|
||||
* Interprétation et synthèse
|
||||
|
||||
|
||||
|
||||
# ACP sur le jeu de données "voitures anciennes"
|
||||
|
||||
* Importation du jeu de données "autos.csv" (il comporte 18 voitures et 6 variables actives : Cylindrée, Puissance, Longueur, Largeur, Poids, Vitesse maximum)
|
||||
|
||||
|
||||
```{r}
|
||||
autos <- read.table("autos.csv", sep=";",header=TRUE)
|
||||
```
|
||||
```{r}
|
||||
rownames(autos)<-autos$Modele
|
||||
autos$Modele<-NULL
|
||||
```
|
||||
|
||||
```{r}
|
||||
autos<-autos[,c(1:6,8)]
|
||||
```
|
||||
|
||||
|
||||
* Lancer FactoMineR sur le jeu de données autos en mettant la variable PRIX en supplémentaire, comparez avec les résultats obtenus "à la main" ci-dessus.
|
||||
|
||||
```{r,echo=FALSE}
|
||||
library(FactoMineR)
|
||||
help(PCA)
|
||||
```
|
||||
|
||||
|
||||
```{r,echo=FALSE}
|
||||
res.autos<-PCA(autos, scale.unit=TRUE, quanti.sup = "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
|
||||
```
|
||||
|
||||
|
||||
|
||||
```{r}
|
||||
eigenvalues <- res.autos$eig # pour faire l'eboulis des valeurs propres
|
||||
|
||||
```
|
||||
```{r}
|
||||
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")
|
||||
```
|
||||
Axe 1
|
||||
|
||||
https://www.google.com/search?q=renault+30&sxsrf=AJOqlzXa7fdk2FHIzJnBMybS2VVl848JTw:1675932953411&source=lnms&tbm=isch&sa=X&ved=2ahUKEwjMx-viiIj9AhX0VKQEHayxCH8Q_AUoAXoECAIQAw&biw=1920&bih=973&dpr=1#imgrc=Do9PtlcmoQ22EM
|
||||
https://www.google.com/search?q=toyota+corolla&sxsrf=AJOqlzUZUO_FZkxQBSnrw_fECwllyzSicA:1675932937647&source=lnms&tbm=isch&sa=X&ved=2ahUKEwi_tanbiIj9AhWkaqQEHeKnB64Q_AUoAXoECAEQAw&biw=1920&bih=973&dpr=1#imgrc=Ia1iG0X2ojWldM
|
||||
|
||||
Axe 2
|
||||
|
||||
https://www.google.com/search?q=Alfetta+1.66&tbm=isch&ved=2ahUKEwi3-KXeiYj9AhWjmicCHZPPAJ8Q2-cCegQIABAA&oq=Alfetta+1.66&gs_lcp=CgNpbWcQA1DhAVjlCWCEDGgBcAB4AIABMYgBYJIBATKYAQCgAQGqAQtnd3Mtd2l6LWltZ8ABAQ&sclient=img&ei=HLbkY7f6EqO1nsEPk5-D-Ak&bih=973&biw=1920
|
||||
|
||||
https://www.google.com/search?q=Audi+100&tbm=isch&ved=2ahUKEwiYsc7fiYj9AhVgnCcCHVTHBzQQ2-cCegQIABAA&oq=Audi+100&gs_lcp=CgNpbWcQAzIICAAQgAQQsQMyBQgAEIAEMgUIABCABDIFCAAQgAQyBQgAEIAEMgUIABCABDIFCAAQgAQyBQgAEIAEMgUIABCABDIFCAAQgAQ6BAgjECc6BggAEAUQHjoECAAQHjoGCAAQCBAeOgcIABCABBAYOgQIABBDOgcIABCxAxBDUJMHWPwhYMwjaABwAHgAgAGBAYgB6AeSAQQxOC4xmAEAoAEBqgELZ3dzLXdpei1pbWfAAQE&sclient=img&ei=H7bkY9ilBOC4nsEP1I6foAM&bih=973&biw=1920#imgrc=HcD1MCnYOiL6CM
|
||||
|
||||
|
||||
# ACP normée sur les données "Habitudes alimentaires de certaines CSP"
|
||||
|
||||
|
||||
|
||||
Individus : AGRI : exploitants agricoles // SAAG : salariés agricoles // PRIN : professions indépendantes // CSUP : cadres supérieurs // CMOY : cadres moyens // EMPL : employés // OUVR : ouvriers // INAC : inactifs
|
||||
|
||||
Variables : Pains ordinaires (PAO), Autres pains (plus sophistiqués) (PAA), Vins ordinaires (VIO), Autres vins (plus sophistiqués) (VIA), Pommes de terre (POT), Légumes secs (lentilles, flageolets etc) (LEC), Raisins (fruits) (RAI), Plats préparés (coûteux à l'époque de l'enquête) (PLP)
|
||||
|
||||
* Charger les données "alimentation.csv" vous les mettrez dans un jeu de données appelé alim.
|
||||
|
||||
```{r, include=FALSE}
|
||||
alim <- read.table('alimentation.csv', sep=';', header=TRUE)
|
||||
```
|
||||
|
||||
* Formater les pour l'ACP
|
||||
```{r}
|
||||
rownames(alim)<-alim$ROW_LABEL
|
||||
alim$ROW_LABEL<-NULL
|
||||
```
|
||||
|
||||
* Calculer la matrice des corrélations
|
||||
```{r}
|
||||
help(cor)
|
||||
corr <- cor(alim)
|
||||
corr
|
||||
```
|
||||
|
||||
* Lancer FactoMineR sur ce jeu de données. Effectuer l'analyse statistique des résultats.
|
||||
* Que remarquez vous chez les individus ?
|
||||
|
||||
|
||||
```{r}
|
||||
res.alim<-PCA(alim, scale.unit=TRUE, quanti.sup = c())
|
||||
```
|
||||
```{r}
|
||||
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(8))
|
||||
```
|
||||
|
||||
```{r}
|
||||
summary(res.alim2, nb.dec = 2, nbelements = Inf, nbind = Inf, ncp = 3)
|
||||
```
|
||||
|
||||
# ACP sur le jeu de données "iris" : quantifier les variations de morphologie des fleurs d'iris de trois espèces
|
||||
|
||||
https://fr.wikipedia.org/wiki/Iris_de_Fisher
|
||||
|
||||
```{r}
|
||||
data(iris)
|
||||
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)
|
||||
```
|
||||
9
L3/Analyse Multidimensionnelle/TP1/alimentation.csv
Normal file
9
L3/Analyse Multidimensionnelle/TP1/alimentation.csv
Normal file
@@ -0,0 +1,9 @@
|
||||
ROW_LABEL;PAO;PAA;VIO;VIA;POT;LEC;RAI;PLP
|
||||
AGRI;167;1;163;23;41;8;6;6
|
||||
SAAG;162;2;141;12;40;12;4;15
|
||||
PRIN;119;6;69;56;39;5;13;41
|
||||
CSUP;87;11;63;111;27;3;18;39
|
||||
CMOY;103;5;68;77;32;4;11;30
|
||||
EMPL;111;4;72;66;34;6;10;28
|
||||
OUVR;130;3;76;52;43;7;7;16
|
||||
INAC;138;7;117;74;53;8;12;20
|
||||
|
1
L3/Analyse Multidimensionnelle/TP1/autos.csv
Normal file
1
L3/Analyse Multidimensionnelle/TP1/autos.csv
Normal file
@@ -0,0 +1 @@
|
||||
Modele;CYL;PUISS;LONG;LARG;POIDS;V-MAX;FINITION;PRIX;R-POID.PUIS
|
||||
|
243
L3/Analyse Multidimensionnelle/TP3/TP3-Enonce.Rmd
Normal file
243
L3/Analyse Multidimensionnelle/TP3/TP3-Enonce.Rmd
Normal 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 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
|
||||
```
|
||||
13
L3/Analyse Multidimensionnelle/TP3/TP3.Rproj
Normal file
13
L3/Analyse Multidimensionnelle/TP3/TP3.Rproj
Normal 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
|
||||
7
L3/Analyse Multidimensionnelle/TP3/jusdorange.csv
Normal file
7
L3/Analyse Multidimensionnelle/TP3/jusdorange.csv
Normal 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
|
||||
|
13
L3/Analyse Multidimensionnelle/TP4/TP4.Rproj
Normal file
13
L3/Analyse Multidimensionnelle/TP4/TP4.Rproj
Normal 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
|
||||
9
L3/Analyse Multidimensionnelle/TP4/depsau.csv
Normal file
9
L3/Analyse Multidimensionnelle/TP4/depsau.csv
Normal file
@@ -0,0 +1,9 @@
|
||||
;INF05;S0510;S1020;S2035;S3550;SUP50
|
||||
ARIE;870;330;730;680;470;890
|
||||
AVER;820;1260;2460;3330;2170;2960
|
||||
H.G.;2290;1070;1420;1830;1260;2330
|
||||
GERS;1650;890;1350;2540;2090;3230
|
||||
LOT;1940;1130;1750;1660;770;1140
|
||||
H.P.;2110;1170;1640;1500;550;430
|
||||
TARN;1770;820;1260;2010;1680;2090
|
||||
T.G;1740;920;1560;2210;990;1240
|
||||
|
13
L3/Analyse Multidimensionnelle/TP5/TP5.Rproj
Normal file
13
L3/Analyse Multidimensionnelle/TP5/TP5.Rproj
Normal 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
|
||||
249
L3/Analyse Multidimensionnelle/TP5/TP5_Enonce.Rmd
Normal file
249
L3/Analyse Multidimensionnelle/TP5/TP5_Enonce.Rmd
Normal file
@@ -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
|
||||
14
L3/Analyse Multidimensionnelle/TP5/housetasks.csv
Normal file
14
L3/Analyse Multidimensionnelle/TP5/housetasks.csv
Normal file
@@ -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
|
||||
|
556
L3/Calculs Numériques/DM1.ipynb
Normal file
556
L3/Calculs Numériques/DM1.ipynb
Normal file
File diff suppressed because one or more lines are too long
578
L3/Calculs Numériques/DM2.ipynb
Normal file
578
L3/Calculs Numériques/DM2.ipynb
Normal file
File diff suppressed because one or more lines are too long
783
L3/Calculs Numériques/DM3.ipynb
Normal file
783
L3/Calculs Numériques/DM3.ipynb
Normal file
File diff suppressed because one or more lines are too long
691
L3/Calculs Numériques/Interpolation.ipynb
Normal file
691
L3/Calculs Numériques/Interpolation.ipynb
Normal file
File diff suppressed because one or more lines are too long
479
L3/Calculs Numériques/Interpolation_2.ipynb
Normal file
479
L3/Calculs Numériques/Interpolation_2.ipynb
Normal file
File diff suppressed because one or more lines are too long
561
L3/Calculs Numériques/Intégration.ipynb
Normal file
561
L3/Calculs Numériques/Intégration.ipynb
Normal file
File diff suppressed because one or more lines are too long
1000
L3/Calculs Numériques/Methode_de_Newton.ipynb
Normal file
1000
L3/Calculs Numériques/Methode_de_Newton.ipynb
Normal file
File diff suppressed because one or more lines are too long
347
L3/Calculs Numériques/Point_Fixe.ipynb
Normal file
347
L3/Calculs Numériques/Point_Fixe.ipynb
Normal file
File diff suppressed because one or more lines are too long
BIN
L3/Calculs Numériques/image0.png
Normal file
BIN
L3/Calculs Numériques/image0.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 199 KiB |
BIN
L3/Calculs Numériques/image1.png
Normal file
BIN
L3/Calculs Numériques/image1.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 114 KiB |
BIN
L3/Calculs Numériques/sprime.png
Normal file
BIN
L3/Calculs Numériques/sprime.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 14 KiB |
584
L3/Equations Différentielles/TP1_EDO_EulerExp.ipynb
Normal file
584
L3/Equations Différentielles/TP1_EDO_EulerExp.ipynb
Normal file
File diff suppressed because one or more lines are too long
813
L3/Equations Différentielles/TP2_Lokta_Volterra.ipynb
Normal file
813
L3/Equations Différentielles/TP2_Lokta_Volterra.ipynb
Normal file
File diff suppressed because one or more lines are too long
1041
L3/Equations Différentielles/TP3_Convergence.ipynb
Normal file
1041
L3/Equations Différentielles/TP3_Convergence.ipynb
Normal file
File diff suppressed because one or more lines are too long
987
L3/Méthodes Numériques/TP1_Equation_de_Poisson.ipynb
Normal file
987
L3/Méthodes Numériques/TP1_Equation_de_Poisson.ipynb
Normal file
File diff suppressed because one or more lines are too long
214
L3/Probabilités/CC2.ipynb
Normal file
214
L3/Probabilités/CC2.ipynb
Normal file
File diff suppressed because one or more lines are too long
721
L3/Probabilités/TP1.ipynb
Normal file
721
L3/Probabilités/TP1.ipynb
Normal file
File diff suppressed because one or more lines are too long
360
L3/Probabilités/TP2.ipynb
Normal file
360
L3/Probabilités/TP2.ipynb
Normal file
File diff suppressed because one or more lines are too long
305
L3/Statistiques/TP1.ipynb
Normal file
305
L3/Statistiques/TP1.ipynb
Normal file
File diff suppressed because one or more lines are too long
335
L3/Statistiques/TP2.ipynb
Normal file
335
L3/Statistiques/TP2.ipynb
Normal file
File diff suppressed because one or more lines are too long
Reference in New Issue
Block a user