Informe regresión generalizada múltiple
Julian Diaz
2022-09-28
A. Punto 1 People analytics
Con base en los datos de rotación realizar los puntos 1 a 7.
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).
Hipótesis seleccionadas
H1.Viajes laborales. Se espera que las personas que tengan que viajar con mayor frecuencia podrían tener una mayor rotación, debido al desgaste físico que produce o menor tiempo disponible para compartir con la familia e hijos.
H2.Dpto de Ventas. Se espera que las personas que trabajen en ventas puedan tener mayor rotación asociado al cumplimiento de metas de ventas u oportunidades laborales con mayores esquemas de comisión en otras empresas.
H3.Equilibrio vida personal. Las personas que manifiestan tener poco equilibrio entre la vida personal y el trabajo buscan cambiar a trabajos que le permitan alcanzar ese equilibrio deseado.
H4.Cantidad de trabajos. Las personas que las personas con mayor cantidad de trabajos anteriores tengan una mayor rotación, debido a problemas de adaptación al cargo o a la cultura de la empresa o acceso a mejores salarios.
H5.% Aumento salario. Se espera que las personas con menor tasa de aumento laboral tengan una mayor rotación buscando aumentar su nivel de ingresos.
H6.Capacitaciones. Se espera que las personas con menor número de capacitaciones tengan mayor rotación buscando nuevas opciones laborales que les permitan fortalecer sus conocimientos.
knitr::opts_chunk$set(echo = TRUE)
library(readxl)
Datos_Rotación <- read_excel("C:/Users/Julian/Downloads/Datos_Rotación.xlsx")
head(Datos_Rotación)## # A tibble: 6 x 24
## Rotación Edad `Viaje de Negocios` Departamento Distancia_Casa Educación
## <chr> <dbl> <chr> <chr> <dbl> <dbl>
## 1 Si 41 Raramente Ventas 1 2
## 2 No 49 Frecuentemente IyD 8 1
## 3 Si 37 Raramente IyD 2 2
## 4 No 33 Frecuentemente IyD 3 4
## 5 No 27 Raramente IyD 2 1
## 6 No 32 Frecuentemente IyD 2 2
## # ... with 18 more variables: Campo_Educación <chr>,
## # Satisfacción_Ambiental <dbl>, Genero <chr>, Cargo <chr>,
## # Satisfación_Laboral <dbl>, Estado_Civil <chr>, Ingreso_Mensual <dbl>,
## # Trabajos_Anteriores <dbl>, Horas_Extra <chr>,
## # Porcentaje_aumento_salarial <dbl>, Rendimiento_Laboral <dbl>,
## # Años_Experiencia <dbl>, Capacitaciones <dbl>,
## # Equilibrio_Trabajo_Vida <dbl>, Antigüedad <dbl>, ...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.
require(dplyr)## Loading required package: dplyr##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionDatos_Re=Datos_Rotación %>%
mutate(Equilibrio=case_when(Equilibrio_Trabajo_Vida==1~"bajo",
Equilibrio_Trabajo_Vida==2~"regular",
Equilibrio_Trabajo_Vida==3~"bueno",
Equilibrio_Trabajo_Vida==4~"excelente"))
require(ggplot2)## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.1.3require(ggpubr)## Loading required package: ggpubrnames (Datos_Re)[1] = "Rotacion"
g1=ggplot(Datos_Re,aes(x=`Viaje de Negocios`))+geom_bar(aes(x = `Viaje de Negocios`),fill ='orange')+theme_bw()
g2=ggplot(Datos_Re,aes(x=Departamento))+geom_bar(aes(x = Departamento),fill ='orange')+theme_bw()
g3=ggplot(Datos_Re,aes(x=Equilibrio))+geom_bar(aes(x = Equilibrio),fill ='orange')+theme_bw()
g4=ggplot(Datos_Re,aes(x=Rotacion))+geom_bar(aes(x =Rotacion),fill ='orange')+theme_bw()
g5=ggplot(Datos_Re,aes(x=Trabajos_Anteriores))+geom_histogram(color="black", fill="orange",bins=30)+theme_bw()
g6=ggplot(Datos_Re,aes(x=Porcentaje_aumento_salarial))+geom_histogram(color="black", fill="orange",bins=30)+theme_bw()
g7=ggplot(Datos_Re,aes(x=Capacitaciones))+geom_histogram(color="black", fill="orange",bins=30)+theme_bw()
ggarrange(g1,g2,g3,g4,g5,g6,g7, labels=c("A","B","C","D","E","F","G"), ncol=3,nrow=3)
Tablas de frecuencia
prop.table(table(Datos_Re$`Viaje de Negocios`))*100##
## Frecuentemente No_Viaja Raramente
## 18.84354 10.20408 70.95238prop.table(table(Datos_Re$Departamento))*100##
## IyD RH Ventas
## 65.374150 4.285714 30.340136prop.table(table(Datos_Re$Equilibrio))*100##
## bajo bueno excelente regular
## 5.442177 60.748299 10.408163 23.401361prop.table(table(Datos_Re$Rotacion))*100##
## No Si
## 83.87755 16.12245Estadísticos tendencia central
#Tabla Trabajos anteriores
promedio_trabajos=mean(Datos_Re$Trabajos_Anteriores,na.rm = TRUE)
mediana_trabajos=median(Datos_Re$Trabajos_Anteriores,na.rm = TRUE)
maximo_trabajos=max(Datos_Re$Trabajos_Anteriores)
minimo_trabajos=min(Datos_Re$Trabajos_Anteriores)
#Tabla Aumento salarial
promedio_aumento=mean(Datos_Re$Porcentaje_aumento_salarial,na.rm = TRUE)
mediana_aumento=median(Datos_Re$Porcentaje_aumento_salarial,na.rm = TRUE)
maximo_aumento=max(Datos_Re$Porcentaje_aumento_salarial)
minimo_aumento=min(Datos_Re$Porcentaje_aumento_salarial)
#Tabla Capacitaciones
promedio_capacitaciones=mean(Datos_Re$Capacitaciones,na.rm = TRUE)
mediana_capacitaciones=median(Datos_Re$Capacitaciones,na.rm = TRUE)
maximo_capacitaciones=max(Datos_Re$Capacitaciones)
minimo_capacitaciones=min(Datos_Re$Capacitaciones)
#Generación tablas resumen
resultado_trabajos=data.frame(promedio_trabajos,mediana_trabajos,maximo_trabajos,minimo_trabajos)
resultado_aumentos=data.frame(promedio_aumento,mediana_aumento,maximo_aumento,minimo_aumento)
resultado_capacitaciones=data.frame(promedio_capacitaciones,mediana_capacitaciones,maximo_capacitaciones,minimo_capacitaciones)
resultados=data.frame(resultado_trabajos,resultado_aumentos,resultado_capacitaciones)
resultados## promedio_trabajos mediana_trabajos maximo_trabajos minimo_trabajos
## 1 2.693197 2 9 0
## promedio_aumento mediana_aumento maximo_aumento minimo_aumento
## 1 15.20952 14 25 11
## promedio_capacitaciones mediana_capacitaciones maximo_capacitaciones
## 1 2.79932 3 6
## minimo_capacitaciones
## 1 0Discusión de resultados
H1.Viajes laborales. Sólo el 18% de los empleados viaja de manera frecuente. No se descarta como un factor que incida en la rotación pero puede que solo lo haga para una determinada proporción de la población con ciertas características.
H2.Dpto de Ventas. El 30% de los empleados pertenece al área de ventas. Con esta información no se puede descartar o profundizar en la hipótesis inicial sobre su impacto en la rotación.
H3.Equilibrio vida personal. Un 29% de los empleados opinan que el equilibrio entre la vida personal y laboral en la empresa es bajo o regular. Es una cifra importante, que puede estar afectando las cifras de rotación
H4.Cantidad de trabajos.. La mediana de No de trabajos anteriores es baja, ubicándose en 2. Estos resultados indicarían en una primera etapa que un mayor número de trabajos no esta incidiendo de manera negativa en la rotación. Una pregunta que surge es el resultado del cruce del número de trabajos y edad, para validar si la poca experiencia y edad podrían ser un determinante.
H5.% Aumento salario. El aumento salarial es desigual y existe un grupo importante que recibe mayores incrementos salariales en comparación al resto.Esto podría indicar preferencias o criterios diferentes para fijar los aumentos salariales, generando incentivos para buscar nuevos trabajos, aumentando la rotación.
H6.Capacitaciones. En general se presenta un número similar de capacitaciones para todos. Puede que en lineas generales se perciba por parte de los empleados que el número recibida es bajo en comparación a la necesidades.
Rotación: Se tiene una rotación del 16% del total de la planta encuestada.
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 hipótesis planteada en el punto 2.
require(CGPfunctions)## Loading required package: CGPfunctionsrequire (plotly)## Loading required package: plotly##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutDatos_Re$y=as.numeric(Datos_Re$Rotacion=="Si")
PlotXTabs2(Datos_Re,`Viaje de Negocios`,y,plottype = "percent")
PlotXTabs2(Datos_Re, Departamento,y,plottype = "percent")
PlotXTabs2(Datos_Re, Equilibrio,y,plottype = "percent")
g4=ggplot(Datos_Re,aes(y,Trabajos_Anteriores,fill=Rotacion))+geom_violin()+geom_boxplot(fill="black", color="white",lwd=0.001, width=0.001)+theme_bw()+ scale_fill_brewer(palette= "Set2")+ theme(legend.position = "none")+
xlab("Rotacion")+ ylab("No trabajos anteriores")+ coord_flip()
g5=ggplot(Datos_Re,aes(x=y,y=Porcentaje_aumento_salarial,fill=Rotacion))+geom_boxplot()+theme_bw()
g6=ggplot(Datos_Re,aes(x=y,y=Capacitaciones,fill=Rotacion))+geom_boxplot()+theme_bw()
ggplotly(g4)## Warning: Continuous x aesthetic -- did you forget aes(group=...)?ggplotly(g5)ggplotly(g6)Discusión resultados análisis bivariado
H1.Viajes laborales. Aunque la proporción de empleados que viaja es baja en relación a quienes si lo hace, se observa que existe una mayor rotación en los empleados que viajan, en especial los que lo hacen de manera frecuente en comparación a los que si lo hacen. Definitivamente se perfila como una variable determinante de la rotación en la empresa analizada.
H2.Dpto de Ventas. La rotación en el área de ventas es mayor en comparación al área de I&D. Se confirma la hipótesis inicial planteada, donde se espera un mayor nivel debido al tipo y condiciones de trabajo.
H3.Equilibrio vida personal. Las personas con una opinión de un bajo equilibrio entre la vida personal y laboral tienen el doble de rotación de aquellas con una opinión más favorable. Se espera que sea otra variable de incidencia en la rotación.
H4.Cantidad de trabajos.. Esta segunda parte del análisis confirma que posiblemente el número de trabajos no es una variable que este incidiendo para esta empresa, no se observa una diferencia entre la distribución de empleados que rotan y el número de trabajos anteriores.
H5.% Aumento salario. Aunque el análisis descriptivo evidenciaba una distribución asimétrica, no se observan diferencias de aumentos salariales superiores en las personas que no rotan en comparación a las que si que nos lleven a pensar que puede ser una variable significativa.
H6.Capacitaciones. Al igual que la variable anterior no se observa una diferencia entre los trabajadores que rotan y aquellos que no,posiblemente puede llegar a ser una variable no determinante para el modelo, a partir de lo observado.
4. Realizar la estimación de un modelo de regresión logístico en el cual la variable respuesta es rotación (y=1 es si rotación, y=0 es no rotación) y las variables las 6 seleccionadas. Interprete los coeficientes del modelo y la significancia de los parámetros
modelo=glm(formula = y~ `Equilibrio`+ `Viaje de Negocios`+Departamento+Trabajos_Anteriores+Porcentaje_aumento_salarial +Capacitaciones, family= "binomial", data=Datos_Re)
summary(modelo)##
## Call:
## glm(formula = y ~ Equilibrio + `Viaje de Negocios` + Departamento +
## Trabajos_Anteriores + Porcentaje_aumento_salarial + Capacitaciones,
## family = "binomial", data = Datos_Re)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1825 -0.6271 -0.5107 -0.4155 2.4173
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.014189 0.461469 -0.031 0.975471
## Equilibriobueno -1.083860 0.266955 -4.060 4.91e-05 ***
## Equilibrioexcelente -0.860965 0.330605 -2.604 0.009209 **
## Equilibrioregular -0.874133 0.288577 -3.029 0.002453 **
## `Viaje de Negocios`No_Viaja -1.416778 0.335550 -4.222 2.42e-05 ***
## `Viaje de Negocios`Raramente -0.680193 0.166977 -4.074 4.63e-05 ***
## DepartamentoRH 0.367324 0.342662 1.072 0.283733
## DepartamentoVentas 0.553814 0.153775 3.601 0.000316 ***
## Trabajos_Anteriores 0.045377 0.028263 1.606 0.108372
## Porcentaje_aumento_salarial -0.005637 0.020073 -0.281 0.778859
## Capacitaciones -0.133564 0.059412 -2.248 0.024570 *
## ---
## 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: 1239.2 on 1459 degrees of freedom
## AIC: 1261.2
##
## Number of Fisher Scoring iterations: 5Análisis modelo
Al estimar el modelo logit observamos que las 3 variables cualitativas todas son significativas,sin embargo, no todas sus categorías lo son. En cuanto a las variables cuantitativas, solo el número de capacitaciones resulta ser significativa aunque no muy fuerte.
En cuanto los departamentos, se observa que trabajar en el área de Recursos humanos no incide en la rotación en comparación a la categoría de referencia, que es Investigación y desarrollo.
Procedemos a calcular el odds ratio para la interpretación de los coeficientes de manera adecuada.
Equilibrio: Las categorías de esta variable afectan de manera positiva la rotación, es decir, cualquier calificación diferente a bajo disminuye la probabilidad de rotar de la persona. A partir del odds ratio calculado, explicaremos los resultados del modelo.
Regular equilibrio: EL coeficiente es negativo, lo cual indica una relación inversa. Si una persona califica el equilibrio en este nivel su probabilidad de rotar es 0,58 veces menos que la persona en nivel bajo. buen equilibrio: EL coeficiente es negativo, lo cual indica una relación inversa. Si una persona califica el equilibrio en este nivel su probabilidad de rotar es 0,66 veces menos que la persona en nivel bajo. excelente equilibrio: EL coeficiente es negativo, lo cual indica una relación inversa. Si una persona califica el equilibrio en este nivel su probabilidad de rotar es 0,57 veces menos que la persona en nivel bajo.
Viaje de negocios: Las categorías de esta variable afectan de manera positiva la rotación, es decir, cualquier persona que no viaje de manera frecuente disminuye la probabilidad de rotar de la persona. A partir del odds ratio calculado, explicaremos los resultados del modelo.
No viaja: EL coeficiente es negativo, lo cual indica una relación inversa. Si una persona No viaja su probabilidad de rotar es 0,75 veces menos que la persona que viaja de manera frecuente.
Viaja raramente: EL coeficiente es negativo, lo cual indica una relación inversa. Si una persona viaja pocas veces o raramente, su probabilidad de rotar es 0,49 veces menos que la persona que viaja de manera frecuente.
Dpto: Las categorías de esta variable afectan de manera negativa la rotación, es decir, cualquier persona que trabaje en un área diferente a investigación y desarrollo aumenta la probabilidad de rotar de la persona. A partir del odds ratio calculado, explicaremos los resultados del modelo.
Dpto_RH: EL coeficiente es positivo, lo cual indica una relación directa. Sin embargo, el valor p es mayor a 0,05 razón por la cual no se reconoce su significancia para la rotación de las personas.
Dpto Ventas: EL coeficiente es positivo, lo cual indica una relación directa. Si una persona trabaja en esta área tiene una probabilidad de rotar 1,73 veces más que la persona que trabaja en investigación y desarrollo.
Capacitaciones: El recibir mayor número de capacitaciones afecta de manera positiva la rotación, es decir, disminuye la probabilidad de rotar en 0,12 veces.
exp(modelo$coefficients)## (Intercept) Equilibriobueno
## 0.9859112 0.3382871
## Equilibrioexcelente Equilibrioregular
## 0.4227540 0.4172237
## `Viaje de Negocios`No_Viaja `Viaje de Negocios`Raramente
## 0.2424942 0.5065192
## DepartamentoRH DepartamentoVentas
## 1.4438661 1.7398758
## Trabajos_Anteriores Porcentaje_aumento_salarial
## 1.0464224 0.9943792
## Capacitaciones
## 0.87497131-exp(modelo$coefficients[2:6])## Equilibriobueno Equilibrioexcelente
## 0.6617129 0.5772460
## Equilibrioregular `Viaje de Negocios`No_Viaja
## 0.5827763 0.7575058
## `Viaje de Negocios`Raramente
## 0.49348081-exp(modelo$coefficients[11])## Capacitaciones
## 0.12502875. Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
Se obtiene un AUC de 65,1% y una curva ROC que se comporta de manera aceptable. El modelo no tiene un buen poder predictivo.
library(pROC)## Warning: package 'pROC' was built under R version 4.1.3## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varpar(pty="s")
roc(Datos_Re$y,modelo$fitted.values,plot=TRUE,legacy.axes=TRUE,
percent=TRUE, xlab="Porcentaje de falsos positivos", ylab="Porcentaje de verdaderos positivos",col="#FF0000",lwd=4,print.auc=TRUE)## Setting levels: control = 0, case = 1## Setting direction: controls < cases
##
## Call:
## roc.default(response = Datos_Re$y, predictor = modelo$fitted.values, percent = TRUE, plot = TRUE, legacy.axes = TRUE, xlab = "Porcentaje de falsos positivos", ylab = "Porcentaje de verdaderos positivos", col = "#FF0000", lwd = 4, print.auc = TRUE)
##
## Data: modelo$fitted.values in 1233 controls (Datos_Re$y 0) < 237 cases (Datos_Re$y 1).
## Area under the curve: 65.11%6. Predecir la probabilidad de que un individuo (hipotético) rote y defina un corte para decidir si se debe intervenir a este empleado o no (posible estrategia para motivar al empleado).
Características del empleado
Equilibrio_vida_trabajo:regular Viaja negocios: muy frecuente Departamento: Ventas capacitaciones recibidas: 2
Este empleado tiene una probabilidad de rotar del 35,4%. Una de las maneras para determinar el punto de corte seria estableciendo la probabilidad de rotar que tenga el empleado con las características o condiciones que más aumentan la probabilidad de rotar, es decir: Trabaje en ventas, tenga un equilibrio bajo, viaje de manera frecuente y ninguna capacitación recibida. Esta probabilidad es del 63,17%. Se podría establecer que todos los trabajadores que se encuentren a una diferencia inferior al 50% de este punto deben ser intervenidos, teniendo en cuenta que bajo el modelo establecido las variables para intervenir pasan por medidas de equilibrio laboral y capacitaciones, donde esta última tiene baja incidencia. Aplicando este criterio se establece el punto de corte en 31.59%, el cual es superado por el trabajador por lo cual debe ser intervenido. De acuerdo a sus características, solo necesita bajar una escala en su nivel de satisfacción con el equilibrio para alcanzar el máximo nivel de alerta, momento para el cual ya pueda ser demasiado tarde.
p_lineal = -0.014189-(0.874133*1)+(0.553814 *1)-(0.133564*2)
prob_exp = 1/(1+exp(-p_lineal))*100
paste("Probabilidad de rotación:", round(prob_exp, 2),"%")## [1] "Probabilidad de rotación: 35.4 %"p_lineal2 = -0.014189+(0.553814 *1)
prob_exp = 1/(1+exp(-p_lineal2))*100
punto_corte=(prob_exp)*0.50
paste("Probabilidad de rotación puntos extremos:", round(prob_exp, 2),"%")## [1] "Probabilidad de rotación puntos extremos: 63.17 %"paste("Punto de corte intervención:", round(punto_corte, 2),"%")## [1] "Punto de corte intervención: 31.59 %"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).
La estrategia tendría dos frentes frentes, el primero estaría enfocado en generar acciones que permitan un mayor equilibrio entre la vida laboral y personal, para lo cual se daría la opción de un horario diferencial dos viernes del mes donde se trabajara hasta mediodía, permitiendo que las personas puedan tener un fin de semana más largo para disfrutar con su familia e intereses personales (Los viajes de negocios deberan planearse de tal forma que los empleados puedab beneficiarse de forma efectiva de esta medida). Adicional se establecerían horarios flexibles que permitan que las personas cumplan con las horas de trabajo en el espacio que mejor se adecue a sus intereses (ejercicio, vida familiar, estudio, entre otras). Finalmente, la empresa contratará un mensajero que realizara todas las vueltas o diligencias personales que pueda realizarle a los empleados (consignaciones, pago de servicios, compras, entre otros). Las personas que viajen tendrán una prelación para tener acceso a este servicio.
El segundo frente estaría en la realización de grupos focales en el área de ventas que permitan establecer cuales son las condiciones particulares de la misma que pueden estar influyendo para tener la mayor tasa de rotación de la compañía. Una mayor profundización de los datos podrían ayudar a estructurar estos grupos y definir unas hipótesis a validar.
Punto 2 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
Análisis descriptivo
library(readxl)
library(GGally)## Warning: package 'GGally' was built under R version 4.1.3## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2Datos_Creditos <- read_excel("C:/Users/Julian/Downloads/Datos_Creditos.xlsx")
cor(Datos_Creditos)## DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL INGRESOS
## DEFAULT 1.00000000 -0.06736953 -0.03352624 0.0965637 -0.06196296
## ANTIUEDAD -0.06736953 1.00000000 0.75279457 0.2671534 0.47661409
## EDAD -0.03352624 0.75279457 1.00000000 0.1502033 0.36493404
## CUOTA_TOTAL 0.09656370 0.26715340 0.15020333 1.0000000 0.36136271
## INGRESOS -0.06196296 0.47661409 0.36493404 0.3613627 1.00000000g9=ggplot(Datos_Creditos,aes(x=ANTIUEDAD))+geom_histogram(color="black", fill="orange",bins=30)+theme_bw()
g10=ggplot(Datos_Creditos,aes(x=EDAD))+geom_histogram(color="black", fill="orange",bins=30)+theme_bw()
g11=ggplot(Datos_Creditos,aes(x=CUOTA_TOTAL))+geom_histogram(color="black", fill="orange",bins=30)+theme_bw()
g12=ggplot(Datos_Creditos,aes(x=INGRESOS))+geom_histogram(color="black", fill="orange",bins=30)+theme_bw()
g13=ggplot(Datos_Creditos,aes(x=DEFAULT))+geom_histogram(color="black", fill="orange",bins=30)+theme_bw()
ggarrange(g9,g10,g11,g12,g13, labels=c("A","B","C","D","E"), ncol=2,nrow=3)
Correlación entre variables
Existe un alto nivel de correlación entre edad y antiguedad, mostrando indicios de una posible multicolinealidad en el modelo a estimar al usar las 2 variables.
cor(Datos_Creditos)## DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL INGRESOS
## DEFAULT 1.00000000 -0.06736953 -0.03352624 0.0965637 -0.06196296
## ANTIUEDAD -0.06736953 1.00000000 0.75279457 0.2671534 0.47661409
## EDAD -0.03352624 0.75279457 1.00000000 0.1502033 0.36493404
## CUOTA_TOTAL 0.09656370 0.26715340 0.15020333 1.0000000 0.36136271
## INGRESOS -0.06196296 0.47661409 0.36493404 0.3613627 1.00000000ggpairs(select_if(Datos_Creditos, is.numeric), lower = list(combo = wrap("facethist", binwidth = 7),continuous = "smooth"),diag = list(continuous = "barDiag"), axisLabels = "none")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Selección de variables
Para realizar la mejor selección de variables y teniendo en cuenta los posibles problemas potenciales de multicolinealidad esperados, se utiliza el método de Akaike Information Criterion (AIC), bajo una estimación hacia delante, con el propósito de realizar la mejor selección de variables posibles. Bajo este técnica tenemos la eliminación de la variable edad. Tambien se tiene que al correr el modelo sin esta variable, la antiguedad resulta no ser significativa, sin embargo se decide mantener al considerar que es importante para el modelo.
De acuerdo a estos resultados, la interpretación es la siguiente para el modelo final. Antiguedad: Tiene una relación inversa con el default. Es decir a mayor antiguedad del cliente menor es la probabilidad de que el cliente caiga en el mismo. Por cada año de antiguedad la probabilidad cae en 0,027 veces.
Cuota total: Tiene una relación directa con el default. Es decir por cada peso adicional que tenga la cuota se incrementa la probabilidad de caer en default.Por cada peso de antiguedad la probabilidad aumenta en 1 vez.
Ingresos del cliente: Tiene una relación inversa con el default. Es decir a mayor ingresos del cliente menor es la probabilidad de que el cliente caiga en el mismo. Por cada peso adicional cae en 0,000000254 veces.
library(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:plotly':
##
## select## The following object is masked from 'package:dplyr':
##
## selectempty.model= glm(DEFAULT ~ 1, data=Datos_Creditos,family="binomial")
horizonte= formula(DEFAULT~ ANTIUEDAD+EDAD+CUOTA_TOTAL+INGRESOS)
modforw <- stepAIC(empty.model, trace=FALSE, direction="forward", scope=horizonte)
modforw$anova## Stepwise Model Path
## Analysis of Deviance Table
##
## Initial Model:
## DEFAULT ~ 1
##
## Final Model:
## DEFAULT ~ CUOTA_TOTAL + INGRESOS + ANTIUEDAD
##
##
## Step Df Deviance Resid. Df Resid. Dev AIC
## 1 779 309.6838 311.6838
## 2 + CUOTA_TOTAL 1 6.061072 778 303.6227 307.6227
## 3 + INGRESOS 1 12.251435 777 291.3713 297.3713
## 4 + ANTIUEDAD 1 2.586531 776 288.7847 296.7847modelofinal=glm(formula=DEFAULT~ ANTIUEDAD+CUOTA_TOTAL+INGRESOS,family="binomial",data=Datos_Creditos)
summary(modelofinal)##
## Call:
## glm(formula = DEFAULT ~ ANTIUEDAD + CUOTA_TOTAL + INGRESOS, family = "binomial",
## data = Datos_Creditos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.8147 -0.3724 -0.2868 -0.1938 3.1088
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.244e+00 3.933e-01 -5.707 1.15e-08 ***
## ANTIUEDAD -2.817e-02 1.803e-02 -1.562 0.1183
## CUOTA_TOTAL 9.860e-07 2.456e-07 4.014 5.96e-05 ***
## INGRESOS -2.542e-07 1.059e-07 -2.400 0.0164 *
## ---
## 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: 288.78 on 776 degrees of freedom
## AIC: 296.78
##
## Number of Fisher Scoring iterations: 6exp(modelofinal$coefficients)## (Intercept) ANTIUEDAD CUOTA_TOTAL INGRESOS
## 0.1060238 0.9722276 1.0000010 0.99999971-exp(modelofinal$coefficients[2])## ANTIUEDAD
## 0.027772411-exp(modelofinal$coefficients[4])## INGRESOS
## 2.542042e-07Validación del modelo
El modelo tiene un limitado poder de predicción de acuerdo al AUC del 69,2%. El modelo es capaz de clasificar el 95,12% de las observaciones de entrenamiento, sin embargo, el modelo no es capaz de identificar de forma correcta a los clientes en default pues solo logra identificar 1 de los 39 clientes, es decir posee un porcentaje de falsos negativos muy alto. El modelo es muy bueno con los clientes “buenos” y no con los “malos”, en parte puede obedecer a que se tienen pocas observaciones de este tipo de clientes que permita al modelo discriminar de forma adecuada este tipo de clientes.
par(pty="s")
roc(Datos_Creditos$DEFAULT, modelofinal$fitted.values,plot=TRUE,legacy.axes=TRUE,
percent=TRUE, xlab="Porcentaje de falsos positivos", ylab="Porcentaje de verdaderos positivos",col="#FF0000",lwd=4,print.auc=TRUE)## Setting levels: control = 0, case = 1## Setting direction: controls < cases
##
## Call:
## roc.default(response = Datos_Creditos$DEFAULT, predictor = modelofinal$fitted.values, percent = TRUE, plot = TRUE, legacy.axes = TRUE, xlab = "Porcentaje de falsos positivos", ylab = "Porcentaje de verdaderos positivos", col = "#FF0000", lwd = 4, print.auc = TRUE)
##
## Data: modelofinal$fitted.values in 741 controls (Datos_Creditos$DEFAULT 0) < 39 cases (Datos_Creditos$DEFAULT 1).
## Area under the curve: 69.22%library(vcd)## Warning: package 'vcd' was built under R version 4.1.3## Loading required package: gridprediccion= predict.glm(modelofinal, newdata = Datos_Creditos, type = "response")
resultado_credito=table(Datos_Creditos$DEFAULT, ifelse(prediccion>0.5,1,0),dnn = c("observaciones", "predicciones"))
resultado_credito## predicciones
## observaciones 0 1
## 0 741 0
## 1 38 1mosaic(resultado_credito, shade = T, colorize = T,
gp = gpar(fill = matrix(c("green3", "red2", "red2", "green3"), 2, 2)))
sum(diag(resultado_credito)/sum(resultado_credito))## [1] 0.9512821