Caso: Ofertas de viviendas

El taller se realiza Con base en los datos de ofertas de vivienda descargados en un archivo Excel a partir de los datos disponibles en el portal Fincaraiz.com.co.

A continuación una muestra del conjunto de datos:

viviendas <- read_excel("C:/MCD/SM1/Metodos/Act4/datos_vivienda.xlsx")
head(viviendas)
area_construida precio_millon
86 250
118 385
130 395
181 419
86 240
98 320

(1) Análisis exploratorio de las variables precio de vivienda (millones de pesos COP) y área de la vivienda (metros cuadrados). 

par(mfrow=c(1,2))
hist(area_construida, xlab="Metros Cuadrados", col="#6495ED", main="Histograma [Área Construida]", freq=FALSE)
lines(density(area_construida), col = "red", lwd = 2)
boxplot(area_construida, xlab="Metros Cuadrados", col="#6495ED", main="Caja [Área Construida]")

data.frame(media, mediana, minimo, maximo, desviacion, q25, q75, q95)
media mediana minimo maximo desviacion q25 q75 q95
25% 115.7469 97 80 195 35.54332 86 130 178.25

Análisis:

Los datos nos revelan que el promedio del área construida de la oferta de viviendas es de 115.7 m2, para áreas que oscilan entre los 80 m2 (mínimo) y los 195 m2 (máximo). De acuerdo a lo observado en el gráfico de caja, la mediana (97 m2) alejada de la media (115.7 m2) y una alta desviación estándar confirman una dispersión de los datos con una mayor concentración para viviendas con área construida inferior a los 100 m2 lo cual se evidencia en la curva de densidad dibujada sobre el histograma, es decir una asimetría positiva a la derecha (o a la derecha) que indica la existencia de valores más separados de la media a la derecha, que se confirma en el gráfico de caja cuyo rango más amplio está precisamente por encima de la mediana donde los datos estarán más dispersos. También podemos precisar que la mitad de las viviendas ofertadas tienen un área construida menor o igual a los 97 m2 y sólo un 25% superan los 130 m2. 

par(mfrow=c(1,2))
hist(precio_millon, xlab="Millón COP$", col="#6495ED", main="Histograma [Precio]", freq=FALSE)
lines(density(precio_millon), col = "red", lwd = 2)
boxplot(precio_millon, xlab="Millón COP$", col="#6495ED", main="Caja [Precio]")

data.frame(media, mediana, minimo, maximo, desviacion, q25, q75, q95)
media mediana minimo maximo desviacion q25 q75 q95
25% 332.0769 305 240 480 82.14423 251.25 395 450

Análisis:

Los datos nos revelan que el promedio del precio de la oferta de viviendas es de 332 millones, para valores que oscilan entre los 240 millones (mínimo) y los 480 millones (máximo). De acuerdo a lo observado en el gráfico de caja, la mediana (305 millones) alejada de la media (332 millones) y una alta desviación estándar confirman una dispersión de los datos aunque sin una concentración de datos tan bien definida, lo cual se evidencia en la curva de densidad dibujada sobre el histograma donde se observa una distribución bimodal con una concentración de precios más o menos homogéneos por debajo y por encima de los 340 millones, con una mayor concentración hacia viviendas más económicas entre los 200 y los 300 millones de pesos colombianos. Lo anterior confirma una asimetría positiva. También podemos precisar que la mitad de las viviendas se oferta a un precio menor o igual a los 305 millones y sólo un 25% están en un rango de costosas superando los 395 millones de pesos colombianos.

(2) Análisis exploratorio bivariado de datos enfocado en la relación entre la variable respuesta (y=precio) en función de la variable predictora (x=area). 

# Gráfico de dispersión Precio vs. Área
plot( x = area_construida, y = precio_millon
      , main = "Precio (x) vs. Área Construida (y)"
      , xlab = "COP ($)"
      , ylab = "Metros cuadrados (m2)"
      , col = "gray52"
      , pch = 19
)

# Ajuste lineal
abline(lm(precio_millon ~ area_construida), col="red", lwd=3)

# Ajuste suavizado
lines(lowess(area_construida, precio_millon), col = "orange", lwd = 3)

# Leyenda
legend("topleft", legend = c("Lineal", "Suavizado"),
       lwd = 3, lty = c(1, 1), col = c("red", "orange"))

coef_r = cor(area_construida, precio_millon)
print( paste('El coeficiente de correlación de Pearson entre Precio (x) vs. Área Construida (y), es: ', coef_r) ) 
## [1] "El coeficiente de correlación de Pearson entre Precio (x) vs. Área Construida (y), es:  0.919029470997185"

