#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

Media vs median (Dispersion de escalas)

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