library(tidyverse)
library(janitor)
library(corrplot)
library(patchwork)
library(VIM)
library(funModeling)
library(formattable)
library(PerformanceAnalytics)
library(h2o)
library(cluster)
library(factoextra)
library(dendextend)
library(rmarkdown)
library(arules)

1 ANÁLISIS EXPLORATORIO DE DATOS

1.1 Primera exploración

datos<-read.csv("Bank_Segmentation.csv")
paged_table(datos)
str(datos)
## 'data.frame':    8950 obs. of  18 variables:
##  $ CUST_ID                         : chr  "C10001" "C10002" "C10003" "C10004" ...
##  $ BALANCE                         : num  40.9 3202.5 2495.1 1666.7 817.7 ...
##  $ BALANCE_FREQUENCY               : num  0.818 0.909 1 0.636 1 ...
##  $ PURCHASES                       : num  95.4 0 773.2 1499 16 ...
##  $ ONEOFF_PURCHASES                : num  0 0 773 1499 16 ...
##  $ INSTALLMENTS_PURCHASES          : num  95.4 0 0 0 0 ...
##  $ CASH_ADVANCE                    : num  0 6443 0 206 0 ...
##  $ PURCHASES_FREQUENCY             : num  0.1667 0 1 0.0833 0.0833 ...
##  $ ONEOFF_PURCHASES_FREQUENCY      : num  0 0 1 0.0833 0.0833 ...
##  $ PURCHASES_INSTALLMENTS_FREQUENCY: num  0.0833 0 0 0 0 ...
##  $ CASH_ADVANCE_FREQUENCY          : num  0 0.25 0 0.0833 0 ...
##  $ CASH_ADVANCE_TRX                : int  0 4 0 1 0 0 0 0 0 0 ...
##  $ PURCHASES_TRX                   : int  2 0 12 1 1 8 64 12 5 3 ...
##  $ CREDIT_LIMIT                    : num  1000 7000 7500 7500 1200 1800 13500 2300 7000 11000 ...
##  $ PAYMENTS                        : num  202 4103 622 0 678 ...
##  $ MINIMUM_PAYMENTS                : num  140 1072 627 NA 245 ...
##  $ PRC_FULL_PAYMENT                : num  0 0.222 0 0 0 ...
##  $ TENURE                          : int  12 12 12 12 12 12 12 12 12 12 ...
summary(datos)
##    CUST_ID             BALANCE        BALANCE_FREQUENCY   PURCHASES       
##  Length:8950        Min.   :    0.0   Min.   :0.0000    Min.   :    0.00  
##  Class :character   1st Qu.:  128.3   1st Qu.:0.8889    1st Qu.:   39.63  
##  Mode  :character   Median :  873.4   Median :1.0000    Median :  361.28  
##                     Mean   : 1564.5   Mean   :0.8773    Mean   : 1003.20  
##                     3rd Qu.: 2054.1   3rd Qu.:1.0000    3rd Qu.: 1110.13  
##                     Max.   :19043.1   Max.   :1.0000    Max.   :49039.57  
##                                                                           
##  ONEOFF_PURCHASES  INSTALLMENTS_PURCHASES  CASH_ADVANCE     PURCHASES_FREQUENCY
##  Min.   :    0.0   Min.   :    0.0        Min.   :    0.0   Min.   :0.00000    
##  1st Qu.:    0.0   1st Qu.:    0.0        1st Qu.:    0.0   1st Qu.:0.08333    
##  Median :   38.0   Median :   89.0        Median :    0.0   Median :0.50000    
##  Mean   :  592.4   Mean   :  411.1        Mean   :  978.9   Mean   :0.49035    
##  3rd Qu.:  577.4   3rd Qu.:  468.6        3rd Qu.: 1113.8   3rd Qu.:0.91667    
##  Max.   :40761.2   Max.   :22500.0        Max.   :47137.2   Max.   :1.00000    
##                                                                                
##  ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
##  Min.   :0.00000            Min.   :0.0000                  
##  1st Qu.:0.00000            1st Qu.:0.0000                  
##  Median :0.08333            Median :0.1667                  
##  Mean   :0.20246            Mean   :0.3644                  
##  3rd Qu.:0.30000            3rd Qu.:0.7500                  
##  Max.   :1.00000            Max.   :1.0000                  
##                                                             
##  CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX  PURCHASES_TRX     CREDIT_LIMIT  
##  Min.   :0.0000         Min.   :  0.000   Min.   :  0.00   Min.   :   50  
##  1st Qu.:0.0000         1st Qu.:  0.000   1st Qu.:  1.00   1st Qu.: 1600  
##  Median :0.0000         Median :  0.000   Median :  7.00   Median : 3000  
##  Mean   :0.1351         Mean   :  3.249   Mean   : 14.71   Mean   : 4494  
##  3rd Qu.:0.2222         3rd Qu.:  4.000   3rd Qu.: 17.00   3rd Qu.: 6500  
##  Max.   :1.5000         Max.   :123.000   Max.   :358.00   Max.   :30000  
##                                                            NA's   :1      
##     PAYMENTS       MINIMUM_PAYMENTS   PRC_FULL_PAYMENT     TENURE     
##  Min.   :    0.0   Min.   :    0.02   Min.   :0.0000   Min.   : 6.00  
##  1st Qu.:  383.3   1st Qu.:  169.12   1st Qu.:0.0000   1st Qu.:12.00  
##  Median :  856.9   Median :  312.34   Median :0.0000   Median :12.00  
##  Mean   : 1733.1   Mean   :  864.21   Mean   :0.1537   Mean   :11.52  
##  3rd Qu.: 1901.1   3rd Qu.:  825.49   3rd Qu.:0.1429   3rd Qu.:12.00  
##  Max.   :50721.5   Max.   :76406.21   Max.   :1.0000   Max.   :12.00  
##                    NA's   :313

