Caso 11

Objetivo:

Realizar un modelo de regresión logística con datos de personas con sus ingresos en USA.

Descripción:

Construir un modelo de regresión logística aplicado a datos de personas con sus ingresos en USA. La variable dependiente es el ‘ingreso’ y es representado por ‘0 y 1’. 0 si ganan por debajo o igual a 50 mil y 1 si ganan por encima de 50 mil.

Proceso

1. Cargar librerías.
1. Cargar datos.
1. Identificar variables.
1. Partición de datos (entrenamiento y validación)
1. Crear modelo de regresión logística.
1. Analizar/describir el modelo.
1. Evaluación del modelo con matríz de confusión.
1. Interpretar el caso.

1. Cargar librerías.

library(ggplot2)
library(dplyr)
library(knitr)
library(caret)
library(readr)
library(knitr)

2. Cargar datos.

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

kable(head(income_data))

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	25	Private	Dropout	7	Not_married	Black	Male	40	<=50K	0.1095890	0.4000000	0.3979592	0
2	38	Private	HighGrad	9	Married	White	Male	50	<=50K	0.2876712	0.5333333	0.5000000	0
3	28	Local-gov	Community	12	Married	White	Male	40	>50K	0.1506849	0.7333333	0.3979592	1
4	44	Private	Community	10	Married	Black	Male	40	>50K	0.3698630	0.6000000	0.3979592	1
5	18	?	Community	10	Not_married	White	Female	30	<=50K	0.0136986	0.6000000	0.2959184	0
6	34	Private	Dropout	6	Not_married	White	Male	30	<=50K	0.2328767	0.3333333	0.2959184	0

kable(tail(income_data))

	X	age	workclass	education	educational.num	marital.status	race	gender	hours.per.week	income	age.scale	educational.num.scale	hours.per.week.scale	income10
48837	48837	22	Private	Community	10	Not_married	White	Male	40	<=50K	0.0684932	0.6000000	0.3979592	0
48838	48838	27	Private	Community	12	Married	White	Female	38	<=50K	0.1369863	0.7333333	0.3775510	0
48839	48839	40	Private	HighGrad	9	Married	White	Male	40	>50K	0.3150685	0.5333333	0.3979592	1
48840	48840	58	Private	HighGrad	9	Widow	White	Female	40	<=50K	0.5616438	0.5333333	0.3979592	0
48841	48841	22	Private	HighGrad	9	Not_married	White	Male	20	<=50K	0.0684932	0.5333333	0.1938776	0
48842	48842	52	Self-emp-inc	HighGrad	9	Married	White	Female	40	>50K	0.4794521	0.5333333	0.3979592	1

3. Identificar 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. Partición de datos (entrenamiento y validación)

70 - 30

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

training_data <- income_data[training,]
validation_data <- income_data[-training,]

kable(head(training_data), caption = "Datos de entrenamiento (primeros diez registros)", row.names = 1:nrow(training_data))

Datos de entrenamiento (primeros diez registros)
	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.1095890	0.4000000	0.3979592	0
2	2	38	Private	HighGrad	9	Married	White	Male	50	<=50K	0.2876712	0.5333333	0.5000000	0
5	5	18	?	Community	10	Not_married	White	Female	30	<=50K	0.0136986	0.6000000	0.2959184	0
7	7	29	?	HighGrad	9	Not_married	Black	Male	40	<=50K	0.1643836	0.5333333	0.3979592	0
8	8	63	Self-emp-not-inc	Master	15	Married	White	Male	32	>50K	0.6301370	0.9333333	0.3163265	1
9	9	24	Private	Community	10	Not_married	White	Female	40	<=50K	0.0958904	0.6000000	0.3979592	0

kable(head(validation_data), caption = "Datos de validación (primeros diez registros)", row.names = 1:nrow(validation_data))

Datos de validación (primeros diez registros)
	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.1506849	0.7333333	0.3979592	1
