Objetivo

Realizar e interpretar regresión logísitica con datos de personas e ingresos de USA

Descripción

Construir un modelo de regresión logísitca aplicado a datos de personas y sus ingresos en USA. La variable dependiente es los ingresos identificado por 0 y 1, los ganan por debajo o igual a 50 Mil y los que ganan por encima de 50 Mil.

Proceso

1. Cargar librerias

library(ggplot2)
library(dplyr)
library(knitr)
library(caret)
library(readr)
library(knitr)
library(DT) # install.packages('DT')

2. Cargar datos

 datos <- read.csv("https://raw.githubusercontent.com/rpizarrog/FundamentosMachineLearning/master/datos/adultos_clean.csv", encoding = "UTF-8")

# datos <- read.csv("../datos/adultos_clean.csv")

# kable(head(datos))
# kable(tail(datos))
datatable(datos, caption = "Los datos", options = list(pageLength = 10))
## Warning in instance$preRenderHook(instance): It seems your data is too big
## for client-side DataTables. You may consider server-side processing: https://
## rstudio.github.io/DT/server.html

3. Las variables

  • age la edad de la persona
  • workclass es un tipo o clase de trabajo de la persona, privado, gobierno, por su cuenta,
  • education indica el nivel educativo de la persona
  • educational es el valor numérico de education
  • marital.status es su estado civil
  • race es el tipo de raza de persona
  • gender es el género de la persona
  • hours.per.week son las horas que trbaja por semana income son los ingresos
  • age_scale la edad escalada
  • hours.per.week escalada
  • income10 con valores de 0 gana menos de 50 mil y 1 mas de 50 mil

4. Crear datos de entrenamiento y validación

70 % datos de entrenamiento 30 % datos de validación

set.seed(2020)
entrena <- createDataPartition(y = datos$income10, p = 0.7, list = FALSE, times = 1)

# Datos entrenamiento
datos.entrenamiento <- datos[entrena, ]  # [renglones, columna]

# Datos validación
datos.validacion <- datos[-entrena, ]

# kable(head(datos.entrenamiento, 10), caption = "Datos de entrenamiento  (primeros diez)", row.names = 1:nrow(datos.entrenamiento))

# kable(head(datos.validacion, 10), caption = "Datos de validación  (primeros diez)", row.names = 1:nrow(datos.entrenamiento))

datatable(datos.entrenamiento, caption = "Datos de entrenamiento", options = list(pageLength = 10))
## Warning in instance$preRenderHook(instance): It seems your data is too big
## for client-side DataTables. You may consider server-side processing: https://
## rstudio.github.io/DT/server.html
datatable(datos.validacion, caption = "Datos de entrenamiento",options = list(pageLength = 10))
## Warning in instance$preRenderHook(instance): It seems your data is too big
## for client-side DataTables. You may consider server-side processing: https://
## rstudio.github.io/DT/server.html

5. Crear modelo de regresión logística

  • Con la regresión logística, dado un conjunto particular de valores de las variables independientes elegidas, se estima la probabilidad de los ingresos de una persona ‘<=50’ o ‘>50’ o lo que es lo mismo ingresos con valores de 0 y 1 en la variable income10.

  • Por medio de la función gml() se contruye un modelo de regresión logística

  • Variable dependiente o predictiva es ‘income10’, ya que depende de todas las demás variables

  • Variables independientes o predictoras, todas las demás: “age”, “workclass”, “education”, “educational.num”, “marital.status”, “race”, “gender”, “hours.per.week”

  • Se utiliza el conjunto de datos de entrenamiento

  • La finalidad de consruir el modelo de regresión logística es entre otros cosas, para conocer los coeficienes y el nivel de significación de cada variable independiente o predictora así como las pruebas t y F

La ecuación \[income10=age.scale+workclass+education+marital.status+race+gender+hours.per.week.scale\]

  • Se asigna a una variable formula y se utiliza para construir el modelo,

  • Significa que la variable ‘income10’ depende o es dependiente de todas las demás variables

  • La fórmula dada por la ecuacuación:

formula = income10 ~ age.scale + workclass + education + marital.status + race + gender + hours.per.week.scale

modelo <- glm(formula, data = datos.entrenamiento, family =  'binomial')

6. Analizar y describir el modelo