Análisis:

Observando la gráfica de dispersión podemos destacar una tendencia directa o creciente en la relación del precio de la vivienda y su área construida. Sin embargo, si observamos la línea naranja de ajuste suavizado, esta relación directa con tendencia creciente parece estabilizarse un poco cuando el precio de la vivienda es mayor a 130 millones de pesos colombianos. Observando el Coeficiente de Correlación de Pearson (0.91) podemos determinar que la asociación que mide la relación lineal entre el precio y el área construida es una relación directa y fuerte por ser mayor a 0.8, pero no del todo perfecta o que es igual a indicar que no es clara su linealidad. Recordemos que este coeficiente es un indicador que nos ayuda a medir la fuerza de la relación lineal entre un par de variables continuas, en este caso se puede interpretar que a mayor precio hay mayor posibilidad a que la vivienda tenga mayor área en metros cuadrados construidos.

(3) Estimación del modelo de regresión lineal simple: precio = f(area) + e. 

modelo_lineal = lm(precio_millon ~ area_construida)
summary(modelo_lineal)
## 
## Call:
## lm(formula = precio_millon ~ area_construida)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -51.673 -25.612  -6.085  24.875  67.650 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       86.234     22.479   3.836 0.000796 ***
## area_construida    2.124      0.186  11.422 3.45e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 33.05 on 24 degrees of freedom
## Multiple R-squared:  0.8446, Adjusted R-squared:  0.8381 
## F-statistic: 130.5 on 1 and 24 DF,  p-value: 3.45e-11

Análisis:

De acuerdo a los indicadores de regresión lineal simple, tenemos:
La ecuación: Y = β0 + β1X + ε
donde,
X, es la variable dependiente o de respuesta, en este caso Área Construida
Y, es la variable independiente o predictora, en este caso Precio
β0, es el intercepto de la recta con el eje vertical. En este caso igual a 86,234
β1, se conoce como pendiente y determina la inclinación de la recta. En este caso igual a 2,124

Precio = 86.234 + 2.124(Area) + ε

En cuanto a la interpretación de los coeficientes, podemos mencionar que β0 no se puede interpretar porque no es coherente considerar alguna vivienda sin área construida o lo que es igual a indicar con cero (0) metros cuadrados construidos. Para el caso del coeficiente β1 podemos interpretar: que por cada metro cuadrado adicional que tenga la vivienda el precio de la misma se incrementa en 2,124 millones de pesos colombianos.

(4) Construcción de intervalo de confianza (95%) para el coeficiente β1. 

# Intervalo de confianza del 95%
confint(modelo_lineal, level=0.95)
##                    2.5 %     97.5 %
## (Intercept)     39.83983 132.627917
## area_construida  1.74017   2.507771

Análisis:

Con un nivel de confianza del 95% y un 5% de error α, podemos determinar que el coeficiente β1 para el caso del área construida podría tomar un valor entre los 1,74 y los 2,50 millones por cada metro cuadrado construido.
Adicionalmente, lo que se logra observar en la prueba de hipotesis t en la tabla de resumen (summary) del modelo de regresión lineal es un P-Value igual 3.45e-11 lo que indica un nivel de confianza del 99.9% (***).
En ninguno de los dos casos el coeficiente fue igual a cero (0), por lo cual existe evidencia estadística de que el precio y el área construida están correlacionados y dicha correlación es significativa.

(5) Indicador de bondad y ajuste R2. 

r2 = summary(modelo_lineal)$r.squared
print( paste("Coeficiente de determinación (R2): ", r2) )
## [1] "Coeficiente de determinación (R2):  0.844615168561367"

Análisis:

El Coeficiente de Determinación, también conocido como R2, es una medida de ajuste que indica si finalmente las estimaciones (predicciones) que se logran con la recta de regresión reflejan la realidad.
El R2 del modelo es del 0.8446 que evidencia un buen ajuste a los datos aunque no excelente y nos permite determinar que el área construida de una vivienda explica el 84.46% de la variabilidad de los precios por millón de dichas viviendas.

(6) Predicción del precio promedio para un apartamento de 110 metros cuadrados. 

