P1.

Cargue los paquetes “data.table”, “ggplot2” y “caret”, junto con la base de datos. (1 punto)

rm(list=ls())

library(data.table)
library(ggplot2)
library(caret)

personas <- fread("esi-2019---personas.csv") 
library(plotly)
library(RColorBrewer)
library(janitor)
library(tidyverse)
library(broom)
library(rgbif)
library(scales)
library(stringr)

P2.

Muestre un histograma de ingreso por region. Limite el histograma a las observaciones con ingresos (ss_t) mayores a 0 y menores a 2 millones de pesos. Recuerde ver la clase de las variables (4 puntos)

###Clase de ingreso 
str(personas$ss_t)
##  chr [1:96240] "0" "229822" "0" "0" "1100000" "6e+05" "0" "0" "242305" "0" ...
###Cambiar clase de ingreso de caracter a numerico 
personas[,ingreso:=as.numeric(ss_t)]

###Crear variable con nombre de regiones 
personas[region==1,nombre_region:='Tarapacá']
personas[region==2 ,nombre_region:='Antofagasta']
personas[region==3 ,nombre_region:='Atacama']
personas[region==4 ,nombre_region:='Coquimbo']
personas[region==5 ,nombre_region:='Valparaíso']
personas[region==6 ,nombre_region:="O'Higgins"]
personas[region==7 ,nombre_region:='Maule']
personas[region==8 ,nombre_region:='Biobío']
personas[region==9 ,nombre_region:='Araucanía']
personas[region==10 ,nombre_region:='Los Lagos']
personas[region==11 ,nombre_region:='Aysén']
personas[region==12 ,nombre_region:='Magallanes']
personas[region==13 ,nombre_region:='Metropolitana']
personas[region==14 ,nombre_region:='Los Ríos']
personas[region==15 ,nombre_region:='Arica y Parinacota']
personas[region==16 ,nombre_region:='Ñuble']

###Hitograma 
ggplot(data=personas[ingreso>0 & ingreso<2000000],mapping = aes(x=ingreso))+
  geom_histogram()+ 
  facet_wrap(facets = "nombre_region")

P3.

Arregle los gráficos para que cada uno tenga un eje x legible, además arregle el eje y. Agregue color a cada gráfico:(4 puntos) Hint: utilice la función scales = ‘free_y’ dentro de facet_wrap para dejar libre el eje y. También recuerde chequear la clase de la variable region para que se asigne correctamente un color a cada región.

ggplot(data=personas[ingreso>0 & ingreso<2000000],mapping = aes(x=ingreso,fill=nombre_region))+
  geom_histogram()+ 
  facet_wrap(facets = "nombre_region",scales = 'free_y')+
  theme(axis.text.x = element_text(angle=90, vjust=0.5)) +
  theme(legend.position = 'none') +
   labs(title = 'Ingresos', subtitle = 'Por región',
       caption = 'Esta Suplementaria de Ingresos (ESI) elaborada por INE',
       x = 'Ingresos',y = 'N° de personas') +
  scale_x_continuous(labels = number_format(scale = 0.000001, suffix = " M."))

P4.

Realice un gráfico de dispersión que muestre la relación entre el ingreso y la edad. (4 puntos)

ggplot(personas,aes(x=edad,y=ingreso)) +  
  geom_point() + 
  geom_smooth() + 
   labs(title = 'Relación entre ingreso y edad',
       caption = 'Esta Suplementaria de Ingresos (ESI) elaborada por INE',
       x = 'Edad',y = 'Ingreso') + 
  scale_y_continuous(labels = number_format(scale = 0.000001, suffix = "M."))

P5

Un miembro de su equipo propone un modelo que calcule la incidencia del sexo y la educación en el ingreso, sin considerar variables adicionales. Usted quiere mostrarle que aquel modelo está incompleto. Para lograr esto, haga el modelo de regresión anteriormente mencionado. (5 puntos)

personas1<-personas[is.na(ingreso)==FALSE]
personas1<-personas1[is.na(habituales)==FALSE]
personas1<-personas1[is.na(b1)==FALSE]
personas1<-personas1[is.na(c1)==FALSE]

Dado que en la segunda regresión agregaremos las variables habituales, c1 y b1, es que se tomó la decisión de eliminar los NA asociados a estas, para de esta forma realizar una comparación óptima de los resultados de ambas regresiones, pues se tendra la misma cantidad de observaciones.

reg1<-lm(data=personas1,formula=ingreso~sexo+cine)

summary(reg1)
## 
## Call:
## lm(formula = ingreso ~ sexo + cine, data = personas1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -543810 -292308 -238998  109973 9706681 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 344607.22    9265.54  37.192  < 2e-16 ***
## sexo        -53310.05    6111.23  -8.723  < 2e-16 ***
## cine           252.77      63.09   4.007 6.17e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 485200 on 25701 degrees of freedom
## Multiple R-squared:  0.003558,   Adjusted R-squared:  0.003481 
## F-statistic: 45.89 on 2 and 25701 DF,  p-value: < 2.2e-16

Al realizar la regresión 1 se pudo observar que el modelo está incompleto puesto que R cuadrado posee un valor cercano a 0, siendo este un 0,3%, lo cual implica que las variables sexo y educación explican un porcentaje muy bajo del ingreso.

P5.1

Calcule el salario predicho para cada observación. (4 puntos)

pred1<-predict(reg1) ##Calcular los y predichos para cada observación

personas1[,pred1:=predict(reg1)] ##Agregar columna de predicción para cada observación

