###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)
base<-fread("C:/Users/Lenovo/Desktop/TAREA 4 DATA/base.csv")
base<-base[!is.na(distprom)]
###P2 Muestre un histograma de ingreso por comuna. Limite el histograma a las observaciones con ingresos menores a 2 millones de pesos. (4 puntos)
base2<-base[IngresoFinal<2000000]
ggplot(base2,aes(x=reorder(comunahg,-IngresoFinal),y=IngresoFinal)) + geom_col() + labs(x="Comunas",y="Ingresos Totales",title="Ingresos por comuna en la Region de Valparaiso", subtitle="Con ingresos menores a 2 Millones",)+theme(axis.text = element_text(angle=45,vjust=0.5))
###P3 Realice un gráfico de dispersión que muestre la relación entre el ingreso y el tiempo de viaje promedio. (4 puntos)
ggplot(base,aes(x=IngresoFinal, y=minviajeprom)) + geom_point()
###P4 Un miembro de su equipo propone un modelo que calcule la incidencia del sexo y la educación en el tiempo de viaje, sin considerar variables adicionales. Usted quiere mostrarle que aquel modelo está incompleto. En orden de lograr esto, haga el modelo de regresión anteriormente mencionado. (5 puntos)
f <- formula(minviajeprom ~ sexo + educ)
reg1 <- lm(formula = f, data = base)
summary(reg1)
##
## Call:
## lm(formula = f, data = base)
##
## Residuals:
## Min 1Q Median 3Q Max
## -32.41 -13.56 -3.56 8.88 620.85
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 31.1237 2.0463 15.209 < 2e-16 ***
## sexoMujer -3.0960 0.2670 -11.595 < 2e-16 ***
## educNo tiene -8.9966 2.1744 -4.138 3.52e-05 ***
## educPrebásicos -8.7876 2.1798 -4.031 5.57e-05 ***
## educPrimarios -4.3761 2.0665 -2.118 0.0342 *
## educProfesional 2.2911 2.0622 1.111 0.2666
## educSecundarios 0.5281 2.0559 0.257 0.7973
## educTécnico Profesional 1.5214 2.0805 0.731 0.4646
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19.28 on 20927 degrees of freedom
## Multiple R-squared: 0.03249, Adjusted R-squared: 0.03216
## F-statistic: 100.4 on 7 and 20927 DF, p-value: < 2.2e-16
###P4.1 Calcule los minutos de viaje promedios predichos para cada observación. (4 puntos)
prediccion <- predict(reg1, newdata = base)
base[, prediccion:=prediccion]
###P4.2 Dado el modelo anterior, calcule la predicción de los minutos de viaje promedio para una mujer y para un hombre con educación Profesional. (5 puntos)
-Si es un hombre profesional
prediccion2 <- predict(reg1, data.table(sexo = "Hombre", educ = "Profesional"))
prediccion2
## 1
## 33.41476
-Si es una mujer profesional
prediccion3 <- predict(reg1, data.table(sexo = "Mujer", educ = "Profesional"))
prediccion3
## 1
## 30.31876
###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. (7 puntos)
V <- formula(minviajeprom ~ sexo + educ + edad +comunahg + distprom )
reg2 <- lm(formula = V, data = base)
summary(reg2)
##
## Call:
## lm(formula = V, data = base)
##
## Residuals:
## Min 1Q Median 3Q Max
## -65.35 -9.10 -2.21 6.65 632.48
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.561e+01 1.733e+00 9.008 < 2e-16 ***
## sexoMujer -5.850e-01 2.150e-01 -2.721 0.006523 **
## educNo tiene -7.530e+00 1.742e+00 -4.323 1.55e-05 ***
## educPrebásicos -6.470e+00 1.747e+00 -3.703 0.000214 ***
## educPrimarios -2.744e+00 1.653e+00 -1.659 0.097056 .
## educProfesional -3.170e+00 1.652e+00 -1.919 0.054980 .
## educSecundarios -1.204e+00 1.647e+00 -0.731 0.464685
## educTécnico Profesional -2.266e+00 1.667e+00 -1.359 0.174095
## edad -4.612e-02 5.358e-03 -8.607 < 2e-16 ***
## comunahgQuilpue 5.460e+00 5.924e-01 9.216 < 2e-16 ***
## comunahgValparaiso 5.803e+00 5.764e-01 10.067 < 2e-16 ***
## comunahgVilla Alemana 4.899e+00 6.090e-01 8.045 9.11e-16 ***
## comunahgVina del Mar 8.105e+00 5.684e-01 14.260 < 2e-16 ***
## distprom 1.913e-03 1.798e-05 106.419 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 15.42 on 20921 degrees of freedom
## Multiple R-squared: 0.3814, Adjusted R-squared: 0.381
## F-statistic: 992.2 on 13 and 20921 DF, p-value: < 2.2e-16
###P5.1 Calcule los minutos de viaje promedios predichos para cada observación. (5 puntos)
prediccion4 <- predict(reg2, newdata = base)
base[, prediccion4:=prediccion4]
###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. (8 puntos)
base[, errorespred1:=(minviajeprom-prediccion)]
base[, errorespred4:=(minviajeprom-prediccion4)]
###7 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)
Metodo MAE
MAE1 <- sum(abs(base$prediccion-base$minviajeprom))/nrow(base)
MAE4 <- sum(abs(base$prediccion4-base$minviajeprom))/nrow(base)
data.table(MAE1,MAE4)
## MAE1 MAE4
## 1: 14.32717 10.67969
R: El MAE es la diferencia absoluta promedio entre los resultados observados y estimados. Entre menor sea el MAE, mejor sera el modelo. Por lo que se puede concluir que el Modelo 2 es mejor que el modelo 1.
MAE Modelo 1 > MAE Modelo 2
###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? (9 puntos)
Importante: Utilice set.seed(12345)
Modelo 1
set.seed(12345)
setupKCV <- trainControl(method = "cv" , number = 5)
predkfolds1<-train(f,data=base,method="lm",trControl= setupKCV)
print(predkfolds1)
## Linear Regression
##
## 20935 samples
## 2 predictor
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 16748, 16748, 16748, 16748, 16748
## Resampling results:
##
## RMSE Rsquared MAE
## 19.27158 0.03212455 14.33246
##
## Tuning parameter 'intercept' was held constant at a value of TRUE
Modelo 2
set.seed(12345)
setupKCV <- trainControl(method = "cv" , number = 5)
predkfolds1<-train(V,data=base,method="lm",trControl= setupKCV)
print(predkfolds1)
## Linear Regression
##
## 20935 samples
## 5 predictor
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 16748, 16748, 16748, 16748, 16748
## Resampling results:
##
## RMSE Rsquared MAE
## 15.39021 0.3836063 10.68738
##
## Tuning parameter 'intercept' was held constant at a value of TRUE
R: Si, usando el metodo K- Folds con 5 Folds, se puede observar que el MAE en los 2 modelos es casi igual que los obtenidos en la pregunta 7, por lo que se pueden mantener las conclusiones que planteamos en la pregunta 7. El modelo 2 es mejor que el modelo 1.