1. Descripción de los Datos y Objetivos de Estudio

La base de datos analizada contiene 178 observaciones correspondientes a los perfiles fisicoquímicos de vinos cultivados en una misma región de Italia. Para cada muestra, se midieron 13 variables químicas continuas (como Alcohol, Ácido Málico, Prolina, Flavanoides, etc.) y se registró una variable categórica correspondiente a los tres cultivares genéticos de origen (Customer_Segment).

Objetivo del estudio: Aplicar la técnica de Análisis de Componentes Principales (ACP) para reducir la dimensionalidad del perfil químico de los vinos, conservando la mayor cantidad de varianza y eliminando la redundancia.

Interrogantes a responder: * ¿Existe la suficiente correlación entre los compuestos químicos para justificar la reducción de dimensiones? * ¿Cuáles son las variables químicas que aportan mayor peso para caracterizar y distinguir a cada vino? * ¿Es posible agrupar visualmente los vinos según su cultivar de origen basándonos exclusivamente en su composición química, sin utilizar la etiqueta cualitativa previa?

2. Preparación de los datos, promedios y covarianzas

Para garantizar un análisis riguroso, verificamos la estructura de los datos y calculamos las medidas de tendencia central y dispersión conjunta antes de cualquier transformación.

# Cargar librerías necesarias
library(readr)
library(corrplot)

# 1. Cargar datos y omitir valores nulos
BD_Wine <- read_csv("BD_Wine.xlsx - Wine.csv")
BD_Wine_limpia <- na.omit(BD_Wine)

# 2. Revisar la estructura de los datos
print("--- DIMENSIONES Y ESTRUCTURA ---")
## [1] "--- DIMENSIONES Y ESTRUCTURA ---"
dim(BD_Wine_limpia)
## [1] 178  14
str(BD_Wine_limpia)
## spc_tbl_ [178 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Alcohol              : num [1:178] 14.2 13.2 13.2 14.4 13.2 ...
##  $ Acido_malico         : num [1:178] 1.71 1.78 2.36 1.95 2.59 1.76 1.87 2.15 1.64 1.35 ...
##  $ Ceniza               : num [1:178] 2.43 2.14 2.67 2.5 2.87 2.45 2.45 2.61 2.17 2.27 ...
##  $ Ceniza_Alcalinidad   : num [1:178] 15.6 11.2 18.6 16.8 21 15.2 14.6 17.6 14 16 ...
##  $ Magnesio             : num [1:178] 127 100 101 113 118 112 96 121 97 98 ...
##  $ Total_fenoles        : num [1:178] 2.8 2.65 2.8 3.85 2.8 3.27 2.5 2.6 2.8 2.98 ...
##  $ Flavanoides          : num [1:178] 3.06 2.76 3.24 3.49 2.69 3.39 2.52 2.51 2.98 3.15 ...
##  $ Noflavanoides_fenoles: num [1:178] 0.28 0.26 0.3 0.24 0.39 0.34 0.3 0.31 0.29 0.22 ...
##  $ Proantocianinas      : num [1:178] 2.29 1.28 2.81 2.18 1.82 1.97 1.98 1.25 1.98 1.85 ...
##  $ intensidad_color     : num [1:178] 5.64 4.38 5.68 7.8 4.32 6.75 5.25 5.05 5.2 7.22 ...
##  $ Matiz                : num [1:178] 1.04 1.05 1.03 0.86 1.04 1.05 1.02 1.06 1.08 1.01 ...
##  $ OD280                : num [1:178] 3.92 3.4 3.17 3.45 2.93 2.85 3.58 3.58 2.85 3.55 ...
##  $ Prolina              : num [1:178] 1065 1050 1185 1480 735 ...
##  $ Customer_Segment     : num [1:178] 1 1 1 1 1 1 1 1 1 1 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Alcohol = col_double(),
##   ..   Acido_malico = col_double(),
##   ..   Ceniza = col_double(),
##   ..   Ceniza_Alcalinidad = col_double(),
##   ..   Magnesio = col_double(),
##   ..   Total_fenoles = col_double(),
##   ..   Flavanoides = col_double(),
##   ..   Noflavanoides_fenoles = col_double(),
##   ..   Proantocianinas = col_double(),
##   ..   intensidad_color = col_double(),
##   ..   Matiz = col_double(),
##   ..   OD280 = col_double(),
##   ..   Prolina = col_double(),
##   ..   Customer_Segment = col_double()
##   .. )
##  - attr(*, "problems")=<pointer: 0x00000155a054bd10>
# 3. Aislar variables continuas
vinos_num <- BD_Wine_limpia[, 1:13]

