Clusters - Puntos, USArrests y Clientes

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.

Instalar paquetes y llamar librerías

# install.packages("cluster") # analísis 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)
# 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) se usaría en una base de datos que tenga variables muy diferentes, en este caso no.

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)
optimizacion1 <- 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(optimizacion1, xlab="Número de clusters k", main="Optimización de Clusters")

# se selecciona como óptimo el primer punto más alto. "3"
# si es diferente, después de esté plot, pues ovbiamente cambiamos el numero de grupos, en la linea de grupos1

Graficar 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

Conclusiones

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

———————————————————————————————————————-

Ejercicio 2. USArrests

Contexto

La base de datos USArrests 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)
optimizacion2 <- 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(optimizacion2, xlab="Número de clusters k", main="Optimización de Clusters")

# se selecciona como óptimo el primer punto más alto. "3"
# si es diferente, después de esté plot, pues ovbiamente cambiamos el numero de grupos, en la linea de grupos1

Graficar 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 ~ "Inseguidad Alta", 
    cluster == 5 ~ "Inseguridad Media",
    cluster == 3 ~ "Inseguridad Baja",
    cluster == 2 ~ "Inseguridad Muy Baja"
  ))
head(df2_clusters)

##            Murder Assault Rape              cluster
## Alabama      13.2     236 21.2    Inseguridad Media
## Alaska       10.0     263 44.5      Inseguidad Alta
## Arizona       8.1     294 31.0 Inseguridad Muy Alta
## Arkansas      8.8     190 19.5     Inseguridad Baja
## California    9.0     276 40.6      Inseguidad Alta
## Colorado      7.9     204 38.7      Inseguidad Alta

Conclusiones

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

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 con sede en Reino Unido. Contiene 522,064 renglones y 8 columnas: Ticket, Producto, Cantidad, Fecha, Hora, Precio, Cliente y País. Cada renglón es un producto dentro de un ticket, no un cliente, por lo que hay que transformar la base antes de poder agrupar.

El objetivo es segmentar a los clientes con el modelo RFM (Recencia, Frecuencia, Monetario) para diseñar estrategias comerciales distintas por grupo.

• Recencia: días transcurridos desde la última compra del cliente. Mientras más bajo, mejor.
• Frecuencia: número de tickets distintos que hizo el cliente.
• Monetario: dinero total gastado por el cliente.

Obtener Datos

df3 <- read.csv("/Users/marcelosalazar/Downloads/ventas.csv")

# renombrar columnas para evitar problemas con el acento de "País"
colnames(df3) <- c("Ticket","Producto","Cantidad","Fecha","Hora","Precio","Cliente","Pais")

Entender Datos

summary(df3)

##        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              Pais       
##  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

str(df3)

## '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 ...
##  $ Pais    : chr  "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...

head(df3,10)

##    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
## 7  536365   GLASS STAR FROSTED T-LIGHT HOLDER        6 01/12/2010 08:26:00
## 8  536366              HAND WARMER UNION JACK        6 01/12/2010 08:28:00
## 9  536366           HAND WARMER RED POLKA DOT        6 01/12/2010 08:28:00
## 10 536367       ASSORTED COLOUR BIRD ORNAMENT       32 01/12/2010 08:34:00
##    Precio Cliente           Pais
## 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
## 7    4.25   17850 United Kingdom
## 8    1.85   17850 United Kingdom
## 9    1.85   17850 United Kingdom
## 10   1.69   13047 United Kingdom

tail(df3,10)

