Actividad Final: Informe regresión generalizada múltiple
Carlos Andrés Gómez Vasco
23/02/2022
Datos de Rotación
Carga de dataframe y visualización.
library(dplyr)
require(CGPfunctions)
require(ggplot2)
require(ggpubr)
library(tidyverse)
library(plotly)
library(psych)
library(GGally)
library(ggthemes)
library(readxl)
datos <- read_excel("Datos_Rotacion.xlsx")
names(datos)## [1] "Rotacion" "Edad"
## [3] "Viaje de Negocios" "Departamento"
## [5] "Distancia_Casa" "Educacion"
## [7] "Campo_Educacion" "Satisfaccion_Ambiental"
## [9] "Genero" "Cargo"
## [11] "Satisfacion_Laboral" "Estado_Civil"
## [13] "Ingreso_Mensual" "Trabajos_Anteriores"
## [15] "Horas_Extra" "Porcentaje_aumento_salarial"
## [17] "Rendimiento_Laboral" "Años_Experiencia"
## [19] "Capacitaciones" "Equilibrio_Trabajo_Vida"
## [21] "Antigüedad" "Antigüedad_Cargo"
## [23] "Años_ultima_promocion" "Años_acargo_con_mismo_jefe"dataf=data.frame(datos)
head(dataf)| Rotacion | Edad | Viaje.de.Negocios | Departamento | Distancia_Casa | Educacion | Campo_Educacion | Satisfaccion_Ambiental | Genero | Cargo | Satisfacion_Laboral | Estado_Civil | Ingreso_Mensual | Trabajos_Anteriores | Horas_Extra | Porcentaje_aumento_salarial | Rendimiento_Laboral | Años_Experiencia | Capacitaciones | Equilibrio_Trabajo_Vida | Antigüedad | Antigüedad_Cargo | Años_ultima_promocion | Años_acargo_con_mismo_jefe |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Si | 41 | Raramente | Ventas | 1 | 2 | Ciencias | 2 | F | Ejecutivo_Ventas | 4 | Soltero | 5993 | 8 | Si | 11 | 3 | 8 | 0 | 1 | 6 | 4 | 0 | 5 |
| No | 49 | Frecuentemente | IyD | 8 | 1 | Ciencias | 3 | M | Investigador_Cientifico | 2 | Casado | 5130 | 1 | No | 23 | 4 | 10 | 3 | 3 | 10 | 7 | 1 | 7 |
| Si | 37 | Raramente | IyD | 2 | 2 | Otra | 4 | M | Tecnico_Laboratorio | 3 | Soltero | 2090 | 6 | Si | 15 | 3 | 7 | 3 | 3 | 0 | 0 | 0 | 0 |
| No | 33 | Frecuentemente | IyD | 3 | 4 | Ciencias | 4 | F | Investigador_Cientifico | 3 | Casado | 2909 | 1 | Si | 11 | 3 | 8 | 3 | 3 | 8 | 7 | 3 | 0 |
| No | 27 | Raramente | IyD | 2 | 1 | Salud | 1 | M | Tecnico_Laboratorio | 2 | Casado | 3468 | 9 | No | 12 | 3 | 6 | 3 | 3 | 2 | 2 | 2 | 2 |
| No | 32 | Frecuentemente | IyD | 2 | 2 | Ciencias | 4 | M | Tecnico_Laboratorio | 4 | Soltero | 3068 | 0 | No | 13 | 3 | 8 | 2 | 2 | 7 | 7 | 3 | 6 |
summary(dataf)## Rotacion Edad Viaje.de.Negocios Departamento
## Length:1470 Min. :18.00 Length:1470 Length:1470
## Class :character 1st Qu.:30.00 Class :character Class :character
## Mode :character Median :36.00 Mode :character Mode :character
## Mean :36.92
## 3rd Qu.:43.00
## Max. :60.00
## Distancia_Casa Educacion Campo_Educacion Satisfaccion_Ambiental
## Min. : 1.000 Min. :1.000 Length:1470 Min. :1.000
## 1st Qu.: 2.000 1st Qu.:2.000 Class :character 1st Qu.:2.000
## Median : 7.000 Median :3.000 Mode :character Median :3.000
## Mean : 9.193 Mean :2.913 Mean :2.722
## 3rd Qu.:14.000 3rd Qu.:4.000 3rd Qu.:4.000
## Max. :29.000 Max. :5.000 Max. :4.000
## Genero Cargo Satisfacion_Laboral Estado_Civil
## Length:1470 Length:1470 Min. :1.000 Length:1470
## Class :character Class :character 1st Qu.:2.000 Class :character
## Mode :character Mode :character Median :3.000 Mode :character
## Mean :2.729
## 3rd Qu.:4.000
## Max. :4.000
## Ingreso_Mensual Trabajos_Anteriores Horas_Extra
## Min. : 1009 Min. :0.000 Length:1470
## 1st Qu.: 2911 1st Qu.:1.000 Class :character
## Median : 4919 Median :2.000 Mode :character
## Mean : 6503 Mean :2.693
## 3rd Qu.: 8379 3rd Qu.:4.000
## Max. :19999 Max. :9.000
## Porcentaje_aumento_salarial Rendimiento_Laboral Años_Experiencia
## Min. :11.00 Min. :3.000 Min. : 0.00
## 1st Qu.:12.00 1st Qu.:3.000 1st Qu.: 6.00
## Median :14.00 Median :3.000 Median :10.00
## Mean :15.21 Mean :3.154 Mean :11.28
## 3rd Qu.:18.00 3rd Qu.:3.000 3rd Qu.:15.00
## Max. :25.00 Max. :4.000 Max. :40.00
## Capacitaciones Equilibrio_Trabajo_Vida Antigüedad Antigüedad_Cargo
## Min. :0.000 Min. :1.000 Min. : 0.000 Min. : 0.000
## 1st Qu.:2.000 1st Qu.:2.000 1st Qu.: 3.000 1st Qu.: 2.000
## Median :3.000 Median :3.000 Median : 5.000 Median : 3.000
## Mean :2.799 Mean :2.761 Mean : 7.008 Mean : 4.229
## 3rd Qu.:3.000 3rd Qu.:3.000 3rd Qu.: 9.000 3rd Qu.: 7.000
## Max. :6.000 Max. :4.000 Max. :40.000 Max. :18.000
## Años_ultima_promocion Años_acargo_con_mismo_jefe
## Min. : 0.000 Min. : 0.000
## 1st Qu.: 0.000 1st Qu.: 2.000
## Median : 1.000 Median : 3.000
## Mean : 2.188 Mean : 4.123
## 3rd Qu.: 3.000 3rd Qu.: 7.000
## Max. :15.000 Max. :17.000nrow(dataf)## [1] 1470ncol(dataf)## [1] 24nrow(dataf)## [1] 1470ncol(dataf)## [1] 24De la carga de datos se puede observar que la data tiene un total de 1470 registros con 24 columnas.
Filtración de la variable Rotación.
Separamos la data en dos dataframe, filtrando en uno los registro que presentan rotación y los registros que no presentan rotación.
rotacion=filter(dataf, Rotacion=="Si")
no_rotacion=filter(dataf, Rotacion=="No")
nrow(rotacion)## [1] 237nrow(no_rotacion)## [1] 1233Se obtienen de los \(1470\) registros totales se consiguen \(237\) de ellos que si presentan rotación. Ello obedece a que el \(16.1\%\) de los registros presentan rotación y el restante \(83.1\%\) son registros en los cuales la rotación no se hace presente.
Para realizar un analisis mas detallado seleccionaremos un conjunto de variables categoricas y otro de variables cuantitaivas para realizar un estudio univariado.
Selección de variables categoricas y cuantitativas.
1. Seleccionar 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que consideren estén relacionadas con la rotación. Nota: Justificar por que estas variables están relacionadas y que tipo de relación se espera (Hipótesis). Ejemplo: Se espera que las horas extra se relacionen con la rotación ya que las personas podrían desgastarse mas al trabajar horas extra y descuidan aspectos personales. La hipótesis es que las personas que trabajan horas extra tienen mayor posibilidad de rotar que las que no trabajan extra. (serian 6, una por variable).
Hipotesis de las Variables Categoricas:
Departamento:
El departamento en que se desempeñe puede influir claramente en la rotación de los mismos, dado que las diferentes dependencias implican diferentes responsabilidades y niveles de desgaste laboral.
Satisfacción_Ambiental:
La satisfacción con el ambiente laboral es una de las motivaciones para que los empleados decidan quedarse o retirarse de la compañia.
Horas Extras:
La realización de horas extras es una de las posibles variables que el empleado tome encuenta para quedar o retirarse de la compañia ya que puede influenciar en otras actividades que desempeñe en su vida personal.
Hipotesis de las Variables Cuantitativa
Ingreso_Mensual:
El nivel salarial bajo puede implicar la desición de retirarse de la compañia.
Trabajos Anteriores:
La cantidad de trabajos que se han tenido anteriormente puede ser un indicador de la inestabilidad laboral del trabajador.
Años a cargo con el mismo jefe:
La cantidad de años de trabajo con el mismo jefe puede desgastar considerablemente relaciones interpersonales, adicionalmente puede convertirse en una situación monotona y que termina por cansar a las partes involucradas, por tal motivo influenciaría en la desición de marcharse de la compañia.
2. Realizar un análisis univariado (caracterización). Nota: Los indicadores o gráficos se usan dependiendo del tipo de variable (cuanti o cuali). Incluir interpretaciones de la rotación.
Satisfacción=rotacion$Satisfaccion_Ambiental
HorasExtra=rotacion$Horas_Extra
EquilibrioTrabajoVida=rotacion$Equilibrio_Trabajo_Vida
g1=ggplot(rotacion,aes(x=Satisfaccion_Ambiental))+geom_histogram()+theme_bw()
g2=ggplot(rotacion,aes(x=`Horas_Extra`))+geom_bar()+theme_bw()
g3=ggplot(rotacion,aes(x=`Departamento`))+geom_bar()+theme_bw()
ggarrange(g1, g2, g3, labels = c("Satisfacción Laboral", "Ralización de Horas Extras","Departamento"),ncol = 1, nrow = 3)
require(ggplot2)
require(ggpubr)
g1=ggplot(rotacion,aes(x=Ingreso_Mensual))+geom_histogram()+theme_bw()
g2=ggplot(rotacion,aes(x=Trabajos_Anteriores))+geom_bar()+theme_bw()
g3=ggplot(rotacion,aes(x=Años_acargo_con_mismo_jefe))+geom_bar()+theme_bw()
ggarrange(g1, g2, g3, labels = c("Ingreso Mensual", "Trabajos Anteriores","Años con el mismo Jefe"),ncol = 1, nrow = 3)
3. Realizar un análisis de bivariado en donde la variable respuesta sea la rotación codificada de la siguiente manera (y=1 es si rotación, y=0 es no rotación), con base en estos resultados identifique cuales son las variables determinantes de la rotación e interpretar el signo del coeficiente estimado. Compare estos resultados con la hipotesis planteada en el punto 2.
Análisis Bivariado
Antes de empezar con el análisis bivariado debemos convertir los valores de la rotación en 0 y 1, donde 0 obedece a la no rotación y 1 a la rotación.
Y adicionar una nueva columna al data frame con los valores de la variable de respuesta y, que en este caso se deja como una respuesta binaria.
dataf$Y=as.numeric(dataf$Rotacion=="Si",1,0)Usando las variables seleccionadas podemos acercarnos a un análisis entre las variables y el conjunto de los que rotan y los que no rotan:
#g1=ggplot(rotacion,aes(x=Rotacion,y=Ingreso_Mensual,fill=Rotación))+geom_boxplot()+theme_bw()
ggplot(data=dataf, aes(Y, Satisfaccion_Ambiental, fill=Rotacion)) + geom_boxplot()+theme_bw()
g4=PlotXTabs2(dataf,`Horas_Extra`,Y, plottype = "percent" )
g4
g5=PlotXTabs2(dataf,`Departamento`,Y, plottype = "percent" )
g5
g6=ggplot(dataf,aes(x=Y,y=Ingreso_Mensual,fill=Rotacion))+geom_boxplot()+theme_bw()
g6
En los resultados mostrados para el analisis univariado que observa como
las personas que mas realizan horas extras son las personas que si
rotaron dentro de la compañia, con ello se puede ver claramente que esta
podria ser una variable que efectivamente lleva a las parsonas a
retirarse de la compañia.
Por otra parte, el ingreso mensual muestra una clara diferencia muy marcada para el salario promedio mayor como para los que no rotaron en la compañia respecto a los que si rotaron, estos últimos tienen un salario promedio inferior y una distribución mucho mas dispersa en sus salarios. Ello permite verificar la hipotesis que el salario es una de la causas por la cual existiria rotación en la compañia.
En cuanto a la hipotesis de la dependencia de los departamentos en los cuales trabaja, la información y analisis construido no facilita verificar la hipotesis. No hay una tendencia muy marcada a que en alguno de los departamentos tenga una mayor y mas sobresaliente tasa de rotación. Por el contrario la realización de horas extras si concide en su gran mayoria con la cantidad de rotación de la compañia.
Y en cuanto a la hipotesis que sea la antiguedad con un mismo jefe la que ocaciona que los empleados terminan por retirarse de la compañia queda totalmente descargada cuando se observa que mas del 80% de los que han rotado no llevan ni un año con el mismo jefe. Por el contrario, se podria invertir la hipotesis para establecer que una relación pobre y escueta con el jefe dado el escaso tiempo de trabajo podria ser una causa de la rotación.
4. Realizar la estimación de un modelo de regresión logistico en el cual la variable respuesta es rotación (y=1 es si rotación, y=0 es no rotación) y las covariables las 6 seleccionadas. Interprete los coeficientes del modelo y la significancia de los parametros.
Podemos construir un modelo generalizado binomial para el análisis de las variables mas significativas en relación con la rotación de empleados.
mod1=glm(Y~Departamento+Ingreso_Mensual+Horas_Extra+Ingreso_Mensual+Satisfaccion_Ambiental+Años_acargo_con_mismo_jefe+Trabajos_Anteriores,data=dataf,family=binomial(link="logit"))
summary(mod1)##
## Call:
## glm(formula = Y ~ Departamento + Ingreso_Mensual + Horas_Extra +
## Ingreso_Mensual + Satisfaccion_Ambiental + Años_acargo_con_mismo_jefe +
## Trabajos_Anteriores, family = binomial(link = "logit"), data = dataf)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4109 -0.5890 -0.4158 -0.2308 3.0915
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -6.902e-01 2.550e-01 -2.707 0.006789 **
## DepartamentoRH 4.248e-01 3.647e-01 1.165 0.244061
## DepartamentoVentas 7.039e-01 1.654e-01 4.256 2.08e-05 ***
## Ingreso_Mensual -1.387e-04 2.544e-05 -5.451 5.01e-08 ***
## Horas_ExtraSi 1.502e+00 1.571e-01 9.557 < 2e-16 ***
## Satisfaccion_Ambiental -3.414e-01 7.039e-02 -4.850 1.24e-06 ***
## Años_acargo_con_mismo_jefe -9.607e-02 2.714e-02 -3.540 0.000401 ***
## Trabajos_Anteriores 8.155e-02 3.052e-02 2.672 0.007536 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1298.6 on 1469 degrees of freedom
## Residual deviance: 1103.1 on 1462 degrees of freedom
## AIC: 1119.1
##
## Number of Fisher Scoring iterations: 5El modelo logra mostrar con las variables que el departmento de ventas, el ingreso mensual, la realización de horas extras, la satisfacción ambiental así como los años que se encuentran sujetos al mismo jefe y en menor grado la cantidad de trabajos anteriores estan fuertemente corelacionados con la rotación en la empresa.
1-exp(mod1$coefficients)## (Intercept) DepartamentoRH
## 0.4985419511 -0.5292980907
## DepartamentoVentas Ingreso_Mensual
## -1.0216115232 0.0001386593
## Horas_ExtraSi Satisfaccion_Ambiental
## -3.4902579519 0.2891947010
## Años_acargo_con_mismo_jefe Trabajos_Anteriores
## 0.0916010291 -0.0849639486Sin embargo, al revisar los coeficientes se puede observar con más detalle que el ingreso tiene una muy baja probabilidad de aumentar la rotación en la compañia.
La satisfacción ambiental aumenta en un 28% la posibilidad de rotación en la empresa. Y, trabajar con el mismo jefe al ser menor produce una mayor rotación en la compañia.
Respecto a la hipotesis inicial que durar bastantes años con el mismo jefe puede ser una causa de la rotación, podemos darla por descartada dado que se observa un coeficiente muy negativo. Que implica entonces que no aumenta el porcentaje de probabilidad de aumentar la rotación en la compañia.
En cuanto a trabajar horas extras es totalmente afirmativo el hecho de que estas horas de mas terminan afectado gravemente la rotación, al igual que las personas que trabajan en eld epartamento de ventas y algún grado menor el departamento de RH.
5. Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
AL usar el modelo con las varibles que resultaron ser mas significativas podemos tener:
mod2=glm(Y~Departamento+Horas_Extra,data=dataf,family=binomial(link="logit"))
summary(mod2)##
## Call:
## glm(formula = Y ~ Departamento + Horas_Extra, family = binomial(link = "logit"),
## data = dataf)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.9738 -0.5436 -0.4281 -0.4281 2.2069
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.3435 0.1203 -19.484 <2e-16 ***
## DepartamentoRH 0.4264 0.3461 1.232 0.2179
## DepartamentoVentas 0.5060 0.1550 3.263 0.0011 **
## Horas_ExtraSi 1.3376 0.1474 9.073 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1298.6 on 1469 degrees of freedom
## Residual deviance: 1206.2 on 1466 degrees of freedom
## AIC: 1214.2
##
## Number of Fisher Scoring iterations: 4prd=predict(mod2,list(Departamento =dataf$Departamento,Horas_Extra=dataf$Horas_Extra),type = "response")
library(ROCR)
library(pROC)
ROC_dataf=roc(dataf$Y~prd, percent = T, ci=T)
ROC_dataf##
## Call:
## roc.formula(formula = dataf$Y ~ prd, percent = T, ci = T)
##
## Data: prd in 1233 controls (dataf$Y 0) < 237 cases (dataf$Y 1).
## Area under the curve: 68.04%
## 95% CI: 64.35%-71.72% (DeLong)plot(ROC_dataf,print.auc=T,print.thres = "best",col="red"
,xlab = "Specificidad", ylab = "Sensitividad")
con este modelo no conseguimos el mejor poder discriminatorio, el área
bajo la curva (AUROC) es del 68%. Sin duda se podria mejor mucho el
modelo intentando estudiar otras de las variables que no se tuvieron en
cuenta dentro de la construcción de este modelo.
6. Predeccir la probabilidad de que un individuo (hipotetico) rote y defina un corte para decidir si se debe intervenir a este empleado o no (posible estrategia para motivar al empleado).
Para la predicción del modelo perfilamos a un trabajador con las siguientes caracteristicas:
Un empleado que trabaja en el departamento de ventas que realiza con horas extras.
predict(mod2, list(Departamento = "Ventas", Horas_Extra= "Si", Satisfación_Laboral="2"),type = "response")## 1
## 0.3775537Obteniendo una probabilidad de no rotar de aproximadamente un 38%. Es muy importante establecer algun nivel que considero debe ser del 50%, si existe la probabilidad de un 50% de que el empleado rote, sera necesario realizar intervención sobre el empleado.
7. En las conclusiones se discute sobre cual seria la estrategia para disminuir la rotación en la empresa (con base en las variables que resultaron significativas en el punto 3). Ejemplo: Mejorar el ambiente laboral, los incentivos económicos, distribuir la carga de horas extra (menos turnos y mas personal).
Es recomendable que la compañia establezca mecanismos directos sobre el departamento de ventas, podrian ser incentivos salariales o de caracter personal o emocional para fortalecer el grupo de trabajo y disminuir la rotación en este departamento.
Y en generale es bastante recomendable revisar la politica de las horas extras que tiene la compañia, pensar un poco en que mecanismos o estrategias desarrollar para reducir en gran parte la existencia de horas extras, dado que ellas terminan por afactar considerablemente la rotación en de los empleados.
Datos de Creditos
Con base en los datos de créditos proponga un modelo de regresión logístico múltiple que permita predecir el riesgo de default en función de las covariables que considere importantes y seleccionándolas de acuerdo con un proceso adecuado. Tenga en cuenta realizar una evaluación de la significancia de los parámetros, interpretación y proponga un método de evaluación por medio de validación cruzada. Presente métricas apropiadas como el AUC y la curva ROC.
library(readxl)
datos_creditos<-read_excel("Datos_Creditos.xlsx")
names(datos_creditos)## [1] "DEFAULT" "ANTIUEDAD" "EDAD" "CUOTA_TOTAL" "INGRESOS"datacr=data.frame(datos_creditos)
head(datacr)| DEFAULT | ANTIUEDAD | EDAD | CUOTA_TOTAL | INGRESOS |
|---|---|---|---|---|
| 1 | 37.317808 | 76.98356 | 3020519 | 8155593 |
| 1 | 37.317808 | 73.77534 | 1766552 | 6181263 |
| 1 | 30.978082 | 78.93699 | 1673786 | 4328075 |
| 1 | 9.728767 | 51.52877 | 668479 | 5290910 |
| 1 | 8.443836 | 38.96986 | 1223559 | 5333818 |
| 1 | 6.605480 | 44.87945 | 3517756 | 2710736 |
summary(datacr)## DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL
## Min. :0.00 Min. : 0.2548 Min. :26.61 Min. : 387
## 1st Qu.:0.00 1st Qu.: 7.3767 1st Qu.:48.18 1st Qu.: 328516
## Median :0.00 Median :15.1192 Median :57.92 Median : 694460
## Mean :0.05 Mean :18.0353 Mean :56.99 Mean : 885206
## 3rd Qu.:0.00 3rd Qu.:30.6637 3rd Qu.:66.19 3rd Qu.:1244126
## Max. :1.00 Max. :37.3178 Max. :92.43 Max. :6664588
## INGRESOS
## Min. : 633825
## 1st Qu.: 3583324
## Median : 5038962
## Mean : 5366430
## 3rd Qu.: 6844098
## Max. :22197021nrow(datacr)## [1] 780ncol(datacr)## [1] 5La base de datos posee 5 columnas con un total de 780 registros en total. Tiene un default; que registra de forma binaraia las fallas del cliente con el sistema fnanciero. La antiguedad del cliente, la edad, la cuota total y los ingresos del mismo.
Análisis Exploratorio.
g_1=ggplot(datacr,aes(x=DEFAULT))+geom_bar(fill="blue")+theme_bw()
g_1=ggplotly(g_1)
g_1g_2= ggplot(datacr, aes(y=ANTIUEDAD, fill=ANTIUEDAD))+geom_boxplot(color="red", fill="violet")+theme_bw()+theme(legend.position="none", plot.title = element_text(size=11))+ggtitle("ANTIGUEDAD")+xlab("Antiguedad del Cliente")
g_2=ggplotly(g_2)
g_2g_3= ggplot(datacr, aes(y=EDAD, fill=EDAD))+geom_boxplot(color="blue", fill="blue")+theme_bw()+theme(legend.position="none", plot.title = element_text(size=11))+ggtitle("EDAD")+xlab("")
g_3=ggplotly(g_3)
g_3g_4= ggplot(datacr, aes(y=CUOTA_TOTAL, fill=CUOTA_TOTAL))+geom_boxplot(fill="green")+theme_bw()+theme(legend.position="none", plot.title = element_text(size=11))+ggtitle("CUOTA TOTAL")+xlab("")
g_4=ggplotly(g_4)
g_4g_5= ggplot(datacr, aes(y=INGRESOS, fill=INGRESOS))+geom_boxplot(fill="pink")+theme_bw()+theme(legend.position="none", plot.title = element_text(size=11))+ggtitle("INGRESOS")+xlab("")
g_5=ggplotly(g_5)
g_5De una base de datos de 780 registros, se consigue 39 personas que han incumplido con los pagos de sus creditos teniendo un default en su historia crediticia. Se puede observar que la antiguedad de los clientes no sobrepasa los 38 meses con una edad en promedio de 58 años, así como un valor de cuota en promedio que tiene \(\$694.460\) pesos, dejandose ver que los valores atipicos, que representan cuotas muy altas, entre \(\$2.651.716\) mas de \(\$6000000\). Por otra partes se observa que el salario promedio ronda los \(\$5.000.000\) con valores atipicos de salarios muy altos.
Para un análisis inicial podemos filtrar los 39 clientes que han faltado a su obligación y revisar los valores promedios de sus cuotas e ingresos.
datacr_1=filter(datacr, DEFAULT ==1)
head(datacr_1)| DEFAULT | ANTIUEDAD | EDAD | CUOTA_TOTAL | INGRESOS |
|---|---|---|---|---|
| 1 | 37.317808 | 76.98356 | 3020519 | 8155593 |
| 1 | 37.317808 | 73.77534 | 1766552 | 6181263 |
| 1 | 30.978082 | 78.93699 | 1673786 | 4328075 |
| 1 | 9.728767 | 51.52877 | 668479 | 5290910 |
| 1 | 8.443836 | 38.96986 | 1223559 | 5333818 |
| 1 | 6.605480 | 44.87945 | 3517756 | 2710736 |
summary(datacr_1)## DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL
## Min. :1 Min. : 1.370 Min. :30.38 Min. : 34374
## 1st Qu.:1 1st Qu.: 6.796 1st Qu.:48.04 1st Qu.: 471346
## Median :1 Median : 9.995 Median :53.66 Median :1074994
## Mean :1 Mean :14.531 Mean :55.16 Mean :1196570
## 3rd Qu.:1 3rd Qu.:20.367 3rd Qu.:65.18 3rd Qu.:1670598
## Max. :1 Max. :37.318 Max. :78.94 Max. :3517756
## INGRESOS
## Min. :1020386
## 1st Qu.:3101544
## Median :4799180
## Mean :4650560
## 3rd Qu.:6204102
## Max. :8644666g_6= ggplot(datacr_1, aes(y=ANTIUEDAD, fill=ANTIUEDAD))+geom_boxplot(color="red", fill="violet")+theme_bw()+theme(legend.position="none", plot.title = element_text(size=11))+ggtitle("ANTIGUEDAD")+xlab("Antiguedad del Cliente")
g_6=ggplotly(g_6)
g_6g_7= ggplot(datacr_1, aes(y=EDAD, fill=EDAD))+geom_boxplot(color="grey", fill="blue")+theme_bw()+theme(legend.position="none", plot.title = element_text(size=11))+ggtitle("EDAD")+xlab("")
g_7=ggplotly(g_7)
g_7g_8= ggplot(datacr_1, aes(y=CUOTA_TOTAL, fill=CUOTA_TOTAL))+geom_boxplot(fill="green")+theme_bw()+theme(legend.position="none", plot.title = element_text(size=11))+ggtitle("CUOTA TOTAL")+xlab("")
g_8=ggplotly(g_8)
g_8g_9= ggplot(datacr_1, aes(y=INGRESOS, fill=INGRESOS))+geom_boxplot(fill="pink")+theme_bw()+theme(legend.position="none", plot.title = element_text(size=11))+ggtitle("INGRESOS")+xlab("")
g_9=ggplotly(g_9)
g_9Dentro de los clientes que han inclumplido su compromiso, se puede observar que las cuotas son en promedio de \(\$1.000.000\) con una distribución simetrica y unicamente un datos que supera los \(\$3.500.000\), lo que implica que el monto de la obligación no debe ser el principal problema para el no cumplimiento de la obligación. Por otra parte el promedio del salario es de \(\$4.799.180\) y en un rango desde \(\$1.000.000\) hasta \(\$8.600.000\), lo que nuevamente no muestra una relación directa y clara entre los salarios y el pago de de las obligaciones.
Para una evaluación en conjunto de las posibles combinaciones o variables que afectan este incumplimiento por parte de los clientes, se realiza una analisis bivariado.
Análisis Bivariado.
ggpairs(datacr, lower = list(continuous = "smooth"),
diag = list(continuous = "barDiag"), axisLabels = "none")
En el análisis bivariado se observa claramente que los ingresos existe
una correlación significativa entre el valor de la cuota total y el
inclumplimiento, que adicionalmente la antiguedad tiene una fuerte
tendencia lineal con la edad de los clientes y adicionalmente deja ver
que algunas cantidades tienen una tendencia normal, como la edad y la
distribución de los ingresos. Por otra parte los valores de las cuotas
presentan una distribución normal pero con alguna asimetria hacia la
izquierda o incluso se podria pensar que tiene otra distribución no
normal.
Para la selección de las covariables podemos decir que la que presentan una mayor correlación es cuota total, sin embargo al no ser tantas variables, podemos realizar un modelo de regresión logistica con todas las variables.
Modelo Logistico
modelo_credito=glm(DEFAULT~INGRESOS+ANTIUEDAD+EDAD+CUOTA_TOTAL,data = datacr,family = binomial(link="logit"))
summary(modelo_credito)##
## Call:
## glm(formula = DEFAULT ~ INGRESOS + ANTIUEDAD + EDAD + CUOTA_TOTAL,
## family = binomial(link = "logit"), data = datacr)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.9181 -0.3672 -0.2873 -0.1917 3.1332
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.193e+00 9.306e-01 -3.431 0.000601 ***
## INGRESOS -2.615e-07 1.057e-07 -2.474 0.013348 *
## ANTIUEDAD -4.616e-02 2.353e-02 -1.961 0.049849 *
## EDAD 2.229e-02 1.932e-02 1.154 0.248641
## CUOTA_TOTAL 1.013e-06 2.473e-07 4.098 4.16e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 309.68 on 779 degrees of freedom
## Residual deviance: 287.49 on 775 degrees of freedom
## AIC: 297.49
##
## Number of Fisher Scoring iterations: 6Del modelo es claro que las variable mas significativa es la cuota total, sin embargo los ingresos y la antiguedad son tambien variables a tener en cuenta, con una significancia menor que podria afectar el modelo.
Se observa que a mayor antiguedad, la probabilidad de incumplir con el credito es menor, al igual que a mayores ingresos su probabilidad de incumplimiento se hace menor. Por otra parte y mucho mas fuerte en el valor de significancia se hace que el aumento en el valor de la cuota, sea considerablemente el factor mas relevante que influiria en el incumplimiento de la obligación.
Para el modelo construido podemos validar usando ROC
set.seed(50)
n<- nrow(datacr)
indin<- 1:n
nent<-ceiling(0.7*n)
ntest<- n-nent
indient<- sort(sample(indin,nent))
inditest<- setdiff(indin,indient)
part <- datacr[indient,]
modelo_logistico <- glm(DEFAULT~INGRESOS+ANTIUEDAD+CUOTA_TOTAL,part,
family=binomial, maxit=10000)
prediccion= predict(modelo_logistico,list(INGRESOS =part$INGRESOS,
ANTIUEDAD=part$ANTIUEDAD,
CUOTA_TOTAL=part$CUOTA_TOTAL),type = "response")
ROC_res=roc(part$DEFAULT~prediccion, percent = T, ci=T)## Setting levels: control = 0, case = 1## Setting direction: controls < casesROC_res##
## Call:
## roc.formula(formula = part$DEFAULT ~ prediccion, percent = T, ci = T)
##
## Data: prediccion in 520 controls (part$DEFAULT 0) < 26 cases (part$DEFAULT 1).
## Area under the curve: 68.09%
## 95% CI: 57.33%-78.86% (DeLong)plot(ROC_res,print.auc=T,print.thres = "best",col="red"
,xlab = "Specificidad", ylab = "Sensitividad")
El modelo presenta un buen manejo predictivo, el area bajo la curva es del \(68\%\) lo que da un buen poder discriminatorio.