# 4. Vector de promedios y Matriz de Covarianzas
print("--- VECTOR DE PROMEDIOS ---")
## [1] "--- VECTOR DE PROMEDIOS ---"
print(colMeans(vinos_num))
##               Alcohol          Acido_malico                Ceniza 
##            13.0006180             2.3363483             2.3665169 
##    Ceniza_Alcalinidad              Magnesio         Total_fenoles 
##            19.4949438            99.7415730             2.2951124 
##           Flavanoides Noflavanoides_fenoles       Proantocianinas 
##             2.0292697             0.3618539             1.5908989 
##      intensidad_color                 Matiz                 OD280 
##             5.0580899             0.9574494             2.6116854 
##               Prolina 
##           746.8932584
print("--- MATRIZ DE VARIANZAS-COVARIANZAS ---")
## [1] "--- MATRIZ DE VARIANZAS-COVARIANZAS ---"
print(cov(vinos_num))
##                            Alcohol Acido_malico        Ceniza
## Alcohol                 0.65906233   0.08561131  0.0471151590
## Acido_malico            0.08561131   1.24801540  0.0502770393
## Ceniza                  0.04711516   0.05027704  0.0752646353
## Ceniza_Alcalinidad     -0.84109290   1.07633171  0.4062082778
## Magnesio                3.13987812  -0.87077953  1.1229365835
## Total_fenoles           0.14688722  -0.23433772  0.0221455913
## Flavanoides             0.19203322  -0.45863037  0.0315347299
## Noflavanoides_fenoles  -0.01575426   0.04073336  0.0063584714
## Proantocianinas         0.06351752  -0.14114698  0.0015155780
## intensidad_color        1.02828254   0.64483818  0.1646543266
## Matiz                  -0.01331344  -0.14332564 -0.0046821545
## OD280                   0.04169782  -0.29244748  0.0007618358
## Prolina               164.56718498 -67.54886657 19.3197390973
##                       Ceniza_Alcalinidad     Magnesio Total_fenoles
## Alcohol                       -0.8410929    3.1398781    0.14688722
## Acido_malico                   1.0763317   -0.8707795   -0.23433772
## Ceniza                         0.4062083    1.1229366    0.02214559
## Ceniza_Alcalinidad            11.1526862   -3.9747604   -0.67114915
## Magnesio                      -3.9747604  203.9893354    1.91646988
## Total_fenoles                 -0.6711491    1.9164699    0.39168954
## Flavanoides                   -1.1720828    2.7930870    0.54047042
## Noflavanoides_fenoles          0.1504219   -0.4555634   -0.03504512
## Proantocianinas               -0.3771762    1.9328325    0.21937334
## intensidad_color               0.1450242    6.6205206   -0.07999752
## Matiz                         -0.2091181    0.1808513    0.06203888
## OD280                         -0.6562344    0.6693081    0.31102128
## Prolina                     -463.3553450 1769.1586999   98.17105726
##                        Flavanoides Noflavanoides_fenoles Proantocianinas
## Alcohol                 0.19203322          -0.015754260     0.063517520
## Acido_malico           -0.45863037           0.040733362    -0.141146982
## Ceniza                  0.03153473           0.006358471     0.001515578
## Ceniza_Alcalinidad     -1.17208281           0.150421856    -0.377176220
## Magnesio                2.79308703          -0.455563385     1.932832476
## Total_fenoles           0.54047042          -0.035045125     0.219373345
## Flavanoides             0.99771867          -0.066867000     0.373147553
## Noflavanoides_fenoles  -0.06686700           0.015488634    -0.026059868
## Proantocianinas         0.37314755          -0.026059868     0.327594668
## intensidad_color       -0.39916863           0.040120510    -0.033503918
## Matiz                   0.12408197          -0.007471177     0.038664565
## OD280                   0.55826225          -0.044469244     0.210932940
## Prolina               155.44749222         -12.203586301    59.554333778
##                       intensidad_color        Matiz         OD280     Prolina
## Alcohol                     1.02828254 -0.013313443  0.0416978226   164.56718
## Acido_malico                0.64483818 -0.143325638 -0.2924474830   -67.54887
## Ceniza                      0.16465433 -0.004682155  0.0007618358    19.31974
## Ceniza_Alcalinidad          0.14502419 -0.209118054 -0.6562343681  -463.35535
## Magnesio                    6.62052061  0.180851266  0.6693080683  1769.15870
## Total_fenoles              -0.07999752  0.062038876  0.3110212785    98.17106
## Flavanoides                -0.39916863  0.124081969  0.5582622548   155.44749
## Noflavanoides_fenoles       0.04012051 -0.007471177 -0.0444692440   -12.20359
## Proantocianinas            -0.03350392  0.038664565  0.2109329398    59.55433
## intensidad_color            5.37444938 -0.276505801 -0.7058125762   230.76748
## Matiz                      -0.27650580  0.052244961  0.0917662439    17.00022
## OD280                      -0.70581258  0.091766244  0.5040864089    69.92753
## Prolina                   230.76748014 17.000223386 69.9275255507 99166.71736
# 5. Escalar los datos y generar Matriz de Correlaciones
vinos_escalados <- scale(vinos_num)
matriz_cor <- cor(vinos_escalados)

