Maria comenzó como agente de bienes raíces en Cali hace 10 años. Después de laborar dos años para una empresa nacional, se traslado a Bogotá y trabajó para otra agencia de bienes raíces. Sus amigos y familiares la convencieron de que con su experiencia y conocimientos del negocio debía abrir su propia agencia. Terminó por adquirir la licencia de intermediario y al poco tiempo fundó su propia compañía, C&A (Casas y Apartamentos) en Cali. Santiago y Lina, dos vendedores de la empresa anterior aceptaron trabajar en la nueva compaña. En la actualidad ocho agentes de bienes raíces colaboran con ella en C&A.

Actualmente las ventas de bienes raíces en Cali se han visto disminuidas de manera significativa en lo corrido del año. Durante este periodo muchas instituciones bancarias de ahorro y vivienda están prestando grandes sumas de dinero para la industria y la construcción comercial y residencial. Cuando el efecto producto de las tensiones políticas y sociales disminuya, se espera que la actividad económica de este sector se reactive.

Hace dos días, María recibió una carta solicitando asesoría para la compra de dos viviendas por parte de una compañía internacional que desea ubicar a dos de sus empleados con sus familias en la ciudad. Las solicitudes incluyen las siguientes condiciones:

vivienda 1

Área construida: 200 m²
Estrato: 4
Habitaciones: 4
Parqueaderos: 1
Baños: 2

vivienda 2

Área construida: 200 m²
Estrato: 4
Habitaciones: 4
Parqueaderos: 1
Baños: 2

Ayude a María a responder la solicitud, mediante técnicas modelación que usted conoce. Ella requiere le envíe un informe ejecutivo donde analice los dos casos y sus recomendaciones (Informe). Como soporte del informe debe anexar las estimaciones, validaciones y comparación de modelos requeridos (Anexos) .

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?).
Realice un análisis exploratorio de datos enfocado en la correlación entre la variable respuesta (precio de la casa) 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.
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).
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).
Con el modelo identificado debe predecir el precio de la vivienda con las características de la primera solicitud.
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 pre-aprobado de máximo 350 millones de pesos. Realice un análisis y presente en un mapa al menos 5 ofertas potenciales que debe discutir.
Realice los pasos del 1 al 6. Para la segunda solicitud que tiene un crédito pre-aprobado por valor de $850 millones.

Primero se imporatán las librerías necesarias y la base de datos….

library(paqueteMODELOS)
library(knitr)    
library(dplyr)
library(stargazer) 
library(leaflet)
library(ggplot2)
library(plotly)
library(car)
library(lmtest)
library(boot)
data("vivienda")

data(vivienda)
vivienda <- na.omit(vivienda)

Limpieza de datos

Como es debido, se realizó la limpieza de datos donde le damos tratamiento a los datos faltantes (NA) imputando la variable piso, estrato,, parqueaderos, baños, habitaciones y tipo por la moda estadística. Las variables precio, y area que contenían NA’s se imputaron por la media estadística y finalmente, los registros de las variables barrios, longitud y latitud que contenían NA’s fueron eliminados.También se garantizó que los datos de la columna barrio no presentaran errores tipográficos, como inconvenientes presentados por mayúsculas y minúsculas, espacios en blanco y caracteres especiales. Por último, se establecieron de manera pertinente las variables numéricas y categóricas.

vivienda1 <- vivienda

vivienda1 <- vivienda1[!is.na(vivienda1$id), ]

vivienda1$piso[is.na(vivienda1$piso)] <- names(which.max(table(vivienda1$piso)))
vivienda1$estrato[is.na(vivienda1$estrato)] <- names(which.max(table(vivienda1$estrato)))
vivienda1$parqueaderos[is.na(vivienda1$parqueaderos)] <- as.numeric(names(which.max(table(vivienda1$parqueaderos))))
vivienda1$banios[is.na(vivienda1$banios)] <- as.numeric(names(which.max(table(vivienda1$banios))))
vivienda1$habitaciones[is.na(vivienda1$habitaciones)] <- as.numeric(names(which.max(table(vivienda1$habitaciones))))
vivienda1$tipo[is.na(vivienda1$tipo)] <- names(which.max(table(vivienda1$tipo)))

vivienda1$preciom[is.na(vivienda1$preciom)] <- mean(vivienda1$preciom, na.rm = TRUE)
vivienda1$areaconst[is.na(vivienda1$areaconst)] <- mean(vivienda1$areaconst, na.rm = TRUE)


vivienda1 <- vivienda1[!is.na(vivienda1$barrio), ]
vivienda1 <- vivienda1[!is.na(vivienda1$latitud), ]
vivienda1 <- vivienda1[!is.na(vivienda1$longitud), ]



