Informe regresión generalizada múltiple

names(datos)

##  [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"

Punto 1:

library(readxl)
library(dplyr)
glimpse(datos)

## Rows: 1,470
## Columns: 24
## $ Rotación                    <chr> "Si", "No", "Si", "No", "No", "No", "No", ~
## $ Edad                        <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35~
## $ `Viaje de Negocios`         <chr> "Raramente", "Frecuentemente", "Raramente"~
## $ Departamento                <chr> "Ventas", "IyD", "IyD", "IyD", "IyD", "IyD~
## $ Distancia_Casa              <dbl> 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, 15, 2~
## $ Educación                   <dbl> 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1, 2, ~
## $ Campo_Educación             <chr> "Ciencias", "Ciencias", "Otra", "Ciencias"~
## $ Satisfacción_Ambiental      <dbl> 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1, 2, ~
## $ Genero                      <chr> "F", "M", "M", "F", "M", "M", "F", "M", "M~
## $ Cargo                       <chr> "Ejecutivo_Ventas", "Investigador_Cientifi~
## $ Satisfación_Laboral         <dbl> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, ~
## $ Estado_Civil                <chr> "Soltero", "Casado", "Soltero", "Casado", ~
## $ Ingreso_Mensual             <dbl> 5993, 5130, 2090, 2909, 3468, 3068, 2670, ~
## $ Trabajos_Anteriores         <dbl> 8, 1, 6, 1, 9, 0, 4, 1, 0, 6, 0, 0, 1, 0, ~
## $ Horas_Extra                 <chr> "Si", "No", "Si", "Si", "No", "No", "Si", ~
## $ Porcentaje_aumento_salarial <dbl> 11, 23, 15, 11, 12, 13, 20, 22, 21, 13, 13~
## $ Rendimiento_Laboral         <dbl> 3, 4, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 3, 3, ~
## $ Años_Experiencia            <dbl> 8, 10, 7, 8, 6, 8, 12, 1, 10, 17, 6, 10, 5~
## $ Capacitaciones              <dbl> 0, 3, 3, 3, 3, 2, 3, 2, 2, 3, 5, 3, 1, 2, ~
## $ Equilibrio_Trabajo_Vida     <dbl> 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2, 3, ~
## $ Antigüedad                  <dbl> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2,~
## $ Antigüedad_Cargo            <dbl> 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2, 2, ~
## $ Años_ultima_promoción       <dbl> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, ~
## $ Años_acargo_con_mismo_jefe  <dbl> 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 3, 2, ~

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).

Variables categóricas:

• Frecuencia de viaje de negocios (Frecuentemente, Raramente, No viaja).
• Estado civil (Casado, Soltero, Divorciado).
• Horas extra (Si, No).

Variables cuantitativas:

• Distancia a Casa (km).
• Ingreso Mensual ($).
• Porcentaje aumento salarial (%).

Hipótesis:

• Las personas con mayor frecuencia de viajes tienen mayor posibilidad de rotar por efectos de cansancio.
• Las personas con estado civil Soltero tienen mayor posibilidad de rotar que las personas casadas ya que lo ultimo involucra una mayor responsabilidad.
• Las personas que trabajan horas extra tienen mayor posibilidad de rotar que las que no trabajan extra, ya que no tienen suficiente tiempo libre.
• Las personas que viven mas distantes de casa tienen mayor posibilidad de rotar debido al estrés que genera el trafico.
• Entre menor ingreso mensual, mayor posibilidad de rotar, ya que las personas quieren aumentar sus ingresos.
• Entre menor porcentaje de aumento salarial, mayor posibilidad de rotar, las personas quieren crecimiento económico.

Punto 1.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.

Variable Rotacion:

require(ggplot2)
require(ggpubr)
require(ggplot2)
ggplot(datos,aes(Rotación, fill=Rotación))+
  geom_bar()+
  theme_bw()

Se evidencia que el 84% de los usuarios no han rotado, mientras que el 16% si lo han hecho:

participacion_rot = prop.table(table(datos$Rotación))*100
participacion_rot

