Análisis de Regresión Logística de datos adultos

Análisis de regresión logística para predicción de ingresos de personas

La regresión logística se usa para predecir una clase, es decir, una probabilidad.
La regresión logística puede predecir un resultado binario.
Como ejemplo, se podría predecir si un préstamo es denegado / aceptado en función de muchos atributos.
La regresión logística es de la forma 0/1. y = 0 si se rechaza un préstamo, y = 1 si se acepta. (Guru99, 2020) https://www.guru99.com/r-generalized-linear-model.html
En muchas aplicaciones de la regresión, la variable dependiente asume sólo dos valores discretos, por ejemplo, en un banco suele necesitarse una ecuación de regresión estimada para predecir si a una persona se le aprobará su solicitud de tarjeta de crédito.
A esta variable dependiente pueden dársele los valores y = 1 si la solicitud de tarjeta de crédito es aprobada, y y = 0 si es rechazada. (Anderson, Sweeney, & Williams, 2008).
Con la regresión logística, dado un conjunto particular de valores de las variables independientes elegidas, se estima la probabilidad de que el banco apruebe la solicitud de tarjeta de crédito.
Un modelo de regresión logística difiere del modelo de regresión lineal de dos maneras:
- En primer lugar, la regresión logística solo acepta entradas dicotómicas (binarias) como una variable dependiente (es decir, un vector de 0 y 1).
- En segundo lugar, el resultado se mide mediante la siguiente función de enlace probabilístico llamada sigmoide, debido a su forma de S.

Descripción

Se utiliza un conjunto de datos de personas para ilustrar la regresión logística.
El conjunto de datos adultos.csv se utiliza tanto para la tarea de clasificación y predicción.

Objetivo

Predecir si el ingreso anual en dólares de un individuo excederá los $50,000.

Las librerías

library(tidyverse) # varias
library(dplyr) # select filter mutate ...
library(ggplot2) # Gráficas
library(fdth) # Para tablas de distribución y frecuencias
library(knitr) # Para ver tablas mas amigables en formato html markdown
library(caret) # Pra particionar datos
library(reshape)    # Para renombrar columnas en caso de necesitarse
library(scales) # Para escalar datos

Los datos

Cargando los datos

Se identifica la ruta en donde están los datos.
En la variable datos se carga el conjunto de datos adultos.csv. En RUTA, reemplazar la ruta con su directorio de trabajo en donde se encuentre Sales.csv

ruta <- "D:/inspiron 1545/ESCUELA/ITD/OCTAVO/Analisis Inteligente de Datos/R/datos" #DEFINE LA RUTA EN DONDE ESTÁN LOS DATOS
setwd(ruta)    
datos <- read_csv("adultos.csv")

## Parsed with column specification:
## cols(
##   x = col_double(),
##   age = col_double(),
##   workclass = col_character(),
##   education = col_character(),
##   `educational-num` = col_double(),
##   `marital-status` = col_character(),
##   race = col_character(),
##   gender = col_character(),
##   `hours-per-week` = col_double(),
##   income = col_character()
## )

Explorando los datos

Los primeros diez registros:

Usando kable

kable(head(datos,10))

x	age	workclass	education	educational-num	marital-status	race	gender	hours-per-week	income
1	25	Private	11th	7	Never-married	Black	Male	40	<=50K
2	38	Private	HS-grad	9	Married-civ-spouse	White	Male	50	<=50K
3	28	Local-gov	Assoc-acdm	12	Married-civ-spouse	White	Male	40	>50K
4	44	Private	Some-college	10	Married-civ-spouse	Black	Male	40	>50K
5	18	?	Some-college	10	Never-married	White	Female	30	<=50K
6	34	Private	10th	6	Never-married	White	Male	30	<=50K
7	29	?	HS-grad	9	Never-married	Black	Male	40	<=50K
8	63	Self-emp-not-inc	Prof-school	15	Married-civ-spouse	White	Male	32	>50K
9	24	Private	Some-college	10	Never-married	White	Female	40	<=50K
10	55	Private	7th-8th	4	Married-civ-spouse	White	Male	10	<=50K

Los últimos diez registros:

Usando kable

kable(tail(datos,10))

x	age	workclass	education	educational-num	marital-status	race	gender	hours-per-week	income
48833	32	Private	10th	6	Married-civ-spouse	Amer-Indian-Eskimo	Male	40	<=50K
48834	43	Private	Assoc-voc	11	Married-civ-spouse	White	Male	45	<=50K
48835	32	Private	Masters	14	Never-married	Asian-Pac-Islander	Male	11	<=50K
48836	53	Private	Masters	14	Married-civ-spouse	White	Male	40	>50K
48837	22	Private	Some-college	10	Never-married	White	Male	40	<=50K
48838	27	Private	Assoc-acdm	12	Married-civ-spouse	White	Female	38	<=50K
48839	40	Private	HS-grad	9	Married-civ-spouse	White	Male	40	>50K
48840	58	Private	HS-grad	9	Widowed	White	Female	40	<=50K
48841	22	Private	HS-grad	9	Never-married	White	Male	20	<=50K
48842	52	Self-emp-inc	HS-grad	9	Married-civ-spouse	White	Female	40	>50K

La estructura de los datos:

x: Variable de consecutivo de los datos.
age: Edad de la persona.
workclass: Tipo o clase de trabajo de la persona: privado, gobierno, por su cuenta.
education: Nivel educativo de la persona.
educational: Valor numérico de education.
marital: Estado civil.
race: Tipo de raza de la persona.
gender: Sexo de la persona.
hours.per.week: Horas que trabaja.
income: Ingresos.

Estructura y resumen de los datos

str(datos)

## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 48842 obs. of  10 variables:
##  $ x              : num  1 2 3 4 5 6 7 8 9 10 ...
##  $ age            : num  25 38 28 44 18 34 29 63 24 55 ...
##  $ workclass      : chr  "Private" "Private" "Local-gov" "Private" ...
##  $ education      : chr  "11th" "HS-grad" "Assoc-acdm" "Some-college" ...
##  $ educational-num: num  7 9 12 10 10 6 9 15 10 4 ...
##  $ marital-status : chr  "Never-married" "Married-civ-spouse" "Married-civ-spouse" "Married-civ-spouse" ...
##  $ race           : chr  "Black" "White" "White" "Black" ...
##  $ gender         : chr  "Male" "Male" "Male" "Male" ...
##  $ hours-per-week : num  40 50 40 40 30 30 40 32 40 10 ...
##  $ income         : chr  "<=50K" "<=50K" ">50K" ">50K" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   x = col_double(),
##   ..   age = col_double(),
##   ..   workclass = col_character(),
##   ..   education = col_character(),
##   ..   `educational-num` = col_double(),
##   ..   `marital-status` = col_character(),
##   ..   race = col_character(),
##   ..   gender = col_character(),
##   ..   `hours-per-week` = col_double(),
##   ..   income = col_character()
##   .. )

Excepto la columna x que no interesa:

kable(summary(datos[-1]))

age	workclass	education	educational-num	marital-status	race	gender	hours-per-week	income
Min. :17.00	Length:48842	Length:48842	Min. : 1.00	Length:48842	Length:48842	Length:48842	Min. : 1.00	Length:48842
1st Qu.:28.00	Class :character	Class :character	1st Qu.: 9.00	Class :character	Class :character	Class :character	1st Qu.:40.00	Class :character
Median :37.00	Mode :character	Mode :character	Median :10.00	Mode :character	Mode :character	Mode :character	Median :40.00	Mode :character
Mean :38.64	NA	NA	Mean :10.08	NA	NA	NA	Mean :40.42	NA
3rd Qu.:48.00	NA	NA	3rd Qu.:12.00	NA	NA	NA	3rd Qu.:45.00	NA
Max. :90.00	NA	NA	Max. :16.00	NA	NA	NA	Max. :99.00	NA

Proceso para analizar los datos

De los pasos 1 al 4 se pueden integrar en fases de ciencia de los datos como de carga, limpieza y exploración de los datos.
A partir del paso 5 se construye un modelo de regresión lógistica para predicciones.
- paso 1: Identificar variables numéricas.
- paso 2: Identificar variables factor.
- paso 3: Ingeniería de datos.
- paso 4: Estadísticos descriptivos.
- paso 5: Conjunto de datos de entrenamiento y de validación Train/test set.
- paso 6: Modelo de regresión logística.
- paso 7: Evaluar el modelo.
- paso 8: Predicciones con datos de entrenamiento

Paso 1 - Identificar las variables númericas

Se utiliza select_if() para seleccionar ciertas variables del conjunto de datos. select_if() es un función de la librería dplyr.
Se analizan dos variables numéricas (education.num es un valor numérico del factor education por lo que se analiza en variables tipo factor más adelante).:
- hours.per.week
- age

numericas <- select_if(datos, is.numeric)
kable(summary(numericas[-1]))