vivienda1$barrio <- vivienda1$barrio %>%
  tolower() %>%                      
  trimws() %>%                       
  gsub("[^a-záéíóúñ ]", "", .) %>%   
  gsub("aguablanca|agua blanca", "aguablanca", .) %>%  
  gsub("alf@rez real", "alférez real", .) %>%         
  gsub("alfonso lopez|alfonso lópez", "alfonso lópez", .) 



vivienda1 <- vivienda1 %>%
  mutate (
    id = as.numeric(id),
    zona = as.factor(zona),
    piso = as.numeric(piso),
    estrato = as.factor(estrato),
    preciom = as.numeric(preciom),
    areaconst = as.numeric(areaconst),
    parqueaderos = as.numeric(parqueaderos),
    banios = as.numeric(banios),
    habitaciones = as.numeric(habitaciones),
    tipo = as.factor(tipo),
    barrio = as.factor(barrio),
    longitud = as.numeric(longitud),
    latitud = as.numeric(latitud)
    
  )

Caso vivienda 1

# Filtrar la base para obtener solo casas en la Zona Norte
casas_norte <- vivienda1 %>% 
  filter(tipo == "Casa" & zona == "Zona Norte")

A continuación se toman los primeros 3 registros que cumplen con las características de ser tipo casa y zona norte.

# Mostrar los primeros 3 registros
head(casas_norte, 3)

## # A tibble: 3 × 13
##      id zona     piso estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <fct>   <dbl> <fct>     <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  1209 Zona N…     2 5           320       150            2      4            6
## 2  1592 Zona N…     2 5           780       380            2      3            3
## 3  4460 Zona N…     2 4           625       355            3      5            5
## # ℹ 4 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>

En la siguiente tabla se evidencia que hay 254 casas por la zona norte, la tabla presentada nos sirve para garantizar que no hubieron errores en el análisis y la columna que corresponde a apartamentos garantiza que solamente eligimos viviendas tipo casa

# Tablas de frecuencia para confirmar el filtro
table(casas_norte$tipo)

## 
## Apartamento        Casa 
##           0         254

A continuación evidenciamos que el proceso unicamente tendrá en cuenta viviendas en la zona norte para esta parte del análisis.

# Tablas de frecuencia para confirmar el filtro

table(casas_norte$zona)

## 
##  Zona Centro   Zona Norte   Zona Oeste Zona Oriente     Zona Sur 
##            0          254            0            0            0

El siguiente mapa tiene el propósito de visualizar que en efecto todas las viviendas se sitúen en la zona norte de la ciudad, en el mapa se observa que todos los puntos están agrupados con excepción de un dato que se encuentra relativamente lejos de ellos, esto puede indicar un dato mál digitado o categorizado, se le podría dar tratamiento a este caso eliminando el outlayer, sin embargo proseguiremos con el análisis para evidenciar como se comportan los datos en los procedimientos más adelante.

# Generar un mapa con leaflet

mapa_casas_norte <- leaflet(casas_norte) %>%
  addTiles() %>%
  addMarkers(lng = ~longitud, lat = ~latitud,
             popup = ~paste("Barrio:", barrio, "<br>",
                            "Precio:", preciom, "millones"))
mapa_casas_norte

Procedemos a realizar un scatter plot para entender la relación de area y precio en los distintos estratos.Se observa una tendencia positiva y la relación parece ser lineal. Los departamentos de estrato 3 parecen estar concentrados en areas más pequeñas mientras que las de estrato 5 están más distribuídas en distintas áreas. A partir de los 800 en el eje de precio parecen haber datos atípicos

# catter Plot: Área Construida vs Precio (diferenciando por Estrato)
p1 <- ggplot(casas_norte, aes(x = areaconst, y = preciom, color = estrato)) +
  geom_point() +
  labs(title = "Relación entre Área Construida y Precio",
       x = "Área Construida",
       y = "Precio (millones)",
       color = "Estrato") +
  theme_minimal()
ggplotly(p1)

A continuación observamos un Boxplot donde se evidencia una relación positiva entre baños y precio. entre número de baños 2 y número de baños 6 esta tendencia está más clara aunque con outlayers que se evidencian en los puntos fuera de las cajas. Se evidencia que hay pocas viviendas con 1 solo baño. Habrá que realizar más adelante un análisis de Anova con ánimo de concluir si la variable baños realmente es significativa.

# Boxplot: Precio según Número de Baños
p2 <- ggplot(casas_norte, aes(x = as.factor(banios), y = preciom)) +
  geom_boxplot(fill = "#69b3a2") +
  labs(title = "Distribución del Precio según Número de Baños",
       x = "Número de Baños",
       y = "Precio (millones)") +
  theme_minimal()
ggplotly(p2)

En el siguiente Boxplot también se evidencia una relación positiva entre el número de habitaciones y el precio, sin embargo hay considerable variabilidad y no hay una relación lineal perfecta

