Actividad 2 | Caso C&A

Enunciado

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.

ctualmente 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:

Características Vivienda 1 Vivienda 2
Tipo Casa Apartamento
Área construida 200 m² 300 m²
Parqueaderos 1 3
Baños 2 3
Habitaciones 4 5
Estrato 4 o 5 5 o 6
Zona Norte Sur
Crédito preaprobado 350 millones 850 millones

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) .

Los datos de los tres últimos meses se adjuntan en la base que puede obtener con el siguiente código en R:

Variable Descripción
zona Ubicación de la vivienda: Zona Centro, Zona Norte…
piso Piso que ocupa la vivienda: primer piso, segundo piso…
estrato Estrato socio-económico: 3, 4, 5, 6
preciom Precio de la vivienda en millones de pesos
areaconst Área construida
parqueaderos Número de parqueaderos
banios Número de baños
habitaciones Número de habitaciones
tipo Tipo de vivienda: Casa, Apartamento
barrio Barrio de ubicación de la vivienda: 20 de Julio, Álamos…
longitud Coordenada geográfica
latitud Coordenada geográfica 
data <- data %>%
  group_by(tipo) %>%
  mutate(
    # Calcular la moda de 'banios' y reemplazar ceros
    banios = ifelse(banios == 0, Mode(banios[banios != 0]), banios),
    
    # Calcular la moda de 'habitaciones' y reemplazar ceros
    habitaciones = ifelse(habitaciones == 0, Mode(habitaciones[habitaciones != 0]), habitaciones)
  ) %>%
  ungroup()


kable(head(data,3), caption = "Tabla 1 - Muestra de la Base Inicial 8.322 registros con 13 variables")
Tabla 1 - Muestra de la Base Inicial 8.322 registros con 13 variables
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 
data <- data %>%
  filter(!is.na(latitud))

data$longitud <- as.numeric(data$longitud)
data$latitud <- as.numeric(data$latitud)

Base 1: Casas de la zona norte

1 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?).

library(dplyr)
library(knitr)
library(kableExtra)

# Filtrar la base de datos
base1 <- data %>% 
  filter(zona == "Zona Norte" & tipo == "Casa")

# Tabla 1: Muestra Base Casas Zona Norte
kable(head(base1,3), caption = "Tabla 2 - Muestra Base Casas Zona Norte 722 registros con 13 variables") %>%
  kable_styling(font_size = 10, full_width = FALSE) # Reducir tamaño
Tabla 2 - Muestra Base Casas Zona Norte 722 registros con 13 variables
id zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo barrio longitud latitud
1209 Zona Norte 02 5 320 150 2 4 6 Casa acopi -76.51341 3.47968
1592 Zona Norte 02 5 780 380 2 3 3 Casa acopi -76.51674 3.48721
4057 Zona Norte 02 6 750 445 NA 7 6 Casa acopi -76.52950 3.38527 
# Tabla 2: Número de casas en Zona Norte por Estrato
kable(table(base1$estrato, base1$zona), caption = "Tabla 3 - # de casas zona norte por estrato") %>%
  kable_styling(font_size = 10, full_width = FALSE) # Reducir tamaño
Tabla 3 - # de casas zona norte por estrato
Zona Norte
3 235
4 161
5 271
6 55

Mapa 1: casas zona norte

mapa_zn <- leaflet(base1) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud, 
    popup = ~paste("ID:", id, "<br>Barrio:", barrio),
    radius = 5,  # Tamaño más pequeño del círculo
    color = "gray", fillOpacity = 0.6, stroke = FALSE
  )

mapa_zn
library(leaflet)
library(RColorBrewer)

En el mapa se logra identificar que filtrando las casas de la zona norte presenta errores, ya que arroja inmuebles en toca la ciudad (zonas diferentes a la zona norte). Hay dos posibilidades, que la base tenga un error en el registro de la zona o error en las coordenadas,

Al realizar el mapa con todas las zonas, se identifica el mismo error de registro de la ubicación geográfica o segmentación de la zona.

Mapa 2: Mapa de todas las zonas

# Definir una paleta de colores para las zonas
paleta_colores <- colorFactor(palette = "Set1", domain = data$zona)

# Crear el mapa con colores según la zona
mapa_total <- leaflet(data) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud, 
    popup = ~paste("ID:", id, "<br>Barrio:", barrio, "<br>Zona:", zona),
    radius = 5,  # Tamaño del marcador
    color = ~paleta_colores(zona),  # Asignar color según zona
    fillOpacity = 0.6, stroke = FALSE
  ) %>%
  addLegend("bottomright",  # Agregar leyenda
            pal = paleta_colores, 
            values = ~zona, 
            title = "Zona",
            opacity = 1)

mapa_total

Se realiza una nueva segmentación de zona para cada inmueble usando el centroide de lat y lon de la zona y se obtiene: el 79% de los inmuebles se encuentran segmentados en la zona que corresponde

# Eliminar registros con NA en coordenadas
data_filtrada <- data %>%
  filter(!is.na(latitud) & !is.na(longitud))

# Calcular centroides por zona
centroides <- data_filtrada %>%
  group_by(zona) %>%
  summarise(
    latitud = mean(latitud, na.rm = TRUE), 
    longitud = mean(longitud, na.rm = TRUE)
  ) %>%
  ungroup()

# Aplicar KNN para encontrar la zona más cercana
knn_result <- get.knnx(centroides[, c("longitud", "latitud")], 
                       data_filtrada[, c("longitud", "latitud")], k = 1)

# Asignar la zona más cercana a cada punto
data_filtrada$zona_corregida <- centroides$zona[knn_result$nn.index]

# Verificar la corrección


kable(table(data_filtrada$zona, data_filtrada$zona_corregida), caption = "Tabla 4 - Validación de zona de cada inmueble") %>%
  kable_styling(font_size = 10, full_width = FALSE) # Reducir tamaño
Tabla 4 - Validación de zona de cada inmueble
Zona Centro Zona Norte Zona Oeste Zona Oriente Zona Sur
Zona Centro 96 6 12 8 2
Zona Norte 100 1439 126 63 192
Zona Oeste 81 44 1006 21 46
Zona Oriente 29 34 11 223 54
Zona Sur 390 102 279 154 3801

Mapa 3: Mapa todas las zonas corregido

library(leaflet)
library(RColorBrewer)

# Definir una paleta de colores para las zonas
paleta_colores <- colorFactor(palette = "Set3", domain = data$zona)

# Crear el mapa con colores según la zona
mapa_total <- leaflet(data_filtrada) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud, 
    popup = ~paste("ID:", id, "<br>Barrio:", barrio, "<br>Zona:", zona),
    radius = 5,  # Tamaño del marcador
    color = ~paleta_colores(zona_corregida),  # Asignar color según zona
    fillOpacity = 0.6, stroke = FALSE
  ) %>%
  addLegend("bottomright",  # Agregar leyenda
            pal = paleta_colores, 
            values = ~zona, 
            title = "zona_corregida",
            opacity = 1)