age	educational-num	hours-per-week
Min. :17.00	Min. : 1.00	Min. : 1.00
1st Qu.:28.00	1st Qu.: 9.00	1st Qu.:40.00
Median :37.00	Median :10.00	Median :40.00
Mean :38.64	Mean :10.08	Mean :40.42
3rd Qu.:48.00	3rd Qu.:12.00	3rd Qu.:45.00
Max. :90.00	Max. :16.00	Max. :99.00

Análisis de la variable hours.per.week

Se visualiza un histograma.
Se determina la tabla de distribución de frecuencia con la función fdt() de la variable hours.per.week.
La mayoría de la gente trabaja entre 36 y 42 horas por semana.

ggplot(numericas, aes(x = numericas$`hours-per-week`)) +
    geom_density(alpha = .2, fill = "#FF6666")

distribucion <- fdt(numericas$`hours-per-week`,breaks="Sturges") 


kable(distribucion)

Class limits	f	rf	rf(%)	cf	cf(%)
[0.99,6.8)	410	0.0083944	0.8394415	410	0.8394415
[6.8,13)	982	0.0201056	2.0105647	1392	2.8500061
[13,18)	1180	0.0241595	2.4159535	2572	5.2659596
[18,24)	2383	0.0487900	4.8789976	4955	10.1449572
[24,30)	2896	0.0592932	5.9293231	7851	16.0742803
[30,36)	2481	0.0507964	5.0796446	10332	21.1539249
[36,42)	24217	0.4958233	49.5823267	34549	70.7362516
[42,48)	3803	0.0778633	7.7863314	38352	78.5225830
[48,53)	5319	0.1089022	10.8902174	43671	89.4128005
[53,59)	1318	0.0269850	2.6984972	44989	92.1112977
[59,65)	2596	0.0531510	5.3150977	47585	97.4263953
[65,71)	483	0.0098890	0.9889030	48068	98.4152983
[71,77)	223	0.0045657	0.4565743	48291	98.8718726
[77,83)	237	0.0048524	0.4852381	48528	99.3571107
[83,88)	98	0.0020065	0.2006470	48626	99.5577577
[88,94)	52	0.0010647	0.1064657	48678	99.6642234
[94,1e+02)	164	0.0033578	0.3357766	48842	100.0000000

	x
start	0.990000
end	99.990000
h	5.823529
right	0.000000

barplot(height = distribucion$table$f, names.arg = distribucion$table$`Class limits`)

Análisis de la variable age

Se visualiza un histograma.
Se determina la tabla de distribución de frecuencia con la función fdt() de la variable age.
La mayoría tiene entre 30 y 34 años y de igual forma una gran población en edades de 43 y 47 años de edad.

ggplot(numericas, aes(x = age)) +
    geom_density(alpha = .2, fill = "#FF6666")

distribucion <- fdt(numericas$age, breaks="Sturges") 


kable(distribucion)

Class limits	f	rf	rf(%)	cf	cf(%)
[17,21)	4719	0.0966177	9.6617665	4719	9.661767
[21,26)	4908	0.1004873	10.0487286	9627	19.710495
[26,30)	4888	0.1000778	10.0077802	14515	29.718275
[30,34)	6494	0.1329593	13.2959338	21009	43.014209
[34,39)	5229	0.1070595	10.7059498	26238	53.720159
[39,43)	4793	0.0981328	9.8132755	31031	63.533434
[43,47)	5445	0.1114819	11.1481921	36476	74.681626
[47,52)	3435	0.0703288	7.0328815	39911	81.714508
[52,56)	3247	0.0664797	6.6479669	43158	88.362475
[56,60)	2078	0.0425454	4.2545350	45236	92.617010
[60,65)	1519	0.0311003	3.1100283	46755	95.727038
[65,69)	1086	0.0222350	2.2234962	47841	97.950534
[69,73)	479	0.0098071	0.9807133	48320	98.931248
[73,78)	272	0.0055690	0.5568978	48592	99.488145
[78,82)	154	0.0031530	0.3153024	48746	99.803448
[82,87)	30	0.0006142	0.0614225	48776	99.864870
[87,91)	66	0.0013513	0.1351296	48842	100.000000

	x
start	16.830000
end	90.900000
h	4.357059
right	0.000000

barplot(height = distribucion$table$f, names.arg = distribucion$table$`Class limits`)

Estandarizar los valores numéricos

Escalar los valores numéricos de datos con la función rescale() de la librería scales.
La finalidad de estandarizar los datos numéricos escalando o centrando los mismos es para mejorar el rendimiento en los análisis teniendo en cuenta que se establecen valores numéricos bajo los mismos criterios.
Se dejan los datos escalados en un nuevo conjunto de datos excepto la variable x [-1] que no interesa
Se visualzan los primeros diez registros
Se visualizan los últimos diez registros
Observar que las variables numéricas age y hours.per.week están centradas y escaladas.
Se generan tres nuevas variables por medio de mutate() con datos numéricos escalados
Se retomará en el análisis más adelante el conjunto de datos datos.Escalados generado en esta apartado

escalados <- datos[-1] %>%
    mutate(age.scale = rescale(age), educational.num.scale = rescale(datos$`educational-num`), hours.per.week.scale = rescale(numericas$`hours-per-week`)  )

kable(head(escalados, 10))

age w	orkclass e	ducation	educational-num m	arital-status r	ace g	ender	hours-per-week i	ncome	age.scale	educational.num.scale	hours.per.week.scale
25	Private	11th	7	Never-married	Black	Male	40	<=50K	0.1095890	0.4000000	0.3979592
38	Private	HS-grad	9	Married-civ-spouse	White	Male	50	<=50K	0.2876712	0.5333333	0.5000000
28	Local-gov	Assoc-acdm	12	Married-civ-spouse	White	Male	40	>50K	0.1506849	0.7333333	0.3979592
44	Private	Some-college	10	Married-civ-spouse	Black	Male	40	>50K	0.3698630	0.6000000	0.3979592
18	?	Some-college	10	Never-married	White	Female	30	<=50K	0.0136986	0.6000000	0.2959184
34	Private	10th	6	Never-married	White	Male	30	<=50K	0.2328767	0.3333333	0.2959184
29	?	HS-grad	9	Never-married	Black	Male	40	<=50K	0.1643836	0.5333333	0.3979592
63	Self-emp-not-inc	Prof-school	15	Married-civ-spouse	White	Male	32	>50K	0.6301370	0.9333333	0.3163265
24	Private	Some-college	10	Never-married	White	Female	40	<=50K	0.0958904	0.6000000	0.3979592
55	Private	7th-8th	4	Married-civ-spouse	White	Male	10	<=50K	0.5205479	0.2000000	0.0918367

kable(tail(escalados, 10))

age w	orkclass e	ducation	educational-num m	arital-status r	ace g	ender	hours-per-week i	ncome	age.scale	educational.num.scale	hours.per.week.scale
32	Private	10th	6	Married-civ-spouse	Amer-Indian-Eskimo	Male	40	<=50K	0.2054795	0.3333333	0.3979592
43	Private	Assoc-voc	11	Married-civ-spouse	White	Male	45	<=50K	0.3561644	0.6666667	0.4489796
32	Private	Masters	14	Never-married	Asian-Pac-Islander	Male	11	<=50K	0.2054795	0.8666667	0.1020408
53	Private	Masters	14	Married-civ-spouse	White	Male	40	>50K	0.4931507	0.8666667	0.3979592
22	Private	Some-college	10	Never-married	White	Male	40	<=50K	0.0684932	0.6000000	0.3979592
27	Private	Assoc-acdm	12	Married-civ-spouse	White	Female	38	<=50K	0.1369863	0.7333333	0.3775510
40	Private	HS-grad	9	Married-civ-spouse	White	Male	40	>50K	0.3150685	0.5333333	0.3979592
58	Private	HS-grad	9	Widowed	White	Female	40	<=50K	0.5616438	0.5333333	0.3979592
22	Private	HS-grad	9	Never-married	White	Male	20	<=50K	0.0684932	0.5333333	0.1938776
52	Self-emp-inc	HS-grad	9	Married-civ-spouse	White	Female	40	>50K	0.4794521	0.5333333	0.3979592

Paso 2 - Identificar las variables factor

Este paso tiene la finalidad de dentificar variales categóricas o factor
Se hace para identificar valores NA, valores con alguna incertidubre o duda de que es o que significa
workclass. Son 9 niveles y hay un nivel cuya etiqueta es ‘?’; habrá que considerar para modificar el valor. ? : 2799. Pendiente esta clase
education son 16 niveles
marital.status que represnta estado civil aparece con 7 niveles
race o raza de persona aparecen con valores de NA, es.
gender que representa género (Female=1, Male=2) de la persona también aparecen con valores NA
Finalmente la variable income tiene de igual forma valores NA
Con lo anterior, como analista de datos, habrá que decidir que hacer con los registros que existe NA o el nivel de ? en workclass

factores <- data.frame(select_if(datos, is.factor))

summary(factores)

## < table of extent 0 x 0 >

kable(summary(factores))

## Warning in kable_markdown(x, padding = padding, ...): The table should have a
## header (column names)

|| || || ||

str(factores)

## 'data.frame':    48842 obs. of  0 variables