# Boxplot: Precio según Número de Habitaciones
p3 <- ggplot(casas_norte, aes(x = as.factor(habitaciones), y = preciom)) +
  geom_boxplot(fill = "#404080") +
  labs(title = "Distribución del Precio según Número de Habitaciones",
       x = "Número de Habitaciones",
       y = "Precio (millones)") +
  theme_minimal()
ggplotly(p3)

A continuación probamos el modelo de Regresión Lineal Múltiple preciom = areaconst + estrato + habitaciones + parqueaderos + banios y observamos los resultados en la tabla de resumen. Se observa que el modelo explica el 59.75% de la variabilidad en los precios, el p-valor indica que el modelo es significativo. Se identifica, sin embargo, que la variable baños no parece ser significativa. Es importante mencionar que la variable estrato se convirtió en variable Dummy para efectos de los análisis de aquí en adelante.

modelo_precio <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = casas_norte)

summary(modelo_precio)

## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
##     banios, data = casas_norte)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -752.22  -83.33  -15.83   54.98  930.42 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -2.30587   37.65478  -0.061 0.951220    
## areaconst      0.66610    0.06714   9.921  < 2e-16 ***
## estrato4     118.04946   34.06001   3.466 0.000623 ***
## estrato5     181.38590   32.50743   5.580 6.34e-08 ***
## estrato6     284.93069   49.76148   5.726 2.99e-08 ***
## habitaciones  10.01530    7.27941   1.376 0.170123    
## parqueaderos  28.08429    6.78830   4.137 4.83e-05 ***
## banios         9.27740    9.74261   0.952 0.341905    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 153 on 246 degrees of freedom
## Multiple R-squared:  0.5975, Adjusted R-squared:  0.586 
## F-statistic: 52.16 on 7 and 246 DF,  p-value: < 2.2e-16

Ahora bien, se revisará que no existan problemas de multicolinealidad, para ello, aplicamos la prueba de factor de inflación de la varianza; donde se muestra que, al ser todos los valores menores a 5, no existe multicolinealidad en las variables.

# Calcular el VIF para detectar multicolinealidad
vif(modelo_precio)

##                  GVIF Df GVIF^(1/(2*Df))
## areaconst    1.416661  1        1.190236
## estrato      1.293096  3        1.043771
## habitaciones 1.884751  1        1.372862
## parqueaderos 1.217214  1        1.103274
## banios       2.053333  1        1.432945

Validación de supuestos

Se evidencia en el gráfico de residuos vs valores ajustados que, si bien los datos se observan un poco dispersos, no existe en patron de curva. El patron que se observa nos indica un patrón lineal en los datos como lo señala una linea roja en la gráfica.Por otra parte, no podemos decir que hay heterocedasticidad clara en los datos

# Gráfico de residuos vs valores ajustados
plot(modelo_precio$fitted.values, resid(modelo_precio), 
     xlab = "Valores Ajustados", ylab = "Residuos", 
     main = "Gráfico de Residuos vs Valores Ajustados")
abline(h = 0, col = "red")

En el histograma a continuación podemos identificar una forma de campana, sin embargo con unas colas alargadas, lo cual es un indicador de valores atípicos, esto indica que el supuesto de normalidad podría no cumplirse.

# Histograma de residuos
hist(resid(modelo_precio), breaks = 20, 
     main = "Histograma de Residuos", xlab = "Residuos")

Para corroborar realizaremos la prueba de normalidad Shapiro Wilk, donde identificamos un p-valor > 0,05. Los datos no siguen una distribución normal. Ahora bien, esto podría no ser un problema grave ya que tenemos un n > a 30, sin embargo el modelo podría ajustarse para obtener un mejor resultado.

# Prueba de Normalidad de Shapiro-Wilk
shapiro.test(resid(modelo_precio))

## 
##  Shapiro-Wilk normality test
## 
## data:  resid(modelo_precio)
## W = 0.87744, p-value = 2.025e-13

La prueba Durbin-Watson presentada a continuación sugiere que NO hay autocorrelación de residuos

# Prueba de Durbin-Watson (Independencia de los residuos)
dwtest(modelo_precio)

## 
##  Durbin-Watson test
## 
## data:  modelo_precio
## DW = 1.9269, p-value = 0.2425
## alternative hypothesis: true autocorrelation is greater than 0

Como resumen; el supuesto de linealidad de cumple, el supuesto de independencia de errores (Autocorrelación) se cumple, el supuesto de homocedasticidad de cumple, sabemos que no hay multicolinealidad sin embargo el supuesto de normalidad en los residuos no se cumple. A continuación realizaremos la proyección para la Vivienda 1 solicitada con las características:

Área construida: 200 m²
Estrato: 4
Habitaciones: 4
Parqueaderos: 1
Baños: 2

# Crear un nuevo data frame con las características de la Vivienda 1
vivienda1_nueva <- data.frame(
  areaconst = 200,
  estrato = factor(4, levels = levels(casas_norte$estrato)),  # Convertir estrato a factor
  habitaciones = 4,
  parqueaderos = 1,
  banios = 2
)

# Hacer la predicción del precio con el modelo ajustado
precio_predicho <- predict(modelo_precio, newdata = vivienda1_nueva)

# Mostrar el precio predicho
precio_predicho

##        1 
## 335.6635

Como se puede apreciar, el valor predicho está por debajo del crédito aprobado de 350 millones, esto quiere decir que la empresa tiene suficiente crédito pre-aprobado.
Vamos, sin embargo, a realizar un anáisis Bootstrap.

# Función para calcular el error de predicción del modelo (RMSE)
boot_function <- function(data, indices) {
  sample_data <- data[indices, ]  # Generar muestra bootstrap
  model <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = sample_data)
  predictions <- predict(model, sample_data)
  error <- sqrt(mean((sample_data$preciom - predictions)^2))  # RMSE
  return(error)
}

# Aplicar Bootstrap con 1000 iteraciones
set.seed(123)  # Para reproducibilidad
boot_results <- boot(data = casas_norte, statistic = boot_function, R = 1000)

# Mostrar los resultados del bootstrap
print(boot_results)

## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = casas_norte, statistic = boot_function, R = 1000)
## 
## 
## Bootstrap Statistics :
##     original   bias    std. error
## t1* 150.5801 -5.39238    15.62316

# Intervalo de confianza del RMSE obtenido con bootstrap
boot.ci(boot_results, type = "perc")

## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 1000 bootstrap replicates
## 
## CALL : 
## boot.ci(boot.out = boot_results, type = "perc")
## 
## Intervals : 
## Level     Percentile     
## 95%   (114.3, 176.7 )  
## Calculations and Intervals on Original Scale

Identificamos en el Bootstrap que hay un sesgo de 150.84 millones, es un dato importante a tener en cuenta. A continuación realizaremos una Anova donde identificamos que la variable baños no es significativa en el modelo.

# Aplicar ANOVA al modelo de regresión de la Vivienda 1
anova(modelo_precio)

## Analysis of Variance Table
## 
## Response: preciom
##               Df  Sum Sq Mean Sq  F value    Pr(>F)    
## areaconst      1 6444942 6444942 275.2866 < 2.2e-16 ***
## estrato        3 1367036  455679  19.4637 2.346e-11 ***
## habitaciones   1  228970  228970   9.7801  0.001976 ** 
## parqueaderos   1  486507  486507  20.7805 8.122e-06 ***
## banios         1   21229   21229   0.9068  0.341905    
## Residuals    246 5759291   23412                       
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Filtrar viviendas en Zona Norte con precio <= 350 millones
ofertas_viables <- casas_norte %>%
  filter(preciom <= 350 & 
           areaconst >= 150 & areaconst <= 250 & 
           parqueaderos >= 1 & parqueaderos <= 2 & 
           banios >= 2 & banios <= 3 &  
           habitaciones >= 3 & habitaciones <= 5 &  
           estrato %in% c(4, 5))  

# Mostrar las primeras 5 opciones disponibles
head(ofertas_viables, 5)

## # A tibble: 5 × 13
##      id zona     piso estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <fct>   <dbl> <fct>     <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  4265 Zona N…     1 5           245       165            2      2            3
## 2  4313 Zona N…     1 5           335       220            1      3            3
## 3  1376 Zona N…     2 5           320       160            1      3            4
## 4  3586 Zona N…     1 4           330       240            1      2            3
## 5  1020 Zona N…     2 4           230       250            2      3            5
## # ℹ 4 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>

# Generar mapa con las viviendas viables
mapa_ofertas <- leaflet(ofertas_viables) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud,
    radius = 5,
    color = "blue",
    popup = ~paste("ID:", id, "<br>",
                   "Precio:", preciom, "millones<br>",
                   "Área:", areaconst, "m²<br>",
                   "Estrato:", estrato, "<br>",
                   "Parqueaderos:", parqueaderos, "<br>",
                   "Baños:", banios, "<br>",
                   "Habitaciones:", habitaciones, "<br>",
                   "Barrio:", barrio)
  )

# Mostrar el mapa
mapa_ofertas

# Verificar si todas las viviendas filtradas realmente están en la Zona Norte
table(ofertas_viables$zona)

## 
##  Zona Centro   Zona Norte   Zona Oeste Zona Oriente     Zona Sur 
##            0            9            0            0            0