## 
##       No       Si 
## 83.87755 16.12245

Variables Categóricas:

g1=ggplot(datos,aes(x=`Viaje de Negocios`))+geom_bar()+theme_bw()+theme(axis.text.x = element_text(angle = 90))
g2=ggplot(datos,aes(x=Estado_Civil))+geom_bar()+theme_bw()+theme(axis.text.x = element_text(angle = 90))
g3=ggplot(datos,aes(x=Horas_Extra))+geom_bar()+theme_bw()+theme(axis.text.x = element_text(angle = 90))

Frecuencia_viaje = prop.table(table(datos$`Viaje de Negocios`))*100
Estado_civil = prop.table(table(datos$Estado_Civil))*100
Horas_Extra = prop.table(table(datos$Horas_Extra))*100

ggarrange(g1, g2, g3,labels = c("A", "B", "C"),ncol = 3, nrow = 1)

#En general el 71% los usuarios raramente viajan, el 10% no viaja y el 19% viaja frecuentemente:
Frecuencia_viaje 

## 
## Frecuentemente       No_Viaja      Raramente 
##       18.84354       10.20408       70.95238

#El 46% de los usuarios está casado, el 22% divorciado, mientras que los solteros componen el 32%.
Estado_civil 

## 
##     Casado Divorciado    Soltero 
##   45.78231   22.24490   31.97279

#El 72% de los usuarios no hace horas extra, mientras que el 28% si. 
Horas_Extra

## 
##       No       Si 
## 71.70068 28.29932

Variables Numericas:

require(ggplot2)
require(plotly)
graph1= ggplot(datos,aes( y=Distancia_Casa))+
  geom_boxplot(colour = "#3366FF",outlier.colour = "red")+
  theme_bw()
graph2= ggplot(datos,aes( y=Ingreso_Mensual))+
  geom_boxplot(colour = "#3366FF",outlier.colour = "red")+
  theme_bw()
graph3= ggplot(datos,aes( y=Porcentaje_aumento_salarial))+
  geom_boxplot(colour = "#3366FF",outlier.colour = "red")+
  theme_bw()

library(patchwork)
graph1 + graph2 + graph3

#Estadísticas Distancia_Casa
media_distancia = mean(datos$Distancia_Casa)
mediana_distancia = median(datos$Distancia_Casa)
desviacion_distancia = sd(datos$Distancia_Casa)
min_distancia = min(datos$Distancia_Casa)
max_distancia = max(datos$Distancia_Casa)
data_Distancia = data.frame(media_distancia,mediana_distancia, desviacion_distancia, min_distancia, max_distancia)

#Estadísticas Ingreso Mensual
media_ingreso = mean(datos$Ingreso_Mensual)
mediana_ingreso = median(datos$Ingreso_Mensual)
desviacion_ingreso = sd(datos$Ingreso_Mensual)
min_ingreso = min(datos$Ingreso_Mensual)
max_ingreso = max(datos$Ingreso_Mensual)
data_ingreso = data.frame(media_ingreso,mediana_ingreso, desviacion_ingreso, min_ingreso, max_ingreso)

#Estadísticas Porcentaje aumento salarial
media_aumento = mean(datos$Porcentaje_aumento_salarial)
mediana_aumento = median(datos$Porcentaje_aumento_salarial)
desviacion_aumento = sd(datos$Porcentaje_aumento_salarial)
min_aumento = min(datos$Porcentaje_aumento_salarial)
max_aumento = max(datos$Porcentaje_aumento_salarial)
data_aumento = data.frame(media_aumento,mediana_aumento, desviacion_aumento, min_aumento, max_aumento)


#En cuanto a distancia, se observa que la mayoría de los datos se distribuyen en el rango de 1 a 10 kilómetros, con una mediana de 7 kilómetros. 
data_Distancia

media_distancia	mediana_distancia	desviacion_distancia	min_distancia	max_distancia
9.192517	7	8.106864	1	29

#En cuanto al ingreso, se observa que la mayoría de datos se distribuyen alrededor de $4919
data_ingreso