mapa_total

2. 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.

library(dplyr)
base1_clean <- base1 %>%
  dplyr::select(preciom, areaconst, estrato, banios, habitaciones) %>%
  dplyr::filter(complete.cases(.))  # Elimina filas con NA automáticamente

analisis_base1 = summary(base1_clean)

knitr::kable(analisis_base1, caption = "Tabla 5 - Análisis generar las variable BASE1")
Tabla 5 - Análisis generar las variable BASE1
preciom areaconst estrato banios habitaciones
Min. : 89.0 Min. : 30.0 Min. :3.000 Min. : 1.000 Min. : 1.000
1st Qu.: 261.2 1st Qu.: 140.0 1st Qu.:3.000 1st Qu.: 2.000 1st Qu.: 3.000
Median : 390.0 Median : 240.0 Median :4.000 Median : 3.000 Median : 4.000
Mean : 445.9 Mean : 264.9 Mean :4.202 Mean : 3.611 Mean : 4.618
3rd Qu.: 550.0 3rd Qu.: 336.8 3rd Qu.:5.000 3rd Qu.: 4.000 3rd Qu.: 5.000
Max. :1940.0 Max. :1440.0 Max. :6.000 Max. :10.000 Max. :10.000 
# Calcular matriz de correlación
cor_matrix <- cor(base1_clean)  # Excluye zona porque es categórica
cor_melt <- melt(cor_matrix)

# Graficar matriz de correlación
ggplot(cor_melt, aes(x=Var1, y=Var2, fill=value)) +
  geom_tile() +
  scale_fill_gradient2(low="blue", high="red", mid="white", midpoint=0, limit=c(-1,1)) +
  geom_text(aes(label=round(value, 2)), size=4, color="black") +  # Agregar valores de correlación
  labs(title="Gráfico 1: Matriz de Correlación entre Variables", x="", y="") +
  theme_minimal()

La matriz de correlación muestra la relación entre el precio de la vivienda (preciom) y las variables explicativas. Se observa que el área construida (areaconst) tiene la mayor correlación con el precio (0.73), lo que indica que a mayor área, mayor es el precio de la vivienda.

Asimismo, el estrato siendo una variable categorica, presenta una correlación positiva moderada (0.61), sugiriendo que las viviendas en estratos más altos tienden a tener precios más elevados. El número de baños y el número de habitaciones tienen correlaciones de 0.52 y 0.32, respectivamente, lo que sugiere que estas variables también influyen en el precio, aunque en menor medida.

En general, todas las correlaciones son positivas, lo que indica que a medida que aumentan estas variables, el precio de la vivienda también aumenta. Sin embargo, las correlaciones no son perfectas, lo que sugiere que hay otros factores que también afectan el precio de las viviendas.

p1 <- plot_ly(base1_clean, 
              x = ~areaconst, 
              y = ~preciom, 
              type = 'scatter', 
              mode = 'markers',
              marker = list(size = 8, opacity = 0.6),
              color = ~estrato  # Asignar color según estrato
              ) %>%
  layout(title = "Gráfico 2 - Precio vs Área Construida",
         xaxis = list(title = "Área Construida (m²)"),
         yaxis = list(title = "Precio (millones)"),
         coloraxis = list(colorbar = list(title = "Estrato")))

p1

El gráfico de dispersión muestra la relación entre el precio de la vivienda y el área construida. Se observa una tendencia positiva, lo que indica que a mayor área construida, el precio de la vivienda tiende a aumentar. Sin embargo, hay cierta dispersión en los datos, especialmente en áreas grandes, lo que sugiere que otros factores también influyen en el precio.

Se identifican algunos valores atípicos, con viviendas de gran tamaño (más de 800 m²) que presentan precios muy variados. Esto puede deberse a diferencias en ubicación, estrato o características específicas de la vivienda.

En general, el área construida es un factor clave en la determinación del precio de una vivienda, pero no es el único determinante, por lo que vamos a complementar el análisis con las otras variables del data frame.

p2 <- plot_ly(base1_clean, x = ~factor(estrato), y = ~preciom, type = "box",
              boxpoints = "all", jitter = 0.3, pointpos = -1.8) %>%
  layout(title = "Gráfico 3 - Distribución del Precio según Estrato",
         xaxis = list(title = "Estrato"),
         yaxis = list(title = "Precio (millones)"))

p2

El gráfico de caja muestra la distribución del precio de las viviendas según el estrato socioeconómico. Se observa una tendencia creciente, donde los precios tienden a ser más altos en los estratos altos.

•   Estrato 3 y 4: Presentan una mayor concentración de precios en un rango más bajo, con valores medios estrato 3 de 215 M y estrato 4 de 380 M.
•   Estrato 5 y 6: Los precios son más altos y presentan una mayor variabilidad, con valores que pueden superar los 1,000 millones de pesos.
•   Valores atípicos: Se pueden ver outliers en todos los estratos, especialmente en estratos altos, donde algunas viviendas alcanzan precios muy elevados hasta de 1940 M en estrato 5.

En general, el gráfico confirma que el estrato es un factor importante en la determinación del precio de la vivienda, pero también sugiere que dentro de cada estrato puede haber una variabilidad significativa en los precios.

p3 <- plot_ly(base1_clean, x = ~factor(banios), y = ~preciom, type = "box",
              boxpoints = "all", jitter = 0.3, pointpos = -1.8) %>%
  layout(title = "Gráfico 4 - Distribución del Precio según Número de Baños",
         xaxis = list(title = "Número de Baños"),
         yaxis = list(title = "Precio (millones)"))

p3

El gráfico de caja muestra la relación entre el número de baños en una vivienda y su precio en millones de pesos. Se observa una tendencia creciente, lo que indica que en general, las viviendas con más baños tienden a tener precios más altos.

•   Viviendas con 1 a 3 baños: Presentan una mayor concentración de precios en rangos más bajos, con la mediana entre 100 y 500 millones de pesos.
•   Viviendas con 4 a 6 baños: Se observa una mayor dispersión de precios, con valores que pueden superar los 1,000 millones.
•   Viviendas con más de 6 baños: Hay pocos registros, pero los precios tienden a ser significativamente más altos.
•   Valores atípicos: Se identifican en casi todos los grupos, con algunas viviendas de bajo número de baños pero precios muy elevados, lo que sugiere que otros factores como la ubicación y el área construida también influyen en el precio.

En conclusión, el número de baños es un factor relevante en la determinación del precio, pero no es el único, ya que se observa variabilidad dentro de cada grupo.

p4 <- plot_ly(base1_clean, x = ~factor(habitaciones), y = ~preciom, type = "box",
              boxpoints = "all", jitter = 0.3, pointpos = -1.8) %>%
  layout(title = "Gráfico 5 - Distribución del Precio según Número de Habitaciones",
         xaxis = list(title = "Número de Habitaciones"),
         yaxis = list(title = "Precio (millones)"))