Haciendo una primera inspección llegamos a las siguientes conclusiones:

  • Parece que se trata de una base de datos que contiene información sobre 8.950 clientes de tarjetas de crédito.
  • Existen valores ausentes en las variables CREDIT_LIMIT(1) y MINIMUM_PAYMENTS(313).
  • Hay variables que aparecen tanto en términos monetarios como de frecuencia (FREQUENCY). En el caso de PURCHASES y CASH ADVANCE, también cuentan con una variable acabada en TRX.
  • TRX es un acrónimo que suele utilizarse para referirse a la palabra Transaction, por lo que suponemos que las variables CASH_ADVANCE_TRX y PURCHASES_TRX son el número de adelantos de efectivo y de compras realizadas con la tarjeta.
  • La variable TENURE parece hacer referencia al número de meses que los clientes han permanecido con la tarjeta, siendo 12 al menos en el 75% de los casos. Los clientes con un valor menor a 12 podrían tratarse de clientes que cancelaron la tarjeta.
  • La variable PURCHASES es igual a la suma de ONEOFF_PURCHASES e INSTALLMENT_PURCHASES (a excepción de 19 casos que, tras ser analizados, entiendo que se tratan de errores y los elimino):
nrow(datos)
## [1] 8950
datos %>% filter(round(PURCHASES)==round(ONEOFF_PURCHASES+INSTALLMENTS_PURCHASES)) %>% count() # Redondeo para evitar problemas con decimales
##      n
## 1 8931
datos<-datos %>% filter(round(PURCHASES)==round(ONEOFF_PURCHASES+INSTALLMENTS_PURCHASES))
  • Las variables terminadas en FREQUENCY hacen referencia al número de veces que se ha comprado, adelantado efectivo o realizado algún movimiento en el balance, normalizado por el número de meses que se ha tenido la tarjeta (TENURE). Por tanto, una mayor frecuencia representará una mayor regularidad en el tiempo en el uso de la tarjeta. Esto se puede constatar comprobando que los valores de estas variables son múltiplos de 1/TENURE.
# Para TENURE==12
tenure12<-filter(datos,TENURE==12) 
sort(unique(tenure12$PURCHASES_FREQUENCY))
##  [1] 0.000000 0.083333 0.166667 0.250000 0.333333 0.416667 0.500000 0.583333
##  [9] 0.666667 0.750000 0.833333 0.916667 1.000000
sort(unique(tenure12$CASH_ADVANCE_FREQUENCY)) 
##  [1] 0.000000 0.083333 0.166667 0.250000 0.333333 0.416667 0.500000 0.583333
##  [9] 0.666667 0.750000 0.833333 0.916667 1.000000
# Para TENURE==8
tenure8<-filter(datos,TENURE==8) 
sort(unique(tenure8$PURCHASES_FREQUENCY))
## [1] 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000
sort(unique(tenure8$CASH_ADVANCE_FREQUENCY))
##  [1] 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 1.125 1.250

Otra sospecha era que las variables FRECUENCY hubieran sido calculadas como el número de transaciones (TRX) normalizado por TENURE. Sin embargo, se ha constatado que no es así:

datos %>% filter(round(PURCHASES_FREQUENCY,2)!=round(PURCHASES_TRX/TENURE,2)) %>% count() %>%
  mutate(prop=round(n/nrow(datos),2))
##      n prop
## 1 4361 0.49
datos %>% filter(round(CASH_ADVANCE_FREQUENCY,2)!=round(CASH_ADVANCE_TRX/TENURE,2)) %>% count() %>% 
  mutate(prop=round(n/nrow(datos),2))
##      n prop
## 1 2731 0.31
  • Existen 8 casos en los que la variable CASH_ADVANCE_FREQUENCY es mayor que 1. Al tratarse de pocos casos, supondremos que se tratan de errores y los eliminaremos:
datos %>% filter(CASH_ADVANCE_FREQUENCY>1) %>% count()
##   n
## 1 8
datos<-datos %>% filter(CASH_ADVANCE_FREQUENCY<=1)

Aunque ya tenemos una idea del significado de la mayoría de variables, no está tan claro respecto a las variables relativas a pagos (PAYMENTS, MINIMUM_PAYMENTS,PRC_FULL_PAYMENTS). Por otro lado, aunque la variable BALANCE parece indicar el saldo de la tarjeta, no está tan claro como se obtiene el mismo. Vamos a echar un vistazo a las correlaciones.

1.2 Correlaciones

correl<-cor(select_if(datos,is.numeric),use = "complete.obs")

corrplot(correl, method = "color", order = "hclust", type = "full", 
         tl.col = "grey10", tl.srt = 90,
         col = colorRampPalette(c("orangered2","white","darkgreen"))(200), 
         outline = T, addCoef.col = "white", addCoefasPercent = T,
         number.cex = 0.67, title = "Matriz de correlaciones",
         mar = c(0,0,2,0), tl.cex = 0.5,tl.pos = "l")

Apreciaciones relacionadas con la variable BALANCE:

  • Está bastante correlacionada con las variables CREDIT_LIMIT, CASH_ADVANCE Y MINIMUM_PAYMENTS, por lo que seguramente en el cálculo del saldo de las tarjetas intervengan de alguna forma dichas variables.
  • Por otro lado, llama la atención que prácticamente no tenga correlación con las variables relativas a PURCHASES. Una posible explicación a esto podría ser que las variables PURCHASES hagan referencia a las compras realizadas (sin necesidad de que se efectué desembolso alguno debido, por ejemplo, a aplazamientos de pago) y las variables relativas a PAYMENTS hagan referencia al pago efectivo de dichas compras.
  • La variable PRC_FULL_PAYMENT tiene una correlación negativa notable con BALANCE, por lo que mayores valores de la misma implican un menor saldo en la tarjeta.
  • El hecho de que los pagos y los adelantos de efectivo estén positivamente correlacionados con BALANCE indica que el saldo de la tarjeta hace referencia a la deuda que tiene el cliente con la entidad bancaria, y no el resultado de restar al límite de crédito todos los pagos como se podría pensar.

Otras apreciaciones:

  • Llama la atención que las variables PURCHASES y CASH_ADVANCE estén muy correlacionadas con la variable PAYMENTS, pero prácticamente nada con la variable MINIMUM_PAYMENT.

  • Las variables más correlacionadas con PURCHASES_FRECUENCY y CASH_ADVANCE_FRECUENCY son PURCHASES_TRX y CASH_ADVANCE_TRX, respectivamente. Esto refuerza la teoría anterior de que las variables de frecuencia hacen referencia al número de meses en los que se ha comprado o adelantado efectivo, normalizado por TENURE, ya que si se realizan un mayor número de transacciones es más probable que abarquen un mayor número de meses.

2 Creación de nuevas variables

Vamos a crear tres nuevas variables que pueden ser interesantes a la hora de analizar y segmentar los clientes:

  • MEAN_PURCHASES: importe medio de compras, calculado como PURCHASES/PURCHASES_TRX.
  • MEAN_CASH_ADVANCE: importe medio de adelantos de efectivo, calculado como CASH_ADVANCE/CASH_ADVANCE_TRX.
  • CHURN: 0 si TENURE==12 y 1 en caso contrario (suponemos que los clientes que han tenido la tarjeta menos de 12 meses es porque la han cancelado).
  • PRC_INSTALLMENTS: porcentaje de compras a plazo sobre el total de compras.
datos<-datos %>% mutate(MEAN_PURCHASES=ifelse(PURCHASES_TRX==0,0,PURCHASES/PURCHASES_TRX),
                        MEAN_CASH_ADVANCE=ifelse(CASH_ADVANCE_TRX==0,0,CASH_ADVANCE/CASH_ADVANCE_TRX), 
                        PRC_INSTALLMENTS=ifelse(PURCHASES==0,0,INSTALLMENTS_PURCHASES/PURCHASES),
                        CHURN=as.factor(ifelse(datos$TENURE==12,0,1)))
datos %>% tabyl(CHURN) %>% adorn_pct_formatting(digits = 0)
##  CHURN    n percent
##      0 7568     85%
##      1 1355     15%

3 ANÁLISIS GRÁFICO

En primer lugar, realizaremos los histogramas de las diferentes variables:

plot_num(datos)

En general se trata de histogramas muy asimétricos, debido a la existencia de valores extremos.

Ahora, realizaremos gráficos de dispersión entre algunas variables (BALANCE, CREDIT_LIMIT, PURCHASES, CASH_ADVANCE y PAYMENTS) para un mejor análisis de las relaciones (la función empleada se especifica en el anexo del final del documento):

