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:

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") # Gráfica de optimización del número de clusters
library(factoextra)
library(dplyr)

Ejercicio 1. Puntos

Contexto

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

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 los datos

# datos_escalados <- scale(datos_originales)
# En este ejercicio no se escala: las dos variables ya están en la misma unidad y escala.

Asignar número de grupos

grupos1 <- 4

Agrupar los puntos

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"

Graficar los grupos

fviz_cluster(clusters1, data=df1, repel=TRUE)

Ejercicio 2. USArrests

Contexto

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

Entender datos

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

Escalar los datos

# 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

Optimizar número de grupos

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")

Asignar número de grupos

grupos2 <- 5

Agrupar los estados

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"

Graficar los grupos

fviz_cluster(clusters2, data=df2_escalados, repel=TRUE)

Agregar grupos a la base de datos

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

Ejercicio 3. Segmentación de clientes

Contexto

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")

Entender datos

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

Limpiar la base de datos

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

Construir el perfil de cada cliente (RFM)

Para segmentar clientes se usa el modelo RFM, que resume a cada cliente en tres números:

  • Recencia: cuántos días han pasado desde su última compra. Entre menos, mejor.
  • Frecuencia: cuántas compras distintas ha hecho.
  • Monto: cuánto dinero ha dejado en total.
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

Escalar los datos

Aquí hay dos problemas, no uno:

  1. Las tres variables están en unidades distintas (días, compras, libras).
  2. Están muy sesgadas: la mediana del monto es de unas 670 libras, pero el cliente más grande gastó más de 280,000. Si escalamos así, un puñado de mayoristas enormes se lleva todo el peso y el resto de los clientes queda amontonado en un solo grupo.

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

Optimizar número de grupos

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")

Asignar número de grupos

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.

Agrupar los clientes

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

Graficar los grupos

fviz_cluster(clusters3, data = df3_escalados, geom = "point",
             repel = FALSE, ellipse.type = "norm") +
  labs(title = "Segmentos de clientes")

Agregar grupos a la base de datos

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

Nombrar los segmentos

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

Características de cada segmento

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.

Sugerencias para la empresa

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.