P5.2

Dado el modelo anterior, calcule la predicción del salario para una mujer y para un hombre con educación Universitario (5 puntos)

pred_uni<-personas1[,c("sexo", "cine", "pred1")]

pred_uni[cine==7]
##       sexo cine    pred1
##    1:    1    7 293066.5
##    2:    1    7 293066.5
##    3:    1    7 293066.5
##    4:    2    7 239756.5
##    5:    1    7 293066.5
##   ---                   
## 4797:    1    7 293066.5
## 4798:    1    7 293066.5
## 4799:    1    7 293066.5
## 4800:    2    7 239756.5
## 4801:    1    7 293066.5
pred_uni <- pred_uni[!duplicated(pred1)]
pred_uni[cine==7]
##    sexo cine    pred1
## 1:    1    7 293066.5
## 2:    2    7 239756.5

El salario predicho para mujer (2) con educacion universitaria es de 239.756 pesos y el salario predicho para hombre (1) con educacion universitaria es de 293.066 pesos.

P6.

Teniendo ya el modelo propuesto por su colega, contrarreste usted con un modelo de predicción en base a los datos con los que ya cuenta. Utilice el argumento na.action por los datos nulos en la función de la regresión. (7 puntos)

 #filtramos por fila, que sean personas con horas habituales mayores a 900
personas2<-personas1[!habituales %like% "999",] 

reg2<-lm(data=personas2,formula=ingreso~sexo+cine+edad+habituales+c1+b1, na.action = na.omit)

summary(reg2)
## 
## Call:
## lm(formula = ingreso ~ sexo + cine + edad + habituales + c1 + 
##     b1, data = personas2, na.action = na.omit)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -725738 -253452  -63753  148605 9384855 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 1223481.13   22914.99  53.392  < 2e-16 ***
## sexo         -72715.97    5739.36 -12.670  < 2e-16 ***
## cine            233.42      57.33   4.071 4.69e-05 ***
## edad          -1456.28     186.67  -7.802 6.35e-15 ***
## habituales    -1434.41     224.76  -6.382 1.78e-10 ***
## c1          -276441.74    8939.41 -30.924  < 2e-16 ***
## b1           -66177.91    1154.78 -57.308  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 440800 on 25696 degrees of freedom
## Multiple R-squared:  0.1778, Adjusted R-squared:  0.1776 
## F-statistic: 926.1 on 6 and 25696 DF,  p-value: < 2.2e-16

P6.1

Calcule el salario predicho para cada observación. (5 puntos)

pred2<-predict(reg2) ## calcular los y predichos para cada observación

personas2[,pred2:=predict(reg2)]

P7.

Contando ya con su modelo, usted puede realizar una comparación directa entre ambos. Calcule los errores de predicción dentro de muestra para ambos modelos. (8 puntos)

predicciones1<-data.table(RMSE=RMSE(pred1,personas1$ingreso), ###Error cuadratico medio
                         MAE=MAE(pred1,personas1$ingreso)) ###Media absoluta del error 
predicciones1
##        RMSE      MAE
## 1: 485208.6 301705.4
predicciones2<-data.table(RMSE=RMSE(pred2,personas2$ingreso), ###Error cuadratico medio
                         MAE=MAE(pred2,personas2$ingreso)) ###Media absoluta del error 
predicciones2
##        RMSE      MAE
## 1: 440760.2 268614.5

P8.

Interprete la diferencia en los errores de predicción entre el Modelo 1 y el Modelo 2. ¿Qué modelo hace una mejor predicción dentro de muestra? (5 puntos)

El error cuadrático medio del modelo 1 en comparación al del modelo 2 es mayor, por ende, las variables que se consideran en el modelo 1 no son suficientemente significativas para realizar una buena predicción de los ingresos. Por el contrario, en el modelo 2 se decidió incluir las siguientes variables:

En la realidad estas variables si afectan el ingreso de una persona, ya que influye en cuanto sera remunerado el trabajador, por ende se deben considerar. Esto se corrobora a través del resultado del error cuadrático medio, el cual fue inferior al del primer modelo, además de un R-cuadrado igual a 17% mayor que un 0,3% del modelo 1, esto se traduce en una menor dispersión entre la línea de tendencia y los datos observados, por ende una menor desviación estándar.

P9.

Realice validación cruzada (CV) a los modelos de la pregunta anterior por el método K-folds con 5 folds. ¿Se mantienen las conclusiones obtenidas en el análisis dentro de muestra? (9 puntos)

set.seed(12345) 
setupKCV <- trainControl(method = "cv" , number = 5)

kfolds1<-train(ingreso~sexo+cine,data=personas1,method="lm",trControl= setupKCV)
kfolds2<-train(ingreso~sexo+cine+edad+habituales+c1+b1,data=personas2,method="lm",trControl= setupKCV)

print(kfolds1)
## Linear Regression 
## 
## 25704 samples
##     2 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 20563, 20563, 20563, 20564, 20563 
## Resampling results:
## 
##   RMSE    Rsquared     MAE     
##   485109  0.003733476  301722.9
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE
print(kfolds2)
## Linear Regression 
## 
## 25703 samples
##     6 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 20562, 20562, 20562, 20563, 20563 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   440325.4  0.1784431  268665.1
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

Los magnitud de variación del RMSE, MAE y R-cuadrado son mínimas, por ende las conclusiones obtenidas del análisis dentro de la muestra que se hicieron en un principio se mantienen.