Teoría

Agrupamiento o clustering es una técnica de aprendizaje automático no supervisado que agrupa datos en funci+on de su similitud.

Algunos usos típicos de esa técnica son:

  • Segmentación de clientes
  • Detección de anormalidades *Categorización de documentos

Instalar paquetes

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

Paso 2. Obtener los datos

df1 <- data.frame(x=c(2,2,8,5,7,6,1,4), y=c(10,5,4,8,5,4,2,9))

Paso 3. -

summary(df1)
##        x               y         
##  Min.   :1.000   Min.   : 2.000  
##  1st Qu.:2.000   1st Qu.: 4.000  
##  Median :4.500   Median : 5.000  
##  Mean   :4.375   Mean   : 5.875  
##  3rd Qu.:6.250   3rd Qu.: 8.250  
##  Max.   :8.000   Max.   :10.000
str(df1)
## 'data.frame':    8 obs. of  2 variables:
##  $ x: num  2 2 8 5 7 6 1 4
##  $ y: num  10 5 4 8 5 4 2 9

Paso 4. Escalar los datos

# Sólo si no estan en la misma escala
# datos_escalados <- scale(datos_originales)

Paso 5. Determinar número de grupos

# Siempre es un valor inicial "cualquiera", luego se optimiza.
plot(df1$x, df1$y)

grupos1 <- 3

Paso 6. Generar los grupos

set.seed(123)
clusters1 <- kmeans(df1, grupos1)
clusters1
## K-means clustering with 3 clusters of sizes 2, 3, 3
## 
## Cluster means:
##          x        y
## 1 1.500000 3.500000
## 2 3.666667 9.000000
## 3 7.000000 4.333333
## 
## Clustering vector:
## [1] 2 1 3 2 3 3 1 2
## 
## Within cluster sum of squares by cluster:
## [1] 5.000000 6.666667 2.666667
##  (between_SS / total_SS =  85.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Paso 7. Optimizar el número de grupos

set.seed(123)
optimizacion1 <- clusGap(df1, FUN=kmeans, nstart = 1, K.max=7)
# EL K means normalmente es 10, en este ejercicio al ser 8 datos, se dejó en 7.
plot(optimizacion1, xlab="Número de clústers k")

# Selecciona como óptimo el primer punto más alto
# Similar a la técnica del codo pero esta es más notable

Paso 8. Graficar los grupos

fviz_cluster(clusters1, data=df1)

Paso 9. Agregar Grupos a la Base de Datos

