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:
#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 del número de clusters
library(factoextra)
library(dplyr)
Agrupa los siguientes 8 puntos.
df1 <- data.frame (x=c(2,2,8,5,7,6,1,4), y=c(10,5,4,8,5,4,2,9))
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)
# datos_escalados <- scale(datos_originales)
# En este ejercicio no se escala: las dos variables ya están en la misma unidad y escala.
grupos1 <- 4
set.seed(123)
clusters1 <- kmeans(df1,grupos1)
clusters1
## K-means clustering with 4 clusters of sizes 2, 3, 2, 1
##
## Cluster means:
## x y
## 1 1.500000 3.5
## 2 3.666667 9.0
## 3 7.500000 4.5
## 4 6.000000 4.0
##
## Clustering vector:
## [1] 2 1 3 2 3 4 1 2
##
## Within cluster sum of squares by cluster:
## [1] 5.000000 6.666667 1.000000 0.000000
## (between_SS / total_SS = 87.4 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
fviz_cluster(clusters1, data=df1, repel=TRUE)
La base de datos USArrests trae, para cada uno de los 50 estados de Estados Unidos, los arrestos por cada 100,000 habitantes por asesinato, asalto y violación, más el porcentaje de población urbana.
Objetivo: agrupar los estados por su nivel de inseguridad.
df2 <- USArrests
summary(df2)
## Murder Assault UrbanPop Rape
## Min. : 0.800 Min. : 45.0 Min. :32.00 Min. : 7.30
## 1st Qu.: 4.075 1st Qu.:109.0 1st Qu.:54.50 1st Qu.:15.07
## Median : 7.250 Median :159.0 Median :66.00 Median :20.10
## Mean : 7.788 Mean :170.8 Mean :65.54 Mean :21.23
## 3rd Qu.:11.250 3rd Qu.:249.0 3rd Qu.:77.75 3rd Qu.:26.18
## Max. :17.400 Max. :337.0 Max. :91.00 Max. :46.00
str(df2)
## 'data.frame': 50 obs. of 4 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 ...
## $ UrbanPop: int 58 48 80 50 91 78 77 72 80 60 ...
## $ Rape : num 21.2 44.5 31 19.5 40.6 38.7 11.1 15.8 31.9 25.8 ...
head(df2)
## Murder Assault UrbanPop Rape
## Alabama 13.2 236 58 21.2
## Alaska 10.0 263 48 44.5
## Arizona 8.1 294 80 31.0
## Arkansas 8.8 190 50 19.5
## California 9.0 276 91 40.6
## Colorado 7.9 204 78 38.7
# Aquí sí hay que escalar: Assault llega a 337 y Murder apenas a 17.
# Sin escalar, Assault dominaría el agrupamiento solo por su magnitud.
df2_escalados <- scale(df2)
summary(df2_escalados)
## Murder Assault UrbanPop Rape
## Min. :-1.6044 Min. :-1.5090 Min. :-2.31714 Min. :-1.4874
## 1st Qu.:-0.8525 1st Qu.:-0.7411 1st Qu.:-0.76271 1st Qu.:-0.6574
## Median :-0.1235 Median :-0.1411 Median : 0.03178 Median :-0.1209
## Mean : 0.0000 Mean : 0.0000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.7949 3rd Qu.: 0.9388 3rd Qu.: 0.84354 3rd Qu.: 0.5277
## Max. : 2.2069 Max. : 1.9948 Max. : 1.75892 Max. : 2.6444
set.seed(123)
optimizacion2 <- clusGap(df2_escalados, FUN=kmeans, nstart=1, K.max=10)
plot(optimizacion2, xlab="Numero de clusters k", main="Optimización de Clusters")
grupos2 <- 5
set.seed(123)
clusters2 <- kmeans(df2_escalados, grupos2)
clusters2
## K-means clustering with 5 clusters of sizes 6, 13, 16, 7, 8
##
## Cluster means:
## Murder Assault UrbanPop Rape
## 1 0.9823573 1.3308109 0.3081225 1.60161408
## 2 -0.9615407 -1.1066010 -0.9301069 -0.96676331
## 3 -0.4894375 -0.3826001 0.5758298 -0.26165379
## 4 0.4488240 0.7896961 1.0779352 0.99864726
## 5 1.4118898 0.8743346 -0.8145211 0.01927104
##
## Clustering vector:
## Alabama Alaska Arizona Arkansas California
## 5 1 4 5 4
## Colorado Connecticut Delaware Florida Georgia
## 4 3 3 1 5
## Hawaii Idaho Illinois Indiana Iowa
## 3 2 4 3 2
## Kansas Kentucky Louisiana Maine Maryland
## 3 2 5 2 1
## Massachusetts Michigan Minnesota Mississippi Missouri
## 3 1 2 5 4
## Montana Nebraska Nevada New Hampshire New Jersey
## 2 2 1 2 3
## New Mexico New York North Carolina North Dakota Ohio
## 1 4 5 2 3
## Oklahoma Oregon Pennsylvania Rhode Island South Carolina
## 3 3 3 3 5
## South Dakota Tennessee Texas Utah Vermont
## 2 5 4 3 2
## Virginia Washington West Virginia Wisconsin Wyoming
## 3 3 2 2 3
##
## Within cluster sum of squares by cluster:
## [1] 8.189644 11.952463 16.212213 6.777944 8.316061
## (between_SS / total_SS = 73.8 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
fviz_cluster(clusters2, data=df2_escalados, repel=TRUE)
df2_clusters <- cbind(df2, cluster = clusters2$cluster)
head(df2_clusters)
## Murder Assault UrbanPop Rape cluster
## Alabama 13.2 236 58 21.2 5
## Alaska 10.0 263 48 44.5 1
## Arizona 8.1 294 80 31.0 4
## Arkansas 8.8 190 50 19.5 5
## California 9.0 276 91 40.6 4
## Colorado 7.9 204 78 38.7 4
df2_clusters %>% group_by(cluster) %>% summarise_all(mean) %>%
mutate(indicador_inseguridad = Murder + Assault + Rape) %>%
arrange(desc(indicador_inseguridad))
## # A tibble: 5 × 6
## cluster Murder Assault UrbanPop Rape indicador_inseguridad
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 12.1 282. 70 36.2 330.
## 2 5 13.9 244. 53.8 21.4 279.
## 3 4 9.74 237. 81.1 30.6 277.
## 4 3 5.66 139. 73.9 18.8 163.
## 5 2 3.6 78.5 52.1 12.2 94.3
df2_clusters <- df2_clusters %>%
mutate(cluster = case_when(
cluster == 1 ~ "Inseguridad Muy Alta",
cluster == 5 ~ "Inseguridad Alta",
cluster == 4 ~ "Inseguridad Media",
cluster == 3 ~ "Inseguridad Baja",
cluster == 2 ~ "Inseguridad Muy Baja"
))
head(df2_clusters)
## Murder Assault UrbanPop Rape cluster
## Alabama 13.2 236 58 21.2 Inseguridad Alta
## Alaska 10.0 263 48 44.5 Inseguridad Muy Alta
## Arizona 8.1 294 80 31.0 Inseguridad Media
## Arkansas 8.8 190 50 19.5 Inseguridad Alta
## California 9.0 276 91 40.6 Inseguridad Media
## Colorado 7.9 204 78 38.7 Inseguridad Media
table(df2_clusters$cluster)
##
## Inseguridad Alta Inseguridad Baja Inseguridad Media
## 8 16 7
## Inseguridad Muy Alta Inseguridad Muy Baja
## 6 13
La base de datos ventas tiene los registros entre el 1 de diciembre de 2010 y el 9 de diciembre de 2011 de las ventas de una empresa minorista en línea sin tienda física, basada en Reino Unido. La empresa vende principalmente regalos únicos para toda ocasión, y muchos de sus clientes son mayoristas. Objetivo: Segmentar clientes, asignarles nombre y características de comportamiento, y proponer sugerencias a la empresa para aumentar ventas.
# file.choose()
ventas <- read.csv("/Users/santiagojaramillo/Downloads/ventas (1).csv")
dim(ventas)
## [1] 522064 8
str(ventas)
## 'data.frame': 522064 obs. of 8 variables:
## $ Ticket : chr "536365" "536365" "536365" "536365" ...
## $ Producto: chr "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
## $ Cantidad: int 6 6 8 6 6 2 6 6 6 32 ...
## $ Fecha : chr "01/12/2010" "01/12/2010" "01/12/2010" "01/12/2010" ...
## $ Hora : chr "08:26:00" "08:26:00" "08:26:00" "08:26:00" ...
## $ Precio : num 2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
## $ Cliente : int 17850 17850 17850 17850 17850 17850 17850 17850 17850 13047 ...
## $ País : chr "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...
head(ventas)
## Ticket Producto Cantidad Fecha Hora
## 1 536365 WHITE HANGING HEART T-LIGHT HOLDER 6 01/12/2010 08:26:00
## 2 536365 WHITE METAL LANTERN 6 01/12/2010 08:26:00
## 3 536365 CREAM CUPID HEARTS COAT HANGER 8 01/12/2010 08:26:00
## 4 536365 KNITTED UNION FLAG HOT WATER BOTTLE 6 01/12/2010 08:26:00
## 5 536365 RED WOOLLY HOTTIE WHITE HEART 6 01/12/2010 08:26:00
## 6 536365 SET 7 BABUSHKA NESTING BOXES 2 01/12/2010 08:26:00
## Precio Cliente País
## 1 2.55 17850 United Kingdom
## 2 3.39 17850 United Kingdom
## 3 2.75 17850 United Kingdom
## 4 3.39 17850 United Kingdom
## 5 3.39 17850 United Kingdom
## 6 7.65 17850 United Kingdom
summary(ventas)
## Ticket Producto Cantidad Fecha
## Length :522064 Length :522064 Min. :-9600.00 Length :522064
## N.unique : 21663 N.unique : 4183 1st Qu.: 1.00 N.unique : 305
## N.blank : 0 N.blank : 1455 Median : 3.00 N.blank : 0
## Min.nchar: 6 Min.nchar: 0 Mean : 10.09 Min.nchar: 10
## Max.nchar: 7 Max.nchar: 36 3rd Qu.: 10.00 Max.nchar: 10
## Max. :80995.00
##
## Hora Precio Cliente País
## Length :522064 Min. :-11062.060 Min. :12346 Length :522064
## N.unique : 739 1st Qu.: 1.250 1st Qu.:13950 N.unique : 30
## N.blank : 0 Median : 2.080 Median :15265 N.blank : 0
## Min.nchar: 8 Mean : 3.827 Mean :15317 Min.nchar: 3
## Max.nchar: 8 3rd Qu.: 4.130 3rd Qu.:16837 Max.nchar: 20
## Max. : 13541.330 Max. :18287
## NAs :134041
La base tiene una fila por producto vendido, no por cliente. Para poder agrupar clientes primero hay que limpiarla y después resumirla por cliente.
# Cuántos datos faltan y cuántas devoluciones hay
colSums(is.na(ventas))
## Ticket Producto Cantidad Fecha Hora Precio Cliente País
## 0 0 0 0 0 0 134041 0
sum(ventas$Cantidad <= 0) # devoluciones y cancelaciones
## [1] 1336
sum(ventas$Precio <= 0) # registros sin precio
## [1] 2513
ventas$Fecha <- as.Date(ventas$Fecha, format = "%d/%m/%Y")
ventas_limpias <- ventas %>%
filter(!is.na(Cliente), # sin cliente no se puede segmentar
Cantidad > 0, # quitamos devoluciones
Precio > 0) %>% # quitamos registros sin precio
mutate(Importe = Cantidad * Precio)
nrow(ventas) # filas originales
## [1] 522064
nrow(ventas_limpias) # filas que se conservan
## [1] 387985
Para segmentar clientes se usa el modelo RFM, que resume a cada cliente en tres números:
fecha_corte <- max(ventas_limpias$Fecha) + 1
df3 <- ventas_limpias %>%
group_by(Cliente) %>%
summarise(
Recencia = as.numeric(fecha_corte - max(Fecha)),
Frecuencia = n_distinct(Ticket),
Monto = sum(Importe),
.groups = "drop"
)
head(df3)
## # A tibble: 6 × 4
## Cliente Recencia Frecuencia Monto
## <int> <dbl> <int> <dbl>
## 1 12346 326 1 77184.
## 2 12347 3 7 4310.
## 3 12349 19 1 1758.
## 4 12350 311 1 334.
## 5 12352 37 8 2506.
## 6 12353 205 1 89
summary(df3)
## Cliente Recencia Frecuencia Monto
## Min. :12346 Min. : 1.00 Min. : 1.000 Min. : 3.75
## 1st Qu.:13832 1st Qu.: 18.00 1st Qu.: 1.000 1st Qu.: 306.72
## Median :15322 Median : 51.00 Median : 2.000 Median : 668.85
## Mean :15316 Mean : 93.16 Mean : 4.227 Mean : 1993.61
## 3rd Qu.:16790 3rd Qu.:143.00 3rd Qu.: 5.000 3rd Qu.: 1652.79
## Max. :18287 Max. :374.00 Max. :209.000 Max. :280206.02
Aquí hay dos problemas, no uno:
Por eso primero se aplica logaritmo (que comprime los valores extremos) y después se escala.
df3_log <- df3 %>%
mutate(Recencia = log(Recencia),
Frecuencia = log(Frecuencia),
Monto = log(Monto))
df3_escalados <- scale(df3_log[, c("Recencia", "Frecuencia", "Monto")])
summary(df3_escalados)
## Recencia Frecuencia Monto
## Min. :-2.74439 Min. :-1.0503 Min. :-4.19025
## 1st Qu.:-0.65739 1st Qu.:-1.0503 1st Qu.:-0.68305
## Median : 0.09459 Median :-0.2791 Median :-0.06222
## Mean : 0.00000 Mean : 0.0000 Mean : 0.00000
## 3rd Qu.: 0.83904 3rd Qu.: 0.7403 3rd Qu.: 0.65820
## Max. : 1.53323 Max. : 4.8933 Max. : 4.74584
set.seed(123)
optimizacion3 <- clusGap(df3_escalados, FUN = kmeans, nstart = 25, K.max = 8, B = 25)
## Warning: Quick-TRANSfer stage steps exceeded maximum (= 214800)
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: Quick-TRANSfer stage steps exceeded maximum (= 214800)
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
plot(optimizacion3, xlab = "Numero de clusters k", main = "Optimización de Clusters")
grupos3 <- 5
La gráfica sigue subiendo hasta 6, pero la ganancia entre 5 y 6 es mínima. Con 5 grupos los segmentos quedan bien diferenciados y cada uno se puede nombrar y accionar; con 6 se parten en dos grupos que se comportan casi igual. En segmentación de clientes conviene el número que el negocio pueda usar.
set.seed(123)
clusters3 <- kmeans(df3_escalados, grupos3, nstart = 25, iter.max = 50)
clusters3$size
## [1] 858 877 1019 486 1056
clusters3$centers
## Recencia Frecuencia Monto
## 1 -0.9789500 0.5885123 0.4905136
## 2 -0.2639518 -0.7532997 -0.7094566
## 3 0.4698693 0.2087306 0.3514277
## 4 -1.2100544 1.8627172 1.6800270
## 5 1.1181009 -0.9112469 -0.9216526
fviz_cluster(clusters3, data = df3_escalados, geom = "point",
repel = FALSE, ellipse.type = "norm") +
labs(title = "Segmentos de clientes")
df3_clusters <- cbind(df3, cluster = clusters3$cluster)
head(df3_clusters)
## Cliente Recencia Frecuencia Monto cluster
## 1 12346 326 1 77183.60 3
## 2 12347 3 7 4310.00 4
## 3 12349 19 1 1757.55 2
## 4 12350 311 1 334.40 5
## 5 12352 37 8 2506.04 1
## 6 12353 205 1 89.00 5
# Perfil de cada segmento, con la mediana para que los mayoristas
# gigantes no distorsionen el promedio
perfil <- df3_clusters %>%
group_by(cluster) %>%
summarise(
Clientes = n(),
Recencia = round(median(Recencia)),
Frecuencia = round(median(Frecuencia), 1),
Monto = round(median(Monto)),
.groups = "drop"
) %>%
arrange(desc(Monto))
perfil
## # A tibble: 5 × 5
## cluster Clientes Recencia Frecuencia Monto
## <int> <int> <dbl> <dbl> <dbl>
## 1 4 486 9 12 5026
## 2 1 858 15 4 1370
## 3 3 1019 80 3 1047
## 4 2 877 34 1 320
## 5 5 1056 234 1 244
df3_clusters <- df3_clusters %>%
mutate(segmento = case_when(
cluster == 4 ~ "Campeones",
cluster == 1 ~ "Leales",
cluster == 3 ~ "En riesgo",
cluster == 2 ~ "Nuevos",
cluster == 5 ~ "Dormidos"
))
head(df3_clusters)
## Cliente Recencia Frecuencia Monto cluster segmento
## 1 12346 326 1 77183.60 3 En riesgo
## 2 12347 3 7 4310.00 4 Campeones
## 3 12349 19 1 1757.55 2 Nuevos
## 4 12350 311 1 334.40 5 Dormidos
## 5 12352 37 8 2506.04 1 Leales
## 6 12353 205 1 89.00 5 Dormidos
table(df3_clusters$segmento)
##
## Campeones Dormidos En riesgo Leales Nuevos
## 486 1056 1019 858 877
Campeones — compraron hace unos días, muchas veces, y son los que más dinero dejan. Son los mayoristas del negocio. Son pocos pero valen mucho.
Leales — compran seguido y hace poco, con montos medios. Son la base estable del negocio.
En riesgo — llevan meses sin comprar, pero cuando compraban lo hacían varias veces y con buen monto. Son los que más urge recuperar, porque ya demostraron que valen.
Nuevos — compraron una sola vez, hace relativamente poco, y con monto bajo. Todavía no se sabe si se van a quedar.
Dormidos — una sola compra, hace muchísimo tiempo y de monto bajo. Probablemente ya se perdieron.
Campeones: darles trato preferente. Precios por volumen, un contacto directo de ventas y acceso anticipado a los productos nuevos. Perder uno de estos duele mucho más que perder diez clientes ocasionales.
Leales: subirlos a Campeones. Ofrecerles descuento por comprar más volumen y recomendarles productos parecidos a los que ya se llevan.
En riesgo: es donde está la mayor oportunidad. Mandar una campaña de recuperación con un descuento atractivo y preguntarles directamente por qué dejaron de comprar. Ya se sabe que gastan bien.
Nuevos: convertirlos en recurrentes. Un correo de seguimiento después de la primera compra y un cupón para la segunda.
Dormidos: no gastar mucho en ellos. Una última campaña barata por correo y, si no responden, sacarlos de las listas activas para no inflar los costos de marketing.
Recomendación general: la empresa debería medir estos segmentos cada mes y vigilar cuántos clientes se mueven de Leales a En riesgo. Ese movimiento es la señal temprana de que se están perdiendo ventas, y se detecta antes de que caiga la facturación.