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 $x_1, x_2 ... x_n ó \beta_1, \beta_2...\beta_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 $𝑛$ 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 11, entonces su modelo se puede escribir como:

$$ (^Tx_i) = P(Y =1|X=x) =

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 θTxiθTxi tome valores elevados pero negativos, entonces el valor de la función será 00 dado que $e ^ {\theta^Tx_i}$ 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 $x_i$ 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
Realizar predicciones con el conjunto de datos de validación
Interpretar el caso

Cargar librerías

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	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

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.

Hide

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

# 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

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

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 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')

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.

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	0

# datatable(comparar, caption = "Comparar valores", options = list(pageLength = 10))

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)

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 = \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

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

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

Evaluar el modelo con predicciones

Precision

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

precision <- VP / (VP + FP)
precision * 100

## [1] 85.29752

precision

## [1] 0.8529752

Exactitud

exactitud <- (VP + FP) / (nrow(datos.validacion))
exactitud * 100

## [1] 82.58258

exactitud

## [1] 0.8258258

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

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.

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.

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 _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.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.

Interpretar el 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, al ver los datos se puede observar las variables que son mas significativas en relacion a la varibale dependiente con “***”, se crea la matriz confusion para poder visualizar el rendimiento del mismo, despues de comparan los valores de income10 que es la varibale dependiente con los valores ajustados, y estos valores es la probabilidad ya una vez visualizados los valores ajustados en una grafica se puede observar la media los que estan por encima y por debajo de la media, ya con todo lo anterior se puede generar la matriz confusion, 0 es por debajo y 1 por encima por lo que 24135 esta por debajo y se interpreta que atino a 70.59 a los VP verdaderos positivos, asi que con los datos de entrenamiento el modelo es capaz de predecir y clasificar con un 82.6%.

Al hacer predicciones con dicho modelo con diferentes registros y datos en la mayoria de las predicciones le atina mas del 80% de los casos, asi que no es un modelo 100% efectivo al momento de predecir pero esta bastante bien y llega a tener un porcentaje bajo de fallar. 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.

Caso 6. Regresión Logística. Personas e Ingresos USA

Angel Ceniceros

5/5/2021