Actividad 3
Christian Martinez
2024-10-14
Problema
Con base en los datos de ofertas de vivienda descargadas del portal Fincaraiz para apartamento de estrato 4 con área construida menor a 200 m2 la inmobiliaria A&C requiere el apoyo en la construcción de un modelo que lo oriente sobre los precios de inmuebles. Con este propósito el equipo de asesores ha diseñado los siguientes pasos para obtener un modelo y así poder a futuro determinar los precios de los inmuebles a negociar
Análisis exploratorio de datos
Se inicia reconociendo los campos presentes en la base de datos provista. En la siguiente tabla se observan los primeros 6 registros donde el campo Zona, Estrato y Tipo son tratados como Factores, dejando así 2 variables cuantitativas continuas, el Area Construida y el Precio del tipo Double.
formattable(head(vivienda4))| zona | estrato | preciom | areaconst | tipo |
|---|---|---|---|---|
| Zona Norte | 4 | 232.2643 | 52 | Apartamento |
| Zona Norte | 4 | 272.3068 | 160 | Casa |
| Zona Norte | 4 | 254.8213 | 108 | Apartamento |
| Zona Sur | 4 | 257.7722 | 96 | Apartamento |
| Zona Norte | 4 | 250.1956 | 82 | Apartamento |
| Zona Norte | 4 | 261.1614 | 117 | Casa |
En la siguiente tabla se encuentra el resumen de los datos por campo, se observa que todos los datos recopilados son exclusivamente de estrato 4.
summary(vivienda4) zona estrato preciom areaconst
Zona Centro : 8 3: 0 Min. :207.4 Min. : 40.00
Zona Norte : 288 4:1706 1st Qu.:230.7 1st Qu.: 60.00
Zona Oeste : 60 5: 0 Median :238.8 Median : 75.00
Zona Oriente: 6 6: 0 Mean :243.7 Mean : 87.63
Zona Sur :1344 3rd Qu.:251.5 3rd Qu.: 98.00
Max. :309.7 Max. :200.00
tipo
Apartamento:1363
Casa : 343
Finalmente, se encuentra el resumen estadístico de las variables cuantitativas.
formattable(as.data.frame(round(descr(vivienda4), 2)))| areaconst | preciom | |
|---|---|---|
| Mean | 87.63 | 243.70 |
| Std.Dev | 36.35 | 19.56 |
| Min | 40.00 | 207.41 |
| Q1 | 60.00 | 230.73 |
| Median | 75.00 | 238.77 |
| Q3 | 98.00 | 251.51 |
| Max | 200.00 | 309.70 |
| MAD | 22.24 | 14.19 |
| IQR | 38.00 | 20.77 |
| CV | 0.41 | 0.08 |
| Skewness | 1.53 | 1.26 |
| SE.Skewness | 0.06 | 0.06 |
| Kurtosis | 1.68 | 1.25 |
| N.Valid | 1706.00 | 1706.00 |
| Pct.Valid | 100.00 | 100.00 |
A priori, se puede comentar que el Area Construida presenta datos dispersos, pues el coeficiente de variacion es superior al 20%. Por otra parte, analizando los valores de los Cuartiles, se observa que los datos se encuentran algo sesgados a la derecha, es decir, con prepondernacia de valores menores, esto se corrobora con el Skewness > 0 y con los histogramas de estas variables mostrados en la siguiente figura.
par(mfrow = c(1,2))
hist(vivienda4$preciom, main = "Precio", xlab = "Millones COP")
hist(vivienda4$areaconst, main = "Area Construida", xlab = "m^2")
par(mfrow = c(1,1))Datos Faltantes
En la siguiente gráfica se observa que no hay datos faltantes en la base de datos.
gg_miss_var(vivienda4)
Comportamiento del precio
Para explorar cómo se comporta el precio de las viviendas, se segregan los datos por Zona y Tipo con el fin de conocer datos atípicos y encontrar comportamientos similares, cabe resaltar, que no se involucra el estrato ya que sólo se cuenta con datos de estrato 4.
# Lineas y labels Casas
zonasur <- subset(vivienda4, zona == "Zona Sur" & tipo == "Casa")
q <- quantile(zonasur$preciom, probs = c(0.25, 0.50, 0.75))
i <- iqr(zonasur$preciom)
infpreciocasassur <- q[1] - 1.5*i
if (infpreciocasassur <= min(zonasur$preciom)) infpreciocasassur <- min(zonasur$preciom)
suppreciocasassur <- q[3] + 1.5*i
if (suppreciocasassur >= max(zonasur$preciom)) suppreciocasassur <- max(zonasur$preciom)
# Lineas y labels Apartamentos
zonasuraptos <- subset(vivienda4, zona == "Zona Sur" & tipo == "Apartamento")
qsuraptos <- quantile(zonasuraptos$preciom, probs = 0.25)
isuraptos <- iqr(zonasuraptos$preciom)
infpreciosuraptos <- qsuraptos - 1.5*isuraptos
if (infpreciosuraptos <= min(zonasuraptos$preciom)) infpreciosuraptos <- min(zonasuraptos$preciom)
zonacenaptos <- subset(vivienda4, zona == "Zona Centro" & tipo == "Apartamento")
qcenaptos <- quantile(zonacenaptos$preciom, probs = 0.75)
icenaptos <- iqr(zonacenaptos$preciom)
suppreciocenaptos <- qcenaptos + 1.5*icenaptos
if (suppreciocenaptos >= max(zonacenaptos$preciom)) suppreciocenaptos <- max(zonacenaptos$preciom)
# Boxplot Casas
par(mfrow = c(1, 2))
boxplot(preciom ~ zona,
data = subset(vivienda4, tipo == "Casa"),
main = "Casas",
xlab = NA,
ylab = "Precio m^2",
notch = TRUE)
abline(h = infpreciocasassur, col = "blue", lty = "dashed")
text(infpreciocasassur, labels = round(infpreciocasassur, 2), pos = 3, col = "blue")
abline(h = suppreciocasassur, col = "blue", lty = "dashed")
text(suppreciocasassur, labels = round(suppreciocasassur, 2), pos = 1, col = "blue")
# Boxplot Apartamentos
boxplot(preciom ~ zona,
data = subset(vivienda4, tipo == "Apartamento"),
main = "Apartamentos",
xlab = NA,
ylab = "Precio m^2",
notch = TRUE)
abline(h = infpreciosuraptos, col = "blue", lty = "dashed")
text(infpreciosuraptos, labels = round(infpreciosuraptos, 2), pos = 3, col = "blue")
abline(h = suppreciocenaptos, col = "blue", lty = "dashed")
text(suppreciocenaptos, labels = round(suppreciocenaptos, 2), pos = 3, col = "blue")
par(mfrow = c(1, 1))Se observa que para las casas, la mediana del precio es similar, pues las muescas de los diagramas de caja se traslapan para todas las zonas, por lo tanto, se tomarán como datos atipicos aquellos valores mostrados en la figura anterior. Para los apartamentos, se dará un trato similar.
Comportamiento del area construida
Se realizo un tratamiento similar para el área construida la cual se presenta a continuación.
# Lineas y labels Casas
zonasur <- subset(vivienda4, zona == "Zona Sur" & tipo == "Casa")
q <- quantile(zonasur$areaconst, probs = 0.25)
i <- iqr(zonasur$areaconst)
infareacasasssur <- q - 1.5*i
if (infareacasasssur <= min(zonasur$areaconst)) infareacasasssur <- min(zonasur$areaconst)
zonanorte <- subset(vivienda4, zona == "Zona Norte" & tipo == "Casa")
qnorcasas <- quantile(zonanorte$areaconst, probs = 0.75)
inorcasas <- iqr(zonanorte$areaconst)
supareanorcasas <- qnorcasas + 1.5*inorcasas
if (supareanorcasas >= max(zonanorte$areaconst)) supareanorcasas <- max(zonanorte$areaconst)
# Lineas y labels Apartamentos
zonasuraptos <- subset(vivienda4, zona == "Zona Sur" & tipo == "Apartamento")
qsuraptos <- quantile(zonasuraptos$areaconst, probs = 0.25)
isuraptos <- iqr(zonasuraptos$areaconst)
infareasuraptos <- qsuraptos - 1.5*isuraptos
if (infareasuraptos <= min(zonasuraptos$areaconst)) infareasuraptos <- min(zonasuraptos$areaconst)
zonacenaptos <- subset(vivienda4, zona == "Zona Centro" & tipo == "Apartamento")
qcenaptos <- quantile(zonacenaptos$areaconst, probs = 0.75)
icenaptos <- iqr(zonacenaptos$areaconst)
supareacenaptos <- qcenaptos + 1.5*icenaptos
if (supareacenaptos >= max(zonacenaptos$areaconst)) supareacenaptos <- max(zonacenaptos$areaconst)
# Boxplot Casas
par(mfrow = c(1, 2))
boxplot(areaconst ~ zona,
data = subset(vivienda4, tipo == "Casa"),
main = "Casas",
xlab = NA,
ylab = "Area m^2",
notch = TRUE)
abline(h = infareacasasssur, col = "blue", lty = "dashed")
text(infareacasasssur, labels = round(infareacasasssur, 2), pos = 3, col = "blue")
abline(h = supareanorcasas, col = "blue", lty = "dashed")
text(supareanorcasas, labels = round(supareanorcasas, 2), pos = 1, col = "blue")
# Boxplot Apartamentos
boxplot(areaconst ~ zona,
data = subset(vivienda4, tipo == "Apartamento"),
main = "Apartamentos",
xlab = NA,
ylab = "Area m^2",
notch = TRUE)
abline(h = infareasuraptos, col = "blue", lty = "dashed")
text(infareasuraptos, labels = round(infareasuraptos, 2), pos = 3, col = "blue")
abline(h = supareacenaptos, col = "blue", lty = "dashed")
text(supareacenaptos, labels = round(supareacenaptos, 2), pos = 3, col = "blue")
par(mfrow = c(1, 1))Análisis exploratorio bivariado
En la siguiente gráfica, se presenta la relación entre la variable Precio como variable de respuesta y la variable Area Construida como variable independiente.
ggpairs(vivienda4[3:4], title = "Relacion Precio y Area")
Se observa que hay una correlación positiva fuerte, con un coeficiente R de 0.931. La prueba de significancia sobre el coeficiente nos dice que es significativamente diferente de cero.
Estimación modelo regresión lineal precio vs area
Para realizar el modelo, inicialmente se eliminaron datos atípicos teniendo en cuenta los gráficos de cajas mostrados anteriormente.
viviendalimpia <- subset(vivienda4,
ifelse (tipo == "Casa",
preciom >= infpreciocasassur & preciom <= suppreciocasassur &
areaconst >= infareacasasssur & areaconst <= supareanorcasas,
preciom >= infpreciosuraptos & preciom <= suppreciocenaptos &
areaconst >= infareasuraptos & areaconst <= supareacenaptos
))Eliminados los datos atípicos, permanecen un 98.77% de los datos originales, es decir, sólo se removieron 21 registros.
De acuerdo con lo observado en el Análisis Exploratorio de Datos, se propone realizar un modelo para estimar el precio de las casas y otro modelo para estimar el precio de los apartamentos.
Modelo para estimar precio de casas
viviendalimpiacasas <- subset(viviendalimpia, tipo == "Casa")
preciocasas <- lm(viviendalimpiacasas$preciom ~ viviendalimpiacasas$areaconst)
summary(preciocasas)
Call:
lm(formula = viviendalimpiacasas$preciom ~ viviendalimpiacasas$areaconst)
Residuals:
Min 1Q Median 3Q Max
-20.1064 -4.7773 -0.3723 4.9441 21.2966
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.978e+02 1.399e+00 141.38 <2e-16 ***
viviendalimpiacasas$areaconst 5.138e-01 9.868e-03 52.06 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 7.371 on 341 degrees of freedom
Multiple R-squared: 0.8883, Adjusted R-squared: 0.8879
F-statistic: 2711 on 1 and 341 DF, p-value: < 2.2e-16Se observa que tanto el valor obtenido para el intercepto como el valor de la pendiente son significativamente distintos de cero para una significancia del 5%, aparte de ello, se observa que el coeficiente de determinación es muy bueno, pues el modelo es capaz de explicar el comportamiento de la variable Precio en un 88.8%. Finalmente, la globalidad del modelo se encuentra significativa por medio del criterio de la prueba F
A continuacion, se verifican los supuestos del modelo.
shapiro.test(preciocasas$residuals)
Shapiro-Wilk normality test
data: preciocasas$residuals
W = 0.99705, p-value = 0.7918bptest(preciocasas)
studentized Breusch-Pagan test
data: preciocasas
BP = 0.56669, df = 1, p-value = 0.4516dwtest(preciocasas)
Durbin-Watson test
data: preciocasas
DW = 2.1222, p-value = 0.8693
alternative hypothesis: true autocorrelation is greater than 0par(mar=c(5.1, 2, 2, 2.1))
par(mfrow = c(2, 2))
plot(preciocasas)
par(mfrow = c(1, 1))En el gráfico QQ de residuales se observa que estos presentan una distribución normal, esta afirmación se corrobora con la prueba de Shapiro Wilks, con la cual no se rechaza la hipótesis nula de normalidad, pues p-value > 0.05.
En el gráfico de residuales vs valores ajustados se observa que los residuales presentan varianza constante, esta afirmación se corrobora con la prueba de Breusch-Pagan con la cual no se rechaza la hipótesis nula de varianza constante.
Finalmente se observa que los residuales presentan un comportamiento aleatorio y simétrico a cero en el gráfico de residuales vs valores ajustados, esta afirmación se corrobora con la prueba de Durbin-Watson con la cual no se rechaza la hipótesis nula de correlación de residuales igual a 0.
La gráfica de apalancamiento no muestra valores influyentes.
A continuación, se presenta un intervalo de confianza del 95% para los coeficientes del modelo.
confint(preciocasas) 2.5 % 97.5 %
(Intercept) 195.0422304 200.5460327
viviendalimpiacasas$areaconst 0.4943707 0.5331918Como el intérvalo del coeficiente viviendalimpiacasas$areaconst no contiene el valor cero, se confirma por otro criterio (a parte de la significancia obtenida por el p-valor) que dicho valor es distinto de cero y que el cambio de un metro cuadrado en el área construida influye de 0.49 a 0.53 veces en el precio de las casas, mientras que, independientemente del área construida, el precio de las viviendas casas parten de 195 a 200 millones con una confianza del 95%.
Modelo para estimar precio de apartamentos
viviendalimpiaapto <- subset(viviendalimpia, tipo == "Apartamento")
precioapto <- lm(preciom ~ areaconst, data = viviendalimpiaapto)
summary(precioapto)
Call:
lm(formula = preciom ~ areaconst, data = viviendalimpiaapto)
Residuals:
Min 1Q Median 3Q Max
-26.1634 -5.0663 -0.0043 4.6055 24.3535
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 200.42598 0.78688 254.7 <2e-16 ***
areaconst 0.49321 0.01032 47.8 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 7.097 on 1340 degrees of freedom
Multiple R-squared: 0.6303, Adjusted R-squared: 0.6301
F-statistic: 2285 on 1 and 1340 DF, p-value: < 2.2e-16Se observa que tanto el valor obtenido para el intercepto como el valor de la pendiente son significativamente distintos de cero para una significancia del 5%, aparte de ello, se observa que el coeficiente de determinación no es muy alto ya que el modelo es capaz de explicar el comportamiento de la variable Precio en un 63%, probablemente haya más variables que se deban tener en cuenta para predecir el precio de un apartamento, por ejemplo el piso en el que está ubicado y las comodidades del edificio donde se encuentre. Finalmente, la globalidad del modelo se encuentra significativa por medio del criterio de la prueba F.
A continuacion, se verifican los supuestos del modelo.
shapiro.test(precioapto$residuals)
Shapiro-Wilk normality test
data: precioapto$residuals
W = 0.99876, p-value = 0.4789bptest(precioapto)
studentized Breusch-Pagan test
data: precioapto
BP = 0.090144, df = 1, p-value = 0.764gqtest(precioapto)
Goldfeld-Quandt test
data: precioapto
GQ = 1.0595, df1 = 669, df2 = 669, p-value = 0.2274
alternative hypothesis: variance increases from segment 1 to 2dwtest(precioapto)
Durbin-Watson test
data: precioapto
DW = 2.0386, p-value = 0.7572
alternative hypothesis: true autocorrelation is greater than 0par(mar=c(5.1, 2, 2, 2.1))
par(mfrow = c(2, 2))
plot(precioapto)
par(mfrow = c(1, 1))En el gráfico QQ de residuales se observa que estos presentan una distribución normal, esta afirmación se corrobora con la prueba de Shapiro Wilks, con la cual no se rechaza la hipótesis nula de normalidad, pues p-value > 0.05.
En el gráfico de residuales vs valores ajustados se observa que aparentemente la varianza de los residuales disminuye para valores ajustados mayores, sin embargo, se ejecutaron 2 pruebas de hipótesis por sospecha (la de Breusch-Pagan y Goldfeld-Quant) con las cuales se corrobora el supuesto de varianza constante.
Finalmente se observa que los residuales presentan un comportamiento aleatorio y simétrico a cero en el gráfico de residuales vs valores ajustados, esta afirmación se corrobora con la prueba de Durbin-Watson con la cual no se rechaza la hipótesis nula de correlación de residuales igual a 0.
La gráfica de apalancamiento no muestra valores influyentes.
A continuación, se presenta un intervalo de confianza del 95% para los coeficientes del modelo.
confint(precioapto) 2.5 % 97.5 %
(Intercept) 198.8823335 201.969623
areaconst 0.4729702 0.513453Como el intérvalo del coeficiente viviendalimpiaapto$areaconst no contiene el valor cero, se confirma por otro criterio (a parte de la significancia obtenida por el p-valor) que dicho valor es distinto de cero y que el cambio de un metro cuadrado en el área construida influye de 0.47 a 0.51 veces en el precio de los apartamentos, mientras que, independientemente del área construida, el precio de los apartamentos parten de 199 a 202 millones con una confianza del 95%.
Exploracion de otros modelos
Se realizó una exploración de modelos utilizando transformaciones logarítmicas para el modelo de predicción de precio de casas que se muestran a continuación.
y <- viviendalimpiacasas$preciom
logy <- log(y)
x <- viviendalimpiacasas$areaconst
logx <- log(x)
modelo1 <- lm(y ~ x) #lin-lin
modelo2 <- lm(logy ~ x) #log-lin
modelo3 <- lm(y ~ logx) #lin-log
modelo4 <- lm(logy ~ logx) #log-log
stargazer(modelo1, modelo2, modelo3, modelo4,
type = "text",
df = FALSE,
title = "Exploracaión Modelos Precio vs Area Casas")
Exploracaión Modelos Precio vs Area Casas
=======================================================================
Dependent variable:
---------------------------------------------------
y logy y logy
(1) (2) (3) (4)
-----------------------------------------------------------------------
x 0.514*** 0.002***
(0.010) (0.00004)
logx 64.607*** 0.244***
(1.358) (0.005)
Constant 197.794*** 5.324*** -46.639*** 4.401***
(1.399) (0.005) (6.619) (0.024)
-----------------------------------------------------------------------
Observations 343 343 343 343
R2 0.888 0.885 0.869 0.876
Adjusted R2 0.888 0.885 0.869 0.875
Residual Std. Error 7.371 0.028 7.978 0.029
F Statistic 2,710.607*** 2,621.839*** 2,264.156*** 2,403.096***
=======================================================================
Note: *p<0.1; **p<0.05; ***p<0.01Se observa que el mejor modelo es el primero (lin-lin) descrito descrito en el apartado “Modelo para estimar precio de casas” ya que se obtiene tanto un R cuadrado y un valor F mayor que el resto de modelos.
De igual manera, se realizó una exploración de modelos para la predicción del precio de apartamentos, los resultados se presentan a continuación.
y <- viviendalimpiaapto$preciom
logy <- log(y)
x <- viviendalimpiaapto$areaconst
logx <- log(x)
modelo1 <- lm(y ~ x) #lin-lin
modelo2 <- lm(logy ~ x) #log-lin
modelo3 <- lm(y ~ logx) #lin-log
modelo4 <- lm(logy ~ logx) #log-log
stargazer(modelo1, modelo2, modelo3, modelo4,
type = "text",
df = FALSE,
title = "Exploracaión Modelos Precio vs Area Apartamentos")
Exploracaión Modelos Precio vs Area Apartamentos
=======================================================================
Dependent variable:
---------------------------------------------------
y logy y logy
(1) (2) (3) (4)
-----------------------------------------------------------------------
x 0.493*** 0.002***
(0.010) (0.00004)
logx 39.250*** 0.163***
(0.851) (0.004)
Constant 200.426*** 5.316*** 69.112*** 4.771***
(0.787) (0.003) (3.643) (0.015)
-----------------------------------------------------------------------
Observations 1,342 1,342 1,342 1,342
R2 0.630 0.618 0.613 0.606
Adjusted R2 0.630 0.618 0.613 0.606
Residual Std. Error 7.097 0.030 7.257 0.031
F Statistic 2,284.902*** 2,168.182*** 2,126.870*** 2,064.912***
=======================================================================
Note: *p<0.1; **p<0.05; ***p<0.01También se observa que el modelo lin-lin descrito en el apartado “Modelo para estimar precio de apartamentos” es el mejor teniendo en cuenta los mismos criterios de la exploración anterior.
Estimación de precio de apartamentos
Si por ejemplo, se quisiera estimar el precio promedio de un apartamento de 110 metros cuadrados, utilizando el modelo desarrollado, se obtendría un valor entre 253.85 y 255.50 millones con una confianza del 95%
predict.lm(precioapto, data.frame(areaconst = 110),
interval = "confidence", level = 0.95) fit lwr upr
1 254.6793 253.8559 255.5026Si la inmobiliaria encontrara un apartamento con la misma área en un precio de 200 millones de pesos, sería una oferta muy atractiva ya que como se estimó, el precio es mayor, esto bajo las consideraciones de condición del apartamento, estado físico, estado legal, etc.