Clustering-Vinos

Contexto

Estos datos son el resultado de un análisis químico de vinos cultivados en la misma región de Italia, pero derivados de tres cultivares diferentes.

El análisis determinó las cantidades de 13 componentes que se encuentran en cada uno de los tres cultivares.

Paso 1. Instalar paquetes y llamar librerías

#install.packeges("cluster") #Análisis de Agrupamiento
library(cluster)
#install.packeges("ggplot2") #Graficar
library(ggplot2)
#install.packeges("data.table") #Manejo de muchos datos
library(data.table)
#install.packages("factoextra") #Grafica optimización de número de clusters
library(factoextra)

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

Paso 2. Obtener los datos

df1 <- read.csv("/Users/antoniodiaz/Desktop/MODULO2/wine.csv")

Paso 3. Entender los datos

summary(df1)

##     Alcohol        Malic_Acid         Ash         Ash_Alcanity  
##  Min.   :11.03   Min.   :0.740   Min.   :1.360   Min.   :10.60  
##  1st Qu.:12.36   1st Qu.:1.603   1st Qu.:2.210   1st Qu.:17.20  
##  Median :13.05   Median :1.865   Median :2.360   Median :19.50  
##  Mean   :13.00   Mean   :2.336   Mean   :2.367   Mean   :19.49  
##  3rd Qu.:13.68   3rd Qu.:3.083   3rd Qu.:2.558   3rd Qu.:21.50  
##  Max.   :14.83   Max.   :5.800   Max.   :3.230   Max.   :30.00  
##    Magnesium      Total_Phenols     Flavanoids    Nonflavanoid_Phenols
##  Min.   : 70.00   Min.   :0.980   Min.   :0.340   Min.   :0.1300      
##  1st Qu.: 88.00   1st Qu.:1.742   1st Qu.:1.205   1st Qu.:0.2700      
##  Median : 98.00   Median :2.355   Median :2.135   Median :0.3400      
##  Mean   : 99.74   Mean   :2.295   Mean   :2.029   Mean   :0.3619      
##  3rd Qu.:107.00   3rd Qu.:2.800   3rd Qu.:2.875   3rd Qu.:0.4375      
##  Max.   :162.00   Max.   :3.880   Max.   :5.080   Max.   :0.6600      
##  Proanthocyanins Color_Intensity       Hue             OD280      
##  Min.   :0.410   Min.   : 1.280   Min.   :0.4800   Min.   :1.270  
##  1st Qu.:1.250   1st Qu.: 3.220   1st Qu.:0.7825   1st Qu.:1.938  
##  Median :1.555   Median : 4.690   Median :0.9650   Median :2.780  
##  Mean   :1.591   Mean   : 5.058   Mean   :0.9574   Mean   :2.612  
##  3rd Qu.:1.950   3rd Qu.: 6.200   3rd Qu.:1.1200   3rd Qu.:3.170  
##  Max.   :3.580   Max.   :13.000   Max.   :1.7100   Max.   :4.000  
##     Proline      
##  Min.   : 278.0  
##  1st Qu.: 500.5  
##  Median : 673.5  
##  Mean   : 746.9  
##  3rd Qu.: 985.0  
##  Max.   :1680.0

str(df1)

## 'data.frame':    178 obs. of  13 variables:
##  $ Alcohol             : num  14.2 13.2 13.2 14.4 13.2 ...
##  $ Malic_Acid          : num  1.71 1.78 2.36 1.95 2.59 1.76 1.87 2.15 1.64 1.35 ...
##  $ Ash                 : num  2.43 2.14 2.67 2.5 2.87 2.45 2.45 2.61 2.17 2.27 ...
##  $ Ash_Alcanity        : num  15.6 11.2 18.6 16.8 21 15.2 14.6 17.6 14 16 ...
##  $ Magnesium           : int  127 100 101 113 118 112 96 121 97 98 ...
##  $ Total_Phenols       : num  2.8 2.65 2.8 3.85 2.8 3.27 2.5 2.6 2.8 2.98 ...
##  $ Flavanoids          : num  3.06 2.76 3.24 3.49 2.69 3.39 2.52 2.51 2.98 3.15 ...
##  $ Nonflavanoid_Phenols: num  0.28 0.26 0.3 0.24 0.39 0.34 0.3 0.31 0.29 0.22 ...
##  $ Proanthocyanins     : num  2.29 1.28 2.81 2.18 1.82 1.97 1.98 1.25 1.98 1.85 ...
##  $ Color_Intensity     : num  5.64 4.38 5.68 7.8 4.32 6.75 5.25 5.05 5.2 7.22 ...
##  $ Hue                 : num  1.04 1.05 1.03 0.86 1.04 1.05 1.02 1.06 1.08 1.01 ...
##  $ OD280               : num  3.92 3.4 3.17 3.45 2.93 2.85 3.58 3.58 2.85 3.55 ...
##  $ Proline             : int  1065 1050 1185 1480 735 1450 1290 1295 1045 1045 ...