p1<-grafico_dispersion(datos,"BALANCE","PURCHASES",0.98)
p2<-grafico_dispersion(datos,"BALANCE","PAYMENTS",0.98)
p3<-grafico_dispersion(datos,"BALANCE","CASH_ADVANCE",0.98)
p4<-grafico_dispersion(datos,"BALANCE","CREDIT_LIMIT",0.98)
p5<-grafico_dispersion(datos,"PURCHASES","PAYMENTS",0.98)
p6<-grafico_dispersion(datos,"PURCHASES","CASH_ADVANCE",0.98)
p7<-grafico_dispersion(datos,"PURCHASES","CREDIT_LIMIT",0.98)
p8<-grafico_dispersion(datos,"PAYMENTS","CASH_ADVANCE",0.98)
p9<-grafico_dispersion(datos,"PAYMENTS","CREDIT_LIMIT",0.98)
p10<-grafico_dispersion(datos,"CASH_ADVANCE","CREDIT_LIMIT",0.98)

(p1|p2)/(p3|p4)

(p5|p6)/(p7|p8)

p9+p10

Los gráficos anteriores vuelven a corroborar las relaciones ya indicadas en el análisis de correlaciones.
LLama la atención la relación entre CREDIT_LIMIT y BALANCE, ya que parece que esta última nunca es mayor que la primera. Lo comprobamos:

datos %>% filter(BALANCE>CREDIT_LIMIT) %>% count() %>%  mutate(prop=round(n/nrow(datos),2))
##     n prop
## 1 226 0.03

Tan sólo un 3% de las observaciones tiene un saldo de trajeta mayor que el límite de crédito. Esto vuelve a corroborar que el saldo de la tarjeta hace referencia a la deuda del cliente con la entidad.

Ahora vamos a crear gráficos de densidad (función especificada en el anexo) cruzando todas las variables con la variable CHURN que hemos creado anteriormente para determinar la capacidad de estas variables de discriminar entre personas que cancelan la tarjeta de las que no:

g1<-grafico_densidad(datos,"BALANCE","CHURN",0.98)
g2<-grafico_densidad(datos,"BALANCE_FREQUENCY","CHURN")
g3<-grafico_densidad(datos,"PURCHASES","CHURN",0.98)
g4<-grafico_densidad(datos,"ONEOFF_PURCHASES","CHURN",0.98)
g5<-grafico_densidad(datos,"INSTALLMENTS_PURCHASES","CHURN",0.98)
g6<-grafico_densidad(datos,"PURCHASES_FREQUENCY","CHURN")
g7<-grafico_densidad(datos,"ONEOFF_PURCHASES_FREQUENCY","CHURN")
g8<-grafico_densidad(datos,"PURCHASES_INSTALLMENTS_FREQUENCY","CHURN")
g9<-grafico_densidad(datos,"PURCHASES_TRX","CHURN",0.98)
g10<-grafico_densidad(datos,"MEAN_PURCHASES","CHURN",0.98)
g11<-grafico_densidad(datos,"CASH_ADVANCE","CHURN",0.98)
g12<-grafico_densidad(datos,"CASH_ADVANCE_FREQUENCY","CHURN")
g13<-grafico_densidad(datos,"CASH_ADVANCE_TRX","CHURN",0.98)
g14<-grafico_densidad(datos,"MEAN_CASH_ADVANCE","CHURN",0.98)
g15<-grafico_densidad(datos,"CREDIT_LIMIT","CHURN",0.98)
g16<-grafico_densidad(datos,"PAYMENTS","CHURN",0.98)
g17<-grafico_densidad(datos,"MINIMUM_PAYMENTS","CHURN",0.98)
g18<-grafico_densidad(datos,"PRC_FULL_PAYMENT","CHURN")

(g1|g2)/(g3|g4)+plot_layout(guides = 'collect')

(g5|g6)/(g7|g8)+plot_layout(guides = 'collect')

(g9|g10)/(g11|g12)+plot_layout(guides = 'collect')

(g13|g14)/(g15|g16)+plot_layout(guides = 'collect')

g17+g18+plot_layout(guides = 'collect')

En general podemos ver que las personas que cancelan la tarjeta se trata de personas que compran/pagan poco y con menos frecuencia y que tienen un límite de crédito más bajo. Por otro lado, las personas que no cancelan la tarjeta tienen valores de PRC_FULL_PAYMENTS más bajos.
LLama la atención que los clientes que cancelan la tarjeta realizan más adelantos de efectivo que los que no.
Hay que tener en cuenta que obviamente los clientes que han cancelado la tarjeta han estado menos tiempo expuestos y, por tanto, es normal que tengan un valor menor de las variables PURCHASES (ONEOFF e INSTALLMENTS), CASH_ADVANCE, PAYMENTS y MINIMUM_PAYMENTS, por lo que los gráficos de estas variables no son muy representativos.

Este análisis se puede hacer tambien mediante la siguiente tabla, que muestra la mediana (medida más robusta que la media ante variables con ouliers) de cada variable agrupada en función de la variable CHURN:

tabla<-datos %>% group_by(CHURN) %>% 
  summarise(BALANCE=median(BALANCE),PURCHASES=median(PURCHASES),ONEOFF_PURCHASES=median(ONEOFF_PURCHASES),
            INSTALLMENTS_PURCHASES=median(INSTALLMENTS_PURCHASES),PURCHASES_TRX=median(PURCHASES_TRX),
            MEAN_PURCHASES=median(MEAN_PURCHASES),CASH_ADVANCE=median(CASH_ADVANCE),
            CASH_ADVANCE_TRX=median(CASH_ADVANCE_TRX),MEAN_CASH_ADVANCE=median(MEAN_CASH_ADVANCE),
            CREDIT_LIMIT=median(CREDIT_LIMIT,na.rm = TRUE),
            PAYMENTS=median(PAYMENTS),MINIMUM_PAYMENTS=median(MINIMUM_PAYMENTS,na.rm = TRUE)) %>%
  pivot_longer(cols = -c("CHURN"),names_to = "Variable",values_to = "mediana") %>%  
  pivot_wider(names_from = "CHURN",values_from = "mediana") %>% rename(No=`0`,Si=`1`) %>% 
  mutate_if(is.numeric, ~round(.x)) %>% 
  formattable()
tabla
Variable No Si
BALANCE 913 687
PURCHASES 403 190
ONEOFF_PURCHASES 53 0
INSTALLMENTS_PURCHASES 111 0
PURCHASES_TRX 8 3
MEAN_PURCHASES 42 37
CASH_ADVANCE 0 312
CASH_ADVANCE_TRX 0 1
MEAN_CASH_ADVANCE 0 94
CREDIT_LIMIT 3500 2000
PAYMENTS 959 449
MINIMUM_PAYMENTS 330 229

3.1 Otras preguntas

Algunas preguntas que nos podemos plantear:

  • ¿Los clientes compran más en la modalidad de pago único o de pago fraccionado?
datos %>% filter(PURCHASES !=0) %>% pivot_longer(cols = c("ONEOFF_PURCHASES","INSTALLMENTS_PURCHASES"),names_to="modalidad",values_to="importe") %>% group_by(modalidad) %>% summarise(media=round(mean(importe)),mediana=round(median(importe))) %>% formattable()
modalidad media mediana
INSTALLMENTS_PURCHASES 533 233
ONEOFF_PURCHASES 769 196

En media los clientes compran más en la modalidad de pago único, sin embargo, si consideramos la mediana es ligeramente mayor el volumen de compras a plazo. Esto se debe a la mayor dispersión o mayor nivel de outliers en la variable pago único que en la de pago fraccionado.

  • ¿Los clientes que realizan adelantos de efectivo compran/pagan más o menos que los que no?
# COMPRAS
datos %>% mutate(adelanto=ifelse(CASH_ADVANCE==0,0,1)) %>% group_by(adelanto) %>% summarise(num=n(),media=round(mean(PURCHASES)),mediana=round(median(PURCHASES))) %>% 
  formattable()
adelanto num media mediana
0 4615 1349 600
1 4308 635 55 
# PAGOS
datos %>% mutate(adelanto=ifelse(CASH_ADVANCE==0,0,1)) %>% group_by(adelanto) %>% summarise(num=n(),media=round(mean(PAYMENTS)),mediana=round(median(PAYMENTS))) %>% 
  formattable()
adelanto num media mediana
0 4615 1428 704
1 4308 2057 1069

Los clientes que relizan adelantos de efectivo compran menos, pero pagan más. Recordemos que los adelantos de efectivo tenían una correlación positiva importante con los pagos. Lo que nos lleva a la siguiente pregunta:

  • ¿Los adelantos de efectivo pueden ser una subcategoría de pagos?
datos %>% filter(CASH_ADVANCE<=PAYMENTS) %>% count() %>% mutate(prop=round(n/nrow(datos),2)) %>% formattable()
n prop
6901 0.77

La respuesta es negativa, ya que el 22% de los clientes tienen importes de adelantos de efectivo mayores que de pagos.

  • ¿Hay un registro para cada cliente o pueden haber varios registros de un mismo cliente?
nrow(datos)
## [1] 8923
length(unique(datos$CUST_ID))
## [1] 8923

Existe un único registro por cada cliente.

3.2 Valores ausentes

Como hemos señalado anteriormente existen valores ausentes en las variables CREDIT_LIMIT Y MINIMUM_PAYMENT. Como contamos con un número elevado de observaciones y el porcentaje de ausentes es muy reducido, eliminaremos dichos registros:

aggr(datos,cex.axis=0.5,plot = FALSE)
## 
##  Missings in variables:
##          Variable Count
##      CREDIT_LIMIT     1
##  MINIMUM_PAYMENTS   313
datos<-datos %>% filter(!is.na(CREDIT_LIMIT) & !is.na(MINIMUM_PAYMENTS))