media_ingreso	mediana_ingreso	desviacion_ingreso	min_ingreso	max_ingreso
6502.931	4919	4707.957	1009	19999

#En cuanto al porcentaje de aumento salarial, se observa que la mayoría de los datos se distribuyen alrededor del 14% 
data_aumento

media_aumento	mediana_aumento	desviacion_aumento	min_aumento	max_aumento
15.20952	14	3.659938	11	25

Punto 1.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.

require(CGPfunctions)
require(ggpubr)
require(plotly)

datos$y=as.numeric(datos$Rotación=="Si")
datos$y=as.factor(datos$y)
datos$Viaje_de_Negocios =as.factor(datos$`Viaje de Negocios`)
datos$Estado_Civil=as.factor(datos$Estado_Civil)
datos$Horas_Extra=as.factor(datos$Horas_Extra)

g1=PlotXTabs2(datos, `Viaje de Negocios`,y, plottype ="percent", palette = "Pastel1")
g2=PlotXTabs2(datos,Estado_Civil,  y, plottype = "percent" ,palette = "Pastel1")
g3=PlotXTabs2(datos, y, Horas_Extra, plottype ="percent",palette = "Pastel1")

Variables Categóricas

Hipótesis: Las personas con mayor frecuencia de viajes tienen mayor posibilidad de rotar por efectos de cansancio. El 25% de las personas que viajan frecuentemente si rotan, y la proporción es mayor que las que no viajan(8%) o lo hacen raramente (15%). Por tanto la hipótesis se cumple.

g1

Hipótesis: Las personas con estado civil Soltero tienen mayor posibilidad de rotar que las personas casadas ya que lo ultimo involucra una mayor responsabilidad. El 26% de las personas con estado civil soltero si rotan, y la proporción es mayor que las casadas (12%) y las divorciadas (10%). Por tanto la hipótesis se cumple.

g2

Hipótesis: Las personas que trabajan horas extra tienen mayor posibilidad de rotar que las que no trabajan extra, ya que no tienen suficiente tiempo libre. El 54% de las personas que hacen horas extra si rotan, esta proporción es mayor a las personas que rotan y no hacen horas extra (23%). Por tanto la hipótesis se cumple.

g3

Entre menor porcentaje de aumento salarial, mayor posibilidad de rotar, las personas quieren crecimiento económico.

Variables Numericas

g4=ggplot(datos,aes(x=y, y=Distancia_Casa, fill=Rotación))+geom_boxplot(outlier.colour = "red", outlier.shape = 1)+theme_bw()+geom_jitter(width = 0.1) 
g5=ggplot(datos,aes(x=y, y=Ingreso_Mensual, fill=Rotación))+geom_boxplot(outlier.colour = "red", outlier.shape = 1)+theme_bw()+geom_jitter(width = 0.1) 
g6=ggplot(datos,aes(x=y, y=Porcentaje_aumento_salarial, fill=Rotación))+geom_boxplot(outlier.colour = "red", outlier.shape = 1)+theme_bw()+geom_jitter(width = 0.1) 

Hipótesis: Las personas que viven mas distantes de casa tienen mayor posibilidad de rotar debido al estrés que genera el trafico. Las personas que si rotan tienen una mediana de distancia (9km) mayor a la mediana de las personas que no rotan (7km). Por tanto la hipótesis se cumple.

ggplotly(g4)

Hipótesis: Entre menor ingreso mensual, mayor posibilidad de rotar, ya que las personas quieren aumentar sus ingresos. Las personas que si rotan tienen una mediana de ingreso de 3202, menor a la mediana de las personas que no rotan equivalente a $5204. Por tanto la hipótesis se cumple.

ggplotly(g5)

Hipótesis Entre menor porcentaje de aumento salarial, mayor posibilidad de rotar, las personas quieren crecimiento económico. La mediana entre del porcentaje de aumento entre las personas que rotan y las que no lo haces es igual: 14%, ademas, el rango intercuartil es muy similar. Por tanto, no se puede asegurar que la hipótesis se cumple.

ggplotly(g6)

Punto 1.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 covariables las 6 seleccionadas. Interprete los coeficientes del modelo y la significancia de los parámetros.

