From f52cc569d90ac7406eba65cfce8d7484b458e686 Mon Sep 17 00:00:00 2001 From: Arthur DANJOU Date: Thu, 7 Mar 2024 14:36:05 +0100 Subject: [PATCH] Add DM --- Analyse Multidimensionnelle/DM ACP/.RData | Bin 0 -> 19783 bytes Analyse Multidimensionnelle/DM ACP/.Rhistory | 512 ++++++++++++++++++ Analyse Multidimensionnelle/DM ACP/DM_ACP.Rmd | 325 +++++++++-- 3 files changed, 806 insertions(+), 31 deletions(-) create mode 100644 Analyse Multidimensionnelle/DM ACP/.RData diff --git a/Analyse Multidimensionnelle/DM ACP/.RData b/Analyse Multidimensionnelle/DM ACP/.RData new file mode 100644 index 0000000000000000000000000000000000000000..3ced7c0cc3ffb42acde204d2630292511153ee1f GIT binary patch literal 19783 zcmV)5K*_%!iwFP!000001MR&BR20v$IK1Q_Ihx5igQy@P{4#r22qkrP>djA zL{v~gF@uVN5kx>_$clnQ$sjp{WQpO0oU^C5duqC?tE;NJs(Yq3 z>26hF-pWiM5NHUrG}Htdy2-x;I#ZL?a?1$>TI$IR6@iw(G*xKj>geK5AW*YSX4s&~ zZu)}nq!eMyp1u%HmFWxNBTQe&{ORHxMBv)gbsZ7L?u$<6uOZ?S(-$H&U5zawGY$U{ zk)H-rLKO9<3uYlhW8>g7nXpd&ri$67ZxIOJXMwTEZ?bf@adDD&v$eG$!BZ0n1j(?; z|08DR_jd1F?|Zd=Sc21U7a`4${!W3VwVzFv=kkYN%vi@g!W8w%zAScpk&b(Cb`S^AYXmGwVdBB zNpW-M7LKM5X~wQ2tKEZCih7iuCTyt*-(7k1&}Ty?TLaD&^^P9Qu_qlnG*^|mteL;- z{tmO}JIbpim0MnZk=wEINi(xa4;xJiUyI_(P7+M>n$(Rs*2Ov*U-C|5&q>tlEC3ahhe&R>fx_dUCu zH(xDNzU1z*GW)Yz+S|3*wm*5uxNsvsufXo1D;{I!;VfQD8|y~eH@_7?_AQgh{9J7o zI%lriYwANTo{ICf=d?s{=6~26kQ$qRKYpq2E9FkEQ2qnqV=Qs@`U=Bu$9uV#bSDm7 zCstQCIy1)|6E*CmH`u-N;+eMu6$LMseCFmxZ$qn=UHsPX9x?6wZgw=yYR{Y#hAb}? zTMdU!6wul8dMD-+9tB$Qr=CAt=lYIn6W!A*dpQ_wJ!t1-H6^#+xq`-7XUw(B313S^ zI5!cryX~U(lfW(g@o%WUWpL4To|jvFA}MkCGi|Zmhvde{opGlCk>-o4bLA}3kuq~pH*{9 zn)*&n&zEus?iXsB&3Uyg{(eda;~Xi^SnYVf9@gL+B4O73#Qhcz(iJSdPe~im?xYEM zY?A9jIQZ92$*@1PY zFHT1dSATuBYVHc#PpdXAJZ@b^)OfSDbFTbi3D@lg1|osP2(2?lkrLpQ6~D@~^zMf6 zlV>HfEE|_TkfhU2ikiR9IWcL3vvPK~BeE>M2{t>jlTj!jvyMa(2_la4=?b<@AKr(8{S~7x2!jc~v4QY+Ug~^2E7)EajP-Gz_oo z?xi}~(S39Rbi=%NY}HDUR~PqQ-mNRXI+4Lun8##Ee`@(ob&J!1N{7|@I`Y_<6@`;c zc_Ma7Dfttvs1jxA{go9@K11TlKg0wH=ICv=i%sC}{P#Tj-nku`5@ zj`SsleztXC0*}o<${xfoBSd#dfSV*nQYk` z)Ka&TYvk!tL!-eXMzZOf^4-M$?do4>&~s+`UsUf=)_)O%%~r>)N0eF&3UxXns*Y-SuyPTpM7OwFZlV&6z5RXpQu!y>qjh=n zZr<3J$jUVT^4h&ik3Uo$PImM%*SONK`eLhkny^>4Jfr2ahb*o41#Yl04{_~J^YvC$ z2Od~1C26^3NZrl;VP3s}w&QgV-6fjsvVoD-suoL8OZ^W=Eo(N9y}su)VIGl2tMAV$ zB$JrS+V*JdO0}lhMq^o9;>sf%wSwNgRMvj(xCQwnasS$AYIDL)uc0ev&3fe`oOT#< ziW&&hoTl=ijZ)56&Xz+@UD=Y8e@q13TozunL`bE7RsHRS7t|FJ7@2~L#eH`g6bgPx zR?SJx4J=vcVzJL^e%9+dPe!e7cxB)EqPYFhJtxDm`tW%-KeWj=JUXrMRb%CoM;V%1 zG&^xYV5YV77fD4cFD+qu{C(Bp!qWHI3@Z|Eu6c1+B7SVW(UAkHUD52sP+=wa@g02&+A=&B zo~~!6R!U6097dZ_8qT%fVbhZ}JP#M`%W&sAlu)}>e^P`#@A37cjGkYsJhw&6E-wD@!g(zFVJ=ztXUFQ~Y zwxxVH=hN2Gwr)}WsB3Q8eZ7$MdGnfy9dpaq6dm5f*_IP_^@{0({+s(5{mPfD%xx@S zeD66ZWGDJEDCo08<-q3B!v)vYvT8UDEhq9iGox7a~V8q=Il#Pa%3tvXWVg(HEf;U=~-(%c54@BccO!pxs!{Rxu+!& zUlt+@1J{ZMt`(mJ&h6lAiR;$TesiI%SBL|aS8SvP2{EZuCe zGFEK)$wpd&PL)lslBE%;5KFq8>W_#(YBA4Q?xV=O?mIDW+*crTPjMMZd^(8mW>&V` z;W~!!K6xH}wG%R^hM z3W`Rk;yA9RxG}@`#@GdyWFNx!DkJd*t`r!pP+viOU=u-wU#y1rkDsFp2<5ew5=3paeNZ-3ZFuxkA`9FnKx-&z` zk<-hUQnf;U;}zkj7ib}8j%kzFw+u)-5=XU8_Ab2M##TwFn}8P*2RTnZc@6jMcO9x? zz6-bX3-z8|w1;DZqsKYdSAb=$bN_g@70lsM^VyZ3I@=_1wsf*}oBYEuMeM23n*1@Z zv30ifbV!Tvw8cv3wH%z%9^pAgowP@ewr=jWSS9r9JRBWto$+DaU`e#bYucRli0I<% zu+Ia3mRZYY@?p!gXEt~V-CF0g2si9u24jzdmd?(2&2)OU&O`@1qwituK)$oi#gUw0 zFmSMTakRuMVV=am-ouvY;Qj;J<0o|2Sh~5p;OH`~@o;c-wDfQy!y4NX?ePrbbl2Q} zJgY@?nzV;-Lg-EQB`t!CF2fpIm&s?{@Sbh5bxwPP!=|0Faq+Mu+Tb-!_Xfv;-jrx% z>44`L*15R-)F^|Nv%8Cfv+a+X+$W#>(W;@NgQtTn5g#i(TcYP=vslH(UXGqWs5VI% za)w!FH_>5|60W;{>YcNt2i`m8)kI6@w1+MZZg|T~Cc7ucb8@uEsH~gH$2k2U?IbO2 z-N@B>5M7Amwv8-39PtdTzKe$|ChOBC=#&LZ(g9Qa$v8n_NeWB;%UE*eH0NaLI5~Z} z5^ddVo!xESre;TsJIPa=p{u)ti?h73>ffFsl?mi2l751eGGOUn%z~;7QYZN07!U>I z7@~R591*KA>kduah6ucrwamSF1mP{Ld!T;!Hp0QoqaG{14q>bPwyw6+17WM8c9v`i zK^TvmhJdl92;BwiGPCrA1Ad5H(hxdLd8 zYl)3`vK*R}-=4HMG!JTelUcduqflcTc6UH}36#?^mv=a>hvF8o5UZO6D2gffx)^;H z3VBzAZ6I_)o^6!b?QU22)bvWLbnF2ni$5A)`Fah!`Pxu^z-uWaTsS1PL&pFjBD^9i z_K89St&iSaiyFA+vve%&o(|lm`uK`bb^@+3jdr)MI1iT#cJC~oUjcyH3S7`5mwPB8Iax0WNsI>X@1QK7-4C=I}qMpP!Z8?^Mf7QJkSj$b$D9;ljoH zclvXN#+#vTe$`yFRNG8dJ5y_rWa_t?=!c^ERkVMrCrEmCw&wbsS|iT|zgJE(l=e)` zOIB;MRqd~H$4q@PTlf5;oMvmYzdi9$Sdzk$|7@0=X&YF(5Y4w@Q_wuQ5rAAcUdkHM2VNj*XM zvG+ko`pxJ(qm6?TZX0o9a2(Tc7}<=7E>>iQn;axdM=vr>C$sjBmJVd8-JoS4Z|rXA zjx!qXbVh!yv)$xaOfD)MY^P=XpV7kXL8hOS8y6zpHa*!icO>%@4bc`?D0KEj+aF@( zHCd<2emv*uL3Aan6nd9Q$(fYbnQd`;S`z=)Yaupd*_)*gI=VuUC0pF$`iGcjEg7x+*khlVb|F~8_jP4_Z*JoHTG)fiW@LMiy6&ZmrBrVrqc(o6q z^)|gzNM8pl__yV#|3iEl9eMOjWi0s?Kd|71Q67G}2d{tzh7w+rA zd}CxE5$>y+?Nh>iO_;BX>~q6>X=I-l?z6&uU6{`a_nH0To5Ou;vwVDH9~tgL!+c+4 z-yi1dBm1~89~$nX!+mJD50C6K!+m48wS!wLv#lQ78o{j^+{(bL7_!xcSy8wZM7GK> z>x*nXVb%xP8o{j}%o@V2H?nnuTR*sUG~1fOtR38{!>uy1b%lYxa zT|(tqNhkEJJ6%wi;}3OJDfSv-@1dpi~>jI|=upeXacd+og7s<0vRTk;(`j=tSnjo@hifj!Sv<9zDn}3r(Ek^bKCz z${H-F_kujFi4YO*JJ8uD=&G;#9zTB^;Uol> z?QV`kL~<|KQLzp}W3uIfS|xR8+q=}{pkOLO$3NF*>FF+nz-4_wccCA2-LUjgjeZ6t z%N8)b*!2w|e2Z&ev}iumR|E~+PBKBLpF3Web8i$bhzMJ<7zaQ`&r5!_Ynf0#f9Wdj z1Q)2;Xq&9a7KSjaDSFfInuIJKs}YMO#$Wly8902N|}5 zbH17@K{3M)4Lv^Woua-lE3I#>-Q9RFgAPZfusj)A1L`1l2w|K=rL#Tp_R>YO^B1|$a+j#QZpmO1X zt7Qi);YIF3{XwPmkoCg$5_dx_BDSt~|HY&3P;wxH7__V$@)d28Ct^jx zcZm-BE${D;Ws|+wO;-WFOVjGk=O2Wj<7n!E9e^l```7O(A4eAN4ovgv(S!@@D$EzN zuSJA7pRH|;Xn~p)G4}kc`Jk$T*Y^F~A%uP;{1v^pFmxJp8kXFug>X9~AD=JL5cY1l zoapHaguBtbe;wN$XmI%OCS0Hk!ajX*;tM$eF~#zprGZ>9zWtiD`S~}H`QbHh0E-7y zdveIz&3y&Yhgd@#i=X~x2`&9&3C%JwYsrk8vNJuNGfcF*n@NS@Ig zle5c|cY3m#$wl>){ISoHKWeQ#_&*cvU(3kHUIt4g=8=wp3Sh@T z6|nO8*zwT$SUn4{a#1Xm#^5Ef`o;B0$4Z5;yd>#7Dk6p*H(iW9HxJ9pVC{-w?Z{#G z#W6gE2s18339DCXRyi-0;&_W=aEe&{N*JEX$)s`t3{DusPa3BOUO(2p7?u~497w&e zLyAmS9l;LLOG%E>$?(c?n^)*}gD}Q3;WzwvO~CHWc(c8bjvZUGtRZ z;N+w&5SYpP$qf-~9c^|zr;BjCd@h(C`T*fq%sutxm;qtdg^1j&s;VGVBJQeEy{! zMGI2OkIXEmU%s*3Z*d$VoKrB>VMOY_h1Qv6`iL+Fuk;>E)nv_2xPK+{hqz!!Tkm)P zB75OfSww^>A{ctV-uPQCBDT8lj!|$QvLM_q$7db;Pfd~NN`sA)%H@N#lN3Y5R=S3j zFt0@BP4-%HAPtel#!Cw8mk7p}@>nV|4Ze@e$3oN9976b}9#6f12zyLbG>9lo4~HHi ziouC6Pd9|{Og-)zj!0wm%*V?4Fg#@ANc4~;;X|g=TWi>S6~{QO^71af6)k>PiNAVnTJGA1*{zb?0Fn- z84`Yo9F`XxAkj$%lLJvwzYxJ&Q(yv!K1dMIDOxd=q4i;9r?CxMUORQEP^;K$U-?Z{!{A~|nnITuDJT(3!E<1K~JQxUr_ zi|HFtzLdS)L1Ty{hL5-z-E-%KyUF@Z7N_gXamDFMZdc_2362ZHdjU3X^4m!5;PouP z?#sE6Qkt3lfMs zinXVL%pTI2<10wIkH};Flf(M0ggw6mgIk2<7h-UVjx+IBV8QUm=O^Q7yvY1I55p7J z+w-vccrkcfugmx0&ynht!P?`Ug*Pi!4=47VNb=0_6~pMX2)obejo~@79vH&lr7$?* zK5SmW`XhwVoddhifX}Dmq~~Zz&;LSK39MdeY+UhqNO?7>Tty9Q4}+7$##5GMCS7GP ze1!1%lswKPy7FS8Sh*;cid@9`hg9u^c zB*BOA*TtFj$OmD1EQ*AOTrz%(MAtc({#3Lk>956@o|VG*QGp%P-&py4Z2pnK^xpz( zUg5yn6U6i+3#RWyF?jhAk{%Po`GAhpt{8^D%-d=GO~#uKpRX{zDwj{1FC?*fU4n!c zbYXD#Jgcymq<6VU`2Ipy$!^m8D22^GlDNLPLF%6jrq9K(dgU;FRK(^NNlYKhV)#p7 z_vOj@kVIE;On*vX^N}c?Mw0MTav{-GZr3!u$oPq0n#SuFyz%*jgS4JQ#MDW6$Yc28 z>tKm3(-RE&Iq6w+qOm~zFzYx=BQVV}e&mVNf=%L6! z8gD_2U*t*rh6rQpKXDR1h&VP*Quw?nPwIyZmX~=&qL(mfya==BEhUWq_^|O1#OR`E zNTRDW)=zBxi->1F{Ce}H+-$s|51WtKuzG|sI!a@FDva^J5XQfvB5?r)hzX)d;%_oO zG*~@S7@vq28*kIut%^ut{4IcuAI{f{Fn&;)xeoY+u40({DB$ZGELFzntBC1cag6_k zBQXB3oUzV9q%nAGorNgP(y!te9Bzl;dPi|qUfKKi_myVlaeYTSt6U7vWA$Kq9=D4S zWh}+l{nE4YIG(atia#fb*N@Aq_snv}KlBU7lM736J5F*IoYbuQ%HA{cINd}D_(h_t zBsQ<%av+9}7naIm{DH4`aJy8#Z05R1!hgnmNiN6nlf>q6^1P8e10U=)$X}nA!P>+5 z9;dI&wwZRVD0W{8>yJ3g@9QIvr}xZq1#G>gh>-H)7=E%?JNW#M(-|+9!}>**e2lL6 z_~R*#H%MQ7zDXTi~*&1#bP|5Lxo zbevT$PFGxRWoA9EI4hN&b^lLvoR$C6MeY~QFZlXuwjNUUo(YHdUwIZBx&JeE{n>GE z=Z2}B@SjgL{k&!V*Bkvm9TE8Be*Ir;&;PvZ|3BEF|K%*r-#k|EkM`u!Svy*~;qGF* zklDu4-BR9;Xz4WjSPc`=WxxE)_c$mUE|d+If9i(I?0pg{{M_JTbg=wx#xt%ZFzB&u z%riCwefe%*&LPsci*!uD8k}GIsJI})YXCqK^ z(&S#zU==z4EoI(gF5wEac79V%41)`rTP3NNe|H|*@;xuQf8I5;EnLH8aL*eU8Ff-k z>C%IyB+4B1EI6~9IR#tCD8ffs& z3L8vq`OW4iJ>k!rqxAn5vieUrNH}A(S>3EH9c^vYt*7?6h}g)}A>u+LPrAsoWo?hh znNDAb)J__Qyrnl0i5ExL^EX7#nlb*l=O0-x)Ta|N=5ux0x|h9_M)+F2l;h;-5!z|q zx`fdChq7kU@gh9ACO6)0TmR3-{1@zJys_yp{SpxAjZGRB#WWVhj9K6u)-EnY8#nVw zC2j6TYLnDqXz`{gyp(hneg9IEb9aO|yz3iWr2TLZO+7KeaXCa0t&V^8h7eBkhYtTk zw^&(;Q)iL1Npa^@k6 zHqMbEBz#BMS!;RTE%=Hs9z12*{%$uym3}dhp4$e-qfH}E^zWOUJM0J+`O!Oapd-lVve5kg+4?-G>4;$nvbA){1W}$1+1eS{(bn6FY$IUTFY0QF&NP2eSNI`LdTSRaS3#v2 zIprBSl^MAuGjggka!Y6Amd(g5pOI6;Wr)@hl%&hXvtjf&n60Acs_?&9%U~lW} zY5C*aGoPz1aY~_C+S>}c*a>=0YF$fbYy7T|wTF|3qouopr>)>00H;}-dWw3q827G* zHj(AThXSXe?Q!bHqiliDd_2$9mtPc`lP-PlC{Kp=29~96%9YT$ld;Hsz8SO?zufiy z^g-x!5G7u+?ZxF3I&3Cx>mPT4Qs#~QCeM~Y6UXu7z17w8_UdWl;YTWv zYLa!ji2Xj43`^%3`u9Td9vQmzQGHNr%SP?dD2aXuN*>rBYKLZoKVHVEWr^l)Uo<2T zcN9h6Hc*+I=EC&>nqSvi)~o*o>aspq9+&zA=6iblm#(Kq3!)Ws72|o(ik0$8KGloS z6p10<)oER5vVKp8$e0VH%CzY5dM5vTJ zejE+6x#G3BWEEMz#n&>|DYBTL<&BA%NI)N2YZEFKZ?Xq!txm7G^7;_^Xk?jW2)87B zy3qb1S85sh=3v?3#DiIoOmo({`1mWh+Z?}KZ9yo6d{wKl$Yw`lWsd}w>*_5yJ$rmw67QrO>?JP;&hDq{%Op?1XNj^18l9ez? zuEiwzJSNFXm?Vc|lH7wyaxW&y;MCSa1xg-P-POp-e> zNp{90nG2I-xml8|jY+aUCdrF2N$#5^$uBWUmc=Cb8YamrFiEDxBzZR`$#R$^6K6?s z1t!TyF-g|NBw2ozBzI$y?0`wK7beMKm?W!WlKc*nw5`JYRtorpLIg*YGIojn*yQsmPKYt&KhVj zl*{TG3Wc_wr-$uRw?NbJS zM8N~DwD&6oE#T(rDlaC2E_QTnsg>`Mi`HE{Ev|R6ALL zI|QOLV*RJLu81VpfYR3uzcfqUVepB(L$LQIYL zg36%95Y-_+-+k8w*lN{$KCS}k`ckW zM^5G}mWWVLfbX1l%aH}f+&(6odyoayk6uOH*^h{*)9k-;q8br1JhCX`E*m10^XRND zT?ry)$^E%*-6>>Ifvt;{_^G_{$?WfrXl`@A^rv;{)Qp`1|sv=5DxV+q1!zA2tUpJ&Fi_FAwT5I z%Pixo2<;l{+95&*w6r!KtYk=!SG9T-d1db%%X1bgK4NtlMdT@Kc|tRBzsdFiLM8 zGBk5WmMf_58+0_GNb^fkfuva|q!q zwefX2PpFnZ?QS4_3ySBD2%0LWqqU)INi|t(5L!*zI)TBYWKP06<|AEOlbLRrzucCm zjL^)1%m|@Y=!wWGzZPN!qh7+_*6`kev$>Wk$7NWO>7KtldV%XvGJB6zv{Dc~!tPLg zd-tLJ$#jDgN=ddR$@4iQqz*P6Nai`6)K#ZZ0>c_FsQuqjBh=dKi8SW&(4H|b(dgrC zgexGTt9nox;TY`R>+vxS(ys;W%28{EZ{3vv&*a(>y1YGQbLMfNePbmlvMTNfeKpH` zg~ldmLX(;obml=3+unl?W;@UxqR;*p*_WWvPiMg#HIV4*7H^V!6|HJf2o(P!4`044 zD>-%)OH%Icl zEa64Jtofv~*>^n*i@&7*!i~V^uQhG)H!7eltx#K9G!yDx8-1~m+zyQg{gqAJ!_e-K zBg~tURAIzV%5N~G11%He=qW!hi#EBQZ@21t3-y}!M7iQ$p)VL|Y?mpC!1&JXua3@% zfj$w2dlg$a(epd%ZpA;aMK66$V(lv(fvO9Q-~8%7PcC)mU(J2+1{wtq?cc7QheqwS z6Np=0n9NZx$#Ug_I+P`KNgo*9k7ivqe;1Lq7A*~2Fqp9X9NK)jkZ*gv1^Ru=cZ+(( zS9EOfc4ey!Kl<(>`?IJUmhb?HxW6ieA8ny-SsXs>hxR>Ky=N%F6KedkGBorm(cbcb zOVvZCpdo12CHbTr=*_*E$lW`J4h#A;HeN>&8o3YW)qS5s!`z5cKhHR563Y`0ym|ud z%PRlmqGO46X70@lDe{Geb6NZ%doE0lTUE|uNiMW2c=+nMx*e14Sf2Ty(T{esmK3aw((J}X1 zkApi_!540}co%{TS~a?B<%;W%(R{gZszH}{D19KQ>%R2?+BF6eOWRxF+rYhd`;;C- z-G|lIJL1;D=VQd9yZBJ(c>GdJPbU-|8xqU7P*aOG32=9rC4`_od$Mg6Eq9@V+{eye zG0lSfMSKV9=kTMgD{qJSpVfqFUAqlO+DxIg#GlJ9ZXr~k*x*iog@7jZK9@YqvkjSZ z^+IK|lNz)edHY8TB|__ZwvC$&1JK6qPowTra_GEO?GCRU+OavTEbQnY`aH2Zz4A#b zlqaPtwoOE#EjBwAHQdiczXb&%AwKcFy_at54k~&Z(umKuOup|M%X{ z|A!lA1yHv+uj2rXD0IeMdOfIf5K5O3L#tPcLrU=W)t&j0(4iu-fb(25G*t_4xcgZe zisboDZ+KAxEg!n0vN-lb+4>#ba?7%y{@jrH+rz@p(D6P(eC;==T^i8UYaRq^7+m7# zz$>WpG_8{Ta0uv)cxbzqxI0S zvFZL!?;yyxUvtH0yb0PPm#mLm(+r))#n)`opF#dHqmEba%Ahg3?nV8>Qg}eOjzx3* z9Ox)Xsu+3o1lkPmZ4@_bhJb!%K0bPVC_7eFdFOyG)ZP>DtXrB6i9QqRJZJ)R%sIN> zqHhrLu2g0w6x)M)zcyjum>9&weq&~f^n)wHF1(AiPO!%iro42^LcAbM)Ejz;oq;q?EJm5YBYk_TYI|xWW7}c4KP- zB;Tr{YqhWdVmiw<-f#7ArHm$_$}<1@H3K4Cpe@`JWtsqQ6O*_DCHKKLrWjdg zUv7x;k~^?OClek-TP3^e#XvE&6%CYR!d($btsFihxZxA}MpWR`WWORdR7~pH%Uy*B z-vrNvlqFH7oIO#nXLmkd$jBL3A6auI((yU?6!Ape$>xL8IyJVh8n3_uRRsqb$-9ub zb@d^~Yo6ecf0oM4RarBrV0-rk?t{>zW9j|jqa!?hY<+RNUm!>ulAmUh6U~hCTJnf9!nAgh+&qqs^e_mn(8HORE ztnLfp^s=6eL-Xq)ur&Z;&pN{0Z}dXf&FVoX=(C2+0ad7f6x`6S7zqtbCUe;u(t*Y( z@IY>MK2TlAdD41p4frsBHjLgY1NTe=n?02m!*gkB#%?xAFrb}Bm2GGX4Gwni^`f`K zlPuYG@sc-S7v*v8#lmXvDrD&6BRF9 z)O=W`QxyQ`R%-|G>v2HbJ!H+EcUq9lQY*&?pP?|!^BsLQGu&CvwK@UW1>wh>!pcsc zg*##*g62z;Aar@%)*Y1_A;G)fL}76`#9F_a8(zH_t_4un3uVoPi;35yiDS|5>8#aj z+lK9s#CV=MD25X<#%;8ZG^N5TdR3Leo_!EgZStkpY8SZX+I1GL@rSFUo6Mxbset%E z-0US?Je(9&b6(cu4A-s%$ai1#0W;e#eLiX1pz%#Sa;eq>Zfou-v!9;;H#Lo%mDqzJ zKj3UzCGQACGLDYqUZ{m9sbZ;p9-*Kz9=!#*yA*=tJ)LPM2BDDCXt?%+HY9#uB`Y~< z1U{U=AEkK%PVbCdyUNZNG6OczJ$6xrySj59B&)21#~k7=5nb(IFcI^3>4u~5{`Qu` z+96%woBT90j_ne-4zl-^ogzTIoGj5~C>1iS*l!F6G(eES{AStR*WtzIHvx9LF2T9i z+Vz14q`^KRDE20U7+gM`tNg7e7%ILPJWZ2+559Ch+~?SDmniWWI*toUv1ox2>SSzgQol>GTECE-eCSji(v! zw<*JmafMWS=`pZ2l)P-ww+)<4!%vAkE`^u-&TZfOffqu*S6>rrYXdFXBwDB5y|7$4 zDPcv%dw3kU!tYFSFuY1$mYE&h1KUuV0}4agusNV^qipOxxOI)+{st8a`zjP}xTWod zC_kHH)LQwl;eJMNWUL=$4Mtgm{lB&bqkKq=@*y$Ghr}o!5~F-bjPfBd%7?@#YcR?h z?4P~{lSbGc*Y+QZP(!%lciuQPE{o9ct&(2xVi!XDVG+Yw*)<3YAM(WcG#kS5-mCoJ zr84O?;Un5M< z5XWv|X@o9Q?XtZ`AVU3y{^I*>hA^a{!d3Tm5klSglJoYtc?cu7xard2K7>b$_xnKw zBEp(Tlpib4N9bq=!lIaqVSLN?fzgwp2(RdHfoGQ;j66G@uUO)Uuvt4veq!8+aGRVr zTk)U-;dr@}c@fkgyzIx<(+5i+3z=y3qmtGlylzaj_7|NHMq#e8HpwQ0UO+~5S#c!7 zk@&UGd0q~}eXfJA3f+Qmy*f%gynzM!dkJ%ky|obP!JL*B_pLGP#aqFcn&p<9*ng#MX%&>YN8ALAhc4L#A) zZF^orZ7E^tKK?-U8)tL;WR@_@K>fM02g|c|fEzbgnKe-d?Wz*m zo1TQCgYmukC!OP9aNB7@c9AOjRZHq(wWfbEwLkyaI7St8d^vS;s=F!F_6N2nj^2aT z(dBjtU<-vQjdmL=I$*@UjzgZf0ft24smiP};ECaYcokOqDj=pz$j-ifFTfw!)FtP_a=6+vUqPF*MYMLl8%AUK7x~|TRB81B znp0E`xqes;od=$5c`ufO7JWaScyJ&C?cZ6`tWvTX&Dp=Ng+@CY604t8&WQVxMI04nY=L#u_XfmVL2%+K(0b0*y zCdqK*qJ>oZ1T{Z8qvbc51-A)ph5NN%D0no^cxRmnG-aITeRZi2zLYk-xwz#x z)UB4v)>6?%J65W7c3NA&;KgO{u3S8fezvd+JbL6LTF<|K#X*&Ps4>4R9wMNKMvY9U zl-5_n&}iCW)s2PFt;avKZayb^dUU6e?v?Xsz&4Kb{(-YlCZ4{8jg}wk#ce}$inAui z@r-b(ttT2G*FrqayegR`QIF30yeNEbzR=AvVuEI*ZJ(IK>4_FK-;Pqz`iwSk2yw2S z2tY@6jMB#(F+_*LcR1fre~+fKa9``_pMZN^ueZG8RY4n^vJO)na74Rbr+f-H5dxJ` z8|7N<@1otznGuS&jV8^ogFLE?iO@|Y$UQ%_6dkb0jM8TRh!8eH*>L%GsGY~XZh!Jx zs4J;aOI+WKb{8`&FXMlTcG`5V-hA*hH0T|F;c?g&EghvEIs3*2?NZ6^>MBcxn$5~W zT+)xwuP^;eGHz%amazwVo*SKB#McL7 zl{S{Qo}Wj@_=%c>GNw@d#E><;f{0dKQ{Gi=VU6Yu*aVfTMMJ46@p22bI@)#hgY2$s zPx$swflrHR6V&;mrQK#b;IkT=4(+SG(4k+HUfL>wj$K>#w6HH0Z7jY|vp7o!?NLgP z_3KnZ2R<(KPd6@wyhhfQ1DZ8xOWW{70v97x)vn(Vs;&jKHw6tols(PP4 za+x-BQ?%hVOWNK=%#-*o^PjNVfTk_26|B1(0K;x^Uo7g*L5W^w<+xceT6|2);a&b2 z7=0iR{VX6UnLwj{aHFvcbfr+aJQJsaUK@9WOZyO7ab%&(mA79YqjoXdmBS-w!4A5G~v7`X#|&hatw>YOUHz-wo$;qG9x z!|Tl5@k%MQHIhy&e_s|`8mSTL3RM)@*`@tLr4yjKt3*L~UbU0M^ZI(t*+ z_CzUKX`*mGU_2h}32c;&cMV7DOF!>bG2w^gfZBC~H-pjS4S6C@^;f|+K^@*NXKT@# zi|bDAEA574qi+^@HGARRV}GI4Ay%}5Z|LMg69&llKJ}TSY8hI2b4$C3?xfjRH;?9# zlJlR<#Gg*_7ld5(5!pfm1;ex*)QjgsUV_q^MP`bS*AO!?xAYDamb8vVc?CgHgJA02 zPy;BOyT+fGNDD*8>h(wk_? zfS{!*UpM-JX4AE1bx|~7^ZW_FQBO4eNT{CvKt7uD)X>D9y$8O?Im zE@CjbjZSX4-v%Y)2x+FI$dHnm+{Pr6F`4;U=ltIFo_D?PTAydHwV&_)W3RpT+W$Py zrq$DOz>S3}`=4Li`B(F*DpCqUuJ__aWfONsSI#&I6(Q4xTxUea82eoo&p&HTvlHZR zs)lA{iLOpPOT4m0hAz)FW6ig2`A(A7pfPGboSp#JwZPpGT3{k<|4@4T_K>qnsGV)m z^0A#Y|5Hz`VK~RR6GtRJXA`h};_$ZyAFhD%(?;2H=-kZ155G_q`aJ@BGH1rklH|G# z_=4+f6r^S=&MHt!l=;ig->pv9yw5(-K%Uk^Eb{m#kD&wi;@-vqV2%3(XUGSh%?{{Y zbVG5Cy;<8uS8Q(hs&3~XssytFY!L62>F2$v7M6S!hd&gEfuD=H<(V-WzfK2My-RZ@ zpZ-d(eNH;({t)ownp_g&YMMt_$?o>-qW4VHu4eUgU48N9vl6*}-iZ&Ey4tm$;Yr<*BC+wotY z&5Mv;QJ>plwH=qXV@5?hOsOQdkbuAnDwbUIuul4moa09#p^3`JoUpwo#ZW|eOYQxB z)br}wCi93uXHobf&D3y^amI1HSvP2KHluhxL}6*7Dfe-6LpB%c_F8vSX5NWIxm<|a z{(4<^o~fCS7F05%xa~rg52cd&3@K&vlBisvplKKiVa4 zhBu#zYHv7xttrhF4=(uQ3gV-e(_|i+82SEj(gYFNqQY;1-!Nnj2?sZKy*L_U{ETFP zjtZlApl9O#0gCxOu?Q4K_QAG5suvw+|{Z=AU;{-9| z6JiNM>J2I3C~R+|?;))a1bajorhwTEo@tDLr;bf=wzQaUBUWFFH2YB)+;g8$-aEC~ z@jc3=A9gVo0~3+yVP{R91ARemhiBhORhpnl-dmJ{sLyh;)Ei$~cPW4l(U%T0oq#)| z2CLdIcBElT1tOYUPR#p3X#UVSbwpMtVe|aWby!rWcBP8*Sk;v!RZT-#_(Q{%tp#mz zOHlSgWo16URM3y`nUbF0B{p^nlk<>c;@Wd-ov1U5^5{acM<^gkSU^jq^R=I9!wAn@)q+N?vd>v7exF@N2j$n8&yw@;yrR=HbXzQ{V%>33hvzZ~p? zZCzIUZ3fC*oT0d|>Sa=7uxD!(N4_n4Occ%+eOD;FhV%ys?z2_v-al{w+#0E_8Mf5B z`#BwbLlZpM_SK5t$l27h`8W)=*N5JQTY!|Jy8JDCjcn7;$zaS*dt}~l+TJ6&Bm*a3fh%})(d|#A>zf~>H@qB+)uHrSpp5)>v1?yTzSuddH zs~og5N<24vUMKLuWA^8kUZL11PvWPh8X?^@@6UwzML@GD55g#H&`vriL3u)F0kcKz z|G94 znTQ6jtTE7b?4ISBpU@>cH{mjMK(WeC(!J^TxdQB^Pw;*0B5s_K*fFGD&pHBp>%8%1 z-_2?Jje)zT0pCgJT*4f5in+m+9}j;F3G;~03+Zg{h>2B{_zm~9iXZvFL7hil?LTq* z+lT254u303Ir>j(izG;?5~QWTg!8=6JQoM6yIk^FVcHh``-NKdGRFC%buLHiI3WjT z#@-y1J|wsntPA zS)<(JLm7I>UA$*5TR&AQ702ts#_ag7v#bw&8$@t1CMPZ=nAEd3*Bc1R2k9I0%*+O`UtRDxh z>v&cA#4f=`8fdnDt29?Q9~V;~4zQoRQEd`^27gCX_m7$AK|iZwSCEjB56W4G^Yuj) z^qKSN=uH(i_-dvbgwlv=U5n0qjZoVSenCs1E7mAkoTqksjOjbSQA{jn zmynaY^)|Hw_DPKA2mhB}Ii=bu*~ndv7;=A>IwlR5i6Wp!I-+8Pt0SD_R+XMl1Ulsk zDqZyHh>l;Eo3v*M=Mz^;a0186h~Zek(i^s9O@&1{qrUi?NSeb=jXk#`D z=^we zADakxG+S<`{YV|75@Svu9+sy9m`fFwM{g#gPb+5hLFaS5HZ?GCPA^^I(g*X zXoNRSi4hVS&05=)*UQl>7fmZnYH3*zh2o?U&x`4J-7xU3)UQ>om;toQQzj)V7^6iyvI!nr1*H&(pS!D5XAY}na>E*gPsEq(M zC(oSp%fSCeevklpv(F+hboc9HJCJQ{t;!!IslXUwyXXrhsp^7TTz9bkbS!=W5Pj+P zZUq_gqFCS?azeJEJ(_Ol!VA`t0BgNQ#kwmKk{#YF{5Mj6 zUjZ;JPt3sUV*fspyose)N$^-umGoj{%d?N_HVVaL#1+mM+U` zZWy9>mP9^n4ewY<;q928J%>Uqo9@vN)7Mb+t29@+*5Db<)KT;O^7-7W zq*swy@&Yjvq=5T!a<4qvVFH6il}r6j zYYI%zuRl}X%XQ)2B|n5VQqMe1MKEDAuBI|)bmLwZ7os9S?{+K07@U6gm3QfgX=t$c zPG-Z@j;v-vtUdDuxmOp}-s0%IyPY3t7Wd2&sR6oMQzld616@gFophnpE>)=v9myRa z?%&Og;BM0Ndk-^&$5((HGXcBV@|w`83lORrHmc~Q>G(?dFaA+EZKkTX8B)dd|DgcY x>;Cd@;RO#uid-O6j@@zps7>!dQ#;`~r`bVvH)RmSdd{`He2P!RR)y!#{{a+ST+;vm literal 0 HcmV?d00001 diff --git a/Analyse Multidimensionnelle/DM ACP/.Rhistory b/Analyse Multidimensionnelle/DM ACP/.Rhistory index e69de29..d152650 100644 --- a/Analyse Multidimensionnelle/DM ACP/.Rhistory +++ b/Analyse Multidimensionnelle/DM ACP/.Rhistory @@ -0,0 +1,512 @@ +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 +quali_julien <- res.notes$ind$cos2["Julien", 1:2] +quali_julien +sum(quali_julien * 100) +contrib_moy_ind <- mean(res.notes$ind$contrib) +contrib_moy_ind +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,1], decreasing = TRUE) +head(indiv_contrib_axe_1, 3) +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,2:2], decreasing = TRUE) +indiv_contrib_axe_1[1:3] +mal_representes <- rownames(res.notes$ind$contrib)[rowSums(res.notes$ind$contrib[,1:2]) <= contrib_moy_ind] +cat("Les individus mal représentés sont : ", mal_representes) +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +summary(res.notes_sup, nb.dec = 2, nbelements = Inf, nbind = Inf) +contrib_moy_var <- mean(res.notes_sup$var$contrib) # 100 * 1/14 +contrib_moy_var +var_contrib_axe_2 <- sort(res.notes_sup$var$contrib[,2:2], decreasing = TRUE) +head(var_contrib_axe_2, 3) +mal_representes <- rownames(res.notes_sup$var$cos2[,1:2])[rowSums(res.notes_sup$var$cos2[,1:2]) <= 0.6] +mal_representes +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +indiv_contrib_axe_1[1:3] +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +head(indiv_contrib_axe_1, 3) +knitr::opts_chunk$set(include = FALSE) +rm(list=ls()) +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) +X <- scale(X,center=TRUE,scale=TRUE) +X +cor_X <- cor(X) +eigen_X <- eigen(cor_X, symmetric = TRUE) +lambda <- eigen_X["values"]$values +vect <- eigen_X["vectors"]$vectors +lambda +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 +C <- X %*% vect +C[,1:2] +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 = c('blue', 'red', 'green', 'yellow', 'purple', 'orange'), +pch=15 +) +legend(x = 'topleft', legend = rownames(X), col = c('blue', 'red', 'green', 'yellow', 'purple', 'orange'), pch = 15) +nrow(notes_MAN_prep) # Nombre d'individus +ncol(notes_MAN_prep) # Nombre de variables +dim(notes_MAN_prep) # On peut également utiliser 'dim' qui renvoit la dimension +library(FactoMineR) +# help(PCA) +# 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) +summary(res.notes, nbind = Inf, nbelements = Inf, nb.dec = 2) +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) +coords_man_stats <- res.notes$var$coord["MAN.Stats",] +coords_man_stats[1:2] +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 +quali_julien <- res.notes$ind$cos2["Julien", 1:2] +quali_julien +sum(quali_julien * 100) +contrib_moy_ind <- mean(res.notes$ind$contrib) +contrib_moy_ind +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,1], decreasing = TRUE) +head(indiv_contrib_axe_1, 3) +indiv_contrib_axe_2 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +head(indiv_contrib_axe_2, 3) +mal_representes <- rownames(res.notes$ind$contrib)[rowSums(res.notes$ind$contrib[,1:2]) <= contrib_moy_ind] +cat("Les individus mal représentés sont : ", mal_representes) +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +summary(res.notes_sup, nb.dec = 2, nbelements = Inf, nbind = Inf) +contrib_moy_var <- mean(res.notes_sup$var$contrib) # 100 * 1/14 +contrib_moy_var +var_contrib_axe_2 <- sort(res.notes_sup$var$contrib[,2:2], decreasing = TRUE) +head(var_contrib_axe_2, 3) +mal_representes <- rownames(res.notes_sup$var$cos2[,1:2])[rowSums(res.notes_sup$var$cos2[,1:2]) <= 0.6] +mal_representes +indiv_contrib_axe_2 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +head(indiv_contrib_axe_2, 4) +indiv_contrib_axe_2 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +head(indiv_contrib_axe_2, 3) +View(X) +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) +View(X) +View(notes_MAN) +View(res.notes) +mal_representes <- rownames(res.notes$ind$contrib)[rowSums(res.notes$ind$contrib[,1:2]) <= 4.334] +cat("Les individus mal représentés sont : ", mal_representes) +mal_representes <- rownames(res.notes$ind$contrib)[rowSums(res.notes$ind$contrib[,1:2]) <= contrib_moy_ind] +cat("Les individus mal représentés sont : ", mal_representes) +mal_representes <- rownames(res.notes$ind$cos2)[rowSums(res.notes$ind$cos2[,1:2]) <= mean(res.notes$ind$cos2[,1:2])] +cat("Les individus mal représentés sont : ", mal_representes) +View(notes_MAN_prep) +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +plot(res.notes_sup, habillage = "Mentions") +knitr::opts_chunk$set(include = FALSE) +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +knitr::opts_chunk$set(include = FALSE) +rm(list=ls()) +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) +X <- scale(X,center=TRUE,scale=TRUE) +X +cor_X <- cor(X) +eigen_X <- eigen(cor_X, symmetric = TRUE) +lambda <- eigen_X["values"]$values +vect <- eigen_X["vectors"]$vectors +lambda +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 +C <- X %*% vect +C[,1:2] +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) +nrow(notes_MAN_prep) # Nombre d'individus +ncol(notes_MAN_prep) # Nombre de variables +dim(notes_MAN_prep) # On peut également utiliser 'dim' qui renvoit la dimension +library(FactoMineR) +# help(PCA) +# 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) +summary(res.notes, nbind = Inf, nbelements = Inf, nb.dec = 2) +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) +coords_man_stats <- res.notes$var$coord["MAN.Stats",] +coords_man_stats[1:2] +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 +quali_julien <- res.notes$ind$cos2["Julien", 1:2] +quali_julien +sum(quali_julien * 100) +contrib_moy_ind <- mean(res.notes$ind$contrib) +contrib_moy_ind +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,1], decreasing = TRUE) +head(indiv_contrib_axe_1, 3) +indiv_contrib_axe_2 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +head(indiv_contrib_axe_2, 3) +mal_representes <- rownames(res.notes$ind$cos2)[rowSums(res.notes$ind$cos2[,1:2]) <= mean(res.notes$ind$cos2[,1:2])] +cat("Les individus mal représentés sont : ", mal_representes) +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +plot.PCA(res.iris, choix = "ind", habillage = "Mentions", label = "none") +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +plot.PCA(res.notes_sup, choix = "ind", habillage = "Mentions", label = "none") +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +plot.PCA(res.notes_sup, choix = "ind", habillage = "Mentions") +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +plot.PCA(res.notes_sup, choix = "ind", habillage = "Mention") +View(notes_MAN) +View(notes_MAN) +knitr::opts_chunk$set(include = FALSE) +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 +knitr::opts_chunk$set(include = FALSE) +rm(list=ls()) +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) +X <- scale(X,center=TRUE,scale=TRUE) +X +cor_X <- cor(X) +eigen_X <- eigen(cor_X, symmetric = TRUE) +lambda <- eigen_X["values"]$values +vect <- eigen_X["vectors"]$vectors +lambda +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 +C <- X %*% vect +C[,1:2] +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) +nrow(notes_MAN_prep) # Nombre d'individus +ncol(notes_MAN_prep) # Nombre de variables +dim(notes_MAN_prep) # On peut également utiliser 'dim' qui renvoit la dimension +library(FactoMineR) +# help(PCA) +# 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) +summary(res.notes, nbind = Inf, nbelements = Inf, nb.dec = 2) +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) +coords_man_stats <- res.notes$var$coord["MAN.Stats",] +coords_man_stats[1:2] +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 +quali_julien <- res.notes$ind$cos2["Julien", 1:2] +quali_julien +sum(quali_julien * 100) +contrib_moy_ind <- mean(res.notes$ind$contrib) +contrib_moy_ind +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,1], decreasing = TRUE) +head(indiv_contrib_axe_1, 3) +indiv_contrib_axe_2 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +head(indiv_contrib_axe_2, 3) +mal_representes <- rownames(res.notes$ind$cos2)[rowSums(res.notes$ind$cos2[,1:2]) <= mean(res.notes$ind$cos2[,1:2])] +cat("Les individus mal représentés sont : ", mal_representes) +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +plot.PCA(res.notes_sup, choix = "ind", habillage = "Mention") +summary(res.notes_sup, nb.dec = 2, nbelements = Inf, nbind = Inf) +contrib_moy_var <- mean(res.notes_sup$var$contrib) # 100 * 1/14 +contrib_moy_var +var_contrib_axe_2 <- sort(res.notes_sup$var$contrib[,2], decreasing = TRUE) +head(var_contrib_axe_2, 3) +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 +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 +knitr::opts_chunk$set(include = FALSE) +rm(list=ls()) +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) +X <- scale(X,center=TRUE,scale=TRUE) +X +cor_X <- cor(X) +eigen_X <- eigen(cor_X, symmetric = TRUE) +lambda <- eigen_X["values"]$values +vect <- eigen_X["vectors"]$vectors +lambda +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 +C <- X %*% vect +C[,1:2] +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) +nrow(notes_MAN_prep) # Nombre d'individus +ncol(notes_MAN_prep) # Nombre de variables +dim(notes_MAN_prep) # On peut également utiliser 'dim' qui renvoit la dimension +library(FactoMineR) +# help(PCA) +# 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) +summary(res.notes, nbind = Inf, nbelements = Inf, nb.dec = 2) +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) +coords_man_stats <- res.notes$var$coord["MAN.Stats",] +coords_man_stats[1:2] +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 +quali_julien <- res.notes$ind$cos2["Julien", 1:2] +quali_julien +sum(quali_julien * 100) +contrib_moy_ind <- mean(res.notes$ind$contrib) +contrib_moy_ind +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,1], decreasing = TRUE) +head(indiv_contrib_axe_1, 3) +indiv_contrib_axe_2 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +head(indiv_contrib_axe_2, 3) +mal_representes <- rownames(res.notes$ind$cos2)[rowSums(res.notes$ind$cos2[,1:2]) <= mean(res.notes$ind$cos2[,1:2])] +cat("Les individus mal représentés sont : ", mal_representes) +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +plot.PCA(res.notes_sup, choix = "ind", habillage = "Mention") +summary(res.notes_sup, nb.dec = 2, nbelements = Inf, nbind = Inf) +contrib_moy_var <- mean(res.notes_sup$var$contrib) # 100 * 1/14 +contrib_moy_var +var_contrib_axe_2 <- sort(res.notes_sup$var$contrib[,2], decreasing = TRUE) +head(var_contrib_axe_2, 3) +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 +mal_representes <- rownames(res.notes$ind$cos2)[rowSums(res.notes$ind$cos2[,1:2]) <= mean(res.notes$ind$cos2[,1:2])] +mal_representes +knitr::opts_chunk$set(include = FALSE) +rm(list=ls()) +library(dplyr) +notes_MAN <- read.table("notes_MAN.csv", sep=";", dec=",", row.names=1, header=TRUE) +knitr::opts_chunk$set(include = FALSE) +rm(list=ls()) +library(dplyr) +notes_MAN <- read.table("notes_MAN.csv", sep=";", dec=",", row.names=1, header=TRUE) +knitr::opts_chunk$set(include = FALSE) +rm(list=ls()) +library(dplyr) +notes_MAN <- read.table("notes_MAN.csv", sep=";", dec=",", row.names=1, header=TRUE) +knitr::opts_chunk$set(include = FALSE) +rm(list=ls()) +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) +X <- scale(X,center=TRUE,scale=TRUE) +X +cor_X <- cor(X) +eigen_X <- eigen(cor_X, symmetric = TRUE) +lambda <- eigen_X["values"]$values +vect <- eigen_X["vectors"]$vectors +lambda +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 +C <- X %*% vect +C[,1:2] +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) +nrow(notes_MAN_prep) # Nombre d'individus +ncol(notes_MAN_prep) # Nombre de variables +dim(notes_MAN_prep) # On peut également utiliser 'dim' qui renvoit la dimension +library(FactoMineR) +# help(PCA) +# 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) +summary(res.notes, nbind = Inf, nbelements = Inf, nb.dec = 2) +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) +coords_man_stats <- res.notes$var$coord["MAN.Stats",] +coords_man_stats[1:2] +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 +quali_julien <- res.notes$ind$cos2["Julien", 1:2] +quali_julien +sum(quali_julien * 100) +contrib_moy_ind <- mean(res.notes$ind$contrib) +contrib_moy_ind +indiv_contrib_axe_1 <- sort(res.notes$ind$contrib[,1], decreasing = TRUE) +head(indiv_contrib_axe_1, 3) +indiv_contrib_axe_2 <- sort(res.notes$ind$contrib[,2], decreasing = TRUE) +head(indiv_contrib_axe_2, 3) +mal_representes <- rownames(res.notes$ind$cos2)[rowSums(res.notes$ind$cos2[,1:2]) <= mean(res.notes$ind$cos2[,1:2])] +mal_representes +res.notes_sup <- PCA(notes_MAN, scale.unit = TRUE, quali.sup = c("Mention")) +plot.PCA(res.notes_sup, choix = "ind", habillage = "Mention") +summary(res.notes_sup, nb.dec = 2, nbelements = Inf, nbind = Inf) +contrib_moy_var <- mean(res.notes_sup$var$contrib) # 100 * 1/14 +contrib_moy_var +var_contrib_axe_2 <- sort(res.notes_sup$var$contrib[,2], decreasing = TRUE) +head(var_contrib_axe_2, 3) +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 diff --git a/Analyse Multidimensionnelle/DM ACP/DM_ACP.Rmd b/Analyse Multidimensionnelle/DM ACP/DM_ACP.Rmd index 3dccd52..84e893c 100644 --- a/Analyse Multidimensionnelle/DM ACP/DM_ACP.Rmd +++ b/Analyse Multidimensionnelle/DM ACP/DM_ACP.Rmd @@ -1,14 +1,23 @@ --- -title: "DM Statistique exploratoire multidimensionelle" +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) +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) ------------------------------------------------------------------------ @@ -16,17 +25,17 @@ Ce devoir maison est à rendre individuellement au plus tard le 1er mars 2024 so knitr::opts_chunk$set(include = FALSE) ``` -### PARTIE 1 : Calcul de composantes principales sous R (Sans FactoMineR) +# PARTIE 1 : Calcul de composantes principales sous R (Sans FactoMineR) -- Vide l'environnement de travail, initialise la matrice avec laquelle vous allez travailler +- 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) +- Importation du jeu de données (compiler ce qui est ci-dessous mais + NE SURTOUT PAS MODIFIER) ```{r} library(dplyr) @@ -38,83 +47,337 @@ 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) +# 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) +- Question 1 : que fait la fonction “scale” dans la cellule ci-dessus + ? (1 point) -- 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). +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 ``` -- Question 3 : quelle est la part d’inertie expliquée par les 2 premières composantes principales ? (1 point) - ```{r} +lambda ``` -- Question 4 : calculer les coordonnées des individus sur les deux premières composantes principales (1 point) +- 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 5 : représenter les individus sur le plan formé par les deux premières composantes principales (1 point) +- 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 +# PARTIE 2 : ACP avec FactoMineR -À partir de maintenant, on considère l'entièreté des notes et des étudiants. +À 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. +- 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} +```{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) ``` -- Question 3 : Afficher l’éboulis des valeurs propre. - ```{r} +summary(res.notes, nbind = Inf, nbelements = Inf, nb.dec = 2) ``` -- Question 4 : Quelles sont les coordonnées de la variable MAN.Stats sur le cercle des corrélations ? - -- Question 5 : Quelle est la contribution moyenne des individus ? Quelle est la contribution de Thérèse au 3e axe principal ? +- 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 6 : Quelle est la qualité de représentation de Julien sur le premier plan factoriel (constitué du premier et deuxième axe) ? +- Question 4 : Quelles sont les coordonnées de la variable MAN.Stats + sur le cercle des corrélations ? -- Question 7 : Discuter du nombre d’axes à conserver selon les deux critères vus en cours. Dans toutesla suite on gardera néanmoins 2 axes. +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: -- Question 8 : Effectuer l’étude des individus. Être en particulier vigilant aux étudiants mal représentéset commenter. +\* $corr(x,y)$: la corrélation entre x et y -- Question 9 : Relancer une ACP en incluant la variable catégorielle des mentions comme variable supplémentaire. +\* $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] ``` -- Qestion 10 : Déduire des deux questions précédentes une interprétation du premier axe principal. +Les coordonnées de la variable **MAN.Stats** sont donc environ +**(0.766,-0.193)** -- Question 11 : Effectuer l’analyse des variables. Commenter les UE mal représentées. +- Question 5 : Quelle est la contribution moyenne des individus ? + Quelle est la contribution de Thérèse au 3e axe principal ? -- Question 12 : Interpréter les deux premières composantes principales. +```{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. \ No newline at end of file