Frecuencias de cada variable factores

Se utiliza la función fdt_cat() para determinar frecuencias de variables categóricas o tipo factor
Se muestran las tablas de distribución de cada variable tipo factor

#distribucion <- fdt_cat(factores)

Variable workclass

Tabla de distribución
En el renglón 4 se observa ? 2799 0.0573072356 5.73072356 43703 89.47832, que se interpreta que no se sabe de que clase es y habrá que modificar la categoría

#kable(distribucion$workclass)

Gráfica de barra

#barplot(height = distribucion$workclass$table$f, names.arg = distribucion$workclass$table$Category)

Variable education

Tabla de distrubución
Se observa que hay gran frecuencia de personas con High School: HS-grad de 15784 representando el 32.32%
Se observa que hay 83 casos de personas con nivel educativo de Preschool representando tan solo el 0.17%

#kable(distribucion$education)

Gráfica de barra

#barplot(height = distribucion$education$table$f, names.arg = distribucion$education$table$Category)

Variable marital.status

Tabla de distribución
Se observa que hay gran frecuencia de personas en estado civil de Married-civ-spouse (esposa o esposo casado): de 22379 representando el 45.82%
Se observa que hay 37 casos de personas en estado civil de Married-AF-spouse (esposa o esposo casado de ámbito militar-Armed Forces) representando tan solo el 0.08%

#kable(distribucion$marital.status)

Gráfica de barra

#barplot(height = distribucion$marital.status$table$f, names.arg = distribucion$marital.status$table$Category)

Variable race

Tabla de distribución
Se observa que hay gran frecuencia de personas de raza blanca con un valor de White = 41762 representando el 85.50%
Se observa que hay 406 casos de personas de otro tipo de raza diferente a White, Black, Asian-Pac-Islander, Amer-Indian-Eskimo representando tan solo el 0.08%

#kable(distribucion$race)

Gráfica de barra

#barplot(height = distribucion$race$table$f, names.arg = distribucion$race$table$Category)

Variable gender

Tabla de distribución
Se observa que hay dos tipos de género Male y Female
El género ‘Male’ masculino existen 32650 casos representando el 66.84%
El género ‘Female’ femenino hay 16192 casos representando el 33.15%

#kable(distribucion$gender)

Gráfica de barra

#barplot(height = distribucion$gender$table$f, names.arg = distribucion$gender$table$Category)

Paso 3 - Ingeniería de datos

Este proceso tiene la finalidad principal de realizar algunos ajsutes en las variables
Estos ajustes van desde categorizar o agrupar en nuevas etiquetas algunas variables hasta modificar algunos valores #### Recategorizar la variable education
La variable education tiene 16 niveles.
Algunos niveles ecucativos tienen pocas observaciones.
Posiblemente se quiera mejorar y hacer mas eficiente el conjunto de datos o lo que significa recategorizar
Se sugiere y conforme a la literatura consultada los siguientes niveles para la variable education:
- Dropout integra niveles educativos varios {Preschool,10th 11th,12th,1st-4th,5th-6th,7th-8th,9th}
- HighGrad integra {HS-Grad}
- Community integra {Some-college, Assoc-acdm, Assoc-voc}
- Bachelors integra {Bachelors}
- Master integra {Masters, Prof-school}
- Phd integra {Doctorate}
Se utiliza el conjunto de datos.Escalados que ya tiene datos eficientemente preparados (limpios y ajustados)
Se deja en un nuevo conjunto de datos llamado recategorizados

recategorizados <- escalados %>%
    mutate(education = factor(ifelse(education == "Preschool" | education == "10th" | education == "11th" | education == "12th" | education == "1st-4th" | education == "5th-6th" | education == "7th-8th" | education == "9th", "Dropout", ifelse(education == "HS-grad", "HighGrad", ifelse(education == "Some-college" | education == "Assoc-acdm" | education == "Assoc-voc", "Community",ifelse(education == "Bachelors", "Bachelors",
        ifelse(education == "Masters" | education == "Prof-school", "Master", "PhD")))))))

kable(head(recategorizados))

age w	orkclass e	ducation	educational-num m	arital-status r	ace g	ender	hours-per-week i	ncome	age.scale	educational.num.scale	hours.per.week.scale
25	Private	Dropout	7	Never-married	Black	Male	40	<=50K	0.1095890	0.4000000	0.3979592
38	Private	HighGrad	9	Married-civ-spouse	White	Male	50	<=50K	0.2876712	0.5333333	0.5000000
28	Local-gov	Community	12	Married-civ-spouse	White	Male	40	>50K	0.1506849	0.7333333	0.3979592
44	Private	Community	10	Married-civ-spouse	Black	Male	40	>50K	0.3698630	0.6000000	0.3979592
18	?	Community	10	Never-married	White	Female	30	<=50K	0.0136986	0.6000000	0.2959184
34	Private	Dropout	6	Never-married	White	Male	30	<=50K	0.2328767	0.3333333	0.2959184

Agrupar estadísticamente la variable nivel de educación

Se agrupa por la variable education ya recategorizada
Se encuentra la media de la variable educational.num que previamente había sido escalada
Se determinar cuantos de cada grupo

recategorizados %>% 
  group_by(education) %>%
    summarize(promedio_educacion = mean(datos$`educational-num`),
        cuantos = n()) %>%
    arrange(promedio_educacion)

## # A tibble: 6 x 3
##   education promedio_educacion cuantos
##   <fct>                  <dbl>   <int>
## 1 Bachelors               10.1    8025
## 2 Community               10.1   14540
## 3 Dropout                 10.1    6408
## 4 HighGrad                10.1   15784
## 5 Master                  10.1    3491
## 6 PhD                     10.1     594

Recategorizar la variable marital.status

Se hace la misma operación que en la variable education.
Se sugiere y conforme a la literatura consultada los siguientes niveles para la variable marital.status:
- Not-married integra varios valores {Never-married, Married-spouse-absent}
- Married integra {Married-AF-spouse, Married-civ-spouse}
- Community integra {Some-college, Assoc-acdm, Assoc-voc}
- Separated integra {Separated, Divorced}
- Widow integra {Widowed}
- Se de igual manera, utiliza el conjunto de datos.Escalados que ya tiene datos eficientemente preparados (limpios y ajustados)
Así mismo, se deja en el nuevo conjunto de datos llamado recategorizados

recategorizados <- recategorizados %>%
    mutate(marital.status = factor(ifelse(datos$`marital-status` == "Never-married" | datos$`marital-status` == "Married-spouse-absent", "Not_married", ifelse(datos$`marital-status` == "Married-AF-spouse" | datos$`marital-status` == "Married-civ-spouse", "Married", ifelse(datos$`marital-status` == "Separated" | datos$`marital-status` == "Divorced", "Separated", "Widow")))))

kable(head(recategorizados))

age w	orkclass e	ducation	educational-num m	arital-status r	ace g	ender	hours-per-week i	ncome	age.scale	educational.num.scale	hours.per.week.scale m	arital.status
25	Private	Dropout	7	Never-married	Black	Male	40	<=50K	0.1095890	0.4000000	0.3979592	Not_married
38	Private	HighGrad	9	Married-civ-spouse	White	Male	50	<=50K	0.2876712	0.5333333	0.5000000	Married
28	Local-gov	Community	12	Married-civ-spouse	White	Male	40	>50K	0.1506849	0.7333333	0.3979592	Married
44	Private	Community	10	Married-civ-spouse	Black	Male	40	>50K	0.3698630	0.6000000	0.3979592	Married
18	?	Community	10	Never-married	White	Female	30	<=50K	0.0136986	0.6000000	0.2959184	Not_married
34	Private	Dropout	6	Never-married	White	Male	30	<=50K	0.2328767	0.3333333	0.2959184	Not_married

Frecuencia de la variable marital.status

Se observan las frecuencias del estado civil (marital.status.R) recategorizadas

table(recategorizados$marital.status)

## 
##     Married Not_married   Separated       Widow 
##       22416       16745        8163        1518

Paso 4 - Estadísticos descriptivos

Algunos valores estadísticos del conjunto de datos escalados y categorizados.
Conjunto de datos = recategorizados #### Género y sueldos (gender, income)
Se observa que hay mas casos de personas de género masculino ‘Male’ que ganan por encima de 50 mil en relación con las personas del género femenino ‘Female’
En absoluto respeto y con estos datos se interpreta que los hombres ganan mas que las mujeres

ggplot(recategorizados, aes(x = gender, fill = income)) +
    geom_bar(position = "fill") +
    theme_classic()

Origen o raza de persona y su ingreso (race, income)

Se observa que las personas de raza blanca ‘White’ al igual que las personas de raza Asiática ganan mas que las otras razas

ggplot(recategorizados, aes(x = race, fill = income)) + 
  geom_bar(position = "fill") +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90))

Horas trabajadas por semana y el género de persona (hours.per.week, gender)

Se observa con datos escalados, que los hombres trabajan mas horas a la semana que las mujeres

head(recategorizados)