# Mostrar las coordenadas de las viviendas para revisar anomalías
ofertas_viables %>%
  select(id, barrio, zona, longitud, latitud, preciom)

## # A tibble: 9 × 6
##      id barrio     zona       longitud latitud preciom
##   <dbl> <fct>      <fct>         <dbl>   <dbl>   <dbl>
## 1  4265 el bosque  Zona Norte    -76.5    3.49     245
## 2  4313 el bosque  Zona Norte    -76.5    3.49     335
## 3  1376 la flora   Zona Norte    -76.5    3.49     320
## 4  3586 la merced  Zona Norte    -76.5    3.48     330
## 5  1020 la merced  Zona Norte    -76.5    3.47     230
## 6  1887 vipasa     Zona Norte    -76.5    3.48     340
## 7  1842 vipasa     Zona Norte    -76.5    3.48     350
## 8  1211 zona norte Zona Norte    -76.5    3.39     340
## 9    94 zona norte Zona Norte    -76.5    3.47     265

Caso vivienda 2

A continuación se toman los primeros 3 registros que cumplen con las características de ser tipo apartamento y zona sur

# Filtrar apartamentos en la Zona Sur
apartamentos_sur <- vivienda1 %>%
  filter(tipo == "Apartamento" & zona == "Zona Sur")
# Mostrar los primeros registros para verificar
head(apartamentos_sur, 3)

## # A tibble: 3 × 13
##      id zona     piso estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <fct>   <dbl> <fct>     <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  5098 Zona S…     5 4           290        96            1      2            3
## 2   698 Zona S…     2 3            78        40            1      1            2
## 3  6975 Zona S…     6 4           220        75            1      2            3
## # ℹ 4 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>

En la siguiente tabla se evidencia que hay 1860 casas por la zona sur, la tabla presentada nos sirve para garantizar que no hubieron errores en el análisis y la columna que corresponde a apartamentos garantiza que solamente eligimos viviendas tipo apartamento.

# Tablas de frecuencia para confirmar el filtro
table(apartamentos_sur$tipo)

## 
## Apartamento        Casa 
##        1860           0

A continuación evidenciamos que el proceso unicamente tendrá en cuenta viviendas en la zona sur para esta parte del análisis

table(apartamentos_sur$zona)

## 
##  Zona Centro   Zona Norte   Zona Oeste Zona Oriente     Zona Sur 
##            0            0            0            0         1860

Ahora realizamos la regresión lineal Múltiple para este caso

# Ajustar un modelo de regresión lineal para los apartamentos en Zona Sur
modelo_precio_sur <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = apartamentos_sur)

# Mostrar el resumen del modelo
summary(modelo_precio_sur)

## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
##     banios, data = apartamentos_sur)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -988.52  -39.04    1.05   36.08  910.88 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -43.24107   14.47937  -2.986  0.00286 ** 
## areaconst      1.20612    0.05785  20.850  < 2e-16 ***
## estrato4      30.73114   10.86651   2.828  0.00473 ** 
## estrato5      50.09496   10.97111   4.566  5.3e-06 ***
## estrato6     196.28052   12.72877  15.420  < 2e-16 ***
## habitaciones -11.96288    4.09463  -2.922  0.00352 ** 
## parqueaderos  69.35460    4.88769  14.190  < 2e-16 ***
## banios        41.03330    3.69888  11.093  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 90.57 on 1852 degrees of freedom
## Multiple R-squared:  0.764,  Adjusted R-squared:  0.7631 
## F-statistic: 856.3 on 7 and 1852 DF,  p-value: < 2.2e-16

El grafico a continuación sugiere problemas con la heterocedasticidad del modelo

# Supuesto de homocedasticidad: Gráfico de residuos vs valores ajustados
plot(modelo_precio_sur$fitted.values, resid(modelo_precio_sur), 
     main = "Gráfico de Residuos vs Valores Ajustados",
     xlab = "Valores Ajustados", ylab = "Residuos",
     pch = 19, col = "black")
abline(h = 0, col = "red")

Se evidencia en el histograma que el modelo no sigue una distribución normal en sus residuos, esto es corroborado también por la prueba Shapiro.

# Supuesto de normalidad de los residuos: Histograma
hist(resid(modelo_precio_sur), 
     main = "Histograma de Residuos",
     xlab = "Residuos", col = "gray", breaks = 20)

# Test de normalidad de los residuos (Shapiro-Wilk)
shapiro_test_sur <- shapiro.test(resid(modelo_precio_sur))
print(shapiro_test_sur)

## 
##  Shapiro-Wilk normality test
## 
## data:  resid(modelo_precio_sur)
## W = 0.76612, p-value < 2.2e-16

La prueba Durbin Watson indica autocorrelación de los residuos

# Supuesto de independencia de los residuos (Durbin-Watson)
dw_test_sur <- dwtest(modelo_precio_sur)
print(dw_test_sur)

