Parcial3

R Markdown

#1. Elección de las variables

De las variables categóricas, se eligieron las siguientes:

Trabajo Esta variable fue elegida pues puede estar relacionada con el depósito a plazo fijo , pues puede que las personas que tienen trabajos más estables estén más interesadas en tener un depósito fijo.

Hipotesis: Las personas que trabajan en management tienen mayor probabilidad de tener un depósito a termino fijo que los estudiantes
Mora
Si una persona se encuentra en mora,es probable que por el momento no pueda tener un depósito a termino fijo

Hipotesis: Las personas en mora tienen mayor probabilidad de no querer un depósito a termino fijo
Préstamo Si una persona tiene un préstamo personal, es más probable que decida no tener un depósito a termino fijo pues debe seguir pagandolo y no tendrá para este ahorro

Hipotesis: Las personas con préstamo tienen mayor probabilidad de no querer un depósito a termino fijo

De las variables cuantitativas, se eligieron las siguientes:

Edad Esta variable cuantitativa puede estar relacionada con la determinación de personas que aceptarán un depósito a termino fijo, pues puede que las personas que tengan un mayor edad, deseen tener mayor seguridad en su vida

Hipotesis: Las personas de mayor edad tienen mayor probabilidad de tener un depósito a termino fijo

Ho: Media_SI = Media_NO Ha: Media_SI > Media_NO
Campaña actual El número de contactos realizados durante la campaña actual, puede influir en si una persona decide tener o no un depósito a termino fijo, pues si tiene mayor conocimiento sobre la oferta, hay mayor probabilidad de que la tome

Hipotesis: Las personas que han tenido menos contactos realizados, tienen menor probabilidad de tener un depósito a termino fijo

Ho: Media_SI = Media_NO Ha: Media_SI > Media_NO
Campañaas anteriores El número de contactos realizados durante campañas previas, puede influir en si una persona decide tener o no un depósito a termino fijo, pues si tiene mayor conocimiento sobre la oferta, hay mayor probabilidad de que la tome

Hipotesis: Las personas que han tenido más contactos previos realizados, tienen mayor probabilidad de tener un depósito a termino fijo

Ho: Media_SI = Media_NO Ha: Media_SI > Media_NO

#2. Análisis Univariado

data.frame(table(Parcial3$y))

##   Var1 Freq
## 1   no 4000
## 2  yes  521

El 11,5% de las personas de la base de datos SI decidió tener un depósito a termino fijo

require(table1)

y <- table1::table1(~age+job+default+loan+campaign+previous | y, data = Parcial3)
y

	no (N=4000)	yes (N=521)	Overall (N=4521)
age
Mean (SD)	41.0 (10.2)	42.5 (13.1)	41.2 (10.6)
Median [Min, Max]	39.0 [19.0, 86.0]	40.0 [19.0, 87.0]	39.0 [19.0, 87.0]
job
admin.	420 (10.5%)	58 (11.1%)	478 (10.6%)
blue-collar	877 (21.9%)	69 (13.2%)	946 (20.9%)
entrepreneur	153 (3.8%)	15 (2.9%)	168 (3.7%)
housemaid	98 (2.5%)	14 (2.7%)	112 (2.5%)
management	838 (21.0%)	131 (25.1%)	969 (21.4%)
retired	176 (4.4%)	54 (10.4%)	230 (5.1%)
self-employed	163 (4.1%)	20 (3.8%)	183 (4.0%)
services	379 (9.5%)	38 (7.3%)	417 (9.2%)
student	65 (1.6%)	19 (3.6%)	84 (1.9%)
technician	685 (17.1%)	83 (15.9%)	768 (17.0%)
unemployed	115 (2.9%)	13 (2.5%)	128 (2.8%)
unknown	31 (0.8%)	7 (1.3%)	38 (0.8%)
default
no	3933 (98.3%)	512 (98.3%)	4445 (98.3%)
yes	67 (1.7%)	9 (1.7%)	76 (1.7%)
loan
no	3352 (83.8%)	478 (91.7%)	3830 (84.7%)
yes	648 (16.2%)	43 (8.3%)	691 (15.3%)
campaign
Mean (SD)	2.86 (3.21)	2.27 (2.09)	2.79 (3.11)
Median [Min, Max]	2.00 [1.00, 50.0]	2.00 [1.00, 24.0]	2.00 [1.00, 50.0]
previous
Mean (SD)	0.471 (1.63)	1.09 (2.06)	0.543 (1.69)
Median [Min, Max]	0 [0, 25.0]	0 [0, 14.0]	0 [0, 25.0]

