El presente documento contiene dos ejercicios de simulación de regresiones generalizadas multiples con diferentes tematicas que se presentan a continuación:

Rotación Personal 

rotacion <- read_excel("Datos_Rotación.xlsx")
names(rotacion)
##  [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"

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

hipotisis = read_excel("~/JAVERIANA/Actividad 2/hipotisis.xlsx")
head(hipotisis)
## # A tibble: 6 × 4
##   Numeral Variable                    Tipo         Hipótesis                    
##     <dbl> <chr>                       <chr>        <chr>                        
## 1       1 IngresoMensual              Cuantitativa Se espera que el ingreso mes…
## 2       2 Porcentaje Aumento Salarial Cuantitativa Se espera que el porcentaje …
## 3       3 Edad                        Cuantitativa Se espera que la edad se rel…
## 4       4 Cargo                       Cualitativa  Se espera que los trabajador…
## 5       5 Horas Extras                Cualitativa  Se espera que las horas extr…
## 6       6 Satisfación Laboral         Cualitativa  Se espera que la satisfacció…
  1. 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(rotacion,aes(x=Ingreso_Mensual))+geom_histogram(fill = "blue")+theme_bw()
g2=ggplot(rotacion,aes(x=Porcentaje_aumento_salarial))+geom_histogram(fill = "blue")+theme_bw()
g3=ggplot(rotacion,aes(x=Edad))+geom_histogram(fill = "blue")+theme_bw()
g4=ggplot(rotacion,aes(x=Satisfación_Laboral))+geom_bar(fill = "blue")+theme_bw()
g5=ggplot(rotacion,aes(x=Cargo))+geom_bar(fill = "blue")+theme_bw()+ theme(axis.text.x = element_text(angle = 90, hjust = 1))
g6=ggplot(rotacion,aes(x=Horas_Extra))+geom_bar(fill = "blue")+theme_bw()
ggarrange(g1, g2, g3, g4, g5, g6,labels = c("A", "B","C","D","E","F"),ncol = 2, nrow = 1)
## $`1`

## 
## $`2`

## 
## $`3`

## 
## attr(,"class")
## [1] "list"      "ggarrange"

Interpretación

A: según la grafica se evidencia mayor concentración en salirios menores a 5 millones, identificando que a mayor ingresos menor concentracion de funcionarios B: según la grafica se evidencia mayor concentración en incremento salarial del 15% y de menor representación del 25% , identicando que a mayor porcentaje incremento salarial menor es la concentracion de Funcionarios C:según la grafica se evidencia mayor concentración en las edades de25 hasta 40 años de los funcionarios D:según la grafica se evidencia mayor concentración en nivel de satisfacion 3 y 4 (satisfechos) E:según la grafica se evidencia mayor concentración en lso cargos: ejecutivo de ventas, investigador cientifico y tecnico laboratorio. F:según la grafica se evidencia mayor concentración en los funcionarios que no tranajan horas extras.

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.

A continuación realizamos la codificación de 0 y uno para nuestra varible objetivo rotación.

rotacion$Rotacion <- factor(ifelse(rotacion$Rotación == "Si", 1, 0))
head(rotacion$Rotacion)
## [1] 1 0 1 0 0 0
## Levels: 0 1
graficocargo=PlotXTabs2(rotacion,Cargo, Rotacion,plottype = "percent")+ theme(axis.text.x = element_text(angle = 90, hjust = 1))
graficohoras=PlotXTabs2(rotacion,Horas_Extra, Rotacion,plottype = "percent")
graficosatisfaccion=PlotXTabs2(rotacion,Satisfación_Laboral, Rotacion,plottype = "percent")
graficocargo

Variable Rotación, se evidencia que se presenta mayor rotación en el cargo representantes de ventas y se demuestra que la hipotisis es verdara ” los cargos de menor rango tienen mayor posibilidad de rotar que los cargos de rango medio.

graficohoras

La variable Rotación se evidencia que se demuestra que la hipotisis es verdara “las personas que causan horas extras tienen mayor probabilidad de rotar que las que no”

graficosatisfaccion

Labora y variable rotación se prueba que la hipotisis es verdadera “las personas que se perciben menos satisfechas podrían considerar rotar a otro empleo más satisfactorio”.

graficoingreso=ggplot(rotacion,aes(x=Rotacion,y= Ingreso_Mensual,fill=Rotacion))+geom_boxplot()+theme_bw()
graficoaumento=ggplot(rotacion,aes(x=Rotacion,y= Porcentaje_aumento_salarial,fill=Rotacion))+geom_boxplot()+theme_bw()
graficoedad=ggplot(rotacion,aes(x=Rotacion,y= Edad,fill=Rotacion))+geom_boxplot()+theme_bw()
ggplotly(graficoingreso)

