Caso 8. Regresion Logistica datos de ingresos adultos USA
Alfredo Quiñones Vasquez
18/6/2021
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 -Cargar librerías -Cargar datos -Identificar variables -Crear datos de entrenamiento y validación -Crear modelo de regresión logística -Analizar y/o describir el modelo -Evaluar el modelo con matriz de confusión -Realizar predicciones con el conjunto de datos de validación -Interpretar el caso
- Cargar librerias
library(ggplot2)
library(dplyr)
library(knitr)
library(caret)
library(readr)
library(knitr)
library(DT) # install.packages('DT')- 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.htmlLos datos
X age workclass education educational.num marital.status race gender hours.per.week income age.scale educational.num.scale hours.per.week.scale income10
1 1 25 Private Dropout 7 Not_married Black Male 40 <=50K 0.10958904109589 0.4 0.397959183673469 0
2 2 38 Private HighGrad 9 Married White Male 50 <=50K 0.287671232876712 0.533333333333333 0.5 0
3 3 28 Local-gov Community 12 Married White Male 40 >50K 0.150684931506849 0.733333333333333 0.397959183673469 1
4 4 44 Private Community 10 Married Black Male 40 >50K 0.36986301369863 0.6 0.397959183673469 1
5 5 18 ? Community 10 Not_married White Female 30 <=50K 0.0136986301369863 0.6 0.295918367346939 0
6 6 34 Private Dropout 6 Not_married White Male 30 <=50K 0.232876712328767 0.333333333333333 0.295918367346939 0
7 7 29 ? HighGrad 9 Not_married Black Male 40 <=50K 0.164383561643836 0.533333333333333 0.397959183673469 0
8 8 63 Self-emp-not-inc Master 15 Married White Male 32 >50K 0.63013698630137 0.933333333333333 0.316326530612245 1
9 9 24 Private Community 10 Not_married White Female 40 <=50K 0.0958904109589041 0.6 0.397959183673469 0
10 10 55 Private Dropout 4 Married White Male 10 <=50K 0.520547945205479 0.2 0.0918367346938776 0Las 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
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.htmlDatos de entrenamiento
X age workclass education educational.num marital.status race gender hours.per.week income age.scale educational.num.scale hours.per.week.scale income10
1 1 25 Private Dropout 7 Not_married Black Male 40 <=50K 0.10958904109589 0.4 0.397959183673469 0
2 2 38 Private HighGrad 9 Married White Male 50 <=50K 0.287671232876712 0.533333333333333 0.5 0
5 5 18 ? Community 10 Not_married White Female 30 <=50K 0.0136986301369863 0.6 0.295918367346939 0
7 7 29 ? HighGrad 9 Not_married Black Male 40 <=50K 0.164383561643836 0.533333333333333 0.397959183673469 0
8 8 63 Self-emp-not-inc Master 15 Married White Male 32 >50K 0.63013698630137 0.933333333333333 0.316326530612245 1
9 9 24 Private Community 10 Not_married White Female 40 <=50K 0.0958904109589041 0.6 0.397959183673469 0
10 10 55 Private Dropout 4 Married White Male 10 <=50K 0.520547945205479 0.2 0.0918367346938776 0
11 11 65 Private HighGrad 9 Married White Male 40 >50K 0.657534246575342 0.533333333333333 0.397959183673469 1
13 13 26 Private HighGrad 9 Not_married White Female 39 <=50K 0.123287671232877 0.533333333333333 0.387755102040816 0
14 14 58 ? HighGrad 9 Married White Male 35 <=50K 0.561643835616438 0.533333333333333 0.346938775510204 0datatable(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.htmlDatos de entrenamiento
X age workclass education educational.num marital.status race gender hours.per.week income age.scale educational.num.scale hours.per.week.scale income10
3 3 28 Local-gov Community 12 Married White Male 40 >50K 0.150684931506849 0.733333333333333 0.397959183673469 1
4 4 44 Private Community 10 Married Black Male 40 >50K 0.36986301369863 0.6 0.397959183673469 1
6 6 34 Private Dropout 6 Not_married White Male 30 <=50K 0.232876712328767 0.333333333333333 0.295918367346939 0
12 12 36 Federal-gov Bachelors 13 Married White Male 40 <=50K 0.26027397260274 0.8 0.397959183673469 0
19 19 37 Private HighGrad 9 Widow White Female 20 <=50K 0.273972602739726 0.533333333333333 0.193877551020408 0
25 25 25 Private Bachelors 13 Married White Male 40 <=50K 0.10958904109589 0.8 0.397959183673469 0
26 26 45 Self-emp-not-inc HighGrad 9 Married White Male 90 >50K 0.383561643835616 0.533333333333333 0.908163265306122 1
29 29 54 Private HighGrad 9 Married White Male 35 <=50K 0.506849315068493 0.533333333333333 0.346938775510204 0
41 41 65 Private Master 14 Married White Male 50 >50K 0.657534246575342 0.866666666666667 0.5 1
42 42 44 Self-emp-inc Community 11 Married White Male 45 >50K 0.36986301369863 0.666666666666667 0.448979591836735 1Crear 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')- 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: 11La mayoría de las variables tiene in efecto estadísticamente significativo en relación a la variable dependiente, dado los ’***’.
- 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## 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.htmlComparar valores
income10 ajuste income10ajustados
1 0 0.00533775718966519 0
2 0 0.340424332500925 0
3 0 0.00824793093699516 0
4 0 0.0074259205625787 0
5 1 0.748205925002192 1
6 0 0.0316506645316352 0
7 0 0.0731529309784818 0
8 1 0.446313637170719 0
9 0 0.0183336211334211 0
10 0 0.18898487549565 0Visualizando 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
- 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.3710815Determinar 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.5618892Evaluar 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 1Matriz 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 1772Evaluando 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.