Edad: Como se puede observar, las personas que NO tienen un depósito fijo tienen una edad menor(41) en comparación a los que SI tienen un depósito fijo (42.5) Trabajo: Según lo observado en la tabla1, se puede decir que la mayor parte de las personas que NO tienen un depósito a término fijo son las personas que realizan trabajos manuales o obras (blue-collar) (21.9%), mientras que la mayoría de las personas que SI tienen un depósito a término fijo son administradores (management) (25.1%) Mora: De la tabla1 se puede decir que de las personas que SI tienen un depósito a término fijo, la mayoría no está en mora (98.3%), y en las personas que SI tienen un depósito a término fijo, la mayoría tampoco está en mora. (98.3) Préstamo: Sobre los prestamos, se puede observar que las personas que NO tienen un depósito a término fijo, no tienen en su mayoría prestamos (83.8%).Lo mismo ocurre con las personas que SI tienen un depósito a término fijo, pues la mayoría de ellas no tiene préstamos personales(91.7%).Lo que si se puede resaltar, es que el porcentaje aumenta en las personas que SI decidieron tener el despósito. Campaña actual: Como se muestra en la tabla1, el promedio de contactos en la campaña actual de las personas que rechazaron tener un depósito a término fijo es de 2.86, mayor que el de las personas que si decidieron a SI tenerlo (2.27). Como esto es contrario a las hipotesis previas, estas deben tener sus respectivas correcciones Ho: Media_SI = Media_NO Ha: Media_SI < Media_NO Campañas previas: Según la tabla1,de las personas que SI decidieron tener un depósito a término fijo, el promedio de contactos fue de 1.09, mientras que el de las personas que decidieron no tenerlo es de 0.471

#3.Análisis Bivariado

Variables cuantitativas:

require(table1)
t.test(Parcial3$age~Parcial3$y)

## 
##  Welch Two Sample t-test
## 
## data:  Parcial3$age by Parcial3$y
## t = -2.5024, df = 604.47, p-value = 0.0126
## alternative hypothesis: true difference in means between group no and group yes is not equal to 0
## 95 percent confidence interval:
##  -2.6653503 -0.3213752
## sample estimates:
##  mean in group no mean in group yes 
##          40.99800          42.49136

Como el intervalo de confianza es de -2.6653503 -0.3213752, significa que si hay una diferencia significativa entre la edad de las personas que si tienen un depósito a término fijo, y los que no, pues el 0 no está incluido en el intervalo. Con un nivel de confianza del 95%, se puede concluir que como el p-valor (0.0126)< a 0.05 se rechaza Ho, entonces la edad de las personas que si tienen un depósito a término fijo es estadisticamente mayor a las que no decidieron tomarlo.

require(table1)
t.test(Parcial3$campaign~Parcial3$y)

## 
##  Welch Two Sample t-test
## 
## data:  Parcial3$campaign by Parcial3$y
## t = 5.6824, df = 877.72, p-value = 1.807e-08
## alternative hypothesis: true difference in means between group no and group yes is not equal to 0
## 95 percent confidence interval:
##  0.3897875 0.8011233
## sample estimates:
##  mean in group no mean in group yes 
##          2.862250          2.266795

Como el intervalo de confianza es de 0.3897875 0.8011233, significa que si hay una diferencia significativa entre la cantidad de contactos a las personas que si tienen un depósito a término fijo, y los que no, pues el 0 no está incluido en el intervalo. Con un nivel de confianza del 95%, se puede concluir que como el p-valor (1.807e-08)< a 0.05 se rechaza Ho, entonces la cantidad de contactos a las personas que si tienen un depósito a término fijo es estadisticamente menor a las que no decidieron tomarlo.

