1 Objetivo

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

2 Descripción

Construir un modelo de regresión logística 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 dólares respectivamente.

3 Fundamento teórico

La regresión lineal es una herramienta simple, útil y al mismo tiempo, su implementación no ofrece dificultad alguna. A menudo se requiere estudiar la relación de una variable respuesta, siempre y cuando esta sea continua, con la variable o variables predictoras.

Después de construir el modelo, se obtiene, entre otros, el intercept y los coeficientes asociados a la variable o variables predictoras o independientes, con estos coeficientes se podrá predecir el valor de la variable respuesta o dependiente de una observación introduciendo el valor de su variable o variables predictoras.

El modelo lineal posee bondades, también presenta algunas limitaciones. Tal como su propio nombre indica, describe la relación lineal entre las variables, por lo que el modelo no será adecuado cuando no existe una relación lineal. La regresión lineal tampoco es ideal cuando lo que se pretende es clasificar una observación entre dos clases, debido a que los valores predichos por el modelo pueden hallarse fuera del rango.

La regresión polinómica ofrece alguna solución para cuando la relación no es del todo lineal y la regresión múltiple para cuando las variables son cuantitativas.

La regresión logística ofrece solución para clasificar y para predecir valores lógicos, es decir con un valor etiquetado tal vez 0 o 1.

Para predicciones el modelo encuentra la probabilidad de ocurrencia de un evento determinado y dicha probabilidad se hallará siempre dentro del rango.

Cuando la variable respuesta posee dos categorías, entonces se estará delante de una regresión logística binaria. En cambio, si la variable respuesta posee más de dos categorías, se usará la regresión logística multinomial. (Zang, Jindu 2020). En este caso que se presenta y describe a continuación, se utiliza la regresión logística simple binomial como parte de los algoritmos supervisados de machine learning.

3.1 Regresión logística simple

La regresión logística simple, también conocida como regresión logit, es una de las herramientas que ofrece los Modelos Lineales Generalizados, GLM por sus siglas en inglés (Zang, Jindu 2020).

El modelo requiere una cantidad de variables independientes del modelo \(x_1, x_2 ... x_n\) ó \(\beta_1, \beta_2...\beta_n\).

Se debe identificar la variable dependiente \(Y\) o la variable respuesta de tipo binaria, donde cada componente de 𝑌 se distribuye mediante una distribución de Bernoulli \([ 0 | 1]\).

Se necesitan \(𝑛\) el número de observaciones.

Entonces \(𝑋 = (𝑥_1, … , 𝑥_𝑛)^T\) el conjunto de variable independientes.

Se identifica como \(\theta\) el vector de parámetros asociado al modelo, de forma que \(\theta\in R^{k+1}\) que significa que los valores del vector resultante pertenecen a cada una de las variables.

Sea \(\pi(\theta^T𝑥_𝑖)\) la probabilidad de que \(Y_i\) tome un valor igual a \(1\), entonces su modelo se puede escribir como:\[ \pi(\theta^Tx_i) = P(Y =1|X=x) = \frac{1}{1+e} \]

Si \(\theta^Tx_i\) los valores ajustados toma valores elevados y positivos, entonces … … se aproximará a 0 y, en consecuencia, el valor de la función anterior será igual a 1. En caso de que \(\theta^Tx_i\) tome valores elevados pero negativos, entonces el valor de la función será \(0\) dado que \(e ^ {\theta^Tx_i}\) tenderá a infinito. (Zang, Jindu 2020).

El valor \(e\) como número irracional y basado en la teoría de logaritmos naturales es el valor constante que se puede obtener en lenguaje R con la función exp(1) igual a 2.7182818.

Efectuando la transformación logit a la expresión inicial, se obtiene:

\[ logit(\pi(\theta^Tx_i)) = ln(\frac{\pi(\theta^Tx_i)}{1 - \pi(\theta^Tx_i)}) \]

que significa calcular el logaritmo natural de cada valor de de \(x_i\) para determinar su probabilidad.

4 Desarrollo

Se presenta el desarrollo bajo el siguiente proceso:

  1. Cargar librerías

  2. Cargar datos

  3. Identificar variables

  4. Crear datos de entrenamiento y validación

  5. Crear modelo de regresión logística

  6. Analizar y/o describir el modelo

  7. Evaluar el modelo con matriz de confusión

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

  9. Interpretar el caso

4.1 Cargar librerías

library(ggplot2)   # Gráfics
library(dplyr)     # Filtar datos
library(knitr) # Amigabilidad las tablas datos
library(caret) # Partir los datos    
library(readr) # Impotar CSV
library(DT) # install.packages('DT') Pendiente

4.2 Cargar los datos

Cargar los datos desde la dirección: "https://raw.githubusercontent.com/rpizarrog/FundamentosMachineLearning/master/datos/adultos_clean.csv

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

#datatable(datos, caption = "Los datos", options = list(geLength = 10))

