Actividad3_Metodos_Estadisticos_Francisco_Pizarro
Francisco Pizarro
2023-04-03
Problema 1
Importación de datos
options(repos = list(CRAN="http://cran.rstudio.com/"))
install.packages('plyr', repos = "http://cran.us.r-project.org")## Installing package into 'C:/Users/franc/AppData/Local/R/win-library/4.2'
## (as 'lib' is unspecified)## package 'plyr' successfully unpacked and MD5 sums checked## Warning: cannot remove prior installation of package 'plyr'## Warning in file.copy(savedcopy, lib, recursive = TRUE): problema al copiar
## C:\Users\franc\AppData\Local\R\win-library\4.2\00LOCK\plyr\libs\x64\plyr.dll a
## C:\Users\franc\AppData\Local\R\win-library\4.2\plyr\libs\x64\plyr.dll:
## Permission denied## Warning: restored 'plyr'##
## The downloaded binary packages are in
## C:\Users\franc\AppData\Local\Temp\RtmpkTXaio\downloaded_packagesinstall.packages("devtools") # solo la primera vez## Installing package into 'C:/Users/franc/AppData/Local/R/win-library/4.2'
## (as 'lib' is unspecified)## package 'devtools' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\franc\AppData\Local\Temp\RtmpkTXaio\downloaded_packagesdevtools::install_github("dgonxalex80/paqueteMOD", force =TRUE)## WARNING: Rtools is required to build R packages, but is not currently installed.
##
## Please download and install Rtools 4.2 from https://cran.r-project.org/bin/windows/Rtools/ or https://www.r-project.org/nosvn/winutf8/ucrt3/.## Downloading GitHub repo dgonxalex80/paqueteMOD@HEAD## Error in utils::download.file(url, path, method = method, quiet = quiet, :
## download from 'https://api.github.com/repos/dgonxalex80/paqueteMOD/tarball/HEAD' failedlibrary(paqueteMOD)
data("rotacion")
data("creditos")1. Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación.
1.1 Pre procesamiento de datos
library("tidyverse")## Warning: package 'tidyverse' was built under R version 4.2.3## Warning: package 'tidyr' was built under R version 4.2.2## Warning: package 'readr' was built under R version 4.2.2## Warning: package 'purrr' was built under R version 4.2.2## Warning: package 'dplyr' was built under R version 4.2.2## Warning: package 'stringr' was built under R version 4.2.2## Warning: package 'forcats' was built under R version 4.2.2## Warning: package 'lubridate' was built under R version 4.2.2## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.0 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.1.8
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errorsglimpse(rotacion)## 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, …El DataSet de rotación esta compuesto por 24 variables y 1.470 observaciones, se procede a hacer casting de variables
data_rotacion <- rotacion
data_rotacion$Rotacion = as.factor(data_rotacion$Rotación)
data_rotacion$Educacion = as.factor(data_rotacion$Educación)
data_rotacion$Satisfaccion_Ambiental = as.factor(data_rotacion$Satisfacción_Ambiental)
data_rotacion$Satisfacion_Laboral = as.factor(data_rotacion$Satisfación_Laboral)
data_rotacion$Viaje_Negocios = as.factor(data_rotacion$`Viaje de Negocios`)
data_rotacion$Departamento = as.factor(data_rotacion$Departamento)
data_rotacion$Campo_Educacion = as.factor(data_rotacion$Campo_Educación)
data_rotacion$Genero = as.factor(data_rotacion$Genero)
data_rotacion$Cargo = as.factor(data_rotacion$Cargo)
data_rotacion$Estado_Civil = as.factor(data_rotacion$Estado_Civil)
data_rotacion$Horas_Extra = as.factor(data_rotacion$Horas_Extra)
data_rotacion$Equilibrio_Trabajo_Vida = as.factor(data_rotacion$Equilibrio_Trabajo_Vida)
data_rotacion$Anios_Experiencia = data_rotacion$Años_Experiencia
data_rotacion$Antiguedad = data_rotacion$Antigüedad
data_rotacion$Antiguedad_Cargo = data_rotacion$Antigüedad_Cargo
data_rotacion$Anios_ultima_promocion = data_rotacion$Años_ultima_promoción
data_rotacion$Anios_acargo_con_mismo_jefe = data_rotacion$Años_acargo_con_mismo_jefe
data_rotacion2 <- subset(data_rotacion, select= c(Rotacion,Edad,Viaje_Negocios,Departamento,Distancia_Casa,Educacion,Campo_Educacion,Satisfaccion_Ambiental,Genero,Cargo,Satisfacion_Laboral,Estado_Civil,Ingreso_Mensual,Trabajos_Anteriores,Horas_Extra,Porcentaje_aumento_salarial,Rendimiento_Laboral,Anios_Experiencia,Capacitaciones,Equilibrio_Trabajo_Vida,Antiguedad,Antiguedad_Cargo,Anios_ultima_promocion,Anios_acargo_con_mismo_jefe))
glimpse(data_rotacion2)## Rows: 1,470
## Columns: 24
## $ Rotacion <fct> Si, No, Si, No, No, No, No, No, No, No, No…
## $ Edad <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35…
## $ Viaje_Negocios <fct> Raramente, Frecuentemente, Raramente, Frec…
## $ Departamento <fct> Ventas, IyD, IyD, IyD, IyD, IyD, IyD, IyD,…
## $ Distancia_Casa <dbl> 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, 15, 2…
## $ Educacion <fct> 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1, 2, …
## $ Campo_Educacion <fct> Ciencias, Ciencias, Otra, Ciencias, Salud,…
## $ Satisfaccion_Ambiental <fct> 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1, 2, …
## $ Genero <fct> F, M, M, F, M, M, F, M, M, M, M, F, M, M, …
## $ Cargo <fct> Ejecutivo_Ventas, Investigador_Cientifico,…
## $ Satisfacion_Laboral <fct> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, …
## $ Estado_Civil <fct> Soltero, Casado, Soltero, Casado, 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 <fct> Si, No, Si, Si, No, No, Si, No, No, No, No…
## $ 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, …
## $ Anios_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 <fct> 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2, 3, …
## $ Antiguedad <dbl> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2,…
## $ Antiguedad_Cargo <dbl> 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2, 2, …
## $ Anios_ultima_promocion <dbl> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, …
## $ Anios_acargo_con_mismo_jefe <dbl> 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 3, 2, …1.2 Selección de 3 variables categóricas y 3 variables cuantitativas
Variables Categóricas
-Satisfacion_Laboral -Horas_Extra -Satisfaccion_Ambiental
Se seleccionan estas tres variables categóricas debido a que se tiene por hipotesis que:
- La variable “Satisfaccion_Laboral” se relaciona con la variable “Rotacion” ya que si un empleado siente un buen nivel de satisfacción laboral, tendra menos probabilidad de buscar un nuveo trabajo.
- La variable “Horas_Extra” se relaciona con la variable “Rotacion” ya que si un empleado tiene que hacer horas extra tendrá menos tiempo para realizar otras actividades, por ende, aumentará la probabilidad de rotar de trabajo.
- La variable “Equilibrio_Trabajo_Vida” se relaciona con la variable “Rotacion” ya que si un empleado siente un buen nivel de equilibrio con su vida personal, tendra menos probabilidad de buscar un nuveo trabajo. Adicionalmente, es probable que haya una relación entre “Horas_Extra” y “Equilibrio_Trabajo_Vida”, ya que al haber horas extra se disminuira el equilibrio de la vida laboral y la personal
- La variable “Edad” se relaciona con la variable “Rotacion” ya que un empleado con mayor edad tenderá a rotar de trabajo con menor probabilidad, ya que a mayor edad será menos “empleable”
- La variable “Distancia_Casa” se relaciona con la variable “Rotacion” ya que los empleados tenderán a buscar empleos que esten mas cerca a su casa, por ende, a mayor distancia aumentará la probabilidad de rotar. 6.La variable “Anios_ultima_promocion” se relaciona con la variable “Rotacion” ya que a mayor tiempo sin una promoción el empleado se sentirá estancado y buscará cambiar de trabajo
2.Realiza un análisis univariado (caracterización) de la información contenida en la base de datos rotacion.
#Creación de data set con las 7 variables
data_rotacion3 <- subset(data_rotacion, select= c(Rotacion,Satisfacion_Laboral,Horas_Extra,Equilibrio_Trabajo_Vida,Edad,Distancia_Casa,Anios_ultima_promocion))
#as.data.frame(data_rotacion3)2.1 Exploración de datos categóricos
library(ggmosaic)
library(plotly)## Warning: package 'plotly' was built under R version 4.2.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutp <- ggplot(data=data_rotacion3) +
ggmosaic::geom_mosaic(aes(x = product(Horas_Extra), fill = Rotacion)) +
ggplot2::labs(x = "Horas Extra", y = "Rotacion",
title = "Rotación según horas extra")
ggplotly(p)## Warning: `unite_()` was deprecated in tidyr 1.2.0.
## ℹ Please use `unite()` instead.
## ℹ The deprecated feature was likely used in the ggmosaic package.
## Please report the issue at <]8;;https://github.com/haleyjeppson/ggmosaichttps://github.com/haleyjeppson/ggmosaic]8;;>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.table_HE <-table(data_rotacion3$Horas_Extra,data_rotacion3$Rotacion)
table_HE##
## No Si
## No 944 110
## Si 289 127Se puede ver que el 89% de los empleados que no tuvieron horas extras No Rotarion de trabajo, mientras que solo el 69% de los empleados que Si tuvieron horas extra, No rotaron de trabajo.
p <- ggplot(data=data_rotacion3) +
ggmosaic::geom_mosaic(aes(x = product(Satisfacion_Laboral), fill = Rotacion)) +
ggplot2::labs(x = "Satisfacion Laboral", y = "Rotacion",title = "Rotación según horas extra")
ggplotly(p)table_SL <-table(data_rotacion3$Satisfacion_Laboral,data_rotacion3$Rotacion)
table_SL##
## No Si
## 1 223 66
## 2 234 46
## 3 369 73
## 4 407 52Se puede ver que a medida que crece la satisfacción laboral, se reduce la proporción en que rotan los empleados.
p <- ggplot(data=data_rotacion3) +
ggmosaic::geom_mosaic(aes(x = product(Equilibrio_Trabajo_Vida), fill = Rotacion)) +
ggplot2::labs(x = "Equilibrio_Trabajo_Vida", y = "Rotacion",title = "Rotacion según horas extra")
ggplotly(p)table_EV <-table(data_rotacion3$Equilibrio_Trabajo_Vida,data_rotacion3$Rotacion)
table_EV##
## No Si
## 1 55 25
## 2 286 58
## 3 766 127
## 4 126 27En el caso de la relación entre la variable “Equilibrio_Trabajo_Vida” y “Rotacion”, no es tan claro una reducción en el % de trabajadores que rotan vs el nivel de equilibrio de trabajo-vida.
2.2 Exploración de datos cuantitativos
ggplot(data = data_rotacion3, aes(x=Rotacion,y=Edad)) + geom_boxplot(aes(fill=Rotacion)) + theme_bw()
Se puede ver graficamente el promedio de edad de los trabajadores que SI rotaron es inferior al promedio de los trabajadores que NO rotaron.
ggplot(data = data_rotacion3, aes(x=Rotacion,y=Distancia_Casa)) + geom_boxplot(aes(fill=Rotacion)) + theme_bw()
Se puede ver graficamente que los trabajadores que SI rotaron tienen una
distancia a casa mayor que los que no rotaron.
ggplot(data = data_rotacion3, aes(x=Rotacion,y=Anios_ultima_promocion)) + geom_boxplot(aes(fill=Rotacion)) + theme_bw()
3. 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.
# Codificación binaria de Rotación
data_rotacion4 = data_rotacion3
data_rotacion4$Rotacion = as.numeric(data_rotacion4$Rotacion == "Si")
glimpse(data_rotacion4)## Rows: 1,470
## Columns: 7
## $ Rotacion <dbl> 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0…
## $ Satisfacion_Laboral <fct> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, 3, 1…
## $ Horas_Extra <fct> Si, No, Si, Si, No, No, Si, No, No, No, No, Si…
## $ Equilibrio_Trabajo_Vida <fct> 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2, 3, 3, 3…
## $ Edad <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35, 29…
## $ Distancia_Casa <dbl> 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, 15, 26, 1…
## $ Anios_ultima_promocion <dbl> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, 0, 8…3.1 Modelos generales lineales para variables cuantitativas
Modelo de regresión lineal general de Rotación vs Edad
mod_edad = glm(Rotacion ~ Edad, data= data_rotacion4, family="binomial")
summary(mod_edad)##
## Call:
## glm(formula = Rotacion ~ Edad, family = "binomial", data = data_rotacion4)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.8854 -0.6446 -0.5451 -0.4155 2.4009
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.20637 0.30597 0.674 0.5
## Edad -0.05225 0.00870 -6.006 1.9e-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: 1259.1 on 1468 degrees of freedom
## AIC: 1263.1
##
## Number of Fisher Scoring iterations: 4Se puede ver que el modelo lineal de Rotacion vs Edad es: 0.2 - 0.05*Edad, lo cual muestra hay una relación lineal negativa entre la edad y la rotación, sin embargo, este modelo no indica la probabilidad de rotación según el comportamiento de la edad, para ello, se debe transformar a un modelo de regresión logistica.
Este comportamiento esta alineado con la hipotesis inicial, en la cual se decia que había una relación inversa entre la rotación con la edad.
Modelo de regresión lineal general de Rotación vs Distancia_Casa
mod_Distancia_Casa = glm(Rotacion ~ Distancia_Casa, data= data_rotacion4, family="binomial")
summary(mod_Distancia_Casa)##
## Call:
## glm(formula = Rotacion ~ Distancia_Casa, family = "binomial",
## data = data_rotacion4)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.7341 -0.5947 -0.5618 -0.5366 2.0046
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.890051 0.111382 -16.969 < 2e-16 ***
## Distancia_Casa 0.024710 0.008312 2.973 0.00295 **
## ---
## 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: 1290.0 on 1468 degrees of freedom
## AIC: 1294
##
## Number of Fisher Scoring iterations: 4Se puede ver que el modelo lineal de Rotacion vs Distancia_Casa es: -1.8 + 0.02*Distancia_Casa, lo cual muestra hay una relación lineal positiva entre la distancia a casa y la rotación, sin embargo, este modelo no indica la probabilidad de rotación según el comportamiento de la distancia a casa, para ello, se debe transformar a un modelo de regresión logistica.
Este comportamiento esta alineado con la hipotesis inicial, en la cual se decia que había una relación directa entre la rotación y la distancia a casa.
Modelo de regresión lineal general de Rotación vs Anios_ultima_promocion
mod_Promocion = glm(Rotacion ~ Anios_ultima_promocion, data= data_rotacion4, family="binomial")
summary(mod_Promocion)##
## Call:
## glm(formula = Rotacion ~ Anios_ultima_promocion, family = "binomial",
## data = data_rotacion4)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.6101 -0.6101 -0.6018 -0.5543 2.0769
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.58703 0.08501 -18.670 <2e-16 ***
## Anios_ultima_promocion -0.02979 0.02358 -1.263 0.206
## ---
## 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: 1296.9 on 1468 degrees of freedom
## AIC: 1300.9
##
## Number of Fisher Scoring iterations: 4Se puede ver que el modelo lineal de Rotacion vs ultima promocion es: -1.5 - 0.02*Anios_ultima_promocion, lo cual muestra hay una relación lineal negativa entre el tiempo desde la ultima promoción y la rotación, sin embargo, este modelo no indica la probabilidad de rotación según el comportamiento de la ultima promoción, para ello, se debe transformar a un modelo de regresión logistica.
Este comportamiento esta alineado con la hipotesis inicial, en la cual se decia que había una relación inversa entre la rotación y el tiempo hasta la ultima promoción.
3.2 Modelos generales lineales para variables cualitativas
Modelo de regresión lineal general de Rotación vs Satisfacción laboral
mod_sas = glm(Rotacion ~ Satisfacion_Laboral, data= data_rotacion4, family="binomial")
summary(mod_sas)##
## Call:
## glm(formula = Rotacion ~ Satisfacion_Laboral, family = "binomial",
## data = data_rotacion4)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.7201 -0.6008 -0.5991 -0.4904 2.0870
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.2175 0.1401 -8.689 < 2e-16 ***
## Satisfacion_Laboral2 -0.4092 0.2137 -1.915 0.0555 .
## Satisfacion_Laboral3 -0.4028 0.1899 -2.122 0.0339 *
## Satisfacion_Laboral4 -0.8401 0.2033 -4.132 3.59e-05 ***
## ---
## 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: 1281.2 on 1466 degrees of freedom
## AIC: 1289.2
##
## Number of Fisher Scoring iterations: 4Se puede ver que el intercepto es-1.2, y que a medida que avanza la satisfacción laboral, se incrementa un descenso en la rotación. Este efecto esta alineado con la hipotesis inicial, en la cual se pensaba que a mayor satisfacción laboral, menor rotación.sin embargo, este modelo solo explica la parte lineal, para describir la probabilida de rotación según la satisfacción laboral se debe hacer un modelo de regresión logistica.
Modelo de regresión lineal general de Rotación vs Horas_Extra
mod_horas = glm(Rotacion ~ Horas_Extra, data= data_rotacion4, family="binomial")
summary(mod_horas)##
## Call:
## glm(formula = Rotacion ~ Horas_Extra, family = "binomial", data = data_rotacion4)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.8535 -0.4695 -0.4695 -0.4695 2.1260
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.1496 0.1007 -21.338 <2e-16 ***
## Horas_ExtraSi 1.3274 0.1466 9.056 <2e-16 ***
## ---
## 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: 1217.2 on 1468 degrees of freedom
## AIC: 1221.2
##
## Number of Fisher Scoring iterations: 4Se puede ver que el intercepto es-2.1, el cual es cuando NO hay horas extra, situación que disminuiría la rotación, por otro lado, cuando SI hay horas extra, se le suma 1.32 al intercepto, aumentando la probabilidad de rotacion. Este efecto esta alineado con la hipotesis inicial.
Modelo de regresión lineal general de Rotación vs Equilibrio_Trabajo_Vida
mod_equilibrio = glm(Rotacion ~ Equilibrio_Trabajo_Vida, data= data_rotacion4, family="binomial")
summary(mod_equilibrio)##
## Call:
## glm(formula = Rotacion ~ Equilibrio_Trabajo_Vida, family = "binomial",
## data = data_rotacion4)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.8657 -0.6077 -0.5539 -0.5539 1.9750
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.7885 0.2412 -3.269 0.001080 **
## Equilibrio_Trabajo_Vida2 -0.8071 0.2809 -2.873 0.004066 **
## Equilibrio_Trabajo_Vida3 -1.0085 0.2595 -3.886 0.000102 ***
## Equilibrio_Trabajo_Vida4 -0.7520 0.3212 -2.341 0.019215 *
## ---
## 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: 1284.5 on 1466 degrees of freedom
## AIC: 1292.5
##
## Number of Fisher Scoring iterations: 4En el caso de equilibrio trabajo-vida, no es claro el efecto de esta variable en la rotación, ya que es una variable cualitativa ordinal, con el intercepto en trabajo_vida = 1 con -0.7, pero al avanzar el indice hasta trabajo_vida = 4 es de -0.75, lo cual no esta alineado con la hipotesis inicial, en la cual se esperaba que al aumentar el nivel de equilibrio entre el trabajo y la vida disminuyera la rotación.
4.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 regresión lineal
data_rotacion4$Horas_Extra## [1] Si No Si Si No No Si No No No No Si No No Si No Si Si No Si No No No No
## [25] No No Si No No No No Si No No Si No Si No Si No No No No No No No No No
## [49] Si No Si Si Si Si Si Si No Si No No Si No Si No No Si No No No Si No No
## [73] No No No No No Si No Si Si No No Si No No No No No No No Si Si Si No No
## [97] No No No No Si No Si No No No Si Si No No No Si Si No No No No No No Si
## [121] No No Si No Si No No Si No No No No Si Si No No No No No Si No No Si No
## [145] No No No No No No No No Si No No No No Si No No No No No Si Si No No No
## [169] No No Si No No No Si Si No No No No Si No Si No No No No No No No No No
## [193] Si No No Si No No No No No Si Si Si Si No Si No No No No No No No Si Si
## [217] No No No No No No Si No No No No No No Si No No No No Si Si No Si No Si
## [241] No No No No No No No No No No No No No Si No No Si No No No No No No Si
## [265] No No No No Si No Si Si No No No Si No Si No No Si No No Si Si No Si No
## [289] Si No Si No No Si Si No No No No No No No No No No No No No Si Si No No
## [313] Si No Si No Si No Si Si Si No No Si No No No Si No No No Si No No No Si
## [337] Si No No No No Si Si Si No No Si No No No Si No No Si Si No No Si No No
## [361] No Si No Si No No No No Si Si No No No No No No No No Si Si Si No No No
## [385] No Si No No No Si No No No No No No Si Si Si No Si No No No No No Si No
## [409] No No No No No No Si No Si No No No No No No No No No No No No No No No
## [433] No Si No Si No No Si No Si No No No No No No No No No Si Si No Si No No
## [457] No Si No Si No No No Si No No No No Si No No No No Si Si No No No No Si
## [481] No Si No No No No Si No No Si No Si No No Si No No Si No No Si No No No
## [505] No Si No No No No No Si No Si Si No No No No No No Si No Si No No No No
## [529] Si No No No No Si No No No No No No Si No Si No Si No No Si No No No No
## [553] No Si No No No No No Si No No Si No No No Si No Si No No No No No No Si
## [577] No Si Si No No No No No No Si No No No Si No No Si No No Si No Si No No
## [601] No No Si No No No No No No No Si No Si No Si No No No No No No Si No No
## [625] Si Si No No No No No Si Si No Si Si Si No No No No No No Si Si Si No No
## [649] No No No Si Si No No Si Si No Si No Si No No No Si Si Si Si No Si No No
## [673] No Si Si No Si No No No No No No Si No No Si No Si No Si Si No Si No No
## [697] No No No No No No No Si No No Si Si No Si No Si No No No Si No No Si Si
## [721] Si Si No No No Si No No No Si Si Si No No No No No No No No No No No Si
## [745] No Si No Si No No Si No No Si No No No No Si No No No Si Si No No Si No
## [769] No No No No No No No No Si No Si Si No No No No No No No No No No No Si
## [793] No No No Si Si No Si No No Si No No No No No Si No No No No No No No Si
## [817] No No No No No No No No No Si No Si No Si Si No No No No No No No Si No
## [841] No No Si No No Si No No No No No No No No Si No No Si No Si Si No No No
## [865] No No No No No No Si No No No No No No No No Si No Si Si No No No Si Si
## [889] Si Si No No Si No No Si No No No No No No No Si No No No No Si Si No Si
## [913] Si Si Si No No Si Si No No Si No No Si Si No Si No Si No Si Si No No No
## [937] No Si No No No No No No No Si Si Si Si No Si No Si No Si No No No No No
## [961] No Si Si No No No Si No No No No No No No No Si Si No No No No Si No No
## [985] No Si Si No Si Si No Si No No Si Si Si Si No No No No No No No No No Si
## [1009] No Si No Si No No No No No No No No No No No No No Si No No Si No No No
## [1033] Si No Si No Si Si No No No No No No No No No No No No No No No No No No
## [1057] No No Si No Si No Si No No Si No Si No No No No No No Si No No No No No
## [1081] No No No No Si No Si Si No No No No No Si No Si Si No Si No No No Si No
## [1105] No No No No No No Si No No No No No No No No No No No Si Si No No Si No
## [1129] Si No No No No No No No Si Si Si No Si No Si No No Si No No No No No No
## [1153] No Si No No No No No No No Si No No Si Si No Si Si No No Si No No No No
## [1177] No No No No No Si No No No No Si No Si No No No Si No No No Si No Si No
## [1201] Si Si No No Si No No No No No No No No Si Si Si Si No No No No No No No
## [1225] No No No No No Si No No No No No Si Si No No No Si No No No No No No No
## [1249] No No Si No Si No No Si No No No No No Si Si No No No No Si Si No No No
## [1273] No Si No No No Si Si Si No Si No No No No No No No No No No No No No Si
## [1297] No Si No No No No No Si No No No No Si No Si No No Si No Si No Si No No
## [1321] No No No No No No Si No No No No No Si No No No No No No Si Si No Si No
## [1345] Si Si No No No Si No No No Si No No No No Si Si No No No No Si No No No
## [1369] Si Si No No No Si Si Si No No Si No No No Si No No No No No No No No No
## [1393] Si No No Si Si No No No Si Si Si No No No Si No No No No No No Si No No
## [1417] No No No Si No No Si No No Si No No No No No No Si Si No Si Si No No No
## [1441] No No Si No No No No No No No Si No No No No No Si No No Si No Si No No
## [1465] No No No Si No No
## Levels: No Simod_6v = glm(Rotacion ~.,data=data_rotacion4, family="binomial")
summary(mod_6v)##
## Call:
## glm(formula = Rotacion ~ ., family = "binomial", data = data_rotacion4)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4660 -0.5843 -0.4183 -0.2817 2.9228
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.230817 0.446280 2.758 0.00582 **
## Satisfacion_Laboral2 -0.422802 0.229022 -1.846 0.06487 .
## Satisfacion_Laboral3 -0.437604 0.202704 -2.159 0.03086 *
## Satisfacion_Laboral4 -1.054632 0.219189 -4.812 1.50e-06 ***
## Horas_ExtraSi 1.500428 0.156069 9.614 < 2e-16 ***
## Equilibrio_Trabajo_Vida2 -0.981733 0.301476 -3.256 0.00113 **
## Equilibrio_Trabajo_Vida3 -1.236092 0.278833 -4.433 9.29e-06 ***
## Equilibrio_Trabajo_Vida4 -0.851556 0.345135 -2.467 0.01361 *
## Edad -0.061509 0.009451 -6.508 7.59e-11 ***
## Distancia_Casa 0.026483 0.009099 2.910 0.00361 **
## Anios_ultima_promocion 0.009626 0.025856 0.372 0.70968
## ---
## 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: 1122.4 on 1459 degrees of freedom
## AIC: 1144.4
##
## Number of Fisher Scoring iterations: 5Se puede apreciar que las variables significativas son:
-Horas_Extra -Equilibrio_Trabajo_Vida -Edad -Distancia_Casa -Satisfaccion_Laboral
Las variables que no son significativas son:
-Anios_ultima_promocion
Interpretación de probabilidades de evento “Rotación”
exp(mod_6v$coefficients)## (Intercept) Satisfacion_Laboral2 Satisfacion_Laboral3
## 3.4240254 0.6552084 0.6455812
## Satisfacion_Laboral4 Horas_ExtraSi Equilibrio_Trabajo_Vida2
## 0.3483207 4.4836092 0.3746614
## Equilibrio_Trabajo_Vida3 Equilibrio_Trabajo_Vida4 Edad
## 0.2905175 0.4267506 0.9403445
## Distancia_Casa Anios_ultima_promocion
## 1.0268366 1.0096723Interpretando los coeficientes de ODDs Ratio, se tiene que si un coeficiente es >1,quiere decir que hay una relación POSTIVIA entre la variable independiente y la probabilidad de exito (Rotación == 1), cuando =1, quiere decir que la variable independiente no influye en la probabilidad de exito, y cuando es <1, quiere decir que hay una relación NEGATIVA entre la variable independiente y la probabilidad de exito.
Se puede ver que:
-Horas_Extra == “Si” tiene un efecto POSITIVO grande (4) en incrementar la probabilidad de Rotación -Edad tiene un efecto negativo en la probabilidad de Rotación, de tal manera que a mayor edad, menor probabilidad de rotar. -Distancia_Casa tiene un efecto POSTIVO en la probabilidad de Rotación, de tal manera que a mayor distancia a casa, aumenta levemente la probabilidad de rotar. -Satisfaccion_Laboral tiene un efecto NEGATIVO en la probabilidad de Rotación, ya que al aumentar el nivel de satisfacción laboral (S_L=4), disminuye la probabilidad de rotar (coeficiente=0.34) -Equilibrio_Vida tiene una relación negativa con la probabilidad de rotar, ya que al aumentar el nivel de equilibrio (EV=4) se disminuye la probabilidad de rotar (coeficiente=0.42)
5.Evaluar el poder predictivo del modelo con base en la curva ROC y el AIC.
Se puede ver que el modelo propuesto con las 6 variables evaluadas según las hipotesis iniciales tiene un AIC de 1144.
table_mod6v <-table(data_rotacion4$Rotacion)
table_mod6v##
## 0 1
## 1233 2375.1 Creación de Test y Train
#make this example reproducible
set.seed(1)
#use 70% of dataset as training set and 30% as test set
sample <- sample(c(TRUE, FALSE), nrow(data_rotacion4), replace=TRUE, prob=c(0.6,0.4))
train <- data_rotacion4[sample, ]
test <- data_rotacion4[!sample, ]
nrow(data_rotacion4)## [1] 1470head(test)## # A tibble: 6 × 7
## Rotacion Satisfacion_Laboral Horas_Extra Equilibrio_Trabajo_Vida Edad
## <dbl> <fct> <fct> <fct> <dbl>
## 1 0 3 Si 3 33
## 2 0 4 No 2 32
## 3 0 1 Si 2 59
## 4 0 3 No 3 30
## 5 0 3 No 3 38
## 6 0 3 No 2 31
## # ℹ 2 more variables: Distancia_Casa <dbl>, Anios_ultima_promocion <dbl>head(train)## # A tibble: 6 × 7
## Rotacion Satisfacion_Laboral Horas_Extra Equilibrio_Trabajo_Vida Edad
## <dbl> <fct> <fct> <fct> <dbl>
## 1 1 4 Si 1 41
## 2 0 2 No 3 49
## 3 1 3 Si 3 37
## 4 0 2 No 3 27
## 5 0 3 No 2 36
## 6 0 2 No 3 35
## # ℹ 2 more variables: Distancia_Casa <dbl>, Anios_ultima_promocion <dbl>table_mod6v <-table(test$Rotacion)
table_mod6v##
## 0 1
## 469 985.2 Análisis de la matriz de confusión:
probas_mod1 = mod_6v$fitted.values
rotacion_mod1 = as.factor(as.numeric(probas_mod1 > 0.17))
rotacion_real = data_rotacion4$Rotacion
mcRotacion=table(rotacion_real,rotacion_mod1)
mcRotacion## rotacion_mod1
## rotacion_real 0 1
## 0 901 332
## 1 84 153desempeño = round(sum(diag(mcRotacion))/sum(mcRotacion)*100,1)
desempeño## [1] 71.7El modelo de las 6 variables escogidas tiene un desempeño del 71%
rendimiento_data <- data.frame(rotacion_real,rotacion_mod1)
positivos <- sum(rotacion_real=="1")
negativos <- sum(rotacion_real=="0")
positivos_pronosticados <- sum(rotacion_mod1=="1")
negativos_pronosticados <- sum(rotacion_mod1=="0")
total <- nrow(rendimiento_data)
TP <- sum(rotacion_real=="1" & rotacion_mod1=="1")
TN <- sum(rotacion_real=="0" & rotacion_mod1=="0")
FP <- sum(rotacion_real=="0" & rotacion_mod1=="1")
FN <- sum(rotacion_real=="1" & rotacion_mod1=="0")## Evaluación del modelo
Exactitud <- (TP+TN)/total
Tasa_de_Error <- (FP+FN)/total
Sensibilidad <- TP/positivos
Especificidad <- TN/negativos
Precision <- TP/positivos_pronosticados
Valor_prediccion_negativo <- TN / negativos_pronosticados
indicadores <- t(data.frame(Exactitud,Tasa_de_Error,Sensibilidad,Especificidad,Precision,Valor_prediccion_negativo))
indicadores %>% round(.,3)## [,1]
## Exactitud 0.717
## Tasa_de_Error 0.283
## Sensibilidad 0.646
## Especificidad 0.731
## Precision 0.315
## Valor_prediccion_negativo 0.915Se puede ver que la precisión del modelo con 6 variables inicialmente escogidas es del 31%, y la exactitud es del 71%, la sensibilidad (% de positivos que son clasificados por el modelo como positivos) es del 64%, mientras que la espeficididad fue del 73%.
5.3 Curva ROC
#Curva ROC
library(pROC)## Warning: package 'pROC' was built under R version 4.2.3## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varcurva_ROC <- roc(as.numeric(rotacion_real), as.numeric(rotacion_mod1))## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc<- round(auc(curva_ROC, levels =c(0,1), direction = "<"),4) # 0.9177
ggroc(curva_ROC, colour = "#FF7F00", size=2)+
ggtitle(paste0("Curva ROC ", "(AUC = ", auc, ")"))+
xlab("Especificidad")+
ylab("Sensibilidad") 
6. 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(mod_6v,list(Edad=20,Satisfacion_Laboral="1",Equilibrio_Trabajo_Vida="2",Distancia_Casa=4,Horas_Extra="Si",Anios_ultima_promocion=4),type="response")## 1
## 0.660106317%, en este caso, la proabilidad de rotación fue del 66%, por ende, este empleado se considera en riesgo de rotación, para ello, se deberían quitar las horas extra, se debería darle una promoción, ya que lleva 4 años desde su ultimo ascenso y se debería mejorar su nivel de equilibrio-vida respetando la asignación de tareas en horario laboral
7. 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).
Conclusiones
- Se concluye que la empresa debería tener una politica de buen ambiente laboral, tener un programa de crecimiento laboral, en el cual, se les den oportunidades de ascenso a los trabajadores según sus desempeños y el tiempo en el compañia.
Problema 2
glimpse(creditos)## Rows: 780
## Columns: 5
## $ default <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ antiguedad <dbl> 37.317808, 37.317808, 30.978082, 9.728767, 8.443836, 6.6054…
## $ edad <dbl> 76.98356, 73.77534, 78.93699, 51.52877, 38.96986, 44.87945,…
## $ cuota <dbl> 3020519, 1766552, 1673786, 668479, 1223559, 3517756, 130479…
## $ ingresos <dbl> 8155593, 6181263, 4328075, 5290910, 5333818, 2710736, 31697…Se procede a castear la variable “Default” cómo categórica
data_credito <- creditos
data_credito$default = as.factor(data_credito$default)
glimpse(data_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,…
## $ antiguedad <dbl> 37.317808, 37.317808, 30.978082, 9.728767, 8.443836, 6.6054…
## $ edad <dbl> 76.98356, 73.77534, 78.93699, 51.52877, 38.96986, 44.87945,…
## $ cuota <dbl> 3020519, 1766552, 1673786, 668479, 1223559, 3517756, 130479…
## $ ingresos <dbl> 8155593, 6181263, 4328075, 5290910, 5333818, 2710736, 31697…Creación del modelo completo con todas las variables
mod_completoCred = glm(default ~.,data=data_credito,family="binomial")
summary(mod_completoCred)##
## Call:
## glm(formula = default ~ ., family = "binomial", data = data_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 ***
## antiguedad -4.616e-02 2.353e-02 -1.961 0.049849 *
## edad 2.229e-02 1.932e-02 1.154 0.248641
## cuota 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 puede ver que las variables “antiguedad” e “ingresos” tienen una relación NEGATIVA con la probabilidad de defalult (a medida que aumentan estas variables disminuye la probabilidad de default), mientras que las variables “edad” y “cuota” tienen una relación POSITIVA con la probabilidad de default.
Se puede ver que la única variable que no es significativa para el modelo es la edad, por ende, se decide quitar del modelo final.
Análisis de coeficientes
exp(mod_completoCred$coefficients)## (Intercept) antiguedad edad cuota ingresos
## 0.04105509 0.95489160 1.02254364 1.00000101 0.99999974Al analizar los coeficientes de ODDs Ratio se puede ver que:
- Al aumentar la antiguedad crediticia, se disminuye la probabilidad de Default.
- Al aumentar la edad, se aumenta la probabilidad de default
- Al aumentar los ingresos, disminuye la probabilidad de dafault
Optimización del modelo por metodo “Backward”
step(mod_completoCred,direction="backward")## Start: AIC=297.49
## default ~ antiguedad + edad + cuota + ingresos
##
## Df Deviance AIC
## - edad 1 288.79 296.79
## <none> 287.49 297.49
## - antiguedad 1 291.28 299.28
## - ingresos 1 294.76 302.76
## - cuota 1 304.34 312.34
##
## Step: AIC=296.78
## default ~ antiguedad + cuota + ingresos
##
## Df Deviance AIC
## <none> 288.79 296.79
## - antiguedad 1 291.37 297.37
## - ingresos 1 295.61 301.61
## - cuota 1 304.95 310.95##
## Call: glm(formula = default ~ antiguedad + cuota + ingresos, family = "binomial",
## data = data_credito)
##
## Coefficients:
## (Intercept) antiguedad cuota ingresos
## -2.244e+00 -2.817e-02 9.860e-07 -2.542e-07
##
## Degrees of Freedom: 779 Total (i.e. Null); 776 Residual
## Null Deviance: 309.7
## Residual Deviance: 288.8 AIC: 296.8Se puede ver que el AIC aumenta mas cuando se quitan las variables “Cuota”, “Ingresos” y “antiguedad”, por ende, estas son las 3 variables que tienen mayor explicabilidad para la variable objetivo Default.
mod_cred_final = glm(default~ antiguedad + cuota + ingresos, data=data_credito,family = "binomial")
summary(mod_cred_final)##
## Call:
## glm(formula = default ~ antiguedad + cuota + ingresos, family = "binomial",
## data = data_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 ***
## antiguedad -2.817e-02 1.803e-02 -1.562 0.1183
## cuota 9.860e-07 2.456e-07 4.014 5.96e-05 ***
## ingresos -2.542e-07 1.059e-07 -2.400 0.0164 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 309.68 on 779 degrees of freedom
## Residual deviance: 288.78 on 776 degrees of freedom
## AIC: 296.78
##
## Number of Fisher Scoring iterations: 6Creación de test y train
#make this example reproducible
set.seed(1)
#use 70% of dataset as training set and 40% as test set
sample <- sample(c(TRUE, FALSE), nrow(data_credito), replace=TRUE, prob=c(0.6,0.4))
trainC <- data_credito[sample, ]
testC <- data_credito[!sample, ]
nrow(data_credito)## [1] 780Análisis de matriz de confusión
table_ <-table(data_credito$default)
table_##
## 0 1
## 741 39Se tiene una proporción del 5% de los casos con default
probas_mod2 = mod_cred_final$fitted.values
default_mod = as.factor(as.numeric(probas_mod2 > 0.10))
default_real = data_credito$default
mcCreditos=table(default_real,default_mod)
mcCreditos## default_mod
## default_real 0 1
## 0 698 43
## 1 31 8round(sum(diag(mcCreditos))/sum(mcCreditos)*100,1)## [1] 90.5rendimiento_data <- data.frame(default_real,default_mod)
positivos <- sum(default_real=="1")
negativos <- sum(default_real=="0")
positivos_pronosticados <- sum(default_mod=="1")
negativos_pronosticados <- sum(default_mod=="0")
total <- nrow(rendimiento_data)
TP <- sum(default_real=="1" & default_mod=="1")
TN <- sum(default_real=="0" & default_mod=="0")
FP <- sum(default_real=="0" & default_mod=="1")
FN <- sum(default_real=="1" & default_mod=="0")## Evaluación del modelo
Exactitud <- (TP+TN)/total
Tasa_de_Error <- (FP+FN)/total
Sensibilidad <- TP/positivos
Especificidad <- TN/negativos
Precision <- TP/positivos_pronosticados
Valor_prediccion_negativo <- TN / negativos_pronosticados
indicadores <- t(data.frame(Exactitud,Tasa_de_Error,Sensibilidad,Especificidad,Precision,Valor_prediccion_negativo))
indicadores %>% round(.,3)## [,1]
## Exactitud 0.905
## Tasa_de_Error 0.095
## Sensibilidad 0.205
## Especificidad 0.942
## Precision 0.157
## Valor_prediccion_negativo 0.957Se puede ver que la precisión del modelo con 6 variables inicialmente escogidas es del 15%, y la exactitud es del 90%, la sensibilidad (% de positivos que son clasificados por el modelo como positivos) es del 20%, mientras que la espeficididad fue del 94%.
Curva ROC
curva_ROC <- roc(as.numeric(default_real), as.numeric(default_mod))## Setting levels: control = 1, case = 2## Setting direction: controls < casesauc<- round(auc(curva_ROC, levels =c(0,1), direction = "<"),4) # 0.9177
ggroc(curva_ROC, colour = "#FF7F00", size=2)+
ggtitle(paste0("Curva ROC ", "(AUC = ", auc, ")"))+
xlab("Especificidad")+
ylab("Sensibilidad") 