mod_logi = glm(data = datos, formula = 
                 y ~ Viaje_de_Negocios+
                 Estado_Civil+
                 Horas_Extra+
                 Distancia_Casa+
                 Ingreso_Mensual+
                 Porcentaje_aumento_salarial,
               family = "binomial") 
mod_logi

## 
## Call:  glm(formula = y ~ Viaje_de_Negocios + Estado_Civil + Horas_Extra + 
##     Distancia_Casa + Ingreso_Mensual + Porcentaje_aumento_salarial, 
##     family = "binomial", data = datos)
## 
## Coefficients:
##                 (Intercept)    Viaje_de_NegociosNo_Viaja  
##                  -1.3386232                   -1.3049766  
##  Viaje_de_NegociosRaramente       Estado_CivilDivorciado  
##                  -0.6033788                   -0.2726669  
##         Estado_CivilSoltero                Horas_ExtraSi  
##                   0.9115714                    1.4460795  
##              Distancia_Casa              Ingreso_Mensual  
##                   0.0320273                   -0.0001335  
## Porcentaje_aumento_salarial  
##                  -0.0132273  
## 
## Degrees of Freedom: 1469 Total (i.e. Null);  1461 Residual
## Null Deviance:       1299 
## Residual Deviance: 1095  AIC: 1113

summary(mod_logi)

## 
## Call:
## glm(formula = y ~ Viaje_de_Negocios + Estado_Civil + Horas_Extra + 
##     Distancia_Casa + Ingreso_Mensual + Porcentaje_aumento_salarial, 
##     family = "binomial", data = datos)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.4747  -0.5981  -0.4068  -0.2390   3.0773  
## 
## Coefficients:
##                               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                 -1.339e+00  4.020e-01  -3.330 0.000869 ***
## Viaje_de_NegociosNo_Viaja   -1.305e+00  3.501e-01  -3.728 0.000193 ***
## Viaje_de_NegociosRaramente  -6.034e-01  1.791e-01  -3.370 0.000753 ***
## Estado_CivilDivorciado      -2.727e-01  2.293e-01  -1.189 0.234361    
## Estado_CivilSoltero          9.116e-01  1.702e-01   5.356 8.50e-08 ***
## Horas_ExtraSi                1.446e+00  1.569e-01   9.219  < 2e-16 ***
## Distancia_Casa               3.203e-02  9.198e-03   3.482 0.000498 ***
## Ingreso_Mensual             -1.335e-04  2.309e-05  -5.782 7.37e-09 ***
## Porcentaje_aumento_salarial -1.323e-02  2.121e-02  -0.624 0.532887    
## ---
## 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: 1095.4  on 1461  degrees of freedom
## AIC: 1113.4
## 
## Number of Fisher Scoring iterations: 5

Análisis: Todas las variables son significantivas a excepción de la variable Porcentaje de aumento salarial y el estado civil de divorciado.

Punto 1.5.

Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.

predict1= predict.glm(mod_logi, newdata = datos, type = "response")
result1 = table(datos$y, ifelse(predict1 >0.2, 1, 0))
result1

##    
##       0   1
##   0 971 262
##   1  86 151

sum(diag(result1)/sum(result1))

## [1] 0.7632653

library(ROCR)

## Warning: package 'ROCR' was built under R version 4.1.3

prediccion_rotacion= ROCR::prediction(predict1,datos$y)
perf= performance(prediction.obj = prediccion_rotacion, "tpr", "fpr")
plot(perf)
abline(a=0, b=1, col="red")
grid()

AUClog1= performance(prediccion_rotacion, measure = "auc")@y.values[[1]]
cat("AUC: ", AUClog1, "n")

## AUC:  0.7666492 n

Análisis: El Área bajo la curva de 0.77 indica que el modelo es aceptable y puede servir para predecir.

Punto 1.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).

newdata1 <- data.frame(Distancia_Casa= 25, Ingreso_Mensual=1500, Porcentaje_aumento_salarial=11,
                   Horas_Extra =  "Si", Estado_Civil = "Soltero" , Viaje_de_Negocios = "Frecuentemente" )
