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