Segmentación (Clustering) Vinos

Contexto.

La segmentación o clusters es un conjunto de técnicas cuyo proposito es formar grupos apartir de elementos,

Estos datos son el resultado de un análisis químico de vinos cultivados en la región de Italia. Para este analisis se tomaron en cuenta diversos factores como el alcohol, el color, entre otros.

Más información:
Descripción de la base de datos ‘Vinos’

Pasos.

Paso 1

PInstalar 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)

Paso 2

Obtener los datos.

library(readr)
wine <- read_csv("C:\\Users\\LuisD\\Documents\\Concentración\\wine.csv")

## Rows: 178 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (13): Alcohol, Malic_Acid, Ash, Ash_Alcanity, Magnesium, Total_Phenols, ...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

#View(wine)
head(wine)

## # A tibble: 6 × 13
##   Alcohol Malic_Acid   Ash Ash_Alcanity Magnesium Total_Phenols Flavanoids
##     <dbl>      <dbl> <dbl>        <dbl>     <dbl>         <dbl>      <dbl>
## 1    14.2       1.71  2.43         15.6       127          2.8        3.06
## 2    13.2       1.78  2.14         11.2       100          2.65       2.76
## 3    13.2       2.36  2.67         18.6       101          2.8        3.24
## 4    14.4       1.95  2.5          16.8       113          3.85       3.49
## 5    13.2       2.59  2.87         21         118          2.8        2.69
## 6    14.2       1.76  2.45         15.2       112          3.27       3.39
## # ℹ 6 more variables: Nonflavanoid_Phenols <dbl>, Proanthocyanins <dbl>,
## #   Color_Intensity <dbl>, Hue <dbl>, OD280 <dbl>, Proline <dbl>

Paso 3

Conociendo nuestros datos.

str(wine)

## spc_tbl_ [178 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Alcohol             : num [1:178] 14.2 13.2 13.2 14.4 13.2 ...
##  $ Malic_Acid          : num [1:178] 1.71 1.78 2.36 1.95 2.59 1.76 1.87 2.15 1.64 1.35 ...
##  $ Ash                 : num [1:178] 2.43 2.14 2.67 2.5 2.87 2.45 2.45 2.61 2.17 2.27 ...
##  $ Ash_Alcanity        : num [1:178] 15.6 11.2 18.6 16.8 21 15.2 14.6 17.6 14 16 ...
##  $ Magnesium           : num [1:178] 127 100 101 113 118 112 96 121 97 98 ...
##  $ Total_Phenols       : num [1:178] 2.8 2.65 2.8 3.85 2.8 3.27 2.5 2.6 2.8 2.98 ...
##  $ Flavanoids          : num [1:178] 3.06 2.76 3.24 3.49 2.69 3.39 2.52 2.51 2.98 3.15 ...
##  $ Nonflavanoid_Phenols: num [1:178] 0.28 0.26 0.3 0.24 0.39 0.34 0.3 0.31 0.29 0.22 ...
##  $ Proanthocyanins     : num [1:178] 2.29 1.28 2.81 2.18 1.82 1.97 1.98 1.25 1.98 1.85 ...
##  $ Color_Intensity     : num [1:178] 5.64 4.38 5.68 7.8 4.32 6.75 5.25 5.05 5.2 7.22 ...
##  $ Hue                 : 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 ...
##  $ Proline             : num [1:178] 1065 1050 1185 1480 735 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Alcohol = col_double(),
##   ..   Malic_Acid = col_double(),
##   ..   Ash = col_double(),
##   ..   Ash_Alcanity = col_double(),
##   ..   Magnesium = col_double(),
##   ..   Total_Phenols = col_double(),
##   ..   Flavanoids = col_double(),
##   ..   Nonflavanoid_Phenols = col_double(),
##   ..   Proanthocyanins = col_double(),
##   ..   Color_Intensity = col_double(),
##   ..   Hue = col_double(),
##   ..   OD280 = col_double(),
##   ..   Proline = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>

