Descripción

El conjunto de datos Bank Marketing proviene del repositorio UCI Machine Learning y está relacionado con campañas de marketing directo (llamadas telefónicas) de una institución bancaria portuguesa. Las campañas de marketing se basaron en llamadas telefónicas. A menudo, se requería más de un contacto con el mismo cliente, para poder acceder a si el producto (depósito bancario a plazo) estaría (o no) suscrito.

En el siguiente link se puede acceder a la base de datos: https://archive.ics.uci.edu/ml/datasets/Bank+Marketing# .

Esta base de datos cuenta con 45.211 observaciones y 17 variables entre numéricas y categóricas las cuales se describen a continuación:

Otros archivos de esta misma base de datos contienen también , las siguientes variables hacen referencia más que todo al contexto social y económico

Variable de salida

y - ¿El cliente se ha suscrito a un depósito a plazo? (binario: ‘sí’, ‘no’) (1/0)

El propósito de este trabajo será realizar la estimación de un modelo de regresión logístico con el fin de predecir si el cliente se suscribirá (1/0) a un depósito a plazo (variable y).

library(readxl)
bank <- read_excel("C:/Users/Lenovo/Downloads/SEXTO SEMESTRE/ESTADISTICA AVANZADA/Bank/bank-full.xlsx")
str(bank)
## tibble [45,211 x 17] (S3: tbl_df/tbl/data.frame)
##  $ age      : num [1:45211] 58 44 33 47 33 35 28 42 58 43 ...
##  $ job      : chr [1:45211] "management" "technician" "entrepreneur" "blue-collar" ...
##  $ marital  : chr [1:45211] "married" "single" "married" "married" ...
##  $ education: chr [1:45211] "tertiary" "secondary" "secondary" "unknown" ...
##  $ default  : chr [1:45211] "no" "no" "no" "no" ...
##  $ balance  : num [1:45211] 2143 29 2 1506 1 ...
##  $ housing  : chr [1:45211] "yes" "yes" "yes" "yes" ...
##  $ loan     : chr [1:45211] "no" "no" "yes" "no" ...
##  $ contact  : chr [1:45211] "unknown" "unknown" "unknown" "unknown" ...
##  $ day      : num [1:45211] 5 5 5 5 5 5 5 5 5 5 ...
##  $ month    : chr [1:45211] "may" "may" "may" "may" ...
##  $ duration : num [1:45211] 261 151 76 92 198 139 217 380 50 55 ...
##  $ campaign : num [1:45211] 1 1 1 1 1 1 1 1 1 1 ...
##  $ pdays    : num [1:45211] -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ previous : num [1:45211] 0 0 0 0 0 0 0 0 0 0 ...
##  $ poutcome : chr [1:45211] "unknown" "unknown" "unknown" "unknown" ...
##  $ y        : chr [1:45211] "no" "no" "no" "no" ...

Variables

A continuación se seleccionaron 4 variables categóricas y 4 variables cuantitativas, que considere que se encuentran relacionadas con la subscripcion o no a un deposito a plazo.

Hipótesis 1: Si la persona tiene un credito personal es menos probable que se subscriba a un depósito a plazo.

Hipótesis 2: Las persona con crédito en mora probablemente no se subscriba a un depósito a plazo.

Hipótesis 3: Hay meses o temporadas en los que los clientes potenciales tienden a rechazar las ofertas de depósito a plazo.

Hipótesis 4: Los clientes mas potenciales que aceptarian realizar este tipo depositos a plazo serian los jubilados.

Hipótesis 5: Hay ciertos rangos de edades en el que la suscripción a un depósito a plazo tendrá mayor éxito.

Hipótesis 6: Los clientes con mayor saldo en la cuenta tienen más probabilidad de suscribirse a un depósito a plazo.

Hipótesis 7: El número de contacto que se tuvo con los clientes es realmente importante. Demasiados contactos con el cliente podrían hacer que rechace la oferta de subscribirse o no a un depósito a plazo.

Hipótesis 8: El número de segundos llevados a cabo en la llamada con el cliente puede ser un buen indicio de hacer que se suscriba al depósito a plazo ya que, de esta manera el cliente logra conocer en que consiste y que políticas tiene realmente aceptar el depósito a plazo.

Validación de hipótesis

Hipótesis 1

Se valida la primera hipótesis, de las personas que tiene un crédito personal, solo el 7% decidieron suscribirse al depósito a plazo mientras que, aquellas que no tienen el 13% decidieron suscribirse.

PlotXTabs2(data = bank,x = loan  ,y = y)

Hipótesis 2

Se valida la segunda hipótesis, de las personas que tiene un credito en mora, solo el 6% decidieron suscribirse al déposito a plazo.

PlotXTabs2(data = bank,x = default  ,y = y)

Hipótesis 3

Se valida la tercera hipótesis, hay meses en el que la suscripción al depósito a plazo tiene más éxito. Lo anterior, se puede notar en meses como diciembre, octubre, septiembre y marzo.