p4

El gráfico de caja muestra la relación entre el número de habitaciones y el precio de la vivienda en millones de pesos. Se observa una tendencia creciente, donde las viviendas con más habitaciones tienden a tener precios más altos, aunque con una alta dispersión.

•   Viviendas con 1 a 3 habitaciones: Tienen precios más bajos, con una mediana entre 100 y 500 millones de pesos.
•   Viviendas con 4 a 7 habitaciones: Se observa una mayor dispersión en los precios, con algunas propiedades superando los 1,000 millones de pesos.
•   Viviendas con más de 7 habitaciones: Presentan valores más altos y variables, con algunos casos extremos que pueden superar los 1,500 millones de pesos.
•   Valores atípicos: Se pueden ver outliers en todas las categorías, lo que indica que algunas viviendas tienen precios inusualmente altos respecto a otras con el mismo número de habitaciones.

En conclusión, aunque el número de habitaciones influye en el precio, la dispersión sugiere que otros factores como ubicación, estrato y área construida también juegan un papel importante en la determinación del valor de una vivienda.

p5 <- plot_ly(base1_clean,  y = ~preciom, type = "box",
              boxpoints = "all", jitter = 0.3, pointpos = -1.8) %>%
  layout(title = "Gráfico 6 - Distribución del Precio de la zona Norte | Casas",
         xaxis = list(title = "Zona"),
         yaxis = list(title = "Precio (millones)"))

p5

El gráfico de caja muestra la distribución del precio de las viviendas en la Zona Norte. Se observa que la mayoría de los precios se concentran entre 260 y 550 millones de pesos, con una mediana cercana a los 390 millones.

•   Rango intercuartil (caja): Indica que el 50\% central de las viviendas tiene precios entre aproximadamente 260 y 550 millones de pesos.
•   Extremos de la caja y bigotes: Los valores más bajos y más altos dentro del rango esperado se encuentran entre 89 y 950 millones de pesos.
•   Valores atípicos (outliers): Hay múltiples viviendas con precios que superan 900 millones de pesos, alcanzando incluso los 2,000 millones. Estos casos pueden deberse a características premium como ubicación privilegiada y  mayor área construida.

En conclusión, aunque la mayoría de las viviendas en la Zona Norte tienen precios dentro de un rango definido, la presencia de valores atípicos sugiere que hay una variabilidad considerable dentro de esta zona, posiblemente debido a diferencias en tamaño, estrato y características particulares de cada propiedad.

3. 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 𝑅2 y discuta el ajuste del modelo e implicaciones (que podrían hacer para mejorarlo).

Tabla 6: Modelo regresión lineal múltiple

modelo <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = base1)
summary(modelo)

Call:
lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
    banios, data = base1)

Residuals:
    Min      1Q  Median      3Q     Max 
-778.36  -78.41  -15.27   47.44  975.91 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)    
(Intercept)  -236.12506   44.89427  -5.260 2.28e-07 ***
areaconst       0.67288    0.05308  12.676  < 2e-16 ***
estrato        79.35410    9.91122   8.006 1.12e-14 ***
habitaciones    6.88822    5.84516   1.178  0.23927    
parqueaderos   23.47716    5.88549   3.989 7.80e-05 ***
banios         21.27981    7.77805   2.736  0.00648 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 155 on 429 degrees of freedom
  (287 observations deleted due to missingness)
Multiple R-squared:  0.6047,    Adjusted R-squared:  0.6001 
F-statistic: 131.3 on 5 and 429 DF,  p-value: < 2.2e-16

El modelo representa el precio de la vivienda en funcion de: área construida, estrato, # de habitaciones, # de parqeuaderos y # de baños.

Interpretacion de coeficientes:

  • Intercepto(-236,13): No teiene interpretación en este caso, ya que representa el caso cuando todas las variables son cero, lo cual es imposible en este caso.
  • Área construida: (0.67288) un aumento de 1m cuadrado en el área incrementa el precio en 672.800 Pesos
  • Estrato (79,35): por aumento en el estrato, el precio de la vivienda aumenta en aproximadamente 79,35 Millones
  • Habitaciones (6,88): No es estadísiticamente significativo, lo que indica que el número de habitaciones no tiene un impacto en el precio de la vivienda.
  • Parqueaderos (23,47): Un parqueadero adicional incrementa en 23,47 millones de pesos el precio. Además es una variables estadísticamente significativa.
  • Baños (23,28): Cada baño adicional aumenta el precio en 21,28 millones de pesos, es significativa pero nomor al área y el estrato.

Evaluación del modelo:

  • R² = 0.6047 y R² ajustado = 0.6001. El modelo explica apriximadamente el 60% la variabilidad del precio de la vivienda.
  • F-statistic: 131.3 on 5 and 429 DF, p-value: < 2.2e-16: Indica que el modelo en su conjunto es estadísticamente significativo, es decir, al menos una de las variables predictoras tiene un impacto real en el precio de la vivienda.
  • Error residual (155) muestra la dispersión de los errores que es relativamente alta, lo que indica que apun hay variabilidad sin explicar.
kable(vif(modelo), caption = "Tabla 7 - Analisis de multicolinealidad")
Tabla 7 - Analisis de multicolinealidad
x
areaconst 1.478234
estrato 1.332507
habitaciones 1.742764
parqueaderos 1.235189
banios 2.053912

Con el factor de inflación de la varianza podemos medir la colinealidad entre las variables predictoras, (< 5 no hay multicolinealidad, entre 5 y 10 multicolinealidad moderada, Mayor a 10 multicolinealidad alta). No existe mulsticolinealidad entre las variables predictoras, todos los valores de VIF están por debajo de 5.

¿Cómo Mejorar el Modelo?

  • Incluir más variables explicativas cómo la antiguedad de la vivienda y caracteristicas específicas del inmueble como: Zonas comunes, balcones, seguridad del la zona y si es cercano a centros comerciales o vías de acceso.
  • Probar transformaciones logaritmicas en el precio para reducior impactos de precios muy altos o bajos.

4. 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).

Gráfico 7: Validación de los supuestos

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

- Residuos vs Valores Ajustados

Se espera que los residuos estén aleatoriamente distribuidos en torno a 0. Sin embargo, en este gráfico, se observa una leve tendencia en forma de abanico, lo que podría indicar heterocedasticidad (varianza de los residuos no constante).También hay algunos valores atípicos alejados de la nube principal.

En la prueba Breusch-Pagan p-value = 1.151e-15, valida que existe heterocedasticidad. Se podría aplicar una transformación logarítmica en la variable dependiente preciom

library(lmtest)
bptest(modelo)

    studentized Breusch-Pagan test

data:  modelo
BP = 79.344, df = 5, p-value = 1.151e-15

- Q-Q Plot de los residuos

Se espera que los puntos sigan la línea diagonal, sin embargo se puede observar una desviación en los extremos del gráfico, lo que nos lleva a concluir que los residuos no llevan una distribución normal