summary(wine)

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

nulos<- colSums(is.na(wine))
nulos

##              Alcohol           Malic_Acid                  Ash 
##                    0                    0                    0 
##         Ash_Alcanity            Magnesium        Total_Phenols 
##                    0                    0                    0 
##           Flavanoids Nonflavanoid_Phenols      Proanthocyanins 
##                    0                    0                    0 
##      Color_Intensity                  Hue                OD280 
##                    0                    0                    0 
##              Proline 
##                    0

Paso 4

Escalar los datos.

scaled_wine <- scale(wine) #para escalar los datos

Paso 5

Asignar una cantidad de grupos.

grupos <- 3 #Numero de grupos random

Paso 6

Generar los segmentos.

segmentos <- kmeans(scaled_wine,grupos)
segmentos

## K-means clustering with 3 clusters of sizes 65, 62, 51
## 
## 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.8328826 -0.3029551  0.3636801   -0.6084749  0.57596208    0.88274724
## 3  0.1644436  0.8690954  0.1863726    0.5228924 -0.07526047   -0.97657548
##    Flavanoids Nonflavanoid_Phenols Proanthocyanins Color_Intensity        Hue
## 1  0.02075402          -0.03343924      0.05810161      -0.8993770  0.4605046
## 2  0.97506900          -0.56050853      0.57865427       0.1705823  0.4726504
## 3 -1.21182921           0.72402116     -0.77751312       0.9388902 -1.1615122
##        OD280    Proline
## 1  0.2700025 -0.7517257
## 2  0.7770551  1.1220202
## 3 -1.2887761 -0.4059428
## 
## Clustering vector:
##   [1] 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 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 3 1 1 1 1 1 1 1 1 1 1 1 2
##  [75] 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [112] 1 1 1 1 1 1 1 3 1 1 2 1 1 1 1 1 1 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
## [149] 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
## 
## Within cluster sum of squares by cluster:
## [1] 558.6971 385.6983 326.3537
##  (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(wine, cluster = segmentos$cluster)
head(asignacion)

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

#asignacion

Paso 8

Graficar los clusters.

fviz_cluster(segmentos, data=scaled_wine)

Paso 9

Optimizar el cantidad de grupos.

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

set.seed(123)
optimizacion <- clusGap(scaled_wine, FUN = kmeans, nstart=1, K.max = 10)
plot(optimizacion, xlab= 'Número de clusters k')

Nos indica la gráfica que el punto de cluster más alto que existe es de 8, así que cambiamos nuestro número de grupos en la parte de arriba.

Paso 10

Comparación de segmentos.

cluster_prom <- aggregate(. ~ cluster, data=asignacion, FUN=mean)
cluster_prom

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

Conclusión.

Dentro de nuestro df se pudieron identificar 3 tipos de clusters distintos:

Clúster 1: Los vinos en este cluster tienen niveles relativamente altos de alcohol y ácido málico en comparación con los otros clusters. También tienen una alcalinidad de las cenizas más alta. Sin embargo, tienen niveles bajos de fenoles totales, flavonoides, proantocianidinas y color de intensidad. Tienen un tono de color más claro y una concentración de proline moderada.

Clúster 2: Los vinos en este cluster tienen un nivel moderado de alcohol y ácido málico. La alcalinidad de las cenizas es relativamente baja. Tienen los niveles más altos de fenoles totales, flavonoides, proantocianidinas y color de intensidad entre los tres clusters. Tienen un color más intenso y una concentración de proline más alta.

Clúster 3: Los vinos en este cluster tienen los niveles más bajos de alcohol y ácido málico. La alcalinidad de las cenizas está en el rango intermedio. Tienen niveles moderados de fenoles totales, flavonoides y proantocianidinas. Tienen el color de intensidad más bajo entre los tres clusters y una concentración de proline moderada..