Tarea 5

Tarea 5

P.1

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

rm(list=ls())
library(data.table)
library(ggplot2)
library(caret)
library(scales)
library(moderndive)
library(knitr)
library(dplyr)
Base_datos <-fread("/Users/hassansantiago/Downloads/esi-2019---personas.csv")

P.2

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

Base_datos[,ss_t:=as.numeric(ss_t)]

ggplot(Base_datos[ss_t >0 & ss_t<2000000], aes(x=ss_t, fill=region)) + 
  geom_histogram(bins=16)+ facet_wrap(~region)

P.3

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.

class(Base_datos[,region])

## [1] "integer"

Base_datos[,region:=as.numeric(region)]

ggplot(Base_datos[ss_t >0 & ss_t<2000000], aes(x=ss_t, fill=region, color=region))+geom_histogram(bins=16)+ labs(x="Ingresos", title="Ingresos por regiones", caption = "Fuente: Instituto nacional de estadísticas-Chile") + theme(axis.text.x = element_text(angle=90,vjust=0.5))+ facet_wrap(facets="region", scales="free_y")

P.4

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

ggplot(Base_datos,aes(x=edad, y=ss_t)) +  geom_point(color="green")+scale_y_continuous(labels = number_format(scale = 1))

P4.

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.

Base_datos2<- mutate_all(Base_datos, ~replace(., is.na(.), 0))
reg_ing <- lm(ss_t~ cine+ sexo , data = Base_datos2)

4.1

Calcule el salario predicho para cada observación.

get_regression_table(reg_ing) %>% kable()

term	estimate	std_error	statistic	p_value	lower_ci	upper_ci
intercept	132173.429	2869.307	46.065	0	126549.620	137797.237
cine	153.649	22.054	6.967	0	110.424	196.875
sexo	-40065.659	1790.118	-22.382	0	-43574.269	-36557.048

Base_datos[,prediccion1 :=predict(reg_ing)]

4.2

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

nuevo = data.frame(sexo=c(1,2), cine=c(7))
predict(object = reg_ing, newdata = nuevo)

##        1        2 
## 93183.31 53117.66

P5.

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.

reg_ing2 <- lm(ss_t~ cine+ sexo+ grupo_edad+ b1+ region , data = Base_datos2)

P5.1

Calcule el salario predicho para cada observación..

Base_datos[,prediccion2 :=predict(reg_ing2)]

P6.

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.

Base_datos[,residuo:=resid(reg_ing)]
Base_datos[,residuo2:=resid(reg_ing2)]

P7.

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?

get_regression_table(reg_ing) %>% kable()

term	estimate	std_error	statistic	p_value	lower_ci	upper_ci
intercept	132173.429	2869.307	46.065	0	126549.620	137797.237
cine	153.649	22.054	6.967	0	110.424	196.875
sexo	-40065.659	1790.118	-22.382	0	-43574.269	-36557.048

get_regression_table(reg_ing2) %>% kable()

term	estimate	std_error	statistic	p_value	lower_ci	upper_ci
intercept	58182.041	3701.516	15.718	0	50927.113	65436.970
cine	121.618	21.868	5.561	0	78.757	164.479
sexo	-30175.781	1814.693	-16.629	0	-33732.558	-26619.003
grupo_edad	5458.634	365.000	14.955	0	4743.238	6174.029
b1	9331.390	284.457	32.804	0	8773.857	9888.923
region	1865.468	218.437	8.540	0	1437.334	2293.603

Dado los resultados,se puede de notar que todas las variables agregadas al modelo 2 ( reg_ing2) son estadisticamente significativas y tienen un efecto en la predicción del ingreso; dado que sus estimadores son distintos a 0. Al considerar mas variables que tienene incidencia en el ingreso la proyeccion 2 es mas precisa que el modelo 1.

P8.

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?

set.seed(12345) ## setear una semilla

setupKCV <- trainControl(method = "cv" , number = 5)

CVBase_datos_reg1<-train(ss_t~ cine+ sexo , data = Base_datos2,method="lm",trControl= setupKCV)

CVBase_datos_reg2<-train(ss_t~ cine+ sexo+ grupo_edad+ b1+ region , data = Base_datos2,method="lm",trControl= setupKCV)

print(CVBase_datos_reg1)

## Linear Regression 
## 
## 96240 samples
##     2 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 76992, 76992, 76992, 76992, 76992 
## Resampling results:
## 
##   RMSE      Rsquared     MAE     
##   277341.9  0.005646889  125483.2
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

print(CVBase_datos_reg2)

## Linear Regression 
## 
## 96240 samples
##     5 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 76992, 76992, 76992, 76992, 76992 
## Resampling results:
## 
##   RMSE      Rsquared    MAE     
##   274773.6  0.02382866  118432.4
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

SI se mantienen, se ratifica que el modelo 2 predice de mejor manera los ingresos; al comparar los “Rsquared” vemos que el modelo 2 tiene un mayor valor (0.02382866>0.005646889) lo que indica que el modelo 2 explica en mayor medida la predicción.