Segun el test shapiro p-value = < 2.2e-16 se rechaza normalidad de los residuos validando los resultados del gráfico.

shapiro.test(modelo$residuals)

    Shapiro-Wilk normality test

data:  modelo$residuals
W = 0.85286, p-value < 2.2e-16

- Scale-Location

Este gráfico muestra si la varianza de los residuos es constante. Se observa una tendencia creciente de la línea roja, lo que demuestra que existe heterocedasticidad, la varianza aumenta que los valores ajustados aumentan.

- Resudials vs Leverage

Este gráfico muestra algunos puntos que pueden influir en el modelo de regresión. En este caso, los puntos 513, 632 y 186 pueden ser atípicos que afectan la regresión. Puntos que podrían llegar a excluirse del modelo para evitar el impacto.

- Autocorrelación en los residuos

Como el p-valor es menor a 0.05, rechazamos la hipótesis nula de no autocorrelación, lo que indica que existe autocorrelación positiva en los residuos del modelo. La autocorrelación en los residuos sugiere que los errores del modelo no son independientes, lo que puede hacer que los errores estándar de los coeficientes estén subestimados.

library(lmtest)
dwtest(modelo)

    Durbin-Watson test

data:  modelo
DW = 1.7518, p-value = 0.004047
alternative hypothesis: true autocorrelation is greater than 0

5. Con el modelo identificado debe predecir el precio de la vivienda con las características de la primera solicitud.

Antes de predecir el precio de la vivienda con el modelo, vamos a hacer los cambios necesarios para ajustar.

El resultado de BoxCox sugiere realizar una transformación logarítmica al precio, con esto podemos lograr reducir la heterocedasticidad, mejorar la normalidad de los residuos y mejorar la precisión del modelo. Tabién podemos eliminar atípicos según lo visto en el gráfico de residuals vs leverage del punto anterior para lograr un modelo más ajustado.

Gráfico 8: BoxCox

library(MASS)
boxcox(modelo)  # identifica la mejor transformación

# Calcular la distancia de Cook para identificar outliers
cook <- cooks.distance(modelo)

# Identificar observaciones influenciales
influentes <- which(cook > (4/nrow(base1)))

# Eliminar los outliers
base_sin_outliers <- base1[-influentes,]

# Ajustar nuevamente el modelo sin outliers
modelo_sin_outliers <- lm(log(preciom) ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
                          data = base_sin_outliers)

# Verificar el modelo
summary(modelo_sin_outliers)

Call:
lm(formula = log(preciom) ~ areaconst + estrato + habitaciones + 
    parqueaderos + banios, data = base_sin_outliers)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.12601 -0.16130 -0.02049  0.15313  1.07648 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  4.398e+00  7.754e-02  56.721  < 2e-16 ***
areaconst    1.084e-03  9.083e-05  11.938  < 2e-16 ***
estrato      2.177e-01  1.701e-02  12.798  < 2e-16 ***
habitaciones 1.848e-02  9.867e-03   1.872 0.061866 .  
parqueaderos 4.871e-02  1.007e-02   4.838 1.87e-06 ***
banios       4.838e-02  1.324e-02   3.653 0.000293 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2583 on 402 degrees of freedom
  (276 observations deleted due to missingness)
Multiple R-squared:  0.6995,    Adjusted R-squared:  0.6958 
F-statistic: 187.2 on 5 and 402 DF,  p-value: < 2.2e-16

Interpretación del nuevo modelo con transformación logaritmica y eliminación de atípicos: • se tiene un modelo con Mayor precisión: R² ajustado aumentó del 60.01% al 69.58%, indicando que el modelo ahora explica mejor la variabilidad del precio. • Estabilidad: El error estándar residual bajó considerablemente en escala log, lo que indica menos dispersión de los residuos y mayor estabilidad del modelo. • Área construida, estrato, parqueaderos y baños son claramente significativas (p<0.01). pero habitaciones sigue teniendo una significancia baja (p=0.061866), aunque mejora respecto al modelo anterior.

Evaluación de métricas

# Cargar librerías necesarias
library(Metrics)

# Verificar que no haya NA en los datos
base_sin_outliers_1 <- na.omit(base_sin_outliers)

# Predicciones del nuevo modelo en la escala logarítmica
predicciones_log_1 <- predict(modelo_sin_outliers, newdata = base_sin_outliers_1)

# Convertir las predicciones de logaritmo a escala original
predicciones_1 <- exp(predicciones_log_1)

# Valores reales del dataset
reales_1 <- base_sin_outliers_1$preciom

# Validación: Verificar si hay NA en predicciones o valores reales
if (any(is.na(predicciones_1)) || any(is.na(reales_1))) {
  cat("Error: Existen valores NA en las predicciones o en los valores reales. Verificar el dataset.\n")
} else {
  # Calcular métricas solo si no hay NA
  rmse_value_1 <- rmse(reales_1, predicciones_1)
  mae_value_1 <- mae(reales_1, predicciones_1)
  mape_value_1 <- mape(reales_1, predicciones_1)

  # Mostrar resultados
  cat("RMSE (Root Mean Squared Error) - Modelo 1:", rmse_value_1, "\n")
  cat("MAE (Mean Absolute Error) - Modelo 1:", mae_value_1, "\n")
  cat("MAPE (Mean Absolute Percentage Error) - Modelo 1:", mape_value_1, "\n")
}
RMSE (Root Mean Squared Error) - Modelo 1: 156.0373 
MAE (Mean Absolute Error) - Modelo 1: 103.16 
MAPE (Mean Absolute Percentage Error) - Modelo 1: 0.2034884

RMSE: promedio de error en la predicción en Millones 156.03

MAE: Media de los errores absolutos, promedio de la desviación de cada predicción

MAPE: En promedio el modelo comete un error de 20.34% al hacer una predicción.

Validación de supuestos:

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

library(lmtest)
bptest(modelo_sin_outliers)

    studentized Breusch-Pagan test

data:  modelo_sin_outliers
BP = 48.795, df = 5, p-value = 2.444e-09

Ahora, con el nuevo modelo ajustado vamos a predecir el precio de la vivienda con las siguientes caracteristicas:

  • Área costruida 200 metros
  • Parqueaderos 1
  • Baños 2
  • Habotaciones 4
  • Estrato 4 o 5
  • zona norte (El df ya está filtrado con Casas de la zona norte)
# Definir las características de la vivienda
nueva_vivienda <- data.frame(
  areaconst = 200,         # Área construida en m²
  estrato = 4.5,           # Promedio entre estrato 4 y 5
  habitaciones = 4,        # Número de habitaciones
  parqueaderos = 1,        # Número de parqueaderos
  banios = 2              # Número de baños
)

# Predecir el precio logarítmico
log_precio_predicho <- predict(modelo_sin_outliers, newdata = nueva_vivienda)

# Convertir de logaritmo a escala original
precio_predicho <- exp(log_precio_predicho)

