Teoría

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

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

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

Paso 1. Instalar paquetes y llamar librerías

#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") # Grafica 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. Entender los datos

summary(df1) # min, promedio, max, NAs
##        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) # estructura: tipo de objeto, número de objetos
## '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 los datos no están 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) #K.max normalmente es 10, en este ejercicio al tener 8 datos se dejó así
plot(optimizacion1, xlab="Número de clusters k", main="Optimización de Clusters") #el primer punto más alto se selecciona como óptimo

Paso 8. Graficar los grupos

fviz_cluster(clusters1, data=df1)

Paso 9. Agregar Clusters al Dataframe

df1_clusters <- cbind(df1, cluster = clusters1$cluster)
head(df1_clusters)
##   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

Conclusiones

La técnica de clustering permite identificar patrones o grupos naturales en los datos sin necesidad de etiquetas previas.

LS0tCnRpdGxlOiAiOCBQdW50b3MiCmF1dGhvcjogIkFubmEgRHVyw6FuIEEwMTI4NTY3NCIKZGF0ZTogImByIFN5cy5EYXRlKClgIgpvdXRwdXQ6CiAgICAgICAgaHRtbF9kb2N1bWVudDoKICAgICAgICAgICAgICAgIHRvYzogVFJVRQogICAgICAgICAgICAgICAgdG9jX2Zsb2F0OiBUUlVFCiAgICAgICAgICAgICAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCiAgICAgICAgICAgICAgICB0aGVtZTogeWV0aQotLS0KCiFbXShodHRwczovL21pcm8ubWVkaXVtLmNvbS8xKmJ2QmpVekFTZzBBaWp2ZXNibWJQZ0EuZ2lmKQoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IzUyOEI4QjsiPjxiPlRlb3LDrWE8L2I+PC9zcGFuPgoKKipBZ3J1cGFtaWVudG8qKiBvICpjbHVzdGVyaW5nKiBlcyB1bmEgdMOpY25pY2EgZGUgYXByZW5kaXphamUgYXV0b23DoXRpY28gbm8gc3VwZXJ2aXNhZG8gcXVlIGFncnVwYSBkYXRvcyBlbiBmdW5jacOzbiBkZSBzdSBzaW1pbGl0dWQuICAKCkFsZ3Vub3MgdXNvcyB0w61waWNvcyBkZSBlc3RhIHTDqWNuaWNhIHNvbjogIAoKKiBTZWdtZW50YWNpw7NuIGRlIGNsaWVudGVzICAKKiBEZXRlY2Npw7NuIGRlIGFub3JtYWxpZGFkZXMgIAoqIENhdGVnb3JpemFjacOzbiBkZSBkb2N1bWVudG9zICAKCgojIDxzcGFuIHN0eWxlPSJjb2xvcjojNTI4QjhCOyI+PGI+UGFzbyAxLiBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzPC9iPjwvc3Bhbj4KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KI2luc3RhbGwucGFja2FnZXMoImNsdXN0ZXIiKSAjIEFuw6FsaXNpcyBkZSBBZ3J1cGFtaWVudG8KbGlicmFyeShjbHVzdGVyKQojaW5zdGFsbC5wYWNrYWdlcygiZ2dwbG90MiIpICMgR3JhZmljYXIKbGlicmFyeShnZ3Bsb3QyKQojaW5zdGFsbC5wYWNrYWdlcygiZGF0YS50YWJsZSIpICMgTWFuZWpvIGRlIG11Y2hvcyBkYXRvcwpsaWJyYXJ5KGRhdGEudGFibGUpCiNpbnN0YWxsLnBhY2thZ2VzKCJmYWN0b2V4dHJhIikgIyBHcmFmaWNhIG9wdGltaXphY2nDs24gZGUgbsO6bWVybyBkZSBjbHVzdGVycwpsaWJyYXJ5KGZhY3RvZXh0cmEpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IzUyOEI4QjsiPjxiPlBhc28gMi4gT2J0ZW5lciBsb3MgZGF0b3MgPC9iPjwvc3Bhbj4KYGBge3J9CmRmMSA8LSBkYXRhLmZyYW1lKHg9YygyLDIsOCw1LDcsNiwxLDQpLCB5PWMoMTAsNSw0LDgsNSw0LDIsOSkpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IzUyOEI4QjsiPjxiPlBhc28gMy4gRW50ZW5kZXIgbG9zIGRhdG9zIDwvYj48L3NwYW4+CmBgYHtyfQpzdW1tYXJ5KGRmMSkgIyBtaW4sIHByb21lZGlvLCBtYXgsIE5BcwpzdHIoZGYxKSAjIGVzdHJ1Y3R1cmE6IHRpcG8gZGUgb2JqZXRvLCBuw7ptZXJvIGRlIG9iamV0b3MKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjojNTI4QjhCOyI+PGI+UGFzbyA0LiBFc2NhbGFyIGxvcyBkYXRvcyA8L2I+PC9zcGFuPgpgYGB7cn0KIyBTw7NsbyBzaSBsb3MgZGF0b3Mgbm8gZXN0w6FuIGVuIGxhIG1pc21hIGVzY2FsYQojIGRhdG9zX2VzY2FsYWRvcyA8LSBzY2FsZShkYXRvc19vcmlnaW5hbGVzKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiM1MjhCOEI7Ij48Yj5QYXNvIDUuIERldGVybWluYXIgbsO6bWVybyBkZSBncnVwb3MgPC9iPjwvc3Bhbj4KYGBge3J9CiMgU2llbXByZSBlcyB1biB2YWxvciBpbmljaWFsICJjdWFscXVpZXJhIiwgbHVlZ28gc2Ugb3B0aW1pemEuCnBsb3QoZGYxJHgsZGYxJHkpCmdydXBvczEgPC0gIDMKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjojNTI4QjhCOyI+PGI+UGFzbyA2LiBHZW5lcmFyIGxvcyBncnVwb3MgIDwvYj48L3NwYW4+CmBgYHtyfQpzZXQuc2VlZCgxMjMpCmNsdXN0ZXJzMSA8LSAga21lYW5zKGRmMSwgZ3J1cG9zMSkKY2x1c3RlcnMxCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IzUyOEI4QjsiPjxiPlBhc28gNy4gT3B0aW1pemFyIGVsIG7Dum1lcm8gZGUgZ3J1cG9zICA8L2I+PC9zcGFuPgpgYGB7cn0Kc2V0LnNlZWQoMTIzKQpvcHRpbWl6YWNpb24xIDwtIGNsdXNHYXAoZGYxLCBGVU49a21lYW5zLCBuc3RhcnQ9MSwgSy5tYXg9NykgI0subWF4IG5vcm1hbG1lbnRlIGVzIDEwLCBlbiBlc3RlIGVqZXJjaWNpbyBhbCB0ZW5lciA4IGRhdG9zIHNlIGRlasOzIGFzw60KcGxvdChvcHRpbWl6YWNpb24xLCB4bGFiPSJOw7ptZXJvIGRlIGNsdXN0ZXJzIGsiLCBtYWluPSJPcHRpbWl6YWNpw7NuIGRlIENsdXN0ZXJzIikgI2VsIHByaW1lciBwdW50byBtw6FzIGFsdG8gc2Ugc2VsZWNjaW9uYSBjb21vIMOzcHRpbW8KYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjojNTI4QjhCOyI+PGI+UGFzbyA4LiBHcmFmaWNhciBsb3MgZ3J1cG9zIDwvYj48L3NwYW4+CmBgYHtyfQpmdml6X2NsdXN0ZXIoY2x1c3RlcnMxLCBkYXRhPWRmMSkKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjojNTI4QjhCOyI+PGI+UGFzbyA5LiBBZ3JlZ2FyIENsdXN0ZXJzIGFsIERhdGFmcmFtZSA8L2I+PC9zcGFuPgpgYGB7cn0KZGYxX2NsdXN0ZXJzIDwtIGNiaW5kKGRmMSwgY2x1c3RlciA9IGNsdXN0ZXJzMSRjbHVzdGVyKQpoZWFkKGRmMV9jbHVzdGVycykKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjojNTI4QjhCOyI+PGI+Q29uY2x1c2lvbmVzIDwvYj48L3NwYW4+CkxhIHTDqWNuaWNhIGRlICpjbHVzdGVyaW5nKiBwZXJtaXRlIGlkZW50aWZpY2FyIHBhdHJvbmVzIG8gZ3J1cG9zIG5hdHVyYWxlcyBlbiBsb3MgZGF0b3Mgc2luIG5lY2VzaWRhZCBkZSBldGlxdWV0YXMgcHJldmlhcy4=