PlotXTabs2(data = bank,x = month, y = y)

Hipótesis 4

Se valida la cuarta hipótesis los jubilados son las personas que mas suelen suscribirse a depositos a plazo ya que los jubilados tienden a no gastar mucho su dinero, por lo que es más probable que pongan su dinero a trabajar prestándolo al banco. Sin embargo, es importante notar que los estudiantes tambien aceptarian este tipo de estrategias de mercadeo brindadas por los bancos.

PlotXTabs2(data = bank,x = job, y = y)

Hipótesis 5

A continuación, se realizan intervalos con las edades de la base de datos con el fin de realizar un estudio y verificar si hay rango de edades en los que la campaña de marketing del banco tiene exito y por tanto, la suscripcion de mas clientes.

bank$edad = cut(bank$age,breaks=c(10,20,30,40,50,60,70,80,90,100))

Se valida la hipótesis 5, se puede ver que clientes entre 18-20 años y mayores a 60 años se suelen suscribir mas a los depositos a plazos que personas entre 20-60 años.

PlotXTabs2(data = bank,x = edad, y = y)

Hipótesis 6

Se valida la hipótesis 6, las personas con un ingreso en promedio de 1800 suelen tener mayor probabilidad de abrir un depósito a plazo.Sin embargo, la desviación estandar es alta por tanto, indica que los datos se extienden sobre un rango de valores más amplio.

Hipótesis 7

Se valida que cuando mas se contacta con el cliente la probabilidad de que este rechace la oferta de subscribirse a un deposito a plazo es mayor.

Hipótesis 8

La duración en la llamada que se tiene con cualquier cliente es muy importante, se valida que llamadas con una duración mas larga hacen que se tenga mas probabilidad de que un cliente abra un depósito a plazoya que una mayor duración significa un mayor interés (compromiso) del cliente potencial hacia lo que le esta informando el banco.

table1::table1(~ bank$age +  bank$balance + bank$campaign + bank$duration| bank$y, data = bank)
no
(N=39922)		 yes
(N=5289)		 Overall
(N=45211)
bank$age
Mean (SD) 40.8 (10.2) 41.7 (13.5) 40.9 (10.6)
Median [Min, Max] 39.0 [18.0, 95.0] 38.0 [18.0, 95.0] 39.0 [18.0, 95.0]
bank$balance
Mean (SD) 1300 (2970) 1800 (3500) 1360 (3040)
Median [Min, Max] 417 [-8020, 102000] 733 [-3060, 81200] 448 [-8020, 102000]
bank$campaign
Mean (SD) 2.85 (3.21) 2.14 (1.92) 2.76 (3.10)
Median [Min, Max] 2.00 [1.00, 63.0] 2.00 [1.00, 32.0] 2.00 [1.00, 63.0]
bank$duration
Mean (SD) 221 (207) 537 (393) 258 (258)
Median [Min, Max] 164 [0, 4920] 426 [8.00, 3880] 180 [0, 4920]

Se convierte la variable de respuesta (y) a tipo binaria (1/0) para poder utilizar en la estimación del modelo

bank$yy=as.numeric(bank$y=="yes")

Modelo de regresión logistico

Como se puede identificar, las variables del modelo son significativas. Si el coeficiente es negativo, se tiene que hay una relación inversamente proporcional con la suscripción a un depósito a plazo mientras que, si el coeficiente es positivo, existe una relación proporcional con respecto a la variable de respuesta.