# Imprimir el precio estimado
print(precio_predicho)
       1 
334.9359

El modelo estima un precio de $334,9 millones para la vivienda con las características de la primera solicitud. Este valor se encuentra dentro del rango del crédito preaprobado de $350 millones, lo que indica que el presupuesto asignado es acorde con la estimación del mercado según el modelo.

6. 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.

# Filtrar viviendas similares a la solicitud con precio ≤ 350 millones
ofertas_potenciales <- base1 %>%
  filter(
    areaconst >= 180 & areaconst <= 220,   # Rango cercano a 200 m²
    estrato >= 4 & estrato <= 5,           # Estrato 4 o 5
    parqueaderos >= 1,                      # 1 parqueadero
    banios >= 2,                            # 2 baños
    habitaciones >= 4,                     # 4 habitaciones
    preciom <= 334
    )

kable((ofertas_potenciales), caption = "Tabla 8 - Inmuebles potenciales")
Tabla 8 - Inmuebles potenciales
id zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo barrio longitud latitud
1343 Zona Norte 02 5 320 200 2 4 4 Casa la flora -76.51524 3.48893
1144 Zona Norte NA 4 320 200 2 4 4 Casa la merced -76.51156 3.48029
1151 Zona Norte NA 5 320 210 2 3 5 Casa urbanización la merced -76.51200 3.47600
1914 Zona Norte 02 5 300 205 2 5 6 Casa vipasa -76.51832 3.48138

Mapa 4 de las ofertas potenciales:

paleta_colores <- colorFactor(palette = "Set1", domain = data$preciom)
# Crear el mapa con colores según la zona
mapa_total_pot <- leaflet(ofertas_potenciales) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud, 
    popup = ~paste("ID:", id, "<br>Barrio:", barrio, "<br>Zona:", zona,"<br>Precio:", preciom,"<br>Estrato:", estrato,"<br>Parqueaderos:", parqueaderos,"<br>Baños:", banios,"<br>Habitaciones:", habitaciones),
    radius = 9,  # Tamaño del marcador
    color = ~paleta_colores(preciom),  # Asignar color según zona
    fillOpacity = 1, stroke = FALSE
  ) 

mapa_total_pot

Base 2: Apartamentos zona Sur

1 Realice un filtro a la base de datos e incluya solo las ofertas de : base 2: apartamentos, de la zona sur 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?).

library(dplyr)
library(knitr)
library(kableExtra)

# Filtrar la base de datos
base2 <- data %>% 
  filter(zona == "Zona Sur" & tipo == "Apartamento")


# Tabla 1: Muestra Base Casas Zona Norte
kable(head(base2,3), caption = "Tabla 9 - Muestra Base Apartamentos Zona Sur 2787 registros con 13 variables") %>%
  kable_styling(font_size = 10, full_width = FALSE) # Reducir tamaño
Tabla 9 - Muestra Base Apartamentos Zona Sur 2787 registros con 13 variables
id zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo barrio longitud latitud
5098 Zona Sur 05 4 290 96 1 2 3 Apartamento acopi -76.53464 3.44987
698 Zona Sur 02 3 78 40 1 1 2 Apartamento aguablanca -76.50100 3.40000
8199 Zona Sur NA 6 875 194 2 5 3 Apartamento aguacatal -76.55700 3.45900 
# Tabla 2: Número de casas en Zona Norte por Estrato
kable(table(base2$estrato, base2$zona), caption = "Tabla 10 - # de Apartamentos zona sur por estrato") %>%
  kable_styling(font_size = 10, full_width = FALSE) # Reducir tamaño
Tabla 10 - # de Apartamentos zona sur por estrato
Zona Sur
3 201
4 1091
5 1033
6 462

Mapa 5: Apartamentos zona Sur

mapa_zn2 <- leaflet(base2) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud, 
    popup = ~paste("ID:", id, "<br>Barrio:", barrio),
    radius = 5,  # Tamaño más pequeño del círculo
    color = "gray", fillOpacity = 0.6, stroke = FALSE
  )

mapa_zn2
library(leaflet)
library(RColorBrewer)

En el mapa se logra identificar que filtrando los apartamentos de la zona sur presenta errores, ya que arroja inmuebles en toca la ciudad (zonas diferentes a la zona sur). Hay dos posibilidades, que la base tenga un error en el registro de la zona o error en las coordenadas,

Al realizar el mapa con todas las zonas, se identifica el mismo error de registro de la ubicación geográfica o segmentación de la zona.

Mapa 6: Mapa de todas las zonas

# Definir una paleta de colores para las zonas
paleta_colores <- colorFactor(palette = "Set1", domain = data$zona)

# Crear el mapa con colores según la zona
mapa_total2 <- leaflet(data) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud, 
    popup = ~paste("ID:", id, "<br>Barrio:", barrio, "<br>Zona:", zona),
    radius = 5,  # Tamaño del marcador
    color = ~paleta_colores(zona),  # Asignar color según zona
    fillOpacity = 0.6, stroke = FALSE
  ) %>%
  addLegend("bottomright",  # Agregar leyenda
            pal = paleta_colores, 
            values = ~zona, 
            title = "Zona",
            opacity = 1)

mapa_total2

Se realiza una nueva segmentación de zona para cada inmueble usando el centroide de lat y lon de la zona y se obtiene: el 79% de los inmuebles se encuentran segmentados en la zona que corresponde

# Eliminar registros con NA en coordenadas
data_filtrada2 <- data %>%
  filter(!is.na(latitud) & !is.na(longitud))

# Calcular centroides por zona
centroides2 <- data_filtrada2 %>%
  group_by(zona) %>%
  summarise(
    latitud = mean(latitud, na.rm = TRUE), 
    longitud = mean(longitud, na.rm = TRUE)
  ) %>%
  ungroup()


# Aplicar KNN para encontrar la zona más cercana
knn_result2 <- get.knnx(centroides2[, c("longitud", "latitud")], 
                       data_filtrada2[, c("longitud", "latitud")], k = 1)

# Asignar la zona más cercana a cada punto
data_filtrada2$zona_corregida <- centroides2$zona[knn_result$nn.index]

# Verificar la corrección


kable(table(data_filtrada2$zona, data_filtrada2$zona_corregida), caption = "Tabla 11 - Validación de zona de cada inmueble") %>%
  kable_styling(font_size = 10, full_width = FALSE) # Reducir tamaño
Tabla 11 - Validación de zona de cada inmueble
Zona Centro Zona Norte Zona Oeste Zona Oriente Zona Sur
Zona Centro 96 6 12 8 2
Zona Norte 100 1439 126 63 192
Zona Oeste 81 44 1006 21 46
Zona Oriente 29 34 11 223 54
Zona Sur 390 102 279 154 3801

Mapa 7: Mapa todas las zonas corregido

library(leaflet)
library(RColorBrewer)

# Definir una paleta de colores para las zonas
paleta_colores <- colorFactor(palette = "Set3", domain = data$zona)

