Caso6. Regresión logística personas e ingresos USA
Alfredo Quiñones
17/6/2021
Objetivo Realizar e interpretar regresión logística con datos de personas e ingresos de USA.
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.
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.
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 x1,x2…xnóβ1,β2…βn.
Se debe identificar la variable dependiente YY o la variable respuesta de tipo binaria, donde cada componente de 𝑌 se distribuye mediante una distribución de Bernoulli [0|1].
Se necesitan n el número de observaciones.
Entonces X=(x1,…,xn)T el conjunto de variable independientes.
Se identifica como θ el vector de parámetros asociado al modelo, de forma que θ∈Rk+1 que significa que los valores del vector resultante pertenecen a cada una de las variables.
Sea π(θTxi) la probabilidad de que Yi tome un valor igual a 11, entonces su modelo se puede escribir como:
$$ (^Tx_i) = P(Y =1|X=x) =
$$
Si θTxi 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 θTxiθTxi tome valores elevados pero negativos, entonces el valor de la función será 00 dado que eθTxi tenderá a infinito. (Zang, Jindu 2020).
El valor ee 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((^Tx_i)) = ln()
$$
que significa calcular el logaritmo natural de cada valor de de xi para determinar su probabilidad.
Desarrollo Se presenta el desarrollo bajo el siguiente 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
Cargar librerias library(ggplot2) # Gráfics library(dplyr) # Filtar datos ## ## Attaching package: 'dplyr' ## The following objects are masked from 'package:stats': ## ## filter, lag ## The following objects are masked from 'package:base': ## ## intersect, setdiff, setequal, union library(knitr) # Amigabilidad las tablas datos library(caret) # Partir los datos ## Loading required package: lattice library(readr) # Impotar CSV library(DT) # install.packages('DT') Pendiente ## Warning: package 'DT' was built under R version 4.0.5 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 0kable(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 1Identificar 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))Datos de entrenamiento
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 0Datos de validación
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 0Crear 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 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')
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 = _0 + _1(coeficiente) + _2 (coeficiente) \ + _3 (coeficiente) + … + _n(coeficiente)
Y …
income10 = -2.66731 + age (coeficiente) + workclass(coeficiente) + education (coeficiente) \ + marital.status (coeficiente) + race (coeficiente) + \ gender (coeficiente) + hours.per.week (coeficiente) + \ (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.
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("../images/matriz_confusion.jfif")
Hay que encontrar a cuantos casos se le atinaron utilizando los datos de validación y con ello encontrar el porcentaje de aciertos.
Comparar los valores de income10 VS valores ajustados
Utilizando los datos de entrenamiento
Tres variables income10 original con valores 0 1 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 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 0Visualizando 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)
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. Evaluando el modelo Se evalúa el modelo de acuerdo a estas condiciones:
Precision o precisión precision =
Recall o recuperación
recall =
Accuracy o exactitud
accuracy =
Especificity o especificidad (tasa de verdaderos negativos)
especificity =
¿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.8272887Predicciones 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.2135466Determinar los valores probabilísticos de las predicciones o lo que sería una interpretación probabilística sería estimar la probabilidad prob
prob =
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
predicciones <- data.frame(income10 = datos.validacion$income10, predicciones_prob)```
# prediccionespredicciones <- 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
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
VP <- matriz_confusion[1,1]
FP <- matriz_confusion[2,2]precision <- VP / (VP + FP)
precision * 100
## [1] 85.29752
precision
## [1] 0.8529752
exactitud <- (VP + FP) / (nrow(datos.validacion))
exactitud * 100
## [1] 82.58258
exactitud
## [1] 0.8258258Predecir 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 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
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.
Usando fórmula formula = income10 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.
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 = _0 + _1 (coef.age) + _2.coef.workclass + _3.education + \ _4.marital.status + _5.race + _6.gender + _7 (hours.per.week)El valor de _o es Intercept, y los valores de _1, _2 … _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.994377INTERPRETACION DEL CASO Para este caso se uso el modelo de regresion logistica el cual nos ayuda para estimar la relacion existente entre una variable dependiente no metrica y un conjunto de variables independientes metricas o no metricas, la varibale dependiente son los ingresos y estan como 0 y 1, los que ganan menos de 50 mi y los que ganan mas de 50 mil, se comenzoc cargando las librerias necesarias y cargando los datos, se logran ver las variables que se usaran para dicho casos las mas importantes y lo que significa cada una, se construye el modelo la varibale dependiente es income10 y las variables dependientes son age, workclass, education, educational.num, marital.status, race, gender, hours.per.week