4 SEGMENTACIÓN

La segmentación de este conjunto de clientes se va a realizar a través de dos enfoques:

  • Modelo ICF(Importe-Cantidad-Frecuencia).
  • Modelo clúster.

4.1 Modelo ICF:

Este modelo consistirá en crear segmentos a través de tres dimensiones:

  • Importe: medido a través del importe medio por compra (MEAN_PURCHASES).
  • Cantidad: medido a través del número de compras realizadas (PURCHASES_TRX).
  • Frecuencia: medido a traves del número de meses del año en los que se ha realizado alguna compra entre el número de meses del año que se ha tenido la tarjeta (PURCHASES_FREQUENCY).
    Para ello, haremos una agrupación por quintiles de los clientes para cada una de las dimensiones, asignandole un ranking (del 1 al 5) para cada una de ellas.
    Cabe señalar que, para este caso, dejamos fuera aquellos clientes que no han hecho ninguna compra, ya que constituyen ya un segmento específico de clientes.
datos_ICF<-datos %>% filter(PURCHASES!=0) %>% #Eliminamos clientes que no han comprado
  select(MEAN_PURCHASES,PURCHASES_FREQUENCY,PURCHASES_TRX) # Seleccionamos variables
datos_ICF$rank_imp<-ntile(datos_ICF$MEAN_PURCHASES,5) # Ranking para la dimensión importe
datos_ICF$rank_cant<-ntile(datos_ICF$PURCHASES_TRX,5) # Ranking para la dimensión cantidad
datos_ICF$rank_freq<-ntile(datos_ICF$PURCHASES_FREQUENCY,5) # Ranking para la dimensión frecuencia
datos_ICF$ICF<-paste(datos_ICF$rank_imp,datos_ICF$rank_cant,datos_ICF$rank_freq,sep = "_") #Segmentos

Una vez creados los segmentos, vemos cuántos hay:

length(unique(datos_ICF$ICF))
## [1] 110

Creamos una tabla descriptiva de los segmentos creados y examinamos los 50 segmentos con mayor número de clientes:

tabla_segmentos<-datos_ICF %>%
  group_by(ICF) %>%
  summarise(num=n(),porc=num/nrow(datos_ICF),media_imp=mean(MEAN_PURCHASES),media_cant=mean(PURCHASES_TRX),
            media_freq=mean(PURCHASES_FREQUENCY)) %>% 
  arrange(-num) %>%
  formattable()

tabla_segmentos[-1]<-round(tabla_segmentos[-1],2) 
tabla_segmentos[1:50,]
ICF num porc media_imp media_cant media_freq
5_1_1 449 0.07 401.75 1.59 0.12
4_1_1 211 0.03 86.20 1.79 0.13
5_2_2 195 0.03 250.18 5.91 0.39
1_1_1 171 0.03 18.49 1.73 0.13
1_2_2 169 0.03 19.77 5.53 0.42
3_1_1 166 0.02 55.87 1.83 0.13
4_2_2 160 0.02 85.84 6.14 0.41
4_5_4 157 0.02 83.24 59.17 0.97
2_1_1 155 0.02 38.20 1.69 0.12
2_2_2 149 0.02 36.52 5.72 0.41
3_5_5 149 0.02 55.45 61.42 1.00
3_5_4 146 0.02 55.51 63.01 0.98
3_2_2 144 0.02 55.48 6.10 0.41
2_5_5 138 0.02 37.62 65.88 1.00
2_5_4 128 0.02 36.59 58.62 0.98
1_3_5 125 0.02 18.61 11.71 1.00
3_4_3 121 0.02 55.97 19.33 0.73
1_5_5 120 0.02 19.68 59.67 1.00
1_4_5 114 0.02 20.16 20.35 1.00
4_4_3 114 0.02 84.96 19.00 0.72
4_5_5 107 0.02 82.80 57.63 1.00
1_3_3 101 0.02 20.34 10.50 0.74
2_4_3 99 0.01 38.16 18.59 0.75
2_3_5 96 0.01 36.87 11.76 1.00
4_4_4 96 0.01 84.99 20.84 0.96
3_4_4 92 0.01 55.75 21.18 0.95
1_3_4 91 0.01 19.40 11.46 0.95
3_3_3 90 0.01 54.30 10.41 0.70
4_3_3 90 0.01 85.41 11.12 0.72
2_4_4 89 0.01 37.81 20.40 0.96
2_4_5 86 0.01 37.41 19.52 1.00
1_5_4 79 0.01 19.93 69.04 0.98
5_4_3 79 0.01 177.52 19.05 0.74
2_3_3 78 0.01 36.71 10.55 0.74
5_5_4 76 0.01 167.35 61.07 0.98
2_3_4 75 0.01 37.08 11.63 0.95
3_4_5 70 0.01 56.20 20.86 1.00
1_4_4 68 0.01 20.02 20.32 0.95
3_3_5 66 0.01 55.74 11.85 1.00
1_4_3 64 0.01 20.44 18.59 0.73
2_2_3 62 0.01 38.08 7.39 0.64
1_2_3 61 0.01 19.14 7.49 0.65
5_3_3 59 0.01 197.26 10.69 0.71
4_3_2 57 0.01 84.71 10.61 0.42
5_4_4 57 0.01 177.42 19.25 0.96
4_4_5 54 0.01 82.79 20.74 1.00
2_3_2 52 0.01 37.61 10.77 0.46
3_2_3 52 0.01 55.08 7.40 0.65
5_2_1 52 0.01 218.47 5.40 0.21
3_3_4 51 0.01 55.37 11.63 0.95