# Crear el mapa con colores según la zona
mapa_total_22 <- leaflet(data_filtrada) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud, 
    popup = ~paste("ID:", id, "<br>Barrio:", barrio, "<br>Zona:", zona),
    radius = 5,  # Tamaño del marcador
    color = ~paleta_colores(zona_corregida),  # Asignar color según zona
    fillOpacity = 0.6, stroke = FALSE
  ) %>%
  addLegend("bottomright",  # Agregar leyenda
            pal = paleta_colores, 
            values = ~zona, 
            title = "zona_corregida",
            opacity = 1)

mapa_total_22

2. 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.

library(tidyverse)


base2_clean <- base2 %>%
  dplyr::select(preciom, areaconst, estrato, banios, habitaciones, zona) %>%
  filter(complete.cases(.))  # Filtrar filas con valores NA

##str(base2)

analisis_base2 = summary(base2_clean)

knitr::kable(analisis_base2, caption = "Tabla 12 - Análisis generar las variable BASE2")
Tabla 12 - Análisis generar las variable BASE2
preciom areaconst estrato banios habitaciones zona
Min. : 75.0 Min. : 40.00 Min. :3.00 Min. :1.000 Min. :1.000 Length:2787
1st Qu.: 175.0 1st Qu.: 65.00 1st Qu.:4.00 1st Qu.:2.000 1st Qu.:3.000 Class :character
Median : 245.0 Median : 85.00 Median :5.00 Median :2.000 Median :3.000 Mode :character
Mean : 297.3 Mean : 97.47 Mean :4.63 Mean :2.493 Mean :2.974 NA
3rd Qu.: 335.0 3rd Qu.:110.00 3rd Qu.:5.00 3rd Qu.:3.000 3rd Qu.:3.000 NA
Max. :1750.0 Max. :932.00 Max. :6.00 Max. :8.000 Max. :6.000 NA 
# Calcular matriz de correlación
cor_matrix2 <- cor(base2_clean %>% dplyr::select(-zona))
cor_melt2 <- melt(cor_matrix2)

# Graficar matriz de correlación
ggplot(cor_melt2, aes(x=Var1, y=Var2, fill=value)) +
  geom_tile() +
  scale_fill_gradient2(low="blue", high="red", mid="white", midpoint=0, limit=c(-1,1)) +
  geom_text(aes(label=round(value, 2)), size=4, color="black") +  # Agregar valores de correlación
  labs(title="Gráfico 9: Matriz de Correlación entre Variables Base 2", x="", y="") +
  theme_minimal()

• La variable areaconst tiene la mayor correlación con preciom (0.76), lo que indica que el área construida es un factor clave para determinar el precio de una vivienda. • banios también muestra una correlación fuerte con el precio (0.72), lo que sugiere que el número de baños influye significativamente en el valor de la vivienda. • estrato presenta una correlación de 0.67 con el precio, lo cual es lógico, ya que un estrato más alto suele estar asociado con viviendas más costosas. • habitaciones tiene la correlación más baja con el precio (0.33), lo que indica que el número de habitaciones por sí solo no es un factor determinante en la variación del precio.

Entre las variables explicativas muestran una posible multicolinealidad, la fuerte correlación entre areaconst y banios (0.67) y entre areaconst y estrato (0.48) podría indicar un problema de multicolinealidad, que podría afectar la interpretación de los coeficientes en un modelo de regresión. Para confirmar esto adelante se relizará el calculo de factor de inflación de la varianza para cosiderar la elimnación de variables en la regresión

Con el analisis de correlaciones, se espera que el área construida, # número de baños y estrato sean los predictores más importantes y el # de habitaciones por el contrario parece no ser un predictor del precio.

p12 <- plot_ly(base2_clean, 
              x = ~areaconst, 
              y = ~preciom, 
              type = 'scatter', 
              mode = 'markers',
              marker = list(size = 8, opacity = 0.6),
              color = ~estrato  # Asignar color según estrato
              ) %>%
  layout(title = "Gráfico 10 - Precio vs Área Construida | Base 2",
         xaxis = list(title = "Área Construida (m²)"),
         yaxis = list(title = "Precio (millones)"),
         coloraxis = list(colorbar = list(title = "Estrato")))

p12

El gráfico de dispersión muestra la relación entre el precio de la vivienda y el área construida. Se observa una tendencia positiva, lo que indica que a mayor área construida, el precio de la vivienda tiende a aumentar. Sin embargo, hay cierta dispersión en los datos, especialmente en áreas grandes, lo que sugiere que otros factores también influyen en el precio.

Se identifican algunos valores atípicos, con viviendas de gran tamaño (más de 400 m²) que presentan precios muy variados. Esto puede deberse a diferencias en ubicación, estrato o características específicas de la vivienda.

En general, el área construida es un factor clave en la determinación del precio de una vivienda, pero no es el único determinante, por lo que vamos a complementar el análisis con las otras variables del data frame.

p22 <- plot_ly(base2_clean, x = ~factor(estrato), y = ~preciom, type = "box",
              boxpoints = "all", jitter = 0.3, pointpos = -1.8) %>%
  layout(title = "Gráfico 11 - Distribución del Precio según Estrato",
         xaxis = list(title = "Estrato"),
         yaxis = list(title = "Precio (millones)"))

p22

El gráfico de muestra una tendencia creciente del precio a medida que aumenta el estrato. Los estratos bajos la dispersión de precios es menor, y por el contrario en los estratos 5 y 6 la variabildad de los precios es alta en donde se presentan valores atípicos. En general, el gráfico confirma que el estrato es un factor importante en la determinación del precio de la vivienda, pero también sugiere que dentro de cada estrato puede haber una variabilidad significativa en los precios.

p32 <- plot_ly(base2_clean, x = ~factor(banios), y = ~preciom, type = "box",
              boxpoints = "all", jitter = 0.3, pointpos = -1.8) %>%
  layout(title = "Gráfico 12 - Distribución del Precio según Número de Baños",
         xaxis = list(title = "Número de Baños"),
         yaxis = list(title = "Precio (millones)"))

p32

Se observa una tendencia creciente, lo que indica que en general, las viviendas con más baños tienden a tener precios más altos. Se presentan datos atípicos en apartamentos con cero baños, lo cual en el contexto del mercado no es posoble, se ajustara este dato con la moda del número de baños del data set.

p42 <- plot_ly(base2_clean, x = ~factor(habitaciones), y = ~preciom, type = "box",
              boxpoints = "all", jitter = 0.3, pointpos = -1.8) %>%
  layout(title = "Gráfico 13 - Distribución del Precio según Número de Habitaciones",
         xaxis = list(title = "Número de Habitaciones"),
         yaxis = list(title = "Precio (millones)"))

p42

Se observa una tendencia creciente, donde las viviendas con más habitaciones tienden a tener precios más altos, aunque con una alta dispersión. Iagual que en la cantidad de baños, se presentan datos atípicos de apartamentos con cero habitaciones, lo cual no es posible en el contexto de información de viviendas.