## # A tibble: 6 x 13
##     age workclass education `educational-nu~ `marital-status` race  gender
##   <dbl> <chr>     <fct>                <dbl> <chr>            <chr> <chr> 
## 1    25 Private   Dropout                  7 Never-married    Black Male  
## 2    38 Private   HighGrad                 9 Married-civ-spo~ White Male  
## 3    28 Local-gov Community               12 Married-civ-spo~ White Male  
## 4    44 Private   Community               10 Married-civ-spo~ Black Male  
## 5    18 ?         Community               10 Never-married    White Female
## 6    34 Private   Dropout                  6 Never-married    White Male  
## # ... with 6 more variables: `hours-per-week` <dbl>, income <chr>,
## #   age.scale <dbl>, educational.num.scale <dbl>, hours.per.week.scale <dbl>,
## #   marital.status <fct>

ggplot(recategorizados, aes(x = gender, y = datos$`hours-per-week`)) +
    geom_boxplot() +
    stat_summary(fun.y = mean,
        geom = "point",
        size = 3,
        color = "steelblue") +
    theme_classic()

Horas trabajadas por semana y el nivel educativo (hours.per.week, education)

Con datos escalados y recategorizados, se observ que los de nivel HighSchool

ggplot(recategorizados, aes(x = datos$`hours-per-week`)) +
    geom_density(aes(color = education), alpha = 0.5) +
    theme_classic()

No linealidad de los datos

Representar datos en gráficas de dispersión y agruando para encontrar la no linealidad de los mismos horas por semana (hours.per.week) y la edad (age) agrupados por el sueldo (income)
- Se observa que con respecto a la varible horas por semana (hours.per.week) y la edad (age) agrupados por el sueldo (income) no una una linealidad en los datos
- Se interpreta que los que trabajan mas ganan mas

ggplot(recategorizados, aes(x = age, y = datos$`hours-per-week`)) +
    geom_point(aes(color = income),
        size = 0.5) +
    stat_smooth(method = 'lm',
        formula = y~poly(x, 2),
        se = TRUE,
        aes(color = income)) +
    theme_classic()

horas por semana (hours.per.week) y el nivel de educación (education) agrupados por el sueldo (income) - Se observa que con respecto a la varible horas por semana (hours.per.week) y la edad (age) agrupados por el sueldo (income) no una una linealidad en los datos - Se interpreta que los que trabajan mas ganan mas

ggplot(recategorizados, aes(x = education, y = datos$`hours-per-week`)) +
    geom_point(aes(color = income),
        size = 0.5) +
    stat_smooth(method = 'lm',
        formula = y~poly(x, 2),
        se = TRUE,
        aes(color = income)) +
    theme_classic()

Recodificar la variable income a income10

1 para income ‘>50’
- 0 para income ‘<=50’
- Se crea una nueva variable llamada income10
- Se muestran los primeros registros de las columnas 9 y 10 del conjunto de datos

recategorizados <- recategorizados %>%
  mutate(income10 = recode(income,"<=50K" = 0,">50K" = 1))


head(recategorizados[,c(9,13)])

## # A tibble: 6 x 2
##   income marital.status
##   <chr>  <fct>         
## 1 <=50K  Not_married   
## 2 <=50K  Married       
## 3 >50K   Married       
## 4 >50K   Married       
## 5 <=50K  Not_married   
## 6 <=50K  Not_married

Nombres de las variables de datos recategorizados

Es el conjunto de datos limpios en el data.frame llamado recategorizados
- Los primeros seis registros
- A partir de aquí, se espera construir el modelo
- A partir de esta punto, se puede construir el modelo de regresión logística

names(recategorizados)

##  [1] "age"                   "workclass"             "education"            
##  [4] "educational-num"       "marital-status"        "race"                 
##  [7] "gender"                "hours-per-week"        "income"               
## [10] "age.scale"             "educational.num.scale" "hours.per.week.scale" 
## [13] "marital.status"        "income10"

head(recategorizados)

## # A tibble: 6 x 14
##     age workclass education `educational-nu~ `marital-status` race  gender
##   <dbl> <chr>     <fct>                <dbl> <chr>            <chr> <chr> 
## 1    25 Private   Dropout                  7 Never-married    Black Male  
## 2    38 Private   HighGrad                 9 Married-civ-spo~ White Male  
## 3    28 Local-gov Community               12 Married-civ-spo~ White Male  
## 4    44 Private   Community               10 Married-civ-spo~ Black Male  
## 5    18 ?         Community               10 Never-married    White Female
## 6    34 Private   Dropout                  6 Never-married    White Male  
## # ... with 7 more variables: `hours-per-week` <dbl>, income <chr>,
## #   age.scale <dbl>, educational.num.scale <dbl>, hours.per.week.scale <dbl>,
## #   marital.status <fct>, income10 <dbl>

Generar un archivo con datos ajustados

Generar un archivo llamado “adultos_clean.csv”
- Se verifica el directorio la existencia de este archivo generado
- Se puede hacer el ejercicio de “Regresión logística” a partir de este conjunto de datos y comenzar desde el paso 5 en otro archivo markdown

write.csv(recategorizados, file="adultos_clean.csv")
dir()

##  [1] "adultos_clean.csv"                       
##  [2] "ArbolesMelbourne.html"                   
##  [3] "ArbolesMelbourne.Rmd"                    
##  [4] "CorrelacionyRegresionLinealMultiple.html"
##  [5] "CorrelacionyRegresionLinealMultiple.Rmd" 
##  [6] "CorrelacionyRegresionLinealSimple.html"  
##  [7] "CorrelaciónyRegresiónLinealSimple.html"  
##  [8] "CorrelacionyRegresionLinealSimple.Rmd"   
##  [9] "CorrelaciónyRegresiónLinealSimple.Rmd"   
## [10] "CorrelacionYRLMultipleMelbourne.html"    
## [11] "CorrelacionYRLMultipleMelbourne.Rmd"     
## [12] "ExplorandoDatosVentas.html"              
## [13] "ExplorandoDatosVentas.Rmd"               
## [14] "practica-8.html"                         
## [15] "practica 8.Rmd"                          
## [16] "Prueba.html"                             
## [17] "Prueba.Rmd"                              
## [18] "RegresionLogisticaAdultos.html"          
## [19] "RegresionLogisticaAdultos.Rmd"           
## [20] "RegresionLogisticaAdultos_files"         
## [21] "RegresionLogisticaCuadroHonor.html"      
## [22] "RegresionLogisticaCuadroHonor.Rmd"       
## [23] "RegresionLogisticaNoPago.html"           
## [24] "RegresionLogisticaNoPago.Rmd"            
## [25] "rsconnect"                               
## [26] "VentasxCajero.html"                      
## [27] "VentasxCajero.Rmd"                       
## [28] "VentasxHora.html"                        
## [29] "VentasxHora.Rmd"

Paso 5 - Conjunto de datos de entrenamiento y de validación Train/Test set

Se establece una semilla inicial
- Se genera el conjunto de datos de entrenamiento
- Se genera un conjunto de datos de validación o prueba
- Se muestran los primeros y últimos registros de datos de entrenamiento
- Se muestran los primeros y últimos registros de datos de validación

Datos de entrenamiento

Se generan los registros en la variable entrena
- Los datos de entrenamiento datos.Entrena serán los registros que aleatoriamente se filtran del conjunto de datos categorizados
- Los datos de validación serán los que no son de entrenamiento

nrow(recategorizados)

## [1] 48842

set.seed(2020)

entrena <- createDataPartition(recategorizados$income, p=0.7, list = FALSE)

datos.Entrena <- recategorizados[entrena,]
datos.Validacion <- recategorizados[-entrena,]

nrow(datos.Entrena)

## [1] 34190

kable(head(datos.Entrena))

age w	orkclass e	ducation	educational-num m	arital-status r	ace g	ender	hours-per-week i	ncome	age.scale	educational.num.scale	hours.per.week.scale m	arital.status	income10
25	Private	Dropout	7	Never-married	Black	Male	40	<=50K	0.1095890	0.4000000	0.3979592	Not_married	0
38	Private	HighGrad	9	Married-civ-spouse	White	Male	50	<=50K	0.2876712	0.5333333	0.5000000	Married	0
28	Local-gov	Community	12	Married-civ-spouse	White	Male	40	>50K	0.1506849	0.7333333	0.3979592	Married	1
44	Private	Community	10	Married-civ-spouse	Black	Male	40	>50K	0.3698630	0.6000000	0.3979592	Married	1
18	?	Community	10	Never-married	White	Female	30	<=50K	0.0136986	0.6000000	0.2959184	Not_married	0
29	?	HighGrad	9	Never-married	Black	Male	40	<=50K	0.1643836	0.5333333	0.3979592	Not_married	0

kable(tail(datos.Entrena))

