Análisis de datos Bancarios
Amílcar José Escobedo Pérez
9 de noviembre de 2018
require(survival)## Loading required package: survivalrequire(survminer)## Loading required package: survminer## Loading required package: ggplot2## Loading required package: ggpubr## Loading required package: magrittrAnálisis descriptivo
Introducción.
Se pretende hacer un análisis acerca del tiempo de permanencia de los clientes de un banco con relación a ciertas características de los mismos que se capturaron en la base de datos del banco. Las variables son:
Datos <- read.csv("~/Documentos/7moSemestre/Estadistica3/Tarea5a/DatosBanco/Bank_Churn_Modelling.csv")
colnames(Datos)## [1] "RowNumber" "CustomerId" "Surname"
## [4] "CreditScore" "Geography" "Gender"
## [7] "Age" "Tenure" "Balance"
## [10] "NumOfProducts" "HasCrCard" "IsActiveMember"
## [13] "EstimatedSalary" "Exited"La variable “Exited” indica si se ha perdido o no al cliente en cuestión. La variable “Tenure” es el tiempo que el cliente ha permanecido con el banco hasta su partida o censura.
Gráficas de supervivencia.
Supervivencia base.
Primero se observará la supervivencia general, es decir, la función de supervivencia estimada de todos los tiempos de permanencia “Tenure” de los clientes del banco, sin considerar características particulares de los mismos.
ajuste0<-surv_fit(Surv(Tenure,Exited)~1,data = Datos)
ggsurvplot(ajuste0)
Influencia de la geografía.
Ahora se intentará ver si el país del cliente tiene algún efecto en la permanencia del mismo.
ajuste_geo<-surv_fit(Surv(Tenure,Exited)~Geography,data = Datos)
ggsurvplot(ajuste_geo)
En la gráfica se puede apreciar que los clientes alemanes son más propensos a dejar el banco que los franceses o españoles. Hecho que puede ser confirmado con una prueba de hipótesis sobre las supervivencias estimadas.
survdiff(Surv(Tenure,Exited)~Geography,data = Datos)## Call:
## survdiff(formula = Surv(Tenure, Exited) ~ Geography, data = Datos)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## Geography=France 5014 810 1019 42.7 90.6
## Geography=Germany 2509 814 516 171.6 244.0
## Geography=Spain 2477 413 502 15.8 22.2
##
## Chisq= 244 on 2 degrees of freedom, p= <2e-16Es decir, se rechaza que las supervivencias sean iguales, cómo se suponía de ver la gráfica.
Influencia de la calificación crediticia.
A continuación se verá si la calificación crediticia de los clientes tiene relación con su tiempo de permanencia en el banco.
Credit_score_q<-quantile(Datos$CreditScore,probs = seq(1,3)/3)
Credit_scores<-Datos$CreditScore
for(i in 1:length(Credit_scores)){
if(Credit_scores[i]<=Credit_score_q[2]){
if(Credit_scores[i]<=Credit_score_q[1])
Credit_scores[i]<-"Low"
else
Credit_scores[i]<-"Medium"
}else{
Credit_scores[i]<-"High"
}
}
ajuste_cscore<-surv_fit(Surv(Tenure,Exited)~Credit_scores,data = Datos)
ggsurvplot(ajuste_cscore)
El gráfico no parece mostrar ninguna diferencia significativa en las supervivencias en función de las calificaciones crediticias de los grupos. Esto se puede corroborar con una pruebe de hipótesis de diferencia de supervivencias.
survdiff(Surv(Tenure,Exited)~Credit_scores,data = Datos)## Call:
## survdiff(formula = Surv(Tenure, Exited) ~ Credit_scores, data = Datos)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## Credit_scores=High 3303 654 680 0.996 1.585
## Credit_scores=Low 3363 724 683 2.481 3.957
## Credit_scores=Medium 3334 659 674 0.340 0.539
##
## Chisq= 4 on 2 degrees of freedom, p= 0.1El p-value de 0.1 de la prueba no es lo suficientemente pequeño cómo para descartar que las supervivencias sean iguales.
Membresía con el banco.
Veamos si los miembros activos del banco son menos propensos a cerrar sus cuentas que los no miembros.
ajuste_membership<-surv_fit(Surv(Tenure,Exited)~IsActiveMember,data = Datos)
ggsurvplot(ajuste_membership)
Efectivamente, la gráfica parece mostrar lo que se suponía acerca de las supervivencias de los miembros contra las de los no miembros. En la siguiente prueba de hipótesis se confirma esta afirmación.
survdiff(Surv(Tenure,Exited)~IsActiveMember,data = Datos)## Call:
## survdiff(formula = Surv(Tenure, Exited) ~ IsActiveMember, data = Datos)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## IsActiveMember=0 4849 1302 1009 85.1 179
## IsActiveMember=1 5151 735 1028 83.5 179
##
## Chisq= 179 on 1 degrees of freedom, p= <2e-16Influencia del nivel salarial.
Aquí se inquirirá si el nivel salarial de los clientes influye en su tiempo de estadía con el banco.
Los niveles salariales de los clientes tienen las siguientes características:
summary(Datos$EstimatedSalary)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 11.58 51002.11 100193.91 100090.24 149388.25 199992.48La gráfica es:
Est_salary<-Datos$EstimatedSalary
for(i in 1:length(Est_salary)){
if(Est_salary[i]<=mean(Datos$EstimatedSalary)){
Est_salary[i]<-"Low"
}else{
Est_salary[i]<-"High"
}
}
ajuste_esal<-surv_fit(Surv(Tenure,Exited)~Est_salary,data = Datos)
ggsurvplot(ajuste_esal)
El raro comportamiento de la supervivencia del grupo de bajo salario quizás se debe a que es un grupo mucho menor que el de salario alto. El resultado no es concluyente.
Posesión de targeta de crédito.
Lo que se hará a continuación es explorar si el tener targeta de crédito hace que un cliente se quede más con el banco o no.
ajuste_ccard<-surv_fit(Surv(Tenure,Exited)~HasCrCard,data = Datos)
ggsurvplot(ajuste_ccard)
No parece haber ninguna diferencia significativa en las supervivencias de los dos grupos. La siguiente prueba confirma lo anterior:
survdiff(Surv(Tenure,Exited)~HasCrCard,data = Datos)## Call:
## survdiff(formula = Surv(Tenure, Exited) ~ HasCrCard, data = Datos)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## HasCrCard=0 2945 613 587 1.197 1.78
## HasCrCard=1 7055 1424 1450 0.484 1.78
##
## Chisq= 1.8 on 1 degrees of freedom, p= 0.2Número de productos utilizados.
Veamos si la cantidad de productos bancarios adicionales que el cliente utiliza hace que éste dure más tiempo con el banco.
summary(Datos$NumOfProducts)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 1.00 1.00 1.53 2.00 4.00N_products<-ifelse(Datos$NumOfProducts>=mean(Datos$NumOfProducts),"Many","Few")
ajuste_nprod<-surv_fit(Surv(Tenure,Exited)~N_products,data = Datos)
ggsurvplot(ajuste_nprod)
Parece que el hacer uso de más productos incrementa el tiempo de lealtad del cliente. Comprobémoslo con una prueba de hipótesis.
survdiff(Surv(Tenure,Exited)~N_products,data = Datos)## Call:
## survdiff(formula = Surv(Tenure, Exited) ~ N_products, data = Datos)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## N_products=Few 5084 1409 1027 142 304
## N_products=Many 4916 628 1010 144 304
##
## Chisq= 304 on 1 degrees of freedom, p= <2e-16Balance de la cuenta.
Intentemos averiguar el monto que el cliente tiene en su cuenta es un buen predictor del tiempo que permanecerá con el banco.
Qbalance<-ifelse(Datos$Balance>=mean(Datos$Balance),"Upper","Lower")
ajuste_balance<-surv_fit(Surv(Tenure,Exited)~Qbalance,data = Datos)
ggsurvplot(ajuste_balance)
Parece ser que los que tienen montos menores se quedan más tiempo con el banco.
survdiff(Surv(Tenure,Exited)~Qbalance,data = Datos)## Call:
## survdiff(formula = Surv(Tenure, Exited) ~ Qbalance, data = Datos)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## Qbalance=Lower 4081 611 844 64.1 116
## Qbalance=Upper 5919 1426 1193 45.3 116
##
## Chisq= 116 on 1 degrees of freedom, p= <2e-16La prueba anterior confirma este hecho.
Influencia de la edad de los clientes.
Veamos cómo influye la edad de los clientes en su tiempo de permanencia.
Ages<-ifelse(Datos$Age>=mean(Datos$Age),"Upper","Lower")
ajuste_age<-surv_fit(Surv(Tenure,Exited)~Ages,data = Datos)
ggsurvplot(ajuste_age)
Los clientes jovenes, de acuerdo con la gráfica anterior, tienden a permanecer más con el banco que los más viejos.
survdiff(Surv(Tenure,Exited)~Ages,data = Datos)## Call:
## survdiff(formula = Surv(Tenure, Exited) ~ Ages, data = Datos)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## Ages=Lower 5564 525 1129 323 769
## Ages=Upper 4436 1512 908 402 769
##
## Chisq= 770 on 1 degrees of freedom, p= <2e-16Esta prueba es la confirma lo anterior.
Influencia del género.
Veamos si el género del cliente tiene algo que ver con el tiempo que se queda con el banco.
ajuste_gender<-surv_fit(Surv(Tenure,Exited)~Gender,data = Datos)
ggsurvplot(ajuste_gender)
Parece que los hombres se quedan más tiempo con el banco que las mujeres.
survdiff(Surv(Tenure,Exited)~Gender,data = Datos)## Call:
## survdiff(formula = Surv(Tenure, Exited) ~ Gender, data = Datos)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## Gender=Female 4543 1139 920 52.2 101
## Gender=Male 5457 898 1117 43.0 101
##
## Chisq= 101 on 1 degrees of freedom, p= <2e-16La prueba de hipótesis anterior valida la conclusión arriba enunciada.
Análisis cuantitativo.
Primero se convierten a variables numéricas todas las variables de la base de datos para no tener problemas con los ajustes. También se eligen sólo las variables relativas a los clientes, que pueden ser conocidas antes de que entren al banco, a saber, la calificación crediticia la nacionalidad, el género, la edad y el salario estimado (esto para diseñar estrategias para horientar la publicidad a segmentos de la población que serían buenos clientes).
Clustering
Se hace un análisis para detectar cúmulos en los datos, después del análisis (en el que se probó dividir los datos en varios números de clusters y hacer ajustes de supervivencia explicados con las categorías en cuestión), se decidió que el número de cúmulos (clusters) óptimo para dividir los datos poder hacer un ajuste de los datos estratificados por estos cúmlos y que las funciones de supervivencia resultantes fueran diferentes entre sí es 4. Todas las variables que se tomaron en cuenta fueron la calificación crediticia la nacionalidad, el género, la edad y el salario estimado junto con las variables de respuesta que nos interesan, el tiempo de permanencia con el banco y si aún es cliente del banco o no.
Ajuste
Se ajusta un modelo de riesgos proporcionales a cada categoría para ver cómo afectan las variables \(\textbf{NumOfProducts}\), \(\textbf{IsActiveMember}\) y \(\textbf{HasCrCard}\) a los riesgos de irse para cada una de las cuatro clases de individuos. Se tiene interés en cuantificar estos efectos porque estas variables pueden ser alteradas por el banco una vez que una persona es cliente del mismo (por ejemplo, se puede incentivar o desincentivar a un cliente a ser miembro del banco o a tener tarjeta de crédito si es que no la tiene por medio de promociones y publicidad). Se ajusta un modelo de riesgos proporcionales usando \(\textbf{NumOfProducts}\), \(\textbf{IsActiveMember}\) y \(\textbf{HasCrCard}\) cómo las covariables del modelo:
Los resultados de las pruebas son:
Para la Categoría 1:
## Call:
## coxph(formula = Surv(Tenure, Exited) ~ NumOfProducts + IsActiveMember +
## HasCrCard, data = Individuos1)
##
## n= 2441, number of events= 499
##
## coef exp(coef) se(coef) z Pr(>|z|)
## NumOfProducts -0.05600 0.94554 0.07791 -0.719 0.472
## IsActiveMember -0.61376 0.54131 0.09310 -6.593 4.32e-11 ***
## HasCrCard -0.06738 0.93484 0.09805 -0.687 0.492
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## exp(coef) exp(-coef) lower .95 upper .95
## NumOfProducts 0.9455 1.058 0.8116 1.1015
## IsActiveMember 0.5413 1.847 0.4510 0.6497
## HasCrCard 0.9348 1.070 0.7714 1.1329
##
## Concordance= 0.586 (se = 0.015 )
## Rsquare= 0.019 (max possible= 0.942 )
## Likelihood ratio test= 46.18 on 3 df, p=5e-10
## Wald test = 44.38 on 3 df, p=1e-09
## Score (logrank) test = 45.75 on 3 df, p=6e-10Aquí la única variable que fue relevante resultó ser si es miembro activo o no, y el efecto de la misma no fue nada despreciable, de hecho, el hecho de ser mienbro del banco para los individuos de esta categoría reduce el riesgo de dejar al banco en casi la mitad.
Para la Categoría 2:
## Call:
## coxph(formula = Surv(Tenure, Exited) ~ NumOfProducts + IsActiveMember +
## HasCrCard, data = Individuos2)
##
## n= 2466, number of events= 487
##
## coef exp(coef) se(coef) z Pr(>|z|)
## NumOfProducts -0.071991 0.930539 0.079115 -0.910 0.363
## IsActiveMember -0.706923 0.493159 0.095152 -7.429 1.09e-13 ***
## HasCrCard -0.008779 0.991259 0.099406 -0.088 0.930
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## exp(coef) exp(-coef) lower .95 upper .95
## NumOfProducts 0.9305 1.075 0.7969 1.0866
## IsActiveMember 0.4932 2.028 0.4093 0.5943
## HasCrCard 0.9913 1.009 0.8158 1.2045
##
## Concordance= 0.606 (se = 0.015 )
## Rsquare= 0.024 (max possible= 0.937 )
## Likelihood ratio test= 59.97 on 3 df, p=6e-13
## Wald test = 57.02 on 3 df, p=3e-12
## Score (logrank) test = 59.43 on 3 df, p=8e-13Aquí cómo en la categoría 1, la única variable que tuvo un efecto significativo fue la membresía con el banco. En este caso, el hecho de ser miembro disminuyó el riesgo de los individuos en más de la mitad.
Para la Categoría 3:
## Call:
## coxph(formula = Surv(Tenure, Exited) ~ NumOfProducts + IsActiveMember +
## HasCrCard, data = Individuos3)
##
## n= 2375, number of events= 463
##
## coef exp(coef) se(coef) z Pr(>|z|)
## NumOfProducts -0.32970 0.71914 0.08811 -3.742 0.000183 ***
## IsActiveMember -0.59494 0.55160 0.09670 -6.152 7.63e-10 ***
## HasCrCard 0.06351 1.06557 0.10369 0.612 0.540238
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## exp(coef) exp(-coef) lower .95 upper .95
## NumOfProducts 0.7191 1.3905 0.6051 0.8547
## IsActiveMember 0.5516 1.8129 0.4564 0.6667
## HasCrCard 1.0656 0.9385 0.8696 1.3057
##
## Concordance= 0.593 (se = 0.015 )
## Rsquare= 0.023 (max possible= 0.934 )
## Likelihood ratio test= 54.51 on 3 df, p=9e-12
## Wald test = 52.35 on 3 df, p=3e-11
## Score (logrank) test = 53.5 on 3 df, p=1e-11Para los inividuos de esta categoría hubo dos variables relevantes, el número de productos consumidos y la membresía. Lo que se observó es que para estos individuos, por cada producto extra del banco que se consume, el riesgo de dejar el banco disminuye a poco menos de tres cuartos de lo que sería si no se consumiera el producto extra, y el hecho de tener membresía con el banco hace que el riesgo baje casi a la mitad.
Para la Categoría 4:
## Call:
## coxph(formula = Surv(Tenure, Exited) ~ NumOfProducts + IsActiveMember +
## HasCrCard, data = Individuos4)
##
## n= 2305, number of events= 493
##
## coef exp(coef) se(coef) z Pr(>|z|)
## NumOfProducts -0.24249 0.78467 0.08173 -2.967 0.00301 **
## IsActiveMember -0.57538 0.56249 0.09445 -6.092 1.12e-09 ***
## HasCrCard -0.22441 0.79899 0.09614 -2.334 0.01959 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## exp(coef) exp(-coef) lower .95 upper .95
## NumOfProducts 0.7847 1.274 0.6685 0.9210
## IsActiveMember 0.5625 1.778 0.4674 0.6769
## HasCrCard 0.7990 1.252 0.6618 0.9647
##
## Concordance= 0.606 (se = 0.015 )
## Rsquare= 0.022 (max possible= 0.948 )
## Likelihood ratio test= 52.45 on 3 df, p=2e-11
## Wald test = 50.81 on 3 df, p=5e-11
## Score (logrank) test = 51.83 on 3 df, p=3e-11Para este grupo, las tres variables fueron significativas, siendo la que mayor efecto tiene en el riesgo la relacionada con la membresía (disminuyó el riesgo casi a la mitad), luego el número de productos que lo reduce por un factor de 0.78467 por cada producto extra consumido y, por último, el tener tarjeta de crédito reduce el riesgo para los individuos de este grupo por un factor de 0.79899.
Conclusión.
En general se recomienda hacer miembros del banco a todos los clientes que sea posible pues esta simple acción tiene un efecto considerable en la lealtad de los mismos (para todos los grupos de individuos se observó que ser miembro activo del banco hace que el riesgo de los individuos disminuya más o menos a la mitad). Para los individuos de los grupos 3 y 4 es recomendable incentivar el uso de más productos del banco por medio de publicidad y promociones pues esto tiene un efecto que reduce el riesgo de perder a estos clientes. Para los individuos del grupo 4, además de proporcionar los incentivos arriba descritos, una acción adicional que haría que el riesgo de perder a estos clientes baje todavía más es hacer que tantos cómo se pueda adquieran tarjeta de crédito, para esto se puede hacer un estudio de mercado para conocer en qué establecimientos compran los individuos de este grupo y afiliarse con estos establecimientos para incentivar a los individuos de este grupo a utilizar tarjeta de crédito en los mismos cómo forma de pago (o simplemente usando publicidad).