newdata1$rankP <- predict(mod_logi, newdata = newdata1, type = "response")
newdata1

Distancia_Casa	Ingreso_Mensual	Porcentaje_aumento_salarial	Horas_Extra	Estado_Civil	Viaje_de_Negocios	rankP
25	1500	11	Si	Soltero	Frecuentemente	0.8136529

Análisis: Se define un corte de 60% para decidir si se debe intervenir a este empleado. Por tanto para un empleado que tenga las siguientes condiciones:

• Distancia_Casa= 25,
• Ingreso_Mensual=1500,
• Porcentaje_aumento_salarial=11,
• Horas_Extra = “Si”,
• Estado_Civil = “Soltero” ,
• Viaje_de_Negocios = “Frecuentemente”

El modelo arroja una probabilidad de 81% de que el empleado con las condiciones anteriores rote.

Como estrategia para que el empleado disminuya su probabilidad de rotar, se puede tratar de ofrecer opciones de vivienda mas cercanas o brindar la opción de trabajo remoto, aumentar el rango salarial y distribuir la carga laborar para evitar horas extra.

Punto 1.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)..

Recomendaciones:

• Disminuir la frecuencia de viajes de negocio para minimizar el cansancio percibido.
• Actividades que permitan integrar a los empleados; esto puede mejorar el estado de animo de las personas y tal vez generar futuras relaciones y así reducir la cantidad de personas con estado civil: soltero.
• Reducir la cantidad de horas extra o dividirlas entre más personas para que los trabajadores puedan tener mayor tiempo libre.
• Incentivar el trabajo remoto, para evitar estrés por desplazamiento desde la casa al trabajo.
• Aumentar el ingreso mensual para evitar que los trabajadores busquen nuevas oportunidades mejor remuneradas.

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.

library(readxl)
datos_credito <- read_excel("D:/ESTUDIO/MASTER IN DATA SCIENCE/Semester 2/Metodos estadisticos para la toma de decisiones/MOD3/Datos_Creditos.xlsx")
datos_credito$DEFAULT = as.factor(datos_credito$DEFAULT)

glimpse(datos_credito)

## Rows: 780
## Columns: 5
## $ DEFAULT     <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1~
## $ ANTIUEDAD   <dbl> 37.317808, 37.317808, 30.978082, 9.728767, 8.443836, 6.605~
## $ EDAD        <dbl> 76.98356, 73.77534, 78.93699, 51.52877, 38.96986, 44.87945~
## $ CUOTA_TOTAL <dbl> 3020519, 1766552, 1673786, 668479, 1223559, 3517756, 13047~
## $ INGRESOS    <dbl> 8155593, 6181263, 4328075, 5290910, 5333818, 2710736, 3169~

Análisis de variables

require(ggplot2)
require(ggpubr)
require(ggplot2)
ggplot(datos_credito,aes(DEFAULT, fill=DEFAULT))+
  geom_bar()+
  theme_bw()

g7=ggplot(datos_credito,aes(x=DEFAULT, y=EDAD, fill=DEFAULT))+geom_boxplot(outlier.colour = "red", outlier.shape = 1)+theme_bw()+geom_jitter(width = 0.1) 
g8=ggplot(datos_credito,aes(x=DEFAULT, y=INGRESOS, fill=DEFAULT))+geom_boxplot(outlier.colour = "red", outlier.shape = 1)+theme_bw()+geom_jitter(width = 0.1) 
g9=ggplot(datos_credito,aes(x=DEFAULT, y=ANTIUEDAD, fill=DEFAULT))+geom_boxplot(outlier.colour = "red", outlier.shape = 1)+theme_bw()+geom_jitter(width = 0.1) 
g10=ggplot(datos_credito,aes(x=DEFAULT, y=CUOTA_TOTAL, fill=DEFAULT))+geom_boxplot(outlier.colour = "red", outlier.shape = 1)+theme_bw()+geom_jitter(width = 0.1) 

graf_variables=ggarrange(g7, g8, g9, g10,labels = c("A", "B","C","D"), ncol = 2, nrow = 2)
graf_variables