age w	orkclass e	ducation	educational-num m	arital-status r	ace g	ender	hours-per-week i	ncome	age.scale	educational.num.scale	hours.per.week.scale m	arital.status	income10
43	Private	Community	11	Married-civ-spouse	White	Male	45	<=50K	0.3561644	0.6666667	0.4489796	Married	0
32	Private	Master	14	Never-married	Asian-Pac-Islander	Male	11	<=50K	0.2054795	0.8666667	0.1020408	Not_married	0
27	Private	Community	12	Married-civ-spouse	White	Female	38	<=50K	0.1369863	0.7333333	0.3775510	Married	0
58	Private	HighGrad	9	Widowed	White	Female	40	<=50K	0.5616438	0.5333333	0.3979592	Widow	0
22	Private	HighGrad	9	Never-married	White	Male	20	<=50K	0.0684932	0.5333333	0.1938776	Not_married	0
52	Self-emp-inc	HighGrad	9	Married-civ-spouse	White	Female	40	>50K	0.4794521	0.5333333	0.3979592	Married	1

Datos de validación

Los datos de validación serán los que no son de entrenamiento

datos.Validacion <- recategorizados[-entrena,]

nrow(datos.Validacion)

## [1] 14652

kable(head(datos.Validacion))

age w	orkclass e	ducation	educational-num m	arital-status r	ace g	ender	hours-per-week i	ncome	age.scale	educational.num.scale	hours.per.week.scale m	arital.status	income10
34	Private	Dropout	6	Never-married	White	Male	30	<=50K	0.2328767	0.3333333	0.2959184	Not_married	0
48	Private	HighGrad	9	Married-civ-spouse	White	Male	48	>50K	0.4246575	0.5333333	0.4795918	Married	1
20	State-gov	Community	10	Never-married	White	Male	25	<=50K	0.0410959	0.6000000	0.2448980	Not_married	0
65	?	HighGrad	9	Married-civ-spouse	White	Male	40	<=50K	0.6575342	0.5333333	0.3979592	Married	0
65	Private	Master	14	Married-civ-spouse	White	Male	50	>50K	0.6575342	0.8666667	0.5000000	Married	1
52	Private	Dropout	7	Separated	Black	Female	18	<=50K	0.4794521	0.4000000	0.1734694	Separated	0

kable(tail(datos.Validacion))

age w	orkclass e	ducation	educational-num m	arital-status r	ace g	ender	hours-per-week i	ncome	age.scale	educational.num.scale	hours.per.week.scale m	arital.status	income10
31	Private	Master	14	Divorced	Other	Female	30	<=50K	0.1917808	0.8666667	0.2959184	Separated	0
65	Self-emp-not-inc	Master	15	Never-married	White	Male	60	<=50K	0.6575342	0.9333333	0.6020408	Not_married	0
43	Self-emp-not-inc	Community	10	Married-civ-spouse	White	Male	50	<=50K	0.3561644	0.6000000	0.5000000	Married	0
53	Private	Master	14	Married-civ-spouse	White	Male	40	>50K	0.4931507	0.8666667	0.3979592	Married	1
22	Private	Community	10	Never-married	White	Male	40	<=50K	0.0684932	0.6000000	0.3979592	Not_married	0
40	Private	HighGrad	9	Married-civ-spouse	White	Male	40	>50K	0.3150685	0.5333333	0.3979592	Married	1

Paso 6 - Regresión Logística

Con la regresión logística, dado un conjunto particular de valores de las variables independientes elegidas, se estima la probabilidad de los ingresos de una persona ‘<=50’ o ‘>50’

Construir el modelo

Por medio de la función gml() se contruye un modelo de regresión logística
Variable dependiente o predictiva es ‘income’, ya que depende de todas las demás variables
Variables independientes o predictoras, todas las demás: “age”, “workclass”, “education”, “educational.num” ya que inlfuyen en la variable dependiente ‘income’ , “marital.status”, “race”, “gender”, “hours.per.week”
Se utiliza el conjunto de datos de entrenamiento
La finalidad de consruir el modelo de rgresión logística es entre otroas cosas, para conocer los coeficienes y el nivel de significación de cada variable independiente o predictora así como las pruebas t y F
La fórmula “income10 ~ age.scale + workclass + education + marital.status + race + gender + hours.per.week.scale” que se asigna a una variable y se utiliza para construir el modelo, significa que la variable ingresos ‘income10’ depende o es dependiente de todas las demás variables

formula = income10 ~ age.scale + workclass + education + marital.status + race + gender + hours.per.week.scale
modelo <- glm(formula, data = datos.Entrena, family = 'binomial')

Interpretación del modelo

¿Qué significan los coeficientes?
- ¿Qué significan los valores de significancia p?
- ¿Qué significa AIC?
- ¿Como hacer predicciones manuales()?
- ¿Cómo hacer predicciones con la función predict()?

summary(modelo)

## 
## Call:
## glm(formula = formula, family = "binomial", data = datos.Entrena)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.7337  -0.5768  -0.2588  -0.0654   3.3492  
## 
## Coefficients:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)               -2.419e+00  2.228e-01 -10.858  < 2e-16 ***
## age.scale                  2.224e+00  1.053e-01  21.121  < 2e-16 ***
## workclassFederal-gov       1.421e+00  1.237e-01  11.485  < 2e-16 ***
## workclassLocal-gov         6.942e-01  1.100e-01   6.312 2.76e-10 ***
## workclassNever-worked     -8.124e+00  1.042e+02  -0.078   0.9379    
## workclassPrivate           8.124e-01  9.598e-02   8.464  < 2e-16 ***
## workclassSelf-emp-inc      1.218e+00  1.186e-01  10.270  < 2e-16 ***
## workclassSelf-emp-not-inc  1.878e-01  1.071e-01   1.753   0.0797 .  
## workclassState-gov         5.339e-01  1.223e-01   4.367 1.26e-05 ***
## workclassWithout-pay      -3.965e-01  8.276e-01  -0.479   0.6318    
## educationCommunity        -9.930e-01  4.428e-02 -22.426  < 2e-16 ***
## educationDropout          -2.782e+00  7.802e-02 -35.657  < 2e-16 ***
## educationHighGrad         -1.611e+00  4.523e-02 -35.610  < 2e-16 ***
## educationMaster            6.250e-01  6.110e-02  10.230  < 2e-16 ***
## educationPhD               1.077e+00  1.379e-01   7.814 5.55e-15 ***
## marital.statusNot_married -2.491e+00  5.355e-02 -46.511  < 2e-16 ***
## marital.statusSeparated   -2.102e+00  5.650e-02 -37.214  < 2e-16 ***
## marital.statusWidow       -2.163e+00  1.287e-01 -16.809  < 2e-16 ***
## raceAsian-Pac-Islander    -2.461e-02  2.074e-01  -0.119   0.9055    
## raceBlack                  4.784e-04  1.968e-01   0.002   0.9981    
## raceOther                 -9.881e-02  2.817e-01  -0.351   0.7258    
## raceWhite                  2.155e-01  1.876e-01   1.148   0.2509    
## genderMale                 9.432e-02  4.455e-02   2.117   0.0342 *  
## hours.per.week.scale       3.136e+00  1.398e-01  22.430  < 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: 37626  on 34189  degrees of freedom
## Residual deviance: 25011  on 34166  degrees of freedom
## AIC: 25059
## 
## Number of Fisher Scoring iterations: 11

¿Qué significan los coeficientes?

Por cada unidad en el valor de edad, representa una probabilidad de exp( 0.39771) en relación a tener ingresos >50K ó 1. exp(prediccionesfit)/(1+exp(prediccionesfit)) ¿Qué significan los valores de significancia Pr(>|z|) ?
La variable age tiene un valor de significancia muy bueno para el modelo de age.scale < 2e-16 ***
- age.scale
Con respecto a la variable workclass, los empleos de gobierno federal, estatal, local, los privados, autoempleo tienen un valor significativo muy bueno para el modelo ***
- workclassFederal-gov < 2e-16 ***
- workclassLocal-gov 2.76e-10 ***
- workclassPrivate < 2e-16 ***
- workclassSelf-emp-inc < 2e-16 ***
- workclassState-gov 1.26e-05 ***
- El nivel de educación también refleja un nivel de significancia muy imporatnte para el modelo
  - educationCommunity < 2e-16 ***
  - educationDropout< 2e-16 ***
  - educationHighGrad < 2e-16 ***
  - educationMaster < 2e-16 ***
  - educationPhD 5.55e-15 ***
- El estado civil de soltero, diverciado, y viudo reflejan de igual forma un importante nivel de significancia en el modelo
  - marital.statusNot_married < 2e-16 ***
  - marital.statusSeparated < 2e-16 ***
  - marital.statusWidow < 2e-16 ***
- La variable race origen o raza étnica no representa un valor significativo para el modelo
- El género masculino aparece con aceptable nivel de significancia 0.0342 *
- La variable horas de trabajo por semana también aparece con un nivel de signifancia de < 2e-16 ***
- hours.per.week.scale < 2e-16 ***

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

Comparara los valores de income10 VS valores ajustados. - Utilizando los datos de entrenamiento - Tres variables - income10 original con valores 0 y 1 s - Valores ajustados - Valores ajustados codificados 0 y 1 s aquellos cuya probabilidad sea > 0.5 o al 50% - Con las columnas 1 y 3 se puede generar la matriz de confusión