se evidencia que la variable ingresos y variable rotación se evidencia que demuestra la hipotisis menor salario, mayor rotación

ggplotly(graficoaumento)

de acuerdo con la variable porcentaje de aumento salarial y la variable rotación se evidencia que no presenta mucha variabilidad de los que rotan y los que no , por lo tanto no se demuestra la hipostisis

ggplotly(graficoedad)

De acuerdo con la variable edad y rotación se evidencia que la hipotisis es demostrada “los más jóvenes tienen mayor posibilidad de rotar que los más adultos”.

  1. 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.
rotacion$Satisfación_Laboral= factor(rotacion$Satisfación_Laboral)
modelo_rotacion_a=glm(Rotacion~Ingreso_Mensual+Porcentaje_aumento_salarial+Edad+Cargo + Horas_Extra + Satisfación_Laboral,data = rotacion,family = binomial(link="logit"))

summary(modelo_rotacion_a)
## 
## Call:
## glm(formula = Rotacion ~ Ingreso_Mensual + Porcentaje_aumento_salarial + 
##     Edad + Cargo + Horas_Extra + Satisfación_Laboral, family = binomial(link = "logit"), 
##     data = rotacion)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8707  -0.5821  -0.4031  -0.2230   2.9806  
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                  -2.374e+00  1.067e+00  -2.226 0.026044 *  
## Ingreso_Mensual               1.152e-05  4.468e-05   0.258 0.796610    
## Porcentaje_aumento_salarial  -7.388e-03  2.143e-02  -0.345 0.730248    
## Edad                         -3.585e-02  1.036e-02  -3.461 0.000539 ***
## CargoDirector_Manofactura     1.006e+00  8.760e-01   1.148 0.251017    
## CargoEjecutivo_Ventas         2.083e+00  8.291e-01   2.513 0.011982 *  
## CargoGerente                  8.379e-01  8.643e-01   0.969 0.332318    
## CargoInvestigador_Cientifico  1.818e+00  9.135e-01   1.990 0.046636 *  
## CargoRecursos_Humanos         2.490e+00  9.425e-01   2.642 0.008248 ** 
## CargoRepresentante_Salud      1.030e+00  8.800e-01   1.171 0.241731    
## CargoRepresentante_Ventas     3.193e+00  9.431e-01   3.385 0.000711 ***
## CargoTecnico_Laboratorio      2.531e+00  9.110e-01   2.778 0.005464 ** 
## Horas_ExtraSi                 1.547e+00  1.603e-01   9.651  < 2e-16 ***
## Satisfación_Laboral2         -4.722e-01  2.351e-01  -2.009 0.044576 *  
## Satisfación_Laboral3         -4.534e-01  2.078e-01  -2.182 0.029139 *  
## Satisfación_Laboral4         -1.037e+00  2.210e-01  -4.693 2.69e-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: 1084.3  on 1454  degrees of freedom
## AIC: 1116.3
## 
## Number of Fisher Scoring iterations: 6

Las covariables edad,cargo, horas extras y satisfacción laboral son significativas para el modelo y logran brindar una explicación de la variable respuesta rotación. Mientras que la variable ingreso y porcentaje ingreso no brindan valor dentro del modelo.

exp(modelo_rotacion_a$coefficients)
##                  (Intercept)              Ingreso_Mensual 
##                   0.09313715                   1.00001152 
##  Porcentaje_aumento_salarial                         Edad 
##                   0.99263890                   0.96478169 
##    CargoDirector_Manofactura        CargoEjecutivo_Ventas 
##                   2.73347560                   8.03040029 
##                 CargoGerente CargoInvestigador_Cientifico 
##                   2.31157712                   6.15675524 
##        CargoRecursos_Humanos     CargoRepresentante_Salud 
##                  12.05944050                   2.80157161 
##    CargoRepresentante_Ventas     CargoTecnico_Laboratorio 
##                  24.35150819                  12.56595015 
##                Horas_ExtraSi         Satisfación_Laboral2 
##                   4.69598980                   0.62364502 
##         Satisfación_Laboral3         Satisfación_Laboral4 
##                   0.63545432                   0.35446770

Cada año adicional que posea el empleado podría aumentar la posibilidad de generar una rotación de personal, por otro lado los cargos de ventas, laboratorio y recursos humanos son los cargos que tienen mayor posibilidad de generar rotación. Finalmente un valor representativo se encuentra en las horas extras, auqellos que han incurrido al uso de horas extras tienen una mayor posibilidad de aumentar su rotación en 4.6, finalmente un empleado que ha reportado una satisfacción laboral de 4 tiene una posibilidad menor de rotar frente a satisfación laboral de 3 y de 2.

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

