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?
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:
Promedios y varianzas: Al analizar el vector de promedios, observamos una disparidad masiva en las escalas de medición. La Prolina tiene un promedio altísimo (746.89), seguida del Magnesio (99.74), mientras que compuestos como los Fenoles no flavanoides apenas promedian 0.36. La matriz de varianzas-covarianzas confirma esta gran magnitud de dispersión en la Prolina. Esto demuestra que es estrictamente necesario estandarizar los datos (scale()), ya que, de no hacerlo, el ACP le daría todo el peso a la Prolina simplemente por tener números más grandes, opacando al resto de los químicos.
Correlaciones y adecuación del ACP: Al observar la gráfica de calor (corrplot), detectamos una evidente multicolinealidad. Existe una fuerte correlación positiva entre los Flavanoides y el Total de Fenoles (0.86), y una correlación negativa moderada entre la Intensidad de Color y el Matiz (-0.52). Estas altas asociaciones demuestran que hay información redundante, lo que justifica plenamente la adecuación del Análisis de Componentes Principales para condensar estas variables en dimensiones menores.
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:
El Componente 1 (Dim. 1) es el más importante, capturando aproximadamente el 36.2% de la varianza total de los datos.
El Componente 2 (Dim. 2) captura un 19.2% adicional.
El Componente 3 (Dim. 3) captura un 11.1%.
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.
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:
En la Dimensión 1 (asociada a los fenoles), destacan fuertemente los vinos 15, 147 y 138. Al verlos en el mapa, estas botellas se ubican en los extremos más alejados del eje X, lo que indica que tienen concentraciones inusualmente altas (o bajas) de flavanoides y antioxidantes frente al promedio de su cultivar.
En la Dimensión 2 (asociada a color y prolina), sobresalen los vinos 116 y 159. Visualmente, estos puntos “jalan” la gráfica hacia arriba o hacia abajo, apartándose de las elipses de confianza de su grupo, lo que sugiere niveles atípicos de intensidad de color o magnesio.
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:
Agrupación y Separació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 durante los cálculos químicos, logró agrupar las muestras en tres conglomerados (clústeres) bien definidos con una superposición mínima.
Distribución en los Ejes: Los vinos del Cultivar 1 y del Cultivar 3 se separan perfectamente a lo largo del eje horizontal (Dim 1). Los vinos del Cultivar 2 se sitúan en el centro horizontal, pero se separan verticalmente a lo largo de la Dimensión 2.
Individuos Sobresalientes (Atípicos/Extremos): Al observar la gráfica de contribuciones de los individuos, ciertas muestras (representadas por el número de su fila en la base de datos) destacan notablemente por encima de la línea promedio punteada roja. Estas botellas de vino poseen concentraciones químicas extremas que “jalan” los ejes y definen la varianza del modelo. En el mapa de individuos, estos vinos son los puntos que se alejan más del centro geométrico de sus respectivas elipses.
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.