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 3 cultivares diferentes.

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

Paso 1. Instalar paquetes y llamar librerías

#install.packages("cluster") # Análisis de Agrupamiento
library(cluster)
#install.packages("ggplot2") # Paquete de gráficas
library(ggplot2)
#install.packages("data.table") # Manejo de muchos datos
library(data.table)
#install.packages("factoextra") # Gráfica optimización de número de clusters
library(factoextra)

Paso 2. Obtener los datos

df1 <- read.csv("/Users/pablosancho/Desktop/Concentración/Modulo 2 Concentracion (R)/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

Paso 4. Escalar los datos

datos_escalados <- scale(df1)

Paso 5. Determinar numero de grupos

plot(datos_escalados)

grupos <- 3

Paso 6. Generar los grupos

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

Paso 7. Optimizar el numero de grupos

set.seed(123)
optimizacion1 <- clusGap(datos_escalados, FUN=kmeans, nstart=1, K.max=10)
plot (optimizacion1, xlab="Numero de clusters k")

Paso 8. Graficar los grupos

fviz_cluster(clusters1,data=df1)

LS0tCnRpdGxlOiAiQ2x1c3RlcnMgVmlub3MiCmF1dGhvcjogIlBhYmxvIFNhbmNobyBBMDE3MjIyMzYiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDogCiAgICB0b2M6IFRSVUUKICAgIHRvY19mbG9hdDogVFJVRQogICAgY29kZV9kb3dubG9hZDogVFJVRQogICAgdGhlbWU6IGRhcmtseQpkYXRlOiAiMjAyNS0wOC0xOCIKLS0tCgohW10oaHR0cHM6Ly90aGVsaXR0bGVmaW5ld2luZWNvbXBhbnkuY28udWsvd3AtY29udGVudC91cGxvYWRzLzIwMjMvMDcvZ2xhc3Mtb2Ytcm9zZS1zY2FsZWQuanBnKQoKCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBDb250ZXh0byA8L3NwYW4+CkVzdG9zIGRhdG9zIHNvbiBlbCByZXN1bHRhZG8gZGUgdW4gYW7DoWxpc2lzIHF1w61taWNvIGRlIHZpbm9zIGN1bHRpdmFkb3MgZW4gbGEgbWlzbWEgcmVnacOzbiBkZSBJdGFsaWEsIHBlcm8gZGVyaXZhZG9zIGRlIDMgY3VsdGl2YXJlcyBkaWZlcmVudGVzLgoKRWwgYW7DoWxpc2lzIGRldGVybWlubyBsYXMgY2FudGlkYWRlcyBkZSAxMyBjb21wb25lbnRlcyBxdWUgc2UgZW5jdWVudHJhbiBlbiBjYWRhIHVubyBkZSBsb3MgdHJlcyBjdWx0aXZhcmVzLgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBQYXNvIDEuIEluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYXMgPC9zcGFuPgpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQojaW5zdGFsbC5wYWNrYWdlcygiY2x1c3RlciIpICMgQW7DoWxpc2lzIGRlIEFncnVwYW1pZW50bwpsaWJyYXJ5KGNsdXN0ZXIpCiNpbnN0YWxsLnBhY2thZ2VzKCJnZ3Bsb3QyIikgIyBQYXF1ZXRlIGRlIGdyw6FmaWNhcwpsaWJyYXJ5KGdncGxvdDIpCiNpbnN0YWxsLnBhY2thZ2VzKCJkYXRhLnRhYmxlIikgIyBNYW5lam8gZGUgbXVjaG9zIGRhdG9zCmxpYnJhcnkoZGF0YS50YWJsZSkKI2luc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKSAjIEdyw6FmaWNhIG9wdGltaXphY2nDs24gZGUgbsO6bWVybyBkZSBjbHVzdGVycwpsaWJyYXJ5KGZhY3RvZXh0cmEpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBQYXNvIDIuIE9idGVuZXIgbG9zIGRhdG9zIDwvc3Bhbj4KYGBge3J9CmRmMSA8LSByZWFkLmNzdigiL1VzZXJzL3BhYmxvc2FuY2hvL0Rlc2t0b3AvQ29uY2VudHJhY2lvzIFuL01vZHVsbyAyIENvbmNlbnRyYWNpb24gKFIpL3dpbmUuY3N2IikKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gMy4gRW50ZW5kZXIgbG9zIGRhdG9zIDwvc3Bhbj4KYGBge3J9CnN1bW1hcnkoZGYxKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gUGFzbyA0LiBFc2NhbGFyIGxvcyBkYXRvcyA8L3NwYW4+CmBgYHtyfQpkYXRvc19lc2NhbGFkb3MgPC0gc2NhbGUoZGYxKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gUGFzbyA1LiBEZXRlcm1pbmFyIG51bWVybyBkZSBncnVwb3MgPC9zcGFuPgpgYGB7cn0KcGxvdChkYXRvc19lc2NhbGFkb3MpCmdydXBvcyA8LSAzCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBQYXNvIDYuIEdlbmVyYXIgbG9zIGdydXBvcyA8L3NwYW4+CmBgYHtyfQpjbHVzdGVyczEgPC0ga21lYW5zKGRhdG9zX2VzY2FsYWRvcyxncnVwb3MpCmNsdXN0ZXJzMQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gUGFzbyA3LiBPcHRpbWl6YXIgZWwgbnVtZXJvIGRlIGdydXBvcyA8L3NwYW4+CmBgYHtyfQpzZXQuc2VlZCgxMjMpCm9wdGltaXphY2lvbjEgPC0gY2x1c0dhcChkYXRvc19lc2NhbGFkb3MsIEZVTj1rbWVhbnMsIG5zdGFydD0xLCBLLm1heD0xMCkKcGxvdCAob3B0aW1pemFjaW9uMSwgeGxhYj0iTnVtZXJvIGRlIGNsdXN0ZXJzIGsiKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gUGFzbyA4LiBHcmFmaWNhciBsb3MgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CmZ2aXpfY2x1c3RlcihjbHVzdGVyczEsZGF0YT1kZjEpCmBgYA==