kable(head(datos, 10), caption = "Primeros diez registros")
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 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
7 29 ? HighGrad 9 Not_married Black Male 40 <=50K 0.1643836 0.5333333 0.3979592 0
8 63 Self-emp-not-inc Master 15 Married White Male 32 >50K 0.6301370 0.9333333 0.3163265 1
9 24 Private Community 10 Not_married White Female 40 <=50K 0.0958904 0.6000000 0.3979592 0
10 55 Private Dropout 4 Married White Male 10 <=50K 0.5205479 0.2000000 0.0918367 0 
kable(tail(datos, 10), caption = "Últimos diez registros")
Últimos 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
48833 48833 32 Private Dropout 6 Married Amer-Indian-Eskimo Male 40 <=50K 0.2054795 0.3333333 0.3979592 0
48834 48834 43 Private Community 11 Married White Male 45 <=50K 0.3561644 0.6666667 0.4489796 0
48835 48835 32 Private Master 14 Not_married Asian-Pac-Islander Male 11 <=50K 0.2054795 0.8666667 0.1020408 0
48836 48836 53 Private Master 14 Married White Male 40 >50K 0.4931507 0.8666667 0.3979592 1
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

4.3 Identificar variables

Se describen 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 trabaja 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

Datos de entrenamiento y datos de validación

Se particiona el conjunto de datos original en un 70 30 es decir,

  • 70% datos de entrenamiento y

  • 30% datos de validación

La variable que se utiliza para partir los datos es income10 que trae consigo valores de 0 y 1 respectivamente.

set.seed(2021)
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))

4.3.1 Datos de entrenamiento

# datatable(datos.entrenamiento, caption = "Datos de entrenamiento", options = list(pageLength = 50))

kable(head(datos.entrenamiento, 50), caption = "Datos de entrenamiento  (primeros cincuenta)")
Datos de entrenamiento (primeros cincuenta)
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
4 4 44 Private Community 10 Married Black Male 40 >50K 0.3698630 0.6000000 0.3979592 1
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
10 10 55 Private Dropout 4 Married White Male 10 <=50K 0.5205479 0.2000000 0.0918367 0
12 12 36 Federal-gov Bachelors 13 Married White Male 40 <=50K 0.2602740 0.8000000 0.3979592 0
13 13 26 Private HighGrad 9 Not_married White Female 39 <=50K 0.1232877 0.5333333 0.3877551 0
15 15 48 Private HighGrad 9 Married White Male 48 >50K 0.4246575 0.5333333 0.4795918 1
16 16 43 Private Master 14 Married White Male 50 >50K 0.3561644 0.8666667 0.5000000 1
19 19 37 Private HighGrad 9 Widow White Female 20 <=50K 0.2739726 0.5333333 0.1938776 0
20 20 40 Private PhD 16 Married Asian-Pac-Islander Male 45 >50K 0.3150685 1.0000000 0.4489796 1
21 21 34 Private Bachelors 13 Married White Male 47 >50K 0.2328767 0.8000000 0.4693878 1
22 22 34 Private Community 10 Not_married Black Female 35 <=50K 0.2328767 0.6000000 0.3469388 0
24 24 25 Private Bachelors 13 Not_married White Male 43 <=50K 0.1095890 0.8000000 0.4285714 0
27 27 22 Private HighGrad 9 Not_married White Male 20 <=50K 0.0684932 0.5333333 0.1938776 0
28 28 23 Private HighGrad 9 Separated Black Male 54 <=50K 0.0821918 0.5333333 0.5408163 0
29 29 54 Private HighGrad 9 Married White Male 35 <=50K 0.5068493 0.5333333 0.3469388 0
30 30 32 Self-emp-not-inc Community 10 Not_married White Male 60 <=50K 0.2054795 0.6000000 0.6020408 0
32 32 56 Self-emp-not-inc Dropout 7 Widow White Female 50 <=50K 0.5342466 0.4000000 0.5000000 0
33 33 24 Self-emp-not-inc Bachelors 13 Not_married White Male 50 <=50K 0.0958904 0.8000000 0.5000000 0
35 35 26 Private HighGrad 9 Separated White Female 40 <=50K 0.1232877 0.5333333 0.3979592 0
37 37 36 Local-gov Bachelors 13 Married White Male 40 >50K 0.2602740 0.8000000 0.3979592 1
38 38 22 Private Dropout 3 Not_married White Male 50 <=50K 0.0684932 0.1333333 0.5000000 0
40 40 20 Private HighGrad 9 Not_married White Male 40 <=50K 0.0410959 0.5333333 0.3979592 0
41 41 65 Private Master 14 Married White Male 50 >50K 0.6575342 0.8666667 0.5000000 1
42 42 44 Self-emp-inc Community 11 Married White Male 45 >50K 0.3698630 0.6666667 0.4489796 1
44 44 29 Private Dropout 7 Married White Male 40 <=50K 0.1643836 0.4000000 0.3979592 0
46 46 28 Private Community 11 Married White Female 36 >50K 0.1506849 0.6666667 0.3571429 1
47 47 39 Private Dropout 4 Married White Male 40 <=50K 0.3013699 0.2000000 0.3979592 0
48 48 54 Private Community 10 Married White Male 50 <=50K 0.5068493 0.6000000 0.5000000 0
49 49 52 Private Dropout 7 Separated Black Female 18 <=50K 0.4794521 0.4000000 0.1734694 0
51 51 18 Private Community 10 Not_married White Male 20 <=50K 0.0136986 0.6000000 0.1938776 0
52 52 39 Private HighGrad 9 Separated Black Male 40 <=50K 0.3013699 0.5333333 0.3979592 0
53 53 21 Private Community 10 Not_married White Female 24 <=50K 0.0547945 0.6000000 0.2346939 0
54 54 22 Private HighGrad 9 Not_married White Male 60 >50K 0.0684932 0.5333333 0.6020408 1
55 55 38 Private Dropout 5 Not_married White Male 54 <=50K 0.2876712 0.2666667 0.5408163 0
56 56 21 Private Community 10 Not_married White Female 40 <=50K 0.0547945 0.6000000 0.3979592 0
57 57 63 Private HighGrad 9 Married White Male 40 <=50K 0.6301370 0.5333333 0.3979592 0
58 58 34 Local-gov Bachelors 13 Married White Male 50 >50K 0.2328767 0.8000000 0.5000000 1
59 59 42 Self-emp-inc HighGrad 9 Married White Male 50 >50K 0.3424658 0.5333333 0.5000000 1
60 60 33 Private HighGrad 9 Married White Male 40 <=50K 0.2191781 0.5333333 0.3979592 0
62 62 39 Private Community 10 Separated White Male 40 <=50K 0.3013699 0.6000000 0.3979592 0
64 64 33 Private HighGrad 9 Not_married White Female 40 <=50K 0.2191781 0.5333333 0.3979592 0
65 65 47 Local-gov HighGrad 9 Separated White Female 40 <=50K 0.4109589 0.5333333 0.3979592 0
66 66 41 Private Bachelors 13 Not_married White Female 40 <=50K 0.3287671 0.8000000 0.3979592 0
67 67 41 Self-emp-inc Community 12 Married White Male 60 >50K 0.3287671 0.7333333 0.6020408 1
68 68 19 Private Community 10 Not_married White Male 20 <=50K 0.0273973 0.6000000 0.1938776 0
69 69 46 Private HighGrad 9 Separated White Male 40 <=50K 0.3972603 0.5333333 0.3979592 0
70 70 43 Private HighGrad 9 Married White Male 48 <=50K 0.3561644 0.5333333 0.4795918 0

