Segmentación de Vinos

• Luis Angel Elizondo Gallegos A01198186
• Emilio Martínez de la Torre A01177730
• Héctor Guadalupe de la Garza Treviño A01177960
• Gilberto Menchaca A01177899

Contexto

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

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

• Alcohol: El contenido de alcohol en el vino, que se refiere a la cantidad de etanol presente.

• Ácido Málico (Malic Acid): Un ácido orgánico que contribuye a la acidez del vino.

• Ceniza (Ash): La cantidad de residuo mineral después de la combustión, que puede incluir minerales presentes en el suelo de los viñedos.

• Alcalinidad de la Ceniza (Ash_Alcanity): La alcalinidad de la ceniza, que puede afectar la percepción del sabor del vino.

• Magnesio: Cantidad del mineral Magnesio. Este puede influir en el sabor y la estructura del vino.

• Fenoles Totales (Total Phenols): Compuestos químicos que incluyen antioxidantes y otros compuestos beneficiosos para la salud presentes en la piel y semillas de las uvas.

• Flavonoides: Otro grupo de compuestos antioxidantes que contribuyen a la estructura y color del vino.

• Nonflavanoid_Phenols: Compuestos que contribuyen al sabor y astringencia del vino, no son flavonoides.

• Proanthocyanins: Compuestos fenólicos que aportan astringencia y antioxidantes al vino, presentes en piel y semillas de uvas.

• Color_Intensity: Profundidad del color del vino, indica concentración de pigmentos.

• Hue: Tonalidad del color del vino, muestra matices como rojo, morado o naranja.

• OD280: Medida de absorbancia óptica, relacionada con la concentración de compuestos como los fenoles.

• Proline: Aminoácido presente en el vino, indicativo de la madurez de uvas y fermentación.

Fuente: Wine dataset

Paso 1. Instalar paquetes y llamar librerías

#install.packages("cluster")
library(cluster)
#install.packages("ggplot2")
library(ggplot2)
#install.packages("data.table")
library(data.table)
#install.packages("factoextra")
library(factoextra)

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

Paso 2. Obtener los datos

library(readxl)
datos <- read_excel("/Users/hectordelagarzatrevino/Library/CloudStorage/GoogleDrive-a01177960@tec.mx/Mi unidad/LIT/Sexto semestre/Inteligencia Artificial con Impacto Empresarial/Modulo 2/Sesion 1/wine.xlsx")
summary(datos)

##     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

Paso 3. Escalar las variables

df <- scale(datos)

Paso 4. Optimizar la cantidad de grupos

La cantidad óptima de grupos corresponde al punto más alto de la siguiente gráfica:

set.seed(123)

optimizacion <- clusGap(df, FUN=kmeans, nstart=1, K.max = 8)
plot(optimizacion, xlab = "Número de clusters k")

Paso 5. Cantidad de grupos

El número más óptimo fue 3 grupos.

grupos <- 3

Paso 6. Generar los segmentos

segmentos <- kmeans(df, grupos)
segmentos

## K-means clustering with 3 clusters of sizes 65, 51, 62
## 
## Cluster means:
##      Alcohol Malic_Acid        Ash Ash_Alcanity   Magnesium Total_Phenols
## 1 -0.9234669 -0.3929331 -0.4931257    0.1701220 -0.49032869   -0.07576891
## 2  0.1644436  0.8690954  0.1863726    0.5228924 -0.07526047   -0.97657548
## 3  0.8328826 -0.3029551  0.3636801   -0.6084749  0.57596208    0.88274724
##    Flavanoids Nonflavanoid_Phenols Proanthocyanins Color_Intensity        Hue
## 1  0.02075402          -0.03343924      0.05810161      -0.8993770  0.4605046
## 2 -1.21182921           0.72402116     -0.77751312       0.9388902 -1.1615122
## 3  0.97506900          -0.56050853      0.57865427       0.1705823  0.4726504
##        OD280    Proline
## 1  0.2700025 -0.7517257
## 2 -1.2887761 -0.4059428
## 3  0.7770551  1.1220202
## 
## Clustering vector:
##   [1] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
##  [38] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 2 1 1 1 1 1 1 1 1 1 1 1 3
##  [75] 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [112] 1 1 1 1 1 1 1 2 1 1 3 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [149] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## 
## Within cluster sum of squares by cluster:
## [1] 558.6971 326.3537 385.6983
##  (between_SS / total_SS =  44.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Paso 7. Asignar el grupo al que pertenece cada observación

asignacion <- cbind(cluster = segmentos$cluster, datos)
head(asignacion)

##   cluster Alcohol Malic_Acid  Ash Ash_Alcanity Magnesium Total_Phenols
## 1       3   14.23       1.71 2.43         15.6       127          2.80
## 2       3   13.20       1.78 2.14         11.2       100          2.65
## 3       3   13.16       2.36 2.67         18.6       101          2.80
## 4       3   14.37       1.95 2.50         16.8       113          3.85
## 5       3   13.24       2.59 2.87         21.0       118          2.80
## 6       3   14.20       1.76 2.45         15.2       112          3.27
##   Flavanoids Nonflavanoid_Phenols Proanthocyanins Color_Intensity  Hue OD280
## 1       3.06                 0.28            2.29            5.64 1.04  3.92
## 2       2.76                 0.26            1.28            4.38 1.05  3.40
## 3       3.24                 0.30            2.81            5.68 1.03  3.17
## 4       3.49                 0.24            2.18            7.80 0.86  3.45
## 5       2.69                 0.39            1.82            4.32 1.04  2.93
## 6       3.39                 0.34            1.97            6.75 1.05  2.85
##   Proline
## 1    1065
## 2    1050
## 3    1185
## 4    1480
## 5     735
## 6    1450

#asignacion$cluster <- as.factor(asignacion$cluster)
#summary(asignacion$cluster)

Paso 8. Graficar los clusters

fviz_cluster(segmentos, data = datos)

Paso 9. Comparar segmentos

promedio <- aggregate(asignacion, by = list(asignacion$cluster), FUN=mean)
promedio

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

Conclusión

La segmentación o clusters es un algoritmo útil para identificar el cultivar correspondiente a cada vino.