library(GGally)
library(dplyr)
ggpairs(select_if(datos_credito, is.numeric), lower = list(continuous = "smooth"),
        diag = list(continuous = "barDiag"), axisLabels = "none")

Resultado: Las variables edad y antigüedad tienen un coeficiente de correlación alto (0.75) por lo que puede existir mulicolinealidad entre las variables y verse afectado el modelo.

Modelo de Regresión Logistico Multiple - Considerando Todas las variables

mod1_credito=glm(DEFAULT~EDAD+
                   INGRESOS+
                   ANTIUEDAD+
                   CUOTA_TOTAL,
                 data = datos_credito,family = "binomial")
summary(mod1_credito)

## 
## Call:
## glm(formula = DEFAULT ~ EDAD + INGRESOS + ANTIUEDAD + CUOTA_TOTAL, 
##     family = "binomial", data = datos_credito)
## 
## 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 ***
## EDAD         2.229e-02  1.932e-02   1.154 0.248641    
## INGRESOS    -2.615e-07  1.057e-07  -2.474 0.013348 *  
## ANTIUEDAD   -4.616e-02  2.353e-02  -1.961 0.049849 *  
## 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: 6

Resultado: En el modelo anterior se nota que la variable edad no es significativa, además, como se mostró anteriormente, puede existir problemas de multicolinealidad por la alta correlación entre las variables edad y antigüedad, por lo que utilizando la función step(), el modelo eligirá eliminará las variables que no aporten a la solución

Modelo de Regresión Logistico Multiple - Considerando solo variables relevantes

mod1_credito_mejorado = step(mod1_credito)

## Start:  AIC=297.49
## DEFAULT ~ EDAD + INGRESOS + ANTIUEDAD + CUOTA_TOTAL
## 
##               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 ~ INGRESOS + ANTIUEDAD + CUOTA_TOTAL
## 
##               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.95

summary(mod1_credito_mejorado)

## 
## Call:
## glm(formula = DEFAULT ~ INGRESOS + ANTIUEDAD + CUOTA_TOTAL, family = "binomial", 
##     data = datos_credito)
## 
## 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 ***
## INGRESOS    -2.542e-07  1.059e-07  -2.400   0.0164 *  
## ANTIUEDAD   -2.817e-02  1.803e-02  -1.562   0.1183    
## CUOTA_TOTAL  9.860e-07  2.456e-07   4.014 5.96e-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: 288.78  on 776  degrees of freedom
## AIC: 296.78
## 
## Number of Fisher Scoring iterations: 6

Resultado: En el modejo ajustado, se observa que se elimina la variable EDAD, ademas, se nota que ahora la variable antiguedad tiene poca significancia en el modelo.

Se puede decir tambien que: si la edad es mayor, el riesgo de default seria mas alto. Entre mas alto sean los ingresos hay menos posibilidad de default, lo mismo con la antiguedad, entre mas antiguedad menor posibilidad de default. En cuanto a la cuota, entre esta sea mas alta, hay mayor probabilidad de default.

Validación Cruzada

#ROC

library(ROCR)

prediccion_1credito= predict.glm(mod1_credito_mejorado, newdata = datos_credito, type = "response")
resultado_1credito=table(datos_credito$DEFAULT, ifelse(prediccion_1credito>0.2,1,0))
resultado_1credito

##    
##       0   1
##   0 738   3
##   1  38   1

sum(diag(resultado_1credito)/sum(resultado_1credito))

## [1] 0.9474359

prediccion_default= ROCR::prediction(prediccion_1credito,datos_credito$DEFAULT)
perf_credito= performance(prediction.obj = prediccion_default, "tpr", "fpr")

plot(perf_credito)
abline(a = 0, b = 1,col="red")
grid()

AUC_1credito= performance(prediccion_default,measure = "auc")@y.values[[1]]
cat("AUC: ",AUC_1credito,"n")

## AUC:  0.6922385 n

Análisis: El Área bajo la curva de 0.69 indica que el modelo es regular y no se recomendaría para realizar predicciones.