summary(modelo)
## 
## Call:
## glm(formula = formula, family = "binomial", data = datos.entrenamiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.7548  -0.5778  -0.2603  -0.0684   3.3249  
## 
## Coefficients:
##                           Estimate Std. Error z value Pr(>|z|)    
## (Intercept)               -2.76730    0.23517 -11.767  < 2e-16 ***
## age.scale                  2.04720    0.10474  19.546  < 2e-16 ***
## workclassFederal-gov       1.39346    0.12545  11.107  < 2e-16 ***
## workclassLocal-gov         0.76117    0.11093   6.862 6.79e-12 ***
## workclassNever-worked     -7.98118   98.02680  -0.081  0.93511    
## workclassPrivate           0.88906    0.09705   9.161  < 2e-16 ***
## workclassSelf-emp-inc      1.32433    0.11899  11.130  < 2e-16 ***
## workclassSelf-emp-not-inc  0.31448    0.10762   2.922  0.00348 ** 
## workclassState-gov         0.48978    0.12316   3.977 6.99e-05 ***
## workclassWithout-pay       0.15627    0.85256   0.183  0.85457    
## educationCommunity        -1.00153    0.04434 -22.589  < 2e-16 ***
## educationDropout          -2.69532    0.07543 -35.731  < 2e-16 ***
## educationHighGrad         -1.58616    0.04511 -35.164  < 2e-16 ***
## educationMaster            0.59823    0.06103   9.803  < 2e-16 ***
## educationPhD               1.22350    0.13962   8.763  < 2e-16 ***
## marital.statusNot_married -2.53858    0.05407 -46.948  < 2e-16 ***
## marital.statusSeparated   -2.10873    0.05619 -37.531  < 2e-16 ***
## marital.statusWidow       -2.10698    0.12348 -17.064  < 2e-16 ***
## raceAsian-Pac-Islander     0.32012    0.21854   1.465  0.14298    
## raceBlack                  0.34440    0.20941   1.645  0.10005    
## raceOther                  0.26768    0.28964   0.924  0.35540    
## raceWhite                  0.58693    0.20059   2.926  0.00343 ** 
## genderMale                 0.10151    0.04450   2.281  0.02252 *  
## hours.per.week.scale       3.05128    0.13834  22.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: 37584  on 34189  degrees of freedom
## Residual deviance: 25090  on 34166  degrees of freedom
## AIC: 25138
## 
## Number of Fisher Scoring iterations: 11

La mayoría de las variables tiene in efecto estadísticamente significativo en relación a la variable dependiente, dado los ’***’.

7. Evaluar el modelo con matriz de confusión

Para evaluar el rendimiento del modelo, se crea la matriz de confusión

Una matriz de confusión es una herramienta que permite la visualización del desempeño de un algoritmo que se emplea en aprendizaje supervisado.

Cada columna de la matriz representa el número de predicciones de cada clase, mientras que cada fila representa a las instancias en la clase real.

Uno de los beneficios de las matrices de confusión es que facilitan ver si el sistema está confundiendo las diferentes clases o resultados.

Matriz de Confusión

# include_graphics("../imagenes/matriz confusion.jpg")
Comparar los valores de income10 VS valores ajustados

  • Utilizando los datos de entrenamiento

  • Tres variables income10 original con valores 0 y 1 s

  • valores ajustados

  • valores ajustados codificados 0 y 1 s aquellos cuya probabilidad sea > 0.5 o al 50%

  • Con las columnas1 y 3 se puede generar la matriz de confusión

  • ¿Qué son los valores ajustados?, es la probabilidad, si es mayor al 50% entonces es 1, si es menor o igual al 50% entoces es 0 fitted.values

  • Se observan los primeros diez y últimos diez registros

comparar <- data.frame(datos.entrenamiento$income10, as.vector(modelo$fitted.values) )

comparar <- comparar %>%
    mutate(income10ajustados = if_else (modelo$fitted.values > 0.5, 1, 0))

colnames(comparar) <- c("income10", "ajuste", 'income10ajustados')

# kable(head(comparar, 10), caption = "Comparar valores, primeros diez")

# kable(tail(comparar, 10), caption = "Comparar valores, útlimos diez")

datatable(comparar, caption = "Comparar valores", options = list(pageLength = 10))
## Warning in instance$preRenderHook(instance): It seems your data is too big
## for client-side DataTables. You may consider server-side processing: https://
## rstudio.github.io/DT/server.html
Visualizando los valores ajustados
ggplot(data = comparar, aes(x =row.names(comparar), y = ajuste, )) + 
geom_point(aes(colour = factor(income10))) + 
  geom_hline(yintercept = 0.50)

Matriz de confusión

Con los datos generados en la variable comparar se genera la matriz de confusión

matriz_confusion <- table(comparar$income10, comparar$income10ajustados, dnn = c("income10", "income10ajustados para predicciones"))

kable(matriz_confusion, caption = "Matriz de confusión")
Matriz de confusión
0 1
0 24135 1892
1 4056 4107
¿Qué significa la matriz de confusión?

  • El modelo dice que 24135 ganan por debajo de 50 Mil de los 34190 registros totales. De tal forma que le atinó a 70.59 a los VP verdaderos positivos

  • El modelo dice que 4107 ganan por encima de 50 Mil de los 34190 registros totales. De tal forma que le atinó a 12.01 a los FP verdaderos negativos

De acuerdo a estas condiciones:

  • precision \[precision=TPTP+FP\]
  • recall \[recall=TPTP+FN\]
  • accuracy \[accuracy=TP+FPn\]
  • especificity \[especificity=TNTN+FP\]