p52 <- plot_ly(base2_clean, x = ~zona, y = ~preciom, type = "box",
              boxpoints = "all", jitter = 0.3, pointpos = -1.8) %>%
  layout(title = "Gráfico 14 - Distribución del Precio de la zona Sur | Apartamentos",
         xaxis = list(title = "Zona"),
         yaxis = list(title = "Precio (millones)"))

p52

La mediana del precio de los apartamentos en la Zona Sur se encuentra alrededor de los 245 millones de pesos. Se encuentra una alta dispersión en los precios, lleganto a tener precios deste $75 Millones hasta $1.750 Millones

3. 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 𝑅2 y discuta el ajuste del modelo e implicaciones (que podrían hacer para mejorarlo).

modelo2 <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = base2)
summary(modelo)

Call:
lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
    banios, data = base1)

Residuals:
    Min      1Q  Median      3Q     Max 
-778.36  -78.41  -15.27   47.44  975.91 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)    
(Intercept)  -236.12506   44.89427  -5.260 2.28e-07 ***
areaconst       0.67288    0.05308  12.676  < 2e-16 ***
estrato        79.35410    9.91122   8.006 1.12e-14 ***
habitaciones    6.88822    5.84516   1.178  0.23927    
parqueaderos   23.47716    5.88549   3.989 7.80e-05 ***
banios         21.27981    7.77805   2.736  0.00648 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 155 on 429 degrees of freedom
  (287 observations deleted due to missingness)
Multiple R-squared:  0.6047,    Adjusted R-squared:  0.6001 
F-statistic: 131.3 on 5 and 429 DF,  p-value: < 2.2e-16

El modelo representa el precio de la vivienda en funcion de: área construida, estrato, # de habitaciones, # de parqeuaderos y # de baños.

Interpretacion de coeficientes:

  • Intercepto(-236,12): No teiene interpretación en este caso, ya que representa el caso cuando todas las variables son cero, lo cual es imposible en este caso.
  • Área construida: (0.672) un aumento de 1m cuadrado en el área incrementa el precio en $672.880 Pesos
  • Estrato (79,35): por aumento en el estrato, el precio de la vivienda aumenta en aproximadamente 79,35 Millones
  • Habitaciones (6.88): Relación entre la cantidad de habitaciones, con Pr(>|t|) 0.23927, no es representativa en el modelo.
  • Parqueaderos (23,47): Un parqueadero adicional incrementa en 23,47 millones de pesos el precio. Además es una variables estadísticamente significativa.
  • Baños (21,27): Cada baño adicional aumenta el precio en 21,27 millones de pesos.

Evaluación del modelo:

  • R² = 0.6047 y R² ajustado = 0.6001. Esto indica que el modelo explica apriximadamente el 60,47% la variabilidad del precio de la vivienda.
  • F-statistic: 131.3 on 5 and 429 DF, p-value: < 2.2e-16: Indica que el modelo en su conjunto es estadísticamente significativo, es decir, al menos una de las variables predictoras tiene un impacto real en el precio de la vivienda.
kable(vif(modelo2), caption = "Tabla 12 - Analisis de multicolinealidad")
Tabla 12 - Analisis de multicolinealidad
x
areaconst 2.075598
estrato 1.547395
habitaciones 1.443419
parqueaderos 1.745440
banios 2.556087

Con el factor de inflación de la varianza podemos medir la colinealidad entre las variables predictoras, (< 5 no hay multicolinealidad, entre 5 y 10 multicolinealidad moderada, Mayor a 10 multicolinealidad alta). No existe mulsticolinealidad entre las variables predictoras, todos los valores de VIF están por debajo de 5.

¿Cómo Mejorar el Modelo?

  • Igual que en el caso anterior, hacer una transformación logarítminca al precio podría mejorar el modelo.

4. 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).

Linealidad:La relación entre las variables independientes y el precio debe ser linear

Normalidad de los residuos

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

- Residuos vs Valores Ajustados

Se espera que los residuos estén aleatoriamente distribuidos en torno a 0. Sin embargo, en este gráfico, se observa  que podría indicar heterocedasticidad (varianza de los residuos no constante).También hay algunos valores atípicos alejados de la concentración de datos.

En la prueba Breusch-Pagan p-value < 2.2e-16, valida que existe heterocedasticidad. Esto implica que la varianza de los errores no es constante, lo que puede afectar la eficiencia de los estimadores en el modelo de regresión.

library(lmtest)
bptest(modelo2)

    studentized Breusch-Pagan test

data:  modelo2
BP = 764.49, df = 5, p-value < 2.2e-16

Se podría aplicar una transformación logarítmica en la variable dependiente preciom

- Q-Q Plot de los residuos

Se espera que los puntos sigan la línea diagonal, sin embargo se puede observar una desviación en los extremos del gráfico, lo que nos lleva a concluir que los residuos no llevan una distribución normal

Segun el test shapiro p-value = < 2.2e-16 se rechaza normalidad de los residuos validando los resultados del gráfico

shapiro.test(modelo2$residuals)

    Shapiro-Wilk normality test

data:  modelo2$residuals
W = 0.79099, p-value < 2.2e-16

- Scale-Location

Este gráfico muestra si la varianza de los residuos es constante. Se observa una tendencia creciente de la línea roja, lo que demuestra que existe heterocedasticidad, la varianza aumenta a medida que los valores ajustados aumentan.

- Resudials vs Leverage

Este gráfico muestra algunos puntos que pueden influir en el modelo de regresión. En este caso, los puntos 977, 2569 y 2383 pueden ser atípicos que afectan la regresión. Puntos que podrían llegar a excluirse del modelo para evitar el impacto.

- Autocorrelación en los residuos

Durbin-Watson p-value < 2.2e-16. Como el p-valor es muy bajo, se rechaza la hipótesis nula de no autocorrelación y se confirma la presencia de autocorrelación positiva en los residuos.

library(lmtest)
dwtest(modelo2)

    Durbin-Watson test

data:  modelo2
DW = 1.5335, p-value < 2.2e-16
alternative hypothesis: true autocorrelation is greater than 0

5. Con el modelo identificado debe predecir el precio de la vivienda con las características de la primera solicitud.

Antes de predecir el precio de la vivienda con el modelo, vamos a hacer los cambios necesarios para que esté más ajustado.

El resultado de BoxCox sugiere realizar una transformación logarítmica al precio, con esto podemos lograr reducir la heterocedasticidad, mejorar la normalidad de los residuos y mejorar la precisión del modelo. Tabién podemos eliminar atípicos según lo visto en el gráfico de residuals vs leverage del punto anterior para lograr un modelo más ajustado.

Gráfico 15 Box Plot

library(MASS)
boxcox(modelo2)  # identifica la mejor transformación

# Calcular la distancia de Cook para identificar outliers
cook2 <- cooks.distance(modelo2)