corrplot(matriz_cor, method = "color", type = "upper", 
         addCoef.col = "black", tl.col = "black", tl.srt = 45, 
         number.cex = 0.5, title = "Correlación de Variables Químicas",
         mar = c(0,0,1,0))

Análisis de Promedios, Covarianzas y Justificación del ACP:

3. Eigenvalores y Varianza Explicada

En esta sección ejecutamos el Análisis de Componentes Principales. A partir de las 13 variables químicas originales, el algoritmo calcula los autovectores y autovalores (eigenvalores) para crear nuevas dimensiones que condensen la varianza.

# Cargar librerías para ACP y visualización (instálalas en tu consola si no las tienes)
library(FactoMineR)
library(factoextra)

# 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(vinos_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) ---"
print(head(eigenvalores))
##       eigenvalue variance.percent cumulative.variance.percent
## Dim.1  4.7058503        36.198848                    36.19885
## Dim.2  2.4969737        19.207490                    55.40634
## Dim.3  1.4460720        11.123631                    66.52997
## Dim.4  0.9189739         7.069030                    73.59900
## Dim.5  0.8532282         6.563294                    80.16229
# 3. Gráfico de Sedimentación (Scree plot)
fviz_eig(res.pca, addlabels = TRUE, ylim = c(0, 50),
         main = "Gráfico de Sedimentación (Scree Plot)",
         xlab = "Componentes Principales",
         ylab = "Porcentaje de Varianza Explicada",
         barfill = "steelblue", barcolor = "black")

Análisis de Eigenvalores y Justificación de Retención:

Para determinar el número óptimo de componentes principales a conservar, nos basamos en el Criterio de Kaiser. Este criterio establece que un eigenvalor \(\lambda_i > 1\) indica que ese nuevo componente representa más varianza que la contabilizada por una sola de las variables originales estandarizadas.

Al observar los resultados numéricos y el gráfico de sedimentación:

Si evaluamos el criterio de Kaiser (\(\lambda > 1\)), observamos que únicamente las primeras tres dimensiones superan este umbral (sus eigenvalores son mayores a 1). Por lo tanto, se justifica retener los primeros 3 componentes principales, los cuales en conjunto logran explicar una varianza acumulada cercana al 66.5%. Esto significa que hemos logrado reducir la dimensionalidad de 13 variables químicas a solo 3 dimensiones, perdiendo apenas una tercera parte de la información original, cumpliendo así el objetivo del análisis multivariado.

4. Proyección y análisis de individuos

En esta etapa, proyectamos las 178 muestras de vino sobre el nuevo plano bidimensional. Para evaluar si el modelo logra clasificar los vinos naturalmente por su química, coloreamos los puntos según su cultivar de origen (Customer_Segment).

library(factoextra)

