taller_modelo_generalizado
Santiago Garcia Cifuentes
30/9/2022
https://rpubs.com/sgcifuentes/950129
library(readxl)
datos_rotacion = read_excel("C:/Users/User/Downloads/Datos_Rotacion.xlsx")
attach(datos_rotacion)- 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).
Las Variables seleccionadas son:Edad, trabajos_anteriores, Ingreso_Mensual, Genero, Cargo, Estado_Civil
Se espera que la edad se relacione con la rotación ya que a menor edad (menor a 30) hay menos responsabilidades y menor miedo al cambio. La hipotesis es que las personas de menor edad rotan más que las de mayor edad.
Se espera que los trabajos anteriores se relacione con la rotación ya que cuando una persona tiene menos trabajos tiende a rotar. La hipotesis es que las personas con menor cantidad de trabajos tienden a rotar más.
Se espera que el ingreso mensual se relacione con la rotación ya que las personas con menor ingresos tienen a rotar más. La hipotesis es que las personas con menor ingreso rotan más que las de altos ingresos.
Se espera que el Genero se relacione con la rotación ya que los hombres tienden a rotar más. La hipotesis es que los hombres rotan más que las mujeres.
Se espera que el cargo se relacione con la rotación ya que las personas con cargos comercial rotan con frecuencia. La hipotesis es que las personas con comerciales rotan mas que las de cargos operativos.
Se espera que el estado civil se relacione con la rotación ya que las personas solteras tienden a rotar más: La hipotesis es que los solteros rotan más que los otros estados civiles.
datos_6_variables = datos_rotacion[,c(1,2,14,13,9,10,12)]
table(datos_6_variables$Rotación)##
## No Si
## 1233 237- 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.
##Tabla de Indicadores Importantes variables cuantitativas
Edad_promedio=mean(datos_6_variables$Edad,na.rm = TRUE)
Edad_mediana=median(datos_6_variables$Edad,na.rm = TRUE)
Edad_promedio## [1] 36.92381Edad_mediana## [1] 36resultado_Edad=data.frame(Edad_promedio,Edad_mediana)
resultado_Edad## Edad_promedio Edad_mediana
## 1 36.92381 36require(ggplot2)
require(ggpubr)
require(plotly)
g1=ggplot(datos_6_variables,aes(x=Genero))+geom_bar()+theme_bw()
g2=ggplot(datos_6_variables,aes(x=Cargo))+geom_bar()+theme_bw()
g3=ggplot(datos_6_variables,aes(x=Estado_Civil))+geom_bar()+theme_bw()
ggarrange(g1, g3,labels = c("A", "B"),ncol = 2, nrow = 1)
De acuerdo al análisis univariado categórico que se representa en los gráficos A, B, y C, las caracteristicas de rotación de la compañía son: Hombres, casados en el cargo de Ejecutivo de ventas; es decir, continúa siendo el equipo comercial el que más rotación tiene en la compañía.
g4=ggplot(datos_6_variables,aes(x=Ingreso_Mensual))+geom_histogram()+theme_bw()
g5=ggplot(datos_6_variables,aes(x=Trabajos_Anteriores))+geom_histogram()+theme_bw()
g6=ggplot(datos_6_variables,aes(x=Edad))+geom_histogram()+theme_bw()
ggarrange(g4, g5, g6, labels = c("A", "B", "C"),ncol = 2, nrow = 3)
Validando este análisis se puede concluir que las personas que más tienen rotación en la compañía son: Los que tienen un ingreso mensual inferior a 2 Millones, han tenido menos de 2 trabajos y son menores de 40 años.
- 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.
Se realiza un análisis bivariado de varias maneras, de acuerdo a la variable:
require(CGPfunctions)
require(ggplot2)
require(ggpubr)
require(plotly)
g7=ggplot(datos_6_variables,aes(x=Rotación,y=Edad,fill=Rotación))+geom_boxplot()+theme_bw()
ggplotly(g7)b1 = table(datos_6_variables$Rotación, datos_6_variables$Trabajos_Anteriores)
mosaicplot(b1,
col=c('#faf0ca', '#0d3b66'),
las = 1)
b2 = table(datos_6_variables$Rotación, datos_6_variables$Genero)
mosaicplot(b2,
col=c('#faf0ca', '#0d3b66'),
las = 1)
b3 = table(datos_6_variables$Rotación, datos_6_variables$Cargo)
mosaicplot(b3,
col=c('#faf0ca', '#0d3b66'),
las = 1)
require(CGPfunctions)
require(ggplot2)
require(ggpubr)
require(plotly)
g8=PlotXTabs2(datos_6_variables, Rotación,Estado_Civil,plottype = "percent")
ggarrange(g8, labels = c("D", "E"),ncol = 2, nrow = 1)
La hipotesis consideraba que las personas que más rotan son los inferiores a 30 años, pero los datos reflejan que la mayoría de las personas que tienen mayor rotación son menores a 32 años.
Los datos respaldan la hipotesis que las personas con menor cantidad de trabajos rotan más y efectivamente son las personas con 1 trabajo las que rotan más.
La hipotesis consideraba que los hombres rotan más que las mujeres y efectivamente si.
Las personas con cargos comerciales rotán más.
El estado civil que más rota es el soltero.
- 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.
datos_6_variables$Rota=0
datos_6_variables$Rota[datos_6_variables$Rotación=="Si"]=1
datos_6_variables$Genero=as.factor(datos_6_variables$Genero)
datos_6_variables$Cargo=as.factor(datos_6_variables$Cargo)
datos_6_variables$Estado_Civil=as.factor(datos_6_variables$Estado_Civil)
modelo_1_logit = glm(datos_6_variables$Rota ~ Edad +
Trabajos_Anteriores +
Ingreso_Mensual+
Genero +
Cargo +
Estado_Civil,
data = datos_6_variables,
family = "binomial")
summary(modelo_1_logit)##
## Call:
## glm(formula = datos_6_variables$Rota ~ Edad + Trabajos_Anteriores +
## Ingreso_Mensual + Genero + Cargo + Estado_Civil, family = "binomial",
## data = datos_6_variables)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3728 -0.6310 -0.4578 -0.2641 2.9029
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.219e+00 1.020e+00 -3.157 0.001594 **
## Edad -3.635e-02 1.033e-02 -3.519 0.000432 ***
## Trabajos_Anteriores 1.250e-01 3.019e-02 4.139 3.49e-05 ***
## Ingreso_Mensual 1.971e-05 4.414e-05 0.447 0.655130
## GeneroM 1.742e-01 1.565e-01 1.113 0.265776
## CargoDirector_Manofactura 1.116e+00 8.733e-01 1.278 0.201318
## CargoEjecutivo_Ventas 2.115e+00 8.292e-01 2.551 0.010739 *
## CargoGerente 8.796e-01 8.575e-01 1.026 0.304998
## CargoInvestigador_Cientifico 1.980e+00 9.142e-01 2.166 0.030347 *
## CargoRecursos_Humanos 2.592e+00 9.350e-01 2.772 0.005573 **
## CargoRepresentante_Salud 1.130e+00 8.785e-01 1.286 0.198340
## CargoRepresentante_Ventas 3.191e+00 9.431e-01 3.384 0.000715 ***
## CargoTecnico_Laboratorio 2.504e+00 9.118e-01 2.746 0.006024 **
## Estado_CivilDivorciado -2.350e-01 2.241e-01 -1.049 0.294171
## Estado_CivilSoltero 7.905e-01 1.656e-01 4.773 1.82e-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: 1149.7 on 1455 degrees of freedom
## AIC: 1179.7
##
## Number of Fisher Scoring iterations: 6Se identifica que las variables significativas para el modelo son: Edad, Trabajos_Anteriores, CargoRepresentante_Ventas y Estado_CivilSoltero
Para interpretar los coeficientes se debe sacar el ratio de ODDS
exp(modelo_1_logit$coefficients)## (Intercept) Edad
## 0.04001208 0.96430720
## Trabajos_Anteriores Ingreso_Mensual
## 1.13310032 1.00001971
## GeneroM CargoDirector_Manofactura
## 1.19023499 3.05225523
## CargoEjecutivo_Ventas CargoGerente
## 8.29335167 2.41001354
## CargoInvestigador_Cientifico CargoRecursos_Humanos
## 7.24144131 13.35394713
## CargoRepresentante_Salud CargoRepresentante_Ventas
## 3.09582510 24.32012967
## CargoTecnico_Laboratorio Estado_CivilDivorciado
## 12.23327815 0.79053902
## Estado_CivilSoltero
## 2.20441292Esta razón de probabilidad lo que nos indica es lo siguiente:
Por cada unidad que aumenta la variable Edad, el odds de que se presente el evento de rotación aumenta 0.96 veces, es decir, que una persona menor de 30 años es 0.9 veces mas probable de rotar.
Por cada unidad que aumenta la variable Trabajos_Anteriores, el odds de que se presente el evento de rotación aumenta 1.13 veces, es decir, que una persona con trabajos anteriores tiene 1.13 veces mas de probabilidad de rotar.
Por cada unidad que aumenta la variable CargoRepresentante_Ventas, el odds de que se presente el evento de rotación aumenta 24.32 veces, es decir, que una persona en el cargo de comercial, es 24 veces más probable de que rote.
Por cada unidad que aumenta la variable Estado_CivilSoltero, el odds de que se presente el evento de rotación aumenta 2.20 veces, es decir, que una persona soltera es 2,2 veces mas probable que rote
- Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
pred1 = predict.glm(modelo_1_logit,newdata = datos_6_variables, type="response")
boxplot(pred1)
ypred = ifelse(pred1 >0.4,1,0)
yobser = datos_6_variables$Rota
matrizc = table (yobser,ypred)
matrizc## ypred
## yobser 0 1
## 0 1200 33
## 1 197 40sum(diag(matrizc))/sum(matrizc)## [1] 0.8435374library(ROCR)
pred = ROCR::prediction(pred1,datos_6_variables$Rota)
perf = performance(pred,"tpr","fpr")
plot(perf)
abline(a=0,b=1,col="red")
grid()
#AUC: Area bajo la curva
AUClog1=performance(pred, measure = "auc")@y.values[[1]]
cat("AUC:", AUClog1,"n")## AUC: 0.7376403 nEl poder predictivo del modelo es del 82% con un intercepto en 0,3 Se observa que la curva tiene un área importante acercando el resultado al punto optimo que es x= 0, y=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).
Prueba_1 = data.frame(datos_6_variables$Rota,
Edad=25,
Trabajos_Anteriores=2,
Ingreso_Mensual=2000000,
Genero="M",
Cargo="Representante_Ventas",
Estado_Civil= "Soltero")
pred2 = predict.glm(modelo_1_logit,newdata = Prueba_1, type="response")
boxplot(pred2)
ypred = ifelse(pred2 >0.2,1,0)
yobser = Prueba_1$datos_6_variables.Rota
matrizc2 = table (yobser,ypred)
matrizc2## ypred
## yobser 1
## 0 1233
## 1 237sum(diag(matrizc))/sum(matrizc)## [1] 0.8435374Para esta data puntual de caracteristicas de una persona, hay 1233 observaciones clasificadas como 0 es decir que eran falsos positivos, el modelo está mostrando como 1 y habian 237 como 1 y el modelo los predice como 1, es decir, la empresa no debe intervenir a ningun empleado con estas caracteristicas aún.
- 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).
Las variables que resultaron significativas son: Edad, trabajos anteriores, Representante de Ventas y Soltero.
Como estratégia la empresa debería implementar una política que para los cargos comerciales sólo se puede contratar personas mayores a 30 años, que hayan tenido 2 trabajos o más y que esté casado.
Segundo Punto
Con base en los datos de créditos proponga un modelo de regresión logístico múltiple que permita predecir el riesgo de default en función de las covariables que considere importantes y seleccionándolas de acuerdo con un proceso adecuado. Tenga en cuenta realizar una evaluación de la significancia de los parámetros, interpretación y proponga un método de evaluación por medio de validación cruzada. Presente métricas apropiadas como el AUC y la curva ROC.
library(readxl)
datos_creditos = read_excel("C:/Users/User/Downloads/Datos_Creditos.xlsx")
modelo_2_logit = glm(datos_creditos$DEFAULT ~ ANTIUEDAD +
EDAD +
CUOTA_TOTAL+
INGRESOS,
data = datos_creditos,
family = "binomial")
summary(modelo_2_logit)##
## Call:
## glm(formula = datos_creditos$DEFAULT ~ ANTIUEDAD + EDAD + CUOTA_TOTAL +
## INGRESOS, family = "binomial", data = datos_creditos)
##
## 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 ***
## ANTIUEDAD -4.616e-02 2.353e-02 -1.961 0.049849 *
## EDAD 2.229e-02 1.932e-02 1.154 0.248641
## CUOTA_TOTAL 1.013e-06 2.473e-07 4.098 4.16e-05 ***
## INGRESOS -2.615e-07 1.057e-07 -2.474 0.013348 *
## ---
## 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: 6Se identifica que las variables significativas para el modelo es la CUOTA_TOTAL
Para interpretar los coeficientes se debe sacar el ratio de ODDS
boxplot(datos_creditos$CUOTA_TOTAL)
exp(modelo_2_logit$coefficients)## (Intercept) ANTIUEDAD EDAD CUOTA_TOTAL INGRESOS
## 0.04105509 0.95489160 1.02254364 1.00000101 0.99999974Esta razón de probabilidad lo que nos indica es lo siguiente:
Por cada unidad que aumenta la variable CUOTA_TOTAL, el odds de que se presente el evento de riesgo aumenta en 1, es decir, que una persona con una cuota mayor a 2MM es 1 veces mas probable de riesgo, Es decir, no hay riesgo en estos clientes.
Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
pred3 = predict.glm(modelo_2_logit,newdata = datos_creditos, type="response")
boxplot(pred3)
ypred = ifelse(pred3 >0.4,1,0)
yobser = datos_creditos$DEFAULT
matrizc3 = table (yobser,ypred)
matrizc3## ypred
## yobser 0 1
## 0 741 0
## 1 38 1sum(diag(matrizc))/sum(matrizc)## [1] 0.8435374library(ROCR)
pred3 = ROCR::prediction(pred3,datos_creditos$DEFAULT)
perf = performance(pred3,"tpr","fpr")
plot(perf)
abline(a=0,b=1,col="red")
grid()
#AUC: Area bajo la curva
AUClog3=performance(pred, measure = "auc")@y.values[[1]]
cat("AUC:", AUClog1,"n")## AUC: 0.7376403 nSe identifica que hay 741 observaciones clasificadas como 0 es decir que eran positivos, el modelo está mostrando como 0 y habian 38 como 1 y el modelo los predice como 0, es decir, falsos negativos, la empresa tiene un riesgo con estos 38 empleados, sin embargo, como lo vimos anteriormente el riesgo es mínimo.
El poder predictivo del modelo es del 73% con un intercepto en 0,4 Se observa que la curva tiene un área importante acercando el resultado al punto optimo que es x= 0, y=1.