4	4	44	Private	Community	10	Married	Black	Male	40	>50K	0.3698630	0.6000000	0.3979592	1
6	6	34	Private	Dropout	6	Not_married	White	Male	30	<=50K	0.2328767	0.3333333	0.2959184	0
12	12	36	Federal-gov	Bachelors	13	Married	White	Male	40	<=50K	0.2602740	0.8000000	0.3979592	0
19	19	37	Private	HighGrad	9	Widow	White	Female	20	<=50K	0.2739726	0.5333333	0.1938776	0
25	25	25	Private	Bachelors	13	Married	White	Male	40	<=50K	0.1095890	0.8000000	0.3979592	0

5. Crear modelo de regresión logística.

Con la regresión logística dado un conjunto particular de valores de variables independientes elegidas, se estima la probabilidad de ingresos de una persona ‘x <= 50 o x > 50’, o similar en la variable ‘income10’ donde representamos las condiciones anteriores con 0 y 1.

Por medio de la función gml() se construye un modelo de regresión logística.
La variable dependiente o predictiva es ‘income10’, esta 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 construir un modelo de regresión logística es entre otras cosas, para conocer los coeficientes y el nivel de significancia de cada variable independiente o predictora, así como las pruebas t y F
Su ecuación sería:

\(income10 = age.scale+workclass+education+marital.status+race+gender+hours.peer.week.scale\)

Se asigna a una variable formula y se utiliza para construir el modelo.
Significa que ‘income10’ depende de todas las demás variables.
En código:

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

modelo <- glm(formula, data = training_data, family = 'binomial')

6. Analizar/describir el modelo.

summary(modelo)


Call:
glm(formula = formula, family = "binomial", data = training_data)

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 tienen valor estadísticamente significativo en relación a la variable dependiente, dado por ’***’

7. Evaluación del modelo con matríz de confusión.

Para evaluar el rendimiento del modelo, es necesario crear una matriz de confusión.

Una matriz de confusión es una herramienta que permite la visualización del desempeño de un algoritmos 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 las instancias en la clase real.

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

comparing <- data.frame(training_data$income10, as.vector(modelo$fitted.values))

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

colnames(comparing) <- c("income10", "ajuste", "income10_ajustado")

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

Comparar primeros diez valores
income10	ajuste	income10_ajustado
0	0.0053378	0
0	0.3404243	0
0	0.0082479	0
0	0.0074259	0
1	0.7482059	1
0	0.0316507	0
0	0.0731529	0
1	0.4463136	0
0	0.0183336	0
0	0.1889849	0

kable(tail(comparing, 10), caption = "Comparar primeros diez valores")

Comparar primeros diez valores
	income10	ajuste	income10_ajustado
34181	0	0.0542985	0
34182	0	0.3749281	0
34183	0	0.0553516	0
34184	0	0.4769590	0
34185	1	0.8364836	1
34186	0	0.0330729	0
34187	0	0.2972575	0
34188	1	0.2856366	0
34189	0	0.0678387	0
34190	0	0.0101232	0

conf_matrix <- table(comparing$income10, comparing$income10_ajustado, dnn = c("income10","income10_ajustado para predicciones"))

kable(conf_matrix, caption = "Matriz de confusión")

Matriz de confusión
	0	1
0	24135	1892
1	4056	4107

8. Interpretar el caso.

De la matriz de confusión podemos ver que 24,135 personas ganan por debajo de 50 mil de los 34 190 registros totales. Lo que en porcentaje quiere decir que 70.59% de los verdaderos positivos. Por otro lado, 4107 ganan por encima de 50 mil, siendo el 12.01% de los verdaderos negativos. En términos de exactitud o accuracy y tomandolo como una forma de evaluar el modelo en los datos de entrenamiento tenemos un 82.6% que nos dice que se predice y se clasifica con ese porcentaje de precisión, además solo se puede equivocar un 17.4% de los casos.