Definición de modelo con unicamente variables significativas

modelo_rotacion_b=glm(Rotacion~Edad+Cargo + Horas_Extra + Satisfación_Laboral,data = rotacion,family = binomial(link="logit"))

summary(modelo_rotacion_b)
## 
## Call:
## glm(formula = Rotacion ~ Edad + Cargo + Horas_Extra + Satisfación_Laboral, 
##     family = binomial(link = "logit"), data = rotacion)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8537  -0.5853  -0.4020  -0.2223   2.9949  
## 
## Coefficients:
##                               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                  -2.332772   0.847226  -2.753 0.005898 ** 
## Edad                         -0.035179   0.009791  -3.593 0.000327 ***
## CargoDirector_Manofactura     0.905516   0.800355   1.131 0.257889    
## CargoEjecutivo_Ventas         1.986417   0.743553   2.672 0.007551 ** 
## CargoGerente                  0.849375   0.863132   0.984 0.325085    
## CargoInvestigador_Cientifico  1.676596   0.749750   2.236 0.025338 *  
## CargoRecursos_Humanos         2.363980   0.809641   2.920 0.003503 ** 
## CargoRepresentante_Salud      0.937746   0.808051   1.161 0.245844    
## CargoRepresentante_Ventas     3.044192   0.774669   3.930 8.51e-05 ***
## CargoTecnico_Laboratorio      2.393495   0.747237   3.203 0.001359 ** 
## Horas_ExtraSi                 1.547689   0.160204   9.661  < 2e-16 ***
## Satisfación_Laboral2         -0.471774   0.234939  -2.008 0.044636 *  
## Satisfación_Laboral3         -0.450806   0.207351  -2.174 0.029696 *  
## Satisfación_Laboral4         -1.038113   0.220908  -4.699 2.61e-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: 1084.5  on 1456  degrees of freedom
## AIC: 1112.5
## 
## Number of Fisher Scoring iterations: 6
prediccion=predict(modelo_rotacion_b,list(Edad =rotacion$Edad,Cargo=rotacion$Cargo, Horas_Extra=rotacion$Horas_Extra, Satisfación_Laboral= rotacion$Satisfación_Laboral),type = "response")
ROC_rotacion=roc(rotacion$Rotacion~prediccion, percent = T, ci=T)
ROC_rotacion
## 
## Call:
## roc.formula(formula = rotacion$Rotacion ~ prediccion, percent = T,     ci = T)
## 
## Data: prediccion in 1233 controls (rotacion$Rotacion 0) < 237 cases (rotacion$Rotacion 1).
## Area under the curve: 78.01%
## 95% CI: 74.62%-81.4% (DeLong)
plot(ROC_rotacion,print.auc=T,print.thres = "best",col="red"
         ,xlab = "Specificity", ylab = "Sensitivity")

La curva ROC para el modelo indica que este modelo tiene un buen poder discriminatorio, puesto que el trazo es cercano a la línea horizontal, de hecho el área bajo la curva (AUROC) es 0,78.

  1. Predeccir la probabilida 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).

Se plantea la predición de un funcionario con las siguientes caracteristicas:

27 años, Ejecutivo_Ventas, con horas extras y con satisfación laboral 2

predict(modelo_rotacion_b, list(Edad= 27, Cargo = "Ejecutivo_Ventas", Horas_Extra= "Si", Satisfación_Laboral="2"),type = "response")
##         1 
## 0.4451544

Un Funcionario con las especificaciones anteriores, es probable que no rote en un 44%, según el modelo.

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

Conclusiones

Se recomienda que la empresa implemente incentivos para estudiar y acensos para que los Funcionarios Jovenes continuen en la empresa y genere estabilidad en la empresa.

Se recomienda que se generen incentivos salariales en el reconocimiento de siertas actividades que geren valor y se refleje en los ingresos mensuales.

Se recomienda realizar las validaciones relacionadas con las metas de los trabajadores del área de ventas.

Se recomienda implementar mecanismos que permitan a los empleados mejorar su calidad de vida,incentivos, eventos, espacios de entretenimiento, entre otros, para mejorar el nivel de satisfación laboral.

Se recomienda mejora la politica de pago de horas extras, para que no se incremente la rotación en los Funcionarios que cumplen con este criterio.

Riesgo Crédito

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.

datos <- read_excel("Datos_Creditos.xlsx")
head(datos)
## # 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  2710736