## 
##  Durbin-Watson test
## 
## data:  modelo_precio_sur
## DW = 1.6625, p-value = 1.149e-13
## alternative hypothesis: true autocorrelation is greater than 0

El modelo no presenta multicolinealidad según el VIF

# Multicolinealidad: VIF
vif(modelo_precio_sur)

##                  GVIF Df GVIF^(1/(2*Df))
## areaconst    1.933553  1        1.390523
## estrato      1.730619  3        1.095722
## habitaciones 1.404811  1        1.185247
## parqueaderos 1.938826  1        1.392417
## banios       2.601553  1        1.612933

Realizamos el mismo proceso de analisis pero con las carácterísticas:

Área construida: 200 m²
Estrato: 4
Habitaciones: 4
Parqueaderos: 1
Baños: 2

# Crear un nuevo data frame con las características de la Vivienda 2
vivienda2_nueva <- data.frame(
  areaconst = 300,
  estrato = factor(5, levels = levels(apartamentos_sur$estrato)),  # Convertir estrato a factor
  habitaciones = 5,
  parqueaderos = 3,
  banios = 3
)

# Hacer la predicción del precio con el modelo ajustado
precio_predicho_vivienda2 <- predict(modelo_precio_sur, newdata = vivienda2_nueva)

Como se puede apreciar, el valor predicho está por debajo del crédito aprobado de 850 millones, esto quiere decir que la empresa tiene suficiente crédito pre-aprobado.

# Mostrar el precio predicho
precio_predicho_vivienda2

##        1 
## 640.0379

Procedemos a buscar las 5 mejores opciones y las presentamos en un mapa

# Filtrar apartamentos en Zona Sur con precio <= 850 millones
ofertas_viables_sur <- apartamentos_sur %>%
  filter(preciom <= 850 & 
           areaconst >= 250 & areaconst <= 350 &  
           parqueaderos >= 2 & parqueaderos <= 4 &  
           banios >= 2 & banios <= 4 & 
           habitaciones >= 4 & habitaciones <= 6 &  
           estrato %in% c(5, 6))

# Mostrar las primeras 5 opciones disponibles
head(ofertas_viables_sur, 5)

## # A tibble: 5 × 13
##      id zona     piso estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <fct>   <dbl> <fct>     <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  6175 Zona S…     5 5           350      270             3      3            4
## 2  8113 Zona S…     2 5           410      296.            2      4            4
## 3  7658 Zona S…     6 5           520      320             2      4            4
## 4  4266 Zona S…     5 6           700      250             2      4            5
## 5  2308 Zona S…     4 5           350      258             2      4            5
## # ℹ 4 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>

# Generar mapa con las viviendas viables en la Zona Sur
mapa_ofertas_sur <- leaflet(ofertas_viables_sur) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud,
    radius = 5,
    color = "red",
    popup = ~paste("ID:", id, "<br>",
                   "Precio:", preciom, "millones<br>",
                   "Área:", areaconst, "m²<br>",
                   "Estrato:", estrato, "<br>",
                   "Parqueaderos:", parqueaderos, "<br>",
                   "Baños:", banios, "<br>",
                   "Habitaciones:", habitaciones, "<br>",
                   "Barrio:", barrio)
  )

mapa_ofertas_sur

Se presenta a continuación un mapa con las 5 ofertas del norte y las 5 ofertas del sur

mapa_combinado <- leaflet() %>%
  addTiles() %>%
  

  addCircleMarkers(data = ofertas_viables,
                   lng = ~longitud, lat = ~latitud,
                   radius = 5, color = "blue",
                   popup = ~paste("ID:", id, "<br>",
                                  "Precio:", preciom, "millones<br>",
                                  "Área:", areaconst, "m²<br>",
                                  "Estrato:", estrato, "<br>",
                                  "Parqueaderos:", parqueaderos, "<br>",
                                  "Baños:", banios, "<br>",
                                  "Habitaciones:", habitaciones, "<br>",
                                  "Barrio:", barrio)) %>%
  
  
  addCircleMarkers(data = ofertas_viables_sur,
                   lng = ~longitud, lat = ~latitud,
                   radius = 5, color = "red",
                   popup = ~paste("ID:", id, "<br>",
                                  "Precio:", preciom, "millones<br>",
                                  "Área:", areaconst, "m²<br>",
                                  "Estrato:", estrato, "<br>",
                                  "Parqueaderos:", parqueaderos, "<br>",
                                  "Baños:", banios, "<br>",
                                  "Habitaciones:", habitaciones, "<br>",
                                  "Barrio:", barrio)) 


mapa_combinado

Apartado extra