require(table1)
t.test(Parcial3$previous~Parcial3$y)

## 
##  Welch Two Sample t-test
## 
## data:  Parcial3$previous by Parcial3$y
## t = -6.6092, df = 607.86, p-value = 8.458e-11
## alternative hypothesis: true difference in means between group no and group yes is not equal to 0
## 95 percent confidence interval:
##  -0.8028809 -0.4350414
## sample estimates:
##  mean in group no mean in group yes 
##          0.471250          1.090211

Como el intervalo de confianza es de -0.8028809 -0.4350414, significa que si hay una diferencia significativa entre la cantidad de contactos previos a las personas que si tienen un depósito a término fijo, y los que no, pues el 0 no está incluido en el intervalo. Con un nivel de confianza del 95%, se puede concluir que como el p-valor (8.458e-11)< a 0.05 se rechaza Ho, entonces la cantidad de contactos previamente realizados a las personas que si tienen un depósito a término fijo es estadisticamente mayor a las que no decidieron tomarlo.

Variables cualitativas

require(CGPfunctions)
PlotXTabs2(data = Parcial3,x = job,y = y)

En la gráfica se puede observar que las personas retiradas y los estudiantes son los que más han aceptado tener un depósito a término fijo, Mientras que los que menos aceptan son los obreros. 23% de las personas retiradas y los estudiantes deciden tener un depósito a término fijo, y tan solo un 7% de los obreros tiene depósito fijo.

require(CGPfunctions)
PlotXTabs2(data = Parcial3,x = loan, y=y )

En la gráfica se puede observar que las personas que no tienen préstamos fueron las que más decidieron tener un depósito a término fijo, mientras que las personas que si tenían prestamos personales, no aceptaron el depósito.

require(CGPfunctions)
PlotXTabs2(data = Parcial3,x = default,y = y)

En la gráfica se puede observar que las personas que tienen y no tienen mora aceptaron tener un depósito a término fijo en un 12%

#4. Regresión logística

Parcial3$y=as.numeric(Parcial3$y=="yes")
modelo=glm(y~ `job` +`default` +`loan`+ age+campaign+previous,data=Parcial3,family = binomial(link="logit"))
summary(modelo)

## 
## Call:
## glm(formula = y ~ job + default + loan + age + campaign + previous, 
##     family = binomial(link = "logit"), data = Parcial3)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.7443  -0.5259  -0.4518  -0.3638   3.1370  
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -1.933047   0.257546  -7.506 6.11e-14 ***
## jobblue-collar   -0.564040   0.190006  -2.969 0.002992 ** 
## jobentrepreneur  -0.302693   0.307755  -0.984 0.325336    
## jobhousemaid      0.013968   0.322769   0.043 0.965482    
## jobmanagement     0.125514   0.171002   0.734 0.462954    
## jobretired        0.689997   0.243002   2.839 0.004519 ** 
## jobself-employed -0.119391   0.280938  -0.425 0.670856    
## jobservices      -0.287386   0.222712  -1.290 0.196915    
## jobstudent        0.645424   0.307863   2.096 0.036041 *  
## jobtechnician    -0.132784   0.184078  -0.721 0.470695    
## jobunemployed    -0.257371   0.328411  -0.784 0.433224    
## jobunknown        0.399735   0.447438   0.893 0.371650    
## defaultyes        0.250138   0.364123   0.687 0.492106    
## loanyes          -0.709354   0.167416  -4.237 2.26e-05 ***
## age               0.004013   0.005180   0.775 0.438497    
## campaign         -0.088347   0.023510  -3.758 0.000171 ***
## previous          0.135628   0.020916   6.484 8.91e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3231.0  on 4520  degrees of freedom
## Residual deviance: 3085.4  on 4504  degrees of freedom
## AIC: 3119.4
## 
## Number of Fisher Scoring iterations: 5