bank$yy=as.numeric(bank$y=="yes")
modelo=glm(yy~age + balance + duration + campaign +`job`+`loan` + `month` +`default`,data=bank,family = binomial(link="logit"))
summary(modelo)
## 
## Call:
## glm(formula = yy ~ age + balance + duration + campaign + job + 
##     loan + month + default, family = binomial(link = "logit"), 
##     data = bank)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -5.6447  -0.4136  -0.2990  -0.2127   3.2396  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -2.260e+00  1.015e-01 -22.250  < 2e-16 ***
## age              -2.711e-03  1.845e-03  -1.469 0.141714    
## balance           1.972e-05  4.720e-06   4.179 2.93e-05 ***
## duration          3.918e-03  6.033e-05  64.938  < 2e-16 ***
## campaign         -1.175e-01  9.801e-03 -11.990  < 2e-16 ***
## jobblue-collar   -6.091e-01  6.599e-02  -9.230  < 2e-16 ***
## jobentrepreneur  -4.388e-01  1.173e-01  -3.742 0.000183 ***
## jobhousemaid     -5.958e-01  1.266e-01  -4.706 2.52e-06 ***
## jobmanagement     1.408e-02  5.987e-02   0.235 0.814089    
## jobretired        3.811e-01  8.853e-02   4.304 1.67e-05 ***
## jobself-employed -1.851e-01  1.028e-01  -1.801 0.071779 .  
## jobservices      -3.484e-01  7.913e-02  -4.403 1.07e-05 ***
## jobstudent        8.364e-01  9.952e-02   8.405  < 2e-16 ***
## jobtechnician    -1.594e-01  6.433e-02  -2.477 0.013235 *  
## jobunemployed    -7.969e-02  1.028e-01  -0.775 0.438149    
## jobunknown       -2.512e-01  2.144e-01  -1.171 0.241401    
## loanyes          -5.638e-01  5.724e-02  -9.849  < 2e-16 ***
## monthaug         -4.220e-01  7.113e-02  -5.932 2.99e-09 ***
## monthdec          1.237e+00  1.599e-01   7.737 1.02e-14 ***
## monthfeb         -2.111e-02  7.898e-02  -0.267 0.789246    
## monthjan         -8.479e-01  1.130e-01  -7.502 6.30e-14 ***
## monthjul         -7.686e-01  7.201e-02 -10.673  < 2e-16 ***
## monthjun         -5.691e-01  7.346e-02  -7.747 9.40e-15 ***
## monthmar          1.782e+00  1.114e-01  16.000  < 2e-16 ***
## monthmay         -1.208e+00  6.494e-02 -18.597  < 2e-16 ***
## monthnov         -7.684e-01  7.985e-02  -9.623  < 2e-16 ***
## monthoct          1.258e+00  9.730e-02  12.926  < 2e-16 ***
## monthsep          1.305e+00  1.059e-01  12.321  < 2e-16 ***
## defaultyes       -1.842e-01  1.590e-01  -1.159 0.246654    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 32631  on 45210  degrees of freedom
## Residual deviance: 24281  on 45182  degrees of freedom
## AIC: 24339
## 
## Number of Fisher Scoring iterations: 6

Poder predictivo del modelo con base en la curva ROC y el AUC

Vamos a evaluar el poder predictivo del modelo.

El poder de clasificación del modelo es de 87%. La sensibilidad es del 87% y hace referencia a aquellos que el modelo dice que se suscriben y en verdad lo hacen mientras que, la especificidad es de 86% y hace referencia a aquellos que el modelo dice que no van se van a suscribir y en verdad no se suscriben.

#Vamos a contruir la curva ROC y AUC
require(pROC)

probabilidad_modelo=modelo$fitted.values

objroc <- roc(bank$y ~ probabilidad_modelo,auc=T,ci=T)
objroc
## 
## Call:
## roc.formula(formula = bank$y ~ probabilidad_modelo, auc = T,     ci = T)
## 
## Data: probabilidad_modelo in 39922 controls (bank$y no) < 5289 cases (bank$y yes).
## Area under the curve: 0.8734
## 95% CI: 0.8688-0.8779 (DeLong)
plot.roc(objroc,print.auc=T,print.thres = "best",col="red"
         ,xlab = "Specificity", ylab = "Sensitivity")

En el punto de corte, se tiene que el umbral de clasificación es del 8.8% es decir, que los que estén por encima de este porcentaje se suscribiran al deposito a plazo. La sensibilidad es del 85% mientras que, la especificidad del 754%.

#Punto de corte: 
c<-coords(objroc, "best", ret=c("threshold", "specificity", "sensitivity"),
          as.list=FALSE,drop=TRUE, best.model=c("closest.topleft"), transpose = FALSE)
c
## $threshold
## [1] 0.08868128
## 
## $specificity
## [1] 0.7418967
## 
## $sensitivity
## [1] 0.8542258

Matriz de confusión

El objetivo principal de una matriz de confusión es ver cómo está funcionando nuestro modelo a la hora de clasificar a los clientes potenciales que probablemente suscribirán un depósito a plazo. A continuación, el análisis:

Verdaderos Negativos (Cuadrado Superior Izquierdo): Es el número de clasificaciones correctas de la clase “No” o clientes potenciales que no están dispuestos a suscribir un depósito a plazo.

Falsos Negativos (Cuadrado Superior Derecho): Es el número de clasificaciones incorrectas de la clase “No” o clientes potenciales que no están dispuestos a suscribir un depósito a plazo.

Falsos Positivos (Cuadrado Inferior Izquierdo): Es el número de clasificaciones incorrectas de la clase “Sí” o clientes potenciales que están dispuestos a suscribir un depósito a plazo.

Verdaderos Positivos (Cuadrado Inferior-Derecha): Es el número de clasificaciones correctas de la clase “Sí” o clientes potenciales que están dispuestos a suscribir un depósito a plazo.

probabilidad_modelo=modelo$fitted.values
realidad=bank$y
table(probabilidad_modelo>0.05,realidad)
##        realidad
##            no   yes
##   FALSE 20053   199
##   TRUE  19869  5090

Probabilidad de que un individuo (hipotetico) se suscriba al deposito a plazo 

lineal=predict(modelo,list(age=19 , balance=123, duration=642 , campaign=3 , job="blue-collar" , loan ="no" , month="may" , default="no"    ))
exp(lineal)/(1+exp(lineal))
##         1 
## 0.1231694

Conclusiones