Ya hemos analizado las 2 propuestas solicitadas, ahora bien, en este apartado aplicaremos técnicas para mejorar el modelo de regresión, corregir los inconvenientes presentados al evaluar el cumplimiento de los supuestos y reducir los datos atípicos; todo esto para el caso de vivienda 1 (apartamentos en el norte).

Realizamos un gráfico que señala las coordenadas de las viviendas al norte, e identificamos que la vivienda con ID: 6906 es la más apartada (esta puede ser la vivienda que en el análisis anterior evidenciamos como mal categorizada)

library(ggplot2)

ggplot(casas_norte, aes(x = longitud, y = latitud)) +
  geom_point(color = "blue") +
  geom_text(aes(label = id), vjust = -1, hjust = 1, size = 3) +
  labs(title = "Distribución de las Coordenadas (Casas Norte)", 
       x = "Longitud", 
       y = "Latitud") +
  theme_minimal()

Procedemos a eliminarla

# Eliminar la vivienda con ID 6906
casas_norte <- casas_norte %>%
  filter(id != 6906)


ggplot(casas_norte, aes(x = longitud, y = latitud)) +
  geom_point(color = "blue") +
  geom_text(aes(label = id), vjust = -1, hjust = 1, size = 3) +
  labs(title = "Distribución de las Coordenadas (Casas Norte) - Después de Filtrar",
       x = "Longitud",
       y = "Latitud") +
  theme_minimal()

Procedemos a ajustar del modelo de regresión para mejorar los supuestos, lo haremos por medio de una transformación logarítmica para tratar el inconveniente del supuesto de normalidad de residuos.

# Aplicar transformación logarítmica al precio
casas_norte$log_preciom <- log(casas_norte$preciom)

# Ajustar el nuevo modelo con logaritmo del precio
modelo_precio_log <- lm(log_preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = casas_norte)

# Ver resumen del modelo
summary(modelo_precio_log)

## 
## Call:
## lm(formula = log_preciom ~ areaconst + estrato + habitaciones + 
##     parqueaderos + banios, data = casas_norte)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.00025 -0.16831 -0.01202  0.15369  1.07113 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.9750603  0.0633049  78.589  < 2e-16 ***
## areaconst    0.0011017  0.0001138   9.680  < 2e-16 ***
## estrato4     0.4232876  0.0575814   7.351 2.93e-12 ***
## estrato5     0.5448551  0.0549091   9.923  < 2e-16 ***
## estrato6     0.6784637  0.0871244   7.787 1.93e-13 ***
## habitaciones 0.0120375  0.0125465   0.959  0.33829    
## parqueaderos 0.0475290  0.0114209   4.162 4.38e-05 ***
## banios       0.0460991  0.0174941   2.635  0.00895 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2572 on 245 degrees of freedom
## Multiple R-squared:  0.6876, Adjusted R-squared:  0.6787 
## F-statistic: 77.03 on 7 and 245 DF,  p-value: < 2.2e-16

plot(fitted(modelo_precio_log), resid(modelo_precio_log),
     main="Gráfico de Residuos vs Valores Ajustados (Log)",
     xlab="Valores Ajustados", ylab="Residuos")
abline(h=0, col="red")

hist(resid(modelo_precio_log), main="Histograma de Residuos (Log)",
     xlab="Residuos", breaks=20, col="gray")

shapiro.test(resid(modelo_precio_log))

## 
##  Shapiro-Wilk normality test
## 
## data:  resid(modelo_precio_log)
## W = 0.98493, p-value = 0.009

dwtest(modelo_precio_log)

## 
##  Durbin-Watson test
## 
## data:  modelo_precio_log
## DW = 1.648, p-value = 0.001702
## alternative hypothesis: true autocorrelation is greater than 0

vif(modelo_precio_log)

##                  GVIF Df GVIF^(1/(2*Df))
## areaconst    1.417048  1        1.190398
## estrato      1.329111  3        1.048561
## habitaciones 1.970102  1        1.403603
## parqueaderos 1.218716  1        1.103955
## banios       2.272412  1        1.507452

El análisis muestra una mejoría en la normalidad de residuos y en la prueba durbin Watson, sin embargo aún no es aceptable, el R cuadrado aumentó a 67.8%. Además la variable que no resulta ser significativa es habitaciones.procedemos entonces a eliminarla para mejorar el modelo.

modelo_precio_log_mejorado <- lm(log_preciom ~ areaconst + estrato + parqueaderos + banios, data = casas_norte)


summary(modelo_precio_log_mejorado)

