Informe de regresión logistica
Miguel Velandia - David Barrera
2022-10-02
require(ggplot2)
require(ggpubr)
require(plotly)
require(CGPfunctions)
require(readxl)
require(ROCR)
require(pROC)
library(corrplot)
library(psych)
library(GGally)
library(vcd)Informe de aplicación de regresión Logistica
Punto 1
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).
DatosRotacion <- read_excel("Datos_Rotación.xlsx")
names(DatosRotacion)## [1] "Rotación" "Edad"
## [3] "Viaje de Negocios" "Departamento"
## [5] "Distancia_Casa" "Educación"
## [7] "Campo_Educación" "Satisfacción_Ambiental"
## [9] "Genero" "Cargo"
## [11] "Satisfación_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_promoción" "Años_acargo_con_mismo_jefe"| Variable | Tipo | Justificacion | Hipotesisis |
|---|---|---|---|
| Edad | Cuantitativa | La edad de las personas puede relacionarse con la rotación ya que al tener menos edad hay más probabilidad de crecimiento laboral | Las personas que tienen menor edad son más propensas a rotar que las personas de mayor edad |
| Ingreso_Mensual | Cuantitativa | Los ingresos se relacionan con la rotación laboral ya que aquellas personas que tienen menos ingresos pueden buscar alternativas laborales | Las personas cuyo ingreso es menor tienen más probabilidad de rotas que aquellas que tienen más ingresos |
| Antigüedad | Cuantitativa | La antigüedad puede ser un factor determinante ya que aquellas personas que cuentan con más tiempo laborando en una empresa tienen a rotar menos que aquellos que llevan menos | Las personas que cuentan con mayor antigüedad en la empresa tienen a rotar menos que aquellos que llevan menos |
| Genero | Cualitativa | El género de las personas tiene relación con su rotación en las empresas ya que el género masculino suele tener más oportunidades laborales | Las personas de género masculino tienden a rotar más que las personas de género femenino |
| Cargo | Cualitativa | El cargo de las personas en una empresa se relaciona con la rotación ya que las personas que ocupan cargos menores suelen tener un crecimiento profesional | Las personas cuyo cargo o rol es de menor jerarquía tienen mayor probabilidad de rotar a diversos roles de mayor responsabilidad |
| Estado_Civil | Cualitativa | Se espera que el estado civil de las personas se relacione con su rotación ya que entre menos responsabilidad tengan en su hogar mayor será su probabilidad de rotar | Las personas de estado civil soltero tienen mayor probabilidad de rotar ya que tienen menores responsabilidades y compromisos |
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.
G1 = ggplot(DatosRotacion,aes(x=Edad))+geom_histogram()+theme_bw()
G2 = ggplot(DatosRotacion,aes(x=Ingreso_Mensual))+geom_histogram()+theme_bw()
graficos1=ggarrange(G1, G2,labels = c("A", "B"), ncol = 2, nrow = 1)
graficos1
promedio=mean(DatosRotacion$Edad)
mediana=median(DatosRotacion$Edad)
minimo=min(DatosRotacion$Edad)
maximo=max(DatosRotacion$Edad)
tabla1=data.frame(promedio,mediana,minimo,maximo)
tabla1## promedio mediana minimo maximo
## 1 36.92381 36 18 60promedioing=mean(DatosRotacion$Ingreso_Mensual)
medianaing=median(DatosRotacion$Ingreso_Mensual)
minimoing=min(DatosRotacion$Ingreso_Mensual)
maximoing=max(DatosRotacion$Ingreso_Mensual)
tabla2=data.frame(promedioing,medianaing,minimoing,maximoing)
tabla2## promedioing medianaing minimoing maximoing
## 1 6502.931 4919 1009 19999Análisis A y B
En el grafico A y tabla 1 podemos ver que la edad de los empleados en la empresa va de los 18 a los 60 años y el promedio es de 36.9%
En el grafico B y tabla 2 se observa ver que el salario de los empleados en la empresa va desde 1M hasta los 19.9M con un promedio salarial de 6.5M
G3 = ggplot(DatosRotacion,aes(x=Antigüedad))+geom_histogram()+theme_bw()
G4 = ggplot(DatosRotacion,aes(x=Genero))+geom_bar()+theme_bw()
ggarrange(G3, G4,labels = c("C","D"), ncol = 2, nrow = 1)
Análisis C y D
En el grafico C se evidencia que la antigüedad de los empleados en la empresa va desde los 0 años hasta los 40 años.
En el grafico D es evidente que la mayoría de los empleados es de género Masculino.
G5 = ggplot(DatosRotacion,aes(x=Cargo))+geom_bar()+theme_bw()+ theme(axis.text.x = element_text(angle = 90, hjust = 1))
G6 = ggplot(DatosRotacion,aes(x=Estado_Civil))+geom_bar()+theme_bw()
ggarrange(G5, G6,labels = c("E","F"), ncol = 2, nrow = 1)
Análisis E y F
En el grafico E se evidencia que el cargo con más personal es “Ejecutivo_Ventas” mientras que el cargo con menor cantidad de personas es “Recursos_Humanos”.
En el grafico F podemos observar que la mayoría de los empleados son casados, seguido de aquellos que son solteros y por último divorciados.
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.
G7 = ggplot(DatosRotacion,aes(x=Rotación,y=Edad,fill=Rotación))+geom_boxplot()+theme_bw()
DatosRotacion$RangoEdad=cut(DatosRotacion$Edad,breaks = c(0,20,30,40,50,60))
data.frame(table(DatosRotacion$RangoEdad))## Var1 Freq
## 1 (0,20] 28
## 2 (20,30] 358
## 3 (30,40] 619
## 4 (40,50] 322
## 5 (50,60] 143G8 = PlotXTabs2(DatosRotacion, RangoEdad, Rotación, x.axis.orientation = "vertical", results.subtitle = FALSE)
ggarrange(G7, G8,labels = c("A","B"), ncol = 1, nrow = 1)## $`1`
##
## $`2`
##
## attr(,"class")
## [1] "list" "ggarrange"Se observa que la edad de los empleados que mas rotan es de entre 0-20 años con un 57% de rotacion, mientras que la edad de los que menos rotan es de entre 40-50 años con un 11%
DatosRotacion$Ingreso_Mensual2=DatosRotacion$Ingreso_Mensual/1000
DatosRotacion$RangoIngreso=cut(DatosRotacion$Ingreso_Mensual2,breaks = c(0,5,10,15,20,30))
data.frame(table(DatosRotacion$RangoIngreso))## Var1 Freq
## 1 (0,5] 749
## 2 (5,10] 440
## 3 (10,15] 148
## 4 (15,20] 133
## 5 (20,30] 0G9 = PlotXTabs2(DatosRotacion, RangoIngreso, Rotación, x.axis.orientation = "vertical", results.subtitle = FALSE)
G9
Los empleados con menor ingreso tienden a rotar mas que los empleados
con mayores ingresos
DatosRotacion$RangoAntigüedad=cut(DatosRotacion$Antigüedad,breaks = c(0,5,10,20,30,40,50))
data.frame(table(DatosRotacion$RangoAntigüedad))## Var1 Freq
## 1 (0,5] 732
## 2 (5,10] 448
## 3 (10,20] 180
## 4 (20,30] 50
## 5 (30,40] 16
## 6 (40,50] 0G10 = PlotXTabs2(DatosRotacion, RangoAntigüedad, Rotación, x.axis.orientation = "vertical", results.subtitle = FALSE)
G10
Analizando la rotacion por Antigüedad podemos evidenciar que la rotacion
en mayor medida se esta dando en los empleados mas antiguos con un 25%
de rotacion, seguido por los empleados con menor tiempo en la compañia
con un 20% de rotacion
G11 = PlotXTabs2(DatosRotacion, Genero, Rotación, x.axis.orientation = "vertical", results.subtitle = FALSE)
G11
Los empleados de Genero Maculino tienden a rotar un 2% mas que los empleados de genero femenino
G12 = PlotXTabs2(DatosRotacion, Cargo, Rotación, x.axis.orientation = "vertical", results.subtitle = FALSE)
G12
Se evidencia que los empleados con el cargo Representante_Ventas son quienes rotan mas con un 40% de rotacion, lo cual es un porcentaje importante
G13 = PlotXTabs2(DatosRotacion, Estado_Civil, Rotación, x.axis.orientation = "vertical", results.subtitle = FALSE)
G13
Los empleados con estado civil Soltero tienen el porcentaje de rotacion
mas alto con un 26%
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.
DatosRotacion$Rotación <- as.factor(DatosRotacion$Rotación)
mod1=glm(Rotación ~ Edad + Ingreso_Mensual + Antigüedad + Genero + Cargo +
Estado_Civil,data = DatosRotacion,family = "binomial")
summary(mod1)##
## Call:
## glm(formula = Rotación ~ Edad + Ingreso_Mensual + Antigüedad +
## Genero + Cargo + Estado_Civil, family = "binomial", data = DatosRotacion)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3288 -0.6297 -0.4755 -0.2716 3.0055
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.407e+00 1.024e+00 -3.328 0.000876 ***
## Edad -2.287e-02 9.795e-03 -2.335 0.019530 *
## Ingreso_Mensual 5.463e-05 4.595e-05 1.189 0.234540
## Antigüedad -4.033e-02 1.836e-02 -2.197 0.028036 *
## GeneroM 1.380e-01 1.555e-01 0.887 0.374944
## CargoDirector_Manofactura 1.240e+00 8.767e-01 1.415 0.157134
## CargoEjecutivo_Ventas 2.254e+00 8.352e-01 2.699 0.006959 **
## CargoGerente 7.872e-01 8.567e-01 0.919 0.358169
## CargoInvestigador_Cientifico 2.146e+00 9.226e-01 2.326 0.020002 *
## CargoRecursos_Humanos 2.771e+00 9.431e-01 2.938 0.003308 **
## CargoRepresentante_Salud 1.278e+00 8.834e-01 1.447 0.147850
## CargoRepresentante_Ventas 3.224e+00 9.478e-01 3.402 0.000669 ***
## CargoTecnico_Laboratorio 2.675e+00 9.198e-01 2.909 0.003627 **
## Estado_CivilDivorciado -2.094e-01 2.230e-01 -0.939 0.347612
## Estado_CivilSoltero 7.833e-01 1.648e-01 4.754 1.99e-06 ***
## ---
## 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: 1161.3 on 1455 degrees of freedom
## AIC: 1191.3
##
## Number of Fisher Scoring iterations: 6las covariables que logran una significancia menor a 0.05 y que por consiguiente logran explicar la rotacion en la empresa son Edad, Antigüedad y cargo, por otra parte las variables que no aportar mucho valor para determinar la rotacion son Ingreso_Mensual, Genero y Estado_Civil.
exp(mod1$coefficients)## (Intercept) Edad
## 0.03312525 0.97738581
## Ingreso_Mensual Antigüedad
## 1.00005463 0.96047291
## GeneroM CargoDirector_Manofactura
## 1.14796764 3.45679803
## CargoEjecutivo_Ventas CargoGerente
## 9.52654650 2.19717825
## CargoInvestigador_Cientifico CargoRecursos_Humanos
## 8.55357495 15.96697161
## CargoRepresentante_Salud CargoRepresentante_Ventas
## 3.59089645 25.13523365
## CargoTecnico_Laboratorio Estado_CivilDivorciado
## 14.51923449 0.81106647
## Estado_CivilSoltero
## 2.188780535. Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
prediccion_rotacion= predict.glm(mod1, newdata = DatosRotacion, type = "response")
resultado_Rot=table(DatosRotacion$Rotación, ifelse(prediccion_rotacion>0.2,1,0),dnn = c("observaciones", "predicciones"))
resultado_Rot## predicciones
## observaciones 0 1
## No 927 306
## Si 98 139mc=(resultado_Rot[1,1]+resultado_Rot[2,2])/sum(resultado_Rot)*100
mc## [1] 72.51701mosaic(resultado_Rot,shade=T,colorize=T,gp=gpar(fill=matrix(c("green3","red2","red2","green3"),2,2)))
prediccion_Rota= ROCR::prediction(prediccion_rotacion,DatosRotacion$Rotación)
perf_rotacion= performance(prediction.obj = prediccion_Rota, "tpr", "fpr")
plot(perf_rotacion)
abline(a = 0, b = 1,col="blue")
grid()
AUClog= performance(prediccion_Rota, measure = "auc")@y.values[[1]]
cat("AUC: ", AUClog, "n")## AUC: 0.7304335 nEl modelo tiene un porcentaje de prediccion del 73% lo cual es aceptable, lo que implicaria que con el modelo es posible una prediccion de rotacion aceptable para lo que requiere la empresa, en caso de querer elevar este porcentaje de prediccion se requeriria analizar variables adicicionales que pudieran tener mayor significacncia en el 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).
(predict(mod1,list(Edad = 24, Ingreso_Mensual = 2909
,Antigüedad=10,Genero= "M", Cargo = "Investigador_Cientifico", Estado_Civil = "Soltero"),type = "response"))*100## 1
## 24.35836Realizando la prueba del modelo con un individuo cuyas carateristicas son:
Edad = 24 años ingresos = 2909 antiguedad = 10 años genero = masculino cargo = Investigador_Cientifico Estado civil = Soltero
El modelo nos genera que la probabilidad de que este individuo rote es de un 24%
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).
Con base al análisis obtenido de cada uno de los puntos se le proponen a la empresa las siguientes estrategias con el fin de reducir la rotación
- Implementar un plan carrera para que aquellos empleados jóvenes puedan ver una oportunidad de crecimiento
- Genenrar incentivos como bonos por cumplimientos para aquellos cargos con mayor rotación
- Incrementar la contratación de personal de género femenino con el fin de nivelar los géneros y ya que se evidencia que el género femenino rota menos reducir la rotación
- Ver la posibilidad de un incremento salarial o un bono adicional para aquellos empleados cuyo salario no es competitivo y toman la decisión de rotar
- Implementar un esquema de bono adicional por antigüedad de tal forma que los empleados nuevos vean estos bonos como un objetivo a cumplir
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.
Tranformación de los datos y analisis exploratorio
- Se convierte la variable DEFAULT a factor para definir las dos categorías 0 y 1
- Se agrega el campo COMPROMETIDO para poder medir el % de compromiso de la cuota frente el ingreso
- Se observa que la variable antigüedad, edad y cuota total se agrupan el los cuartiles y no presentan valores atípicos y se observa asimetría entre los valores
- Se observa que la variable ingresos presenta valores atípicos con valores de DEAFULT 0 con asimetría negativa.
datos_creditos <- read_excel("Datos_Creditos.xlsx")
head(datos_creditos)## # A tibble: 6 × 5
## DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL INGRESOS
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 37.3 77.0 3020519 8155593
## 2 1 37.3 73.8 1766552 6181263
## 3 1 31.0 78.9 1673786 4328075
## 4 1 9.73 51.5 668479 5290910
## 5 1 8.44 39.0 1223559 5333818
## 6 1 6.61 44.9 3517756 2710736datos_creditos$CUOTA_TOTAL=datos_creditos$CUOTA_TOTAL/1000000
datos_creditos$INGRESOS=datos_creditos$INGRESOS/1000000
datos_creditos$COMPROMETIDO=datos_creditos$CUOTA_TOTAL/datos_creditos$INGRESOS*100
datos_creditos$DEFAULT=as.factor(datos_creditos$DEFAULT)
summary(datos_creditos)## DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL INGRESOS
## 0:741 Min. : 0.2548 Min. :26.61 Min. :0.000387 Min. : 0.6338
## 1: 39 1st Qu.: 7.3767 1st Qu.:48.18 1st Qu.:0.328516 1st Qu.: 3.5833
## Median :15.1192 Median :57.92 Median :0.694461 Median : 5.0390
## Mean :18.0353 Mean :56.99 Mean :0.885206 Mean : 5.3664
## 3rd Qu.:30.6637 3rd Qu.:66.19 3rd Qu.:1.244126 3rd Qu.: 6.8441
## Max. :37.3178 Max. :92.43 Max. :6.664588 Max. :22.1970
## COMPROMETIDO
## Min. : 0.01126
## 1st Qu.: 7.58949
## Median : 15.58150
## Mean : 17.44663
## 3rd Qu.: 25.27053
## Max. :129.77125Analisis exploratorio
g1=ggplot(datos_creditos, aes(x=DEFAULT,y=ANTIUEDAD,fill=DEFAULT))+geom_boxplot(outlier.shape = NA)+geom_jitter(width = 0.1)+theme(legend.position = "left")+ggtitle("Figura 1. Relación default VS antiguedad")+theme_bw()
ggplotly(g1)g2=ggplot(datos_creditos, aes(x=DEFAULT,y=EDAD,fill=DEFAULT))+geom_boxplot()+geom_boxplot(outlier.shape = NA)+geom_jitter(width = 0.1)+theme(legend.position = "left")+ggtitle("Figura 1. Relación default VS edad")+theme_bw()
ggplotly(g2)g3=ggplot(datos_creditos, aes(x=DEFAULT,y=CUOTA_TOTAL,fill=DEFAULT))+geom_boxplot(outlier.shape = NA)+geom_jitter(width = 0.1)+geom_boxplot()+theme(legend.position = "left")+ggtitle("Figura 1. Relación default VS cuota Total")+theme_bw()
ggplotly(g3)g4=ggplot(datos_creditos, aes(x=DEFAULT,y=INGRESOS,fill=DEFAULT))+geom_boxplot(outlier.shape = NA)+geom_jitter(width = 0.1)+geom_boxplot()+theme(legend.position = "left")+ggtitle("Figura 1. Relación default VS Ingresos")+theme_bw()
ggplotly(g4)Creación del modelo de regresión
Acorde al modelo, el logaritmo de odds esta positivamente relacionado con la antigüedad si esta es mayor, menor es el riesgo de DEFAULT
mod2=glm(DEFAULT ~ EDAD + ANTIUEDAD + CUOTA_TOTAL + INGRESOS + COMPROMETIDO, data = datos_creditos,family = "binomial")
summary(mod2)##
## Call:
## glm(formula = DEFAULT ~ EDAD + ANTIUEDAD + CUOTA_TOTAL + INGRESOS +
## COMPROMETIDO, family = "binomial", data = datos_creditos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.0415 -0.3615 -0.2782 -0.2005 3.0690
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.69954 1.07335 -3.447 0.000567 ***
## EDAD 0.02182 0.01929 1.131 0.257980
## ANTIUEDAD -0.04630 0.02330 -1.987 0.046892 *
## CUOTA_TOTAL 0.58543 0.50135 1.168 0.242919
## INGRESOS -0.15501 0.14669 -1.057 0.290650
## COMPROMETIDO 0.02166 0.02247 0.964 0.335114
## ---
## 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: 286.56 on 774 degrees of freedom
## AIC: 298.56
##
## Number of Fisher Scoring iterations: 6Solo se evidencia una covariables que logra una significancia menor a 0.05 y es la ANTIUEDAD
mod2mejorado = step(mod2)## Start: AIC=298.56
## DEFAULT ~ EDAD + ANTIUEDAD + CUOTA_TOTAL + INGRESOS + COMPROMETIDO
##
## Df Deviance AIC
## - COMPROMETIDO 1 287.49 297.49
## - EDAD 1 287.81 297.81
## - INGRESOS 1 287.81 297.81
## - CUOTA_TOTAL 1 287.96 297.96
## <none> 286.56 298.56
## - ANTIUEDAD 1 290.45 300.45
##
## Step: AIC=297.49
## DEFAULT ~ EDAD + ANTIUEDAD + CUOTA_TOTAL + INGRESOS
##
## Df Deviance AIC
## - EDAD 1 288.79 296.79
## <none> 287.49 297.49
## - ANTIUEDAD 1 291.28 299.28
## - INGRESOS 1 294.76 302.76
## - CUOTA_TOTAL 1 304.34 312.34
##
## Step: AIC=296.78
## DEFAULT ~ ANTIUEDAD + CUOTA_TOTAL + INGRESOS
##
## Df Deviance AIC
## <none> 288.79 296.79
## - ANTIUEDAD 1 291.37 297.37
## - INGRESOS 1 295.61 301.61
## - CUOTA_TOTAL 1 304.95 310.95datos_creditos$DEFAULT=as.character(datos_creditos$DEFAULT)
datos_creditos$DEFAULT=as.numeric(datos_creditos$DEFAULT)
summary(mod2mejorado)##
## 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.24409 0.39325 -5.707 1.15e-08 ***
## ANTIUEDAD -0.02817 0.01803 -1.562 0.1183
## CUOTA_TOTAL 0.98598 0.24561 4.014 5.96e-05 ***
## INGRESOS -0.25420 0.10594 -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: 6En el modelo ajustado, se observa que se elimina la variable EDAD, ademas, ahora la variable ANTIUEDAD tiene poca significancia en el modelo, mientras que la variable INGRESOS toma mayor significancia.
Se analiza segun el resultado del mosaico que el modelo es capaz de clasificar correctamente el 94,7% de las observaciones, pero sin embargo se observa que el modelo solo fue capaz de indentificar 1 de los 39 datos en default 1, lo que constituye un porcentaje alto de falsos negativos, se recomienda es evaluar la exactitud del modelo.
OR=exp(mod2mejorado$coefficients)
OR## (Intercept) ANTIUEDAD CUOTA_TOTAL INGRESOS
## 0.1060238 0.9722276 2.6804343 0.7755334prediccion_credito= predict.glm(mod2mejorado, newdata = datos_creditos, type = "response")
resultado_cre=table(datos_creditos$DEFAULT, ifelse(prediccion_credito>0.2,1,0),dnn=c("observaciones","predicciones"))
resultado_cre## predicciones
## observaciones 0 1
## 0 738 3
## 1 38 1mc=(resultado_cre[1,1]+resultado_cre[2,2])/sum(resultado_cre)*100
mc## [1] 94.74359mosaic(resultado_cre,shade=T,colorize=T,gp=gpar(fill=matrix(c("green3","red2","red2","green3"),2,2)))
prediccion_default= ROCR::prediction(prediccion_credito,datos_creditos$DEFAULT)
perf_credito= performance(prediction.obj = prediccion_default, "tpr", "fpr")
plot(perf_credito)
abline(a = 0, b = 1,col="blue")
grid()
AUC= performance(prediccion_default,measure = "auc")@y.values[[1]]
cat("AUC: ",AUC,"n")## AUC: 0.6922385 nEl modelo tiene un porcentaje de prediccion del 69% lo cual es regular, implicaria que el modelo no es recomendable para ser utilizado para predicciones.