Estructura y conocimiento de los datos

Cabezales de los datos

names(datos)
## [1] "DEFAULT"     "ANTIUEDAD"   "EDAD"        "CUOTA_TOTAL" "INGRESOS"

Resumen de los datos

summary(datos)
##     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.   :22197021

Analisis Descriptivo de las variables

DEFAULT: variable dada por 0 o 1 ANTIGUEDAD: Tiempo en años de afiliado al fondo, como minimo valor 0.25 años y un maximo de 37 años EDAD: Edad en años cumplidos del asociado. con una edad minima de 26 y maxima de 92 años CUOTA TOTAL: Saldo de la deuda por credito de consumo. con una cuota minima de 387 pesos y maxima de 6 millones INGRESOS:Ingresos mensuales del asociado. con ingreos minimos mensuales de 633.825 y maximos de 22 millones

Agregacion de nuevas variables calculadas

datos$COMPROMISO=round(datos$CUOTA_TOTAL/datos$INGRESOS*100,1)
summary(datos$COMPROMISO)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00    7.60   15.55   17.45   25.30  129.80

Se agrega la nueva variable Compromiso para el analisis del modelo, con un minimos de 0 y un maximo de 129

Analisis Descriptivo

Con lo que se busca identificar las variables mas significativas

La Variables Default indica si la persona en algun momento presento una altura de mora considerada grave (mas de 2 meses sin pagar la obligacion). Esta variables es binaria (1=Default y 0=No Default).

Análisis univariado

graf_1= ggplot (datos, aes (x=DEFAULT)) +geom_bar () +theme_bw ()
ggarrange(graf_1, labels = c ("A"),ncol = 1, nrow = 1)

rangea <- ggplot(datos, mapping=aes(), main="Distribuciones") + geom_boxplot(aes(y=ANTIUEDAD), fill='#67B7D1') + 
  labs(title ="ANTIUEDAD", x="", y="ANIOS")

rangeb <- ggplot(datos, mapping=aes(), main="Distribuciones") + geom_boxplot(aes(y=EDAD), fill='#67B7A1') + 
  labs(title ="EDAD", x="", y="ANIOS")

rangec <- ggplot(datos, mapping=aes(), main="Distribuciones") + geom_boxplot(aes(y=CUOTA_TOTAL), fill='#67B7A1') + 
  labs(title ="CUOTA_TOTAL", x="", y="CUOTA")

ranged <- ggplot(datos, mapping=aes(), main="Distribuciones") + geom_boxplot(aes(y=INGRESOS), fill='#67B7A1') + 
  labs(title ="INGRESOS", x="", y="DINERO")


ggplotly(rangea)
ggplotly(rangeb)
ggplotly(rangec)
ggplotly(ranged)

Antes de iniciar el analisis bivariado se realiza una matriz de correlacion para descartar variables duplicadas y de esta manera evitar la multicolinealidad, lo cual nos permita identificar las relaciones de los datos

correlacion<-round(cor(datos), 1)
correlacion
##             DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL INGRESOS COMPROMISO
## DEFAULT         1.0      -0.1  0.0         0.1     -0.1        0.2
## ANTIUEDAD      -0.1       1.0  0.8         0.3      0.5        0.0
## EDAD            0.0       0.8  1.0         0.2      0.4        0.0
## CUOTA_TOTAL     0.1       0.3  0.2         1.0      0.4        0.8
## INGRESOS       -0.1       0.5  0.4         0.4      1.0       -0.2
## COMPROMISO      0.2       0.0  0.0         0.8     -0.2        1.0
corrplot(correlacion, method="number", type="upper")

cov(datos$DEFAULT, datos$ANTIUEDAD )
## [1] -0.1754154
cor(datos$DEFAULT, datos$ANTIUEDAD )
## [1] -0.06736953

Analisis Bivariado

Distribuciones

ggpairs(datos, lower = list(continuous = "smooth"),
        diag = list(continuous = "barDiag"), axisLabels = "none")

Analisis Bivariado

Histogramas

datos$DEFAULT_N = factor(datos$DEFAULT)

histo_tipo <- ggplot(data=datos, aes(x=ANTIUEDAD, fill=DEFAULT_N)) +
    geom_histogram(binwidth=3, position="dodge") + labs(title ="Frecuencia", x="Concentración",  y="Conteo")


histo_tipo1 <- ggplot(data=datos, aes(x=EDAD, fill=DEFAULT_N)) +
    geom_histogram(binwidth=3, position="dodge") + labs(title ="Frecuencia", x="Concentración",  y="Conteo")


