ACP
E.ing NEKUI TIEFANG BIEDIANT
2023-04-11
ACP
#traitement
library(factoextra)## Le chargement a nécessité le package : ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(FactoMineR)
data("mtcars")
mtcars$country=c(rep("Japon",3),rep("us",4),rep("Europe",7),rep("us",3),"Europe",rep("japon",3),rep("us",4),rep("Europe",3),"us",rep("Europe",3))
base =mtcars
names(base)## [1] "mpg" "cyl" "disp" "hp" "drat" "wt" "qsec" "vs"
## [9] "am" "gear" "carb" "country"View(base)
summary(base)## mpg cyl disp hp drat
## Min. :10.40 Min. :4.000 Min. : 71.1 Min. : 52.0 Min. :2.760
## 1st Qu.:15.43 1st Qu.:4.000 1st Qu.:120.8 1st Qu.: 96.5 1st Qu.:3.080
## Median :19.20 Median :6.000 Median :196.3 Median :123.0 Median :3.695
## Mean :20.09 Mean :6.188 Mean :230.7 Mean :146.7 Mean :3.597
## 3rd Qu.:22.80 3rd Qu.:8.000 3rd Qu.:326.0 3rd Qu.:180.0 3rd Qu.:3.920
## Max. :33.90 Max. :8.000 Max. :472.0 Max. :335.0 Max. :4.930
## wt qsec vs am gear
## Min. :1.513 Min. :14.50 Min. :0.0000 Min. :0.0000 Min. :3.000
## 1st Qu.:2.581 1st Qu.:16.89 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:3.000
## Median :3.325 Median :17.71 Median :0.0000 Median :0.0000 Median :4.000
## Mean :3.217 Mean :17.85 Mean :0.4375 Mean :0.4062 Mean :3.688
## 3rd Qu.:3.610 3rd Qu.:18.90 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:4.000
## Max. :5.424 Max. :22.90 Max. :1.0000 Max. :1.0000 Max. :5.000
## carb country
## Min. :1.000 Length:32
## 1st Qu.:2.000 Class :character
## Median :2.000 Mode :character
## Mean :2.812
## 3rd Qu.:4.000
## Max. :8.000remarque taille des données pas homogène
#in acp
acp= PCA(base,scale.unit = T,quali.sup = 12)## Warning: ggrepel: 9 unlabeled data points (too many overlaps). Consider increasing
## max.overlaps
#scale.unit pour une homogeneité (centré et reduire), quali.sup=12 ajouter la 12eme var qui est quali
#obtenir les propriétés de l'objet acp
acp## **Results for the Principal Component Analysis (PCA)**
## The analysis was performed on 32 individuals, described by 12 variables
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$var" "results for the variables"
## 3 "$var$coord" "coord. for the variables"
## 4 "$var$cor" "correlations variables - dimensions"
## 5 "$var$cos2" "cos2 for the variables"
## 6 "$var$contrib" "contributions of the variables"
## 7 "$ind" "results for the individuals"
## 8 "$ind$coord" "coord. for the individuals"
## 9 "$ind$cos2" "cos2 for the individuals"
## 10 "$ind$contrib" "contributions of the individuals"
## 11 "$quali.sup" "results for the supplementary categorical variables"
## 12 "$quali.sup$coord" "coord. for the supplementary categories"
## 13 "$quali.sup$v.test" "v-test of the supplementary categories"
## 14 "$call" "summary statistics"
## 15 "$call$centre" "mean of the variables"
## 16 "$call$ecart.type" "standard error of the variables"
## 17 "$call$row.w" "weights for the individuals"
## 18 "$call$col.w" "weights for the variables"pour voir les resultats sur les les 2 première dimention il faut
summary(acp,ncp=2)##
## Call:
## PCA(X = base, scale.unit = T, quali.sup = 12)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8
## Variance 6.608 2.650 0.627 0.270 0.223 0.212 0.135 0.123
## % of var. 60.076 24.095 5.702 2.451 2.031 1.924 1.230 1.117
## Cumulative % of var. 60.076 84.172 89.873 92.324 94.356 96.279 97.509 98.626
## Dim.9 Dim.10 Dim.11
## Variance 0.077 0.052 0.022
## % of var. 0.700 0.473 0.200
## Cumulative % of var. 99.327 99.800 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr cos2
## Mazda RX4 | 2.234 | -0.657 0.204 0.087 | 1.735 3.551 0.604 |
## Mazda RX4 Wag | 2.081 | -0.629 0.187 0.091 | 1.550 2.833 0.555 |
## Datsun 710 | 2.987 | -2.779 3.653 0.866 | -0.146 0.025 0.002 |
## Hornet 4 Drive | 2.521 | -0.312 0.046 0.015 | -2.363 6.584 0.879 |
## Hornet Sportabout | 2.456 | 1.974 1.844 0.646 | -0.754 0.671 0.094 |
## Valiant | 3.014 | -0.056 0.001 0.000 | -2.786 9.151 0.855 |
## Duster 360 | 3.187 | 3.003 4.264 0.888 | 0.335 0.132 0.011 |
## Merc 240D | 2.841 | -2.055 1.998 0.523 | -1.465 2.531 0.266 |
## Merc 230 | 3.733 | -2.287 2.474 0.375 | -1.984 4.639 0.282 |
## Merc 280 | 1.907 | -0.526 0.131 0.076 | -0.162 0.031 0.007 |
##
## Variables (the 10 first)
## Dim.1 ctr cos2 Dim.2 ctr cos2
## mpg | -0.932 13.143 0.869 | 0.026 0.026 0.001 |
## cyl | 0.961 13.981 0.924 | 0.071 0.191 0.005 |
## disp | 0.946 13.556 0.896 | -0.080 0.243 0.006 |
## hp | 0.848 10.894 0.720 | 0.405 6.189 0.164 |
## drat | -0.756 8.653 0.572 | 0.447 7.546 0.200 |
## wt | 0.890 11.979 0.792 | -0.233 2.046 0.054 |
## qsec | -0.515 4.018 0.266 | -0.754 21.472 0.569 |
## vs | -0.788 9.395 0.621 | -0.377 5.366 0.142 |
## am | -0.604 5.520 0.365 | 0.699 18.440 0.489 |
## gear | -0.532 4.281 0.283 | 0.753 21.377 0.567 |
##
## Supplementary categories
## Dist Dim.1 cos2 v.test Dim.2 cos2 v.test
## Europe | 1.023 | -0.868 0.720 -1.658 | 0.338 0.109 1.020 |
## japon | 3.587 | -3.464 0.932 -2.413 | -0.570 0.025 -0.627 |
## Japon | 1.923 | -1.355 0.497 -0.944 | 1.046 0.296 1.151 |
## us | 2.307 | 2.218 0.924 3.721 | -0.514 0.050 -1.361 |#il donne les valeurs propre, les coordonné des var
#pour obtenir les valeus propres (variance associé aux axes) il faut
val.propre=round(acp$eig[,1],2)
val.propre## comp 1 comp 2 comp 3 comp 4 comp 5 comp 6 comp 7 comp 8 comp 9 comp 10
## 6.61 2.65 0.63 0.27 0.22 0.21 0.14 0.12 0.08 0.05
## comp 11
## 0.02#calcul en pourcentage
cumulative.percentage.variance=round(acp$eig[,3],2)
cumulative.percentage.variance # comme regle on peut prendre deux dimensions ## comp 1 comp 2 comp 3 comp 4 comp 5 comp 6 comp 7 comp 8 comp 9 comp 10
## 60.08 84.17 89.87 92.32 94.36 96.28 97.51 98.63 99.33 99.80
## comp 11
## 100.00#tracer du graphique des valeurs propres
plot(1:11,val.propre,type = "b",ylab = "valeurs propres",xlab = "composante",main = "scree plot")
##coordonnées des variables sur les axes factoriels
#coorelation variables facteurs
print(acp$var$cor[,1:2],digits=2) #coordonnées sur deux dimension## Dim.1 Dim.2
## mpg -0.93 0.026
## cyl 0.96 0.071
## disp 0.95 -0.080
## hp 0.85 0.405
## drat -0.76 0.447
## wt 0.89 -0.233
## qsec -0.52 -0.754
## vs -0.79 -0.377
## am -0.60 0.699
## gear -0.53 0.753
## carb 0.55 0.673#contribution de chaque variable par le cosinus et le contrib
round(acp$var$cos2[,1:2],2)## Dim.1 Dim.2
## mpg 0.87 0.00
## cyl 0.92 0.01
## disp 0.90 0.01
## hp 0.72 0.16
## drat 0.57 0.20
## wt 0.79 0.05
## qsec 0.27 0.57
## vs 0.62 0.14
## am 0.36 0.49
## gear 0.28 0.57
## carb 0.30 0.45round(acp$var$contrib[,1:2],2)## Dim.1 Dim.2
## mpg 13.14 0.03
## cyl 13.98 0.19
## disp 13.56 0.24
## hp 10.89 6.19
## drat 8.65 7.55
## wt 11.98 2.05
## qsec 4.02 21.47
## vs 9.39 5.37
## am 5.52 18.44
## gear 4.28 21.38
## carb 4.58 17.10#contributions des variables sur la dim1
fviz_contrib(acp, choice="var",axes = 1,top = 10)
#contributions des variables sur la dim2
fviz_contrib(acp, choice="var",axes = 2,top = 10)
#contributions total sur la dim 1 et 2
fviz_contrib(acp, choice="ind",axes = 1:2)
#cercle de correlarion - variables actives
#colore en fonction du cos2: qualité de representaion
fviz_pca_var(acp, col.var = "cos2",gradient.cols=c("blue","red","yellow"),repel = T,title="cercle de corelation")
#graphique des individus
#projection des individus sur le premier pla factoreil
#composante des individus sur l'axe principale
round(acp$ind$coord[,1:2],2)## Dim.1 Dim.2
## Mazda RX4 -0.66 1.74
## Mazda RX4 Wag -0.63 1.55
## Datsun 710 -2.78 -0.15
## Hornet 4 Drive -0.31 -2.36
## Hornet Sportabout 1.97 -0.75
## Valiant -0.06 -2.79
## Duster 360 3.00 0.33
## Merc 240D -2.06 -1.47
## Merc 230 -2.29 -1.98
## Merc 280 -0.53 -0.16
## Merc 280C -0.51 -0.32
## Merc 450SE 2.25 -0.68
## Merc 450SL 2.05 -0.68
## Merc 450SLC 2.15 -0.80
## Cadillac Fleetwood 3.90 -0.83
## Lincoln Continental 3.95 -0.73
## Chrysler Imperial 3.59 -0.42
## Fiat 128 -3.86 -0.30
## Honda Civic -4.25 0.69
## Toyota Corolla -4.23 -0.28
## Toyota Corona -1.90 -2.12
## Dodge Challenger 2.18 -1.01
## AMC Javelin 1.86 -0.91
## Camaro Z28 2.89 0.68
## Pontiac Firebird 2.25 -0.87
## Fiat X1-9 -3.57 -0.12
## Porsche 914-2 -2.65 2.05
## Lotus Europa -3.39 1.38
## Ford Pantera L 1.37 3.50
## Ferrari Dino 0.00 3.22
## Maserati Bora 2.67 4.38
## Volvo 142E -2.42 0.23# si l'on a beaucoup d'individus et leurs libele ne sont pas explicite (des numeros par exmple)
# on peut supprimer les noms des libéles tout en laissant les points avec l'argument label="none"
plot(acp,cex=0.8,invisible = "quali", label = "none", title = "graphique des individus")
#mettons y un peut de couleurs en fction des modalites
plot(acp,cex=0.8,habillage = "country",repel=T,title = "graphique des individus")## Warning: ggrepel: 9 unlabeled data points (too many overlaps). Consider increasing
## max.overlaps
#elipse de confiance autour des modalités
plotellipses(acp)## Warning: ggrepel: 9 unlabeled data points (too many overlaps). Consider increasing
## max.overlaps
# calculons la contribution des individus actifs pour les deux premiers axes
round(acp$ind$cos2[,1:2],2)## Dim.1 Dim.2
## Mazda RX4 0.09 0.60
## Mazda RX4 Wag 0.09 0.55
## Datsun 710 0.87 0.00
## Hornet 4 Drive 0.02 0.88
## Hornet Sportabout 0.65 0.09
## Valiant 0.00 0.85
## Duster 360 0.89 0.01
## Merc 240D 0.52 0.27
## Merc 230 0.38 0.28
## Merc 280 0.08 0.01
## Merc 280C 0.06 0.03
## Merc 450SE 0.83 0.08
## Merc 450SL 0.79 0.09
## Merc 450SLC 0.79 0.11
## Cadillac Fleetwood 0.88 0.04
## Lincoln Continental 0.88 0.03
## Chrysler Imperial 0.88 0.01
## Fiat 128 0.94 0.01
## Honda Civic 0.88 0.02
## Toyota Corolla 0.93 0.00
## Toyota Corona 0.39 0.48
## Dodge Challenger 0.62 0.13
## AMC Javelin 0.62 0.15
## Camaro Z28 0.77 0.04
## Pontiac Firebird 0.68 0.10
## Fiat X1-9 0.97 0.00
## Porsche 914-2 0.50 0.30
## Lotus Europa 0.72 0.12
## Ford Pantera L 0.11 0.73
## Ferrari Dino 0.00 0.85
## Maserati Bora 0.24 0.65
## Volvo 142E 0.81 0.01round(acp$ind$contrib[,1:2],2)## Dim.1 Dim.2
## Mazda RX4 0.20 3.55
## Mazda RX4 Wag 0.19 2.83
## Datsun 710 3.65 0.03
## Hornet 4 Drive 0.05 6.58
## Hornet Sportabout 1.84 0.67
## Valiant 0.00 9.15
## Duster 360 4.26 0.13
## Merc 240D 2.00 2.53
## Merc 230 2.47 4.64
## Merc 280 0.13 0.03
## Merc 280C 0.12 0.12
## Merc 450SE 2.39 0.55
## Merc 450SL 1.98 0.55
## Merc 450SLC 2.18 0.76
## Cadillac Fleetwood 7.19 0.81
## Lincoln Continental 7.39 0.63
## Chrysler Imperial 6.10 0.21
## Fiat 128 7.03 0.10
## Honda Civic 8.56 0.56
## Toyota Corolla 8.48 0.09
## Toyota Corona 1.71 5.30
## Dodge Challenger 2.26 1.21
## AMC Javelin 1.64 0.97
## Camaro Z28 3.95 0.55
## Pontiac Firebird 2.39 0.90
## Fiat X1-9 6.04 0.02
## Porsche 914-2 3.32 4.94
## Lotus Europa 5.42 2.24
## Ford Pantera L 0.89 14.44
## Ferrari Dino 0.00 12.22
## Maserati Bora 3.37 22.62
## Volvo 142E 2.77 0.06#graphe avec selection des individus
#select="cos2 0.7": selectionne les individus qui ont sur le plan tracé une qualité de projection superieure a 0.7
plot(acp,cex=0.8,habillage = 12,select = "cos2 0.8")## Warning: ggrepel: 3 unlabeled data points (too many overlaps). Consider increasing
## max.overlaps
#select="cos2 5": selectionne les 5 individus qui ont la meilleur qualité de projection sur le le plan
plot(acp,cex=0.8,habillage = 12,select = "cos2 7")
fviz_pca_ind(acp,col.ind = "cos2",gradient.cols=c("green","red","blue"),repel = T) #evite le chevauchement de texte
#graphe avec selection des individus, des tailles de police differentes
#pour les titres des ombres sous les points
plot(acp,cex=0.8,habillage = 12,select = "cos2 0.7", title = "cathegories des voitures",cex.main=1.1,cex.axis=0.9,shadow=T,auto="y")## Warning: ggrepel: 9 unlabeled data points (too many overlaps). Consider increasing
## max.overlaps
#graphe biplot
fviz_pca_biplot(acp,cex=0.8,habillage = 12,repel = T,col.var = "black",col.ind = "red",ggtheme=theme_minimal())## Warning: Duplicated aesthetics after name standardisation: size
_FIN_