4.3.2 Datos de validación

# datatable(datos.validacion, caption = "Datos de validación", options = list(pageLength = 50))

kable(head(datos.validacion, 50), caption = "Datos de validación  (primeros cincuenta)")
Datos de validación (primeros cincuenta)
X age workclass education educational.num marital.status race gender hours.per.week income age.scale educational.num.scale hours.per.week.scale income10
2 2 38 Private HighGrad 9 Married White Male 50 <=50K 0.2876712 0.5333333 0.5000000 0
3 3 28 Local-gov Community 12 Married White Male 40 >50K 0.1506849 0.7333333 0.3979592 1
5 5 18 ? Community 10 Not_married White Female 30 <=50K 0.0136986 0.6000000 0.2959184 0
6 6 34 Private Dropout 6 Not_married White Male 30 <=50K 0.2328767 0.3333333 0.2959184 0
11 11 65 Private HighGrad 9 Married White Male 40 >50K 0.6575342 0.5333333 0.3979592 1
14 14 58 ? HighGrad 9 Married White Male 35 <=50K 0.5616438 0.5333333 0.3469388 0
17 17 20 State-gov Community 10 Not_married White Male 25 <=50K 0.0410959 0.6000000 0.2448980 0
18 18 43 Private HighGrad 9 Married White Female 30 <=50K 0.3561644 0.5333333 0.2959184 0
23 23 72 ? Dropout 4 Separated White Female 6 <=50K 0.7534247 0.2000000 0.0510204 0
25 25 25 Private Bachelors 13 Married White Male 40 <=50K 0.1095890 0.8000000 0.3979592 0
26 26 45 Self-emp-not-inc HighGrad 9 Married White Male 90 >50K 0.3835616 0.5333333 0.9081633 1
31 31 46 State-gov Community 10 Married Black Male 38 >50K 0.3972603 0.6000000 0.3775510 1
34 34 23 Local-gov Community 10 Married White Male 40 <=50K 0.0821918 0.6000000 0.3979592 0
36 36 65 ? HighGrad 9 Married White Male 40 <=50K 0.6575342 0.5333333 0.3979592 0
39 39 17 Private Dropout 6 Not_married White Male 40 <=50K 0.0000000 0.3333333 0.3979592 0
43 43 36 Private HighGrad 9 Married White Male 40 <=50K 0.2602740 0.5333333 0.3979592 0
45 45 20 State-gov Community 10 Not_married White Male 32 <=50K 0.0410959 0.6000000 0.3163265 0
50 50 56 Self-emp-inc HighGrad 9 Widow White Female 50 <=50K 0.5342466 0.5333333 0.5000000 0
61 61 30 Private Bachelors 13 Not_married White Female 50 <=50K 0.1780822 0.8000000 0.5000000 0
63 63 26 Private Master 14 Not_married White Female 40 <=50K 0.1232877 0.8666667 0.3979592 0
74 74 21 Private Community 10 Separated White Female 40 <=50K 0.0547945 0.6000000 0.3979592 0
76 76 17 ? Dropout 6 Not_married White Male 40 <=50K 0.0000000 0.3333333 0.3979592 0
78 78 69 Self-emp-inc HighGrad 9 Married White Male 30 <=50K 0.7123288 0.5333333 0.2959184 0
85 85 31 Self-emp-not-inc Community 10 Married White Male 50 <=50K 0.1917808 0.6000000 0.5000000 0
88 88 55 Private HighGrad 9 Married White Male 56 >50K 0.5205479 0.5333333 0.5612245 1
89 89 24 Federal-gov Community 10 Not_married White Male 40 <=50K 0.0958904 0.6000000 0.3979592 0
91 91 59 Private Bachelors 13 Not_married White Female 25 <=50K 0.5753425 0.8000000 0.2448980 0
92 92 49 Federal-gov Dropout 4 Not_married Black Male 20 <=50K 0.4383562 0.2000000 0.1938776 0
93 93 33 Private Master 14 Married White Female 10 >50K 0.2191781 0.8666667 0.0918367 1
106 106 36 Private Dropout 6 Separated White Female 40 <=50K 0.2602740 0.3333333 0.3979592 0
107 107 41 Local-gov HighGrad 9 Married White Male 40 <=50K 0.3287671 0.5333333 0.3979592 0
108 108 28 Private HighGrad 9 Not_married White Male 40 <=50K 0.1506849 0.5333333 0.3979592 0
109 109 19 Private Community 10 Not_married Black Male 16 <=50K 0.0273973 0.6000000 0.1530612 0
112 112 28 Private Community 10 Married White Male 40 <=50K 0.1506849 0.6000000 0.3979592 0
116 116 26 Private HighGrad 9 Not_married White Male 40 <=50K 0.1232877 0.5333333 0.3979592 0
118 118 23 Private Dropout 7 Not_married White Female 24 <=50K 0.0821918 0.4000000 0.2346939 0
121 121 31 Local-gov Bachelors 13 Separated White Female 60 <=50K 0.1917808 0.8000000 0.6020408 0
123 123 19 Private Community 10 Not_married White Male 30 <=50K 0.0273973 0.6000000 0.2959184 0
124 124 41 Private Community 10 Separated White Female 40 <=50K 0.3287671 0.6000000 0.3979592 0
136 136 30 Private Community 12 Not_married White Female 40 <=50K 0.1780822 0.7333333 0.3979592 0
147 147 44 Private Community 11 Widow White Female 30 <=50K 0.3698630 0.6666667 0.2959184 0
150 150 19 Private HighGrad 9 Not_married White Male 30 <=50K 0.0273973 0.5333333 0.2959184 0
151 151 28 Private Community 10 Not_married Black Male 14 <=50K 0.1506849 0.6000000 0.1326531 0
152 152 27 Private Dropout 7 Married Black Female 32 <=50K 0.1369863 0.4000000 0.3163265 0
153 153 50 Private Dropout 4 Married White Male 20 <=50K 0.4520548 0.2000000 0.1938776 0
162 162 32 Private HighGrad 9 Married White Male 40 <=50K 0.2054795 0.5333333 0.3979592 0
163 163 22 Private HighGrad 9 Married White Male 45 <=50K 0.0684932 0.5333333 0.4489796 0
167 167 58 Self-emp-not-inc PhD 16 Married White Male 16 >50K 0.5616438 1.0000000 0.1530612 1
171 171 54 Private HighGrad 9 Married White Male 40 >50K 0.5068493 0.5333333 0.3979592 1
173 173 26 Private Bachelors 13 Not_married White Female 40 <=50K 0.1232877 0.8000000 0.3979592 0