##        Ticket                        Producto Cantidad      Fecha     Hora
## 522055 581587      ALARM CLOCK BAKELIKE GREEN        4 09/12/2011 12:50:00
## 522056 581587      ALARM CLOCK BAKELIKE IVORY        4 09/12/2011 12:50:00
## 522057 581587 CHILDRENS APRON SPACEBOY DESIGN        8 09/12/2011 12:50:00
## 522058 581587              SPACEBOY LUNCH BOX       12 09/12/2011 12:50:00
## 522059 581587      CHILDRENS CUTLERY SPACEBOY        4 09/12/2011 12:50:00
## 522060 581587     PACK OF 20 SPACEBOY NAPKINS       12 09/12/2011 12:50:00
## 522061 581587     CHILDREN'S APRON DOLLY GIRL        6 09/12/2011 12:50:00
## 522062 581587    CHILDRENS CUTLERY DOLLY GIRL        4 09/12/2011 12:50:00
## 522063 581587 CHILDRENS CUTLERY CIRCUS PARADE        4 09/12/2011 12:50:00
## 522064 581587    BAKING SET 9 PIECE RETROSPOT        3 09/12/2011 12:50:00
##        Precio Cliente   Pais
## 522055   3.75   12680 France
## 522056   3.75   12680 France
## 522057   1.95   12680 France
## 522058   1.95   12680 France
## 522059   4.15   12680 France
## 522060   0.85   12680 France
## 522061   2.10   12680 France
## 522062   4.15   12680 France
## 522063   4.15   12680 France
## 522064   4.95   12680 France

# clientes y países distintos
length(unique(df3$Cliente))

## [1] 4298

length(unique(df3$Pais))

## [1] 30

Limpiar Datos

# convertir la fecha a formato de fecha
df3$Fecha <- as.Date(df3$Fecha, format="%d/%m/%Y")

# eliminar renglones repetidos
df3 <- distinct(df3)

# eliminar renglones sin cliente identificado, no sirven para segmentar
df3 <- df3[!is.na(df3$Cliente), ]

# eliminar devoluciones y errores de captura (cantidades y precios negativos o en cero)
df3 <- df3[df3$Cantidad > 0, ]
df3 <- df3[df3$Precio > 0, ]

# crear el importe de cada renglón
df3$Importe <- df3$Cantidad * df3$Precio

nrow(df3)

## [1] 382737

length(unique(df3$Cliente))

## [1] 4296

Construir la tabla RFM

# fecha de referencia: un día después de la última venta registrada
fecha_referencia <- max(df3$Fecha) + 1

rfm <- df3 %>%
  group_by(Cliente) %>%
  summarise(
    Recencia   = as.numeric(fecha_referencia - max(Fecha)),
    Frecuencia = n_distinct(Ticket),
    Monetario  = sum(Importe)
  )

# pasar el número de cliente a nombre de renglón para que kmeans solo reciba números
df3_rfm <- as.data.frame(rfm)
rownames(df3_rfm) <- df3_rfm$Cliente
df3_rfm$Cliente <- NULL

summary(df3_rfm)

##     Recencia        Frecuencia        Monetario        
##  Min.   :  1.00   Min.   :  1.000   Min.   :     3.75  
##  1st Qu.: 18.00   1st Qu.:  1.000   1st Qu.:   305.60  
##  Median : 51.00   Median :  2.000   Median :   664.05  
##  Mean   : 93.16   Mean   :  4.227   Mean   :  1987.96  
##  3rd Qu.:143.00   3rd Qu.:  5.000   3rd Qu.:  1647.20  
##  Max.   :374.00   Max.   :209.000   Max.   :280206.02

head(df3_rfm)

##       Recencia Frecuencia Monetario
## 12346      326          1  77183.60
## 12347        3          7   4310.00
## 12349       19          1   1757.55
## 12350      311          1    334.40
## 12352       37          8   2506.04
## 12353      205          1     89.00

Escalar Datos

# las tres variables están en unidades muy distintas (días, tickets y libras),
# además el Monetario está muy sesgado: la media es 1,988 pero el máximo pasa de 280,000.
# primero se aplica logaritmo para reducir el efecto de esos clientes extremos
# y después se escala para que las tres pesen igual en el agrupamiento.
df3_escalados <- scale(log(df3_rfm))
summary(df3_escalados)

##     Recencia          Frecuencia        Monetario       
##  Min.   :-2.74439   Min.   :-1.0503   Min.   :-4.18326  
##  1st Qu.:-0.65739   1st Qu.:-1.0503   1st Qu.:-0.68137  
##  Median : 0.09459   Median :-0.2791   Median :-0.06377  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.83904   3rd Qu.: 0.7403   3rd Qu.: 0.65918  
##  Max.   : 1.53323   Max.   : 4.8933   Max.   : 4.74671

Asignar número de grupos

grupos3 <- 4