comparar <- data.frame(datos.Entrena$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')
head(comparar)

##   income10      ajuste income10ajustados
## 1        0 0.005003194                 0
## 2        0 0.331904483                 0
## 3        1 0.304736019                 0
## 4        1 0.393130183                 0
## 5        0 0.008761445                 0
## 6        0 0.008068021                 0

kable(tail(comparar))

in	come10	ajuste in
34185	0	0.4776056
34186	0	0.0675150
34187	0	0.2899927
34188	0	0.0649039
34189	0	0.0095868
34190	1	0.4300378

Matriz de confusión

Con los datos generados en la variable comparar se genera la matriz de confusión

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

##         income10ajustados para predicciones
## income10     0     1
##        0 24107  1902
##        1  4016  4165

¿Qué tan preciso es el modelo? - Se obtiene el total de casos de entrenamiento que se usaron para construir el modelo y se determina el valor de n - El modelo es capaz de clasificar y predecir correctamente (24103 + 4164) / 34190 = 0.8267 u (82.67%) de las observaciones. - El modelo es capaz de predecir y clasificar con exactidud al 82%, o sea que se puede equivocar en 18% de los casos

n = nrow(datos.Entrena)
exactidud <- (matriz_confusion[1,1] + matriz_confusion[2,2]) / n

exactidud

## [1] 0.8269085

Paso 8 - Predicciones con datos de validación

Se utilizan los datos de validación para realizar predicciones

predicciones <- predict(modelo, datos.Validacion, se.fit = TRUE)

head(predicciones$fit)

##          1          2          3          4          5          6 
## -5.1235447 -0.4589452 -4.1994476 -1.0094459  2.3586616 -4.8803438

kable(tail(predicciones$fit))

	x
14647	-1.8282163
14648	-0.4364728
14649	-0.5542026
14650	1.6730416
14651	-3.3800099
14652	-0.9586976

Convertir predicciones en probabilidad

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

head(predicciones_prob)

##           1           2           3           4           5           6 
## 0.005919626 0.387236079 0.014782074 0.267088310 0.913620236 0.007537162

head(predicciones_prob)

##           1           2           3           4           5           6 
## 0.005919626 0.387236079 0.014782074 0.267088310 0.913620236 0.007537162

Evaluar el modelo de predicción Agregar una columna de la predicción al final del conjunto de datos de validación - Agregar una columna de los datos de validación con los valores probabilísticos de las predicciones con cbind() y con un uevo conjunto de datos llamado las .predicciones - Agregar columna con valor 1 cuando la predicción es mayor que 0.5 y 0 cuando la predicción es menor o igual a 0.5 - Verificar las columnas income10 e income10.prediccion

las.predicciones <- cbind(datos.Validacion, predicciones_prob)

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

##   age workclass education educational-num     marital-status  race gender
## 1  34   Private   Dropout               6      Never-married White   Male
## 2  48   Private  HighGrad               9 Married-civ-spouse White   Male
## 3  20 State-gov Community              10      Never-married White   Male
## 4  65         ?  HighGrad               9 Married-civ-spouse White   Male
## 5  65   Private    Master              14 Married-civ-spouse White   Male
## 6  52   Private   Dropout               7          Separated Black Female
##   hours-per-week income  age.scale educational.num.scale hours.per.week.scale
## 1             30  <=50K 0.23287671             0.3333333            0.2959184
## 2             48   >50K 0.42465753             0.5333333            0.4795918
## 3             25  <=50K 0.04109589             0.6000000            0.2448980
## 4             40  <=50K 0.65753425             0.5333333            0.3979592
## 5             50   >50K 0.65753425             0.8666667            0.5000000
## 6             18  <=50K 0.47945205             0.4000000            0.1734694
##   marital.status income10 predicciones_prob income10.prediccion
## 1    Not_married        0       0.005919626                   0
## 2        Married        1       0.387236079                   0
## 3    Not_married        0       0.014782074                   0
## 4        Married        0       0.267088310                   0
## 5        Married        1       0.913620236                   1
## 6      Separated        0       0.007537162                   0

tail(las.predicciones)

##       age        workclass education educational-num     marital-status  race
## 14647  31          Private    Master              14           Divorced Other
## 14648  65 Self-emp-not-inc    Master              15      Never-married White
## 14649  43 Self-emp-not-inc Community              10 Married-civ-spouse White
## 14650  53          Private    Master              14 Married-civ-spouse White
## 14651  22          Private Community              10      Never-married White
## 14652  40          Private  HighGrad               9 Married-civ-spouse White
##       gender hours-per-week income  age.scale educational.num.scale
## 14647 Female             30  <=50K 0.19178082             0.8666667
## 14648   Male             60  <=50K 0.65753425             0.9333333
## 14649   Male             50  <=50K 0.35616438             0.6000000
## 14650   Male             40   >50K 0.49315068             0.8666667
## 14651   Male             40  <=50K 0.06849315             0.6000000
## 14652   Male             40   >50K 0.31506849             0.5333333
##       hours.per.week.scale marital.status income10 predicciones_prob
## 14647            0.2959184      Separated        0        0.13845090
## 14648            0.6020408    Not_married        0        0.39258175
## 14649            0.5000000        Married        0        0.36488993
## 14650            0.3979592        Married        1        0.84198092
## 14651            0.3979592    Not_married        0        0.03292608
## 14652            0.3979592        Married        1        0.27713903
##       income10.prediccion
## 14647                   0
## 14648                   0
## 14649                   0
## 14650                   1
## 14651                   0
## 14652                   0

Con lo anterior y de acuerdo a la fórmula: income10 ~ age.scale + workclass + education + marital.status + race + gender + hours.per.week.scale
- Se observa por ejemplo el registro 2, que una persona con las siguientes características:
  - age=63, workclass=Self-emp-not-inc, education=Master, marital.status=Married, race=White, gender=Male, hours.per.week=32, income=‘>50K’.
  - Teniendo un valor de income = 1, más de 50K
  - Se predijo con una probabilidad de 0.763796196 y siendo mayor a 0.5 su valor sería 1; que significa que tendrá ingresos mayores a 50000 mil dólares.
El modelo acertó en la predicción.

Matriz de confusión de las predicciones

Con los datos predecidos que se tienen en las.predicciones se genera la matriz de confusión

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

##         predicciones
## income10     0     1
##        0 10357   789
##        1  1762  1744

¿Qué tan precisa fue la predicción? - Se obtiene el total de casos de validación que se usaron para construir el modelo y se determina el valor de n - El modelo fué capaz de clasificar y predecir correctamente (10369 + 1731) / 14652 = 0.8258941 u (82.58%) de las observaciones. - Exactitud muy parecida a la exactitud de los datos de entrenamiento con los valores ajustados - El modelo fue capaz de predecir con una exactidud al 82%, o sea que se equivocó en 18% de los casos - Al final con este modelo hay que decir que se puede predecir con un 82% de exactitud una nueva observación

n = nrow(datos.Validacion)
exactidud <- (matriz_confusion[1,1] + matriz_confusion[2,2]) / n

exactidud

## [1] 0.8258941

Predecir con un nuevo registro

¿Cuál será la predicción de una persona con las siguientes características?
- age=53, workclass=Local-gov, education=HighGrad, marital.status=Married, race=White, gender=Male, hours.per.week=40,
- Con los valores escalados de age.scale = 1.04711018 y hours.per.week.scale = -0.03408661 Primero, identificar el registro a predecir conforme a los atributos del modelo
formula = income10 ~ age.scale + workclass + education + marital.status + race + gender + hours.per.week.scale
Crear un nuevo data.frame con un registro
Dar nombres de las columnas igual que el modelo

# filter (datos.Validacion, age == 53 & workclass == 'Local-gov' & education == 'HighGrad' & marital.status == 'Married' & race == 'White' & gender == 'Male' & hours.per.week == 40)
edad <- 53; horas <- 50
a.predecir <- data.frame(rbind(c(edad, 'Local-gov', 'HighGrad', 'Married', 'White' , 'Male', horas)))

colnames(a.predecir) <- c('age.scale', 'workclass', 'education', 'marital.status', 'race', 'gender', 'hours.per.week.scale')

Segundo, escalar los valores numéricos - Escalar significa centrar conforme con los valores mínimos y máximo de datos originales - Escalar el valor numérico de la edad igualando y con todos los valores de la edad de los datos originales - Escalar el valor de horas por semana ‘hours.per.week.scale’ de acuerdo a la columna hours.per.week de todos los datos originales - Modificar mutate() las columnas de age y hours.per.week - Se toman para este caso el primero registro [1] de los valores escalados: edad.escalada[1] y horas.escalada[1]

edad; horas

## [1] 53

## [1] 50

edad.escalada <- rescale(c(edad, min(datos$age), max(datos$age)))
edad.escalada <- edad.escalada[1]

# Escalando las horas por semana
horas.escalada<- rescale(c(horas, min(datos$hours.per.week), max(datos$hours.per.week)))

## Warning: Unknown or uninitialised column: 'hours.per.week'.

## Warning in min(datos$hours.per.week): ningún argumento finito para min;
## retornando Inf

## Warning: Unknown or uninitialised column: 'hours.per.week'.

## Warning in max(datos$hours.per.week): ningun argumento finito para max;
## retornando -Inf

horas.escalada <- horas.escalada[1]

a.predecir <- a.predecir %>%
  mutate(age.scale = edad.escalada,
         hours.per.week.scale = horas.escalada)
 
a.predecir

##   age.scale workclass education marital.status  race gender
## 1 0.4931507 Local-gov  HighGrad        Married White   Male
##   hours.per.week.scale
## 1                  0.5

Tercero, realizar la predicción con el nuevo registro - Realizar las predicciónes - Establecer la probabilidad de predicción - Determinar si es 0 a 1 la predicción

prediccion <- predict(modelo, a.predecir, se.fit = TRUE)
prediccion

## $fit
##          1 
## -0.3608282 
## 
## $se.fit
## [1] 0.06749201
## 
## $residual.scale
## [1] 1

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

##         1 
## 0.4107591

# Predecir si será 0 o 1 conforme a la probabilidad de predicción
if_else(prediccion_prob > 0.5, 1, 0)

## [1] 0

cat("La probabilidad y la predicción de que una persona con esas características gane >50K es: ", if_else(prediccion_prob > 0.5, 1, 0))

## La probabilidad y la predicción de que una persona con esas características gane >50K es:  0

Nuevas predicciones

Realizar predicciones con 10 nuevos registros y con características específicas de las personas con la finalidad de determinar si van a ganar más de 50 mil dólares ### Predecir con 10 nuevos registros #### Primero, identificar los registros a predecir conforme a los atributos del modelo

edad <- c(40,50,60,70,45,60,65,75,35,53)

clase.empleo <- c('Federal-gov', 'State-gov','Never-worked','Self-emp-inc', 'Federal-gov','Private', 'Private', 'Federal-gov', 'State-gov', 'Local-gov')
nivel.educacion <- c('HighGrad', 'HighGrad', 'HighGrad', 'HighGrad', 'Bachelors', 'Bachelors', 'Community', 'Community', 'Master', 'PhD')
edo.civil <- c('Married', 'Married', 'Separated', 'Widow', 'Not_married', 'Married', 'Separated', 'Widow', 'Married', 'Not_married')

raza <- c('White', 'Asian-Pac-Islander', 'Black', 'Other', 'White', 'White', 'Amer-Indian-Eskimo', 'Black', 'White', 'White')

genero <- c('Female', 'Male', 'Female', 'Male', 'Female', 'Male', 'Female', 'Male', 'Female', 'Male')

horas <- c(50,45,55,58,60,65,70,44,61,53)

a.predecir <- data.frame(rbind(cbind(edad, clase.empleo, nivel.educacion, edo.civil,raza, genero, horas)))

colnames(a.predecir) <- c('age.scale', 'workclass', 'education', 'marital.status', 'race', 'gender', 'hours.per.week.scale')

a.predecir

##    age.scale    workclass education marital.status               race gender
## 1         40  Federal-gov  HighGrad        Married              White Female
## 2         50    State-gov  HighGrad        Married Asian-Pac-Islander   Male
## 3         60 Never-worked  HighGrad      Separated              Black Female
## 4         70 Self-emp-inc  HighGrad          Widow              Other   Male
## 5         45  Federal-gov Bachelors    Not_married              White Female
## 6         60      Private Bachelors        Married              White   Male
## 7         65      Private Community      Separated Amer-Indian-Eskimo Female
## 8         75  Federal-gov Community          Widow              Black   Male
## 9         35    State-gov    Master        Married              White Female
## 10        53    Local-gov       PhD    Not_married              White   Male
##    hours.per.week.scale
## 1                    50
## 2                    45
## 3                    55
## 4                    58
## 5                    60
## 6                    65
## 7                    70
## 8                    44
## 9                    61
## 10                   53

Segundo - Escalar la edad y las horas trabajadas

Se escalan la edad y las horas trabajadas
Los primeros 10 valores escalados son los que interesan porque son 10 nuevos registros
Se escalan de igual forma con los valores originales de datos tanto en age como en hours.per.week

edad; horas

##  [1] 40 50 60 70 45 60 65 75 35 53

##  [1] 50 45 55 58 60 65 70 44 61 53

edad.escalada <- rescale(c(edad, min(datos$age), max(datos$age)))
edad.escalada <- edad.escalada[1:10]

# Escalando las horas por semana
horas.escalada<- rescale(c(horas, min(datos$hours.per.week), max(datos$hours.per.week)))

## Warning: Unknown or uninitialised column: 'hours.per.week'.

## Warning in min(datos$hours.per.week): ningún argumento finito para min;
## retornando Inf

## Warning: Unknown or uninitialised column: 'hours.per.week'.

## Warning in max(datos$hours.per.week): ningun argumento finito para max;
## retornando -Inf

horas.escalada <- horas.escalada[1:10]

a.predecir <- a.predecir %>%
  mutate(age.scale = edad.escalada,
         hours.per.week.scale = horas.escalada)
 
a.predecir

##    age.scale    workclass education marital.status               race gender
## 1  0.3150685  Federal-gov  HighGrad        Married              White Female
## 2  0.4520548    State-gov  HighGrad        Married Asian-Pac-Islander   Male
## 3  0.5890411 Never-worked  HighGrad      Separated              Black Female
## 4  0.7260274 Self-emp-inc  HighGrad          Widow              Other   Male
## 5  0.3835616  Federal-gov Bachelors    Not_married              White Female
## 6  0.5890411      Private Bachelors        Married              White   Male
## 7  0.6575342      Private Community      Separated Amer-Indian-Eskimo Female
## 8  0.7945205  Federal-gov Community          Widow              Black   Male
## 9  0.2465753    State-gov    Master        Married              White Female
## 10 0.4931507    Local-gov       PhD    Not_married              White   Male
##    hours.per.week.scale
## 1            0.23076923
## 2            0.03846154
## 3            0.42307692
## 4            0.53846154
## 5            0.61538462
## 6            0.80769231
## 7            1.00000000
## 8            0.00000000
## 9            0.65384615
## 10           0.34615385

Tercero - Realizar la predicción con los nuevos registros

Realizar la predicción
Establecer la probabilidad de predicción
Determinar si es 0 a 1 la predicción

prediccion <- predict(modelo, a.predecir, se.fit = TRUE)
prediccion

## $fit
##           1           2           3           4           5           6 
##  -0.9688213  -2.3000990 -11.6184416  -1.6757010  -0.4901021   2.5463636 
##           7           8           9          10 
##  -0.1033626  -2.2924585   1.5544869  -0.6459990 
## 
## $se.fit
##            1            2            3            4            5            6 
##   0.09806126   0.13305490 104.21710176   0.25736961   0.10504506   0.07364277 
##            7            8            9           10 
##   0.21604275   0.16940888   0.10583941   0.15255909 
## 
## $residual.scale
## [1] 1

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

##            1            2            3            4            5            6 
## 2.751155e-01 9.111476e-02 8.998519e-06 1.576656e-01 3.798695e-01 9.273288e-01 
##            7            8            9           10 
## 4.741823e-01 9.174947e-02 8.255608e-01 3.438917e-01

# Predecir si será 0 o 1 conforme a la probabilidad de predicción
las.predicciones <- if_else(prediccion_prob > 0.5, 1, 0)

cat("Son las predicciones para las personas con esas características ")

## Son las predicciones para las personas con esas características

las.predicciones

##  [1] 0 0 0 0 0 1 0 0 1 0

print("Las predicciones en la columna final")

## [1] "Las predicciones en la columna final"

cbind(a.predecir ,las.predicciones)

##    age.scale    workclass education marital.status               race gender
## 1  0.3150685  Federal-gov  HighGrad        Married              White Female
## 2  0.4520548    State-gov  HighGrad        Married Asian-Pac-Islander   Male
## 3  0.5890411 Never-worked  HighGrad      Separated              Black Female
## 4  0.7260274 Self-emp-inc  HighGrad          Widow              Other   Male
## 5  0.3835616  Federal-gov Bachelors    Not_married              White Female
## 6  0.5890411      Private Bachelors        Married              White   Male
## 7  0.6575342      Private Community      Separated Amer-Indian-Eskimo Female
## 8  0.7945205  Federal-gov Community          Widow              Black   Male
## 9  0.2465753    State-gov    Master        Married              White Female
## 10 0.4931507    Local-gov       PhD    Not_married              White   Male
##    hours.per.week.scale las.predicciones
## 1            0.23076923                0
## 2            0.03846154                0
## 3            0.42307692                0
## 4            0.53846154                0
## 5            0.61538462                0
## 6            0.80769231                1
## 7            1.00000000                0
## 8            0.00000000                0
## 9            0.65384615                1
## 10           0.34615385                0

Predecir con 10 nuevos registros (ejercicio)

edad <- c(35,55,65,71,42,60,65,75,35,53)

clase.empleo <- c('Self-emp-inc','State-gov','Never-worked','Self-emp-inc', 'Federal-gov','Private', 'Private', 'Federal-gov', 'State-gov', 'Local-gov')
nivel.educacion <- c('HighGrad', 'HighGrad', 'Bachelors', 'HighGrad', 'Bachelors', 'Bachelors', 'Community', 'Community', 'Master', 'PhD')
edo.civil <- c('Married', 'Separated', 'Separated', 'Widow', 'Not_married', 'Married', 'Separated', 'Widow', 'Married', 'Not_married')

raza <- c('White', 'Asian-Pac-Islander', 'Black', 'Other', 'White', 'White', 'Amer-Indian-Eskimo', 'Black', 'White', 'White')

genero <- c('Male', 'Male', 'Female', 'Male', 'Female', 'Male', 'Female', 'Male', 'Female', 'Male')

horas <- c(45,55,50,52,50,34,40,44,60,53)

a.predecir <- data.frame(rbind(cbind(edad, clase.empleo, nivel.educacion, edo.civil,raza, genero, horas)))

colnames(a.predecir) <- c('age.scale', 'workclass', 'education', 'marital.status', 'race', 'gender', 'hours.per.week.scale')

a.predecir

##    age.scale    workclass education marital.status               race gender
## 1         35 Self-emp-inc  HighGrad        Married              White   Male
## 2         55    State-gov  HighGrad      Separated Asian-Pac-Islander   Male
## 3         65 Never-worked Bachelors      Separated              Black Female
## 4         71 Self-emp-inc  HighGrad          Widow              Other   Male
## 5         42  Federal-gov Bachelors    Not_married              White Female
## 6         60      Private Bachelors        Married              White   Male
## 7         65      Private Community      Separated Amer-Indian-Eskimo Female
## 8         75  Federal-gov Community          Widow              Black   Male
## 9         35    State-gov    Master        Married              White Female
## 10        53    Local-gov       PhD    Not_married              White   Male
##    hours.per.week.scale
## 1                    45
## 2                    55
## 3                    50
## 4                    52
## 5                    50
## 6                    34
## 7                    40
## 8                    44
## 9                    60
## 10                   53

Segundo - Escalar la edad y las horas trabajadas

Se escalan la edad y las horas trabajadas
Los primeros 10 valores escalados son los que interesan porque son 10 nuevos registros
Se escalan de igual forma con los valores originales de datos tanto en age como en hours.per.week

edad; horas

##  [1] 35 55 65 71 42 60 65 75 35 53

##  [1] 45 55 50 52 50 34 40 44 60 53

edad.escalada <- rescale(c(edad, min(datos$age), max(datos$age)))
edad.escalada <- edad.escalada[1:10]

# Escalando las horas por semana
horas.escalada<- rescale(c(horas, min(datos$hours.per.week), max(datos$hours.per.week)))

## Warning: Unknown or uninitialised column: 'hours.per.week'.

## Warning in min(datos$hours.per.week): ningún argumento finito para min;
## retornando Inf

## Warning: Unknown or uninitialised column: 'hours.per.week'.

## Warning in max(datos$hours.per.week): ningun argumento finito para max;
## retornando -Inf

horas.escalada <- horas.escalada[1:10]

a.predecir <- a.predecir %>%
  mutate(age.scale = edad.escalada,
         hours.per.week.scale = horas.escalada)
 
a.predecir

##    age.scale    workclass education marital.status               race gender
## 1  0.2465753 Self-emp-inc  HighGrad        Married              White   Male
## 2  0.5205479    State-gov  HighGrad      Separated Asian-Pac-Islander   Male
## 3  0.6575342 Never-worked Bachelors      Separated              Black Female
## 4  0.7397260 Self-emp-inc  HighGrad          Widow              Other   Male
## 5  0.3424658  Federal-gov Bachelors    Not_married              White Female
## 6  0.5890411      Private Bachelors        Married              White   Male
## 7  0.6575342      Private Community      Separated Amer-Indian-Eskimo Female
## 8  0.7945205  Federal-gov Community          Widow              Black   Male
## 9  0.2465753    State-gov    Master        Married              White Female
## 10 0.4931507    Local-gov       PhD    Not_married              White   Male
##    hours.per.week.scale
## 1             0.4230769
## 2             0.8076923
## 3             0.6153846
## 4             0.6923077
## 5             0.6153846
## 6             0.0000000
## 7             0.2307692
## 8             0.3846154
## 9             1.0000000
## 10            0.7307692

Tercero - Realizar la predicción con los nuevos registros

Realizar la predicción
Establecer la probabilidad de predicción
Determinar si es 0 a 1 la predicción

prediccion2 <- predict(modelo, a.predecir, se.fit = TRUE)
prediccion2

## $fit
##           1           2           3           4           5           6 
## -0.62650199 -1.83755130 -9.25228950 -1.16270967 -0.58149631  0.01309886 
##           7           8           9          10 
## -2.51599564 -1.08614200  2.64017176  0.56031750 
## 
## $se.fit
##            1            2            3            4            5            6 
##   0.07944174   0.14556538 104.21711997   0.25952865   0.10429360   0.07398075 
##            7            8            9           10 
##   0.19904399   0.16130387   0.13102211   0.15712413 
## 
## $residual.scale
## [1] 1

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

##            1            2            3            4            5            6 
## 2.751155e-01 9.111476e-02 8.998519e-06 1.576656e-01 3.798695e-01 9.273288e-01 
##            7            8            9           10 
## 4.741823e-01 9.174947e-02 8.255608e-01 3.438917e-01

# Predecir si será 0 o 1 conforme a la probabilidad de predicción
las.predicciones <- if_else(prediccion_prob > 0.5, 1, 0)

cat("Son las predicciones para las personas con esas características ")

## Son las predicciones para las personas con esas características

las.predicciones

##  [1] 0 0 0 0 0 1 0 0 1 0

print("Las predicciones en la columna final")

## [1] "Las predicciones en la columna final"

cbind(a.predecir ,las.predicciones)

##    age.scale    workclass education marital.status               race gender
## 1  0.2465753 Self-emp-inc  HighGrad        Married              White   Male
## 2  0.5205479    State-gov  HighGrad      Separated Asian-Pac-Islander   Male
## 3  0.6575342 Never-worked Bachelors      Separated              Black Female
## 4  0.7397260 Self-emp-inc  HighGrad          Widow              Other   Male
## 5  0.3424658  Federal-gov Bachelors    Not_married              White Female
## 6  0.5890411      Private Bachelors        Married              White   Male
## 7  0.6575342      Private Community      Separated Amer-Indian-Eskimo Female
## 8  0.7945205  Federal-gov Community          Widow              Black   Male
## 9  0.2465753    State-gov    Master        Married              White Female
## 10 0.4931507    Local-gov       PhD    Not_married              White   Male
##    hours.per.week.scale las.predicciones
## 1             0.4230769                0
## 2             0.8076923                0
## 3             0.6153846                0
## 4             0.6923077                0
## 5             0.6153846                0
## 6             0.0000000                1
## 7             0.2307692                0
## 8             0.3846154                0
## 9             1.0000000                1
## 10            0.7307692                0

Análisis de Regresión Logística de datos adultos

AlejandroC

26/3/2020

Análisis de regresión logística para predicción de ingresos de personas

Descripción

Objetivo

Las librerías

Los datos

Cargando los datos

Explorando los datos

Los primeros diez registros:

Los últimos diez registros:

La estructura de los datos:

Estructura y resumen de los datos

Proceso para analizar los datos

Paso 1 - Identificar las variables númericas

Análisis de la variable hours.per.week

Análisis de la variable age

Estandarizar los valores numéricos

Paso 2 - Identificar las variables factor

Frecuencias de cada variable factores

Variable workclass

Variable education

Variable marital.status

Variable race

Variable gender

Paso 3 - Ingeniería de datos

Agrupar estadísticamente la variable nivel de educación

Recategorizar la variable marital.status

Frecuencia de la variable marital.status

Paso 4 - Estadísticos descriptivos

Origen o raza de persona y su ingreso (race, income)

Horas trabajadas por semana y el género de persona (hours.per.week, gender)

Horas trabajadas por semana y el nivel educativo (hours.per.week, education)

No linealidad de los datos

Recodificar la variable income a income10

Nombres de las variables de datos recategorizados

Generar un archivo con datos ajustados

Paso 5 - Conjunto de datos de entrenamiento y de validación Train/Test set

Datos de entrenamiento

Datos de validación

Paso 6 - Regresión Logística

Construir el modelo

Interpretación del modelo

Paso 7 - Evaluar el modelo

Matriz de confusión

Paso 8 - Predicciones con datos de validación

Matriz de confusión de las predicciones

Predecir con un nuevo registro

Nuevas predicciones

Segundo - Escalar la edad y las horas trabajadas

Tercero - Realizar la predicción con los nuevos registros

Predecir con 10 nuevos registros (ejercicio)

Segundo - Escalar la edad y las horas trabajadas

Tercero - Realizar la predicción con los nuevos registros