#Primer examen parcial
library (ade4)
data("bacteria")
bacteria <- bacteria$espaa
str (bacteria)
## 'data.frame': 43 obs. of 21 variables:
## $ Ala: num 60384 28326 50661 85555 91276 ...
## $ Arg: num 48823 23565 36713 55731 48698 ...
## $ Asn: num 12907 17294 20664 41785 46474 ...
## $ Asp: num 24567 20754 31358 58649 61327 ...
## $ Cys: num 5896 3770 7358 8393 9340 ...
## $ Gln: num 12058 9791 11448 47325 45257 ...
## $ Glu: num 41892 46216 56642 90358 85399 ...
## $ Gly: num 54161 32425 46562 81279 82164 ...
## $ His: num 12189 7430 9733 27972 26892 ...
## $ Ile: num 32902 35203 46172 80022 87050 ...
## $ Leu: num 72081 50946 60810 115667 114745 ...
## $ Lys: num 22335 45092 43489 67022 82768 ...
## $ Met: num 12476 8979 16109 30743 31755 ...
## $ Phe: num 17397 24736 29467 51345 53186 ...
## $ Pro: num 40897 19580 24835 44287 43835 ...
## $ Ser: num 47682 23036 35350 64903 74444 ...
## $ Stp: num 2619 1490 2088 3558 3628 ...
## $ Thr: num 29697 20221 26833 64274 64270 ...
## $ Trp: num 8324 4495 6639 13156 12238 ...
## $ Tyr: num 21272 19887 23426 39079 41133 ...
## $ Val: num 55421 38211 55527 86451 80173 ...
#Creamos un vector simulado con el habitat para las 43 especies
set.seed(2)
habit <- sample(c("Suelo", "Patogena", "Marina", "Extremofila"),size = nrow(bacteria), replace = TRUE )
#Unimos la variable cualitativa al final del data.frame
bacteria$Habitat <- as.factor(habit)
str(bacteria)
## 'data.frame': 43 obs. of 22 variables:
## $ Ala : num 60384 28326 50661 85555 91276 ...
## $ Arg : num 48823 23565 36713 55731 48698 ...
## $ Asn : num 12907 17294 20664 41785 46474 ...
## $ Asp : num 24567 20754 31358 58649 61327 ...
## $ Cys : num 5896 3770 7358 8393 9340 ...
## $ Gln : num 12058 9791 11448 47325 45257 ...
## $ Glu : num 41892 46216 56642 90358 85399 ...
## $ Gly : num 54161 32425 46562 81279 82164 ...
## $ His : num 12189 7430 9733 27972 26892 ...
## $ Ile : num 32902 35203 46172 80022 87050 ...
## $ Leu : num 72081 50946 60810 115667 114745 ...
## $ Lys : num 22335 45092 43489 67022 82768 ...
## $ Met : num 12476 8979 16109 30743 31755 ...
## $ Phe : num 17397 24736 29467 51345 53186 ...
## $ Pro : num 40897 19580 24835 44287 43835 ...
## $ Ser : num 47682 23036 35350 64903 74444 ...
## $ Stp : num 2619 1490 2088 3558 3628 ...
## $ Thr : num 29697 20221 26833 64274 64270 ...
## $ Trp : num 8324 4495 6639 13156 12238 ...
## $ Tyr : num 21272 19887 23426 39079 41133 ...
## $ Val : num 55421 38211 55527 86451 80173 ...
## $ Habitat: Factor w/ 4 levels "Extremofila",..: 4 2 3 3 1 1 4 4 4 1 ...
summary (bacteria)
## Ala Arg Asn Asp
## Min. : 878 Min. : 779 Min. : 276 Min. : 482
## 1st Qu.: 18487 1st Qu.: 11362 1st Qu.:12458 1st Qu.:13612
## Median : 33373 Median : 22124 Median :18264 Median :23322
## Mean : 45944 Mean : 29060 Mean :20110 Mean :27054
## 3rd Qu.: 59498 3rd Qu.: 36780 3rd Qu.:24366 3rd Qu.:30803
## Max. :214102 Max. :139943 Max. :52595 Max. :97676
## Cys Gln Glu Gly
## Min. : 128 Min. : 438 Min. : 660 Min. : 736
## 1st Qu.: 2730 1st Qu.: 8742 1st Qu.: 17762 1st Qu.: 16393
## Median : 5040 Median :12875 Median : 33342 Median : 30109
## Mean : 5270 Mean :18827 Mean : 34851 Mean : 38433
## 3rd Qu.: 6362 3rd Qu.:22704 3rd Qu.: 45712 3rd Qu.: 47492
## Max. :18205 Max. :78076 Max. :111560 Max. :155325
## His Ile Leu Lys
## Min. : 239 Min. : 440 Min. : 1108 Min. : 367
## 1st Qu.: 5826 1st Qu.:20306 1st Qu.: 30303 1st Qu.:17758
## Median : 8478 Median :33018 Median : 48221 Median :24051
## Mean :10903 Mean :33836 Mean : 55220 Mean :28970
## 3rd Qu.:12614 3rd Qu.:44389 3rd Qu.: 59171 3rd Qu.:42451
## Max. :39843 Max. :87050 Max. :228871 Max. :82768
## Met Phe Pro Ser
## Min. : 174 Min. : 377 Min. : 511 Min. : 670
## 1st Qu.: 5738 1st Qu.:13568 1st Qu.: 9985 1st Qu.: 20073
## Median :10727 Median :19733 Median :16169 Median : 29024
## Mean :11645 Mean :22086 Mean :23128 Mean : 31947
## 3rd Qu.:13830 3rd Qu.:26256 3rd Qu.:25759 3rd Qu.: 34624
## Max. :37044 Max. :65325 Max. :93268 Max. :101332
## Stp Thr Trp Tyr
## Min. : 35.0 Min. : 546 Min. : 174 Min. : 265
## 1st Qu.: 861.5 1st Qu.:14421 1st Qu.: 2368 1st Qu.: 9716
## Median :1519.0 Median :21290 Median : 3827 Median :16421
## Mean :1749.6 Mean :26667 Mean : 6062 Mean :16593
## 3rd Qu.:2090.5 3rd Qu.:29833 3rd Qu.: 6792 3rd Qu.:20610
## Max. :5255.0 Max. :77369 Max. :27308 Max. :46647
## Val Habitat
## Min. : 756 Extremofila:11
## 1st Qu.: 16811 Marina :10
## Median : 32154 Patogena :10
## Mean : 37685 Suelo :12
## 3rd Qu.: 52911
## Max. :126949
#Buscar datos faltantes
colSums(is.na(bacteria))
## Ala Arg Asn Asp Cys Gln Glu Gly His Ile
## 0 0 0 0 0 0 0 0 0 0
## Leu Lys Met Phe Pro Ser Stp Thr Trp Tyr
## 0 0 0 0 0 0 0 0 0 0
## Val Habitat
## 0 0
# Separamos las variables cuantitativas (químicas)
bacteria_num <- bacteria[, 1:21]
head(bacteria_num)
## Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys
## AERPECG 60384 48823 12907 24567 5896 12058 41892 54161 12189 32902 72081 22335
## AQUAECG 28326 23565 17294 20754 3770 9791 46216 32425 7430 35203 50946 45092
## ARCFUCG 50661 36713 20664 31358 7358 11448 56642 46562 9733 46172 60810 43489
## BACHDCG 85555 55731 41785 58649 8393 47325 90358 81279 27972 80022 115667 67022
## BACSUCG 91276 48698 46474 61327 9340 45257 85399 82164 26892 87050 114745 82768
## BORBUCG 12555 8898 20318 14526 1822 6305 18931 14559 3403 29993 29020 28498
## Met Phe Pro Ser Stp Thr Trp Tyr Val
## AERPECG 12476 17397 40897 47682 2619 29697 8324 21272 55421
## AQUAECG 8979 24736 19580 23036 1490 20221 4495 19887 38211
## ARCFUCG 16109 29467 24835 35350 2088 26833 6639 23426 55527
## BACHDCG 30743 51345 44287 64903 3558 64274 13156 39079 86451
## BACSUCG 31755 53186 43835 74444 3628 64270 12238 41133 80173
## BORBUCG 5008 17514 7044 20862 773 11018 1404 11814 14980
# Vector de Promedios
colMeans(bacteria_num)
## Ala Arg Asn Asp Cys Gln Glu Gly
## 45943.814 29059.930 20109.628 27054.442 5270.093 18826.744 34850.977 38432.837
## His Ile Leu Lys Met Phe Pro Ser
## 10903.279 33836.070 55219.651 28970.093 11645.488 22085.558 23128.488 31946.814
## Stp Thr Trp Tyr Val
## 1749.581 26667.279 6061.744 16593.326 37684.837
**Promedios mas altos: Leu, Ala, Gly, Val
promedios <- colMeans(bacteria_num)
barplot (promedios,
main = "Escalas (promedios)",
col = 2,
las = 3,
cex.names = 0.6)
— Detección global de valores atípicos (Boxplot escalado)
—
# Boxplot general con datos estandarizados
boxplot(scale(bacteria_num),
main = "Detección global de valores atípicos (Variables escaladas)",
col = "lightblue",
las = 2,
cex.axis = 0.8)
— Distribución univariada completa (Histogramas) —
Graficamos los histogramas de las 21 variables cuantitativas para analizar la normalidad, curtosis, sesgos y la presencia de modas múltiples.
par(mfrow = c(4, 4), mar = c(2, 2, 2, 1))
for(i in 1:21) {
hist(bacteria_num[[i]],
probability = TRUE,
main = names(bacteria_num)[i],
col = "darkred",
border = "black",
xlab = "")
lines(density(bacteria_num[[i]]), col = "blue", lwd = 2)
}
par(mfrow = c(1, 1))
cov(bacteria_num)
## Ala Arg Asn Asp Cys Gln Glu
## Ala 1931515878 1163069973 410451858 877838979 151790727 673161125 905035931
## Arg 1163069973 729371732 237409147 524203273 92129741 396180045 567261842
## Asn 410451858 237409147 158614101 221650531 39262508 186254263 267478227
## Asp 877838979 524203273 221650531 433685050 71134573 322059965 470471288
## Cys 151790727 92129741 39262508 71134573 14417263 59393634 79638919
## Gln 673161125 396180045 186254263 322059965 59393634 294771960 353066073
## Glu 905035931 567261842 267478227 470471288 79638919 353066073 601375882
## Gly 1429985212 874160771 327538731 667921471 114429652 504306318 729669415
## His 368611232 220850665 93720741 176707335 31245927 143253726 195523803
## Ile 671883804 410209787 252521808 374718520 63862712 287821597 488034833
## Leu 1795445451 1103794385 467138541 856310061 154047862 696005765 986290572
## Lys 396466298 241254688 201354527 247059596 43008355 192860440 373217411
## Met 351168057 213229418 105077662 179567917 31202768 141846887 215206359
## Phe 524535044 317756823 170731758 273321855 47849269 218956775 339042746
## Pro 857242708 530037080 187767907 390698710 69046551 303594549 425006299
## Ser 873964858 532329877 237604709 425286159 76539963 340914592 490530003
## Stp 46605409 29037338 11975911 21884049 3820337 17309291 25093464
## Thr 825900556 491213046 212719298 403115640 68313583 314729332 441649005
## Trp 251002934 153512012 58850084 116254673 20727743 94490240 127491089
## Tyr 381759864 236273614 124127740 202070792 34484809 154571389 257062358
## Val 1218222021 747990335 294690889 589112862 98779311 433535459 669736434
## Gly His Ile Leu Lys Met Phe
## Ala 1429985212 368611232 671883804 1795445451 396466298 351168057 524535044
## Arg 874160771 220850665 410209787 1103794385 241254688 213229418 317756823
## Asn 327538731 93720741 252521808 467138541 201354527 105077662 170731758
## Asp 667921471 176707335 374718520 856310061 247059596 179567917 273321855
## Cys 114429652 31245927 63862712 154047862 43008355 31202768 47849269
## Gln 504306318 143253726 287821597 696005765 192860440 141846887 218956775
## Glu 729669415 195523803 488034833 986290572 373217411 215206359 339042746
## Gly 1088946108 279601704 562553958 1374110174 355915838 277241925 417811174
## His 279601704 77405081 155948268 366330485 104222647 76929251 115683972
## Ile 562553958 155948268 454041443 781117556 357158657 183409724 290228408
## Leu 1374110174 366330485 781117556 1852740664 537675612 371322433 579503655
## Lys 355915838 104222647 357158657 537675612 332025222 132372448 226570128
## Met 277241925 76929251 183409724 371322433 132372448 84828182 126418030
## Phe 417811174 115683972 290228408 579503655 226570128 126418030 204929050
## Pro 650848230 165893071 321135847 823575608 195265550 160828373 242076207
## Ser 677184581 183811670 404736526 902113347 280484794 189348509 291903715
## Stp 35911457 9334861 19647576 46350054 14000740 9382998 14575325
## Thr 634963468 171400099 360518412 806980546 237630912 172820461 259426516
## Trp 190100637 49817446 99029145 246885821 61350712 49553147 74044657
## Tyr 310109876 84512788 222034991 425207262 171250606 95043349 149861699
## Val 943177962 244669457 524554606 1194737256 347519770 250865875 378186922
## Pro Ser Stp Thr Trp Tyr Val
## Ala 857242708 873964858 46605409 825900556 251002934 381759864 1218222021
## Arg 530037080 532329877 29037338 491213046 153512012 236273614 747990335
## Asn 187767907 237604709 11975911 212719298 58850084 124127740 294690889
## Asp 390698710 425286159 21884049 403115640 116254673 202070792 589112862
## Cys 69046551 76539963 3820337 68313583 20727743 34484809 98779311
## Gln 303594549 340914592 17309291 314729332 94490240 154571389 433535459
## Glu 425006299 490530003 25093464 441649005 127491089 257062358 669736434
## Gly 650848230 677184581 35911457 634963468 190100637 310109876 943177962
## His 165893071 183811670 9334861 171400099 49817446 84512788 244669457
## Ile 321135847 404736526 19647576 360518412 99029145 222034991 524554606
## Leu 823575608 902113347 46350054 806980546 246885821 425207262 1194737256
## Lys 195265550 280484794 14000740 237630912 61350712 171250606 347519770
## Met 160828373 189348509 9382998 172820461 49553147 95043349 250865875
## Phe 242076207 291903715 14575325 259426516 74044657 149861699 378186922
## Pro 397564168 404839618 21921187 377174118 115124058 180126138 559305958
## Ser 404839618 462109298 23053627 411296359 119952605 216433671 596346352
## Stp 21921187 23053627 1493783 21491687 6229127 10812942 31203921
## Thr 377174118 411296359 21491687 396803594 112069281 191497286 562435990
## Trp 115124058 119952605 6229127 112069281 34695469 54395257 164424495
## Tyr 180126138 216433671 10812942 191497286 54395257 114650902 284903381
## Val 559305958 596346352 31203921 562435990 164424495 284903381 843003415
— Matriz de correlación —
Calculamos la matriz de correlaciones de Pearson y la graficamos utilizando la librería corrplot para identificar las asociaciones lineales y redundancias entre compuestos químicos.
library(corrplot)
## corrplot 0.95 loaded
# 1. Matriz de correlación de Pearson
matriz_cor <- cor(bacteria_num)
# 2. Visualización con corrplot
matriz_correlacion <- cor(bacteria_num)
corrplot(matriz_correlacion,
method = "color",
type = "upper",
addCoef.col = "black", # Muestra los números exactos
tl.col = "black",
tl.srt = 45,
number.cex = 0.5, # Tamaño de los números
main = "Matriz de Correlaciones de Vinos",
mar = c(0,0,1,0))
# Boxplot de Alanina segmentado por Habitat
boxplot(Ala ~ habit, data = bacteria,
main = "Niveles de Alanina por Habitat",
xlab = "habitat (habit)",
ylab = "Alanina",
col = c("lightgreen", "lightpink", "lightblue"))
# Cargar Librerías para ACP y visualización (instálalas en tu consola si no las tienes)
library(FactoMineR)
##
## Adjuntando el paquete: 'FactoMineR'
## The following object is masked from 'package:ade4':
##
## reconst
library(factoextra)
## Cargando paquete requerido: ggplot2
## Welcome to factoextra!
## Want to learn more? See two factoextra-related books at https://www.datanovia.com/library/principal-component-methods
# 1. Ejecutar el Análisis de Componentes Principales
# Se usa scale.unit = TRUE para estandarizar los datos automáticamente en el cálculo
res.pca <- PCA(bacteria_num, scale.unit = TRUE, graph = FALSE)
# 2. Extraer Eigenvalores y % de varianza
eigenvalores <- get_eigenvalue(res.pca)
print("--- EIGENVALORES Y VARIANZA EXPLICADA (Primeras 6 dimensiones) ---")
## [1] "--- EIGENVALORES Y VARIANZA EXPLICADA (Primeras 6 dimensiones) ---"
head(eigenvalores)
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 18.6965617 89.0312463 89.03125
## Dim.2 1.3225482 6.2978486 95.32909
## Dim.3 0.2883744 1.3732113 96.70231
## Dim.4 0.2078860 0.9899332 97.69224
## Dim.5 0.1331887 0.6342321 98.32647
# 3. Gráfico de Sedimentación (Scree plot)
fviz_eig(res.pca, addlabels = TRUE, ylim=c(0,100),
main = "Gráfico de Sedimentación (Scree Plot)",
xlab= "Componentes Principales",
ylab = "Porcentaje de Varianza Explicada",
barfill = "steelblue", barcolor = "black")
## Warning: This FactoMineR PCA result contains only 5 eigenvalues and does not
## include the complete spectrum. Refit the PCA with a larger `ncp` before drawing
## a complete scree plot.
Circulo de correlaciones (Variables)
# Gráfico de Correlación de Variables para justificar la identidad de las dimensiones
fviz_pca_var(res.pca,
col.var = "contrib", # Colorea las flechas según su contribución
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE, # Evita que los textos se superpongan
title = "Círculo de Correlaciones")
## Proyección de datos atipicos
# 1. Gráfico de Individuos coloreado por Habitat
fviz_pca_ind(res.pca,
geom.ind = "point", # Muestra puntos en lugar de texto para evitar amontonamiento
col.ind = as.factor(bacteria$Habitat), # Variable de agrupación
palette = c("#00AFBB", "#E7B800", "#FC4E07", "green"),
addEllipses = TRUE, # Agrega elipses de confianza alrededor de los grupos
legend.title = "Habitat",
title = "Mapa de Individuos (PCA) agrupado por Habitat")
# 2. Identificar los individuos (Bacterias) que más contribuyen al modelo
fviz_contrib(res.pca, choice = "ind", axes = 1:2, top = 15,
fill = "darkgreen", color = "black",
title = "Top 15 cepas con mayor contribución (Dim 1 y 2)")
head(sort(res.pca$ind$contrib[, 1], decreasing = TRUE), 5)
## PSEAECG ECOLICG MYCTUCG BACSUCG BACHDCG
## 26.045750 11.628365 8.523643 7.592779 6.880633
head(sort(res.pca$ind$contrib[, 2], decreasing = TRUE), 5)
## MYCTUCG BACSUCG DEIRAC1 PSEAECG BACHDCG
## 14.683330 12.465937 11.375022 8.149424 5.777011
#ACM Poison
library (FactoMineR)
data ("poison")
head (poison)
## Age Time Sick Sex Nausea Vomiting Abdominals Fever Diarrhae Potato
## 1 9 22 Sick_y F Nausea_y Vomit_n Abdo_y Fever_y Diarrhea_y Potato_y
## 2 5 0 Sick_n F Nausea_n Vomit_n Abdo_n Fever_n Diarrhea_n Potato_y
## 3 6 16 Sick_y F Nausea_n Vomit_y Abdo_y Fever_y Diarrhea_y Potato_y
## 4 9 0 Sick_n F Nausea_n Vomit_n Abdo_n Fever_n Diarrhea_n Potato_y
## 5 7 14 Sick_y M Nausea_n Vomit_y Abdo_y Fever_y Diarrhea_y Potato_y
## 6 72 9 Sick_y M Nausea_n Vomit_n Abdo_y Fever_y Diarrhea_y Potato_y
## Fish Mayo Courgette Cheese Icecream
## 1 Fish_y Mayo_y Courg_y Cheese_y Icecream_y
## 2 Fish_y Mayo_y Courg_y Cheese_n Icecream_y
## 3 Fish_y Mayo_y Courg_y Cheese_y Icecream_y
## 4 Fish_y Mayo_n Courg_y Cheese_y Icecream_y
## 5 Fish_y Mayo_y Courg_y Cheese_y Icecream_y
## 6 Fish_n Mayo_y Courg_y Cheese_y Icecream_y
str(poison)
## 'data.frame': 55 obs. of 15 variables:
## $ Age : int 9 5 6 9 7 72 5 10 5 11 ...
## $ Time : int 22 0 16 0 14 9 16 8 20 12 ...
## $ Sick : Factor w/ 2 levels "Sick_n","Sick_y": 2 1 2 1 2 2 2 2 2 2 ...
## $ Sex : Factor w/ 2 levels "F","M": 1 1 1 1 2 2 1 1 2 2 ...
## $ Nausea : Factor w/ 2 levels "Nausea_n","Nausea_y": 2 1 1 1 1 1 1 2 2 1 ...
## $ Vomiting : Factor w/ 2 levels "Vomit_n","Vomit_y": 1 1 2 1 2 1 2 2 1 2 ...
## $ Abdominals: Factor w/ 2 levels "Abdo_n","Abdo_y": 2 1 2 1 2 2 2 2 2 1 ...
## $ Fever : Factor w/ 2 levels "Fever_n","Fever_y": 2 1 2 1 2 2 2 2 2 2 ...
## $ Diarrhae : Factor w/ 2 levels "Diarrhea_n","Diarrhea_y": 2 1 2 1 2 2 2 2 2 2 ...
## $ Potato : Factor w/ 2 levels "Potato_n","Potato_y": 2 2 2 2 2 2 2 2 2 2 ...
## $ Fish : Factor w/ 2 levels "Fish_n","Fish_y": 2 2 2 2 2 1 2 2 2 2 ...
## $ Mayo : Factor w/ 2 levels "Mayo_n","Mayo_y": 2 2 2 1 2 2 2 2 2 2 ...
## $ Courgette : Factor w/ 2 levels "Courg_n","Courg_y": 2 2 2 2 2 2 2 2 2 2 ...
## $ Cheese : Factor w/ 2 levels "Cheese_n","Cheese_y": 2 1 2 2 2 2 2 2 2 2 ...
## $ Icecream : Factor w/ 2 levels "Icecream_n","Icecream_y": 2 2 2 2 2 2 2 2 2 2 ...
# Revisión de la estructura (para conocer el número de observaciones, variables y el tipo de dato de cada una.)
dim(poison)
## [1] 55 15
# Revisión de datos faltantes iniciales (Los valores faltantes fueron identificados para evitar que afectaran el desarrollo del ACM. Para el análisis se conservaron únicamente los registros que cuentan con información completa en las variables categóricas seleccionadas.)
colSums(is.na(poison))
## Age Time Sick Sex Nausea Vomiting Abdominals
## 0 0 0 0 0 0 0
## Fever Diarrhae Potato Fish Mayo Courgette Cheese
## 0 0 0 0 0 0 0
## Icecream
## 0
# Selección de variables cualitativas para el ACM. Para realizar el ACM se seleccionaron las variables categóricas que permiten estudiar las características y relaciones entre los diferentes grupos de pingüinos.
datos_acm <- poison[, c(3: 13 )]
# Conversión de variables a factores (Obligatorio para el ACM)
datos_acm[] <- lapply(datos_acm, factor)
str(datos_acm)
## 'data.frame': 55 obs. of 11 variables:
## $ Sick : Factor w/ 2 levels "Sick_n","Sick_y": 2 1 2 1 2 2 2 2 2 2 ...
## $ Sex : Factor w/ 2 levels "F","M": 1 1 1 1 2 2 1 1 2 2 ...
## $ Nausea : Factor w/ 2 levels "Nausea_n","Nausea_y": 2 1 1 1 1 1 1 2 2 1 ...
## $ Vomiting : Factor w/ 2 levels "Vomit_n","Vomit_y": 1 1 2 1 2 1 2 2 1 2 ...
## $ Abdominals: Factor w/ 2 levels "Abdo_n","Abdo_y": 2 1 2 1 2 2 2 2 2 1 ...
## $ Fever : Factor w/ 2 levels "Fever_n","Fever_y": 2 1 2 1 2 2 2 2 2 2 ...
## $ Diarrhae : Factor w/ 2 levels "Diarrhea_n","Diarrhea_y": 2 1 2 1 2 2 2 2 2 2 ...
## $ Potato : Factor w/ 2 levels "Potato_n","Potato_y": 2 2 2 2 2 2 2 2 2 2 ...
## $ Fish : Factor w/ 2 levels "Fish_n","Fish_y": 2 2 2 2 2 1 2 2 2 2 ...
## $ Mayo : Factor w/ 2 levels "Mayo_n","Mayo_y": 2 2 2 1 2 2 2 2 2 2 ...
## $ Courgette : Factor w/ 2 levels "Courg_n","Courg_y": 2 2 2 2 2 2 2 2 2 2 ...
# Revisamos datos faltantes de las variables que ocupamos y los eliminamos
colSums(is.na(datos_acm))
## Sick Sex Nausea Vomiting Abdominals Fever Diarrhae
## 0 0 0 0 0 0 0
## Potato Fish Mayo Courgette
## 0 0 0 0
datos_acm_n <- na.omit(datos_acm)
colSums(is.na(datos_acm_n))
## Sick Sex Nausea Vomiting Abdominals Fever Diarrhae
## 0 0 0 0 0 0 0
## Potato Fish Mayo Courgette
## 0 0 0 0
# Dimensión final de la base limpia
dim(datos_acm_n)
## [1] 55 11
# Cargar Librerías necesarias
library(FactoMineR)
library(factoextra)
# 1. Ejecutar el Análisis de Correspondencias Múltiples (ACM)
res.mca <- MCA(datos_acm_n, ncp=5, graph=FALSE)
summary(res.mca, nb.dec = 3, ncp=2)
##
## Call:
## MCA(X = datos_acm_n, ncp = 5, graph = FALSE)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Variance 0.404 0.126 0.107 0.088 0.079
## % of var. 40.378 12.646 10.671 8.769 7.902
## Cumulative % of var. 40.378 53.025 63.696 72.464 80.366
##
## Individuals (the 10 first)
## Dim.1 ctr cos2 Dim.2 ctr cos2
## 1 | -0.466 0.976 0.310 | 0.193 0.535 0.053 |
## 2 | 0.826 3.072 0.743 | -0.018 0.005 0.000 |
## 3 | -0.473 1.007 0.472 | -0.275 1.089 0.160 |
## 4 | 1.043 4.903 0.833 | -0.090 0.117 0.006 |
## 5 | -0.480 1.037 0.479 | -0.110 0.175 0.025 |
## 6 | -0.400 0.722 0.030 | 0.612 5.377 0.070 |
## 7 | -0.473 1.007 0.472 | -0.275 1.089 0.160 |
## 8 | -0.637 1.826 0.524 | -0.081 0.095 0.009 |
## 9 | -0.473 1.006 0.316 | 0.358 1.841 0.181 |
## 10 | -0.192 0.167 0.059 | -0.122 0.213 0.024 |
##
## Categories (the 10 first)
## Dim.1 ctr cos2 v.test Dim.2 ctr cos2 v.test
## Sick_n | 1.449 14.619 0.940 7.124 | -0.011 0.003 0.000 -0.055 |
## Sick_y | -0.648 6.540 0.940 -7.124 | 0.005 0.001 0.000 0.055 |
## F | 0.024 0.007 0.001 0.180 | -0.317 3.669 0.104 -2.369 |
## M | -0.025 0.007 0.001 -0.180 | 0.328 3.804 0.104 2.369 |
## Nausea_n | 0.250 1.100 0.224 3.477 | -0.166 1.541 0.098 -2.304 |
## Nausea_y | -0.896 3.941 0.224 -3.477 | 0.593 5.523 0.098 2.304 |
## Vomit_n | 0.479 3.099 0.344 4.311 | 0.429 7.938 0.276 3.861 |
## Vomit_y | -0.718 4.649 0.344 -4.311 | -0.644 11.908 0.276 -3.861 |
## Abdo_n | 1.352 13.470 0.889 6.930 | -0.030 0.021 0.000 -0.151 |
## Abdo_y | -0.658 6.553 0.889 -6.930 | 0.014 0.010 0.000 0.151 |
##
## Categorical variables (eta2)
## Dim.1 Dim.2
## Sick | 0.940 0.000 |
## Sex | 0.001 0.104 |
## Nausea | 0.224 0.098 |
## Vomiting | 0.344 0.276 |
## Abdominals | 0.889 0.000 |
## Fever | 0.818 0.007 |
## Diarrhae | 0.830 0.008 |
## Potato | 0.026 0.509 |
## Fish | 0.007 0.055 |
## Mayo | 0.344 0.012 |
# 2. Resultados Numéricos: Eigenvalores, % de varianza y varianza acumulada
print("--- EIGENVALORES Y VARIANZA ---")
## [1] "--- EIGENVALORES Y VARIANZA ---"
eig.val <- get_eigenvalue(res.mca)
head(eig.val)
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 0.40378451 40.378451 40.37845
## Dim.2 0.12646202 12.646202 53.02465
## Dim.3 0.10671032 10.671032 63.69568
## Dim.4 0.08768803 8.768803 72.46449
## Dim.5 0.07901911 7.901911 80.36640
# 3. Resultado Gráfico: Gráfico de Sedimentación
fviz_screeplot(res.mca, addlabels = TRUE,
title = "Gráfico de Sedimentación - Varianza Explicada por Dimensión")
# 1. Gráfico de Elipses de Confianza
plotellipses(res.mca)
# 2. Mapa de Categorías con Calidad de Representación (Cos2)
fviz_mca_var(res.mca,
col.var = "cos2",
gradient.cols = c("blue2", "green", "red"),
repel = TRUE,
ggtheme = theme_minimal()) +
labs(title = "Nube de Puntos de Categorías (Cos2)")
# 3. Contribución de las categorías a las Dimensiones 1 y 2
fviz_contrib(res.mca, choice = "var", axes = c(1,2), repel = TRUE) +
labs(title = "Contribución de Categorías (Dim 1 y 2)")
head(sort(res.mca$var$contrib[, 1], decreasing = TRUE), 5)
## Sick_n Abdo_n Diarrhea_n Fever_n Diarrhea_y
## 14.619483 13.469967 11.886142 11.723397 6.792081