Agrupar los clientes

set.seed(123)
clusters3 <- kmeans(df3_escalados, grupos3)
clusters3$size

## [1]  822  753 1231 1490

clusters3$centers

##     Recencia Frecuencia  Monetario
## 1 -0.7046971 -0.4570801 -0.4919384
## 2 -1.3005622  1.5115932  1.3420375
## 3  0.1445978  0.4182126  0.4871489
## 4  0.9265667 -0.8572682 -0.8093028

Optimizar número de grupos

set.seed(123)
# B=25 en lugar del valor por defecto (100) porque son más de 4,000 clientes
# y el cálculo se vuelve muy lento.
optimizacion3 <- clusGap(df3_escalados, FUN=kmeans, nstart=1, K.max=10, B=25)
plot(optimizacion3, xlab="Número de clusters k", main="Optimización de Clusters")

# se selecciona como óptimo el primer punto más alto.
# si sale distinto de 4, se cambia el número en la línea de grupos3 y se vuelve a correr.

Graficar los grupos

fviz_cluster(clusters3, data = df3_escalados, geom = "point") +
  ggtitle("Segmentación de Clientes")

Agregar grupos a la base de datos

df3_clusters <- cbind(df3_rfm, cluster = clusters3$cluster)
head(df3_clusters)

##       Recencia Frecuencia Monetario cluster
## 12346      326          1  77183.60       3
## 12347        3          7   4310.00       2
## 12349       19          1   1757.55       1
## 12350      311          1    334.40       4
## 12352       37          8   2506.04       3
## 12353      205          1     89.00       4

# perfil de cada grupo con los valores reales, no los escalados
perfil <- df3_clusters %>%
  group_by(cluster) %>%
  summarise(
    Clientes           = n(),
    Recencia_promedio  = mean(Recencia),
    Frecuencia_promedio= mean(Frecuencia),
    Monetario_promedio = mean(Monetario)
  )
perfil

## # A tibble: 4 × 5
##   cluster Clientes Recencia_promedio Frecuencia_promedio Monetario_promedio
##     <int>    <int>             <dbl>               <dbl>              <dbl>
## 1       1      822              22.2                1.90               479.
## 2       2      753              11.1               12.8               7343.
## 3       3     1231              72.5                4.14              1717.
## 4       4     1490             191.                 1.27               338.

# nombrar los grupos según la tabla de arriba:
# recencia baja + frecuencia y monto altos = mejores clientes
# recencia alta + frecuencia y monto bajos = clientes perdidos
df3_clusters <- df3_clusters %>%
  mutate(cluster = case_when(
    cluster == 1 ~ "Clientes Leales",
    cluster == 2 ~ "Clientes en Riesgo",
    cluster == 3 ~ "Clientes Nuevos",
    cluster == 4 ~ "Clientes Perdidos"
  ))
head(df3_clusters)

##       Recencia Frecuencia Monetario            cluster
## 12346      326          1  77183.60    Clientes Nuevos
## 12347        3          7   4310.00 Clientes en Riesgo
## 12349       19          1   1757.55    Clientes Leales
## 12350      311          1    334.40  Clientes Perdidos
## 12352       37          8   2506.04    Clientes Nuevos
## 12353      205          1     89.00  Clientes Perdidos

Conclusiones

La segmentación RFM permite dejar de tratar a los más de 4,000 clientes como un solo bloque y diseñar acciones distintas para cada grupo. Los clientes leales, que compran seguido y gastan más, sostienen la mayor parte de los ingresos y conviene retenerlos con programas de lealtad o preventas. Los clientes en riesgo, que gastaban bien pero llevan meses sin comprar, son los que más urgen recuperar con campañas de reactivación. Los clientes nuevos necesitan estímulos para lograr una segunda compra, y en los clientes perdidos no vale la pena invertir esfuerzo comercial.

Vale la pena señalar dos limitaciones. La primera es que se eliminaron los renglones sin cliente identificado, que representan alrededor de una cuarta parte de la base, por lo que el análisis solo describe a los clientes registrados. La segunda es que el modelo RFM mide comportamiento de compra, no rentabilidad: un cliente puede gastar mucho y dejar poco margen.