# Cálculo de predicción
predict( modelo_lineal, list(area_construida=110), interval="confidence" )
##        fit      lwr      upr
## 1 319.8706 306.3133 333.4279
Planteamiento Análisis:
¿Considera entonces con este resultado que un apartamento en la misma zona con 110 metros cuadrados en un precio de 200 millones seria una buena oferta? El precio promedio esperado de oferta para una vivienda de 110 metros cuadrados es de 319,87 millones de pesos colombianos. El intervalo de confianza para la predicción del precio nos indica que el promedio estaría entre los 306,31 y los 333,42 millones de pesos colombianos con un 95% de confianza. Por lo tanto un apartamento de 110 metros cuadrados en la misma zona a un precio de 200 millones es claramente una excelente oferta.
¿Qué consideraciones adicionales se deben tener? La predicción puede estar matizada por otras variables que entren en juego como los años de antigüedad del inmueble, el valor de la administración, estrato socio-económico, entre otras, así como la elección del modelo de predicción dependiendo de la naturaleza continua o discreta de sus variables y la correlación entre las mismas.



(7) Validación de supuestos del modelo.


Modelo lineal simple:

par(mfrow=c(2,2))
plot(modelo_lineal)

Supuesto Análisis:
Varianza constante De acuerdo a lo observado en la Gráfica #1 “Residuales vs. Valores Ajustados” el supuesto de aleatoriedad de los errores no se está cumpliendo, es decir que los residuales no se comportan como una nube aleatoria por tanto la relación entre el precio y el área construida de la vivienda no es propiamente una asociación lineal perfecta, como si lo indicaba la gráfica de dispersión.
Normalidad De acuerdo a lo observado en la Gráfica #2 de Normalidad la mayoría de los datos no se ajustan de forma perfecta aunque ligera a la línea de normalidad del QQ-Plot, por lo tanto no se cumple el supuesto.
Linealidad De acuerdo a lo observado en la Gráfica #1 “Residuales vs. Valores Ajustados” la variable dependiente no parece estar linealmente relacionada con la independiente y lo evidenciamos porque la curva de ajuste en rojo no es recta ni horizontal, lo que señalaría que valores observados y residuos se distribuyen entre sí aleatoriamente y con algunos valores atípicos, por tanto no se cumple el supuesto.
Independencia Dado que los datos no están consolidados en función del tiempo, entonces no será posible validar este supuesto, por lo cual se descarta para esta aproximación lineal y futuras transformaciones.


Sugerencia: Realizar distintas transformaciones sobre las variables involucradas a fin de observar si el ajuste hace cumplir los supuestos. Posiblemente una función de transformación que incluya una curva sea mejor para el ajuste.

(8) Mejora al ajuste y supuestos del modelo.


Transformaciones para linealizar el modelo:

modelo_exponencial = lm(formula = log(precio_millon) ~ area_construida)
modelo_logaritmico = lm(formula = precio_millon ~ log10(area_construida))
modelo_doble_logaritmico = lm(formula = log10(precio_millon) ~ log10(area_construida))
modelo_hiperbolico = lm(formula = precio_millon ~ (1/area_construida))
modelo_inverso = lm(formula = (1/precio_millon) ~ area_construida)

Modelo <- c("Lineal", "Exponencial", "Logarítmico", "Doblemente Logarítmico"
                   , "Hiperbólico", "Doblemente Inverso")
R_Cuadrado <- c(summary(modelo_lineal)$r.squared, summary(modelo_exponencial)$r.squared
              , summary(modelo_logaritmico)$r.squared, summary(modelo_doble_logaritmico)$r.squared
              , summary(modelo_hiperbolico)$r.squared, summary(modelo_inverso)$r.squared)
data.frame(Modelo, R_Cuadrado)
Modelo R_Cuadrado
Lineal 0.8446152
Exponencial 0.8172345
Logarítmico 0.8962713
Doblemente Logarítmico 0.8767264
Hiperbólico 0.0000000
Doblemente Inverso 0.7832378


Análisis de Residuales:

# Exponencial
grf_modelo_exponencial <- ggplot(data = viviendas, aes(precio_millon, modelo_exponencial$residuals)) +
  geom_point() +  geom_smooth(color = "firebrick") + 
  geom_hline(yintercept = 0) + theme_classic() + 
  labs(title = "", 
       x = 'Precio/Millón (COP$)', 
       y = 'Residuos')

# Logarítmico
grf_modelo_logaritmico <- ggplot(data = viviendas, aes(precio_millon, modelo_logaritmico$residuals)) +
  geom_point() +  geom_smooth(color = "firebrick") + 
  geom_hline(yintercept = 0) + theme_classic() + 
  labs(title = "", 
       x = 'Precio/Millón (COP$)', 
       y = 'Residuos')

ggarrange(grf_modelo_exponencial, grf_modelo_logaritmico, labels = c("Exponencial", "Logarítmico"))

