
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 anomalidades.
*Categorización de documentos.
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)
#install.packages("tidyr")
library(tidyr)
#install.packages("datasets")
library(datasets)
#install.packages("tidyverse")
library(tidyverse)
Ejercicio 1. Puntos
Contexto
Agrupa los siguientes 8 puntos.
Obtener datos
df1 <- data.frame(x=c(2,2,8,5,7,6,1,4),y=c(10,5,4,8,5,4,2,9))
Entender datos
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
plot(df1$x,df1$y)
## Escalar datos
# datos_escalados <- scale(datos_originales)
Asignar número de grupos
grupos1 <- 3
Agrupar los puntos
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"
Optimizar número de grupos
set.seed(123)
optimizacion <- clusGap(df1, FUN=kmeans, nstart=1, K.max=7)
# El K.max normalmente es 10, en este ejercicio al ser 8 datos, se dejó en 7
plot(optimizacion, xlab="Número de clsuters k", main="Optimización de clusters")

# Se selecciona como óptimo el primer punto más alto
# Si es diferente al original, regresar y ajustar
Gráficar los grupos
fviz_cluster(clusters1,data=df1)
## Agregar grupos a la base de datos
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
Conlusiones
La técnica de clustering permite identificar
patrones o grupos naturales en los datos sin necesidad de etiquetas
previas.
Ejercicio 2. USArrest
Contexto
La base de datos de USArrest contiene estadísticas
en arrestos por cada 100,000 residentes por agresión, asesinato y
violación en cada uno de los 50 estados de EE.UU. en 1973.
Obtener datos
df2 <- USArrests
df2 <- df2 %>% select (-UrbanPop)
Entender datos
summary(df2)
## Murder Assault Rape
## Min. : 0.800 Min. : 45.0 Min. : 7.30
## 1st Qu.: 4.075 1st Qu.:109.0 1st Qu.:15.07
## Median : 7.250 Median :159.0 Median :20.10
## Mean : 7.788 Mean :170.8 Mean :21.23
## 3rd Qu.:11.250 3rd Qu.:249.0 3rd Qu.:26.18
## Max. :17.400 Max. :337.0 Max. :46.00
str(df2)
## 'data.frame': 50 obs. of 3 variables:
## $ Murder : num 13.2 10 8.1 8.8 9 7.9 3.3 5.9 15.4 17.4 ...
## $ Assault: int 236 263 294 190 276 204 110 238 335 211 ...
## $ Rape : num 21.2 44.5 31 19.5 40.6 38.7 11.1 15.8 31.9 25.8 ...
Escalar datos
df2_escalados <- scale(df2)
summary(df2_escalados)
## Murder Assault Rape
## Min. :-1.6044 Min. :-1.5090 Min. :-1.4874
## 1st Qu.:-0.8525 1st Qu.:-0.7411 1st Qu.:-0.6574
## Median :-0.1235 Median :-0.1411 Median :-0.1209
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.7949 3rd Qu.: 0.9388 3rd Qu.: 0.5277
## Max. : 2.2069 Max. : 1.9948 Max. : 2.6444
Asignar número de grupos
grupos2 <- 5
Agrupar los puntos
set.seed(123)
clusters2 <- kmeans(df2_escalados, grupos2)
Optimizar número de grupos
set.seed(123)
optimizacion <- clusGap(df2_escalados, FUN=kmeans, nstart=1, K.max=10)
# El K.max normalmente es 10, en este ejercicio al ser 8 datos, se dejó en 7
plot(optimizacion, xlab="Número de clsuters k", main="Optimización de clusters")