Canto mayor es el número del ranking, mayor es la dimensión que mide. Por ejemplo, la primera categoría (5_1_1) indicaría clientes cuyo importe medio de compra es muy alto, pero la cantidad y la frecuencia es muy baja, es decir, seguramente clientes que han hecho una o dos compras con importes altos.
Hay que tener en cuenta, como ya se ha señalado antes, que las dimensiones cantidad y frecuencia estan muy correlacionadas, motivo por el cual hay muchos clientes en aquellos segmentos donde el ranking de cantidad y frecuencia es el mismo o similar(por ejemplo, 5_1_1) y muy pocos o incluso ninguno en aquellos donde el ranking de estas dos dimensiones es muy dispar (por ejemplo, 4_4_1). Este último ejemplo podría tratarse de clientes que han hecho bastantes compras pero concentradas en pocos meses. La casuística de pocas compras y mucha frecuencia es más improbable.

Realizamos un mapa de calor que representa las tres dimensiones. Aquí también podemos constatar lo que se acaba de argumentar, ya que el primer quintil de cantidad se corresponde con los colores más oscuros (menos frecuencia).

ggplot(datos_ICF)+geom_tile(aes(x = as.factor(rank_cant),y = as.factor(rank_imp),fill=rank_freq))+
  labs(title="Mapa de calor modelo ICF",x="Ranking por cantidad",y="Ranking por importe")

4.2 Modelo cluster

Realizaremos un análisis clúster

No incluímos las variables relacionadas con la frecuencia. Tampoco incluímos la variable BALANCE, por estar fuertemente correlacionada con el balance. En lugar de las variables ONEOFF_PURCHASES y PURCHASES_INSTALLMENTS seleccionamos la variable PRC_INSTALLMENTS. Tampoco incluímos las variables PURCHASES ni CASH_ADVANCE porque existirían problemas de colinealidad perfecta, ya que son el producto del número de transacciones (TRX) y el importe medio (MEAN_PURCHASES y MEAN_CASH_ADVANCE).

seleccion<-select(datos,MEAN_PURCHASES,PURCHASES_TRX,PRC_INSTALLMENTS,MEAN_CASH_ADVANCE,CASH_ADVANCE_TRX,
                  CREDIT_LIMIT,PAYMENTS,MINIMUM_PAYMENTS,PRC_FULL_PAYMENT)

En primer lugar, normalizamos las variables:

seleccion<-scale(seleccion)
seleccion<-as.data.frame(seleccion)

El modelo de clúster que desarrollaremos será un K-medoids, ya que es más robusto y adecuado ante datos con outliers, ya que, a diferencia del k-means donde los centroides son la media de los componentes del clúster, en el modelo k-medoids los centroides se corresponden con una de las observaciones (medoid) que será representativa del resto. Por otro lado, la medida de distancia será la de Manhattan, más robusta frente a outliers.

En primer lugar, calcularemos un gráfico de sedimentación que representará la suma total de cuadrados intragrupos (wss) para cada número de clúster. De esta forma seleccionaremos el número de clústers óptimo.

graf_sed<-fviz_nbclust(x = seleccion, FUNcluster = pam, method = "wss", k.max = 15,
             diss = dist(seleccion, method = "manhattan"))
graf_sed

Si nos fijamos en el gráfico anterior, un número óptimo de clusters sería 8. Estimamos el modelo:

cluster_pam<-pam(x = seleccion, k = 8, metric = "manhattan")

Analizamos el tamaño de los clusters para comprobar que son adecuados:

tamaños<-data.frame(cluster=seq(1,8,1),size=cluster_pam$clusinfo[,1]) %>% formattable()
tamaños
cluster size
1 1977
2 798
3 1537
4 500
5 833
6 1558
7 626
8 780

Los tamaños son correctos. Ahora realizaremos una tabla con los valores de cada variable de las observaciones que son medoids de cada clúster, y por tanto son valores representativos:

cluster_pam$medoids %>% as.data.frame %>% round(digits = 2) %>% formattable()
MEAN_PURCHASES PURCHASES_TRX PRC_INSTALLMENTS MEAN_CASH_ADVANCE CASH_ADVANCE_TRX CREDIT_LIMIT PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT
-0.26 -0.20 1.42 -0.39 -0.48 -0.55 -0.48 -0.29 -0.54
-0.48 -0.60 -0.92 0.96 0.10 0.68 -0.15 0.16 -0.54
0.11 -0.36 -0.92 -0.39 -0.48 -0.55 -0.42 -0.28 -0.54
0.08 0.79 -0.37 -0.39 -0.48 0.40 0.33 -0.29 2.56
-0.08 1.39 -0.10 -0.39 -0.48 1.09 0.19 0.01 -0.54
-0.48 -0.60 -0.92 0.03 -0.04 -0.83 -0.43 -0.19 -0.54
-0.48 -0.60 -0.92 -0.05 1.98 0.40 0.14 0.29 -0.54
-0.26 -0.12 1.42 -0.39 -0.48 -0.42 -0.48 -0.30 2.22

En la interpretación de los diferentes clusters hay que tener en cuenta que se tratan de valores estandarizados. La interpretación sería la siguiente:

  • Grupo 1: se caracteriza fundamentalmente por tener un alto porcentaje de compras a plazo y bajos valores de todas las demas variables. Por tanto, se tratan de clientes poco activos que habran hecho pocas compras de importe reducido pero, pero todas ellas a plazo.
  • Grupo 2: se caracteriza fundamentalmente por clientes que realizan adelantos de efectivo de importes altos en media, tienen un límite de crédito alto, pero realizan pocas compras y de importes bajos.
  • Grupo 3: son clientes que realizan compras con un importe medio alto y sobre todo o exclusivamente en la modalidad de pago único, realizan pocos o ningún adelanto de efectivo, tienen un límite de crédito bajo y realizan pocos pagos.
  • Grupo 4: son clientes que realizan muchas compras y con importes medios altos, tienen límites de crédito altos, realizan muchos pagos (aunque MINIMUM_PAYMENTS es bajo) y tienen un valor alto de PRC_FULL_PAYMENTS. Sin embargo, no realizan adelantos de efectivo o lo hacen muy poco. Quizás es el segmento de clientes más activo.
  • Grupo 5: clientes que realizan muchas compras pero con importes medios pequeños y también realizan muchos pagos. Sin embargo, no realizan adelantos de efectivo. Se trata de los clientes con un mayor límite de crédito.
  • Grupo 6: su característica principal es que son los clientes con el límite de crédito más bajo.
  • Grupo 7: son los clientes que mayor número de adelantos de efectivo efectúan, aunque su importe medio no sea el más elevado. Además tienen un alto límite de crédito y realizan muchos pagos, aunque muy pocas compras.
  • Grupo 8: un porcentaje muy alto de las compras que realizan es a plazo y tienen un valor muy alto de la variable PRC_FULL_PAYMENTS. No realizan adelantos de efectivo y realizan muy pocos pagos.

Por último, realizamos un gráfico PCA:

fviz_cluster(object = cluster_pam, data = seleccion, ellipse.type = "t",
             repel = TRUE) +
  theme_bw() +
  labs(title = "Resultados clustering PAM") +
  theme(legend.position = "none") + 
  coord_cartesian(xlim=c(-2.5,5),ylim=c(-5,5))
## Warning: ggrepel: 8432 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

5 ANEXO: funciones empleadas

5.1 Función grafico_densidad

grafico_densidad<-function(df,x,y,p=1){ # El parámetro p sirve para filtrar los datos eliminando las observaciones
                                        # con un valor de la variable x mayor que dicho percentil. Si no se especifica
  variable<-df[,x]                      # no  se realiza ningún filtrado (p=1). De esta forma, eliminamos outliers.
   cuantil<-quantile(variable,p,na.rm=TRUE)         

  x<-as.symbol(x)
  y<-as.symbol(y)
 
  dfnew <- df %>%
    filter(!!x <= cuantil)
 
  gr <- ggplot( dfnew) +
    geom_density(aes(x = !!x,fill=!!y,na.rm=TRUE),alpha = 0.6) +
    labs(title = paste("Variable ",x))+
    theme_bw()
 
  return(gr)
 
}

5.2 Función grafico_dispersion

grafico_dispersion<-function(df,x,y,p=1){
  
  variable1<-df[,x]
  variable2<-df[,y]
  cuantil1<-quantile(variable1,p,na.rm=TRUE)
  cuantil2<-quantile(variable2,p,na.rm=TRUE)
  
  x<-as.symbol(x)
  y<-as.symbol(y)
 
  dfnew <- df %>%
    filter(!!x <= cuantil1 & !!y <= cuantil2)
 
  gr <- ggplot( dfnew ,aes(!!x,!!y) ) +
    geom_point(alpha = 0.25) +
    geom_smooth(method = "loess") +
    labs(title = paste("Variables ",x,"y ",y))+
    theme_bw()
 
  return(gr)
}