Realice un filtro a la base de datos e incluya sólo las ofertas de apartamentos. Presente los primeros 3 registros de las bases y algunas tablas que comprueben la consulta. Teniendo en cuenta que mas adelante no se van a utilizar algunas variables para la construccion del modelo, se proceden a quitar del dataset
library(paqueteMODELOS)
library(plotly)
apartamentos3 <- subset(vivienda, tipo == "Apartamento")
apartamentos3 <- subset(apartamentos3, select = -c(id, barrio, piso, longitud, latitud))
head(apartamentos3, n = 3L)
## # A tibble: 3 × 8
## zona estrato preciom areaconst parqueaderos banios habitaciones tipo
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 Zona Norte 5 260 90 1 2 3 Apartam…
## 2 Zona Norte 5 240 87 1 3 3 Apartam…
## 3 Zona Norte 4 220 52 2 2 3 Apartam…
frecuencia_tipo <- table(apartamentos3$tipo)
print(frecuencia_tipo)
##
## Apartamento
## 5100
Se van a tratar los NAs que hay en las variables que se usaran en el modelo.
summary(apartamentos3)
## zona estrato preciom areaconst
## Length:5100 Min. :3.000 Min. : 58.0 Min. : 35.0
## Class :character 1st Qu.:4.000 1st Qu.: 175.0 1st Qu.: 68.0
## Mode :character Median :5.000 Median : 279.0 Median : 90.0
## Mean :4.727 Mean : 366.9 Mean :112.8
## 3rd Qu.:6.000 3rd Qu.: 430.0 3rd Qu.:130.0
## Max. :6.000 Max. :1950.0 Max. :932.0
##
## parqueaderos banios habitaciones tipo
## Min. : 1.000 Min. :0.000 Min. :0.000 Length:5100
## 1st Qu.: 1.000 1st Qu.:2.000 1st Qu.:3.000 Class :character
## Median : 1.000 Median :2.000 Median :3.000 Mode :character
## Mean : 1.568 Mean :2.617 Mean :2.971
## 3rd Qu.: 2.000 3rd Qu.:3.000 3rd Qu.:3.000
## Max. :10.000 Max. :8.000 Max. :9.000
## NA's :869
Podemos observar que la variable parqueaderos tiene valores NA, los cuales se imputarán utilizando su moda. Además, existen apartamentos con 0 baños o 0 habitaciones, por lo que se procederá a tratar estos casos de manera adecuada.
get_mode <- function(x) {
uniq_x <- unique(x)
uniq_x[which.max(tabulate(match(x, uniq_x)))]
}
moda_parqueaderos <- get_mode(apartamentos3$parqueaderos[!is.na(apartamentos3$parqueaderos)])
cat("moda de parqueaderos", moda_parqueaderos, "\n")
## moda de parqueaderos 1
apartamentos3$parqueaderos[is.na(apartamentos3$parqueaderos)] <- moda_parqueaderos
cat("Cantidad de apartamentos con 0 habitaciones:", sum(apartamentos3$habitaciones == 0), "\n")
## Cantidad de apartamentos con 0 habitaciones: 21
cat("Cantidad de apartamentos con 0 baños:", sum(apartamentos3$banios == 0), "\n")
## Cantidad de apartamentos con 0 baños: 14
apartamentos3 <- apartamentos3[apartamentos3$banios > 0 & apartamentos3$habitaciones > 0,]
Se reemplazaron los valores NA de la variable parqueaderos con su moda, que es 1. Además, dado que el número de apartamentos con cero habitaciones o cero baños es muy reducido, se han eliminado del dataset.
summary(apartamentos3)
## zona estrato preciom areaconst
## Length:5074 Min. :3.000 Min. : 58.0 Min. : 40.0
## Class :character 1st Qu.:4.000 1st Qu.: 175.0 1st Qu.: 68.0
## Mode :character Median :5.000 Median : 276.0 Median : 90.0
## Mean :4.727 Mean : 366.7 Mean :112.5
## 3rd Qu.:6.000 3rd Qu.: 430.0 3rd Qu.:130.0
## Max. :6.000 Max. :1950.0 Max. :932.0
## parqueaderos banios habitaciones tipo
## Min. : 1.00 Min. :1.000 Min. :1.000 Length:5074
## 1st Qu.: 1.00 1st Qu.:2.000 1st Qu.:3.000 Class :character
## Median : 1.00 Median :2.000 Median :3.000 Mode :character
## Mean : 1.47 Mean :2.623 Mean :2.984
## 3rd Qu.: 2.00 3rd Qu.:3.000 3rd Qu.:3.000
## Max. :10.00 Max. :8.000 Max. :9.000
Como se puede observar, el dataset está ahora listo para realizar los análisis y desarrollar el modelo.
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.
Vamos a analizar la correlación entre la variable respuesta y el área construida. Para ello, calcularemos el coeficiente de correlación de Pearson, que mide la fuerza y la dirección de la relación lineal entre estas dos variables.
# Calcular el coeficiente de correlación de Pearson
correlacion_precio_area <- cor(apartamentos3$preciom, apartamentos3$areaconst, use = "complete.obs")
cat("Correlacion entre Precio y Área", correlacion_precio_area, "\n")
## Correlacion entre Precio y Área 0.834134
#Grafico para apreciar la relacion
plot_ly(apartamentos3, x = ~areaconst, y = ~preciom, mode = 'markers', type = 'scatter') %>%
layout(title = 'Precio vs. Área Construida', xaxis = list(title = 'Área Construida'), yaxis = list(title = 'Precio'))
El coeficiente de correlación de 0.83 entre el precio y el área construida indica una fuerte correlación positiva. Esto sugiere que, en general, a medida que aumenta el área construida, el precio de los apartamentos también tiende a aumentar. Además, en la grafica podemos observar dicha relación.
# Calcular la correlación de Spearman
correlacion_precio_estrato <- cor(apartamentos3$preciom, apartamentos3$estrato, method = "spearman", use = "complete.obs")
# Mostrar el valor de la correlación
cat("Correlacion entre Precio y Estrato", correlacion_precio_estrato, "\n")
## Correlacion entre Precio y Estrato 0.8383017
fig <- plot_ly(apartamentos3, x = ~estrato, y = ~preciom, type = "box", boxpoints = "all", jitter = 0.3, pointpos = -1.8)
fig <- fig %>% layout(title = "Distribución del Precio por Estrato",
xaxis = list(title = "Estrato"),
yaxis = list(title = "Precio"))
fig
El coeficiente de correlación de Spearman de 0.84 entre el precio y el estrato indica una fuerte correlación positiva. Esto sugiere que, en general, a medida que aumenta el estrato, el precio de los apartamentos también tiende a aumentar. En el grafico de cajas y bigotes se aprecia tambien este comportamiento, algo a destacar es el gran aumento que hay en los precios entre el estrato 5 y 6.
# Calcular la correlación de Spearman
correlacion_precio_banios <- cor(apartamentos3$preciom, apartamentos3$banios, method = "spearman", use = "complete.obs")
# Mostrar el valor de la correlación
cat("Correlacion entre Precio y Baños", correlacion_precio_banios, "\n")
## Correlacion entre Precio y Baños 0.7784337
fig2 <- plot_ly(apartamentos3, x = ~banios, y = ~preciom, type = "box", boxpoints = "all", jitter = 0.3, pointpos = -1.8)
fig2 <- fig2 %>% layout(title = "Distribución del Precio por Número de Baños",
xaxis = list(title = "Número de Baños"),
yaxis = list(title = "Precio"))
fig2
El coeficiente de correlación de Spearman de 0.78 entre el precio y el número de baños indica una fuerte correlación positiva. Esto sugiere que, en general, a medida que aumenta el número de baños, el precio de los apartamentos también tiende a aumentar. En el grafico interactivo podemos observar dicho comportamiento de manera clara. Además, se observa que hay muy pocos apartamentos con 7 u 8 baños.
# Calcular la correlación de Spearman
correlacion_precio_habitac <- cor(apartamentos3$preciom, apartamentos3$habitaciones, method = "spearman", use = "complete.obs")
cat("Correlacion entre Precio y Habitaciones", correlacion_precio_habitac, "\n")
## Correlacion entre Precio y Habitaciones 0.33162
fig2 <- plot_ly(apartamentos3, x = ~habitaciones, y = ~preciom, type = "box", boxpoints = "all", jitter = 0.3, pointpos = -1.8)
fig2 <- fig2 %>% layout(title = "Distribución del Precio por Número de Habitaciones",
xaxis = list(title = "Número de Habitaciones"),
yaxis = list(title = "Precio"))
fig2
El coeficiente de correlación de Spearman de 0.33 entre el precio y el número de habitaciones indica una correlación positiva moderada. Esto sugiere que existe una relación positiva entre el número de habitaciones y el precio de los apartamentos, aunque esta relación es más débil en comparación con otras variables. Este comportamiento se refleja en la gráfica, donde el aumento del precio a medida que aumenta el número de habitaciones no es tan evidente. Además, se observa que hay muy pocos apartamentos con entre 6 y 9 habitaciones.
library(dplyr)
# Para comparar Precio entre Zonas
anova_resultado <- aov(preciom ~ zona, data = apartamentos3)
summary(anova_resultado)
## Df Sum Sq Mean Sq F value Pr(>F)
## zona 4 118551566 29637892 490.3 <2e-16 ***
## Residuals 5069 306429342 60452
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fig3 <- plot_ly(apartamentos3, y = ~preciom, x = ~zona, type = 'box',
marker = list(color = 'blue'),
boxmean = TRUE) %>%
layout(title = 'Distribución del Precio por Zona',
xaxis = list(title = 'Zona'),
yaxis = list(title = 'Precio'))
fig3
El valor F de 490.3 y el valor p muy pequeño (<2e-16) indican que hay una diferencia estadísticamente significativa en los precios entre las distintas zonas. En otras palabras, el precio de los apartamentos varía significativamente según la zona en la que se encuentren. Dado que el valor p es mucho menor que 0.001, podemos rechazar la hipótesis nula de que no hay diferencias en los precios entre las zonas. Por lo tanto, podemos concluir que las zonas tienen un efecto importante en los precios de los apartamentos.
Estime un modelo de regresión lineal múltiple con las variables del punto anterior (precio = f(área construida, estrato, número de cuartos, número de parqueaderos, número 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).
modelo1 <- lm(preciom ~ areaconst + estrato + parqueaderos + banios + habitaciones, data = apartamentos3)
summary(modelo1)
##
## Call:
## lm(formula = preciom ~ areaconst + estrato + parqueaderos + banios +
## habitaciones, data = apartamentos3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1765.21 -50.53 1.48 44.20 1021.66
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -244.0901 13.0224 -18.74 <2e-16 ***
## areaconst 2.0862 0.0437 47.74 <2e-16 ***
## estrato 50.9610 2.5309 20.14 <2e-16 ***
## parqueaderos 93.0540 3.7862 24.58 <2e-16 ***
## banios 49.1179 3.0371 16.17 <2e-16 ***
## habitaciones -43.7476 3.3706 -12.98 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 129.5 on 5068 degrees of freedom
## Multiple R-squared: 0.7999, Adjusted R-squared: 0.7997
## F-statistic: 4052 on 5 and 5068 DF, p-value: < 2.2e-16
summary_modelo <- summary(modelo1)
r_squared <- summary_modelo$r.squared
cat("coeficiente R2", r_squared, "\n")
## coeficiente R2 0.7999129
Se puede observar diferentes aspectos a analizar de los resultados:
El intercepto del modelo es -244.09, lo que representa el valor del precio cuando todas las otras variables son cero. Aunque en la práctica un área construida de cero no es realista, este valor sirve como referencia en la combinación de las variables.
Para el área construida, el modelo indica que por cada unidad adicional, el precio aumenta en promedio 2.09 unidades monetarias, lo cual es lógico dado que a mayor área, mayor es el costo de la propiedad. De manera similar, el estrato muestra que un incremento en su nivel eleva el precio en promedio 50.96 unidades monetarias.
Además, el modelo revela que cada parqueadero adicional aumenta el precio en promedio 93.05 unidades monetarias, mientras que cada baño adicional incrementa el precio en promedio 49.12 unidades monetarias. Sin embargo, el número de habitaciones tiene un efecto contrario: por cada habitación adicional, el precio disminuye en promedio 43.75 unidades monetarias. Este resultado puede parecer sorprendente, pero puede explicarse por las preferencias de los compradores, quienes podrían valorar menos apartamentos con muchas habitaciones, especialmente en mercados donde las familias pequeñas y solteros son más comunes.
Todos los coeficientes de las variables tienen un valor p menor a 2e-16, indicando que son estadísticamente significativos, incluyendo el coeficiente negativo para el número de habitaciones, lo que sugiere que el efecto observado es confiable.
El coeficiente de determinación (R²) de 0.7999 indica que el modelo explica aproximadamente el 80% de la variabilidad en el precio de los apartamentos. Aunque el modelo captura bien las relaciones entre las variables y el precio, el 20% restante no está explicado, lo que sugiere que hay otros factores a considerar.
Para mejorar el modelo, se podrían incluir variables adicionales como la ubicación exacta, la antigüedad del inmueble y un índice de seguridad del sector. También sería beneficioso explorar interacciones entre variables, realizar validación cruzada para evitar sobreajuste y considerar transformaciones de variables para optimizar el modelo y mejorar la precisión de las predicciones.
A modo de ejercicio y teniendo en cuenta el comportamiento de la variable “habitaciones” se quitara del modelo, para ver el comportamiento de este.
# Ajustar el modelo sin la variable de habitaciones
modelo_sin_habitaciones <- lm(preciom ~ areaconst + estrato + parqueaderos + banios, data = apartamentos3)
# Ver resumen del nuevo modelo
summary(modelo_sin_habitaciones)
##
## Call:
## lm(formula = preciom ~ areaconst + estrato + parqueaderos + banios,
## data = apartamentos3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1691.13 -52.98 2.98 43.44 1059.00
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -362.85736 9.41729 -38.53 <2e-16 ***
## areaconst 2.00058 0.04391 45.56 <2e-16 ***
## estrato 57.85649 2.51500 23.00 <2e-16 ***
## parqueaderos 95.30850 3.84414 24.79 <2e-16 ***
## banios 34.61852 2.87042 12.06 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 131.7 on 5069 degrees of freedom
## Multiple R-squared: 0.7933, Adjusted R-squared: 0.7931
## F-statistic: 4862 on 4 and 5069 DF, p-value: < 2.2e-16
Los coeficientes de las variables restantes, como el número de parqueaderos y el número de baños, sufren ajustes tras eliminar la variable de habitaciones. Por ejemplo, el coeficiente para el número de parqueaderos aumenta de 93.05 a 95.31 unidades monetarias, mientras que el coeficiente para el número de baños disminuye de 49.12 a 34.62 unidades monetarias. Esto indica que parte de la variabilidad en el precio que se atribuía a estas variables estaba parcialmente explicada por el número de habitaciones.
El coeficiente de determinación (R²) disminuye de 0.7999 a 0.7933 al eliminar la variable de habitaciones, lo que significa que el modelo explica un poco menos de la variabilidad en el precio. Además, el error estándar residual aumenta de 129.5 a 131.7, lo que refleja una menor precisión en las predicciones del modelo.
La eliminación de la variable de habitaciones afecta la interpretación de los demás coeficientes y reduce la capacidad explicativa del modelo. Aunque el efecto negativo de la variable de habitaciones era contraintuitivo, su inclusión era importante para captar las preferencias de los compradores. Sin ella, el modelo puede no reflejar completamente las dinámicas del mercado.
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).
Graficos
library(lmtest)
par(mfrow=c(2,2))
plot(modelo1)
residuales <- residuals(modelo1)
media_residuales <- mean(residuales)
sd_residuales <- sd(residuales)
residuales_estandarizados <- (residuales - media_residuales) / sd_residuales
ks.test(residuales_estandarizados, "pnorm", mean = 0, sd = 1)
##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: residuales_estandarizados
## D = 0.15021, p-value < 2.2e-16
## alternative hypothesis: two-sided
Despues de estandarizar los residuales, se realizo el test de Kolmogorov-Smirnov y se obtuvo el estadistico D el cual indica la maxima diferencia entre la funcion de distribucion empirica de los residuales estandarizados y la distribucion normal teorica, el cual es de 0.15, un valor de este coeficiente esta relacionado con una mayor discrepancia entre la distribucion empirica y la normal. En cuanto al valor p, este es muy pequeno y la grafica Q-Q, muestra que los residuales no siguen una distribucion normal.
# Aplica el test de Breusch-Pagan para la homocedasticidad
bptest(modelo1)
##
## studentized Breusch-Pagan test
##
## data: modelo1
## BP = 1353.7, df = 5, p-value < 2.2e-16
Se puede observar en el gráfico Residuals vs Fitted que los puntos no están distribuidos de manera que no se evidencie un patrón. Además, el test de Breusch-Pagan también confirma que el supuesto de homocedasticidad no se cumple
# Aplica el test de Durbin-Watson para la autocorrelación
dwtest(modelo1)
##
## Durbin-Watson test
##
## data: modelo1
## DW = 1.64, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is greater than 0
De acuerdo con el gráfico Scale-Location observado y la prueba de Durbin-Watson, se puede afirmar que no existe independencia entre los errores. Por lo tanto, este supuesto no se cumple.
Se podrían considerar varias estrategias para tratar de mejorar los supuestos. Para la normalidad de los residuales, se pueden aplicar transformaciones a la variable respuesta, como transformaciones Lin-Log, Log-Log o Box-Cox, que podrían ayudar a estabilizar la distribución. En cuanto a la homocedasticidad, se podría utilizar un modelo de regresión robusto a la heterocedasticidad o aplicar transformaciones a las variables para estabilizar la varianza. Para tratar la autocorrelación, explorar modelos de errores autorregresivos podría ser útil para capturar la estructura de dependencia en los residuos.
Realice una partición en los datos de forma aleatoria donde 70% sea un set para entrenar el modelo y 30% para prueba. Estime el modelo con la muestra del 70%. Muestre los resultados.
library(caret)
set.seed(123)
indices <- createDataPartition(apartamentos3$preciom, p = 0.7, list = FALSE)
datos_entrenamiento <- apartamentos3[indices, ]
datos_prueba <- apartamentos3[-indices, ]
modelo <- lm(formula = preciom ~ areaconst + estrato + parqueaderos + banios + habitaciones, data = datos_entrenamiento)
summary(modelo)
##
## Call:
## lm(formula = preciom ~ areaconst + estrato + parqueaderos + banios +
## habitaciones, data = datos_entrenamiento)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1663.61 -51.73 2.85 45.80 1039.69
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -249.04971 15.77239 -15.79 <2e-16 ***
## areaconst 1.96736 0.05129 38.36 <2e-16 ***
## estrato 52.21694 3.04666 17.14 <2e-16 ***
## parqueaderos 101.21674 4.55041 22.24 <2e-16 ***
## banios 49.43151 3.65371 13.53 <2e-16 ***
## habitaciones -44.17191 4.08168 -10.82 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 132.3 on 3547 degrees of freedom
## Multiple R-squared: 0.7932, Adjusted R-squared: 0.793
## F-statistic: 2722 on 5 and 3547 DF, p-value: < 2.2e-16
Realice predicciones con el modelo anterior usando los datos de prueba (30%).
A continuación, se muestran los primeros 20 resultados de las predicciones:
predicciones <- predict(modelo, newdata = datos_prueba)
resultados <- data.frame(Real = datos_prueba$preciom, Prediccion = predicciones)
head(resultados,n = 20L)
## Real Prediccion
## 1 240 300.19119
## 2 220 230.90174
## 3 385 383.45425
## 4 100 66.30637
## 5 170 184.51179
## 6 130 45.74283
## 7 92 132.11928
## 8 225 207.47767
## 9 370 312.25478
## 10 150 207.47767
## 11 149 193.53055
## 12 147 145.42391
## 13 420 335.60375
## 14 330 246.82495
## 15 185 141.48919
## 16 150 143.45655
## 17 620 1136.10144
## 18 450 413.39642
## 19 143 92.05767
## 20 285 266.49859
Calcule el error cuadrático medio, el error absoluto medio y el R2, interprete.
library(Metrics)
# Valores reales
valores_reales <- datos_prueba$preciom
# Error cuadrático medio (RMSE)
rmse <- rmse(valores_reales, predicciones)
# Error absoluto medio (MAE)
mae <- mae(valores_reales, predicciones)
# Coeficiente de determinación (R²)
r2 <- cor(valores_reales, predicciones)^2
# Imprimir resultados
cat("RMSE:", rmse, "\n")
## RMSE: 123.2382
cat("MAE:", mae, "\n")
## MAE: 76.91612
cat("R²:", r2, "\n")
## R²: 0.8150404
Se puede observar que el Error Cuadrático Medio (RMSE) indica que, en promedio, las predicciones hechas por el modelo se desvían de los valores reales en aproximadamente 123.24 millones de pesos. En cuanto al Error Absoluto Medio (MAE), muestra que en promedio las predicciones del modelo se desvían de los valores reales en aproximadamente 76.92 millones de pesos. En ambos casos, la desviación respecto a los valores reales es considerablemente alta, lo que sugiere que el modelo tiene margen para mejorar.
El coeficiente de determinación (R²) de aproximadamente 0.82 indica que el modelo explica alrededor del 82% de la variabilidad en los datos de respuesta. Este valor sugiere que el modelo tiene una buena capacidad para capturar la relación entre las variables independientes y la variable dependiente. Sin embargo, el 18% de la variabilidad no explicada podría deberse a factores externos no incluidos en el modelo o al ruido inherente en los datos. Aunque un R² de 0.82 es generalmente considerado sólido, se sugiere seguir refinando el modelo para aumentar su capacidad predictiva y ajustar cualquier aspecto que pueda mejorar el ajuste del modelo.