Caso C&A, Asesoria para compra de inmueble.
Para poder realizar un análisis congruente de las solicitudes de ofertas realizadas a la compañía, es importante primero tener un buen manejo de la base de datos que se empleara. Para esto se eliminarán aquellos registros que no cuentan con identificador, y se revisaran las respuestas en la pregunta de parqueaderos, baños y habitaciones disponibles en el inmueble.
#install.packages("devtools")
#install.packages("mapview")
#devtools::install_github("dgonxalex80/paqueteMOD", force =TRUE)
#install.packages("tidyverse")
#install.packages("knitr")
library(paqueteMOD)
library(leaflet)
library(htmlwidgets)
library(knitr)
library(dplyr)
library(kableExtra)
library(tidyverse)
data("vivienda")
vivienda <- vivienda[!is.na(vivienda$id),]
vivienda<-vivienda[vivienda$banios!=0 & vivienda$habitaciones!=0, ]
vivienda$parqueaderos<-replace(vivienda$parqueaderos,vivienda$parqueaderos=="NA",0)
vivienda$parqueaderos<-as.numeric(vivienda$parqueaderos)
vivienda$estrato <- as.numeric(levels(vivienda$estrato))[vivienda$estrato]
longitud<-vivienda$longitud
re <- '(\\d{2})(\\d{2})'
longitud <- gsub(re, '\\1.\\2', longitud)
latitud<-vivienda$latitud
re <- '(\\d{1,1})(\\d{1,4})'
latitud <- gsub(re, '\\1.\\2', latitud)
vivienda$latitud <- as.double(latitud)
vivienda$longitud <- as.double(longitud)
kable(head(vivienda, 6), fontsize = 4) %>%
kable_styling(font_size = 14)| id | zona | piso | estrato | preciom | areaconst | parqueaderos | banios | habitaciones | tipo | barrio | longitud | latitud |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1147 | Zona Oriente | NA | 3 | 250 | 70 | 1 | 3 | 6 | Casa | 20 de julio | -76.51168 | 3.43382 |
| 1169 | Zona Oriente | NA | 3 | 320 | 120 | 1 | 2 | 3 | Casa | 20 de julio | -76.51237 | 3.43369 |
| 1350 | Zona Oriente | NA | 3 | 350 | 220 | 2 | 2 | 4 | Casa | 20 de julio | -76.51537 | 3.43566 |
| 5992 | Zona Sur | 02 | 4 | 400 | 280 | 3 | 5 | 3 | Casa | 3 de julio | -76.54000 | 3.43500 |
| 1212 | Zona Norte | 01 | 5 | 260 | 90 | 1 | 2 | 3 | Apartamento | acopi | -76.51350 | 3.45891 |
| 1724 | Zona Norte | 01 | 5 | 240 | 87 | 1 | 3 | 3 | Apartamento | acopi | -76.51700 | 3.36971 |
Posteriormente para poder revisar ambas solicitudes se crearan bases de datos con el tipo de inmueble y zona específica.
library(kableExtra)
#Punto 1
#Casas de la zona norte de la ciudad.
base1 <- subset(vivienda, tipo == "Casa" & zona == "Zona Norte")
base2 <- subset(vivienda, tipo == "Apartamento" & zona == "Zona Sur")
table1 <- table(base1$zona, base1$tipo)
table2 <- table(base2$zona, base2$tipo)
table1_2 <- cbind(table1, table2)
kable(table1_2, caption = "Solicitudes") %>%
add_header_above(c("Zonas"=1,"Casas Zona Norte(Solicitud 1)" = 2, "Aptos Zona Sur(Solicitud 2)"=2))| Apartamento | Casa | Apartamento | Casa | |
|---|---|---|---|---|
| Zona Centro | 0 | 0 | 0 | 0 |
| Zona Norte | 0 | 700 | 0 | 0 |
| Zona Oeste | 0 | 0 | 0 | 0 |
| Zona Oriente | 0 | 0 | 0 | 0 |
| Zona Sur | 0 | 0 | 2777 | 0 |
map <- leaflet(data = base1) %>%
addTiles() %>%
addCircleMarkers(lng = ~longitud, lat = ~latitud, radius = 0.01,
color = "purple", fillColor = "purple", fillOpacity = 0.7,
popup = paste("<b>ID:</b>", base1$id,
"<br><b>Latitude:</b>", base1$latitud,
"<br><b>Longitude:</b>", base1$longitud,
"<br><b>Tipo:</b>", base1$tipo,
"<br><b>Zona:</b>", base1$zona)) %>%
# Agrega los círculos marcadores de las ubicaciones en base2 en otro color
addCircleMarkers(data = base2, lng = ~longitud, lat = ~latitud, radius = 0.01,
color = "pink", fillColor = "pink", fillOpacity = 0.7,
popup = paste("<b>ID:</b>", base2$id,
"<br><b>Latitude:</b>", base2$latitud,
"<br><b>Longitude:</b>", base2$longitud,
"<br><b>Tipo:</b>", base2$tipo,
"<br><b>Zona:</b>", base2$zona)) %>%
setView(lng = -76.5, lat = 3.44, zoom = 11)
# Visualiza el mapa
mapAnálisis exploratorio
Para poder ofrecer una asesoría correcta es importante realizar un análisis exploratorio de los datos. Para esto se mirarán las distribuciones de las variables, asi como sus correlaciones con la variable de precios.
En cuanto a las correlaciones entre las variables explicativas y el precio de las viviendas, se encuentran que la correlación entre el precio del inmueble y el estrato, es mayor para apartamentos de la zona sur la de ciudad que para casas en la zona norte, fenómeno que también se puede apreciar con el número de baños; Por el contrario en las Casas de la zona norte de la ciudad se puede ver una mayor correlación entre el precio y el área construida (aunque la correlación sigue siendo baja), y el precio con el número de habitaciones disponibles.
Por su lado cuando vemos las distribuciones de las variables una característica a resaltar, tanto para la solicitud 1 como para la solicitud 2, es que las variables no tienen un comportamiento normal. En términos del precio y el área construido se pueden apreciar importantes colas derechas, que se acentúan aún más en la segunda solicitud. Cuando analizamos el número de años, habitaciones y el estrato donde se encuentra ubicado el inmueble, se puede apreciar de que las casas de la zona norte poseen un mayor número de habitaciones y baños que los apartamentos de la zona sur, sin embargo, estas variable no presentan un comportamiento normal, y se ven colas derechas en sus distribuciones. Podemos concluir que tanto para la solicitud 1 como para la solicitud 2 las variables no presentan comportamientos normales, característica que se acentúa más en los apartamentos de la zona sur de la ciudad.
library(plotly)
if(!require("reshape2")) install.packages("reshape2")
library(reshape2)
library(knitr)
library(dplyr)
if(!require(broom)) {
install.packages("broom")
library(broom)
}
library(htmltools)
library(ggplot2)
library(ggpubr)
base1_<- base1[,c("preciom","areaconst","banios","habitaciones","estrato")]
corrdata1<-cor(base1_)
corrdata1[upper.tri(corrdata1, diag = TRUE)] <- NA
corrdata1 <- corrdata1[-1, -ncol(corrdata1)]
x_labels <- colnames(corrdata1)
y_labels <- rownames(corrdata1)
colnames(corrdata1) <- 1:ncol(corrdata1)
rownames(corrdata1) <- nrow(corrdata1):1
plotdata <- melt(corrdata1)
plotdata$size <- (abs(plotdata$value))
scaling <- 500 / ncol(corrdata1) / 2
plotdata$size <- plotdata$size * scaling
xrange <- c(0.5, length(x_labels)+0.5)
yrange <- c(0.5, length(y_labels)+0.5)
x_grid <- seq(1.5, length(x_labels)-0.5, 1)
y_grid <- seq(1.5, length(y_labels)-0.5, 1)
xAx1 <- list(showgrid = FALSE,
showline = FALSE,
zeroline = FALSE,
tickvals = colnames(corrdata1),
ticktext = x_labels,
title = "",
range = xrange,
rangemode = "tozero")
xAx2 <- list(showgrid = TRUE,
showline = FALSE,
zeroline = FALSE,
overlaying = "x",
showticklabels = FALSE,
range = xrange,
tickvals = x_grid)
yAx1 <- list(autoaxis = FALSE,
showgrid = FALSE,
showline = FALSE,
zeroline = FALSE,
tickvals = rownames(corrdata1),
ticktext = y_labels,
title = FALSE,
rangemode = "tozero",
range = yrange)
yAx2 <- list(showgrid = TRUE,
showline = FALSE,
zeroline = FALSE,
overlaying = "y",
showticklabels = FALSE,
range = yrange,
tickvals = y_grid)
fig <- plot_ly(data = plotdata, width = 500, height = 500)
fig <- fig %>% add_trace(x = ~Var2, y = ~Var1, type = "scatter", mode = "markers",
color = ~value,
marker = list(size = ~size, opacity = 1),
symbol = I("square"),
text = ~value,
hovertemplate = "%{text:.2f} <extra></extra>",
xaxis = "x1",
yaxis = "y1")
fig <- fig %>% add_trace(x = ~Var2, y = ~Var1, type = "scatter", mode = "markers",
opacity = 0,
showlegend = FALSE,
xaxis = "x2",
yaxis = "y2",
hoverinfo = "none")
fig <- fig %>% layout(xaxis = xAx1,
yaxis = yAx1,
xaxis2 = xAx2,
yaxis2 = yAx2,
plot_bgcolor = "rgba(0,0,0,0)",
paper_bgcolor = "rgba(0, 0, 0, 0.03)",
title = "Matriz de correlación, Solicitud 1")
base2_<- base2[,c("preciom","areaconst","banios","habitaciones","estrato")]
corrdata1<-cor(base2_)
corrdata1[upper.tri(corrdata1, diag = TRUE)] <- NA
corrdata1 <- corrdata1[-1, -ncol(corrdata1)]
x_labels <- colnames(corrdata1)
y_labels <- rownames(corrdata1)
colnames(corrdata1) <- 1:ncol(corrdata1)
rownames(corrdata1) <- nrow(corrdata1):1
plotdata <- melt(corrdata1)
plotdata$size <- (abs(plotdata$value))
scaling <- 500 / ncol(corrdata1) / 2
plotdata$size <- plotdata$size * scaling
xrange <- c(0.5, length(x_labels)+0.5)
yrange <- c(0.5, length(y_labels)+0.5)
x_grid <- seq(1.5, length(x_labels)-0.5, 1)
y_grid <- seq(1.5, length(y_labels)-0.5, 1)
xAx1 <- list(showgrid = FALSE,
showline = FALSE,
zeroline = FALSE,
tickvals = colnames(corrdata1),
ticktext = x_labels,
title = "",
range = xrange,
rangemode = "tozero")
xAx2 <- list(showgrid = TRUE,
showline = FALSE,
zeroline = FALSE,
overlaying = "x",
showticklabels = FALSE,
range = xrange,
tickvals = x_grid)
yAx1 <- list(autoaxis = FALSE,
showgrid = FALSE,
showline = FALSE,
zeroline = FALSE,
tickvals = rownames(corrdata1),
ticktext = y_labels,
title = FALSE,
rangemode = "tozero",
range = yrange)
yAx2 <- list(showgrid = TRUE,
showline = FALSE,
zeroline = FALSE,
overlaying = "y",
showticklabels = FALSE,
range = yrange,
tickvals = y_grid)
fig2 <- plot_ly(data = plotdata, width = 500, height = 500)
fig2 <- fig2 %>% add_trace(x = ~Var2, y = ~Var1, type = "scatter", mode = "markers",
color = ~value,
marker = list(size = ~size, opacity = 1),
symbol = I("square"),
text = ~value,
hovertemplate = "%{text:.2f} <extra></extra>",
xaxis = "x1",
yaxis = "y1")
fig2 <- fig2 %>% add_trace(x = ~Var2, y = ~Var1, type = "scatter", mode = "markers",
opacity = 0,
showlegend = FALSE,
xaxis = "x2",
yaxis = "y2",
hoverinfo = "none")
fig2 <- fig2 %>% layout(xaxis = xAx1,
yaxis = yAx1,
xaxis2 = xAx2,
yaxis2 = yAx2,
plot_bgcolor = "rgba(0,0,0,0)",
paper_bgcolor = "rgba(0, 0, 0, 0.03)",
title = "Matriz de correlación, Solicitud 2")
tagList(div(style = 'display:inline-block; width:49%; padding-right: 20px;', fig),
div(style = 'display:inline-block; width:49%;', fig2),
tags$style(type="text/css", ".center-div { margin: 0 auto; width:80% }"))base1_dis1<- base1[,c("id","banios","habitaciones","estrato")]
data_long1 <- melt(base1_dis1, id = "id")
cols <- c("violetred", "violet","thistle1","purple","pink")
g1<-ggplot(data_long1, aes(x = value, colour = variable, fill = variable)) +
geom_density(alpha = 0.7,color="gray8") +
scale_fill_manual(values = cols)+theme(legend.position="bottom",text = element_text(size = 10))
g2<-ggplot(base1, aes(x = preciom)) +
geom_density(color = "gray8", fill = "purple", alpha = 0.5, linewidth = 0.5)
g3<-ggplot(base1, aes(x = areaconst)) +
geom_density(color = "gray8", fill = "pink", alpha = 0.5, linewidth = 0.5)
ggarrange(g1, g2, g3, ncol = 1, common.legend = TRUE, legend = "bottom") +
ggtitle("Densidades solicitud 1")
base2_dis2<- base2[,c("id","banios","habitaciones","estrato")]
data_long2 <- melt(base2_dis2, id = "id")
cols <- c("violetred", "violet","thistle1","purple","pink")
g4<-ggplot(data_long2, aes(x = value, colour = variable, fill = variable)) +
geom_density(alpha = 0.7,color="gray8") +
scale_fill_manual(values = cols)+theme(legend.position="bottom",text = element_text(size = 10))
g5<-ggplot(base2, aes(x = preciom)) +
geom_density(color = "gray8", fill = "purple", alpha = 0.5, linewidth = 0.5)
g6<-ggplot(base2, aes(x = areaconst)) +
geom_density(color = "gray8", fill = "pink", alpha = 0.5, linewidth = 0.5)
ggarrange(g4, g5, g6, ncol = 1, common.legend = TRUE, legend = "bottom") +
ggtitle("Densidades solicitud 2")
Estimación del modelo
Se estimará una regresión lineal sin interacciones entre las variables independientes, dado que no existe un argumento analítico que justifique este hecho. Se podría pensar en omitir la variable de área construida dado que el análisis de correlación para ambas solicitudes fue bajo, pero inicialmente se tomarán todas.
Se puede observar que todas las variables tienen un amplio grado explicativo en ambas solicitudes (en la solicitud 2 el área del apto no es significativa, cuestión que es coherente con al análisis preliminar). y se cuenta con que el modelo tiene un buen grado explicativo, más el de la segunda solicitud, pero ambos tienen un buen comportamiento. En la solicitud 1, la variable que genera incrementos más importantes en el precio de la vivienda es el estrato, mientras que, en la segunda solicitud, es el número de baños. Un resultado contraintuitivo que se tiene en la regresión de la solicitud dos, es que al incrementarse el número de habitaciones se disminuye el precio de la vivienda. este efecto es bueno revisarlo con modelos con diferentes especificaciones para ver si se mantiene el signo del parámetro.
Si uno quisiera plantearse otra clase de modelos lo primero es primero revisar si se cumplen o no los supuestos de los errores, porque si estos no se cumplen los diferentes estadísticos pueden no ser válidos.
library("stargazer")
#install.packages("glmtoolbox")
library(glmtoolbox)
library(kableExtra)
model1 <- lm(preciom ~ areaconst + estrato + habitaciones+parqueaderos+banios, data = base1)
model2 <- lm(preciom ~ areaconst + estrato + habitaciones+parqueaderos+banios, data = base2)
stargazer(model1, model2, type = 'html', column.labels = c("Solicitud 1", "Solicitud 2"))| Dependent variable: | ||
| preciom | ||
| Solicitud 1 | Solicitud 2 | |
| (1) | (2) | |
| areaconst | 0.066*** | -0.002 |
| (0.016) | (0.001) | |
| estrato | 108.032*** | 66.952*** |
| (11.064) | (3.433) | |
| habitaciones | 22.528*** | -12.176*** |
| (6.530) | (4.445) | |
| parqueaderos | 32.118*** | 104.231*** |
| (6.733) | (4.473) | |
| banios | 36.184*** | 80.065*** |
| (8.883) | (3.602) | |
| Constant | -341.621*** | -316.909*** |
| (50.781) | (17.544) | |
| Observations | 431 | 2,375 |
| R2 | 0.476 | 0.687 |
| Adjusted R2 | 0.470 | 0.687 |
| Residual Std. Error | 177.880 (df = 425) | 109.103 (df = 2369) |
| F Statistic | 77.282*** (df = 5; 425) | 1,041.850*** (df = 5; 2369) |
| Note: | p<0.1; p<0.05; p<0.01 | |
Validacion de los supuestos: Existen 4 principales:
\(*\) Normalidad de los errores
\(*\) Homocedasticidad de los errores
\(*\) Ausencia de autocorrelación de los errores
\(*\) Media cero de los errores.
Para poder validad la normalidad de los errores podemos hacer uso de dos herramientas, la primera es realizar graficas qq de normalidad y lo segundo es apoyarnos con test estadísticos, como Shapiro wilk y Anderson-Darling. Con los test (se tiene un valor p menor a 0.05, por lo cual se rechaza la hipótesis nula de normalidad) y con los gráficos de normalidad podemos decir que no existe evidencia a favor de la normalidad de los residuos de la regresión, por lo cual se estaría violando este supuesto. Este problema estaria presente en ambas solicitudes.
Otro supuesto escencial del modelo es que los resisuales son \(iid\), es decir independiente e indeticamente distribuidos, esto quiere decir que no debe existir autocorrelacion de los errores y estos deben ser homocedasticos.
Para validad el supuesto de homocedasticidad, el cual consiste en que la varianza de los errores sea contante, realizaremos pruebas estadísticas, como Breusch-Pagan, el test de White y el de Goldfeld-Quandt y las compararemos con los gráficos de Scale-Location, y Residuals vs fitted. Con los resultados reportados en las gráficas y en los test estadísticos, se puede decir que existe evidencia a favor de heterocedasticidad presente en la regresión, dado que los valores p en la mayoria de las pruebas son menores al valor de significancia típico de 0.05, por tanto se rechaza la hipótesis nula de homocedasticidad. En términos gráficos se puede ver que los errores siguen una pendiente (de forma cuadratica) y no cuentan con un comportamiento de nube tipico de errores homocedasticos. Con esto se estaría violando uno de los supuestos necesarios y por lo tanto la estimación por MCO no sería eficiente, ya que la varianza no es óptima, y en este caso los estadístico t y f no se podría usar tal y como están.
En cuanto a la no autocorrelación de los errores, la violacion de este supuesto se da principalmente en muestras de serie de tiempo y no corte transversal, dado que no es posible tener autocorrelacion seriales en los errores si las observaciones se realizan todas en el mismo momento. Por lo tanto se asume que este supuesto se cumple y los errores no estarian correlacionados.
Y finalmente la media cero de los errores hace referencia a la especificación correcta del modelo, si por ejemplo estamos ante un caso de variables con tendencia temporal(sin transformar), es de esperarse que el termino error contenga el comportamiento de esta variable o el comportamiento de la correcta especificacion y genere un efecto constante en los residuales. Esto se puede validar con la grafica Residuals vs fitted, y sacando la esperanza matemática de los errores. Sin embargo en este problema, dado que estamos mirando un corte transversal, con variables sin dependencia temporal, podemos ver que la media de los errores parece ser cero, y al usar un test estdistico, T-test, corroboramos que efectivamente este afirmacion
Para poder corregir las diversas violaciones a los supuestos (normalidad, y homocedasticidad), se podrían realizar diversas transformaciones, dado que realizar predicciones con el modelo son estas características puede ser poco eficiente.
Finalmente es importante realizar un análisis de colinealidad entre las variables del modelo. Ante esta no se presencia un multicolinealidad alarmante en el modelo.
#install.packages('nortest')
library(olsrr)
library(lmtest)
library(skedastic)
library(kableExtra)
library(nortest)
par(mfrow=c(2,2))
plot(model1)
X=ols_test_normality(model1)
G=matrix(c(matrix(c(round(X$shapiro$p.value,3),round(ad.test(model1$residuals)$p.value,3),'','', '','' ), ncol=1), matrix(c('','',round(bptest(model1)$p.value,3),round(white_lm(model1)$p.value,3),round(gqtest(model1)$p.value,3),''), ncol=1),
matrix(c('','','','','',round(t.test(model1$residuals)$p.value,3)), ncol=1)), ncol=3)
colnames(G)<- c("Normalidad","Homocedasticidad","Media cero")
rownames(G)<- c("Shapiro","Anderson","Breusch-Pagan","White", "Goldfeld-Quandt",'T-test')
G %>%
kbl(booktabs = T,) %>%
kable_classic_2(full_width = F)| Normalidad | Homocedasticidad | Media cero | |
|---|---|---|---|
| Shapiro | 0 | ||
| Anderson | 0 | ||
| Breusch-Pagan | 0 | ||
| White | 0 | ||
| Goldfeld-Quandt | 0 | ||
| T-test | 1 |
par(mfrow=c(2,2))
plot(model2)
X=ols_test_normality(model2)
H=matrix(c(matrix(c(round(X$shapiro$p.value,3),round(ad.test(model2$residuals)$p.value,3),'','', '','' ), ncol=1), matrix(c('','',round(bptest(model2)$p.value,3),round(white_lm(model2)$p.value,3),round(gqtest(model2)$p.value,3),''), ncol=1),
matrix(c('','','','','',round(t.test(model2$residuals)$p.value,3)), ncol=1)), ncol=3)
colnames(H)<- c("Normalidad","Homocedasticidad","Media cero")
rownames(H)<- c("Shapiro","Anderson","Breusch-Pagan","White", "Goldfeld-Quandt",'T-test')
H %>%
kbl(booktabs = T,) %>%
kable_classic_2(full_width = F)| Normalidad | Homocedasticidad | Media cero | |
|---|---|---|---|
| Shapiro | 0 | ||
| Anderson | 0 | ||
| Breusch-Pagan | 0 | ||
| White | 0 | ||
| Goldfeld-Quandt | 0.825 | ||
| T-test | 1 |
require(car)
library(kableExtra)
vif1_2 <- cbind(vif(model1), vif(model2))
kable(vif1_2, caption = "VIF") %>%
add_header_above(c("Variables"=1,"Casas Zona Norte(Solicitud 1)" , "Aptos Zona Sur(Solicitud 2)"))| areaconst | 1.028115 | 1.014404 |
| estrato | 1.248681 | 1.541249 |
| habitaciones | 1.642064 | 1.414044 |
| parqueaderos | 1.220580 | 1.665660 |
| banios | 2.017409 | 2.277842 |
Predicción del precio vivienda
Se realizara un predicción de los precios de los inmuebles para ambas solicitudes.
requerimientos_1 = data.frame(
estrato=c(4,5),
areaconst=c(200,200),
parqueaderos=c(1,1),
banios=c(2,2),
habitaciones=c(4,4)
)
requerimientos_2 = data.frame(
estrato=c(5,6),
areaconst=c(300,300),
parqueaderos=c(3,3),
banios=c(3,3),
habitaciones=c(5,5)
)
pred1_2 <- cbind(predict(model1,requerimientos_1), predict(model2,requerimientos_2))
kable(pred1_2, caption = "Predicciones de los modelos") %>%
add_header_above(c("Casas Zona Norte(Solicitud 1)" , "Aptos Zona Sur(Solicitud 2)"))| 298.2315 | 509.2521 |
| 406.2630 | 576.2045 |
Potenciales ofertas
A continuación, se muestran las posibles ofertas que coinciden con las características solicitadas y en el mapa la ubicación de estas.
En cuanto a la primera solicitud, de una Casa en la Zona norte de la ciudad que cuente con las siguientes características:
\(*\) Área construida: 200 \(m^2\)
\(*\) Parqueaderos: 1
\(*\) Baños: 2
\(*\) Habitaciones: 4
\(*\) Estrato: 4 o 5
\(*\) Crédito preaprobado: 350 millones
No se tiene ninguna oferta exactamente con esas características, pero si ponemos las exigencias del cliente como un límite inferior, y la restricción presupuestaria vinculante, nos encontramos con 9 posibles ofertas. Como se muestra en la tabla y se evidencia con lo puntos violetas en el mapa. La mayoría de estas ofertas disponibles cuentan con un número superior de parqueaderos o baños, lo cual puede ser llamativo para el cliente si están contemplados en su presupuesto. En comparación con el precio pronosticado, vemos que para las viviendas del estrato cuatro, el modelo subestimo el precio, y para las del estrato 5 lo sobre estimo, dado que con las características propuestas se encontraron gran número de inmuebles por debajo del precio pronosticado.
En cuanto a la segunda solicitud, de un Apartamento en la Zona sur de la ciudad que cuente con las siguientes características:
\(*\) Área construida: 300 \(m^2\)
\(*\) Parqueaderos: 3
\(*\) Baños: 3
\(*\) Habitaciones: 5
\(*\) Estrato: 5 o 6
\(*\) Crédito preaprobado: 850 millones
No se tiene ninguna oferta exactamente con esas características, pero si ponemos las exigencias del cliente como un aproximado, y la restricción presupuestaria vinculante, nos encontramos con 2 posibles ofertas. Como se muestra en la tabla y se evidencia con lo puntos rosas en el mapa. Ambas ofertas son en estrato 5 y cuentan con un mayor número de baños que el requerido por el cliente, una de ellas posee solo 2 parqueaderos, lo cual si poseen un mayor número de vehículos seria problemático. Si nos enfocamos en aquella que tiene los requisitos mínimos del cliente, podemos ver es un apto de 6 habitaciones y 5 baños por un valor de 670 millones, lo cual estaría dentro de la restricción presupuestaria. Si comparamos estos valores con los pronosticados por el modelo vemos que tanto para estrato 5 como 6 el modelo subestimo los precios.
Este tipo de errores de pronóstico se pueden deber a una mala estimación de las elasticidades del modelo, lo cual se puede corregir mediante la postulación de otro modelo que cumpla los supuestos de los errores y analizar el pronóstico dentro de muestra de una serie de modelos teóricamente correctos, para elegir aquel que minimice estos errores.
library(dplyr)
pot1<-filter(base1, areaconst>=200 & areaconst<=220 & estrato==4 & habitaciones>=4 & banios>=2 & parqueaderos>=1 & preciom<=350)
pot1_2<-filter(base1,areaconst>=200 & areaconst<=220 & estrato==5 & habitaciones>=4 & banios>=2 & parqueaderos>=1 & preciom<=350)
pot_ofertas<-rbind(pot1,pot1_2)
kable(pot_ofertas, fontsize = 4) %>%
kable_styling(font_size = 14)| id | zona | piso | estrato | preciom | areaconst | parqueaderos | banios | habitaciones | tipo | barrio | longitud | latitud |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1144 | Zona Norte | NA | 4 | 320 | 200 | 2 | 4 | 4 | Casa | la merced | -76.51156 | 3.48029 |
| 4210 | Zona Norte | 01 | 5 | 350 | 200 | 3 | 3 | 4 | Casa | el bosque | -76.53010 | 3.48503 |
| 4267 | Zona Norte | 01 | 5 | 335 | 202 | 1 | 4 | 5 | Casa | el bosque | -76.53044 | 3.48399 |
| 1270 | Zona Norte | NA | 5 | 350 | 203 | 2 | 2 | 5 | Casa | el bosque | -76.51448 | 3.48531 |
| 1343 | Zona Norte | 02 | 5 | 320 | 200 | 2 | 4 | 4 | Casa | la flora | -76.51524 | 3.48893 |
| 1163 | Zona Norte | NA | 5 | 350 | 216 | 2 | 2 | 4 | Casa | la merced | -76.51218 | 3.48181 |
| 1151 | Zona Norte | NA | 5 | 320 | 210 | 2 | 3 | 5 | Casa | urbanización la merced | -76.51200 | 3.47600 |
| 1887 | Zona Norte | 01 | 5 | 340 | 203 | 2 | 3 | 4 | Casa | vipasa | -76.51803 | 3.48257 |
| 1914 | Zona Norte | 02 | 5 | 300 | 205 | 2 | 5 | 6 | Casa | vipasa | -76.51832 | 3.48138 |
pot2<-filter(base2, areaconst>=270 & areaconst<=350 & estrato==5 & habitaciones>=5 & banios>=3 & parqueaderos>=2 & preciom<=850)
pot2_2<-filter(base2,areaconst>=270 & areaconst<=350 & estrato==6 & habitaciones>=5 & banios>=3 & parqueaderos>=2 & preciom<=850)
pot_ofertas2<-rbind(pot2,pot2_2)
kable(pot_ofertas2, fontsize = 4) %>%
kable_styling(font_size = 14)| id | zona | piso | estrato | preciom | areaconst | parqueaderos | banios | habitaciones | tipo | barrio | longitud | latitud |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 5306 | Zona Sur | 12 | 5 | 650 | 275 | 2 | 5 | 5 | Apartamento | ciudadela pasoancho | -76.53569 | 3.38597 |
| 7512 | Zona Sur | NA | 5 | 670 | 300 | 3 | 5 | 6 | Apartamento | seminario | -76.55000 | 3.40900 |
map <- leaflet(data = pot_ofertas) %>%
addTiles() %>%
addCircleMarkers(lng = ~longitud, lat = ~latitud, radius = 0.01,
color = "purple", fillColor = "purple", fillOpacity = 0.7,
popup = paste("<b>ID:</b>", base1$id,
"<br><b>Latitude:</b>", base1$latitud,
"<br><b>Longitude:</b>", base1$longitud,
"<br><b>Tipo:</b>", base1$tipo,
"<br><b>Zona:</b>", base1$zona)) %>%
# Agrega los círculos marcadores de las ubicaciones en base2 en otro color
addCircleMarkers(data = pot_ofertas2, lng = ~longitud, lat = ~latitud, radius = 0.01,
color = "violet", fillColor = "violet", fillOpacity = 0.7,
popup = paste("<b>ID:</b>", base2$id,
"<br><b>Latitude:</b>", base2$latitud,
"<br><b>Longitude:</b>", base2$longitud,
"<br><b>Tipo:</b>", base2$tipo,
"<br><b>Zona:</b>", base2$zona)) %>%
setView(lng = -76.5, lat = 3.44, zoom = 12)
# Visualiza el mapa
map