4.4 Crear modelo de regresión logística

Con los datos de entrenamiento se crea el modelo de Regresión Logística.

La regresión logística implica que existe una variable dependiente, dado un conjunto particular de valores de las variables independientes elegidas. Se estima la regresión de una persona con ingresos de una persona \(\leq 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,” “marital.status,” “race,” “gender,” “hours.per.week”

  • Se utiliza el conjunto de datos de entrenamiento

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

  • La ecuación

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

  • Se asigna a una variable la fórmula 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 + workclass + education + marital.status + race + gender + hours.per.week

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

4.5 Analizar y/o describir el modelo

summary(modelo)
## 
## Call:
## glm(formula = formula, family = "binomial", data = datos.entrenamiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.7493  -0.5658  -0.2560  -0.0645   3.3674  
## 
## Coefficients:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                -3.205147   0.236379 -13.559  < 2e-16 ***
## age                         0.029863   0.001444  20.677  < 2e-16 ***
## workclassFederal-gov        1.478382   0.126151  11.719  < 2e-16 ***
## workclassLocal-gov          0.798681   0.112521   7.098 1.27e-12 ***
## workclassNever-worked      -6.829352 110.174714  -0.062  0.95057    
## workclassPrivate            0.928988   0.098912   9.392  < 2e-16 ***
## workclassSelf-emp-inc       1.393424   0.120861  11.529  < 2e-16 ***
## workclassSelf-emp-not-inc   0.355796   0.109343   3.254  0.00114 ** 
## workclassState-gov          0.623399   0.124432   5.010 5.44e-07 ***
## workclassWithout-pay       -0.130936   0.828607  -0.158  0.87444    
## educationCommunity         -0.961600   0.044412 -21.652  < 2e-16 ***
## educationDropout           -2.745016   0.077492 -35.423  < 2e-16 ***
## educationHighGrad          -1.560401   0.045274 -34.466  < 2e-16 ***
## educationMaster             0.691917   0.061673  11.219  < 2e-16 ***
## educationPhD                1.196835   0.138195   8.661  < 2e-16 ***
## marital.statusNot_married  -2.564136   0.053974 -47.507  < 2e-16 ***
## marital.statusSeparated    -2.145131   0.056129 -38.218  < 2e-16 ***
## marital.statusWidow        -2.173145   0.124587 -17.443  < 2e-16 ***
## raceAsian-Pac-Islander      0.241917   0.212802   1.137  0.25561    
## raceBlack                   0.181256   0.202319   0.896  0.37031    
## raceOther                   0.144924   0.289527   0.501  0.61669    
## raceWhite                   0.451932   0.193102   2.340  0.01926 *  
## genderMale                  0.084781   0.044287   1.914  0.05557 .  
## hours.per.week              0.030160   0.001424  21.174  < 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: 37718  on 34189  degrees of freedom
## Residual deviance: 24923  on 34166  degrees of freedom
## AIC: 24971
## 
## Number of Fisher Scoring iterations: 11

Con summary() se identifica que las mayoría de las variables son estadísticamente significativas, salvo las que no tienen ‘*.’

De los diversos coeficiente que genera el modelo, depende o se debiera utilizar si son de un valor o de otro valor conforme a la variable utilizada multiplicado éste por el valor de la variable.

Por ejemplo para workclass o clase de trabajo:

workclass coeficiente
Gobierno federal workclassFederal-gov 1.47838
Gobierno local workclassLocal-gov 0.79868
Nunca trabajó workclassNever-worked -6.82935
Trabajo privado workclassPrivate 0.92899
Trabaja por su cuenta, negocio propio workclassSelf-emp-inc 1.39342
Trabaja por su cuenta sin empresa (informal) workclassSelf-emp-not-inc 0.35580
Gobierno estatal workclassState-gov 0.62340
Trabajo voluntario workclassWithout-pay -0.13094

Entonces una posible predicción sería de la siguiente manera:

\[ Y = \beta\_0 + \beta\_1\cdot(coeficiente) + \beta\_2 \cdot(coeficiente) \\ + \beta\_3 \cdot(coeficiente) + ... + \beta\_n\cdot(coeficiente) \]

Y …

\[ income10 = -2.66731 + age \cdot(coeficiente) + workclass\cdot(coeficiente) + education \cdot(coeficiente) \\ + marital.status \cdot(coeficiente) + race \cdot(coeficiente) + \\ gender \cdot(coeficiente) + hours.per.week \cdot(coeficiente) + \\ \text{las otras variables ...} \times(coeficientes) \]

Se observa que cuando alguien tienen negocio propio el valor del ingreso por consecuencia aumenta más que el tener otra actividad económica.

Las predicciones se hacen más adelante en este caso.

4.6 Evaluar el modelo

  • 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")

Hay que encontrar a cuantos casos se le atinaron utilizando los datos de validación y con ello encontrar el porcentaje de aciertos.

4.6.1 Comparar los valores de income10 VS valores ajustados

  • Utilizando los datos de entrenamiento

  • Tres variables income10 original con valores \(0 \text{ y } 1 \text{ s }\) s

    • Se utilizan los valores ajustados.
    • ¿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.
    • valores ajustados codificados 0 y 1 s aquellos cuya probabilidad sea \(\leq50\) o \(> 50%\)

Se genera un data frame llamado comparar con tres columnas (income10, ajuste,income10ajustados) , con las columnas 1 y 3 se puede generar la matriz de confusión

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")
Comparar valores, primeros diez
income10 ajuste income10ajustados
0 0.0046497 0
1 0.3890455 0
0 0.0067516 0
1 0.7730817 1
0 0.0314673 0
0 0.0730755 0
0 0.7486522 1
0 0.0180558 0
1 0.3968239 0
1 0.8512711 1 
kable(tail(comparar, 10), caption = "Comparar valores, últimos diez")
Comparar valores, últimos diez
income10 ajuste income10ajustados
34181 1 0.2408071 0
34182 0 0.0678873 0
34183 0 0.3931412 0
34184 0 0.0603121 0
34185 0 0.3817556 0
34186 0 0.4850764 0
34187 1 0.8508947 1
34188 0 0.0322399 0
34189 0 0.0679071 0
34190 0 0.0099146 0 
# datatable(comparar, caption = "Comparar valores", options = list(pageLength = 10))

4.6.2 Visualizando los valores ajustados

La gráfica muetra los colores rojos que son los que están pro debajo o igual al 50 % de probablidad o sea 0 y en azul los que están por encima de 50% o sea 1.

Se observa algunos puntos que están en la zona roja que son azules y viceversa, significa aquellos valores que no coinciden con el valor real, es decir que era 0 y con el valor ajustado es 1 o viceversa.

ggplot(data = comparar, aes(x =row.names(comparar), y = ajuste, )) + 
geom_point(aes(colour = factor(income10))) + 
  geom_hline(yintercept = 0.50)

4.6.3 Matriz de confusión

Se genera la matriz de confusión con los datos que se generaron en el data.frame comparar.

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 24068 1901
1 4004 4217

¿Qué significa la matriz de confusión?

  • La matriz de confusión indica a cuantos registro le atinó el modelo.

  • El modelo dice que 24068 ganan por debajo o igual a 50 Mil de los 34190 registros totales el conjunto de entrenamiento.

  • El modelo dice que 4217 ganan encima de 50 Mil de los 34190 registros totales el conjunto de entrenamiento.

  • ¿Que porcentaje de aciertos hubo?, VP verdaderos positivos y FP verdaderos negativos de acuerdo a la imagen de la matriz de confusión.

4.6.4 Evaluando el modelo

Se evalúa el modelo de acuerdo a estas condiciones:

  • Precision o precisión

\[ precision = \frac{TP}{VP + FP} \]

  • Recall o recuperación \[ recall = \frac{VP}{VP + FN} \]

  • Accuracy o exactitud \[ accuracy = \frac{VP + FP}{n} \]

  • Especificity o especificidad (tasa de verdaderos negativos) \[ especificity = \frac{VP}{VN + FP} \]

¿Cuál es la precisión (precision)en el modelo?

VP <- matriz_confusion[1,1]
FP <- matriz_confusion[2,2]

precision <- VP / (VP + FP)
precision * 100
## [1] 85.09104
precision
## [1] 0.8509104

¿Cuál es la exactitud (accuracy )en el modelo?

exactitud <- (VP + FP) / (nrow(datos.entrenamiento))
exactitud * 100
## [1] 82.72887
exactitud
## [1] 0.8272887

4.7 Predicciones

Se hacen predicciones con la función predict() sobre 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), caption="Predicciones")
Predicciones
x
2 -0.6570288
3 -0.7887702
5 -4.8366035
6 -5.1284385
11 -0.1523225
14 -1.4411554
17 -4.2194990
18 -1.1956982
23 -5.3122437
25 0.2135466