# Doblemente Logarítmico
grf_modelo_doble_logaritmico <- ggplot(data = viviendas, aes(precio_millon, modelo_doble_logaritmico$residuals)) +
  geom_point() +  geom_smooth(color = "firebrick") + 
  geom_hline(yintercept = 0) + theme_classic() + 
  labs(title = "", 
       x = 'Precio/Millón (COP$)', 
       y = 'Residuos')

# Doblemente Inverso
grf_modelo_inverso <- ggplot(data = viviendas, aes(precio_millon, modelo_inverso$residuals)) +
  geom_point() +  geom_smooth(color = "firebrick") + 
  geom_hline(yintercept = 0) + theme_classic() + 
  labs(title = "", 
       x = 'Precio/Millón (COP$)', 
       y = 'Residuos')

ggarrange(grf_modelo_doble_logaritmico, grf_modelo_inverso, labels = c("Doblemente Lograrítmico", "Doblemente Inverso"))

Análisis:

Al intentar aplicar diferentes transformaciones a las variables sin incluir al modelo variables predictoras adicionales, buscamos aumentar la medida de ajuste y bondad R2.
Sin embargo observando los R2 obtenidos para las diferentes transformaciones podemos observar que no mejora el ajuste a los datos. Además, si observamos los plot de Residuales vs. Precio, podemos determinar que los errores no tienden a una media cero (0) ni una varianza constante, por lo cual se sugiere aplicar técnicas de regresión no líneal.

(9) Comparación del ajuste y supuestos entre el modelo inicial y el transformado.


Cálculo de R2 y análisis de residuales de los modelos polinomiales (cuadrático y cúbico):

modelo_cuadratico <- lm(precio_millon ~ poly(area_construida, 2))
modelo_cubico <- lm(precio_millon ~ poly(area_construida, 3))

Modelo <- c("Lineal","Polinomial Cuadrático", "Polinomial Cúbico")
R_Cuadrado <- c(summary(modelo_lineal)$r.squared, summary(modelo_cuadratico)$r.squared, summary(modelo_cubico)$r.squared)
data.frame(Modelo, R_Cuadrado)
Modelo R_Cuadrado
Lineal 0.8446152
Polinomial Cuadrático 0.9378497
Polinomial Cúbico 0.9380455 
# Doblemente Logarítmico
grf_modelo_cuadratico <- ggplot(data = viviendas, aes(precio_millon, modelo_cuadratico$residuals)) +
  geom_point() +  geom_smooth(color = "firebrick") + 
  geom_hline(yintercept = 0) + theme_classic() + 
  labs(title = "", 
       x = 'Precio/Millón (COP$)', 
       y = 'Residuos')

# Doblemente Inverso
grf_modelo_cubico <- ggplot(data = viviendas, aes(precio_millon, modelo_cubico$residuals)) +
  geom_point() +  geom_smooth(color = "firebrick") + 
  geom_hline(yintercept = 0) + theme_classic() + 
  labs(title = "", 
       x = 'Precio/Millón (COP$)', 
       y = 'Residuos')

ggarrange(grf_modelo_cuadratico, grf_modelo_cubico, labels = c("Polinomial Cuadrático", "Polinomial Cúbico"))


Gráfica comparativa de los modelos:

ggplot(data=viviendas, aes(x=area_construida, y=precio_millon))+
  geom_point()+
  stat_smooth(method="lm", formula= y~x, color="red", aes(colour = "Lineal"))+
  stat_smooth(method="lm", formula= y~poly(x,2), color="blue", aes(colour = "Cuadrática"))+
  stat_smooth(method="lm", formula= y~poly(x,3), color="green", aes(colour = "Cúbica"))

#  stat_smooth(method="lm", formula= y~x, color="red")+
#  stat_smooth(method="lm", formula= y~poly(x,2), color="blue")+
#  stat_smooth(method="lm", formula= y~poly(x,3), color="green")+
#  scale_color_manual(labels=c("red", "blue", "green"), values = c("red", "blue", "green"))

Análisis:

Cuando las transformaciones no mejoran mucho los parámetros y evaluación del modelo, podemos probar modelos polinomiales. Estos son modelos lineales que contienen la variable X en un polinomio de potencias de X:

Y = α + β1X + β2X2 + β3X3 + … + βnXn

Usualmente se llega hasta la potencia cúbica, para evitar caer en overfitting, aunque en en nuestro caso la medida de ajuste y bondad es exactamente la misma.
Con cualquiera de los dos modelos polinomiales se mejora significativamente la aleatoriedad de los residuales y por lo tanto puede explicar un 93.7% la variación del precio de la vivienda, en comparación con el 84.46% logrado con el modelo lineal simple.