step(modelo,direction = "backward")

## Start:  AIC=3119.45
## y ~ job + default + loan + age + campaign + previous
## 
##            Df Deviance    AIC
## - default   1   3085.9 3117.9
## - age       1   3086.0 3118.0
## <none>          3085.4 3119.4
## - campaign  1   3103.4 3135.4
## - loan      1   3106.5 3138.5
## - job      11   3134.1 3146.1
## - previous  1   3124.0 3156.0
## 
## Step:  AIC=3117.89
## y ~ job + loan + age + campaign + previous
## 
##            Df Deviance    AIC
## - age       1   3086.5 3116.5
## <none>          3085.9 3117.9
## - campaign  1   3103.9 3133.9
## - loan      1   3106.6 3136.6
## - job      11   3134.4 3144.4
## - previous  1   3124.3 3154.3
## 
## Step:  AIC=3116.47
## y ~ job + loan + campaign + previous
## 
##            Df Deviance    AIC
## <none>          3086.5 3116.5
## - campaign  1   3104.4 3132.4
## - loan      1   3107.4 3135.4
## - job      11   3143.1 3151.1
## - previous  1   3124.9 3152.9

## 
## Call:  glm(formula = y ~ job + loan + campaign + previous, family = binomial(link = "logit"), 
##     data = Parcial3)
## 
## Coefficients:
##      (Intercept)    jobblue-collar   jobentrepreneur      jobhousemaid  
##         -1.77147          -0.56068          -0.28411           0.04567  
##    jobmanagement        jobretired  jobself-employed       jobservices  
##          0.13004           0.78178          -0.11080          -0.29004  
##       jobstudent     jobtechnician     jobunemployed        jobunknown  
##          0.59479          -0.13134          -0.24650           0.43279  
##          loanyes          campaign          previous  
##         -0.70585          -0.08815           0.13527  
## 
## Degrees of Freedom: 4520 Total (i.e. Null);  4506 Residual
## Null Deviance:       3231 
## Residual Deviance: 3086  AIC: 3116

Según este modelo, se puede decir que las variables que son más significativas son los préstamos personales,el trabajo, los contactos previos, y los contactos actuales.

Esto se puede interpretar de la siguiente manera:

Prestamos: Por cada 0.70585 que disminuyan las personas con prestamos personales, hay más probabilidad de que si decida tener el depósito a término fijo.

Campaña actual: Se puede decir que por cada 0.08815 contactos menos, hay más probabilidad de que la persona si decida tener el depósito a término fijo.

Campaña previa: Por cada 0.13527 que aumenten el contacto con las personas en campañas anteriores a la actual hay más probabilidad de que si decida tener el depósito a término fijo.

Trabajo: Se puede decir que los obreros tienen un 56% menos de probabilidad de tener un depósito a termino fijo que las personas de administración, y las personas retiradas tienen un 78% más de probabilidad de tener un depósito a termino fijo en comparación a las personas de administración.

#5. Evaluación del poder predictivo del modelo con base en la curva ROC y el AUC

Parcial3$y=as.numeric(Parcial3$y=="yes")
modelo2=glm(y~ `job` +`loan`+ campaign+previous,data=Parcial3,family = binomial(link="logit"))
summary (modelo2)

