CONTEXTO

El conjunto de datos de vinos sobre el que hemos estado discutiendo y planeando aplicar el análisis de KMeans es una colección de medidas químicas de diferentes vinos. Estos datos son típicamente utilizados para entender cómo las características químicas pueden influir en la calidad, el sabor, y otros aspectos sensoriales de los vinos. Al analizar estas propiedades, podemos buscar patrones o agrupaciones naturales que nos ayuden a categorizar los vinos de manera que refleje diferencias significativas en su composición.

Más información: Enología

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)
library(dplyr)

Paso 2. Obtener los datos

df2 = read.csv("C:\\Users\\Eduardo\\Downloads\\wine.csv")
df=scale(df2)
head(df)
##        Alcohol  Malic_Acid        Ash Ash_Alcanity  Magnesium Total_Phenols
## [1,] 1.5143408 -0.56066822  0.2313998   -1.1663032 1.90852151     0.8067217
## [2,] 0.2455968 -0.49800856 -0.8256672   -2.4838405 0.01809398     0.5670481
## [3,] 0.1963252  0.02117152  1.1062139   -0.2679823 0.08810981     0.8067217
## [4,] 1.6867914 -0.34583508  0.4865539   -0.8069748 0.92829983     2.4844372
## [5,] 0.2948684  0.22705328  1.8352256    0.4506745 1.27837900     0.8067217
## [6,] 1.4773871 -0.51591132  0.3043010   -1.2860793 0.85828399     1.5576991
##      Flavanoids Nonflavanoid_Phenols Proanthocyanins Color_Intensity        Hue
## [1,]  1.0319081           -0.6577078       1.2214385       0.2510088  0.3611585
## [2,]  0.7315653           -0.8184106      -0.5431887      -0.2924962  0.4049085
## [3,]  1.2121137           -0.4970050       2.1299594       0.2682629  0.3174085
## [4,]  1.4623994           -0.9791134       1.0292513       1.1827317 -0.4263410
## [5,]  0.6614853            0.2261576       0.4002753      -0.3183774  0.3611585
## [6,]  1.3622851           -0.1755994       0.6623487       0.7298108  0.4049085
##          OD280     Proline
## [1,] 1.8427215  1.01015939
## [2,] 1.1103172  0.96252635
## [3,] 0.7863692  1.39122370
## [4,] 1.1807407  2.32800680
## [5,] 0.4483365 -0.03776747
## [6,] 0.3356589  2.23274072

Paso 3. Entender la base de datos

summary(df)
##     Alcohol           Malic_Acid           Ash            Ash_Alcanity      
##  Min.   :-2.42739   Min.   :-1.4290   Min.   :-3.66881   Min.   :-2.663505  
##  1st Qu.:-0.78603   1st Qu.:-0.6569   1st Qu.:-0.57051   1st Qu.:-0.687199  
##  Median : 0.06083   Median :-0.4219   Median :-0.02375   Median : 0.001514  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.000000  
##  3rd Qu.: 0.83378   3rd Qu.: 0.6679   3rd Qu.: 0.69615   3rd Qu.: 0.600395  
##  Max.   : 2.25341   Max.   : 3.1004   Max.   : 3.14745   Max.   : 3.145637  
##    Magnesium       Total_Phenols        Flavanoids      Nonflavanoid_Phenols
##  Min.   :-2.0824   Min.   :-2.10132   Min.   :-1.6912   Min.   :-1.8630     
##  1st Qu.:-0.8221   1st Qu.:-0.88298   1st Qu.:-0.8252   1st Qu.:-0.7381     
##  Median :-0.1219   Median : 0.09569   Median : 0.1059   Median :-0.1756     
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000     
##  3rd Qu.: 0.5082   3rd Qu.: 0.80672   3rd Qu.: 0.8467   3rd Qu.: 0.6078     
##  Max.   : 4.3591   Max.   : 2.53237   Max.   : 3.0542   Max.   : 2.3956     
##  Proanthocyanins    Color_Intensity        Hue               OD280        
##  Min.   :-2.06321   Min.   :-1.6297   Min.   :-2.08884   Min.   :-1.8897  
##  1st Qu.:-0.59560   1st Qu.:-0.7929   1st Qu.:-0.76540   1st Qu.:-0.9496  
##  Median :-0.06272   Median :-0.1588   Median : 0.03303   Median : 0.2371  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.62741   3rd Qu.: 0.4926   3rd Qu.: 0.71116   3rd Qu.: 0.7864  
##  Max.   : 3.47527   Max.   : 3.4258   Max.   : 3.29241   Max.   : 1.9554  
##     Proline       
##  Min.   :-1.4890  
##  1st Qu.:-0.7824  
##  Median :-0.2331  
##  Mean   : 0.0000  
##  3rd Qu.: 0.7561  
##  Max.   : 2.9631
summary
## function (object, ...) 
## UseMethod("summary")
## <bytecode: 0x000001e2814e2d10>
## <environment: namespace:base>

