Caso C&A - Taller Regresion Multiple
Juan Pablo Mejia
2023-03-18
Carga de paquetes
#install.packages("devtools") # solo la primera vez
#devtools::install_github("dgonxalex80/paqueteMOD", force =TRUE)
library(paqueteMOD)
library(plotly)## Warning: package 'plotly' was built under R version 4.2.3## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.2.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutrequire(leaflet)## Loading required package: leafletlibrary(GGally)## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2library(modelsummary)## Warning: package 'modelsummary' was built under R version 4.2.3require(raster)## Loading required package: raster## Warning: package 'raster' was built under R version 4.2.3## Loading required package: sp##
## Attaching package: 'raster'## The following object is masked from 'package:plotly':
##
## selectrequire(sf)## Loading required package: sf## Warning: package 'sf' was built under R version 4.2.3## Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUErequire(tmap)## Loading required package: tmap## Warning: package 'tmap' was built under R version 4.2.3require(car)## Loading required package: car## Warning: package 'car' was built under R version 4.2.3## Loading required package: carDatadata("vivienda")Exploración preliminar de los datos
head(vivienda)## # A tibble: 6 × 13
## id zona piso estrato preciom areaconst parqueaderos banios habitaciones
## <dbl> <fct> <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1147 Zona O… <NA> 3 250 70 1 3 6
## 2 1169 Zona O… <NA> 3 320 120 1 2 3
## 3 1350 Zona O… <NA> 3 350 220 2 2 4
## 4 5992 Zona S… 02 4 400 280 3 5 3
## 5 1212 Zona N… 01 5 260 90 1 2 3
## 6 1724 Zona N… 01 5 240 87 1 3 3
## # ℹ 4 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>Filtro por tipo de vivienda (Punto 1)
Realice un filtro a la base de datos e incluya solo las ofertas de : base1: casas, de la zona norte de la ciudad. Presente los primeros 3 registros de las bases y algunas tablas que comprueben la consulta. (Adicional un mapa con los puntos de las bases. Discutir si todos los puntos se ubican en la zona correspondiente o se presentan valores en otras zonas, por que?).
apartamentos=subset(vivienda, tipo=="Apartamento")
head(apartamentos,3)## # A tibble: 3 × 13
## id zona piso estrato preciom areaconst parqueaderos banios habitaciones
## <dbl> <fct> <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1212 Zona N… 01 5 260 90 1 2 3
## 2 1724 Zona N… 01 5 240 87 1 3 3
## 3 2326 Zona N… 01 4 220 52 2 2 3
## # ℹ 4 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>#Existe un problema con las coordenadas en el dataframe, puesto que estos no tienen un punto decimal e impide a las bibliotecas cargar los puntos. Se intentó multiplicar las coordenadas latitude * 0.000001 y longitude * -0.000001 para convertirlas al formato correcto, pero los numeros tienen distinta longitud de decimales y no hace coherente la multiplicación en varios de los registros
leaflet() %>% addTiles() %>%
addCircleMarkers(lng = apartamentos$longitud,
lat = apartamentos$latitud)Análisis Exploratorio (Punto 2)
Realice un análisis exploratorio de datos enfocado en la correlación entre la variable respuesta (precio del apartamento) en función del área construida, estrato, numero de baños, numero de habitaciones y zona donde se ubica la vivienda. Use gráficos interactivos con el paquete plotly e interprete los resultados.
#Exploración de los datos
summary(apartamentos)## id zona piso estrato preciom
## Min. : 3 Zona Centro : 24 03 : 573 3: 639 Min. : 58.0
## 1st Qu.:2180 Zona Norte :1198 05 : 564 4:1404 1st Qu.: 175.0
## Median :4158 Zona Oeste :1029 04 : 545 5:1766 Median : 279.0
## Mean :4284 Zona Oriente: 62 02 : 512 6:1291 Mean : 366.9
## 3rd Qu.:6556 Zona Sur :2787 01 : 430 3rd Qu.: 430.0
## Max. :8317 (Other):1095 Max. :1950.0
## NA's :1381
## areaconst parqueaderos banios habitaciones
## Min. : 35.0 Min. : 1.000 Min. :0.000 Min. :0.000
## 1st Qu.: 68.0 1st Qu.: 1.000 1st Qu.:2.000 1st Qu.:3.000
## Median : 90.0 Median : 1.000 Median :2.000 Median :3.000
## Mean : 316.6 Mean : 1.568 Mean :2.617 Mean :2.971
## 3rd Qu.: 135.0 3rd Qu.: 2.000 3rd Qu.:3.000 3rd Qu.:3.000
## Max. :29555.0 Max. :10.000 Max. :8.000 Max. :9.000
## NA's :869
## tipo barrio longitud latitud
## Apartamento:5100 valle del lili: 840 Min. :-7658744 Min. : 34
## Casa : 0 la flora : 267 1st Qu.:-7653546 1st Qu.: 3455
## santa teresita: 250 Median :-7651872 Median :337112
## ciudad jardín : 221 Mean :-4927287 Mean :215467
## pance : 206 3rd Qu.: -76546 3rd Qu.:343514
## normandía : 150 Max. : -765 Max. :349684
## (Other) :3166#Análisis de Correlaciones entre variables predictoras y la variable a predecir. Se omite el estrato por ahora.
ggpairs(apartamentos, columns = c("preciom","areaconst", "banios", "habitaciones"), proportions = "auto")
Modelo de RLM (Punto 3)
Estime un modelo de regresión lineal múltiple con las variables del punto anterior (precio = f(área construida, estrato, numero de cuartos, numero de parqueaderos, numero de baños ) ) e interprete los coeficientes si son estadísticamente significativos. Las interpretaciones deber están contextualizadas y discutir si los resultados son lógicos. Adicionalmente interprete el coeficiente R2 y discuta el ajuste del modelo e implicaciones (que podrían hacer para mejorarlo).
# Manejo de variables categóricas en el modelo de RLM para el estrato
apartamentos$Est4=as.numeric(apartamentos$estrato=="4")
apartamentos$Est5=as.numeric(apartamentos$estrato=="5")
apartamentos$Est6=as.numeric(apartamentos$estrato=="6")
mod_apto=lm(preciom~areaconst+Est4+Est5+Est6+banios+habitaciones,data=apartamentos)
summary(mod_apto)##
## Call:
## lm(formula = preciom ~ areaconst + Est4 + Est5 + Est6 + banios +
## habitaciones, data = apartamentos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -498.30 -75.44 -19.68 55.90 1388.66
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -52.252122 12.387218 -4.218 2.51e-05 ***
## areaconst -0.001415 0.001429 -0.990 0.322130
## Est4 6.423493 8.309028 0.773 0.439515
## Est5 70.702471 8.405374 8.412 < 2e-16 ***
## Est6 298.845816 10.278491 29.075 < 2e-16 ***
## banios 138.224316 3.323543 41.589 < 2e-16 ***
## habitaciones -14.807106 4.159744 -3.560 0.000375 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 169.2 on 5093 degrees of freedom
## Multiple R-squared: 0.658, Adjusted R-squared: 0.6576
## F-statistic: 1633 on 6 and 5093 DF, p-value: < 2.2e-16Validación de Supuestos (Punto 4)
Realice la validación de supuestos del modelo e interprete los resultados (no es necesario corregir en caso de presentar problemas solo realizar sugerencias de que se podría hacer).
#Los errores son variables aleatorias normales
hist(residuals(mod_apto), col = "steelblue")
# Los errores tienen varianza constante
plot(fitted(mod_apto), residuals(mod_apto))
abline(h = 0, lty = 2)
#Los errores tienen media cero
t.test(residuals(mod_apto))##
## One Sample t-test
##
## data: residuals(mod_apto)
## t = 3.2488e-15, df = 5099, p-value = 1
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
## -4.643385 4.643385
## sample estimates:
## mean of x
## 7.694901e-15#Los errores son mutuamente independientes
lmtest::dwtest(mod_apto)##
## Durbin-Watson test
##
## data: mod_apto
## DW = 1.6062, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is greater than 0Posterior a la validación de supuestos, se puede evidenciar que el modelo tiene problemas. Estos problemas pueden estar fuertemente relacionados a las correlaciones que existen entre algunas de las variables predictoras que usamos en el modelo, como por ejemplo la cantidad de habitaciones y baños.
Para solucionar este problema, es necesario eliminar el problema de multicolinealidad con las variables predictoras seleccionadas.
Predicción con el modelo (Punto 5)
Con el modelo identificado debe predecir el precio de la vivienda con las características de la primera solicitud.
intercept <- coef(summary(mod_apto))["(Intercept)", "Estimate"]
areaconst <- coef(summary(mod_apto))["areaconst", "Estimate"]
banios <- coef(summary(mod_apto))["banios", "Estimate"]
habitaciones <- coef(summary(mod_apto))["habitaciones", "Estimate"]
est4 <- coef(summary(mod_apto))["Est4", "Estimate"]
est5 <- coef(summary(mod_apto))["Est5", "Estimate"]
est6 <- coef(summary(mod_apto))["Est6", "Estimate"]
#Valores Predictores
a_banios=3
a_habitaciones=5
a_areaconst=300
a_est4=0
a_est5=1
a_est6=1
#Predicción
precio_apto=intercept + areaconst*(a_areaconst) + banios*(a_banios) + est4*(a_est4) + est5*(a_est5) + est6*(a_est6)
precio_apto## [1] 731.5447Ofertas con base en la predicción (Punto 6)
Con las predicciones del modelo sugiera potenciales ofertas que responda a la solicitud de la vivienda 1. Tenga encuentra que la empresa tiene crédito preaprobado de máximo 350 millones de pesos. Realice un análisis y presente en un mapa al menos 5 ofertas potenciales que debe discutir.
Ofertas Potenciales
#ofertas_a=subset(apartamentos, preciom >= 731.5447 & preciom <=850 & banios==3 & habitaciones == 5 & zona=="Zona Sur" & (estrato=="5" | estrato=="6" ))
ofertas_a=subset(apartamentos, preciom >= 731.5447 & preciom <=850)
#ofertas_a
head(ofertas_a,5)## # A tibble: 5 × 16
## id zona piso estrato preciom areaconst parqueaderos banios habitaciones
## <dbl> <fct> <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 509 Zona N… 05 6 820 377 1 4 4
## 2 4539 Zona N… <NA> 6 850 237 NA 4 3
## 3 7012 Zona N… <NA> 6 850 310 NA 4 5
## 4 7369 Zona O… 03 6 750 179 2 4 3
## 5 8218 Zona O… 05 6 850 186 2 4 4
## # ℹ 7 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>,
## # Est4 <dbl>, Est5 <dbl>, Est6 <dbl>Se grafican sobre un mapa algunas posibles ofertas
cali_apto=shapefile("mc_barrios/cali.shp")
cali_apto.tmap = tm_shape(cali_apto) + tm_polygons()
ofertas_apto=data.frame(lat=c(3.47663, 3.45165, 3.45294, 3.455, 3.45962),
long=c(-76.4978, -76.53198, -76.5468, -76.549, -76.55831))
oferta_apto_sf=st_as_sf(ofertas_apto, coords = c('long', 'lat'))
cali2_apto= tm_shape(cali_apto) + tm_polygons() + tm_shape(oferta_apto_sf) + tm_dots(size=0.3, col="red")
cali2_apto## Warning: Currect projection of shape oferta_apto_sf unknown. Long-lat (WGS84)
## is assumed.
En el anterior análisis, y teniendo en cuenta el resultado de la predicción, se observa que no hay muchas ofertas que se ajusten exactamente a las características. Sin embargo, se sugiere explorar la posibilidad de tener en cuenta otras zonas diferente a la Sur. En la Zona Norte y Oeste se pueden encontrar algunas ofertas con características más cercanas a lo solicitado por el cliente
Análisis para la vivienda de tipo Casa (Punto 7)
Realice los pasos del 1 al 6. Para la segunda solicitud se tiene un crédito preaprobado por valor de $850 millones.
casas=subset(vivienda, tipo=="Casa")
head(casas,3)## # A tibble: 3 × 13
## id zona piso estrato preciom areaconst parqueaderos banios habitaciones
## <dbl> <fct> <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1147 Zona O… <NA> 3 250 70 1 3 6
## 2 1169 Zona O… <NA> 3 320 120 1 2 3
## 3 1350 Zona O… <NA> 3 350 220 2 2 4
## # ℹ 4 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>#Exploración de los datos
summary(casas)## id zona piso estrato preciom
## Min. : 1 Zona Centro : 100 02 : 938 3:814 Min. : 77
## 1st Qu.:1856 Zona Norte : 722 03 : 524 4:725 1st Qu.: 300
## Median :4190 Zona Oeste : 169 01 : 430 5:984 Median : 430
## Mean :3963 Zona Oriente: 289 04 : 62 6:696 Mean : 540
## 3rd Qu.:5862 Zona Sur :1939 07 : 4 3rd Qu.: 670
## Max. :8319 (Other): 7 Max. :1999
## NA's :1254
## areaconst parqueaderos banios habitaciones
## Min. : 30.0 Min. : 1.00 Min. : 0.000 Min. : 0.00
## 1st Qu.: 155.0 1st Qu.: 1.00 1st Qu.: 3.000 1st Qu.: 3.00
## Median : 240.0 Median : 2.00 Median : 4.000 Median : 4.00
## Mean : 402.1 Mean : 2.29 Mean : 3.894 Mean : 4.61
## 3rd Qu.: 350.0 3rd Qu.: 3.00 3rd Qu.: 5.000 3rd Qu.: 5.00
## Max. :47463.0 Max. :10.00 Max. :10.000 Max. :10.00
## NA's :733
## tipo barrio longitud latitud
## Apartamento: 0 ciudad jardín : 295 Min. :-7658915 Min. : 34
## Casa :3219 pance : 203 1st Qu.:-7653390 1st Qu.: 3449
## valle del lili: 168 Median :-7651521 Median :336905
## la flora : 99 Mean :-4809024 Mean :210698
## el caney : 84 3rd Qu.: -76538 3rd Qu.:342535
## ciudad 2000 : 76 Max. : -765 Max. :349584
## (Other) :2294#Análisis de Correlaciones entre variables predictoras y la variable a predecir. Se omite el estrato por ahora.
ggpairs(casas, columns = c("preciom","areaconst", "banios", "habitaciones"), proportions = "auto")
### Modelo para casas
# Manejo de variables categóricas en el modelo de RLM para el estrato
casas$Est4=as.numeric(casas$estrato=="4")
casas$Est5=as.numeric(casas$estrato=="5")
casas$Est6=as.numeric(casas$estrato=="6")
mod_casa=lm(preciom~areaconst+Est4+Est5+Est6+banios+habitaciones,data=casas)
summary(mod_casa)##
## Call:
## lm(formula = preciom ~ areaconst + Est4 + Est5 + Est6 + banios +
## habitaciones, data = casas)
##
## Residuals:
## Min 1Q Median 3Q Max
## -664.98 -119.90 -36.36 67.77 1399.78
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.794e+01 1.435e+01 4.038 5.52e-05 ***
## areaconst 4.745e-03 2.230e-03 2.127 0.0335 *
## Est4 8.179e+01 1.247e+01 6.557 6.35e-11 ***
## Est5 1.894e+02 1.212e+01 15.629 < 2e-16 ***
## Est6 5.664e+02 1.486e+01 38.112 < 2e-16 ***
## banios 6.970e+01 3.665e+00 19.017 < 2e-16 ***
## habitaciones 2.148e+00 2.924e+00 0.735 0.4626
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 232.8 on 3212 degrees of freedom
## Multiple R-squared: 0.5785, Adjusted R-squared: 0.5777
## F-statistic: 734.8 on 6 and 3212 DF, p-value: < 2.2e-16Validación de Supuestos para el modelo de casas
#Los errores son variables aleatorias normales
hist(residuals(mod_casa), col = "steelblue")
# Los errores tienen varianza constante
plot(fitted(mod_casa), residuals(mod_casa))
abline(h = 0, lty = 2)
#Los errores tienen media cero
t.test(residuals(mod_casa))##
## One Sample t-test
##
## data: residuals(mod_casa)
## t = 4.0203e-15, df = 3218, p-value = 1
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
## -8.036579 8.036579
## sample estimates:
## mean of x
## 1.647849e-14#Los errores son mutuamente independientes
lmtest::dwtest(mod_casa)##
## Durbin-Watson test
##
## data: mod_casa
## DW = 1.6709, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is greater than 0Predicción con el modelo
intercept <- coef(summary(mod_casa))["(Intercept)", "Estimate"]
areaconst <- coef(summary(mod_casa))["areaconst", "Estimate"]
banios <- coef(summary(mod_casa))["banios", "Estimate"]
habitaciones <- coef(summary(mod_casa))["habitaciones", "Estimate"]
est4 <- coef(summary(mod_casa))["Est4", "Estimate"]
est5 <- coef(summary(mod_casa))["Est5", "Estimate"]
est6 <- coef(summary(mod_casa))["Est6", "Estimate"]
#Valores Predictores
a_banios=2
a_habitaciones=4
a_areaconst=200
a_est4=1
a_est5=0
a_est6=0
#Predicción
precio_apto=intercept + areaconst*(a_areaconst) + banios*(a_banios) + est4*(a_est4) + est5*(a_est5) + est6*(a_est6)
precio_apto## [1] 280.0842Ofertas Potenciales
ofertas_c=subset(casas, preciom >= 280.0 & preciom <=350 & banios==2 & habitaciones == 4 & zona=="Zona Norte" & (estrato=="5" | estrato=="4" ))
#ofertas_c=subset(casas, preciom == 280.0 & zona=="Zona Norte")
#ofertas_c
head(ofertas_c,5)## # A tibble: 3 × 16
## id zona piso estrato preciom areaconst parqueaderos banios habitaciones
## <dbl> <fct> <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1163 Zona N… <NA> 5 350 216 2 2 4
## 2 1822 Zona N… <NA> 4 340 295 2 2 4
## 3 1943 Zona N… <NA> 5 350 346 1 2 4
## # ℹ 7 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>,
## # Est4 <dbl>, Est5 <dbl>, Est6 <dbl>Se grafican sobre un mapa algunas posibles ofertas
cali=shapefile("mc_barrios/cali.shp")
cali.tmap = tm_shape(cali) + tm_polygons()
ofertas=data.frame(lat=c(3.48181 , 3.4806, 3.47503),
long=c(-76.51218 , -76.51777, -76.51847))
oferta_sf=st_as_sf(ofertas, coords = c('long', 'lat'))
cali2= tm_shape(cali) + tm_polygons() + tm_shape(oferta_sf) + tm_dots(size=0.3, col="red")
cali2## Warning: Currect projection of shape oferta_sf unknown. Long-lat (WGS84) is
## assumed.
Con base en este análisis, y teniendo en cuenta el resultado de la predicción, se observa algunas ofertas cercanas a las características solicitadas. En Vipasa existe la posibilidad de encontrar la propiedad adecuada, teniendo en cuenta el crédito pre-aprobado.