## 
## Call:
## glm(formula = y ~ job + loan + campaign + previous, family = binomial(link = "logit"), 
##     data = Parcial3)
## 
## Deviance Residuals: 
##        Min          1Q      Median          3Q         Max  
## -2.409e-06  -2.409e-06  -2.409e-06  -2.409e-06  -2.409e-06  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)
## (Intercept)      -2.657e+01  1.728e+04  -0.002    0.999
## jobblue-collar    2.919e-16  2.000e+04   0.000    1.000
## jobentrepreneur   4.769e-16  3.196e+04   0.000    1.000
## jobhousemaid     -5.655e-16  3.741e+04   0.000    1.000
## jobmanagement     3.044e-16  1.994e+04   0.000    1.000
## jobretired       -2.112e-15  2.859e+04   0.000    1.000
## jobself-employed  2.216e-15  3.098e+04   0.000    1.000
## jobservices       3.000e-16  2.387e+04   0.000    1.000
## jobstudent       -1.348e-15  4.223e+04   0.000    1.000
## jobtechnician     6.733e-16  2.076e+04   0.000    1.000
## jobunemployed     6.276e-13  3.547e+04   0.000    1.000
## jobunknown       -7.089e-15  6.007e+04   0.000    1.000
## loanyes          -1.371e-14  1.480e+04   0.000    1.000
## campaign         -2.820e-15  1.710e+03   0.000    1.000
## previous         -3.406e-15  3.140e+03   0.000    1.000
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 0.0000e+00  on 4520  degrees of freedom
## Residual deviance: 2.6229e-08  on 4506  degrees of freedom
## AIC: 30
## 
## Number of Fisher Scoring iterations: 25

require (pROC)
probabilidad_modelo =modelo2$fitted.values

realidad= Parcial3$y
objroc <- roc(Parcial3$y ~ probabilidad_modelo,auc=T,ci=T)
objroc

plot.roc(objroc,print.auc=T,print.thres = "best",col="red"
         ,xlab = "Specificity", ylab = "Sensitivity")

#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

El mejor corte es el 12.04%, es decir que si está por encima del 12.04%, SI acepta un depósito a término fijo. Especifico: Detecta los positivos en aproximadamente 67%, es decir que el modelo predice acertadamente a las personas que SI aceptan un depósito a término fijo. Sensibilidad:Detecta los negativos en un 57%, en este caso los negativos se refieren a las personas que el modelo predice acertadamente que NO aceptan un depósito a término fijo

table(probabilidad_modelo>0.1204,realidad)

2680: Lo que el modelo dice que NO aceptarán un depósito y NO lo aceptan. 226: El modelo dice que NO aceptarán un depósito y SI lo aceptan. 1320: El modelo dice que SI aceptarán un depósito y NO lo aceptan. 295: El modelo dice que SI aceptarán un depósito y SI lo aceptan.

#6. Individuo hipotetico

lineal=predict(modelo2, list(campaign=1,job="retired",loan="no",previous=24))
lineal

##         1 
## -26.56607

exp(lineal)/(1+exp(lineal))

##            1 
## 2.900701e-12

Empleado 1

Una persona que está retirada y ya más estable económicamente,que no tiene préstamos personales, que solo fue contactada 1 vez en la campaña actual, pero 24 veces en las campañas previas, tiene una probabilidad muy alta de aceptar el depósito a término fijo. En el caso anterior, la probabilidad es aproximadamente del 90%

lineal=predict(modelo2, list(campaign=6,job="blue-collar",loan="yes",previous=0))
lineal

##         1 
## -26.56607

exp(lineal)/(1+exp(lineal))

##            1 
## 2.900701e-12

Empleado 2

Es una persona que es obrera, tiene préstamos, que ha sido contactada 15 veces en esta campaña y ninguna vez previamente.La probabilidad de que SI acepte el depósito es muy baja. En el caso anterior, la probabilidad es aproximadamente del 2.7%

lineal=predict(modelo2, list(campaign=3,job="student",loan="yes",previous=8))
lineal

##         1 
## -26.56607

exp(lineal)/(1+exp(lineal))

##            1 
## 2.900701e-12

Empleado 3

Para una persona que está estudiando, que ha sido contactada previamente 8 veces, y en esta campaña 3 veces, que tenga ciertos préstamos personales, la probabilidad de que SI acepte el depósito a término fijo es de aproximadamente el 26%

#7.Conclusiones

Después del analisis realizado anteriormente, se puede plantear estrategias para que más personas acepten el depósito como:

Ofrecer el servicio a personas ya retiradas del trabajo o a estudiantes, que no tengan prestamos personales. Tener una buena metodología y planeamiento en las campañas, y contactar constantemente al potencial cliente para que acepte el depósito en futuras ocasiones

Parcial3

Michele Alejandra Roldan Andrade

5/27/2022

R Markdown