Determinar los valores probabilísticos de las predicciones o lo que sería una interpretación probabilística sería estimar la probabilidad \(prob\)

\[ prob = \frac{exp(prediccionesfit)}{(1 + exp(prediccionesfit)} \]

La función \(exp(x)\) calcula el valor logaritmo natural de el valor \(x\),

Valor de \(e=2.71828\)

Ejemplo: \(exp(1) = 2.71828\)

predicciones_prob <- exp(predicciones$fit) / (1 + exp(predicciones$fit))

kable(head(predicciones_prob, 50), caption="Primeros cincuenta registros de la prediccón")
Primeros cincuenta registros de la prediccón
x
2 0.3414074
3 0.3124328
5 0.0078715
6 0.0058909
11 0.4619928
14 0.1913665
17 0.0144929
18 0.2322414
23 0.0049067
25 0.5531847
26 0.5461762
31 0.3191871
34 0.2812870
36 0.2532580
39 0.0047991
43 0.2653473
45 0.0178388
50 0.1286465
61 0.1208452
63 0.1526988
74 0.0432139
76 0.0019009
78 0.5324452
85 0.3014373
88 0.5079015
89 0.0577222
91 0.1332618
92 0.0089832
93 0.5386183
106 0.0117407
107 0.2690695
108 0.0214279
109 0.0111413
112 0.3410849
116 0.0202107
118 0.0032603
121 0.2035445
123 0.0220322
124 0.0758476
136 0.0374113
147 0.0606437
150 0.0122274
151 0.0136882
152 0.0444262
153 0.0840852
162 0.2427224
163 0.2165912
167 0.7500411
171 0.3820588
173 0.0827538

Agregar columna de 0 o 1 según la probabilidad encontrada

predicciones <- data.frame(income10 = datos.validacion$income10, predicciones_prob)

# predicciones

predicciones <- predicciones %>%
    mutate(prediccion = if_else (predicciones_prob > 0.5, 1, 0))

kable(head(predicciones, 50), caption = "Los primeros cincuenta predicciones o 0 o 1")
Los primeros cincuenta predicciones o 0 o 1
income10 predicciones_prob prediccion
2 0 0.3414074 0
3 1 0.3124328 0
5 0 0.0078715 0
6 0 0.0058909 0
11 1 0.4619928 0
14 0 0.1913665 0
17 0 0.0144929 0
18 0 0.2322414 0
23 0 0.0049067 0
25 0 0.5531847 1
26 1 0.5461762 1
31 1 0.3191871 0
34 0 0.2812870 0
36 0 0.2532580 0
39 0 0.0047991 0
43 0 0.2653473 0
45 0 0.0178388 0
50 0 0.1286465 0
61 0 0.1208452 0
63 0 0.1526988 0
74 0 0.0432139 0
76 0 0.0019009 0
78 0 0.5324452 1
85 0 0.3014373 0
88 1 0.5079015 1
89 0 0.0577222 0
91 0 0.1332618 0
92 0 0.0089832 0
93 1 0.5386183 1
106 0 0.0117407 0
107 0 0.2690695 0
108 0 0.0214279 0
109 0 0.0111413 0
112 0 0.3410849 0
116 0 0.0202107 0
118 0 0.0032603 0
121 0 0.2035445 0
123 0 0.0220322 0
124 0 0.0758476 0
136 0 0.0374113 0
147 0 0.0606437 0
150 0 0.0122274 0
151 0 0.0136882 0
152 0 0.0444262 0
153 0 0.0840852 0
162 0 0.2427224 0
163 0 0.2165912 0
167 1 0.7500411 1
171 1 0.3820588 0
173 0 0.0827538 0

4.7.1 Matriz de confusión con las predicciones

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

kable(matriz_confusion, caption = "Matriz de confusión")
Matriz de confusión
0 1
0 10321 865
1 1687 1779

4.7.2 Evaluar el modelo con predicciones

4.7.2.1 Precision

VP <- matriz_confusion[1,1]
FP <- matriz_confusion[2,2]

precision <- VP / (VP + FP)
precision * 100
## [1] 85.29752
precision
## [1] 0.8529752

4.7.2.2 Exactitud

exactitud <- (VP + FP) / (nrow(datos.validacion))
exactitud * 100
## [1] 82.58258
exactitud
## [1] 0.8258258

4.7.3 Predecir un nuevo dato

Se toma un registro aleatorio de los datos originales únicamente con las variables de la fórmula. \(\text{age,workclass, education, marital.status, race, gender, hours.per.week\) y la variable dependiente \(income10\)

nuevo_dato <- datos[sample(x = 1:nrow(datos), size = 1), ]

nuevo_dato <- nuevo_dato[,c(2,3,4,6,7,8,9,14)]

kable(nuevo_dato, caption = "Nuevo registro aleatorio")
Nuevo registro aleatorio
age workclass education marital.status race gender hours.per.week income10
19678 50 State-gov Bachelors Not_married White Female 40 0

4.7.3.1 Usando función predict()

¿Cuántos ingreso económicos debe tener una persona que tiene ciertas características de acuerdo a las variables del modelo?, ¿Menor a igual 50 o mayor que 50?, ¿Qué valor lógico tendrá 0 u 1?.

Estas preguntas relacionadas entre si, tienen que ver con una predicción basado en un modelo de regresión logística.

Se realizó una evaluación tanto con los datos de entrenamiento y de validación y en términos de precisión y exactitud, fueron similares los valores. Se encontró que el modelo ofrece una precisión de 0.8529752 y una exactitud de 0.8258258 de acuerdo a la evaluación con los datos de validación que son muy similares a la evaluación con los datos de entrenamiento.

Se utiliza la función predict() luego se hace el mis proceso de convertir a valor probabilístico los valores ajustados y se identifica si es 0 u 1 el valor lógico de la variable dependiente income10.

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

predicciones.ajustadas <- predicciones$fit

predicciones.ajustadas
##     19678 
## -1.994377

Determinando la probabilidad con el valor ajustado.

prediccion_prob <- exp(predicciones$fit) / (1 + exp(predicciones$fit))

prediccion_prob
##     19678 
## 0.1197946

Convertir ese valor probabilístico a valor lógico entre 0 y 1 dependiente si la probabilidad es menor o igual a 0.50 sería 0 o si es mayor a 0.50 entonces es 1.

prediccion <- data.frame(income10 = nuevo_dato$income10, prediccion_prob)

prediccion
##       income10 prediccion_prob
## 19678        0       0.1197946
la.prediccion <- prediccion %>%
    mutate(prediccion = if_else (prediccion_prob > 0.5, 1, 0))

la.prediccion
##       income10 prediccion_prob prediccion
## 19678        0       0.1197946          0

La pregunta es ¿se hizo la predicción eficientemente?, la respuesta está en el valor de la precision y exactitud de acuerdo a la evaluación del modelo.

4.7.3.2 Usando fórmula

\[ formula = income10 \text{~} age + workclass + education + \\ marital.status + race + gender + hours.per.week \]

  • age = 50

  • workclass = State-gov, trabaja en gobierno estatal

  • education = Bachelors nivel profesional con valor de 13

  • marital.status = Not_married no casado

  • race = White de raza blanca

  • gender = Female género femenino

  • hours.per.week = 40

  • Sus ingresos originales son por debajo o igual a 50M y su valor lógico es de 0.

4.7.3.3 Predecir conforme a la fórmula

Se utiliza la fórmula con los valores de los coeficiente según el modelo y se sustituyen los valores.

modelo$coefficients
##               (Intercept)                       age      workclassFederal-gov 
##               -3.20514724                0.02986330                1.47838240 
##        workclassLocal-gov     workclassNever-worked          workclassPrivate 
##                0.79868138               -6.82935249                0.92898847 
##     workclassSelf-emp-inc workclassSelf-emp-not-inc        workclassState-gov 
##                1.39342406                0.35579616                0.62339872 
##      workclassWithout-pay        educationCommunity          educationDropout 
##               -0.13093573               -0.96159960               -2.74501640 
##         educationHighGrad           educationMaster              educationPhD 
##               -1.56040101                0.69191708                1.19683493 
## marital.statusNot_married   marital.statusSeparated       marital.statusWidow 
##               -2.56413575               -2.14513075               -2.17314530 
##    raceAsian-Pac-Islander                 raceBlack                 raceOther 
##                0.24191738                0.18125580                0.14492365 
##                 raceWhite                genderMale            hours.per.week 
##                0.45193177                0.08478051                0.03016027

Sólo se necesitan el coeficiente de (Intercept), age, de las características del nuevo dato.

coeficientes <- data.frame(
  modelo$coefficients['(Intercept)'],
  modelo$coefficients['age'],
  modelo$coefficients['workclassState-gov'],
  modelo$coefficients['educationBachelors'],
  modelo$coefficients['marital.statusNot_married'],
  modelo$coefficients['raceWhite'],
modelo$coefficients['genderFemale'],
modelo$coefficients['hours.per.week'])

colnames(coeficientes) <- c('Intercept', 'age', 'State-gov', 'Bachelors', 'Not_married', 'White', 'Female', 'hours.per.week')

kable(coeficientes, caption = "Coeficientes")
Coeficientes
Intercept age State-gov Bachelors Not_married White Female hours.per.week
(Intercept) -3.205147 0.0298633 0.6233987 NA -2.564136 0.4519318 NA 0.0301603

¿Pero cual es el valor del coeficiente de la variable Bachelors o de la variable female?. Suponemos que 0

En la variable pred.ajus se calcula el valor ajustado

\[ pred.ajus = \beta_0 + \beta_1 \cdot (coef.age) + \beta_2.coef.workclass + \beta_3.education + \\ \beta_4.marital.status + \beta_5.race + \beta_6.gender + \beta_7 \cdot(hours.per.week) \]

El valor de \(\beta_o\) es Intercept, y los valores de \(\beta_1, \beta_2 ... \text{ hasta } \beta_7\) son las variables independientes ‘age,’ ‘State-gov,’ ‘Bachelors,’ ‘Not_married,’ ‘White,’ ‘Female,’ ‘hours.per.week’

Los valores numéricos de edad (‘age’) y horas trabajadas a la semana (’hours.per.week’) se obtienen del data.frame nuevo_dato[], en la posición correspondiente y los valores de los coeficientes se acceden con la variable coeficientes[] en la posición correspondiente de cada variable según sea el caso.

Se determina el valor ajustado usando los coeficientes, el resultado por coerción se convierte a valor numérico.

pred.ajus = coeficientes[1] + as.numeric(nuevo_dato[1]) * coeficientes[2] + coeficientes[3] + 0 + coeficientes[5] + coeficientes[6] + 0 + as.numeric(nuevo_dato[7]) * coeficientes[8]

pred.ajus <- as.numeric(pred.ajus)

pred.ajus
## [1] -1.994377

El valor ajustado calculado con la fórmula es el mismo que el valor ajustado generado por la función predict(). Entonces se comprueba que los valores son los mismos.

predicciones.ajustadas
##     19678 
## -1.994377

Y finalmente se puede también encontrar el valor probabilístico a partir del valor ajustado y en consecuencia el valor lógico 0 o 1 para decir que una persona gana por debajo o igual a 50M o superior.

5 Interpretar el caso

Referencias Bibliográficas

Zang, Jindu. 2020. “Predicción de Las Rentas de Un Censo Mediante Regresión Logística y Regresión Logística Robusta.” http://diposit.ub.edu/dspace/bitstream/2445/172133/1/TFG_ZangJinduo.pdf.