# 1. Gráfico de Individuos coloreado por Cultivar
fviz_pca_ind(res.pca,
             geom.ind = "point", # Puntos en lugar de texto para evitar amontonamiento
             col.ind = as.factor(BD_Wine_limpia$Customer_Segment), 
             palette = c("#00AFBB", "#E7B800", "#FC4E07"),
             addEllipses = TRUE, 
             legend.title = "Cultivar",
             title = "Mapa de Individuos (PCA) agrupado por Cultivar")

# 2. Gráfico de los individuos que más contribuyen al modelo
fviz_contrib(res.pca, choice = "ind", axes = 1:2, top = 15, 
             fill = "darkgreen", color = "black", 
             title = "Top 15 Vinos con mayor contribución (Dim 1 y 2)")

# 3. Resultados Numéricos: Top 5 individuos por Dimensión
print("--- TOP 5 VINOS CON MAYOR CONTRIBUCIÓN (DIM 1) ---")
## [1] "--- TOP 5 VINOS CON MAYOR CONTRIBUCIÓN (DIM 1) ---"
head(sort(res.pca$ind$contrib[, 1], decreasing = TRUE), 5)
##       15      147      138      137        4 
## 2.220533 2.187555 1.849926 1.830512 1.685153
print("--- TOP 5 VINOS CON MAYOR CONTRIBUCIÓN (DIM 2) ---")
## [1] "--- TOP 5 VINOS CON MAYOR CONTRIBUCIÓN (DIM 2) ---"
head(sort(res.pca$ind$contrib[, 2], decreasing = TRUE), 5)
##      116      159       81       60      117 
## 3.372782 2.779962 2.562875 2.125341 1.791116

Análisis Numérico y Gráfico de Individuos:

Agrupación y Clasificación: El gráfico demuestra que el Análisis de Componentes Principales es altamente efectivo. Aunque el algoritmo nunca “supo” a qué cultivar pertenecía cada vino, logró agrupar las muestras en tres clústeres bien definidos con superposición mínima. Los vinos del Cultivar 1 y del Cultivar 3 se separan perfectamente a lo largo del eje horizontal (Dim 1), mientras que los del Cultivar 2 se ubican al centro pero varían sobre el eje vertical (Dim 2).

Individuos Sobresalientes (Atípicos): Al revisar los resultados numéricos y las barras de contribución, detectamos botellas específicas que definen la variabilidad del modelo debido a sus perfiles químicos extremos:

6. Proyección de Individuos

En esta etapa, proyectamos las 178 muestras de vino sobre el nuevo plano bidimensional creado por la Dimensión 1 y la Dimensión 2. Para evaluar si el modelo logra clasificar los vinos naturalmente por su química, coloreamos los puntos según su cultivar de origen (Customer_Segment).

# 1. Gráfico de Individuos coloreado por Cultivar
fviz_pca_ind(res.pca,
             geom.ind = "point", # Muestra puntos en lugar de texto para evitar amontonamiento
             col.ind = as.factor(BD_Wine_limpia$Customer_Segment), # Variable de agrupación
             palette = c("#00AFBB", "#E7B800", "#FC4E07"),
             addEllipses = TRUE, # Agrega elipses de confianza alrededor de los grupos
             legend.title = "Cultivar",
             title = "Mapa de Individuos (PCA) agrupado por Cultivar")

# 2. Identificar los individuos (vinos) que más contribuyen al modelo
fviz_contrib(res.pca, choice = "ind", axes = 1:2, top = 15, 
             fill = "darkgreen", color = "black", 
             title = "Top 15 Vinos con mayor contribución (Dim 1 y 2)")

Análisis del gráfico de Individuos:

5. Integración de Resultados y Conclusiones

La articulación de la evidencia numérica y gráfica obtenida a través de este Análisis de Componentes Principales nos permite derivar conclusiones sólidas y responder a las interrogantes planteadas al inicio del estudio:

Conclusión final: El Análisis de Componentes Principales no solo permitió simplificar la complejidad analítica de la base de datos eliminando el ruido estadístico, sino que expuso de forma exitosa la estructura subyacente de los datos. Queda demostrado que la huella fisicoquímica y multivariada de un vino es lo suficientemente robusta como para identificar y clasificar visualmente el cultivar de origen de la planta.