Taller Modelos Lineales Generalizados
Karen Andrea Acevedo Landinez
2023-04-04
EJERCICIO 1
- Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación. Nota: Debes justificar porque estas variables están relacionadas y que tipo de relación se espera entre ellas (Hipótesis).
library(readxl)
datos = read_excel("~/Downloads/Datos_Rotación.xlsx")
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"VARIABLES CATEGÓRICAS:
La EDUCACIÓN como variable cualitativa ordinal puede estar relacionada a la rotación de una persona ya que al tener un mayor grado de estudio el individuo busca mejores oportunidades laborales lo cual genera cambios constantes segun sus logros academicos.
Realiza un análisis univariado (caracterización) de la información contenida en la base de datos rotacion. Nota: Los indicadores o gráficos se usan dependiendo del tipo de variable (cuantitativas o cualitativas). Incluir interpretaciones de la variable rotacion.
Hipótesis:A mayor grado de educación mayor probabilidad de rotar o cambiar de trabajo
Analisis univariado de los datos:
library(ggplot2)
library(ggpubr)
require(ggplot2)
require(ggpubr)
g1=ggplot(datos,aes(x=Educación))+geom_bar()+theme_bw()
ggarrange(g1, labels = c("A"),ncol = 1, nrow = 1)
Se identifica que el grueso de los individuos corresponden a profesionales universitarios (grupo 3), seguido por un grupo que cuenta con maestria (grupo 4).
- La SATISFACCIÓN AMBIENTAL se puede considerar actualmente como un punto de referenia para que un individuo decida quedarse o ser parte de una organizaciòn, ya que en este aspecto influyen temas como la comodidad con su entorno, con su jefe y compañeros, que tan conforme se encuentra desempeñando sus actividades y si se siente valorado por su trabajo, entre otros. Por lo cual podriamos decir que cuanto mayor sea el grado de Satisfacción Ambiental hay menor probabilidad de rotar para un individuo.
Hipótesis: A mayor grado de satisfacción en el ambiente laboral, menor propabilidad de rotación laboral.
Analisis univariado de los datos:
require(ggplot2)
require(ggpubr)
g2=ggplot(datos,aes(x=Satisfacción_Ambiental))+geom_bar()+theme_bw()
ggarrange(g2, labels = c("B"),ncol = 1, nrow = 1)
Accorde al grafico la santisfacción Ambiental de los individuos analizados se encuentra entre “Alta” y “Muy alta” las cuales en conjunto superan los 800 indiviuos de los 1470 registrados en la tabla de datos. Por lo cual se puede decir que mas del 50% tienen un ambiente laboral acorde a sus espectativas lo cual se refleja en un alto nivel de satisfacción ambiental.
- El ESTADO CIVIL de un individuo puede ser relevante al momento de tomar la decisión de cambiar de trabajo ya que pueden haber numerosas responsabilidades que varian segun el estado civil y estas pueden generar que el individuo quiera mantener un trabajo de forma estable, por lo que podriamos decir que una persona con estado civil casad@ es menos probable que tenga una alta rotación laboral, mientras que una persona soltera puede que tenga mayor rotación laboral.
Hipótesis: Si el individuo se encuentra en estado civil “solter@” es mas probable que rote o cambie de trabajo
Analisis univariado de los datos:
pie(table(datos$Estado_Civil))
La mayor proporción de los indivisuos se identifican con estado civil casado con casi la mitad del pastel, seguido por el grupo de solteros y en ultima instancia el grupo de divorciados con menor proporción.
require(ggplot2)
require(ggpubr)
g1=ggplot(datos,aes(x=Educación))+geom_bar(bins=30)+theme_bw()## Warning in geom_bar(bins = 30): Ignoring unknown parameters: `bins`g2=ggplot(datos,aes(x=Satisfacción_Ambiental))+geom_bar()+theme_bw()
g3=ggplot(datos,aes(x=Estado_Civil))+geom_bar()+theme_bw()
ggarrange(g1, g2, g3, labels = c("A", "B", "C"),ncol = 3, nrow = 1)
VARIABLES CUANTITATIVAS:
- La EDAD como variable cuantitativa continua puede estar relacionada directamente con la rotaciòn de una persona ya que ha menor edad mas alta es la probabilidad de que el individuo rote de trabajo al estar dentro de la etapa mas productiva de su vida laboral, por lo cual puede acceder a una mayor cantidad de ofertas laborales.
Hipótesis: A menor edad del individuo hay mayor probabiliadd de rotación o cambio de empleo
Análisis univariado de los datos:
require(ggplot2)
require(ggpubr)
g4=ggplot(datos,aes(x=Edad))+geom_histogram(bins=30)+theme_bw()
ggarrange(g4, labels = c("D"),ncol = 1, nrow = 1)
Se evidencia en el grafico que la concentraciñon en edad del grupo de 1470 individuos se da entre los 30 y 35 años, seguido por los de 35 a 40 años. Siendo en menor número aquellos menores a 25 años.
- La DISTANCIA entre el lugar de trabajo y la vivienda, pueden convertise en un factor de suma importancia en el momento de rotar de un trabajo y podriamos indicar que a menor distancia es menor la posibilidad de rotar o cambiar de trabajo. En la data disponible tenemos unicamente distancia en Km, pero también pueden haber otros factores inmersos dentro la misma como: Tiempo utilizado para recorrer la distancia, facilidad del medio de transporte, costo del transporte entre otros.
Hipótesis: A mayor distancia entre el trabajo y la vivienda, mayor probabilidad de cambiar o rotar de empleo.
Analisis univariado de los datos:
require(ggplot2)
require(ggpubr)
g5=ggplot(datos,aes(x=Distancia_Casa))+geom_bar()+theme_bw()
ggarrange(g5,labels = c("E"),ncol = 1, nrow = 1)
La mayoria de los individuos deben recorrer distancias menores a 10Km para ir de su lugar de residencia a su trabajo. Por lo que se podria decir que gran parte de los empleados deben recorrer distancias inferiores a los 5km, lo cual puede ser una ventaja. Sin embargo, hay un grupo que supera los 20km de distancia y estos podrian ser los que no esten comodos en su trabajo y busquen algo mas cerca a sus viviendas.
- El INGRESO MENSUAL que recibe una persona es uno de los principales factores que se tienen encuenta en el momento de cambiar de trabajo, ya que si las funciones que se estan ejecutando son mejor remuneradas en otros lugares, es probable que la persona decida cambiar de trabajo. Pór lo cual con un menor ingreso mensual se incrementa la posibilidad de cambiar de trabajo, es decir se incrementa la posibilidad de rotrar.
Hipótesis: Cuanto menor sea el ingreso mensual del individuo mayor es la probabilidad de cambiar o rotar de empleo.
require(ggplot2)
require(ggpubr)
g6=ggplot(datos,aes(x=Ingreso_Mensual))+geom_histogram()+theme_bw()
ggarrange(g6,labels = c("F"),ncol = 1, nrow = 1)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Se evidencia que el ingreso mensual de los individuos en su mayoria se encuentran por debajo de los 5’000.000, lo cual puede ser uno de los factores que justifican la rotación ya que ser que dentro de este grupo muchos de ellos no se encuentren satisfechos con su remuneración o se sientan mal remuerados.
- Para la ROTACIÓN se identifica que es mayor la proporción de empleados (1233) que no rotan, que aquellos que si lo hacen (237). Por lo que se podria entender que mas del 80% de los empleados estan conformes con su trabajo y no estan interesados en cambiar su trabajo.
pie(table(datos$Rotación))
require(ggplot2)
require(ggpubr)
g4=ggplot(datos,aes(x=Edad))+geom_histogram(bins=30)+theme_bw()
g5=ggplot(datos,aes(x=Distancia_Casa))+geom_bar()+theme_bw()
g6=ggplot(datos,aes(x=Ingreso_Mensual))+geom_histogram()+theme_bw()
ggarrange(g4, g5, g6, labels = c("D", "E", "F"),ncol = 3, nrow = 1)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
datos$Edad_grupo=cut(datos$Edad,breaks = c(0,30,40,50,60))
require(table1)## Loading required package: table1##
## Attaching package: 'table1'## The following objects are masked from 'package:base':
##
## units, units<-y <- table1::table1(~ Educación+Satisfacción_Ambiental+Estado_Civil+Edad+Distancia_Casa+Ingreso_Mensual | Rotación, data = datos)
y| No (N=1233) |
Si (N=237) |
Overall (N=1470) |
|
|---|---|---|---|
| Educación | |||
| Mean (SD) | 2.93 (1.03) | 2.84 (1.01) | 2.91 (1.02) |
| Median [Min, Max] | 3.00 [1.00, 5.00] | 3.00 [1.00, 5.00] | 3.00 [1.00, 5.00] |
| Satisfacción_Ambiental | |||
| Mean (SD) | 2.77 (1.07) | 2.46 (1.17) | 2.72 (1.09) |
| Median [Min, Max] | 3.00 [1.00, 4.00] | 3.00 [1.00, 4.00] | 3.00 [1.00, 4.00] |
| Estado_Civil | |||
| Casado | 589 (47.8%) | 84 (35.4%) | 673 (45.8%) |
| Divorciado | 294 (23.8%) | 33 (13.9%) | 327 (22.2%) |
| Soltero | 350 (28.4%) | 120 (50.6%) | 470 (32.0%) |
| Edad | |||
| Mean (SD) | 37.6 (8.89) | 33.6 (9.69) | 36.9 (9.14) |
| Median [Min, Max] | 36.0 [18.0, 60.0] | 32.0 [18.0, 58.0] | 36.0 [18.0, 60.0] |
| Distancia_Casa | |||
| Mean (SD) | 8.92 (8.01) | 10.6 (8.45) | 9.19 (8.11) |
| Median [Min, Max] | 7.00 [1.00, 29.0] | 9.00 [1.00, 29.0] | 7.00 [1.00, 29.0] |
| Ingreso_Mensual | |||
| Mean (SD) | 6830 (4820) | 4790 (3640) | 6500 (4710) |
| Median [Min, Max] | 5200 [1050, 20000] | 3200 [1010, 19900] | 4920 [1010, 20000] |
Podemos identificar que para el caso de la educación la mediana tanto para los que No rotan como para los que Si lo hacen se encuentra en 3 lo que indica que el grueso de los individuos tienen un nivel educativo profesional. Y se podria intuir que dicha variable no es significativa en el momento en el que el individuo toma la decisión de permanecer o cambiar de trabajo.
Para el caso de la satisfacción en el ambiente laboral se encuentra una media muy cercana para aquellos que No rotan (2,77) y para aquellos que Si lo hacen (2,46). Lo que nos podria indicar que este aspecto es indiferente en el momento de tomar la decisión de rotar de empleo.
De los que si rotaron el 50% corresponde a solteros, mientras que de los que no lo hicieron los casados son los que mayor porcentaje abarcan con el 48%. Lo que nos permite inferir que a el estado civil de un individuo si puede tener incidencia al momento de tomar la decisión de rotar de empleo.
Podemos observar que los que Si rotaron son un poco mas jovenes que los No rotaron ya que la media de los que Si rotaron se encuentra en 33.6, mientras que la media de los que No rotaron se encuentra en 37.6, hay una leve diferencia. Sin embargo, puede que no sea tan marcada para establecer que el factor edad es fundamental al momento de rotar de un empleo a otro.
la Distancia por su parte refleja que para el caso de los que Si rotaron es dos veces mayor la distancia en KM, que la distancia que recorren los que No rotaron en KM. Lo que permite identificar que el factor distancia puede ser importante o significativo en el momento que el individuo toma la decisión de rotar de un empleo a otro.
Por ultimo la diferencia de ingreso entre aquellos que si rotaron y aquellos que no lo hicieron, es cercano a 2`000.000 por lo cual esta diferencia en el momento de cambiar de trabajo puede ser relevante ya que el incremento de su ingreso mensual puede constituirse en el factor decisivo al momento de tomar la decisión de rotar o no hacerlo.
##Si es Cuantitativa
t.test(datos$Distancia_Casa~datos$Rotación)##
## Welch Two Sample t-test
##
## data: datos$Distancia_Casa by datos$Rotación
## t = -2.8882, df = 322.72, p-value = 0.004137
## alternative hypothesis: true difference in means between group No and group Si is not equal to 0
## 95 percent confidence interval:
## -2.8870025 -0.5475146
## sample estimates:
## mean in group No mean in group Si
## 8.915653 10.632911t.test(datos$Edad~datos$Rotación)##
## Welch Two Sample t-test
##
## data: datos$Edad by datos$Rotación
## t = 5.828, df = 316.93, p-value = 1.38e-08
## alternative hypothesis: true difference in means between group No and group Si is not equal to 0
## 95 percent confidence interval:
## 2.618930 5.288346
## sample estimates:
## mean in group No mean in group Si
## 37.56123 33.60759t.test(datos$Ingreso_Mensual~datos$Rotación)##
## Welch Two Sample t-test
##
## data: datos$Ingreso_Mensual by datos$Rotación
## t = 7.4826, df = 412.74, p-value = 4.434e-13
## alternative hypothesis: true difference in means between group No and group Si is not equal to 0
## 95 percent confidence interval:
## 1508.244 2583.050
## sample estimates:
## mean in group No mean in group Si
## 6832.740 4787.093##Si es Cualitativa
require(CGPfunctions)## Loading required package: CGPfunctionsPlotXTabs2(data = datos,x = Edad_grupo,y = Rotación)
PlotXTabs2(data = datos,x = Satisfacción_Ambiental,y = Rotación)
PlotXTabs2(data = datos,x = Educación,y = Rotación)
PlotXTabs2(data = datos,x = Estado_Civil,y = Rotación)
Acorde a los hallazgos identificados con las variables analizadas, podemos inferir que algunas de ellas como el nivel educativo o la edad no constituyen un factor relevante en el momento de tomar al decisión de cambiar de trabajo. Sin embargo, se podria indicar que el estado civil, la distancia y el ingreso mensual son factores significativos en la toma de decisiones de los individuos.
- Realiza un análisis de bivariado en donde la variable respuesta sea rotacion 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.
datos$Rotación=as.numeric(datos$Rotación=="Si")
glm(Rotación~Edad,data = datos,family = "binomial")##
## Call: glm(formula = Rotación ~ Edad, family = "binomial", data = datos)
##
## Coefficients:
## (Intercept) Edad
## 0.20620 -0.05225
##
## Degrees of Freedom: 1469 Total (i.e. Null); 1468 Residual
## Null Deviance: 1299
## Residual Deviance: 1259 AIC: 1263glm(Rotación~.,data = datos,family = "binomial")##
## Call: glm(formula = Rotación ~ ., family = "binomial", data = datos)
##
## Coefficients:
## (Intercept) Edad
## 1.637e+00 -9.109e-02
## `Viaje de Negocios`No_Viaja `Viaje de Negocios`Raramente
## -1.802e+00 -8.613e-01
## DepartamentoRH DepartamentoVentas
## -1.316e+01 -1.969e-01
## Distancia_Casa Educación
## 4.321e-02 2.822e-02
## Campo_EducaciónHumanidades Campo_EducaciónMercadeo
## 9.293e-01 3.690e-01
## Campo_EducaciónOtra Campo_EducaciónSalud
## 8.213e-02 -1.042e-01
## Campo_EducaciónTecnicos Satisfacción_Ambiental
## 9.322e-01 -4.373e-01
## GeneroM CargoDirector_Manofactura
## 3.423e-01 1.306e+00
## CargoEjecutivo_Ventas CargoGerente
## 2.373e+00 1.281e+00
## CargoInvestigador_Cientifico CargoRecursos_Humanos
## 1.650e+00 1.543e+01
## CargoRepresentante_Salud CargoRepresentante_Ventas
## 1.071e+00 3.289e+00
## CargoTecnico_Laboratorio Satisfación_Laboral
## 2.605e+00 -4.084e-01
## Estado_CivilDivorciado Estado_CivilSoltero
## -3.947e-01 9.960e-01
## Ingreso_Mensual Trabajos_Anteriores
## 3.550e-06 1.777e-01
## Horas_ExtraSi Porcentaje_aumento_salarial
## 1.889e+00 -2.494e-02
## Rendimiento_Laboral Años_Experiencia
## 1.765e-01 -5.110e-02
## Capacitaciones Equilibrio_Trabajo_Vida
## -1.879e-01 -3.615e-01
## Antigüedad Antigüedad_Cargo
## 9.581e-02 -1.453e-01
## Años_ultima_promoción Años_acargo_con_mismo_jefe
## 1.738e-01 -1.483e-01
## Edad_grupo(30,40] Edad_grupo(40,50]
## 1.866e-01 7.744e-01
## Edad_grupo(50,60]
## 2.115e+00
##
## Degrees of Freedom: 1469 Total (i.e. Null); 1429 Residual
## Null Deviance: 1299
## Residual Deviance: 883.3 AIC: 965.3- Al ver algunas variables como la Edad, los años de experiencia, los viajes de negocio, el estado civil, la satisfacción ambiental,el porcentaje de aumento saliar, antiguedad en el cargo entre otros factores presentan signo negativo por lo cual podemos afirmar que con el incremento de dichas variables el empleado opta en menor instancia por retirarse o rotar en la compañia.
- Y por otra parte tenemos algunas variables como la Distancia, la educación, estado civil soltero, horas extras entre otras podemos afirmar que con el incremento de dichas variables el empleado opta en mayor medida porretirarse o rotar en la compañia.
Al comparar los resultados anteriores con las hipotesis planteadas en el segundo punto podemos identificar que algunas variables indicadas anteriormente tienen incidencia en la rotación de un empleado. Por lo cual podemos afirmar que a mayor grado de educación mayor probabilidad de rotar o cambiar de trabajo, tambien que a mayor grado de satisfacción en el ambiente laboral, menor propabilidad de rotación laboral. Si el individuo se encuentra en estado civil “solter@” es mas probable que rote o cambie de trabajo. A mayor edad del individuo hay menor probabiliadd de rotación o cambio de empleo. Entre mas distancia entre el trabajo y la vivienda, mayor probabilidad de cambiar o rotar de empleo.Cuanto menor sea el ingreso mensual del individuo mayor es la probabilidad de cambiar o rotar de empleo.
- Realiza la estimación de un modelo de regresión logístico en el cual la variable respuesta es rotacion (y=1 es si rotación, y=0 es no rotación) y las covariables las 6 seleccionadas en el punto 1. Interprete los coeficientes del modelo y la significancia de los parámetros.
require(caret)## Loading required package: caret## Loading required package: lattice##Logistica
table(datos$Rotación)##
## 0 1
## 1233 237control=trainControl(method = "cv",number = 10,p = 0.2)
mod_caret=train(Rotación~.,data=datos,method="glm",family="binomial",trControl=control)## Warning in train.default(x, y, weights = w, ...): You are trying to do
## regression and your outcome only has two possible values Are you trying to do
## classification? If so, use a 2 level factor as your outcome column.varImp(mod_caret)## glm variable importance
##
## only 20 most important variables shown (out of 40)
##
## Overall
## Horas_ExtraSi 100.00
## Satisfacción_Ambiental 53.47
## Satisfación_Laboral 50.97
## Estado_CivilSoltero 50.52
## Trabajos_Anteriores 46.80
## `\\`Viaje de Negocios\\`No_Viaja` 45.05
## Años_ultima_promoción 41.93
## `\\`Viaje de Negocios\\`Raramente` 41.11
## Distancia_Casa 40.73
## Antigüedad_Cargo 32.76
## Años_acargo_con_mismo_jefe 32.05
## Campo_EducaciónTecnicos 30.59
## Equilibrio_Trabajo_Vida 29.50
## Edad 28.65
## Capacitaciones 26.06
## Antigüedad 25.92
## CargoTecnico_Laboratorio 25.54
## `Edad_grupo(50,60]` 22.67
## CargoRepresentante_Ventas 21.82
## GeneroM 18.59plot(varImp(mod_caret))
Para este modelo tomaremos los 1470 datos y tomamos el 20% para realizar la validalicación. Con los resultados obtenidos podemos concluir que una de las variables mas impactante que lleva a las personas a dejara su empleo son las horas extras, seguido por la Safiscacciòn Ambiental, la satisdacción Laboral y aquellos individuos en estado civil de solteros superando el 50.0
mod_caret$finalModel##
## Call: NULL
##
## Coefficients:
## (Intercept) Edad
## 1.637e+00 -9.109e-02
## `\\`Viaje de Negocios\\`No_Viaja` `\\`Viaje de Negocios\\`Raramente`
## -1.802e+00 -8.613e-01
## DepartamentoRH DepartamentoVentas
## -1.316e+01 -1.969e-01
## Distancia_Casa Educación
## 4.321e-02 2.822e-02
## Campo_EducaciónHumanidades Campo_EducaciónMercadeo
## 9.293e-01 3.690e-01
## Campo_EducaciónOtra Campo_EducaciónSalud
## 8.213e-02 -1.042e-01
## Campo_EducaciónTecnicos Satisfacción_Ambiental
## 9.322e-01 -4.373e-01
## GeneroM CargoDirector_Manofactura
## 3.423e-01 1.306e+00
## CargoEjecutivo_Ventas CargoGerente
## 2.373e+00 1.281e+00
## CargoInvestigador_Cientifico CargoRecursos_Humanos
## 1.650e+00 1.543e+01
## CargoRepresentante_Salud CargoRepresentante_Ventas
## 1.071e+00 3.289e+00
## CargoTecnico_Laboratorio Satisfación_Laboral
## 2.605e+00 -4.084e-01
## Estado_CivilDivorciado Estado_CivilSoltero
## -3.947e-01 9.960e-01
## Ingreso_Mensual Trabajos_Anteriores
## 3.550e-06 1.777e-01
## Horas_ExtraSi Porcentaje_aumento_salarial
## 1.889e+00 -2.494e-02
## Rendimiento_Laboral Años_Experiencia
## 1.765e-01 -5.110e-02
## Capacitaciones Equilibrio_Trabajo_Vida
## -1.879e-01 -3.615e-01
## Antigüedad Antigüedad_Cargo
## 9.581e-02 -1.453e-01
## Años_ultima_promoción Años_acargo_con_mismo_jefe
## 1.738e-01 -1.483e-01
## `Edad_grupo(30,40]` `Edad_grupo(40,50]`
## 1.866e-01 7.744e-01
## `Edad_grupo(50,60]`
## 2.115e+00
##
## Degrees of Freedom: 1469 Total (i.e. Null); 1429 Residual
## Null Deviance: 1299
## Residual Deviance: 883.3 AIC: 965.3- Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
modelo=glm(Rotación~Horas_Extra+Distancia_Casa+Estado_Civil,data = datos,family = binomial(link="logit"))
summary(modelo)##
## Call:
## glm(formula = Rotación ~ Horas_Extra + Distancia_Casa + Estado_Civil,
## family = binomial(link = "logit"), data = datos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3127 -0.6214 -0.3969 -0.3429 2.4789
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.77710 0.17480 -15.888 < 2e-16 ***
## Horas_ExtraSi 1.39847 0.15166 9.221 < 2e-16 ***
## Distancia_Casa 0.02757 0.00886 3.112 0.00186 **
## Estado_CivilDivorciado -0.27550 0.22390 -1.230 0.21851
## Estado_CivilSoltero 0.97443 0.16543 5.890 3.86e-09 ***
## ---
## 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: 1159.2 on 1465 degrees of freedom
## AIC: 1169.2
##
## Number of Fisher Scoring iterations: 5predict1= predict.glm(modelo, newdata = datos, type = "response")
result1 = table(datos$Rotación, ifelse(predict1 >0.2, 1, 0), dnn = c("observaciones", "predicciones"))
result1## predicciones
## observaciones 0 1
## 0 942 291
## 1 105 132mosaicplot(result1, shade = T, colorize = T,
gp = gpar(fill = matrix(c("green3", "red2", "red2", "green3"), 2, 2)))## Warning: In mosaicplot.default(result1, shade = T, colorize = T, gp = gpar(fill = matrix(c("green3",
## "red2", "red2", "green3"), 2, 2))) :
## extra arguments 'colorize', 'gp' will be disregarded
sum(diag(result1)/sum(result1))## [1] 0.7306122El modelo es capaz de clasificar correctamente 0.730(73%) de las observaciones cuando se emplean los datos de entrenamiento.
library(ROCR)
prediccion_rotacion= ROCR::prediction(predict1,datos$Rotación)
perf= performance(prediction.obj = prediccion_rotacion, "tpr", "fpr")
plot(perf)
abline(a=0, b=1, col="blue")
grid()
AUClog= performance(prediccion_rotacion, measure = "auc")@y.values[[1]]
cat("AUC: ", AUClog, "n")## AUC: 0.7213239 nEl área bajo la curva de 0.72 indica que el modelo es aceptable y puede servir para predecir.
- Realiza una predicción 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).
Trotacion=(predict(modelo,list(Horas_Extra="Si",Distancia_Casa=24,Estado_Civil="Soltero"),type = "response"))*100
cat("Tasa Rotación: ", Trotacion,"%")## Tasa Rotación: 56.40026 %Una empleado con las caracteristica anteriores tiene la probabilidad de rotar un 56.40%.
- En las conclusiones adicione una discución sobre cuál sería 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:
Acorde a los hallazgos identificados con las variables analizadas, podemos inferir que algunas de ellas como el nivel educativo o la edad no constituyen un factor relevante en el momento de tomar al decisión de cambiar de trabajo. Sin embargo, se podria indicar que el estado civil, la distancia y el ingreso mensual son factores significativos en la toma de decisiones de los individuos. Por lo cual las estrategias de la compañia deben estar relacionadas a:
Implementar alternativas para sus empleados que les permitan facil acceso a creditos de vivienda o de educación para los empleados o sus hijos. También subsidios o bonos de vivienda o educación. Lo que puede llevar a que los empleados casados, sientan mayores garantias al ser parte de la compañia.
Se podria implementar una ruta que cubra la generalidad de las zonas donde viven los empleados o en un punto común donde estos puedan tener este servicio de transporte por parte de la compañia. Otra alternativa podria ser la implementación de home office, lo que puede reducir los costos y mejorar la calidad de vida para los empleados.
Estipular los rangos de salariales acorde a los cargos que se encuentran en la compañia y que sean de publico conocimiento para los empleados, esto permite que identifiquen su rango salarian y se sientan mas comodos con su ingreso mensual. A su vez, algunos incentivos salariales como bonos por iniciativas para reducción de costos o bonos por antiguedad en la compañia podrian ser un factor que impacte positivamente a los empleados.
EJERCICIO 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 o de no pago 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.
- Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación. Nota: Debes justificar porque estas variables están relacionadas y que tipo de relación se espera entre ellas (Hipótesis).
library(readxl)
datos = read_excel("~/Downloads/Datos_Creditos.xlsx")
names(datos)## [1] "DEFAULT" "ANTIUEDAD" "EDAD" "CUOTA_TOTAL" "INGRESOS"datos$COMPROMISO=round(datos$CUOTA_TOTAL/datos$INGRESOS*100,1)
table(datos$DEFAULT)##
## 0 1
## 741 39VARIABLES:
- La EDAD como variable cuantitativa continua puede estar relacionada directamente con el riesgo de default o de no pago.
Hipótesis: A menor edad del individuo hay mayor probabiliadd de que se incremente el riesgo de default o de no pago.
Análisis univariado de los datos:
require(ggplot2)
require(ggpubr)
g4=ggplot(datos,aes(x=EDAD))+geom_histogram(bins=30)+theme_bw()
ggarrange(g4, labels = c("D"),ncol = 1, nrow = 1)
Se evidencia en el grafico que la concentraciñon en edad del grupo de 780 individuos se da entre los 45 y 70 años.
- La INGRESOS como variable cuantitativa continua puede estar relacionada directamente con el riesgo de default o de no pago.
Hipótesis: A mayor ingreso del individuo hay menor probabiliadd de que se incremente el riesgo de default o de no pago.
- El COMPROMISO de un individuo puede llevar a que ese individuo tenga niveles diferentes de rieso o no pago.
Hipótesis: Cuanto mayor sea el nivel de compromiso de un individuo menor va a ser el nivel de riesgo de no pago
- La ANTIGUEDAD de un individuo puede llevar a que ese individuo tenga niveles diferentes de rieso o no pago.
Hipótesis: Cuanto mayor sea la antiguedad de un individuo menor va a ser el nivel de riesgo de no pago.
library(GGally)## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2library(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, unionggpairs(select_if(datos, is.numeric), lower = list(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`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
La correlación entre Edad y Default es de -0.034 por lo cual tiene una incidencia negativa y podriamos decir que el riesgo de no pago se disminuye en relación con la Edad.
La correlación entre la Cuota total y Default es de 0.097 y por lo tanto es una variable que tiene incidencia en el riesgo de pago.
La correlación entre ingresos y Default es de -0.062 por lo cual tiene una incidencia negativa y podriamos decir que el riesgo de no pago se disminuye en relación con el ingreso.
La correlación entre Compromiso y Defaulr es de 0.166, por lo cual es la seria la variable mas significativa en relación a otras veriables y por lo tanto puede afectar en mayor medida el riesgo de no pago.
- Realiza un análisis univariado (caracterización) de la información contenida en la base de datos rotacion. Nota: Los indicadores o gráficos se usan dependiendo del tipo de variable (cuantitativas o cualitativas). Incluir interpretaciones de la variable rotacion.
Default se identifica que es mayor la proporción de individuos con menor riesgo de no pago, que aquellos que si tienen riesgo de no pago. Por lo que se podria entender que mas del 80% de los individuos tiene un riesgo de no pago bajo.
pie(table(datos$DEFAULT))
require(table1)
y <- table1::table1(~ ANTIUEDAD+ EDAD+COMPROMISO| DEFAULT, data = datos)## Warning in table1.formula(~ANTIUEDAD + EDAD + COMPROMISO | DEFAULT, data =
## datos): Terms to the right of '|' in formula 'x' define table columns and are
## expected to be factors with meaningful labels.y| 0 (N=741) |
1 (N=39) |
Overall (N=780) |
|
|---|---|---|---|
| ANTIUEDAD | |||
| Mean (SD) | 18.2 (11.9) | 14.5 (11.6) | 18.0 (11.9) |
| Median [Min, Max] | 15.5 [0.255, 37.3] | 9.99 [1.37, 37.3] | 15.1 [0.255, 37.3] |
| EDAD | |||
| Mean (SD) | 57.1 (12.5) | 55.2 (12.4) | 57.0 (12.5) |
| Median [Min, Max] | 58.0 [26.6, 92.4] | 53.7 [30.4, 78.9] | 57.9 [26.6, 92.4] |
| COMPROMISO | |||
| Mean (SD) | 17.0 (11.9) | 26.7 (21.8) | 17.4 (12.7) |
| Median [Min, Max] | 15.3 [0, 85.8] | 23.1 [0.800, 130] | 15.6 [0, 130] |
Podemos identificar que para el caso de la antiguedad la mediana para quellos que no tienen riesgo de no pago es de 18.2 y para aquellos que tienen riesgo de no pago es de 14.5
Podemos identificar que para el caso de la edad la mediana para quellos que no tienen riesgo de no pago es de 57.1 y para aquellos que tienen riesgo de no pago es de 55.2
Podemos identificar que para el caso de la compromiso la mediana para quellos que no tienen riesgo de no pago es de 17.0 y para aquellos que tienen riesgo de no pago es de 26.7
Realiza un análisis de bivariado en donde la variable respuesta sea rotacion 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.
##Si es Cuantitativa
t.test(datos$COMPROMISO~datos$DEFAULT)##
## Welch Two Sample t-test
##
## data: datos$COMPROMISO by datos$DEFAULT
## t = -2.7594, df = 39.204, p-value = 0.008756
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
## -16.800108 -2.589635
## sample estimates:
## mean in group 0 mean in group 1
## 16.96154 26.65641t.test(datos$EDAD~datos$DEFAULT)##
## Welch Two Sample t-test
##
## data: datos$EDAD by datos$DEFAULT
## t = 0.94189, df = 42.162, p-value = 0.3516
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
## -2.196093 6.040982
## sample estimates:
## mean in group 0 mean in group 1
## 57.08114 55.15869t.test(datos$ANTIUEDAD~datos$DEFAULT)##
## Welch Two Sample t-test
##
## data: datos$ANTIUEDAD by datos$DEFAULT
## t = 1.9332, df = 42.35, p-value = 0.05992
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
## -0.1610822 7.5375264
## sample estimates:
## mean in group 0 mean in group 1
## 18.21966 14.53144Acorde a los hallazgos identificados con las variables analizadas, podemos inferir que algunas de ellas como la Edad o los ingresos y la antiguedad no tienen tanta incidencia en el riesgo de no pago. Sin embargo, se podria indicar que el compromiso y la cuota total son factores significativos.
datos$EDAD_GRUPO=cut(datos$EDAD,breaks = c(0,20,40,60,80,100))
require(CGPfunctions)
PlotXTabs2(data = datos,x = EDAD_GRUPO,y = DEFAULT)
- Realiza la estimación de un modelo de regresión logístico en el cual la variable respuesta es rotacion (y=1 es si rotación, y=0 es no rotación) y las covariables las 6 seleccionadas en el punto 1. Interprete los coeficientes del modelo y la significancia de los parámetros.
modelo=glm(DEFAULT~EDAD+ANTIUEDAD+COMPROMISO,data = datos,family = binomial(link="logit"))
summary(modelo)##
## Call:
## glm(formula = DEFAULT ~ EDAD + ANTIUEDAD + COMPROMISO, family = binomial(link = "logit"),
## data = datos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1700 -0.3526 -0.2798 -0.2167 2.9410
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.27244 0.94783 -4.508 6.56e-06 ***
## EDAD 0.02054 0.01913 1.074 0.283
## ANTIUEDAD -0.04685 0.02158 -2.171 0.030 *
## COMPROMISO 0.04523 0.01140 3.968 7.24e-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.08 on 776 degrees of freedom
## AIC: 296.08
##
## Number of Fisher Scoring iterations: 6OR=exp(modelo$coefficients)
OR## (Intercept) EDAD ANTIUEDAD COMPROMISO
## 0.01394766 1.02075494 0.95423016 1.04626372- Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
predict1= predict.glm(modelo, newdata = datos, type = "response")
result1 = table(datos$DEFAULT, ifelse(predict1 >0.2, 1, 0), dnn = c("observaciones", "predicciones"))
result1## predicciones
## observaciones 0 1
## 0 737 4
## 1 38 1sum(diag(result1)/sum(result1))## [1] 0.9461538El modelo es capaz de clasificar correctamente 0.946(94%) de las observaciones cuando se emplean los datos de entrenamiento.
library(ROCR)
prediccion_credito= ROCR::prediction(predict1,datos$DEFAULT)
perf= performance(prediction.obj = prediccion_rotacion, "tpr", "fpr")
plot(perf)
abline(a=0, b=1, col="blue")
grid()
AUClog= performance(prediccion_credito, measure = "auc")@y.values[[1]]
cat("AUC: ", AUClog, "n")## AUC: 0.7036576 nEl área bajo la curva de 0.70 indica que el modelo es aceptable y puede servir para predecir.
- Realiza una predicción 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).
predict(modelo,list(EDAD =20,ANTIUEDAD=1, COMPROMISO=10),type = "response")## 1
## 0.03058482Una persona tiene la probailidad de un riesgo de no pago del 30.58%.
- En las conclusiones adicione una discución sobre cuál sería 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:
Acorde a los hallazgos identificados con las variables analizadas, podemos inferir que algunas de ellas como la antiguedad o la edad no constituyen un factor relevante para definir el riesgo de no pago. Sin embargo, se podria indicar que el compromiso, es un factor significativo para el riesgo de no pago. Por lo cual las estrategias del banco deben estar relacionadas a:
- Realizar una evaluación previo de los individuos donde el equipo de gestores de riesgo del banco debe tener la capacidad de reconocer aquellos individuos que pueden tener mayor riesgo y por lo tanto es deber del banco da las herrmientas necesarias para que puedan realizar las evaluaciones pertinentes. Para que todos estén en la misma sintonía, se deben establecer lineamientos y parámetros específicos que habiliten el conocimiento de las personas encargadas.
- Conciliar la cultura de riesgo con las características del negocio o del sector económico de la empresa.
- Facilitar una comunicación directa y eficaz entre los clientes y el área de crédito. Automatizar el flujo de informaciones y procesos, de manera que las decisiones se tomen más rápido.
- Pueden haber nuevos factores que impacten el riesgo de credito por lo cual debe haber una actualización permanente de los estudios y las herramientas para la evaluación del riesgo de los usuarios.