Paso 4. Seleccionar numéricas y escalar

num_vars <- df1[ , sapply(df1, is.numeric)]  # solo columnas numéricas
X <- scale(num_vars)                         # estandariza (media=0, sd=1)
dim(X)                                       # debería ser 178 x 13

## [1] 178  13

Paso 5. Determinar número de clusters

set.seed(123)

# Codo (WSS)
fviz_nbclust(X, kmeans, method = "wss") + ggtitle("Codo (WSS)")

# Silhouette medio
fviz_nbclust(X, kmeans, method = "silhouette") + ggtitle("Silhouette")

# Gap Statistic (con regla 1-SE para k)
gap <- clusGap(
  X,
  FUNcluster = function(x, k) kmeans(x, centers = k, nstart = 25),
  K.max = 10,
  B = 50
)
plot(gap, xlab = "k", ylab = "Gap", main = "Gap Statistic")

fviz_gap_stat(gap)

# k óptimo: menor k dentro de 1 SE del máximo (regla 1-SE)
k_opt <- cluster::maxSE(gap$Tab[,"gap"], gap$Tab[,"SE.sim"], method = "firstSEmax")
k_opt

## [1] 3

Paso 6: Generar los grupos

set.seed(123)
km3 <- kmeans(X, centers = 3, nstart = 50, algorithm = "Hartigan-Wong")

km3$size   # cuántos vinos en cada cluster

## [1] 51 62 65

km3$centers  # centroides (en escala estandarizada)

##      Alcohol Malic_Acid        Ash Ash_Alcanity   Magnesium Total_Phenols
## 1  0.1644436  0.8690954  0.1863726    0.5228924 -0.07526047   -0.97657548
## 2  0.8328826 -0.3029551  0.3636801   -0.6084749  0.57596208    0.88274724
## 3 -0.9234669 -0.3929331 -0.4931257    0.1701220 -0.49032869   -0.07576891
##    Flavanoids Nonflavanoid_Phenols Proanthocyanins Color_Intensity        Hue
## 1 -1.21182921           0.72402116     -0.77751312       0.9388902 -1.1615122
## 2  0.97506900          -0.56050853      0.57865427       0.1705823  0.4726504
## 3  0.02075402          -0.03343924      0.05810161      -0.8993770  0.4605046
##        OD280    Proline
## 1 -1.2887761 -0.4059428
## 2  0.7770551  1.1220202
## 3  0.2700025 -0.7517257

Paso 7: Graficar los grupos

fviz_cluster(km3, data = X) + ggtitle("Clusters k-means (k=3)")

Paso 8: Agregar clusters al dataset original y guardar

wine <- df1

# Agregar la columna de clusters
wine$cluster <- km3$cluster

# Guardar dataset con clusters en un CSV
write.csv(wine, "wine_clusters.csv", row.names = FALSE)

# (Opcional) Revisar distribución y medias de cada cluster
table(wine$cluster)

## 
##  1  2  3 
## 51 62 65

aggregate(. ~ cluster, data = wine, mean)

##   cluster  Alcohol Malic_Acid      Ash Ash_Alcanity Magnesium Total_Phenols
## 1       1 13.13412   3.307255 2.417647     21.24118  98.66667      1.683922
## 2       2 13.67677   1.997903 2.466290     17.46290 107.96774      2.847581
## 3       3 12.25092   1.897385 2.231231     20.06308  92.73846      2.247692
##   Flavanoids Nonflavanoid_Phenols Proanthocyanins Color_Intensity       Hue
## 1  0.8188235            0.4519608        1.145882        7.234706 0.6919608
## 2  3.0032258            0.2920968        1.922097        5.453548 1.0654839
## 3  2.0500000            0.3576923        1.624154        2.973077 1.0627077
##      OD280   Proline
## 1 1.696667  619.0588
## 2 3.163387 1100.2258
## 3 2.803385  510.1692

Paso 9: Centros en escala original

centros_original <- sweep(km3$centers, 2, attr(X, "scaled:scale"), "*")
centros_original <- sweep(centros_original, 2, attr(X, "scaled:center"), "+")
round(centros_original, 3)

##   Alcohol Malic_Acid   Ash Ash_Alcanity Magnesium Total_Phenols Flavanoids
## 1  13.134      3.307 2.418       21.241    98.667         1.684      0.819
## 2  13.677      1.998 2.466       17.463   107.968         2.848      3.003
## 3  12.251      1.897 2.231       20.063    92.738         2.248      2.050
##   Nonflavanoid_Phenols Proanthocyanins Color_Intensity   Hue OD280  Proline
## 1                0.452           1.146           7.235 0.692 1.697  619.059
## 2                0.292           1.922           5.454 1.065 3.163 1100.226
## 3                0.358           1.624           2.973 1.063 2.803  510.169

Paso 10: Conclusiones

La técnico de clustering permite identificar patrones o grupos naturales en los datos sin necesidade de etiquetas previas.