## 
## Call:
## lm(formula = log_preciom ~ areaconst + estrato + parqueaderos + 
##     banios, data = casas_norte)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.98628 -0.16436 -0.00797  0.14430  1.06904 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  5.0012874  0.0570894  87.605  < 2e-16 ***
## areaconst    0.0011303  0.0001098  10.295  < 2e-16 ***
## estrato4     0.4082334  0.0553934   7.370 2.59e-12 ***
## estrato5     0.5284535  0.0521717  10.129  < 2e-16 ***
## estrato6     0.6577980  0.0844062   7.793 1.84e-13 ***
## parqueaderos 0.0473608  0.0114177   4.148 4.62e-05 ***
## banios       0.0558596  0.0142297   3.926 0.000112 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2572 on 246 degrees of freedom
## Multiple R-squared:  0.6864, Adjusted R-squared:  0.6788 
## F-statistic: 89.75 on 6 and 246 DF,  p-value: < 2.2e-16

El R cuadrado a mejorado un poco, ahora aumentó a 67.88%. Procedemos a realizar el análisis de los supuestos del modelo…

plot(fitted(modelo_precio_log_mejorado), resid(modelo_precio_log_mejorado),
     main = "Gráfico de Residuos vs Valores Ajustados (Log - Mejorado)",
     xlab = "Valores Ajustados", ylab = "Residuos")
abline(h = 0, col = "red")

hist(resid(modelo_precio_log_mejorado), breaks = 20, main = "Histograma de Residuos (Log - Mejorado)", xlab = "Residuos")

shapiro.test(resid(modelo_precio_log_mejorado))

## 
##  Shapiro-Wilk normality test
## 
## data:  resid(modelo_precio_log_mejorado)
## W = 0.98463, p-value = 0.007968

dwtest(modelo_precio_log_mejorado)

## 
##  Durbin-Watson test
## 
## data:  modelo_precio_log_mejorado
## DW = 1.6506, p-value = 0.001846
## alternative hypothesis: true autocorrelation is greater than 0

vif(modelo_precio_log_mejorado)

##                  GVIF Df GVIF^(1/(2*Df))
## areaconst    1.319286  1        1.148602
## estrato      1.189108  3        1.029288
## parqueaderos 1.218429  1        1.103825
## banios       1.503958  1        1.226360

El modelo ha mejorado mucho, aunque tiene oportunidades de mejora, ya se ha arreglado un poco el supuesto de normalidad de los residuos. Así las cosas vamos a proyectar nuevamente el precio esperado con las características solicitadas.

#Crear un nuevo data frame con las características de la Vivienda 1
vivienda1_mejorada <- data.frame(
  areaconst = 200,
  estrato = factor(4, levels = levels(casas_norte$estrato)),  
  parqueaderos = 1,
  banios = 2
)

# Hacer la predicción en escala logarítmica
log_precio_predicho <- predict(modelo_precio_log_mejorado, newdata = vivienda1_mejorada)

# Convertir el logaritmo del precio a su valor real
precio_predicho_mejorado <- exp(log_precio_predicho)

# Mostrar el precio proyectado
precio_predicho_mejorado

##        1 
## 328.5436

El precio sigue cumpliendo con el credito pre- aprobado con un valor de 328 millones

ofertas_viables_mejoradas <- casas_norte %>%
  filter(preciom <= precio_predicho_mejorado &  
           areaconst >= 150 & areaconst <= 250 &  
           parqueaderos >= 1 & parqueaderos <= 2 &  
           banios >= 2 & banios <= 3 &  
           estrato %in% c(4, 5))  


head(ofertas_viables_mejoradas, 5)

## # A tibble: 4 × 14
##      id zona     piso estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <fct>   <dbl> <fct>     <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  4265 Zona N…     1 5           245       165            2      2            3
## 2  1376 Zona N…     2 5           320       160            1      3            4
## 3  1020 Zona N…     2 4           230       250            2      3            5
## 4    94 Zona N…     2 4           265       162            1      3            4
## # ℹ 5 more variables: tipo <fct>, barrio <fct>, longitud <dbl>, latitud <dbl>,
## #   log_preciom <dbl>

En el mapa mejorado tenemos las viviendas que cumplen con los requisitos habiendo eliminado el caso atípico o mal etiquetado que teníamos

mapa_ofertas_mejoradas <- leaflet(ofertas_viables_mejoradas) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud,
    radius = 5,
    color = "blue",
    popup = ~paste("ID:", id, "<br>",
                   "Precio:", preciom, "millones<br>",
                   "Área:", areaconst, "m²<br>",
                   "Estrato:", estrato, "<br>",
                   "Parqueaderos:", parqueaderos, "<br>",
                   "Baños:", banios, "<br>",
                   "Habitaciones:", habitaciones, "<br>",
                   "Barrio:", barrio)
  )

# Mostrar el mapa actualizado
mapa_ofertas_mejoradas

Caso RLM

Juan Camilo Perdomo

2025-02-26

Limpieza de datos

Caso vivienda 1

Validación de supuestos

Caso vivienda 2

Apartado extra