Practica 11
Laura Alarcón
1/4/2020
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 podría ser 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 denominado “adultos.csv” se utiliza tanto para la tarea de clasificacióny predicción. Objetivo Predecir si el ingreso anual en dólares de un individuo excederá los $ 50,000.
Las librerías
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages -------------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.2.1 v purrr 0.3.3
## v tibble 2.1.3 v dplyr 0.8.4
## v tidyr 1.0.2 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ----------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(dplyr) # select filter mutate ...
library(ggplot2) # Gráficas
library(fdth) # Para tablas de distribución y frecuencias##
## Attaching package: 'fdth'## The following objects are masked from 'package:stats':
##
## sd, varlibrary(knitr) # Para ver tablas mas amigables en formato html markdown
library(caret) # Pra particionar datos## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## liftlibrary(reshape) # Para renombrar columnas en caso de necesitarse## Warning: package 'reshape' was built under R version 3.6.3##
## Attaching package: 'reshape'## The following object is masked from 'package:dplyr':
##
## rename## The following objects are masked from 'package:tidyr':
##
## expand, smithslibrary(scales) # Para escalar datos##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factorLos datos
Se identifica la ruta en donde están los datos En la variable datos se carga el conjunto de datos de adultos.csv
setwd("C:/Users/sm13m/OneDrive/Documentos/ITD/Ing. Sistemas Computacionales/Semestre 8/Analisis inteligente de datos/Ranalisis inteligente de datos/datos")
datos <- read.csv("adultos.csv")Explorando datos
Los primeros diez registros
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
kable(tail(datos,10))| x | age | workclass | education | educational.num | marital.status | race | gender | hours.per.week | income | |
|---|---|---|---|---|---|---|---|---|---|---|
| 48833 | 48833 | 32 | Private | 10th | 6 | Married-civ-spouse | Amer-Indian-Eskimo | Male | 40 | <=50K |
| 48834 | 48834 | 43 | Private | Assoc-voc | 11 | Married-civ-spouse | White | Male | 45 | <=50K |
| 48835 | 48835 | 32 | Private | Masters | 14 | Never-married | Asian-Pac-Islander | Male | 11 | <=50K |
| 48836 | 48836 | 53 | Private | Masters | 14 | Married-civ-spouse | White | Male | 40 | >50K |
| 48837 | 48837 | 22 | Private | Some-college | 10 | Never-married | White | Male | 40 | <=50K |
| 48838 | 48838 | 27 | Private | Assoc-acdm | 12 | Married-civ-spouse | White | Female | 38 | <=50K |
| 48839 | 48839 | 40 | Private | HS-grad | 9 | Married-civ-spouse | White | Male | 40 | >50K |
| 48840 | 48840 | 58 | Private | HS-grad | 9 | Widowed | White | Female | 40 | <=50K |
| 48841 | 48841 | 22 | Private | HS-grad | 9 | Never-married | White | Male | 20 | <=50K |
| 48842 | 48842 | 52 | Self-emp-inc | HS-grad | 9 | Married-civ-spouse | White | Female | 40 | >50K |
| La estru | ctrua de | los d | atos | |||||||
| Resumen | de los d | atos: | ||||||||
| x Variab | le de co | nsecut | ivo de los dato | s | ||||||
| age la e | dad de l | a pers | ona | |||||||
| workclas | s es un | tipo o | clase de traba | jo de la person | a, privado, gobier | no, por su cuenta, | ||||
| educatio | n indica | el ni | vel educativo d | e la persona | ||||||
| educatio | nal es e | l valo | r numérico de e | ducation | ||||||
| marital | es su es | tado c | ivil | |||||||
| race es | el tipo | de raz | a de persona | |||||||
| gender e | s el gén | ero de | la persona | |||||||
| hours.pe | r.week s | on las | horas que trba | ja por semana | ||||||
| income s | on los i | ngreso | s | |||||||
| # Estruc | tura y r | esumen | de los datos |
datos[-1]. Excepto la columna x que no interesa
str(datos)## 'data.frame': 48842 obs. of 10 variables:
## $ x : int 1 2 3 4 5 6 7 8 9 10 ...
## $ age : int 25 38 28 44 18 34 29 63 24 55 ...
## $ workclass : Factor w/ 9 levels "?","Federal-gov",..: 5 5 3 5 1 5 1 7 5 5 ...
## $ education : Factor w/ 16 levels "10th","11th",..: 2 12 8 16 16 1 12 15 16 6 ...
## $ educational.num: int 7 9 12 10 10 6 9 15 10 4 ...
## $ marital.status : Factor w/ 7 levels "Divorced","Married-AF-spouse",..: 5 3 3 3 5 5 5 3 5 3 ...
## $ race : Factor w/ 5 levels "Amer-Indian-Eskimo",..: 3 5 5 3 5 5 3 5 5 5 ...
## $ gender : Factor w/ 2 levels "Female","Male": 2 2 2 2 1 2 2 2 1 2 ...
## $ hours.per.week : int 40 50 40 40 30 30 40 32 40 10 ...
## $ income : Factor w/ 2 levels "<=50K",">50K": 1 1 2 2 1 1 1 2 1 1 ...kable(summary(datos[-1]))| age | workclass | education | educational.num | marital.status | race | gender | hours.per.week | income | |
|---|---|---|---|---|---|---|---|---|---|
| Min. :17.00 | Private :33906 | HS-grad :15784 | Min. : 1.00 | Divorced : 6633 | Amer-Indian-Eskimo: 470 | Female:16192 | Min. : 1.00 | <=50K:37155 | |
| 1st Qu.:28.00 | Self-emp-not-inc: 3862 | Some-college:10878 | 1st Qu.: 9.00 | Married-AF-spouse : 37 | Asian-Pac-Islander: 1519 | Male :32650 | 1st Qu.:40.00 | >50K :11687 | |
| Median :37.00 | Local-gov : 3136 | Bachelors : 8025 | Median :10.00 | Married-civ-spouse :22379 | Black : 4685 | NA | Median :40.00 | NA | |
| Mean :38.64 | ? : 2799 | Masters : 2657 | Mean :10.08 | Married-spouse-absent: 628 | Other : 406 | NA | Mean :40.42 | NA | |
| 3rd Qu.:48.00 | State-gov : 1981 | Assoc-voc : 2061 | 3rd Qu.:12.00 | Never-married :16117 | White :41762 | NA | 3rd Qu.:45.00 | NA | |
| Max. :90.00 | Self-emp-inc : 1695 | 11th : 1812 | Max. :16.00 | Separated : 1530 | NA | NA | Max. :99.00 | NA | |
| NA | (Other) : 1463 | (Other) : 7625 | NA | Widowed : 1518 | NA | NA | NA | NA | |
| # Pro | ceso para analiz | ar los datos | |||||||
| De lo | s pasos 1 al 4 s | e pueden integrar en fase | s de ciencia de los d | atos 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 variables numéricas
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: hours.per.week age education.num es un valor numérico del factor education por lo que se analiza en las variables tipo factor mas adelante
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 distribucion 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 = hours.per.week)) +
geom_density(alpha = .2, fill = "#FF6666")
distribucion <- fdt(numericas$hours.per.week,breaks="Sturges")kable(distribucion)
|
|
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 distribucion 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)
|
|
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 distribucion 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)
|
|
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(educational.num), hours.per.week.scale = rescale(hours.per.week) )
head(escalados, 10)## age workclass education educational.num marital.status race
## 1 25 Private 11th 7 Never-married Black
## 2 38 Private HS-grad 9 Married-civ-spouse White
## 3 28 Local-gov Assoc-acdm 12 Married-civ-spouse White
## 4 44 Private Some-college 10 Married-civ-spouse Black
## 5 18 ? Some-college 10 Never-married White
## 6 34 Private 10th 6 Never-married White
## 7 29 ? HS-grad 9 Never-married Black
## 8 63 Self-emp-not-inc Prof-school 15 Married-civ-spouse White
## 9 24 Private Some-college 10 Never-married White
## 10 55 Private 7th-8th 4 Married-civ-spouse White
## gender hours.per.week income age.scale educational.num.scale
## 1 Male 40 <=50K 0.10958904 0.4000000
## 2 Male 50 <=50K 0.28767123 0.5333333
## 3 Male 40 >50K 0.15068493 0.7333333
## 4 Male 40 >50K 0.36986301 0.6000000
## 5 Female 30 <=50K 0.01369863 0.6000000
## 6 Male 30 <=50K 0.23287671 0.3333333
## 7 Male 40 <=50K 0.16438356 0.5333333
## 8 Male 32 >50K 0.63013699 0.9333333
## 9 Female 40 <=50K 0.09589041 0.6000000
## 10 Male 10 <=50K 0.52054795 0.2000000
## hours.per.week.scale
## 1 0.39795918
## 2 0.50000000
## 3 0.39795918
## 4 0.39795918
## 5 0.29591837
## 6 0.29591837
## 7 0.39795918
## 8 0.31632653
## 9 0.39795918
## 10 0.09183673tail(escalados, 10)## age workclass education educational.num marital.status
## 48833 32 Private 10th 6 Married-civ-spouse
## 48834 43 Private Assoc-voc 11 Married-civ-spouse
## 48835 32 Private Masters 14 Never-married
## 48836 53 Private Masters 14 Married-civ-spouse
## 48837 22 Private Some-college 10 Never-married
## 48838 27 Private Assoc-acdm 12 Married-civ-spouse
## 48839 40 Private HS-grad 9 Married-civ-spouse
## 48840 58 Private HS-grad 9 Widowed
## 48841 22 Private HS-grad 9 Never-married
## 48842 52 Self-emp-inc HS-grad 9 Married-civ-spouse
## race gender hours.per.week income age.scale
## 48833 Amer-Indian-Eskimo Male 40 <=50K 0.20547945
## 48834 White Male 45 <=50K 0.35616438
## 48835 Asian-Pac-Islander Male 11 <=50K 0.20547945
## 48836 White Male 40 >50K 0.49315068
## 48837 White Male 40 <=50K 0.06849315
## 48838 White Female 38 <=50K 0.13698630
## 48839 White Male 40 >50K 0.31506849
## 48840 White Female 40 <=50K 0.56164384
## 48841 White Male 20 <=50K 0.06849315
## 48842 White Female 40 >50K 0.47945205
## educational.num.scale hours.per.week.scale
## 48833 0.3333333 0.3979592
## 48834 0.6666667 0.4489796
## 48835 0.8666667 0.1020408
## 48836 0.8666667 0.3979592
## 48837 0.6000000 0.3979592
## 48838 0.7333333 0.3775510
## 48839 0.5333333 0.3979592
## 48840 0.5333333 0.3979592
## 48841 0.5333333 0.1938776
## 48842 0.5333333 0.3979592paso 2: Identificar 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)## workclass education marital.status
## Private :33906 HS-grad :15784 Divorced : 6633
## Self-emp-not-inc: 3862 Some-college:10878 Married-AF-spouse : 37
## Local-gov : 3136 Bachelors : 8025 Married-civ-spouse :22379
## ? : 2799 Masters : 2657 Married-spouse-absent: 628
## State-gov : 1981 Assoc-voc : 2061 Never-married :16117
## Self-emp-inc : 1695 11th : 1812 Separated : 1530
## (Other) : 1463 (Other) : 7625 Widowed : 1518
## race gender income
## Amer-Indian-Eskimo: 470 Female:16192 <=50K:37155
## Asian-Pac-Islander: 1519 Male :32650 >50K :11687
## Black : 4685
## Other : 406
## White :41762
##
## kable(summary(factores) )| workclass | education | marital.status | race | gender i | ncome | |
|---|---|---|---|---|---|---|
| Private :33906 | HS-grad :15784 | Divorced : 6633 | Amer-Indian-Eskimo: 470 | Female:16192 | <=50K:37155 | |
| Self-emp-not-inc: 3862 | Some-college:10878 | Married-AF-spouse : 37 | Asian-Pac-Islander: 1519 | Male :32650 | >50K :11687 | |
| Local-gov : 3136 | Bachelors : 8025 | Married-civ-spouse :22379 | Black : 4685 | NA | NA | |
| ? : 2799 | Masters : 2657 | Married-spouse-absent: 628 | Other : 406 | NA | NA | |
| State-gov : 1981 | Assoc-voc : 2061 | Never-married :16117 | White :41762 | NA | NA | |
| Self-emp-inc : 1695 | 11th : 1812 | Separated : 1530 | NA | NA | NA | |
| (Other) : 1463 | (Other) : 7625 | Widowed : 1518 | NA | NA | NA |
str(factores)## 'data.frame': 48842 obs. of 6 variables:
## $ workclass : Factor w/ 9 levels "?","Federal-gov",..: 5 5 3 5 1 5 1 7 5 5 ...
## $ education : Factor w/ 16 levels "10th","11th",..: 2 12 8 16 16 1 12 15 16 6 ...
## $ marital.status: Factor w/ 7 levels "Divorced","Married-AF-spouse",..: 5 3 3 3 5 5 5 3 5 3 ...
## $ race : Factor w/ 5 levels "Amer-Indian-Eskimo",..: 3 5 5 3 5 5 3 5 5 5 ...
## $ gender : Factor w/ 2 levels "Female","Male": 2 2 2 2 1 2 2 2 1 2 ...
## $ income : Factor w/ 2 levels "<=50K",">50K": 1 1 2 2 1 1 1 2 1 1 ...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 distribució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% Mientras que del 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)
# Variable income Tabla de distribución Se observa que hay dos tipos de income (Sueldos y salarios o lo que ganan en dinero) ‘<=50 mil’ y ‘>50 mil’ De la categoría ‘<=50’ hay 37155 y representan el 76% De la categoría ‘>50’ hay 11687 casos y representan el 23.92%
kable(distribucion$income)
|
Gráfica de barra
barplot(height = distribucion$income$table$f, names.arg = distribucion$income$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 |
| # Agru | par estadíst | icamente la | variable nivel de | educación | |||||||
| Se agr | upa por la v | ariable educ | ation ya recategor | izada | |||||||
| Se enc | uentra la me | dia de la va | riable educational | .num que previamente | había si | do escala | da | ||||
| Se det | erminar cuan | tos de cada | grupo |
recategorizados %>%
group_by(education) %>%
summarize(promedio_educacion = mean(educational.num),
cuantos = n()) %>%
arrange(promedio_educacion)## # A tibble: 6 x 3
## education promedio_educacion cuantos
## <fct> <dbl> <int>
## 1 Dropout 5.61 6408
## 2 HighGrad 9 15784
## 3 Community 10.4 14540
## 4 Bachelors 13 8025
## 5 Master 14.2 3491
## 6 PhD 16 594Recategorizar 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) Asi mismo, se deja en el nuevo conjunto de datos llamado recategorizados
temporal <- recategorizados %>%
mutate(marital.status=factor(ifelse(marital.status=="Never-married" | marital.status=="Married-spouse-absent","Not_married",ifelse(marital.status == "Married-civ-spouse" | marital.status=="Married-AF-spouse","Married",ifelse(marital.status=="Divorced" | marital.status=="Separated","Separated","Widow")))))
recategorizados <- temporal
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 | Not_married | Black | Male | 40 | <=50K | 0.1095890 | 0.4000000 | 0.3979592 |
| 38 | Private | HighGrad | 9 | Married | White | Male | 50 | <=50K | 0.2876712 | 0.5333333 | 0.5000000 |
| 28 | Local-gov | Community | 12 | Married | White | Male | 40 | >50K | 0.1506849 | 0.7333333 | 0.3979592 |
| 44 | Private | Community | 10 | Married | Black | Male | 40 | >50K | 0.3698630 | 0.6000000 | 0.3979592 |
| 18 | ? | Community | 10 | Not_married | White | Female | 30 | <=50K | 0.0136986 | 0.6000000 | 0.2959184 |
| 34 | Private | Dropout | 6 | Not_married | White | Male | 30 | <=50K | 0.2328767 | 0.3333333 | 0.2959184 |
| # Frec | uencia de la | variable ma | rital.status | ||||||||
| Se obs | ervan las fr | ecuencias de | l estado civil (ma | rital.status.R) r | ecategor | izadas |
table(recategorizados$marital.status)##
## Married Not_married Separated Widow
## 22416 16745 8163 1518paso 4: Estadísticos descriptivos
Algunos valores estadísticos del conjunto de datos escalados y categorizados. Conjunto de datos = recategorizados # Género y suedos (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 ngreso (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)## age workclass education educational.num marital.status race gender
## 1 25 Private Dropout 7 Not_married Black Male
## 2 38 Private HighGrad 9 Married White Male
## 3 28 Local-gov Community 12 Married White Male
## 4 44 Private Community 10 Married Black Male
## 5 18 ? Community 10 Not_married White Female
## 6 34 Private Dropout 6 Not_married White Male
## hours.per.week income age.scale educational.num.scale hours.per.week.scale
## 1 40 <=50K 0.10958904 0.4000000 0.3979592
## 2 50 <=50K 0.28767123 0.5333333 0.5000000
## 3 40 >50K 0.15068493 0.7333333 0.3979592
## 4 40 >50K 0.36986301 0.6000000 0.3979592
## 5 30 <=50K 0.01369863 0.6000000 0.2959184
## 6 30 <=50K 0.23287671 0.3333333 0.2959184ggplot(recategorizados, aes(x = gender, y = 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 = 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 = 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 = 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)])## income income10
## 1 <=50K 0
## 2 <=50K 0
## 3 >50K 1
## 4 >50K 1
## 5 <=50K 0
## 6 <=50K 0Nombres 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] "income10"head(recategorizados)## age workclass education educational.num marital.status race gender
## 1 25 Private Dropout 7 Not_married Black Male
## 2 38 Private HighGrad 9 Married White Male
## 3 28 Local-gov Community 12 Married White Male
## 4 44 Private Community 10 Married Black Male
## 5 18 ? Community 10 Not_married White Female
## 6 34 Private Dropout 6 Not_married White Male
## hours.per.week income age.scale educational.num.scale hours.per.week.scale
## 1 40 <=50K 0.10958904 0.4000000 0.3979592
## 2 50 <=50K 0.28767123 0.5333333 0.5000000
## 3 40 >50K 0.15068493 0.7333333 0.3979592
## 4 40 >50K 0.36986301 0.6000000 0.3979592
## 5 30 <=50K 0.01369863 0.6000000 0.2959184
## 6 30 <=50K 0.23287671 0.3333333 0.2959184
## income10
## 1 0
## 2 0
## 3 1
## 4 1
## 5 0
## 6 0Generar 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] "~$aluación Unidad II.docx"
## [2] "~$ra la elaboración de las tareas adicionales.docx"
## [3] "~$rangocontrato.docx"
## [4] "~$rco-Teorico.docx"
## [5] "~$TALLER_INVESTIGACION_ITD_2019.ppt"
## [6] "1398197092_jdatechooser.zip"
## [7] "177420677VPI.pdf"
## [8] "2.2.4.4 Laura Alarcon"
## [9] "2.2.4.4 Laura Alarcon..rar"
## [10] "2019-09-09_003522.jpg"
## [11] "2019-11-26_114114.jpg"
## [12] "2019-11-26_114147.jpg"
## [13] "2019-11-26_114231.jpg"
## [14] "2019-11-26_114520.jpg"
## [15] "2019-11-26_114535.jpg"
## [16] "245-1-913-1-10-20131227.pdf"
## [17] "30-palabras-difíciles-de-pronunciar-en-inglés.pdf"
## [18] "39077377_1798066246907188_264862219303387136_n.jpg"
## [19] "44310803.pdf"
## [20] "49763043_2292870800941938_9048936282339672064_n.jpg"
## [21] "4ukey-for-android.exe"
## [22] "5.1.1.6 Lab - Configuring Basic Switch Settings.pdf"
## [23] "5.2.1.4-Packet-Tracer-Configuring-SSH-1.pka"
## [24] "5.2.1.4-Packet-Tracer-Configuring-SSH-1.zip"
## [25] "5.2.1.4-Packet-Tracer-Configuring-SSH-Instruction.pdf"
## [26] "5.2.1.4 Packet Tracer - Configuring SSH (1).pka"
## [27] "5.2.1.4 Packet Tracer - Configuring SSH Instruction (1).pdf"
## [28] "5.2.1.4 Packet Tracer - Configuring SSH Instruction.pdf"
## [29] "5.2.1.4 Packet Tracer - Configuring SSH.pka"
## [30] "55451755_2011826879123440_2330352708239753216_n.jpg"
## [31] "6001.18000.080118-1840_x86fre_Server_es-es-KRMSFRE_ES_DVD.iso"
## [32] "69612792_2277136135932127_7429287141307318272_n.jpg"
## [33] "69615842_2225631731025484_1543610150965739520_n.jpg"
## [34] "69652295_1174188032768792_7481341457740070912_n.jpg"
## [35] "70016552_409001166483504_4369815124131708928_n.jpg"
## [36] "70830089_420817588538105_2852515878396755968_n.jpg"
## [37] "71285160835-1101246971-ticket.pdf"
## [38] "73370524_1486063768199176_3678969677519781888_n.jpg"
## [39] "73533047_2473865736044465_8140158027555667968_o.jpg"
## [40] "73533053_2473864629377909_3388800901023006720_o.jpg"
## [41] "74229523_2473864879377884_2380155117484638208_o.jpg"
## [42] "74286887_2560061637373525_5196186966688792576_n.jpg"
## [43] "74505944_415083615798546_8701962526084038656_o.png"
## [44] "75251054_2473865476044491_1357644277571649536_o.jpg"
## [45] "76732178_2383237605262615_3018237019714224128_n.jpg"
## [46] "76784567_2197314167240018_3595385482181083136_n.jpg"
## [47] "77113898_795544964217669_2908110244313825280_n.jpg"
## [48] "78253005_959793631067188_3838086688144359424_n.jpg"
## [49] "78381913_769880363478938_3219121217197834240_n.jpg"
## [50] "84092815_634364677298693_8772525239574724608_n.jpg"
## [51] "84754843_817879911970256_2318594668331270144_n.jpg"
## [52] "87387477_2523271694614710_3075947825255677952_n.jpg"
## [53] "88321444_2720919128005790_1580752461205864448_o.jpg"
## [54] "88397682_2946728942051635_7547359485946232832_o.jpg"
## [55] "89119016_675675546568451_5909468540770975744_n.png"
## [56] "89336447_708390102899508_3671147455447040000_n.png"
## [57] "89356670_206012010816295_2512361439285477376_n.png"
## [58] "89690838_260574734934532_6929990548832911360_n (1).png"
## [59] "89690838_260574734934532_6929990548832911360_n.png"
## [60] "89691423_506429373603480_5692664802191605760_n.png"
## [61] "89736697_2946728932051636_8624864100729487360_o.jpg"
## [62] "90356528_3137491646261091_4988242585999900672_n.jpg"
## [63] "90727823_3711840612191430_449023983094857728_n.jpg"
## [64] "91805613_2856631661098428_4152764738465431552_n.jpg"
## [65] "93376828_543906519858346_4376213848013668352_n.jpg"
## [66] "93620805_518726885466751_3334120976592928768_n.jpg"
## [67] "ACT_NAC.pdf"
## [68] "Actividad_1_AAAG691106MZ4_GZDW.pdf"
## [69] "Actividad_2_AAAG691106MZ4_0WNV.pdf"
## [70] "adultos.csv"
## [71] "adultos_clean.csv"
## [72] "anaconda.jpg"
## [73] "Análisis Predictivo de Datos.pptx"
## [74] "analisis sintactico"
## [75] "Analisis_Inteligente_de_Datos.pdf"
## [76] "Analizador.zip"
## [77] "app-release.apk"
## [78] "app-release.zip"
## [79] "articulos .rar"
## [80] "as-installer-7.0.2389-web.exe"
## [81] "ast.jpg"
## [82] "AtomSetup-x64.exe"
## [83] "attachments.zip"
## [84] "Audacity_crear_pistas_sonoras.pdf"
## [85] "auto-mpg.csv"
## [86] "Autor-valoracion.docx"
## [87] "autorun.inf"
## [88] "AVvector.pdf"
## [89] "baboon.png"
## [90] "bash-it-master"
## [91] "bash-it-master.zip"
## [92] "boletín-digital-OBTUBRE.pdf"
## [93] "boletín-digitl-SEPTIEMBRE.pdf"
## [94] "breast-cancer (1).arff"
## [95] "Brief-New-Faces-Oficial.pdf"
## [96] "buy-computer_ver_clase (1).xls"
## [97] "buy-computer_ver_clase.xls"
## [98] "c2n14-copia.mid.jpg"
## [99] "Calificaciones_6Y.pdf"
## [100] "carmona-Ecuaciones-diferenciales.pdf"
## [101] "carta compromiso jovenes construyendo el futuro Laura Alarcon.pdf"
## [102] "Caso estadistica descriptiva (1).xlsx"
## [103] "CCS_4.104.rar"
## [104] "Cedula_AAGL980130MDGLRR04 (1).pdf"
## [105] "Cedula_AAGL980130MDGLRR04.pdf"
## [106] "ChromeSetup.exe"
## [107] "cofidi.60292731027E6F1-3BE0-4880-918A-D101B173DFD7.pdf"
## [108] "cofidi.60292731027E6F1-3BE0-4880-918A-D101B173DFD7.xml"
## [109] "cofidi.6131027996D2315-87F0-4F88-A295-1DF3B00FF121.pdf"
## [110] "cofidi.6131027996D2315-87F0-4F88-A295-1DF3B00FF121.xml"
## [111] "cofidi.6345600C73B583D-64A8-49CE-99B2-6C4B7F90F85F.pdf"
## [112] "cofidi.6345600C73B583D-64A8-49CE-99B2-6C4B7F90F85F.xml"
## [113] "ColaBanco.rar"
## [114] "COMANDOS AUTOCAD.pdf"
## [115] "comprobante de ingresos.docx"
## [116] "comprobanteLocalizacion25159850301.pdf"
## [117] "Conexion.jmx"
## [118] "ConexionDB.java"
## [119] "consulta para reporte.sql"
## [120] "Contrato-Laura Yesenia Alarcon Garvalena.pdf"
## [121] "corina_schmelkes_metodologia_dela_invest.pdf"
## [122] "coronavirus.jpg"
## [123] "COTIZACIÓN CURSO DE INGLÉS 4 SEM VANCOUVER.pdf"
## [124] "CRANsearcher_1.0.0.tar.gz"
## [125] "CREAR UNA IMAGEN A PARTIR DE UN FICHERO U2.pdf"
## [126] "creative-suite-master-collection-programas-gratis-net_1426043284.exe"
## [127] "cred.jpg"
## [128] "credencialp.jpg"
## [129] "Criterios de Operación del Programa Compensación Ambiental por cambio de uso de suelo en terrenos forestales.pdf"
## [130] "Criterios para la obtención de Germoplasma 2018.pdf"
## [131] "cronograma.xlsx"
## [132] "Cuatro semanas en vogue.pdf"
## [133] "CURP.pdf"
## [134] "CURP_AAGL980130MDGLRR04.pdf"
## [135] "Curriculum Vitae Laurita.pdf"
## [136] "cvAlarconGarvalena (1).pdf"
## [137] "cvAlarconGarvalena.pdf"
## [138] "CYERD INFRAESTRUCTURA.docx"
## [139] "Datasets (1).rar"
## [140] "Datasets.rar"
## [141] "db4o-7.4-java.zip"
## [142] "db4o Whitepaper - Bases de Objetos.pdf"
## [143] "debian-10.3.0-amd64-netinst.iso"
## [144] "debian-8.11.1-amd64-netinst.iso"
## [145] "debian-9.3.0-amd64-DVD-3.iso"
## [146] "debian 7.3"
## [147] "debian.pdf"
## [148] "Descarga Atmel Studio y Proteus.pdf"
## [149] "descarga.jpg"
## [150] "desktop.ini"
## [151] "Diagrama Gantt.xlsx"
## [152] "Dialnet-SistemasExpertos-4843871 (1).pdf"
## [153] "Dialnet-SistemasExpertos-4843871.pdf"
## [154] "diseno-de-personajes-express.zip"
## [155] "dists"
## [156] "doc.pdf"
## [157] "Dockerfile"
## [158] "Dockerfile (1)"
## [159] "DockerToolbox-19.03.1.exe"
## [160] "Documentacion.pdf"
## [161] "Dominio alimentacion.sql"
## [162] "durango.pdf"
## [163] "econometria.jpg"
## [164] "EJECUTAR CONTENEDORES DOCKER U2P1.pdf"
## [165] "EjemploFor.eye"
## [166] "EjemploIf.eye"
## [167] "EjemploIfElse.eye"
## [168] "Ejemplos de Programas.pdf"
## [169] "EjemploWhile.eye"
## [170] "EMACS"
## [171] "EN-A2030Mx_VF.pdf"
## [172] "EncuesApp.pdf"
## [173] "ESP.W.XP.SP3.zip"
## [174] "etc"
## [175] "eventRaceReg_SPTMCAR1520359709_SPTMINS5c38241a56733.pdf"
## [176] "Examen U3 (1).docx"
## [177] "Examen U3.docx"
## [178] "examen.jpg"
## [179] "excel.jpg"
## [180] "excel1.jpg"
## [181] "explosion-copia.mid"
## [182] "explosion-copia.mid.jpg"
## [183] "factibilidad Cinvestav (APOYO).pdf"
## [184] "felicida2.arff"
## [185] "filmora-idco_setup_full1901.exe"
## [186] "filmorapro_setup_full4895.exe"
## [187] "FINANCIAMIENTO LIVE&LEARN.pdf"
## [188] "flauta.jpg"
## [189] "flautanotas.jpg"
## [190] "FORMULARIO DE INSCRIPCION.pdf"
## [191] "Formulario sin título.csv"
## [192] "Formulario sin título.csv.zip"
## [193] "g2ldr"
## [194] "g2ldr.mbr"
## [195] "GPS_Unidad 1_mat_extra_2019.pdf"
## [196] "HaskellPlatform-8.6.5-core-x86_64-setup.exe"
## [197] "HichHikers-Guide-To-the-galaxy-essay.docx"
## [198] "hola.zip"
## [199] "ID_OFI.pdf"
## [200] "ieee830.pdf"
## [201] "ILSC SCHOOL.pdf"
## [202] "imagen.jpg"
## [203] "Imagenes.rar"
## [204] "imagenotra.jpg"
## [205] "InDesign"
## [206] "Insert Animales.sql"
## [207] "Interchange 4th- 3.pdf"
## [208] "Interchange 4th 1-SB.pdf"
## [209] "Interchange 4th 2(verde)-SB.pdf"
## [210] "INTERCHANGE FOURTH EDITION INTRO.pdf"
## [211] "Interfaces unidad 1 Laura Alarcon 16041206 .pdf"
## [212] "Interfaces primera unidad Laura Alarcon 16041206.pdf"
## [213] "interfaces.pdf"
## [214] "IntroCybersecurity - Additional Resources and Activities.pdf"
## [215] "Iris.ipynb"
## [216] "ITD__Pago de Inscipción.pdf"
## [217] "Itinerario.form"
## [218] "Itinerario.java"
## [219] "itinerarios corregido"
## [220] "itinerarios corregido.rar"
## [221] "JavaScript.pdf"
## [222] "Jorge Luis Borges-20190913T030111Z-001.zip"
## [223] "kde-plasma-desktop_84_amd64.deb"
## [224] "kmeans1.jpg"
## [225] "kmeans2.jpg"
## [226] "kmeans3.jpg"
## [227] "lanueva.pdf"
## [228] "Last Loaded Semáforo.pdsbak"
## [229] "lau.mp4"
## [230] "lau.mpg"
## [231] "Laura YeseniaAlarcón Garvale-Conmutación y E-certificate.pdf"
## [232] "Laura YeseniaAlarcón Garvale-Conmutación y E-letter.pdf"
## [233] "laura.pdf"
## [234] "ld-Ingenieria.de.software.enfoque.practico.7ed.Pressman.PDF.pdf"
## [235] "Lenguajes y Autómatas I.pdf"
## [236] "libros_pmbok_guide5th_spanish.pdf"
## [237] "loadMovieDetailsDataset.js"
## [238] "loadMovieDetailsDataset.zip"
## [239] "lovetester (1).swf"
## [240] "lovetester.swf"
## [241] "mainwindow.cpp"
## [242] "MANIFEST"
## [243] "MANIFEST (1)"
## [244] "Manual-de-usuario-EncuesApp.pdf"
## [245] "Mapeo_dulzaina_afinada_en_fa_sostenido_con_piano.png"
## [246] "Marco-Teorico (1).docx"
## [247] "Marco-Teorico (2).docx"
## [248] "Marco-Teorico (3).docx"
## [249] "Marco-Teorico.docx"
## [250] "md5sum.txt"
## [251] "MediaCreationTool1809.exe"
## [252] "microprocesadores-arduino-pic.pptx"
## [253] "Microsoft JDBC Driver 6.0 for SQL Server"
## [254] "mimo.docx"
## [255] "mongod.cfg"
## [256] "mysql-8.0.12-winx64"
## [257] "mysql-8.0.12-winx64-debug-test.zip"
## [258] "mysql-8.0.12-winx64.zip"
## [259] "national-security-letters_h2-2018.zip"
## [260] "noname"
## [261] "Notas-de-codigo-haskell.hs"
## [262] "notes.gif"
## [263] "NPE_pro.zip"
## [264] "npp.7.8.2.Installer.exe"
## [265] "NSS.pdf"
## [266] "NT TDMA.pdf"
## [267] "OBS-Studio-25.0.4-Full-Installer-x64.exe"
## [268] "Odin3_v3.13.1.zip"
## [269] "PacketTracer721_64bit_setup-1.bin"
## [270] "PacketTracer721_64bit_setup.exe"
## [271] "pcriver.com_win_xp_64bit_pro.zip"
## [272] "PdfName-1571693145291.pdf"
## [273] "PhotoBetoCheto.rar"
## [274] "Photoshop-CS6 (By 9126)"
## [275] "Photoshop-CS6 (By 9126).rar"
## [276] "pir.jpg"
## [277] "Plantilla explicada.doc"
## [278] "practica-10.html"
## [279] "practica-11.Rmd"
## [280] "practica-11_files"
## [281] "Practica-Vlans.txt"
## [282] "practica 10 (1).Rmd"
## [283] "practica 10.Rmd"
## [284] "practica 11 (1).Rmd"
## [285] "practica 11.Rmd"
## [286] "Práctica No 1 configuración basica de un router.txt"
## [287] "Practica7-b"
## [288] "Prácticas Proteus (1).pdf"
## [289] "Prácticas Proteus.pdf"
## [290] "Presentación-GARVAM-NEW-FACES.pdf"
## [291] "PROBABILIDAD Y ESTADISTICA BASICA PARA INGENIEROS.pdf"
## [292] "Procesamiento de imagen.ipynb"
## [293] "propuesta-herramienta-twitter.pdf.pdf"
## [294] "Proteus(8.5)"
## [295] "Proteus(8.5).rar"
## [296] "Proy Final -Sim 2013 -1.pdf"
## [297] "Proyecto Final.zip"
## [298] "proyecto.docx"
## [299] "Proyecto_BD.pdf"
## [300] "Proyecto_Semaforo.txt"
## [301] "Proyectos-para-la-Unidad-6.pdf"
## [302] "PT-Assessment-Client-33537292.jnlp"
## [303] "PT-Assessment-Client-33537919.jnlp"
## [304] "PT-Assessment-Client-34005456.jnlp"
## [305] "python1.jpg"
## [306] "python2.jpg"
## [307] "python3.jpg"
## [308] "pythonerror.jpg"
## [309] "R-3.6.2-win.exe"
## [310] "R01u2.asm"
## [311] "R02u2.asm"
## [312] "R03u2.asm"
## [313] "R04u2.asm"
## [314] "README"
## [315] "Regresion.ipynb"
## [316] "Relacion de alimentos-cultura-uso de suelo (1).docx"
## [317] "Relacion de alimentos-cultura-uso de suelo.docx"
## [318] "RELLENA TODOS LOS CAMPOS.xlsx"
## [319] "replicas-keyfile"
## [320] "resumen_Haskell.pdf"
## [321] "reticula.jpg"
## [322] "rmarkdown-spanish.pdf"
## [323] "rsconnect"
## [324] "RStudio-1.2.5033.exe"
## [325] "rup.pdf"
## [326] "rutas_millas_tarifas_de_vuelos.csv"
## [327] "samplehakell.pdf"
## [328] "SDR-master"
## [329] "SDR-master.zip"
## [330] "semaforo.c"
## [331] "semaforo.hex"
## [332] "Semáforo.pdsprj"
## [333] "Semáforo.pdsprj.DESKTOP-VN0M1KD.sm13m.workspace"
## [334] "Servicio social"
## [335] "SERVIDORES.pdf"
## [336] "setup.exe"
## [337] "SetupMFC.exe"
## [338] "SEYTU-Omnilife-Ayacucho-en-Huamanga-Perú.png"
## [339] "seytu.png"
## [340] "simt1b (1).pdf"
## [341] "simt1b (2).pdf"
## [342] "simt1b.pdf"
## [343] "SIMULACIONDE SEMAFORO PROTEUS.pdsprj.zip"
## [344] "sistemas.pdf"
## [345] "Smart_Switch_PC_Setup.exe"
## [346] "solicitudca2016.doc"
## [347] "sopa-de-letras-205.pdf"
## [348] "sopa-de-letras-708.pdf"
## [349] "SOPA.jpg"
## [350] "SOPACHIDA.jpg"
## [351] "ssl"
## [352] "stack-2.1.3-windows-x86_64-installer.exe"
## [353] "Summer School 2020.pdf"
## [354] "Switch.txt"
## [355] "synaptic_0.81.2_amd64.deb"
## [356] "tabla2"
## [357] "TASM.zip"
## [358] "Tecnología-predictiva-y-de-análisis-Big-data (1).docx"
## [359] "Tecnología-predictiva-y-de-análisis-Big-data.docx"
## [360] "tema-8-1x2.pdf"
## [361] "TeoriaDeAutomatas,lenguajesYComputacion-Hopcroft.pdf"
## [362] "this_message_in_html.html"
## [363] "tokens metodos"
## [364] "tonos y notas"
## [365] "U3.zip"
## [366] "ubuntu-18.04.3-live-server-amd64.iso"
## [367] "Ultraiso Portable.rar"
## [368] "Unidad 5 - SQL Procedural.pdf"
## [369] "UNIDAD III CONECTANDO COSAS1a.pptx"
## [370] "UNIDAD IV V CONECTANDO COSAS.pptx"
## [371] "Unidad IV.zip"
## [372] "Untitled-1.docx"
## [373] "UTL.docx"
## [374] "v4-728px-Know-What-to-Feed-a-Turtle-Step-1-Version-2.jpg"
## [375] "Videos 7 templos"
## [376] "VirtualBox 6.1.2 por JimmyTutoriales"
## [377] "VirtualBox 6.1.2 por JimmyTutoriales.rar"
## [378] "VMware-workstation-full-15.5.1-15018445.exe"
## [379] "vmwarecurso.jpg"
## [380] "w2k3sp2_3959_usa_x64fre_spcd (1).iso"
## [381] "w2k3sp2_3959_usa_x64fre_spcd.iso"
## [382] "WebForPC.Com_Windows_XP_Professional_SP3.iso"
## [383] "weka-3-9-3-x64.exe"
## [384] "weka(nom)postura.jpg"
## [385] "weka(nombre.jpg"
## [386] "weka.jpg"
## [387] "win32-loader.ini"
## [388] "Zoologico"
## [389] "Zoologico (1).rar"
## [390] "Zoologico (1).sql"
## [391] "Zoologico (2).sql"
## [392] "Zoologico.rar"
## [393] "Zoologico.sql"
## [394] "Zoologico1"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] 48842set.seed(2020)
entrena <- createDataPartition(recategorizados$income, p=0.7, list = FALSE)
datos.Entrena <- recategorizados[entrena,]
datos.Validacion <- recategorizados[-entrena,]
nrow(datos.Entrena)## [1] 34190kable(head(datos.Entrena))| ag | e wor | kclass edu | cation ed | ucational.num mar | ital.status rac | e gen | der ho | urs.per.week inc | ome ag | e.scale ed | ucational.num.scale ho | urs.per.week.scale in | come10 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 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 |
| 7 | 29 | ? | HighGrad | 9 | Not_married | Black | Male | 40 | <=50K | 0.1643836 | 0.5333333 | 0.3979592 | 0 |
kable(tail(datos.Entrena))| ag | e wor | kclass edu | cation ed | ucational.num mar | ital.status rac | e gen | der ho | urs.per.week inc | ome ag | e.scale ed | ucational.num.scale ho | urs.per.week.scale in | come10 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 48834 | 43 | Private | Community | 11 | Married | White | Male | 45 | <=50K | 0.3561644 | 0.6666667 | 0.4489796 | 0 |
| 48835 | 32 | Private | Master | 14 | Not_married | Asian-Pac-Islander | Male | 11 | <=50K | 0.2054795 | 0.8666667 | 0.1020408 | 0 |
| 48838 | 27 | Private | Community | 12 | Married | White | Female | 38 | <=50K | 0.1369863 | 0.7333333 | 0.3775510 | 0 |
| 48840 | 58 | Private | HighGrad | 9 | Widow | White | Female | 40 | <=50K | 0.5616438 | 0.5333333 | 0.3979592 | 0 |
| 48841 | 22 | Private | HighGrad | 9 | Not_married | White | Male | 20 | <=50K | 0.0684932 | 0.5333333 | 0.1938776 | 0 |
| 48842 | 52 | Self-emp-inc | HighGrad | 9 | Married | White | Female | 40 | >50K | 0.4794521 | 0.5333333 | 0.3979592 | 1 |
| # Datos | de val | idación | |||||||||||
| Los dato | s de v | alidación serán | los que no | son de entrenamien | to |
datos.Validacion <- recategorizados[-entrena,]
nrow(datos.Validacion)## [1] 14652kable(head(datos.Validacion))| ag | e wor | kclass edu | cation ed | ucational.num mar | ital.status rac | e gen | der ho | urs.per.week inc | ome ag | e.scale ed | ucational.num.scale ho | urs.per.week.scale in | come10 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 6 | 34 | Private | Dropout | 6 | Not_married | White | Male | 30 | <=50K | 0.2328767 | 0.3333333 | 0.2959184 | 0 |
| 15 | 48 | Private | HighGrad | 9 | Married | White | Male | 48 | >50K | 0.4246575 | 0.5333333 | 0.4795918 | 1 |
| 17 | 20 | State-gov | Community | 10 | Not_married | White | Male | 25 | <=50K | 0.0410959 | 0.6000000 | 0.2448980 | 0 |
| 36 | 65 | ? | HighGrad | 9 | Married | White | Male | 40 | <=50K | 0.6575342 | 0.5333333 | 0.3979592 | 0 |
| 41 | 65 | Private | Master | 14 | Married | White | Male | 50 | >50K | 0.6575342 | 0.8666667 | 0.5000000 | 1 |
| 49 | 52 | Private | Dropout | 7 | Separated | Black | Female | 18 | <=50K | 0.4794521 | 0.4000000 | 0.1734694 | 0 |
kable(tail(datos.Validacion))| ag | e wor | kclass edu | cation ed | ucational.num mar | ital.status rac | e gen | der ho | urs.per.week inc | ome ag | e.scale ed | ucational.num.scale ho | urs.per.week.scale in | come10 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 48826 | 31 | Private | Master | 14 | Separated | Other | Female | 30 | <=50K | 0.1917808 | 0.8666667 | 0.2959184 | 0 |
| 48830 | 65 | Self-emp-not-inc | Master | 15 | Not_married | White | Male | 60 | <=50K | 0.6575342 | 0.9333333 | 0.6020408 | 0 |
| 48832 | 43 | Self-emp-not-inc | Community | 10 | Married | White | Male | 50 | <=50K | 0.3561644 | 0.6000000 | 0.5000000 | 0 |
| 48836 | 53 | Private | Master | 14 | Married | White | Male | 40 | >50K | 0.4931507 | 0.8666667 | 0.3979592 | 1 |
| 48837 | 22 | Private | Community | 10 | Not_married | White | Male | 40 | <=50K | 0.0684932 | 0.6000000 | 0.3979592 | 0 |
| 48839 | 40 | Private | HighGrad | 9 | Married | White | Male | 40 | >50K | 0.3150685 | 0.5333333 | 0.3979592 | 1 |
| # paso 6 | : Regr | esión logística | |||||||||||
| Con la r | egresi | ón logística, dado | un conjunto | particular de valo | res de las variab | les inde | pendiente | s elegidas, se es | tima la p | robabilidad | de los ingresos de una p | ersona ‘<=50’ o ‘>50’ |
Contruir 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(2.224e+00) en relación a tener ingresos >50K ó 1. exp(prediccionesfit)/(1exp(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 # Comparar 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 robabilidad sea > 0.5 o al 50% Con las columnas1 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 0tail(comparar)## income10 ajuste income10ajustados
## 34185 0 0.47760555 0
## 34186 0 0.06751504 0
## 34187 0 0.28999271 0
## 34188 0 0.06490387 0
## 34189 0 0.00958675 0
## 34190 1 0.43003777 0Matriz 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.8269085paso 8: Predicciones con datos de validación
Se utilizan los datos de validción para realizar predicciones
predicciones <- predict(modelo, datos.Validacion, se.fit = TRUE)
head(predicciones$fit)## 6 15 17 36 41 49
## -5.1235447 -0.4589452 -4.1994476 -1.0094459 2.3586616 -4.8803438tail(predicciones$fit)## 48826 48830 48832 48836 48837 48839
## -1.8282163 -0.4364728 -0.5542026 1.6730416 -3.3800099 -0.9586976predicciones_prob <- exp(predicciones$fit) / (1 + exp(predicciones$fit))
head(predicciones_prob)## 6 15 17 36 41 49
## 0.005919626 0.387236079 0.014782074 0.267088310 0.913620236 0.007537162tail(predicciones_prob)## 48826 48830 48832 48836 48837 48839
## 0.13845090 0.39258175 0.36488993 0.84198092 0.03292608 0.27713903Evaluar 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 Not_married White Male
## 2 48 Private HighGrad 9 Married White Male
## 3 20 State-gov Community 10 Not_married White Male
## 4 65 ? HighGrad 9 Married White Male
## 5 65 Private Master 14 Married 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
## income10 predicciones_prob income10.prediccion
## 1 0 0.005919626 0
## 2 1 0.387236079 0
## 3 0 0.014782074 0
## 4 0 0.267088310 0
## 5 1 0.913620236 1
## 6 0 0.007537162 0tail(las.predicciones)## age workclass education educational.num marital.status race
## 14647 31 Private Master 14 Separated Other
## 14648 65 Self-emp-not-inc Master 15 Not_married White
## 14649 43 Self-emp-not-inc Community 10 Married White
## 14650 53 Private Master 14 Married White
## 14651 22 Private Community 10 Not_married White
## 14652 40 Private HighGrad 9 Married 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 income10 predicciones_prob income10.prediccion
## 14647 0.2959184 0 0.13845090 0
## 14648 0.6020408 0 0.39258175 0
## 14649 0.5000000 0 0.36488993 0
## 14650 0.3979592 1 0.84198092 1
## 14651 0.3979592 0 0.03292608 0
## 14652 0.3979592 1 0.27713903 0Con 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 preciso 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. Exactidu 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.8258941Predecir 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 originale 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] 50edad.escalada <- rescale(c(edad, min(datos$edad), max(datos$edad)))## Warning in min(datos$edad): ningún argumento finito para min; retornando Inf## Warning in max(datos$edad): ningun argumento finito para max; retornando -Infedad.escalada <- edad.escalada[1]
# Escalando las hours por semana
horas.escalada<- rescale(c(horas, min(datos$horas.per.week), max(datos$horas.per.week)))## Warning in min(datos$horas.per.week): ningún argumento finito para min;
## retornando Inf## Warning in max(datos$horas.per.week): ningun argumento finito para max;
## retornando -Infhoras.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.5 Local-gov HighGrad Married White Male
## hours.per.week.scale
## 1 0.5Tercero, realizar la predicción con el nuevo registro
Realizar las 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
## -0.3455959
##
## $se.fit
## [1] 0.0676311
##
## $residual.scale
## [1] 1prediccion_prob <- exp(prediccion$fit) / (1 + exp(prediccion$fit))
prediccion_prob## 1
## 0.4144508# Predecir si será 0 o 1 conforme a la probabilidad de predicción
if_else(prediccion_prob > 0.5, 1, 0)## [1] 0cat("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: 0Nuevas 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 10 nuevas observaciones
edad <- c(35,55,65,71,42,60,65,75,35,53)
clase.empleo <- c('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)))## Warning in cbind(edad, clase.empleo, nivel.educacion, edo.civil, raza, genero, :
## number of rows of result is not a multiple of vector length (arg 2)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 State-gov HighGrad Married White Male
## 2 55 Never-worked HighGrad Separated Asian-Pac-Islander Male
## 3 65 Self-emp-inc Bachelors Separated Black Female
## 4 71 Federal-gov HighGrad Widow Other Male
## 5 42 Private Bachelors Not_married White Female
## 6 60 Private Bachelors Married White Male
## 7 65 Federal-gov Community Separated Amer-Indian-Eskimo Female
## 8 75 State-gov Community Widow Black Male
## 9 35 Local-gov Master Married White Female
## 10 53 State-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 53Segundo: 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 53edad.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)))
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.2465753 State-gov HighGrad Married White Male
## 2 0.2465753 Never-worked HighGrad Separated Asian-Pac-Islander Male
## 3 0.2465753 Self-emp-inc Bachelors Separated Black Female
## 4 0.2465753 Federal-gov HighGrad Widow Other Male
## 5 0.2465753 Private Bachelors Not_married White Female
## 6 0.2465753 Private Bachelors Married White Male
## 7 0.2465753 Federal-gov Community Separated Amer-Indian-Eskimo Female
## 8 0.2465753 State-gov Community Widow Black Male
## 9 0.2465753 Local-gov Master Married White Female
## 10 0.2465753 State-gov PhD Not_married White Male
## hours.per.week.scale
## 1 0.4489796
## 2 0.4489796
## 3 0.4489796
## 4 0.4489796
## 5 0.4489796
## 6 0.4489796
## 7 0.4489796
## 8 0.4489796
## 9 0.4489796
## 10 0.4489796Tercero. 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
## -1.2294432 -12.2295921 -1.3462938 -2.8197890 -1.9252364 0.6596704
## 7 8 9 10
## -2.1369673 -2.9898720 1.0721669 -1.0320874
##
## $se.fit
## 1 2 3 4 5 6
## 0.08562793 104.21716306 0.11222156 0.26059268 0.05940675 0.03953216
## 7 8 9 10
## 0.20689575 0.16649686 0.08291703 0.15263144
##
## $residual.scale
## [1] 1prediccion_prob <- exp(prediccion$fit) / (1 + exp(prediccion$fit))
prediccion_prob## 1 2 3 4 5 6
## 2.262789e-01 4.883751e-06 2.064770e-01 5.626414e-02 1.272788e-01 6.591863e-01
## 7 8 9 10
## 1.055554e-01 4.788553e-02 7.450088e-01 2.626796e-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ísticaslas.predicciones## [1] 0 0 0 0 0 1 0 0 1 0print("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 State-gov HighGrad Married White Male
## 2 0.2465753 Never-worked HighGrad Separated Asian-Pac-Islander Male
## 3 0.2465753 Self-emp-inc Bachelors Separated Black Female
## 4 0.2465753 Federal-gov HighGrad Widow Other Male
## 5 0.2465753 Private Bachelors Not_married White Female
## 6 0.2465753 Private Bachelors Married White Male
## 7 0.2465753 Federal-gov Community Separated Amer-Indian-Eskimo Female
## 8 0.2465753 State-gov Community Widow Black Male
## 9 0.2465753 Local-gov Master Married White Female
## 10 0.2465753 State-gov PhD Not_married White Male
## hours.per.week.scale las.predicciones
## 1 0.4489796 0
## 2 0.4489796 0
## 3 0.4489796 0
## 4 0.4489796 0
## 5 0.4489796 0
## 6 0.4489796 1
## 7 0.4489796 0
## 8 0.4489796 0
## 9 0.4489796 1
## 10 0.4489796 0