Segmentación de Clientes - K-medias
Diana Carolina Echavarria Cardenas
24/11/2021
Caso Tarjetas Bancarias
El objetivo de este trabajo es presentar un proceso de segmentación de clientes para uno de los 10 bancos colombianos más grandes en crédito de consumo.
La segmentación de los clientes se hará con base en información de consumo (transacciones) del último mes de 47871 tarjetahabitantes, los cuales pueden tener tarjetas de tres diferentes franquicias (Visa, Mastercad y una tercera que el banco maneja).
La finalidad es poder segmentar los clientes de acuerdo a sus ocasiones de consumo, de manera que el banco pueda crear planes promocionales para cada grupo.
## Carga de paquetes
library(readxl) #Abrir el excel
library(psych) #Funcion describe
library(ggplot2) #Libreria para graficos de ggplot
library(gridExtra) #Sacar graficos agrupados
library(corrplot)#Es un paquete para dibujar correlaciones
library(PerformanceAnalytics) #para sacar el grafico de correlaciones grande#Ruta de las bases de datos
setwd('C:/Users/Carolina/OneDrive/Carolina/Maestria/Segundo Semestre/Mineria de Datos/Clase 4/Tallerbancasep21')
#getwd()#Lectura del archivo en excel
tarjetasbancarias<-read_excel("infoclientebanca.xlsx")Variables a analizar:
- Cliente: identificador del cliente (anonimizado)
- grupo_de_cliente: Clasificacion del cliente en la segmentacion del banco. Se desconocen los detalles.
- Numero_de_transacciones: Numero de transacciones en el ultimo mes
- Promedio_por_transaccion: Promedio por transaccion en el ultimo mes
- transaccion_minima: Valor de transacción mínima en el último mes
- transaccion_maxima: Valor de transacción máxima en el último mes
- desviacion_estandar_por_transaccion: Desviación estándar del valor de las transacciones del último mes
- Las siguientes variables representan porcentajes de uso de cada franquicia en el último mes por consumo nacional/internacional:
- porcentaje_visa_nacional
- porcentaje_visa_internacional
- porcentaje_mastercard_nacional
- porcentaje_mastercard_internacional
- Porcentaje_otrafranquicia_nacional
- porcentaje_otrafranquicia_internacional
- Las siguientes variables representan porcentajes de uso en el último mes por consumo nacional/internacional:
- porcentaje_nacional_total
- porcentaje_internacional_total
- Las siguientes variables representan porcentajes de uso de tarjeta en el último mes por bloque del día: mañana (6-12 a.m) , tarde (12 a.m-6 p.m) y noche (6 p.m-6a.m):
- porcentaje_manana
- porcentaje_tarde
- porcentaje_noche
- Las siguientes variables representan porcentaje de uso en el último mes en cada uno de los días respectivos del mes:
- porcDOMINGO
- porcLUNES
- porcMARTES
- porcMIERCOLES
- porcJUEVES
- porcVIERNES
- porcSABADO
- Sitio_consumo_masfrecuente: Clasificación MCC del grupo de sitios de consumo más frecuente
# visualizar la parte superior del archivo
head(tarjetasbancarias)## # A tibble: 6 x 26
## CLIENTE grupo_de_cliente Numero_de_trans~ promedio_por_tr~ transaccion_min~
## <dbl> <chr> <dbl> <dbl> <dbl>
## 1 1 A 1 459930. 459930.
## 2 2 A 3 582667. 350000
## 3 3 A 3 616547 616547
## 4 4 A 10 144467. 20000
## 5 5 A 1 321764 321764
## 6 6 A 2 2847849 1735698
## # ... with 21 more variables: transaccion_maxima <dbl>,
## # desviacion_estandar_por_transaccion <dbl>, porcentaje_visa_nacional <dbl>,
## # porcentaje_visa_internacional <dbl>, porcentaje_mastercard_nacional <dbl>,
## # porcentaje_mastercard_internacional <dbl>,
## # Porcentaje_otrafranquicia_nacional <dbl>,
## # porcentaje_otrafranquicia_internacional <dbl>,
## # porcentaje_nacional_total <dbl>, porcentaje_internacional_total <dbl>,
## # porcentaje_manana <dbl>, porcentaje_tarde <dbl>, porcentaje_noche <dbl>,
## # porcDOMINGO <dbl>, porcLUNES <dbl>, porcMARTES <dbl>, porcMIERCOLES <dbl>,
## # porcJUEVES <dbl>, porcVIERNES <dbl>, porcSABADO <dbl>,
## # Sitio_consumo_masfrecuente <chr>#Revisar la estructura del objeto que se tiene y los diferentes tipos de datos.
str(tarjetasbancarias)## tibble [47,871 x 26] (S3: tbl_df/tbl/data.frame)
## $ CLIENTE : num [1:47871] 1 2 3 4 5 6 7 8 9 10 ...
## $ grupo_de_cliente : chr [1:47871] "A" "A" "A" "A" ...
## $ Numero_de_transacciones : num [1:47871] 1 3 3 10 1 2 1 4 1 5 ...
## $ promedio_por_transaccion : num [1:47871] 459930 582667 616547 144467 321764 ...
## $ transaccion_minima : num [1:47871] 459930 350000 616547 20000 321764 ...
## $ transaccion_maxima : num [1:47871] 459930 699000 616547 328444 321764 ...
## $ desviacion_estandar_por_transaccion : num [1:47871] 0 201495 0 116686 0 ...
## $ porcentaje_visa_nacional : num [1:47871] 0 1 1 0 1 1 0 0 1 0.4 ...
## $ porcentaje_visa_internacional : num [1:47871] 1 0 0 0 0 0 1 0 0 0 ...
## $ porcentaje_mastercard_nacional : num [1:47871] 0 0 0 1 0 0 0 1 0 0.6 ...
## $ porcentaje_mastercard_internacional : num [1:47871] 0 0 0 0 0 0 0 0 0 0 ...
## $ Porcentaje_otrafranquicia_nacional : num [1:47871] 0 0 0 0 0 0 0 0 0 0 ...
## $ porcentaje_otrafranquicia_internacional: num [1:47871] 0 0 0 0 0 0 0 0 0 0 ...
## $ porcentaje_nacional_total : num [1:47871] 0 1 1 1 1 1 0 1 1 1 ...
## $ porcentaje_internacional_total : num [1:47871] 1 0 0 0 0 0 1 0 0 0 ...
## $ porcentaje_manana : num [1:47871] 0 0 1 0.4 0 0.5 0 0.75 1 0.2 ...
## $ porcentaje_tarde : num [1:47871] 0 1 0 0.6 1 0.5 0 0.25 0 0.8 ...
## $ porcentaje_noche : num [1:47871] 1 0 0 0 0 0 1 0 0 0 ...
## $ porcDOMINGO : num [1:47871] 0 0 0 0 1 0 0 0 0 0 ...
## $ porcLUNES : num [1:47871] 0 0.667 0 0.6 0 ...
## $ porcMARTES : num [1:47871] 1 0 0 0.2 0 0 0 0 0 0.2 ...
## $ porcMIERCOLES : num [1:47871] 0 0 1 0 0 0 1 0.25 0 0.2 ...
## $ porcJUEVES : num [1:47871] 0 0.333 0 0.1 0 ...
## $ porcVIERNES : num [1:47871] 0 0 0 0 0 0.5 0 0 0 0.2 ...
## $ porcSABADO : num [1:47871] 0 0 0 0.1 0 0 0 0 0 0.2 ...
## $ Sitio_consumo_masfrecuente : chr [1:47871] "CLINICAS - HOSPITALES" "MERCADEO DIRECTO - COMERCIANTES DE VENTAS TELEFONICAS / DIRECTV" "DROGUERIAS, FARMACIAS, TIENDAS NATURISTAS" "ALMACEN POR DEPARTAMENTO CON SUPERMERCADO" ...#Indicadores de resumen
summary(tarjetasbancarias)## CLIENTE grupo_de_cliente Numero_de_transacciones
## Min. : 1 Length:47871 Min. : 1.000
## 1st Qu.:11968 Class :character 1st Qu.: 1.000
## Median :23936 Mode :character Median : 2.000
## Mean :23936 Mean : 5.083
## 3rd Qu.:35904 3rd Qu.: 5.000
## Max. :47871 Max. :142.000
## promedio_por_transaccion transaccion_minima transaccion_maxima
## Min. : 1 Min. : 0 Min. : 1
## 1st Qu.: 81000 1st Qu.: 30700 1st Qu.: 114200
## Median : 167174 Median : 80000 Median : 257933
## Mean : 371603 Mean : 253090 Mean : 580732
## 3rd Qu.: 383667 3rd Qu.: 217800 3rd Qu.: 627401
## Max. :6262025 Max. :6148920 Max. :11040000
## desviacion_estandar_por_transaccion porcentaje_visa_nacional
## Min. : 0 Min. :0.0000
## 1st Qu.: 0 1st Qu.:0.0000
## Median : 30441 Median :0.2000
## Mean : 139884 Mean :0.3749
## 3rd Qu.: 127568 3rd Qu.:0.8276
## Max. :5419241 Max. :1.0000
## porcentaje_visa_internacional porcentaje_mastercard_nacional
## Min. :0.00000 Min. :0.0000
## 1st Qu.:0.00000 1st Qu.:0.0000
## Median :0.00000 Median :0.5714
## Mean :0.03646 Mean :0.5393
## 3rd Qu.:0.00000 3rd Qu.:1.0000
## Max. :1.00000 Max. :1.0000
## porcentaje_mastercard_internacional Porcentaje_otrafranquicia_nacional
## Min. :0.00000 Min. :0.00000
## 1st Qu.:0.00000 1st Qu.:0.00000
## Median :0.00000 Median :0.00000
## Mean :0.02655 Mean :0.01388
## 3rd Qu.:0.00000 3rd Qu.:0.00000
## Max. :1.00000 Max. :1.00000
## porcentaje_otrafranquicia_internacional porcentaje_nacional_total
## Min. :0.00000 Min. :0.0000
## 1st Qu.:0.00000 1st Qu.:1.0000
## Median :0.00000 Median :1.0000
## Mean :0.00891 Mean :0.9281
## 3rd Qu.:0.00000 3rd Qu.:1.0000
## Max. :1.00000 Max. :1.0000
## porcentaje_internacional_total porcentaje_manana porcentaje_tarde
## Min. :0.00000 Min. :0.00000 Min. :0.0000
## 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.2500
## Median :0.00000 Median :0.08333 Median :0.6364
## Mean :0.07192 Mean :0.28805 Mean :0.5837
## 3rd Qu.:0.00000 3rd Qu.:0.50000 3rd Qu.:1.0000
## Max. :1.00000 Max. :1.00000 Max. :1.0000
## porcentaje_noche porcDOMINGO porcLUNES porcMARTES
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.0000 Median :0.0000 Median :0.0000 Median :0.0000
## Mean :0.1282 Mean :0.1393 Mean :0.1317 Mean :0.1327
## 3rd Qu.:0.1176 3rd Qu.:0.1429 3rd Qu.:0.1429 3rd Qu.:0.1429
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
## porcMIERCOLES porcJUEVES porcVIERNES porcSABADO
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.000
## Median :0.0000 Median :0.0000 Median :0.0000 Median :0.000
## Mean :0.1395 Mean :0.1362 Mean :0.1415 Mean :0.179
## 3rd Qu.:0.1667 3rd Qu.:0.1667 3rd Qu.:0.1667 3rd Qu.:0.250
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.000
## Sitio_consumo_masfrecuente
## Length:47871
## Class :character
## Mode :character
##
##
## Escogencia de las variables a utilizar
En primer lugar, dado que tenemos el número de transacciones y el promedio de transacciones, podemos calcular un Total Compra, que es el monto total gastado por el cliente en todas sus tarjetas.
tarjetasbancarias$Total_Compras<-tarjetasbancarias$Numero_de_transacciones*tarjetasbancarias$promedio_por_transaccionDado que vamos a realizar una segmentacion de clientes de acuerdo a sus ocasiones de consumo, vamos a sacar un subset del dataset con las variables que vamos a utilizar.
#Creamos un dataset con las variables a estudiar
TC1<-tarjetasbancarias[,c(8:25)]
TC2<-tarjetasbancarias[,c(27)]
TC<-as.data.frame(cbind(TC1,TC2))
colnames(TC) <- c('Visa_Nal', 'Visa_Int', 'MC_Nal','MC_Int','OF_Nal', 'OF_Int', 'Total_Nal','Total_int','Mañana','Tarde','Noche','Domingo','Lunes','Martes','Miercoles','Jueves','Viernes','Sabado','Total_Compras')
#Hacemos una revisiòn de las variables
describe(TC)## vars n mean sd median trimmed mad
## Visa_Nal 1 47871 0.37 0.41 0.20 0.34 0.30
## Visa_Int 2 47871 0.04 0.16 0.00 0.00 0.00
## MC_Nal 3 47871 0.54 0.43 0.57 0.55 0.64
## MC_Int 4 47871 0.03 0.14 0.00 0.00 0.00
## OF_Nal 5 47871 0.01 0.09 0.00 0.00 0.00
## OF_Int 6 47871 0.01 0.08 0.00 0.00 0.00
## Total_Nal 7 47871 0.93 0.23 1.00 1.00 0.00
## Total_int 8 47871 0.07 0.23 0.00 0.00 0.00
## Mañana 9 47871 0.29 0.36 0.08 0.24 0.12
## Tarde 10 47871 0.58 0.39 0.64 0.60 0.54
## Noche 11 47871 0.13 0.26 0.00 0.06 0.00
## Domingo 12 47871 0.14 0.28 0.00 0.06 0.00
## Lunes 13 47871 0.13 0.27 0.00 0.06 0.00
## Martes 14 47871 0.13 0.27 0.00 0.06 0.00
## Miercoles 15 47871 0.14 0.27 0.00 0.07 0.00
## Jueves 16 47871 0.14 0.27 0.00 0.07 0.00
## Viernes 17 47871 0.14 0.27 0.00 0.07 0.00
## Sabado 18 47871 0.18 0.31 0.00 0.10 0.00
## Total_Compras 19 47871 1422281.82 2914069.58 494960.00 809424.54 585567.70
## min max range skew kurtosis se
## Visa_Nal 0 1 1 0.53 -1.39 0.00
## Visa_Int 0 1 1 4.92 24.24 0.00
## MC_Nal 0 1 1 -0.16 -1.67 0.00
## MC_Int 0 1 1 5.85 35.32 0.00
## OF_Nal 0 1 1 8.59 81.24 0.00
## OF_Int 0 1 1 10.49 115.95 0.00
## Total_Nal 0 1 1 -3.28 9.55 0.00
## Total_int 0 1 1 3.28 9.55 0.00
## Mañana 0 1 1 0.97 -0.51 0.00
## Tarde 0 1 1 -0.33 -1.40 0.00
## Noche 0 1 1 2.26 4.19 0.00
## Domingo 0 1 1 2.18 3.64 0.00
## Lunes 0 1 1 2.30 4.42 0.00
## Martes 0 1 1 2.28 4.33 0.00
## Miercoles 0 1 1 2.20 3.90 0.00
## Jueves 0 1 1 2.24 4.12 0.00
## Viernes 0 1 1 2.18 3.79 0.00
## Sabado 0 1 1 1.76 1.86 0.00
## Total_Compras 1 66293406 66293405 6.54 67.99 13318.76Analisis Exploratorio
Las variables que vamos a utilizar son las que estan relacionadas con porcentaje de uso en el ultimo mes.
#Analisis de correlaciones
M.cor = cor(TC[,c(1:18)],method="spearman")#Correlaciones con el metodo de spearman
p.cor=corrplot::cor.mtest(TC[,c(1:18)])$p #test de significancia
round(M.cor, digits=2)## Visa_Nal Visa_Int MC_Nal MC_Int OF_Nal OF_Int Total_Nal Total_int
## Visa_Nal 1.00 -0.10 -0.83 -0.15 -0.08 -0.05 0.17 -0.17
## Visa_Int -0.10 1.00 -0.22 0.26 0.01 0.11 -0.76 0.76
## MC_Nal -0.83 -0.22 1.00 -0.15 -0.06 -0.11 0.27 -0.27
## MC_Int -0.15 0.26 -0.15 1.00 0.02 0.12 -0.66 0.66
## OF_Nal -0.08 0.01 -0.06 0.02 1.00 0.00 -0.01 0.01
## OF_Int -0.05 0.11 -0.11 0.12 0.00 1.00 -0.38 0.38
## Total_Nal 0.17 -0.76 0.27 -0.66 -0.01 -0.38 1.00 -1.00
## Total_int -0.17 0.76 -0.27 0.66 0.01 0.38 -1.00 1.00
## Mañana 0.02 0.02 0.00 0.00 0.05 0.02 -0.01 0.01
## Tarde 0.03 -0.15 0.05 -0.09 -0.02 -0.04 0.16 -0.16
## Noche -0.06 0.32 -0.08 0.24 0.07 0.09 -0.35 0.35
## Domingo -0.01 0.06 0.03 0.05 0.07 0.03 -0.05 0.05
## Lunes 0.01 0.09 -0.02 0.08 0.08 0.05 -0.10 0.10
## Martes 0.01 0.11 -0.03 0.10 0.07 0.05 -0.12 0.12
## Miercoles 0.00 0.11 -0.02 0.09 0.07 0.06 -0.12 0.12
## Jueves 0.00 0.10 -0.02 0.09 0.08 0.05 -0.11 0.11
## Viernes 0.01 0.10 -0.02 0.08 0.08 0.05 -0.11 0.11
## Sabado -0.01 0.05 0.03 0.04 0.07 0.02 -0.04 0.04
## Mañana Tarde Noche Domingo Lunes Martes Miercoles Jueves Viernes
## Visa_Nal 0.02 0.03 -0.06 -0.01 0.01 0.01 0.00 0.00 0.01
## Visa_Int 0.02 -0.15 0.32 0.06 0.09 0.11 0.11 0.10 0.10
## MC_Nal 0.00 0.05 -0.08 0.03 -0.02 -0.03 -0.02 -0.02 -0.02
## MC_Int 0.00 -0.09 0.24 0.05 0.08 0.10 0.09 0.09 0.08
## OF_Nal 0.05 -0.02 0.07 0.07 0.08 0.07 0.07 0.08 0.08
## OF_Int 0.02 -0.04 0.09 0.03 0.05 0.05 0.06 0.05 0.05
## Total_Nal -0.01 0.16 -0.35 -0.05 -0.10 -0.12 -0.12 -0.11 -0.11
## Total_int 0.01 -0.16 0.35 0.05 0.10 0.12 0.12 0.11 0.11
## Mañana 1.00 -0.75 -0.13 0.03 0.08 0.10 0.10 0.10 0.10
## Tarde -0.75 1.00 -0.41 0.01 -0.04 -0.07 -0.07 -0.07 -0.07
## Noche -0.13 -0.41 1.00 0.11 0.13 0.14 0.14 0.14 0.14
## Domingo 0.03 0.01 0.11 1.00 -0.01 -0.03 -0.04 -0.03 -0.03
## Lunes 0.08 -0.04 0.13 -0.01 1.00 0.03 0.02 0.02 0.01
## Martes 0.10 -0.07 0.14 -0.03 0.03 1.00 0.03 0.03 0.02
## Miercoles 0.10 -0.07 0.14 -0.04 0.02 0.03 1.00 0.03 0.01
## Jueves 0.10 -0.07 0.14 -0.03 0.02 0.03 0.03 1.00 0.03
## Viernes 0.10 -0.07 0.14 -0.03 0.01 0.02 0.01 0.03 1.00
## Sabado 0.07 -0.04 0.11 -0.02 -0.04 -0.05 -0.06 -0.05 -0.04
## Sabado
## Visa_Nal -0.01
## Visa_Int 0.05
## MC_Nal 0.03
## MC_Int 0.04
## OF_Nal 0.07
## OF_Int 0.02
## Total_Nal -0.04
## Total_int 0.04
## Mañana 0.07
## Tarde -0.04
## Noche 0.11
## Domingo -0.02
## Lunes -0.04
## Martes -0.05
## Miercoles -0.06
## Jueves -0.05
## Viernes -0.04
## Sabado 1.00round(p.cor, digits=2)## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.01 0.05
## [2,] 0.00 0.00 0.00 0.00 0.00 0.69 0.00 0.00 0.00 0.00 0.00 0.00 0.84
## [3,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.09 0.00 0.00 0.00 0.00
## [4,] 0.00 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.03
## [5,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.38 0.11 0.00 0.06 0.77
## [6,] 0.00 0.69 0.00 0.15 0.00 0.00 0.00 0.00 0.96 0.00 0.00 0.00 0.78
## [7,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.13
## [8,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.13
## [9,] 0.00 0.00 0.09 0.00 0.38 0.96 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## [10,] 0.00 0.00 0.00 0.00 0.11 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.03
## [11,] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.44
## [12,] 0.01 0.00 0.00 0.00 0.06 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## [13,] 0.05 0.84 0.00 0.03 0.77 0.78 0.13 0.13 0.00 0.03 0.44 0.00 0.00
## [14,] 0.00 0.00 0.00 0.00 0.10 0.04 0.00 0.00 0.02 0.00 0.15 0.00 0.00
## [15,] 0.87 0.00 0.01 0.03 0.27 0.00 0.00 0.00 0.00 0.00 0.02 0.00 0.00
## [16,] 0.58 0.00 0.00 0.12 0.02 0.97 0.00 0.00 0.08 0.00 0.01 0.00 0.00
## [17,] 0.51 0.03 0.01 0.70 0.05 0.03 0.01 0.01 0.00 0.00 0.20 0.00 0.00
## [18,] 0.01 0.00 0.00 0.00 0.98 0.00 0.00 0.00 0.48 0.63 0.09 0.00 0.00
## [,14] [,15] [,16] [,17] [,18]
## [1,] 0.00 0.87 0.58 0.51 0.01
## [2,] 0.00 0.00 0.00 0.03 0.00
## [3,] 0.00 0.01 0.00 0.01 0.00
## [4,] 0.00 0.03 0.12 0.70 0.00
## [5,] 0.10 0.27 0.02 0.05 0.98
## [6,] 0.04 0.00 0.97 0.03 0.00
## [7,] 0.00 0.00 0.00 0.01 0.00
## [8,] 0.00 0.00 0.00 0.01 0.00
## [9,] 0.02 0.00 0.08 0.00 0.48
## [10,] 0.00 0.00 0.00 0.00 0.63
## [11,] 0.15 0.02 0.01 0.20 0.09
## [12,] 0.00 0.00 0.00 0.00 0.00
## [13,] 0.00 0.00 0.00 0.00 0.00
## [14,] 0.00 0.00 0.00 0.00 0.00
## [15,] 0.00 0.00 0.00 0.00 0.00
## [16,] 0.00 0.00 0.00 0.00 0.00
## [17,] 0.00 0.00 0.00 0.00 0.00
## [18,] 0.00 0.00 0.00 0.00 0.00corrplot(M.cor)
De acuerdo con lo observado anteriormente, las variables Porcentaje de uso Nacional e Internacional estan directamente correlacionadas, y nos pueden traer problemas de multicolinealidad. Ademas, estas variables tambien presentan alta correlacion con las variables de porcentaje de uso internacional de visa y mastercard. Por lo tanto se decidio excluirlas del analisis, ya que aparte de presentar altas correlaciones, la informacion que agregan al modelo es redundante, ya que la informacion de uso nacional o internacional se puede encontrar con el porcentaje de uso de las tarjetas respectivas.
Tambien se puede observar que la variable de porcentaje de uso de Visa Nacional esta fuertemente relacionada con la variable porcentaje de uso de Mastercard Nacional.
#Sacamos un nuevo subset sin los Totales nacionales e internacionales
TC<-TC[,-c(7:8)]
describe(TC)## vars n mean sd median trimmed mad
## Visa_Nal 1 47871 0.37 0.41 0.20 0.34 0.30
## Visa_Int 2 47871 0.04 0.16 0.00 0.00 0.00
## MC_Nal 3 47871 0.54 0.43 0.57 0.55 0.64
## MC_Int 4 47871 0.03 0.14 0.00 0.00 0.00
## OF_Nal 5 47871 0.01 0.09 0.00 0.00 0.00
## OF_Int 6 47871 0.01 0.08 0.00 0.00 0.00
## Mañana 7 47871 0.29 0.36 0.08 0.24 0.12
## Tarde 8 47871 0.58 0.39 0.64 0.60 0.54
## Noche 9 47871 0.13 0.26 0.00 0.06 0.00
## Domingo 10 47871 0.14 0.28 0.00 0.06 0.00
## Lunes 11 47871 0.13 0.27 0.00 0.06 0.00
## Martes 12 47871 0.13 0.27 0.00 0.06 0.00
## Miercoles 13 47871 0.14 0.27 0.00 0.07 0.00
## Jueves 14 47871 0.14 0.27 0.00 0.07 0.00
## Viernes 15 47871 0.14 0.27 0.00 0.07 0.00
## Sabado 16 47871 0.18 0.31 0.00 0.10 0.00
## Total_Compras 17 47871 1422281.82 2914069.58 494960.00 809424.54 585567.70
## min max range skew kurtosis se
## Visa_Nal 0 1 1 0.53 -1.39 0.00
## Visa_Int 0 1 1 4.92 24.24 0.00
## MC_Nal 0 1 1 -0.16 -1.67 0.00
## MC_Int 0 1 1 5.85 35.32 0.00
## OF_Nal 0 1 1 8.59 81.24 0.00
## OF_Int 0 1 1 10.49 115.95 0.00
## Mañana 0 1 1 0.97 -0.51 0.00
## Tarde 0 1 1 -0.33 -1.40 0.00
## Noche 0 1 1 2.26 4.19 0.00
## Domingo 0 1 1 2.18 3.64 0.00
## Lunes 0 1 1 2.30 4.42 0.00
## Martes 0 1 1 2.28 4.33 0.00
## Miercoles 0 1 1 2.20 3.90 0.00
## Jueves 0 1 1 2.24 4.12 0.00
## Viernes 0 1 1 2.18 3.79 0.00
## Sabado 0 1 1 1.76 1.86 0.00
## Total_Compras 1 66293406 66293405 6.54 67.99 13318.76# Histogramas
G1 <- ggplot(TC) + geom_histogram (aes(x= TC$Visa_Nal),fill="#009ACD",bins=30) + xlab("% Visa Nacional")
G2 <- ggplot(TC) + geom_histogram (aes(x= TC$Visa_Int ),fill="#009ACD",bins=30)+ xlab("% Visa Internacional")
G3 <- ggplot(TC) + geom_histogram (aes(x= TC$MC_Nal ),fill="#009ACD",bins=30)+ xlab("% MasterCard Nacional")
G4 <- ggplot(TC) + geom_histogram (aes(x= TC$MC_Int),fill="#009ACD",bins=30)+ xlab("% MasterCard Internacional")
G5 <- ggplot(TC) + geom_histogram (aes(x=TC$OF_Nal),fill="#009ACD",bins=30)+ xlab("% franq. Nacional")
G6 <- ggplot(TC) + geom_histogram (aes(x=TC$OF_Int),fill="#009ACD",bins=30)+ xlab("% franq. Internacional")
grid.arrange(G1,G2,G3,G4,G5,G6, ncol=3, nrow=2)
#chart.Correlation(TC[,c(1:6)] , histogram = TRUE, method = "spearman")# Histogramas
G7 <- ggplot(TC) + geom_histogram (aes(x= TC$Mañana ),fill="#009ACD",bins=30) + xlab("% Uso Mañana")
G8 <- ggplot(TC) + geom_histogram (aes(x= TC$Tarde ),fill="#009ACD",bins=30)+ xlab("% Uso Tarde")
G9 <- ggplot(TC) + geom_histogram (aes(x= TC$Noche),fill="#009ACD",bins=30)+ xlab("% Uso Noche")
grid.arrange(G7,G8,G9, ncol=2, nrow=2)
#chart.Correlation(TC[,c(7:9)] , histogram = TRUE, method = "spearman")# Histogramas
G10 <- ggplot(TC) + geom_histogram (aes(x=TC$Domingo),fill="#009ACD",bins=30) + xlab("% Uso Domingo")
G11 <- ggplot(TC) + geom_histogram (aes(x=TC$Lunes),fill="#009ACD",bins=30)+ xlab("% Uso Lunes")
G12 <- ggplot(TC) + geom_histogram (aes(x=TC$Martes),fill="#009ACD",bins=30)+ xlab("% Uso Martes")
G13 <- ggplot(TC) + geom_histogram (aes(x=TC$Miercoles),fill="#009ACD",bins=30)+ xlab("% Uso Miercoles")
G14 <- ggplot(TC) + geom_histogram (aes(x=TC$Jueves),fill="#009ACD",bins=30)+ xlab("% Uso Jueves")
G15 <- ggplot(TC) + geom_histogram (aes(x=TC$Viernes),fill="#009ACD",bins=30)+ xlab("% Uso Viernes")
G16 <- ggplot(TC) + geom_histogram (aes(x=TC$Sabado),fill="#009ACD",bins=30)+ xlab("% Uso Sabado")
grid.arrange(G10,G11,G12,G13,G14,G15,G16, ncol=3, nrow=3)
#chart.Correlation(TC[,c(10:16)] , histogram = TRUE, method = "spearman")En todas las variables el mínimo es cero, y en los histograma se logra observa que hay un alto porcentaje de clientes que no cuentan con productos del banco o que simplemente no lo utilizan.
En los histogramas también son visibles asimetrías positivas mayores que 1 en la mayoria de variables, lo que marca la presencia de pequeños grupos con un grado alto de uso versus grandes grupos de bajo uso.
Preparacion de los datos
En la preparación de los datos se siguieron los siguientes pasos:
- 1. Aplicamos reducción de atípicos a la variable Total Compras
#Función para quitar atípicos del subconjunto de datos (var Total Compras)
remove_outliers <- function(x, na.rm = TRUE, ...) {
qnt <- quantile(x, probs=c(.25, .75), na.rm = na.rm, ...)
H <- 1.5 * IQR(x, na.rm = na.rm)
y <- x
y[x < (qnt[1] - H)] <- NA
y[x > (qnt[2] + H)] <- NA
y
}
#Quitamos atípicos utilizando la función
promtx<-remove_outliers(TC$Total_Compras) #Quitar atípicos
#Agregar columna sin atipicos al subconjunto original
TC<-cbind(TC,promtx)
#Contamos el numero de atipicos
sapply(TC, function(x) sum(is.na(TC$promtx)))## Visa_Nal Visa_Int MC_Nal MC_Int OF_Nal
## 5072 5072 5072 5072 5072
## OF_Int Mañana Tarde Noche Domingo
## 5072 5072 5072 5072 5072
## Lunes Martes Miercoles Jueves Viernes
## 5072 5072 5072 5072 5072
## Sabado Total_Compras promtx
## 5072 5072 5072#Quitar atípicos de la base original
TC1 <- TC[!is.na(TC$promtx),]- 2. Realizamos una transformación a las variables
Teniendo en cuenta la variable Total Compras podemos averiguar a cuánto dinero equivalen los porcentajes de gasto de las tarjetas, los horarios y los días. Esto será el resultado de la multiplicación entre los porcentajes y la variable Total Compras.
TC1$Visa_Nal<-TC1$Total_Compras*TC1$Visa_Nal
TC1$Visa_Int<-TC1$Total_Compras*TC1$Visa_Int
TC1$MC_Nal<-TC1$Total_Compras*TC1$MC_Nal
TC1$MC_Int<-TC1$Total_Compras*TC1$MC_Int
TC1$OF_Nal<-TC1$Total_Compras*TC1$OF_Nal
TC1$OF_Int<-TC1$Total_Compras*TC1$OF_Int
TC1$Mañana<-TC1$Total_Compras*TC1$Mañana
TC1$Tarde<-TC1$Total_Compras*TC1$Tarde
TC1$Noche<-TC1$Total_Compras*TC1$Noche
TC1$Domingo<-TC1$Total_Compras*TC1$Domingo
TC1$Lunes<-TC1$Total_Compras*TC1$Lunes
TC1$Martes<-TC1$Total_Compras*TC1$Martes
TC1$Miercoles<-TC1$Total_Compras*TC1$Miercoles
TC1$Jueves<-TC1$Total_Compras*TC1$Jueves
TC1$Viernes<-TC1$Total_Compras*TC1$Viernes
TC1$Sabado<-TC1$Total_Compras*TC1$Sabado- 2. Estandarizamos las variables para poder usar distancia euclidea.
#Reescalar variables
TCF<-scale(TC1[,1:16],center = T,scale = T)
describe(TCF)## vars n mean sd median trimmed mad min max range skew
## Visa_Nal 1 42799 0 1 -0.45 -0.25 0.14 -0.54 6.43 6.97 2.95
## Visa_Int 2 42799 0 1 -0.16 -0.16 0.00 -0.16 15.66 15.82 8.66
## MC_Nal 3 42799 0 1 -0.41 -0.23 0.39 -0.67 5.29 5.96 2.26
## MC_Int 4 42799 0 1 -0.14 -0.14 0.00 -0.14 19.86 20.00 10.33
## OF_Nal 5 42799 0 1 -0.12 -0.12 0.00 -0.12 35.09 35.21 15.44
## OF_Int 6 42799 0 1 -0.08 -0.08 0.00 -0.08 32.85 32.93 17.92
## Mañana 7 42799 0 1 -0.51 -0.24 0.00 -0.51 7.64 8.15 3.22
## Tarde 8 42799 0 1 -0.39 -0.22 0.50 -0.73 5.26 5.99 2.18
## Noche 9 42799 0 1 -0.34 -0.25 0.00 -0.34 11.49 11.83 5.01
## Domingo 10 42799 0 1 -0.37 -0.24 0.00 -0.37 13.40 13.77 5.24
## Lunes 11 42799 0 1 -0.35 -0.24 0.00 -0.35 11.86 12.21 5.41
## Martes 12 42799 0 1 -0.35 -0.24 0.00 -0.35 11.64 11.99 5.27
## Miercoles 13 42799 0 1 -0.37 -0.25 0.00 -0.37 11.70 12.07 5.00
## Jueves 14 42799 0 1 -0.36 -0.24 0.00 -0.36 11.64 12.00 5.09
## Viernes 15 42799 0 1 -0.37 -0.24 0.00 -0.37 11.67 12.04 5.02
## Sabado 16 42799 0 1 -0.42 -0.24 0.00 -0.42 10.82 11.24 4.41
## kurtosis se
## Visa_Nal 10.19 0
## Visa_Int 88.12 0
## MC_Nal 5.51 0
## MC_Int 129.69 0
## OF_Nal 330.22 0
## OF_Int 392.44 0
## Mañana 12.91 0
## Tarde 5.24 0
## Noche 32.40 0
## Domingo 38.62 0
## Lunes 39.34 0
## Martes 36.79 0
## Miercoles 33.84 0
## Jueves 34.79 0
## Viernes 33.87 0
## Sabado 26.28 0Modelacion
Seleccion de K
Para la selección del número de clusters vamos a utilizar el gráfico de codo, que es un gráfico de las sumas de cuadrados dentro de los clusteres frente al número de clusteres.
En el momento en que la curva cambia de pendiente (se ve un codo), las reducciones de cuadrados internos dejan de ser tan buenas y se puede escoger ese valor como un k sugerido.
En el siguientre código vamos a hacer ese gráfico entre 2 y 10 clústeres:
#utilizo una semilla para replicar resultados
set.seed(5935)
#calculo la suma de cuadrados total
wss <- (nrow(TCF)-1)*sum(apply(TCF,2,var))
#calculo para cada solución de clustering
for (i in 2:10) wss[i] <- sum(kmeans(TCF,
centers=i, nstart=10)$withinss)
plot(1:10, wss, type="b", xlab="Número de Clusters",
ylab="Suma de cuadrados within") 
Una posible solución sería entre 4 y 6 clústeres (aunque no es muy claro)
Ejecución e interpretación de los resultados
library("cluster")
library("fpc")
#ejecución de k-means
TCFcluster<-kmeans(TCF,centers=5,nstart=10,iter.max=20)
#tamaño de grupos
TCFcluster$size## [1] 2970 33131 249 5365 1084#numero de iteraciones
TCFcluster$iter## [1] 5#centros de grupos
TCFcluster$centers## Visa_Nal Visa_Int MC_Nal MC_Int OF_Nal OF_Int
## 1 0.70039361 -0.08890718 1.4425134 -0.06326851 0.02152958 0.002474975
## 2 -0.26285278 -0.11488964 -0.3119438 -0.09294018 -0.07091118 -0.051605266
## 3 0.02021339 -0.08557828 0.2606249 -0.05904195 10.40941251 -0.079752464
## 4 1.24392419 -0.08266432 1.1504006 -0.06678287 -0.03713169 0.240660182
## 5 -0.04638367 4.18382464 -0.1716315 3.35802579 -0.09900060 0.397693620
## Mañana Tarde Noche Domingo Lunes Martes
## 1 0.7133696 1.2891591 0.3748372 1.80287277 0.1059324 0.00826552
## 2 -0.2610124 -0.3498415 -0.1764743 -0.16865536 -0.1767085 -0.18040873
## 3 0.7566289 1.1491540 0.2234295 0.43687364 0.4098359 0.56936839
## 4 1.1002527 1.2996292 0.1997924 -0.09018626 0.8640916 0.90063430
## 5 0.4037243 0.4641580 3.3265536 0.56112217 0.7398626 0.90304178
## Miercoles Jueves Viernes Sabado
## 1 0.009545167 0.02387123 0.05669876 2.10284647
## 2 -0.184060382 -0.18489636 -0.18075097 -0.20296793
## 3 0.445593027 0.71488228 0.62792317 0.48099518
## 4 0.927690337 0.94183227 0.93472304 -0.02828526
## 5 0.905667954 0.76011815 0.59863748 0.47145667#guardar el cluster de pertenencia
TCF <- cbind(TCF,grupo=TCFcluster$cluster)
#Análisis gráfico de los Clusters
X11()
layout(matrix(c(1:6), nrow=2, byrow=FALSE))
boxplot(Visa_Nal~grupo, data=TCF)
boxplot(Visa_Int~grupo, data=TCF)
boxplot(MC_Nal~grupo, data=TCF)
boxplot(MC_Int~grupo, data=TCF)
boxplot(OF_Nal~grupo, data=TCF)
boxplot(OF_Int~grupo, data=TCF)
boxplot(Mañana~grupo, data=TCF)
boxplot(Tarde~grupo, data=TCF)
boxplot(Noche~grupo, data=TCF)
boxplot(Domingo~grupo, data=TCF)
boxplot(Lunes~grupo, data=TCF)
boxplot(Martes~grupo, data=TCF)
boxplot(Miercoles~grupo, data=TCF)
boxplot(Jueves~grupo, data=TCF)
boxplot(Viernes~grupo, data=TCF)
boxplot(Sabado~grupo, data=TCF)
El gráfico a continuación permite ver los clientes proyectados en sus dos dimensiones principales (mediante componentes principales), lo que permitiría explicar o visualizar parcialmente los grupos.
##Evaluación de los Resultados
Se considera un buen resultado si la consistencia esta por encima de 0.75 o 0.85, y uno malo si esta por debajo de 0.6
#validar resultados- consistencia
kclusters <- clusterboot(TCF,B=10,clustermethod=kmeansCBI,k=5,seed=5)## boot 1
## boot 2
## boot 3
## boot 4
## boot 5
## boot 6
## boot 7
## boot 8
## boot 9
## boot 10kclusters$bootmean## [1] 0.5268610 0.7649836 0.4046234 0.9860211 0.9959765Como se observa, los clusters 1 Y 3 son los clusters probablemente menos robusto.