Paso 4. Cantidad de grupos

grupos = 3

Paso 5. Generar los segmentos

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

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

asignacion <- cbind(df2, 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       1
## 2       1
## 3       1
## 4       1
## 5       1
## 6       1

Paso 7. Graficar los Clusters

fviz_cluster(segmentos, data=df)

Paso 8. Optimizar la cantidad de Grupos

La cantidad óptima de grupos corresponde al punto mas alto en la siguiente gráfica

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

Paso 9. Comparar Segmentos

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

Conclusión

Usamos KMeans con 3 grupos en nuestros datos de vinos para ver si podíamos encontrar patrones basados en sus químicos. La idea era ver si los vinos se podían separar de forma lógica, tal vez por tipo de uva o cómo se hacen. Esto nos puede ayudar a entender mejor cómo se diferencian los vinos y a identificar grupos con características similares.

La verdad es que cuánto nos sirva esto depende de si las medidas que usamos realmente muestran diferencias importantes entre los vinos. Dividirlos en 3 grupos nos da una forma sencilla de ver las cosas, útil para empezar a segmentar el mercado o definir tipos de vinos por su sabor. Pero para sacarle el jugo a este análisis, necesitamos mirar más de cerca qué tiene cada grupo y cómo se relaciona con lo que ya sabemos de vinos.

LS0tDQp0aXRsZTogIldpbmVzX0NsdXN0ZXJzIg0KYXV0aG9yOiAiRWR1YXJkbyBDYW1hY2hvIC0gQTAxMDI2NDM3LCBEYW5pZWwgTsOhamVyYSAtIEEwMTcwOTU3OCwgR2VyYXJkbyBDZWRpbGxvLCBBbGVqYW5kcmEgU3XDoXJleiAtIEEwMDgzNTI0NyINCmRhdGU6ICIyMDI0LTAyLTE5Ig0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQotLS0NCg0KIVtdKEM6XFVzZXJzXEVkdWFyZG9cRG93bmxvYWRzXFdpbmUuanBlZykNCg0KIyBDT05URVhUTw0KDQpFbCBjb25qdW50byBkZSBkYXRvcyBkZSAqKnZpbm9zKiogc29icmUgZWwgcXVlIGhlbW9zIGVzdGFkbyBkaXNjdXRpZW5kbyB5IHBsYW5lYW5kbyBhcGxpY2FyIGVsIGFuw6FsaXNpcyBkZSAqS01lYW5zKiBlcyB1bmEgY29sZWNjacOzbiBkZSBtZWRpZGFzIHF1w61taWNhcyBkZSBkaWZlcmVudGVzIHZpbm9zLiBFc3RvcyBkYXRvcyBzb24gdMOtcGljYW1lbnRlIHV0aWxpemFkb3MgcGFyYSBlbnRlbmRlciBjw7NtbyBsYXMgY2FyYWN0ZXLDrXN0aWNhcyBxdcOtbWljYXMgcHVlZGVuIGluZmx1aXIgZW4gbGEgY2FsaWRhZCwgZWwgc2Fib3IsIHkgb3Ryb3MgYXNwZWN0b3Mgc2Vuc29yaWFsZXMgZGUgbG9zIHZpbm9zLiBBbCBhbmFsaXphciBlc3RhcyBwcm9waWVkYWRlcywgcG9kZW1vcyBidXNjYXIgcGF0cm9uZXMgbyBhZ3J1cGFjaW9uZXMgbmF0dXJhbGVzIHF1ZSBub3MgYXl1ZGVuIGEgY2F0ZWdvcml6YXIgbG9zIHZpbm9zIGRlIG1hbmVyYSBxdWUgcmVmbGVqZSBkaWZlcmVuY2lhcyBzaWduaWZpY2F0aXZhcyBlbiBzdSBjb21wb3NpY2nDs24uDQoNCg0KTcOhcyBpbmZvcm1hY2nDs246IFtFbm9sb2fDrWFdKGh0dHBzOi8vc2VhcmNoLnItcHJvamVjdC5vcmcvQ1JBTi9yZWZtYW5zL0hEY2xhc3NpZi9odG1sL3dpbmUuaHRtbCkNCg0KIyBQYXNvIDEuIEluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYXMNCg0KYGBge3IsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9DQojaW5zdGFsbC5wYWNrYWdlcygnY2x1c3RlcicpDQpsaWJyYXJ5IChjbHVzdGVyKQ0KI2luc3RhbGwucGFja2FnZXMoJ2dncGxvdDInKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KI2luc3RhbGwucGFja2FnZXMoJ2RhdGEudGFibGUnKQ0KbGlicmFyeShkYXRhLnRhYmxlKQ0KI2luc3RhbGwucGFja2FnZXMoJ2ZhY3RvZXh0cmEnKQ0KbGlicmFyeShmYWN0b2V4dHJhKQ0KbGlicmFyeShkcGx5cikNCmBgYA0KDQojIFBhc28gMi4gT2J0ZW5lciBsb3MgZGF0b3MNCg0KYGBge3J9DQpkZjIgPSByZWFkLmNzdigiQzpcXFVzZXJzXFxFZHVhcmRvXFxEb3dubG9hZHNcXHdpbmUuY3N2IikNCmRmPXNjYWxlKGRmMikNCmhlYWQoZGYpDQpgYGANCg0KIyBQYXNvIDMuIEVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3MNCg0KYGBge3J9DQpzdW1tYXJ5KGRmKQ0Kc3VtbWFyeQ0KYGBgDQoNCiMgUGFzbyA0LiBDYW50aWRhZCBkZSBncnVwb3MNCg0KYGBge3J9DQpncnVwb3MgPSAzDQpgYGANCg0KIyBQYXNvIDUuIEdlbmVyYXIgbG9zIHNlZ21lbnRvcw0KDQpgYGB7cn0NCnNlZ21lbnRvcyA8LSBrbWVhbnMoZGYsZ3J1cG9zKQ0Kc2VnbWVudG9zDQpgYGANCg0KIyBQYXNvIDYuIEFzaWduYXIgZWwgZ3J1cG8gYWwgcXVlIHBlcnRlbmVjZSBjYWRhIG9ic2VydmFjacOzbg0KDQpgYGB7cn0NCmFzaWduYWNpb24gPC0gY2JpbmQoZGYyLCBjbHVzdGVyID0gc2VnbWVudG9zJGNsdXN0ZXIpDQpoZWFkKGFzaWduYWNpb24pDQpgYGANCg0KIyBQYXNvIDcuIEdyYWZpY2FyIGxvcyBDbHVzdGVycw0KDQpgYGB7cn0NCmZ2aXpfY2x1c3RlcihzZWdtZW50b3MsIGRhdGE9ZGYpDQpgYGANCg0KIyBQYXNvIDguIE9wdGltaXphciBsYSBjYW50aWRhZCBkZSBHcnVwb3MNCg0KTGEgY2FudGlkYWQgw7NwdGltYSBkZSBncnVwb3MgY29ycmVzcG9uZGUgYWwgcHVudG8gbWFzIGFsdG8gZW4gbGEgc2lndWllbnRlIGdyw6FmaWNhDQoNCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0Kb3B0aW1pemFjaW9uID0gY2x1c0dhcChkZiwgRlVOPWttZWFucywgbnN0YXJ0PTEsIEsubWF4PTEwKQ0KcGxvdChvcHRpbWl6YWNpb24sIHhsYWI9ICdOw7ptZXJvIGRlIGNsdXN0ZXJzIEsnKQ0KYGBgDQoNCiMgUGFzbyA5LiBDb21wYXJhciBTZWdtZW50b3MNCg0KYGBge3J9DQpwcm9tZWRpbyA9IGFnZ3JlZ2F0ZShhc2lnbmFjaW9uLCBieT1saXN0KGFzaWduYWNpb24kY2x1c3RlciksIEZVTj1tZWFuKQ0KcHJvbWVkaW8NCmBgYA0KDQoNCiMgQ29uY2x1c2nDs24NCg0KVXNhbW9zIEtNZWFucyBjb24gMyBncnVwb3MgZW4gbnVlc3Ryb3MgZGF0b3MgZGUgdmlub3MgcGFyYSB2ZXIgc2kgcG9kw61hbW9zIGVuY29udHJhciBwYXRyb25lcyBiYXNhZG9zIGVuIHN1cyBxdcOtbWljb3MuIExhIGlkZWEgZXJhIHZlciBzaSBsb3Mgdmlub3Mgc2UgcG9kw61hbiBzZXBhcmFyIGRlIGZvcm1hIGzDs2dpY2EsIHRhbCB2ZXogcG9yIHRpcG8gZGUgdXZhIG8gY8OzbW8gc2UgaGFjZW4uIEVzdG8gbm9zIHB1ZWRlIGF5dWRhciBhIGVudGVuZGVyIG1lam9yIGPDs21vIHNlIGRpZmVyZW5jaWFuIGxvcyB2aW5vcyB5IGEgaWRlbnRpZmljYXIgZ3J1cG9zIGNvbiBjYXJhY3RlcsOtc3RpY2FzIHNpbWlsYXJlcy4NCg0KTGEgdmVyZGFkIGVzIHF1ZSBjdcOhbnRvIG5vcyBzaXJ2YSBlc3RvIGRlcGVuZGUgZGUgc2kgbGFzIG1lZGlkYXMgcXVlIHVzYW1vcyByZWFsbWVudGUgbXVlc3RyYW4gZGlmZXJlbmNpYXMgaW1wb3J0YW50ZXMgZW50cmUgbG9zIHZpbm9zLiBEaXZpZGlybG9zIGVuIDMgZ3J1cG9zIG5vcyBkYSB1bmEgZm9ybWEgc2VuY2lsbGEgZGUgdmVyIGxhcyBjb3Nhcywgw7p0aWwgcGFyYSBlbXBlemFyIGEgc2VnbWVudGFyIGVsIG1lcmNhZG8gbyBkZWZpbmlyIHRpcG9zIGRlIHZpbm9zIHBvciBzdSBzYWJvci4gUGVybyBwYXJhIHNhY2FybGUgZWwganVnbyBhIGVzdGUgYW7DoWxpc2lzLCBuZWNlc2l0YW1vcyBtaXJhciBtw6FzIGRlIGNlcmNhIHF1w6kgdGllbmUgY2FkYSBncnVwbyB5IGPDs21vIHNlIHJlbGFjaW9uYSBjb24gbG8gcXVlIHlhIHNhYmVtb3MgZGUgdmlub3MuDQo=