*Entonces en cuanto a exactitud (accuracy) como una forma de evaluar el modelo en los datos de entrenamiento se tiene un: 82.6, “%” que significa:

*El modelo es capaz de predecir y clasificar con exactidud al 82.6, “%”, o sea que se puede equivocar en 17.4% de los casos

8. Realizar predicciones con el conjunto de datos de validación

Se utiliza para las predicciones el conjunto de datos de validación

predicciones <- predict(object = modelo, newdata = datos.validacion, se.fit = TRUE)

predicciones.ajustadas <- predicciones$fit

kable(head(predicciones.ajustadas, 10))
x
3 -0.7964486
4 -0.4623941
6 -5.0440275
12 1.0617147
19 -3.8320026
25 0.2488330
26 0.2057424
29 -0.6797358
41 2.2801743
42 0.3710815
  • Determinar los valores probabilísticos de las prediccones \[exp(prediccionesfit)(1−exp(predicciones4fit)\]
predicciones_prob <- exp(predicciones$fit) / (1 + exp(predicciones$fit))

kable(head(predicciones_prob))
x
3 0.3107857
4 0.3864180
6 0.0064064
12 0.7430181
19 0.0212067
25 0.5618892
Evaluar el modelo de predicción
  • Agregar una columna de la predicción al final del conjunto de datos de validación
  • Agregar una columna de los datos de validación con los valores probabilísticos de las predicciones con cbind() y con un uevo conjunto de datos llamado las .predicciones
  • Agregar columna con valor 1 cuando la predicción es mayor que 0.5 y 0 cuando la predicción es menor o igual a 0.5
  • Verificar las columnas income10 e income10.prediccion
las.predicciones <- cbind(datos.validacion, predicciones_prob)

las.predicciones <- las.predicciones %>%
  mutate(income10.prediccion =  if_else(predicciones_prob > 0.5, 1, 0))
  
kable(head(las.predicciones))
X age workclass education educational.num marital.status race gender hours.per.week income age.scale educational.num.scale hours.per.week.scale income10 predicciones_prob income10.prediccion
3 28 Local-gov Community 12 Married White Male 40 >50K 0.1506849 0.7333333 0.3979592 1 0.3107857 0
4 44 Private Community 10 Married Black Male 40 >50K 0.3698630 0.6000000 0.3979592 1 0.3864180 0
6 34 Private Dropout 6 Not_married White Male 30 <=50K 0.2328767 0.3333333 0.2959184 0 0.0064064 0
12 36 Federal-gov Bachelors 13 Married White Male 40 <=50K 0.2602740 0.8000000 0.3979592 0 0.7430181 1
19 37 Private HighGrad 9 Widow White Female 20 <=50K 0.2739726 0.5333333 0.1938776 0 0.0212067 0
25 25 Private Bachelors 13 Married White Male 40 <=50K 0.1095890 0.8000000 0.3979592 0 0.5618892 1
  • Matriz de confusión de las predicciones
matriz_confusion <- table(las.predicciones$income10, las.predicciones$income10.prediccion, dnn = c("income10", "predicciones"))
matriz_confusion
##         predicciones
## income10     0     1
##        0 10361   767
##        1  1752  1772
  • Evaluando la matriz de confusión de las predicciones
n <- sum(matriz_confusion)
exactitud <- round(sum(matriz_confusion[1,1], matriz_confusion[2,2]) / n * 100,2)


paste("Las predicciones la atinan al ", exactitud, "%","de los casos")
## [1] "Las predicciones la atinan al  82.81 % de los casos"

Interpretacion del caso

Para este caso de analisis de datos hicimos uso de un conjunto de datos de personas que viven en USA (Estados Unidos de America). El proposito de nuestro modelo es construir una regresion logistica segun los ingresos de las personas. Como variable dependiente usaremos los ingresos identificados con 0 y 1 ( 0 = los que ganan <= a 50 mil y 1 = los que ganan > a 50 mil). Y como variables independientes usaremos la age, workclass, education, marital.status, race, gender, hours.per.week, etc.

Con el modelo de regresion logistica se estima sacar la probabilidad de los ingresos de una persona, donde la variable predictiva es income 10 ya que depende de todas las demas variables.

Segun nuestro modelo se puede ver que la mayoria de las variables tienen un efecto estadisticamente significativo en relacion a la variable dependiente ya que encontramos los tres asteriscos ( *** ). Como precision de nuestro modelo obtenemos un 82% lo cual lo hace fiable.

Por otro lado la matriz de confusion nos dice que 24135 ganan por debajo de 50 Mil de los 34190 registros en el conjunto de datos, de tal forma que le atinó a 70.59 a los VP verdaderos positivos y que 4107 ganan por encima de 50 Mil de los 34190 registros en el conjunto de datos. De tal forma que le atinó a 12.01 a los FP verdaderos negativos