# Identificar observaciones influenciales
influentes2 <- which(cook2 > (4/nrow(base2)))

# Eliminar los outliers
base_sin_outliers2 <- base2[-influentes2,]

# Ajustar nuevamente el modelo sin outliers
modelo_sin_outliers2 <- lm(log(preciom) ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
                          data = base_sin_outliers2)

# Verificar el modelo
summary(modelo_sin_outliers2)

Call:
lm(formula = log(preciom) ~ areaconst + estrato + habitaciones + 
    parqueaderos + banios, data = base_sin_outliers2)

Residuals:
     Min       1Q   Median       3Q      Max 
-2.01128 -0.14079  0.00621  0.14796  0.92227 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)    
(Intercept)   3.7849343  0.0377757 100.195   <2e-16 ***
areaconst     0.0024433  0.0001286  19.005   <2e-16 ***
estrato       0.2340313  0.0073258  31.946   <2e-16 ***
habitaciones -0.0195619  0.0095671  -2.045    0.041 *  
parqueaderos  0.1446076  0.0093968  15.389   <2e-16 ***
banios        0.1311939  0.0081743  16.050   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2247 on 2248 degrees of freedom
  (395 observations deleted due to missingness)
Multiple R-squared:  0.7795,    Adjusted R-squared:  0.779 
F-statistic:  1589 on 5 and 2248 DF,  p-value: < 2.2e-16

Evaluación de métricas

# Cargar librerías necesarias
library(Metrics)

# Verificar que no haya NA en los datos
base_sin_outliers2 <- na.omit(base_sin_outliers2)

# Predicciones del nuevo modelo en la escala logarítmica
predicciones_log_2 <- predict(modelo_sin_outliers2, newdata = base_sin_outliers2)

# Convertir las predicciones de logaritmo a escala original
predicciones_2 <- exp(predicciones_log_2)

# Valores reales del dataset
reales_2 <- base_sin_outliers2$preciom

# Validación: Verificar si hay NA en predicciones o valores reales
if (any(is.na(predicciones_2)) || any(is.na(reales_2))) {
  cat("Error: Existen valores NA en las predicciones o en los valores reales. Verificar el dataset.\n")
} else {
  # Calcular métricas solo si no hay NA
  rmse_value_2 <- rmse(reales_2, predicciones_2)
  mae_value_2 <- mae(reales_2, predicciones_2)
  mape_value_2 <- mape(reales_2, predicciones_2)

  # Mostrar resultados
  cat("RMSE (Root Mean Squared Error) - Modelo 2:", rmse_value_2, "\n")
  cat("MAE (Mean Absolute Error) - Modelo 2:", mae_value_2, "\n")
  cat("MAPE (Mean Absolute Percentage Error) - Modelo 2:", mape_value_2, "\n")
}
RMSE (Root Mean Squared Error) - Modelo 2: 94.92034 
MAE (Mean Absolute Error) - Modelo 2: 52.42158 
MAPE (Mean Absolute Percentage Error) - Modelo 2: 0.1744834

RMSE: promedio de error en la predicción en Millones 94.92

MAE: Media de los errores absolutos, promedio de la desviación de cada predicción

MAPE: En promedio el modelo comete un error de 17.44% al hacer una predicción.

Interpretaciónde modelo con transformación logaritmica y eliminación de atípicos: • Se tiene un modelo con Mayor precisión: R² ajustado aumentó al 77.9%, indicando que el modelo ahora explica mejor la variabilidad del precio. • Estabilidad: El error estándar residual bajó considerablemente en escala log, lo que indica menos dispersión de los residuos y mayor estabilidad del modelo. • Significancia de las variables: • Área construida, estrato, parqueaderos y baños son claramente significativas (p<0.01). pero habitaciones, nuevamante, sigue teniendo una significancia baja (p=0.041), aunque mejora respecto al modelo anterior.

Validación de supuestos:

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

library(lmtest)
bptest(modelo_sin_outliers2)

    studentized Breusch-Pagan test

data:  modelo_sin_outliers2
BP = 694.49, df = 5, p-value < 2.2e-16

Ahora, con el nuevo modelo ajustado vamos a predecir el precio de la vivienda con las siguientes caracteristicas:

  • Área costruida 300 metros
  • Parqueaderos 3
  • Baños 3
  • Habotaciones 5
  • Estrato 5 o 6
  • zona norte (El df ya está filtrado con Casas de la zona norte)
# Definir las características de la vivienda
nueva_vivienda2 <- data.frame(
  areaconst = 300,         # Área construida en m²
  estrato = 5.5,           # Promedio entre estrato 4 y 5
  habitaciones = 5,        # Número de habitaciones
  parqueaderos = 3,        # Número de parqueaderos
  banios = 3              # Número de baños
)

# Predecir el precio logarítmico
log_precio_predicho2 <- predict(modelo_sin_outliers2, newdata = nueva_vivienda2)

# Convertir de logaritmo a escala original
precio_predicho2 <- exp(log_precio_predicho2)

# Imprimir el precio estimado
print(precio_predicho2)
       1 
688.6163

El modelo estima un precio de $688,6 millones para la vivienda con las características de la segunda solicitud. Este valor se encuentra dentro del rango del crédito preaprobado de $850 millones, lo que indica que el presupuesto asignado es acorde con la estimación del mercado según el modelo.

6. 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.

# Filtrar viviendas similares a la solicitud con precio ≤ 350 millones
ofertas_potenciales2 <- base2 %>%
  filter(
    areaconst >= 250 ,   # Rango cercano a 200 m²
    estrato >= 5,           # Estrato 4 o 5
    parqueaderos >= 3,                      # 1 parqueadero
    banios >= 3,                            # 2 baños
    habitaciones >= 5,                     # 4 habitaciones
    preciom <= 692
    )

kable((ofertas_potenciales2), caption = "Tabla 13 - Inmuebles potenciales")
Tabla 13 - Inmuebles potenciales
id zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo barrio longitud latitud
7512 Zona Sur NA 5 670 300 3 5 6 Apartamento seminario -76.55000 3.40900
8036 Zona Sur NA 5 530 256 3 5 5 Apartamento seminario -76.55408 3.40748

Mapa 8: Ofertas potenciales:

paleta_colores <- colorFactor(palette = "Set1", domain = data$preciom)
# Crear el mapa con colores según la zona
mapa_total_pot2 <- leaflet(ofertas_potenciales2) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitud, lat = ~latitud, 
    popup = ~paste("ID:", id, "<br>Barrio:", barrio, "<br>Zona:", zona,"<br>Precio:", preciom,"<br>Estrato:", estrato,"<br>Parqueaderos:", parqueaderos,"<br>Baños:", banios,"<br>Habitaciones:", habitaciones),
    radius = 9,  # Tamaño del marcador
    color = ~paleta_colores(preciom),  # Asignar color según zona
    fillOpacity = 1, stroke = FALSE
  ) 

mapa_total_pot2