ggplotly(histo_tipo)
ggplotly(histo_tipo1)

Analisis Bivariado

Variable respuesta vs predictoras

tapply(datos$COMPROMISO, datos$DEFAULT_N, mean)
##        0        1 
## 16.96154 26.65641
tapply(datos$INGRESOS, datos$DEFAULT_N, mean)
##       0       1 
## 5404108 4650560
tapply(datos$EDAD, datos$DEFAULT_N, mean)
##        0        1 
## 57.08114 55.15869
tapply(datos$ANTIUEDAD, datos$DEFAULT_N, mean)
##        0        1 
## 18.21966 14.53144
tapply(datos$CUOTA_TOTAL, datos$DEFAULT_N, mean)
##         0         1 
##  868818.3 1196569.9

Concluciones Bivariado:

Se observa que del total de personas 39 tiene la condicion de Default es decir el 5% de las personas asociadas al fondo incumplen con el pago a tiempo.

Se observa que en el grupo de los Default el promedio del compromiso es del 26% mientras que en los no Default es de el 16%. Es decir se observa un mayor compromiso de sus ingresos

Se observa qque el grupo de los que estan en Default tienen un ingreso promedio de 4,6 MM frente a 5,4MM de los que no caen en Deault, es decir una diferencia de 800 mil pesos (17% aprox del ingreso promedio de los Default).

Tambien se evidencia que existe una alta correlacion entre las variables, EDAD y ANTIUEDAD, CUOTA_TOTAL y COMPROMISO, por lo cual se quitaron dos de las 4 variables mencionadas para tener un mejor modelo.

Modelamiento

Modelo logistico

modelo=glm(DEFAULT~INGRESOS+ANTIUEDAD+COMPROMISO,data = datos,family = binomial(link="logit"))

summary(modelo)
## 
## Call:
## glm(formula = DEFAULT ~ INGRESOS + ANTIUEDAD + COMPROMISO, family = binomial(link = "logit"), 
##     data = datos)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.2240  -0.3577  -0.2795  -0.2200   2.9254  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -3.270e+00  5.027e-01  -6.505 7.76e-11 ***
## INGRESOS    -2.345e-08  8.546e-08  -0.274 0.783784    
## ANTIUEDAD   -2.831e-02  1.790e-02  -1.581 0.113777    
## COMPROMISO   4.350e-02  1.154e-02   3.770 0.000163 ***
## ---
## 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: 289.13  on 776  degrees of freedom
## AIC: 297.13
## 
## Number of Fisher Scoring iterations: 6

El presente modelo presenta solo 1 variable significativa que acuerdo al estadistico Z, la cual es compromiso, mientras que las otras variables no explican o se ajustan al modelo.

OR=exp(modelo$coefficients)
OR
## (Intercept)    INGRESOS   ANTIUEDAD  COMPROMISO 
##  0.03800439  0.99999998  0.97209016  1.04445701

Cualquier aumento en una unidad de la variable compromiso aumenta la posibilidad en 1.04 de generar riesgo de crédito.

ROC y AUC

A continuación se presenta la división del dataset para revisar el área bajo la curva y la metrica ROC.

## division 
set.seed(50)

n<- nrow(datos)
indin<- 1:n
nent<-ceiling(0.7*n)
ntest<- n-nent
indient<- sort(sample(indin,nent))
inditest<- setdiff(indin,indient)

part <- datos[indient,]
modelo_GLM  <- glm(DEFAULT~INGRESOS+ANTIUEDAD+COMPROMISO,part,
                   family=binomial, maxit=10000)
prediccion= predict(modelo_GLM,list(INGRESOS =part$INGRESOS,
                             ANTIUEDAD=part$ANTIUEDAD,
                             COMPROMISO=part$COMPROMISO),type = "response")
ypred<- ifelse(prediccion>0.2,1,0)
yobser=part$DEFAULT
matriz=table(yobser,ypred)
matriz
##       ypred
## yobser   0   1
##      0 518   2
##      1  26   0
sum(diag(matriz)/sum(matriz))
## [1] 0.9487179
ROC_res=roc(part$DEFAULT~prediccion, percent = T, ci=T)
ROC_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: 67.34%
## 95% CI: 57.14%-77.55% (DeLong)

La curva ROC para el modelo indica que este modelo tiene un buen poder discriminatorio, puesto que el trazo es cercano a la línea horizontal, de hecho el área bajo la curva (AUROC) es 0,65.3.

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

La curva ROC para el modelo indica que este modelo tiene un buen poder discriminatorio, puesto que el trazo es cercano a la línea horizontal, de hecho el área bajo la curva (AUROC) es 0,673