# Se selecciona como óptimo el primer punto más alto
# Si es diferente al original, regresar y ajustar
Gráficar los grupos
fviz_cluster(clusters2,data=df2_escalados)
## Agregar grupos a la base de datos
df2_clusters <- cbind(df2, cluster=clusters2$cluster)
head(df2_clusters)
## Murder Assault Rape cluster
## Alabama 13.2 236 21.2 5
## Alaska 10.0 263 44.5 4
## Arizona 8.1 294 31.0 1
## Arkansas 8.8 190 19.5 3
## California 9.0 276 40.6 4
## Colorado 7.9 204 38.7 4
df2_clusters %>% group_by (cluster) %>% summarise_all(mean) %>% mutate(indicador_inseguridad=Murder+Assault+Rape)
## # A tibble: 5 × 5
## cluster Murder Assault Rape indicador_inseguridad
## <int> <dbl> <dbl> <dbl> <dbl>
## 1 1 11.4 282. 29.7 323.
## 2 2 3.08 80.9 11.8 95.8
## 3 3 6.59 146. 20.1 172.
## 4 4 9.78 249. 42.4 301.
## 5 5 14.4 245 22.2 282.
df2_clusters<- df2_clusters %>%
mutate(cluster=case_when(
cluster == 1 ~ "Inseguridad Muy Alta",
cluster == 4 ~ "Inseguridad Alta",
cluster == 5 ~ "Inseguridad Media",
cluster == 3 ~ "Inseguridad Baja",
cluster == 2 ~ "Inseguridad Muy Baja"
))
Ejercicio 3. Segmentación de Clientes
Contexto
La base de datos ventas tiene los registros entre el
01 de diciembre de 2010 y el 09 de diciembre de 2011 de las ventas de
una empresa minorista en línea sin tienda física, basada en Reino
Unido.
La empresa venfe principalmente regalos únicos para toda ocasión, y
muchos de sus clientes son mayoristas.
Objetivo: Segmentar clientes, asignatles nombre y características de
comportamiento, y proponer sugerencias a la empresa para aumentar
ventas.
LS0tCnRpdGxlOiAiQ2x1c3RlcnMgLSBQdW50b3MgVVNBcnJlc3RzIHkgQ2xpZW50ZXMiCmF1dGhvcjogIkFubmEgTHVpc2EgUm9jaGEgLSBBMDE3NDE3NzYiCmRhdGU6ICIyMDI2LTA4LTI1IgpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IFRSVUUgCiAgICB0b2NfZmxvYXQ6IFRSVUUKICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUKICAgIHRoZW1lOiBzcGFjZWxhYgogICAgCi0tLQoKIVtdKGh0dHBzOi8vbWVkaWEzLmdpcGh5LmNvbS9tZWRpYS92MS5ZMmxrUFRjNU1HSTNOakV4TkdadWFXVndPWEJwT1hKaWREZHFOMnQ0ZW1Gd2FEWmtabWxqYXpVMGJXVm1jWFI2Ym1oMmF5WmxjRDEyTVY5cGJuUmxjbTVoYkY5bmFXWmZZbmxmYVdRbVkzUTlady8xMnZWQUdrYXFIVXFDUS9naXBoeS5naWYpCgojIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+VGVvcsOtYTwvc3Bhbj4KKkFncnVwYW1pZW50byogbyAqQ2x1c3RlcmluZyogZXMgdW5hIHTDqWNuaWNhIGRlIGFwcmVuZGl6YWplIGF1dG9tw6F0aWNvIG5vIHN1cGVydmlzYWRvIHF1ZSBhZ3J1cGEgZGF0b3MgZW4gZnVuY2nDs24gZGUgc3Ugc2ltaWxpdHVkLiAgCgpBbGd1bm9zIHVzb3MgdMOtcGljb3MgZGUgZXN0YSB0w6ljbmljYSBzb246CgoqU2VnbWVudGFjacOzbiBkZSBjbGllbnRlcy4gICAKKkRldGVjY2nDs24gZGUgYW5vbWFsaWRhZGVzLiAgIAoqQ2F0ZWdvcml6YWNpw7NuIGRlIGRvY3VtZW50b3MuICAgCgojIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+SW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hczwvc3Bhbj4KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRSwgcGFnZWQucHJpbnQ9RkFMU0V9CgojaW5zdGFsbC5wYWNrYWdlcygiY2x1c3RlciIpCmxpYnJhcnkoY2x1c3RlcikKI2luc3RhbGwucGFja2FnZXMoImdncGxvdDIiKQpsaWJyYXJ5KGdncGxvdDIpCiNpbnN0YWxsLnBhY2thZ2VzKCJkYXRhLnRhYmxlIikKbGlicmFyeShkYXRhLnRhYmxlKQojaW5zdGFsbC5wYWNrYWdlcygiZmFjdG9leHRyYSIpCmxpYnJhcnkoZmFjdG9leHRyYSkKI2luc3RhbGwucGFja2FnZXMoInRpZHlyIikKbGlicmFyeSh0aWR5cikKI2luc3RhbGwucGFja2FnZXMoImRhdGFzZXRzIikKbGlicmFyeShkYXRhc2V0cykKI2luc3RhbGwucGFja2FnZXMoInRpZHl2ZXJzZSIpCmxpYnJhcnkodGlkeXZlcnNlKQpgYGAKCiMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj5FamVyY2ljaW8gMS4gUHVudG9zPC9zcGFuPgojIyA8c3BhbiBzdHlsZT0gImNvbG9yOmJsdWUiPiBDb250ZXh0bzwvc3Bhbj4KQWdydXBhIGxvcyBzaWd1aWVudGVzIDggcHVudG9zLgoKIyMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj4gT2J0ZW5lciBkYXRvczwvc3Bhbj4KYGBge3J9CmRmMSA8LSBkYXRhLmZyYW1lKHg9YygyLDIsOCw1LDcsNiwxLDQpLHk9YygxMCw1LDQsOCw1LDQsMiw5KSkKYGBgCiMjIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+IEVudGVuZGVyIGRhdG9zPC9zcGFuPgpgYGB7cn0Kc3VtbWFyeShkZjEpCnN0cihkZjEpCnBsb3QoZGYxJHgsZGYxJHkpCmBgYAojIyA8c3BhbiBzdHlsZT0gImNvbG9yOmJsdWUiPiBFc2NhbGFyIGRhdG9zIDwvc3Bhbj4KYGBge3J9CiMgZGF0b3NfZXNjYWxhZG9zIDwtIHNjYWxlKGRhdG9zX29yaWdpbmFsZXMpCmBgYAojIyA8c3BhbiBzdHlsZT0gImNvbG9yOmJsdWUiPiBBc2lnbmFyIG7Dum1lcm8gZGUgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CmdydXBvczEgPC0gMwpgYGAKIyMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj4gQWdydXBhciBsb3MgcHVudG9zIDwvc3Bhbj4KYGBge3J9CnNldC5zZWVkKDEyMykKY2x1c3RlcnMxIDwtIGttZWFucyhkZjEsIGdydXBvczEpCmNsdXN0ZXJzMQpgYGAKCiMjIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+IE9wdGltaXphciBuw7ptZXJvIGRlIGdydXBvcyA8L3NwYW4+CmBgYHtyfQpzZXQuc2VlZCgxMjMpCm9wdGltaXphY2lvbiA8LSBjbHVzR2FwKGRmMSwgRlVOPWttZWFucywgbnN0YXJ0PTEsIEsubWF4PTcpCiMgRWwgSy5tYXggbm9ybWFsbWVudGUgZXMgMTAsIGVuIGVzdGUgZWplcmNpY2lvIGFsIHNlciA4IGRhdG9zLCBzZSBkZWrDsyBlbiA3CnBsb3Qob3B0aW1pemFjaW9uLCB4bGFiPSJOw7ptZXJvIGRlIGNsc3V0ZXJzIGsiLCBtYWluPSJPcHRpbWl6YWNpw7NuIGRlIGNsdXN0ZXJzIikKIyBTZSBzZWxlY2Npb25hIGNvbW8gw7NwdGltbyBlbCBwcmltZXIgcHVudG8gbcOhcyBhbHRvCiMgU2kgZXMgZGlmZXJlbnRlIGFsIG9yaWdpbmFsLCByZWdyZXNhciB5IGFqdXN0YXIKYGBgCiMjIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+IEdyw6FmaWNhciBsb3MgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CmZ2aXpfY2x1c3RlcihjbHVzdGVyczEsZGF0YT1kZjEpCmBgYAojIyA8c3BhbiBzdHlsZT0gImNvbG9yOmJsdWUiPiBBZ3JlZ2FyIGdydXBvcyBhIGxhIGJhc2UgZGUgZGF0b3MgPC9zcGFuPgpgYGB7cn0KZGYxX2NsdXN0ZXJzIDwtIGNiaW5kKGRmMSwgY2x1c3Rlcj1jbHVzdGVyczEkY2x1c3RlcikKaGVhZChkZjFfY2x1c3RlcnMpCmBgYAojIyA8c3BhbiBzdHlsZT0gImNvbG9yOmJsdWUiPiBDb25sdXNpb25lcyA8L3NwYW4+CkxhIHTDqWNuaWNhIGRlICoqY2x1c3RlcmluZyoqIHBlcm1pdGUgaWRlbnRpZmljYXIgcGF0cm9uZXMgbyBncnVwb3MgbmF0dXJhbGVzIGVuIGxvcyBkYXRvcyBzaW4gbmVjZXNpZGFkIGRlIGV0aXF1ZXRhcyBwcmV2aWFzLgoKCiMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj5FamVyY2ljaW8gMi4gVVNBcnJlc3QgPC9zcGFuPgojIyA8c3BhbiBzdHlsZT0gImNvbG9yOmJsdWUiPiBDb250ZXh0byA8L3NwYW4+CkxhIGJhc2UgZGUgZGF0b3MgZGUgKipVU0FycmVzdCoqIGNvbnRpZW5lIGVzdGFkw61zdGljYXMgZW4gYXJyZXN0b3MgcG9yIGNhZGEgMTAwLDAwMCByZXNpZGVudGVzIHBvciBhZ3Jlc2nDs24sIGFzZXNpbmF0byB5IHZpb2xhY2nDs24gZW4gY2FkYSB1bm8gZGUgbG9zIDUwIGVzdGFkb3MgZGUgRUUuVVUuIGVuIDE5NzMuCgoKIyMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj4gT2J0ZW5lciBkYXRvczwvc3Bhbj4KYGBge3J9CmRmMiA8LSBVU0FycmVzdHMKZGYyIDwtIGRmMiAlPiUgc2VsZWN0ICgtVXJiYW5Qb3ApCmBgYAojIyA8c3BhbiBzdHlsZT0gImNvbG9yOmJsdWUiPiBFbnRlbmRlciBkYXRvczwvc3Bhbj4KYGBge3J9CnN1bW1hcnkoZGYyKQpzdHIoZGYyKQpgYGAKIyMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj4gRXNjYWxhciBkYXRvcyA8L3NwYW4+CmBgYHtyfQpkZjJfZXNjYWxhZG9zIDwtIHNjYWxlKGRmMikKc3VtbWFyeShkZjJfZXNjYWxhZG9zKQpgYGAKIyMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj4gQXNpZ25hciBuw7ptZXJvIGRlIGdydXBvcyA8L3NwYW4+CmBgYHtyfQpncnVwb3MyIDwtIDUKYGBgCiMjIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+IEFncnVwYXIgbG9zIHB1bnRvcyA8L3NwYW4+CmBgYHtyfQpzZXQuc2VlZCgxMjMpCmNsdXN0ZXJzMiA8LSBrbWVhbnMoZGYyX2VzY2FsYWRvcywgZ3J1cG9zMikKYGBgCiMjIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+IE9wdGltaXphciBuw7ptZXJvIGRlIGdydXBvcyA8L3NwYW4+CmBgYHtyfQpzZXQuc2VlZCgxMjMpCm9wdGltaXphY2lvbiA8LSBjbHVzR2FwKGRmMl9lc2NhbGFkb3MsIEZVTj1rbWVhbnMsIG5zdGFydD0xLCBLLm1heD0xMCkKIyBFbCBLLm1heCBub3JtYWxtZW50ZSBlcyAxMCwgZW4gZXN0ZSBlamVyY2ljaW8gYWwgc2VyIDggZGF0b3MsIHNlIGRlasOzIGVuIDcKcGxvdChvcHRpbWl6YWNpb24sIHhsYWI9Ik7Dum1lcm8gZGUgY2xzdXRlcnMgayIsIG1haW49Ik9wdGltaXphY2nDs24gZGUgY2x1c3RlcnMiKQojIFNlIHNlbGVjY2lvbmEgY29tbyDDs3B0aW1vIGVsIHByaW1lciBwdW50byBtw6FzIGFsdG8KIyBTaSBlcyBkaWZlcmVudGUgYWwgb3JpZ2luYWwsIHJlZ3Jlc2FyIHkgYWp1c3RhcgpgYGAKCiMjIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+IEdyw6FmaWNhciBsb3MgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CmZ2aXpfY2x1c3RlcihjbHVzdGVyczIsZGF0YT1kZjJfZXNjYWxhZG9zKQpgYGAKIyMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj4gQWdyZWdhciBncnVwb3MgYSBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4KCgpgYGB7cn0KZGYyX2NsdXN0ZXJzIDwtIGNiaW5kKGRmMiwgY2x1c3Rlcj1jbHVzdGVyczIkY2x1c3RlcikKaGVhZChkZjJfY2x1c3RlcnMpCgpkZjJfY2x1c3RlcnMgJT4lIGdyb3VwX2J5IChjbHVzdGVyKSAlPiUgc3VtbWFyaXNlX2FsbChtZWFuKSAlPiUgbXV0YXRlKGluZGljYWRvcl9pbnNlZ3VyaWRhZD1NdXJkZXIrQXNzYXVsdCtSYXBlKQoKCmRmMl9jbHVzdGVyczwtIGRmMl9jbHVzdGVycyAlPiUKICBtdXRhdGUoY2x1c3Rlcj1jYXNlX3doZW4oCiAgICBjbHVzdGVyID09IDEgfiAiSW5zZWd1cmlkYWQgTXV5IEFsdGEiLAogICAgY2x1c3RlciA9PSA0IH4gIkluc2VndXJpZGFkIEFsdGEiLAogICAgY2x1c3RlciA9PSA1IH4gIkluc2VndXJpZGFkIE1lZGlhIiwKICAgIGNsdXN0ZXIgPT0gMyB+ICJJbnNlZ3VyaWRhZCBCYWphIiwKICAgIGNsdXN0ZXIgPT0gMiB+ICJJbnNlZ3VyaWRhZCBNdXkgQmFqYSIKICApKQpgYGAKCgojIDxzcGFuIHN0eWxlPSAiY29sb3I6Ymx1ZSI+RWplcmNpY2lvIDMuIFNlZ21lbnRhY2nDs24gZGUgQ2xpZW50ZXMgPC9zcGFuPgoKIyMgPHNwYW4gc3R5bGU9ICJjb2xvcjpibHVlIj4gQ29udGV4dG8gPC9zcGFuPgpMYSBiYXNlIGRlIGRhdG9zICoqdmVudGFzKiogdGllbmUgbG9zIHJlZ2lzdHJvcyBlbnRyZSBlbCAwMSBkZSBkaWNpZW1icmUgZGUgMjAxMCB5IGVsIDA5IGRlIGRpY2llbWJyZSBkZSAyMDExIGRlIGxhcyB2ZW50YXMgZGUgdW5hIGVtcHJlc2EgbWlub3Jpc3RhIGVuIGzDrW5lYSBzaW4gdGllbmRhIGbDrXNpY2EsIGJhc2FkYSBlbiBSZWlubyBVbmlkby4gIApMYSBlbXByZXNhIHZlbmZlIHByaW5jaXBhbG1lbnRlIHJlZ2Fsb3Mgw7puaWNvcyBwYXJhIHRvZGEgb2Nhc2nDs24sIHkgbXVjaG9zIGRlIHN1cyBjbGllbnRlcyBzb24gbWF5b3Jpc3Rhcy4gIApPYmpldGl2bzogU2VnbWVudGFyIGNsaWVudGVzLCBhc2lnbmF0bGVzIG5vbWJyZSB5IGNhcmFjdGVyw61zdGljYXMgZGUgY29tcG9ydGFtaWVudG8sIHkgcHJvcG9uZXIgc3VnZXJlbmNpYXMgYSBsYSBlbXByZXNhIHBhcmEgYXVtZW50YXIgdmVudGFzLgoKCg==