df1_cluster <- cbind(df1, cluster = clusters1$cluster)
head(df1_cluster)
##   x  y cluster
## 1 2 10       2
## 2 2  5       1
## 3 8  4       3
## 4 5  8       2
## 5 7  5       3
## 6 6  4       3
LS0tCnRpdGxlOiAiQWdydXBhbWllbnRvIChDbHVzdGVycykiCmF1dGhvcjogIkh1bWJlcnRvIENvcnTDqXMgU2FsZGHDsWEiCmRhdGU6ICIyMDI1LTA4LTE4IgpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IFRSVUUKICAgIHRvY19mbG9hdDogVFJVRQogICAgY29kZV9kb3dubG9hZDogVFJVRQogIAotLS0KCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpCmBgYAohW10oaHR0cHM6Ly93d3cuY3MudXMuZXMvfmZzYW5jaG8vQmxvZy9wb3N0cy9DbHVzdGVyaW5nL2ltZy9rLW1lYW5zX2NvbnZlcmdlbmNlLmdpZikKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gVGVvcsOtYSA8L3NwYW4+CioqQWdydXBhbWllbnRvKiogbyAqY2x1c3RlcmluZyogZXMgdW5hIHTDqWNuaWNhIGRlIGFwcmVuZGl6YWplIGF1dG9tw6F0aWNvIG5vIHN1cGVydmlzYWRvIHF1ZSBhZ3J1cGEgZGF0b3MgZW4gZnVuY2krb24gZGUgc3Ugc2ltaWxpdHVkLgoKQWxndW5vcyB1c29zIHTDrXBpY29zIGRlIGVzYSB0w6ljbmljYSBzb246CgoqIFNlZ21lbnRhY2nDs24gZGUgY2xpZW50ZXMKKiBEZXRlY2Npw7NuIGRlIGFub3JtYWxpZGFkZXMKKkNhdGVnb3JpemFjacOzbiBkZSBkb2N1bWVudG9zCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IEluc3RhbGFyIHBhcXVldGVzIDwvc3Bhbj4KCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CiNpbnN0YWxsLnBhY2thZ2VzKCJjbHVzdGVyIikgI0Fuw6FsaXNpcyBkZSBhZ3J1cGFtaWVudG8KbGlicmFyeShjbHVzdGVyKQojaW5zdGFsbC5wYWNrYWdlcygiZ2dwbG90MiIpICNHcmFmaWNhcgpsaWJyYXJ5KGdncGxvdDIpCiNpbnN0YWxsLnBhY2thZ2VzKCJkYXRhLnRhYmxlIikgIyBNYW5lam8gZGUgbXVjaG9zIGRhdG9zCmxpYnJhcnkoZGF0YS50YWJsZSkKI2luc3RhbGwucGFja2FnZXMoImZhY3RvZXh0cmEiKSAjIEdyw6FmaWNhIGRlIG9wdGltaXphY2nDs24gZGUgbsO6bWVybyBkZSBjbHVzdGVycwpsaWJyYXJ5KGZhY3RvZXh0cmEpCgpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gUGFzbyAyLiBPYnRlbmVyIGxvcyBkYXRvcyA8L3NwYW4+CmBgYHtyfQpkZjEgPC0gZGF0YS5mcmFtZSh4PWMoMiwyLDgsNSw3LDYsMSw0KSwgeT1jKDEwLDUsNCw4LDUsNCwyLDkpKQpgYGAKCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gMy4gLSA8L3NwYW4+CmBgYHtyfQpzdW1tYXJ5KGRmMSkKc3RyKGRmMSkKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gNC4gRXNjYWxhciBsb3MgZGF0b3MgPC9zcGFuPgpgYGB7cn0KIyBTw7NsbyBzaSBubyBlc3RhbiBlbiBsYSBtaXNtYSBlc2NhbGEKIyBkYXRvc19lc2NhbGFkb3MgPC0gc2NhbGUoZGF0b3Nfb3JpZ2luYWxlcykKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gNS4gRGV0ZXJtaW5hciBuw7ptZXJvIGRlIGdydXBvcyA8L3NwYW4+CmBgYHtyfQojIFNpZW1wcmUgZXMgdW4gdmFsb3IgaW5pY2lhbCAiY3VhbHF1aWVyYSIsIGx1ZWdvIHNlIG9wdGltaXphLgpwbG90KGRmMSR4LCBkZjEkeSkKZ3J1cG9zMSA8LSAzCiAKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gNi4gR2VuZXJhciBsb3MgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CnNldC5zZWVkKDEyMykKY2x1c3RlcnMxIDwtIGttZWFucyhkZjEsIGdydXBvczEpCmNsdXN0ZXJzMQogCmBgYAojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IFBhc28gNy4gT3B0aW1pemFyIGVsIG7Dum1lcm8gZGUgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CnNldC5zZWVkKDEyMykKb3B0aW1pemFjaW9uMSA8LSBjbHVzR2FwKGRmMSwgRlVOPWttZWFucywgbnN0YXJ0ID0gMSwgSy5tYXg9NykKIyBFTCBLIG1lYW5zIG5vcm1hbG1lbnRlIGVzIDEwLCBlbiBlc3RlIGVqZXJjaWNpbyBhbCBzZXIgOCBkYXRvcywgc2UgZGVqw7MgZW4gNy4KcGxvdChvcHRpbWl6YWNpb24xLCB4bGFiPSJOw7ptZXJvIGRlIGNsw7pzdGVycyBrIikKIyBTZWxlY2Npb25hIGNvbW8gw7NwdGltbyBlbCBwcmltZXIgcHVudG8gbcOhcyBhbHRvCiMgU2ltaWxhciBhIGxhIHTDqWNuaWNhIGRlbCBjb2RvIHBlcm8gZXN0YSBlcyBtw6FzIG5vdGFibGUKCiAKYGBgCgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBQYXNvIDguIEdyYWZpY2FyIGxvcyBncnVwb3MgPC9zcGFuPgpgYGB7cn0KZnZpel9jbHVzdGVyKGNsdXN0ZXJzMSwgZGF0YT1kZjEpCgogCmBgYAoKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gUGFzbyA5LiBBZ3JlZ2FyIEdydXBvcyBhIGxhIEJhc2UgZGUgRGF0b3MgPC9zcGFuPgpgYGB7cn0KZGYxX2NsdXN0ZXIgPC0gY2JpbmQoZGYxLCBjbHVzdGVyID0gY2x1c3RlcnMxJGNsdXN0ZXIpCmhlYWQoZGYxX2NsdXN0ZXIpCiAKYGBgCg==