Introducción.

La empresa C&A (Casas y Apartamentos) fue fundada en la ciudad de Cali hace 10 años. En la actualidad las ventas de bienes raíces en la ciudad han visto una reducción a causa de condiciones del mercado que desincentivan la compra ce inmuebles en la ciudad. Se recibió una solicitud de una empresa para la compra de dos viviendas resaltando la siguiente información:

Características de las Viviendas

Características	Vivienda 1	Vivienda 2
Tipo	Casa	Apartamento
Área construida (m²)	200	300
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

#install.packages("devtools") # solo la primera vez
#devtools::install_github("centromagis/paqueteMODELOS", force =TRUE)
library(paqueteMODELOS)
data("vivienda")

Para dar solución a esta problemática se hará uso de un modelo de regresión Lineal Múltiple para las casas de la Zona Norte y para los apartamentos de la Zona Sur con el objetivo de elaborar recomendaciones de posibles opciones sobre las dos ofertas recibidas.

Tratamiento inicial de los datos.

En primer lugar se identificaron las variables disponibles en el conjunto de datos expresadas en la siguiente tabla :

Descripción de las Variables

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
longitud	Coordenada geográfica (longitud)
latitud	Coordenada geográfica (latitud)

Datos faltantes por variable

Primero, se identificaron los datos erróneos y los valores faltantes en el conjunto de datos, encontrando un total de tres valores incorrectos, así como 2.638 valores faltantes en la variable “piso” y 1.605 en “parqueaderos”. Además, se detectó la presencia de registros con inconsistencias, como viviendas sin habitaciones, baños ni parqueaderos.

library(tibble)
library(knitr)
library(kableExtra)

# Crear tabla sin nombres duplicados
df_info <- tibble(
  Columna = names(vivienda),
  Tipo = sapply(vivienda, function(x) paste(class(x), collapse = ", ")),
  DatosFaltantes = colSums(is.na(vivienda))
)

# Mostrar tabla con kable
kable(df_info, "html") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

Columna	Tipo	DatosFaltantes
id	numeric	3
zona	character	3
piso	character	2638
estrato	numeric	3
preciom	numeric	2
areaconst	numeric	3
parqueaderos	numeric	1605
banios	numeric	3
habitaciones	numeric	3
tipo	character	3
barrio	character	3
longitud	numeric	3
latitud	numeric	3

Eliminar filas con tres o mas valores faltantes.

Se eliminaron los valores faltantes y, mediante la librería mice, se analizaron los posibles patrones presentes en estos datos. Sin embargo, no se identificó ningún patrón específico en la distribución de los valores faltantes, lo que sugiere que estos podrían haberse producido de manera aleatoria.

# Contar los valores faltantes en cada fila
filas_con_muchos_na <- apply(vivienda, 1, function(x) sum(is.na(x)) > 3)

# Filtrar las filas que tienen 3 o menos valores faltantes
vivienda <- vivienda[!filas_con_muchos_na, ]

#install.packages("mice")
library(mice)
md.pattern(vivienda, rotate.names = TRUE)

##      id zona estrato preciom areaconst banios habitaciones tipo barrio longitud
## 4808  1    1       1       1         1      1            1    1      1        1
## 1909  1    1       1       1         1      1            1    1      1        1
## 876   1    1       1       1         1      1            1    1      1        1
## 726   1    1       1       1         1      1            1    1      1        1
##       0    0       0       0         0      0            0    0      0        0
##      latitud parqueaderos piso     
## 4808       1            1    1    0
## 1909       1            1    0    1
## 876        1            0    1    1
## 726        1            0    0    2
##            0         1602 2635 4237

Adicionalmente, se convirtió la variable estrato en un factor para facilitar el uso del modelo de regresión lineal múltiple , permitiendo un mejor manejo de las categorías socioeconómicas y asegurando que el modelo las trate como variables categóricas en lugar de numéricas.

library(dplyr)
vivienda <- vivienda %>% mutate(estrato = as.factor(estrato))

library(dplyr)
glimpse(vivienda)

## Rows: 8,319
## Columns: 13
## $ id           <dbl> 1147, 1169, 1350, 5992, 1212, 1724, 2326, 4386, 1209, 159…
## $ zona         <chr> "Zona Oriente", "Zona Oriente", "Zona Oriente", "Zona Sur…
## $ piso         <chr> NA, NA, NA, "02", "01", "01", "01", "01", "02", "02", "02…
## $ estrato      <fct> 3, 3, 3, 4, 5, 5, 4, 5, 5, 5, 6, 4, 5, 6, 4, 5, 5, 4, 5, …
## $ preciom      <dbl> 250, 320, 350, 400, 260, 240, 220, 310, 320, 780, 750, 62…
## $ areaconst    <dbl> 70, 120, 220, 280, 90, 87, 52, 137, 150, 380, 445, 355, 2…
## $ parqueaderos <dbl> 1, 1, 2, 3, 1, 1, 2, 2, 2, 2, NA, 3, 2, 2, 1, 4, 2, 2, 2,…
## $ banios       <dbl> 3, 2, 2, 5, 2, 3, 2, 3, 4, 3, 7, 5, 6, 2, 4, 4, 4, 3, 2, …
## $ habitaciones <dbl> 6, 3, 4, 3, 3, 3, 3, 4, 6, 3, 6, 5, 6, 2, 5, 5, 4, 3, 3, …
## $ tipo         <chr> "Casa", "Casa", "Casa", "Casa", "Apartamento", "Apartamen…
## $ barrio       <chr> "20 de julio", "20 de julio", "20 de julio", "3 de julio"…
## $ longitud     <dbl> -76.51168, -76.51237, -76.51537, -76.54000, -76.51350, -7…
## $ latitud      <dbl> 3.43382, 3.43369, 3.43566, 3.43500, 3.45891, 3.36971, 3.4…

Imputación de datos para valores faltantes.

La imputación de los valores faltantes y la corrección de las inconsistencias se llevó a cabo mediante el uso de la moda, segmentando los datos por tipo de vivienda y estrato. Esto permitió asignar a cada valor faltante la categoría más frecuente dentro de su grupo, asegurando una imputación coherente con las características del mercado inmobiliario y manteniendo la integridad de los datos.

#Buscar la moda por tipo de vivienda y estrato y reemplazar los valores faltantes y erroneos por esta.
library(dplyr)

# Función para calcular la moda
moda <- function(x) {
  ux <- unique(na.omit(x))  # Eliminar NA y obtener valores únicos
  ux[which.max(tabulate(match(x, ux)))]  # Devolver el valor más frecuente
}

# Convertir variables en formato númerico.
vivienda <- vivienda %>%
  mutate(
    piso = as.numeric(piso),
    banios = as.numeric(banios)
  )

# Calcular las modas por estrato y tipo
modas_calculadas <- vivienda %>%
  group_by(tipo, estrato) %>%
  summarise(
    moda_habitaciones = moda(habitaciones),
    moda_parqueaderos = moda(parqueaderos),
    moda_piso = moda(piso),
    moda_bano = moda(banios)
  )

# Reemplazar los valores faltantes y cero en el dataframe original

vivienda <- vivienda %>%
  left_join(modas_calculadas, by = c("tipo", "estrato")) %>%
  mutate(
    # Reemplazar NA en 'parqueaderos' y 'piso' por la moda.
    parqueaderos = ifelse(is.na(parqueaderos), moda_parqueaderos, parqueaderos),
    piso = ifelse(is.na(piso), moda_piso, piso),
    
    # Reemplazar 0 en 'habitaciones' y 'banios' por la moda.
    habitaciones = ifelse(habitaciones == 0, moda_habitaciones, habitaciones),
    banios = ifelse(banios == 0, moda_bano, banios)
  ) %>%
  select(-moda_habitaciones, -moda_parqueaderos, -moda_piso, -moda_bano)  # Eliminar columnas temporales

Caso 1: Casas Zona Norte

Filtro de casas de la Zona Norte.

En primer lugar, se realizó un filtro sobre las casas de la Zona Norte, arrojando un total de 722 registros para esta zona. Con el propósito de validar la ubicación de cada vivienda para las recomendaciones posteriores, se analizó la distribución geográfica de las propiedades mediante herramientas de visualización espacial, identificando posibles viviendas que tienen categória asignada de manera erronea

# Cargar librerías necesarias
library(dplyr)
library(kableExtra)

# Filtrar la base de datos para casas en la zona norte
base1 <- vivienda %>%
  filter(tipo == "Casa", zona == "Zona Norte")

# Mostrar los primeros 3 registros
head(base1, 5) %>%
  kable() %>%
  kable_styling(full_width = FALSE)

id	zona	piso	estrato	preciom	areaconst	parqueaderos	banios	habitaciones	tipo	barrio	longitud	latitud
1209	Zona Norte	2	5	320	150	2	4	6	Casa	acopi	-76.51341	3.47968
1592	Zona Norte	2	5	780	380	2	3	3	Casa	acopi	-76.51674	3.48721
4057	Zona Norte	2	6	750	445	2	7	6	Casa	acopi	-76.52950	3.38527
4460	Zona Norte	2	4	625	355	3	5	5	Casa	acopi	-76.53179	3.40590
6081	Zona Norte	2	5	750	237	2	6	6	Casa	acopi	-76.54044	3.36862

# Contar la cantidad de registros por tipo de vivienda en base1
base1 %>%
  count(tipo) %>%
  kable(col.names = c("Tipo de Vivienda", "Cantidad")) %>%
  kable_styling(full_width = FALSE)

Tipo de Vivienda	Cantidad
Casa	722

Mapa de distribución de las casas por coordenadas Zona Norte.

Como se observa en el mapa, existen algunas observaciones que no se encuentran dentro de la zona norte de la ciudad, y aunque la ciudad formalmente no tiene distinción de las distintas zonas, es pertinente realizar una revisión posterior de este aspecto al momento de generar recomendaciones para incurrir en errores al sugerir propiedades que no cumplan con los criterios geográficos establecidos por el cliente. Esta revisión permitirá asegurar la consistencia y precisión de las recomendaciones, alineándolas con las expectativas de ubicación y preferencias especificadas en la solicitud.

# Cargar librerías necesarias
library(leaflet)

# Crear el mapa con solo las ubicaciones
leaflet(base1) %>%
  addTiles() %>%
  addCircleMarkers(
    ~longitud, ~latitud,
    radius = 3,
    color = "blue",
    fill = TRUE,
    fillOpacity = 0.7
  )

Se realizó el filtro de casas de la zona norte, encontrando un total de 722 observaciones, al realizar el mapa se evidencia la presencia de distintas propiedades que a pesar de estar categorizadas como “Zona Norte” se encuentran en otras zonas de la ciudad.

# Cargar librerías necesarias
library(dplyr)
library(ggplot2)
library(plotly)
library(reshape2)

# Matriz de correlación para variables numéricas
cor_data <- base1 %>%
  select(preciom, areaconst, banios, habitaciones) %>%
  cor(use = "complete.obs")

# Convertir la matriz de correlación en formato largo
cor_data_melted <- melt(cor_data)

Matriz de correlación Casas Zona Norte.

En la matriz de correlación de las variables numéricas se observa una correlación positiva fuerte entre el precio y el área construida, con un coeficiente de correlación de 0.73, lo cual indica que a medida que aumenta el área construida, también tiende a incrementarse el precio de la vivienda. De igual manera, se aprecia una correlación positiva significativa entre el número de baños y el número de habitaciones, con un coeficiente de 0.6, lo que sugiere que las viviendas con más habitaciones suelen contar con un mayor número de baños.

Además, se identifican correlaciones positivas moderadas, destacándose la relación entre el precio y el número de baños, con un coeficiente de 0.56, indicando que un mayor número de baños podría asociarse con viviendas de mayor valor. Asimismo, la correlación entre el precio y el número de habitaciones, con un coeficiente de 0.37, sugiere que aunque la cantidad de habitaciones influye en el precio, su impacto es menos pronunciado en comparación con las demás variables analizadas.

# Gráfico de matriz de correlación con números encima

# Gráfico de matriz de correlación,
heatmap_plot <- ggplot(cor_data_melted, aes(Var1, Var2, fill = value)) +
  geom_tile() +
  geom_text(aes(label = round(value, 2)), color = "black", size = 3) +
  scale_fill_gradient2(low = "green", high = "red", midpoint = 0) +
  theme_minimal() +
  ggtitle("Matriz de Correlación") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

ggplotly(heatmap_plot)

Gráfico de dispersión precio vs área Casas Zona Norte.

Este gráfico muestra la relación entre el precio de propiedades y su área construida en metros cuadrados sugiriendo una fuerte correlación positiva entre el precio y el área construida: a medida que aumenta el área construida, el precio de la propiedad también tiende a aumentar.

scatter_plot <- ggplot(base1, aes(x = areaconst, y = preciom)) +
  geom_point(aes(color = zona), alpha = 0.7) +
  geom_smooth(method = "lm", col = "red") +
  theme_minimal() +
  labs(title = "Precio vs Área Construida",
       x = "Área Construida (m²)", y = "Precio (millones)")

ggplotly(scatter_plot)

Boxplot de precios por estrato Casas Zona Norte.

En el gráfico se observa una tendencia ascendente en los precios medianos a medida que aumenta el estrato. Esto sugiere que, en general, las propiedades en estratos socioeconómicos más altos tienden a tener precios más altos. La dispersión de los precios también parece aumentar con el estrato, lo que indica una mayor variabilidad en los precios de las propiedades en los estratos más altos.Los valores atípicos representan propiedades con precios significativamente diferentes del resto de las propiedades en su estrato, los cuales podrían ser propiedades de lujo o propiedades con características únicas que influyen en su precio.

library(plotly)

boxplot_estrato <- ggplot(base1, aes(x = as.factor(estrato), y = preciom, fill = as.factor(estrato))) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "Distribución de Precios por Estrato",
       x = "Estrato", y = "Precio")+
  scale_fill_discrete(name = "Estrato")

ggplotly(boxplot_estrato)

Boxplot de área por estrato Casas Zona Norte.

En el Boxplot se observa que generalmente un aumento en el área construida mediana a medida que aumenta el estrato, aunque en menor medida en relación a los precios. Esto sugiere que, en promedio, las propiedades en estratos socioeconómicos más altos tienden a tener áreas construidas ligeramente mayores. Sin embargo, la superposición entre las cajas indica que existen propiedades de diferentes tamaños en todos los estratos.

La dispersión del área construida también parece aumentar con el estrato, lo que indica una mayor variabilidad en el tamaño de las propiedades en los estratos más altos. Esto podría deberse a la presencia de propiedades más grandes y lujosas en estos estrato

boxplot_estrato <- ggplot(base1, aes(x = as.factor(estrato), y = areaconst, fill = as.factor(estrato))) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "Distribución de área por Estrato",
       x = "Estrato", y = "Área m2")+
  scale_fill_discrete(name = "Estrato")

ggplotly(boxplot_estrato)

Violinplot de precios y áreas Casas Zona Norte.

El gráfico de violín muestra la distribución de precios y tamaños de propiedades en la Zona Norte. En este caso se observa una concentración de áreas entre los 100 y 250 metros cuadrados, mientras que en los precios por metro cuadrado se concentran en el rango de 1.500.000 COP y 3.000.000 COP.Es importante mencionar que en este caso los precios por metro cuadrado se encuentran en una escala de 10.000, lo cual es útil para realizar las posteriores interpretaciones.

library(ggplot2)
library(plotly)

# Gráfico de violín para 'preciom' por 'zona'
violin_preciom <- ggplot(base1, aes(x = zona, y = preciom, fill = zona)) +
  geom_violin(trim = FALSE, alpha = 0.7) +
  theme_minimal() +
  labs(title = "Distribución de Precios por Zona (Violín)",
       x = "Zona", y = "Precio") +
  theme(legend.position = "none")

# Gráfico de violín para 'areaconst' por 'zona'
violin_areaconst <- ggplot(base1, aes(x = zona, y = areaconst, fill = zona)) +
  geom_violin(trim = FALSE, alpha = 0.7) +
  theme_minimal() +
  labs(title = "Distribución de Precio y Área Construida por Zona (Violín)",
       x = "Zona", y = "Área Construida (m²)") +
  theme(legend.position = "none")

# Organizar los gráficos uno al lado del otro usando subplot
subplot(ggplotly(violin_preciom), ggplotly(violin_areaconst), 
        nrows = 1, shareX = FALSE, shareY = FALSE, titleX = TRUE, titleY = TRUE)

Modelo 1- Casas Zona Norte.

En primer lugar, se estimará el modelo de regresión lineal múltiple teniendo en cuenta las siguientes variables: área construida, estrato, número de cuartos, número de parqueaderos, número de baños. Este modelo tiene como objetivo principal determinar cómo estas variables influyen en el precio de las propiedades (preciom) y cuantificar la relación específica entre cada una de ellas y el precio.

Para garantizar la robustez y la capacidad de generalización del modelo a nuevos datos, se empleará un enfoque de validación cruzada con 10 folds. Este método consiste en dividir el conjunto de datos en 10 subconjuntos o particiones aproximadamente del mismo tamaño. Durante cada iteración, el modelo se entrena utilizando 9 de estos subconjuntos y se evalúa con el subconjunto restante. Este proceso se repite 10 veces, cambiando el subconjunto de validación en cada ocasión, lo que permite que cada partición se utilice tanto para el entrenamiento como para la validación. Al final, se promedian los resultados de cada iteración para obtener una métrica más confiable del rendimiento del modelo.

El objetivo final es obtener un modelo sólido y preciso que permita predecir con exactitud el precio de las propiedades basándose en las variables seleccionadas, minimizando el riesgo de sobreajuste y mejorando la capacidad de predicción en datos nuevos.

# Cargar librerías necesarias
library(dplyr)
library(caret)

# Definir número de folds para validación cruzada
set.seed(123)  # Para reproducibilidad
control <- trainControl(method = "cv", number = 10)  # 10-fold cross-validation

# Ajustar el modelo con validación cruzada
modelo_cv <- train(
  preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base1, 
  method = "lm", 
  trControl = control
)

# Obtener el modelo final ajustado
modelo <- modelo_cv$finalModel

# Obtener el resumen del modelo final
#summary(modelo)
#print(modelo_cv)

Coeficientes del modelo.

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

# Obtener el resumen del modelo final
summary_modelo <- summary(modelo)

# Convertir los coeficientes en un data frame para usar kableExtra
coeficientes <- as.data.frame(summary_modelo$coefficients)
colnames(coeficientes) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")


#Tabla con KableExtra

coeficientes %>%
  kable("html", caption = "<center>Resumen de Coeficientes del Modelo Lineal</center>") %>%
  kable_styling(
    full_width = F, 
    bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
    position = "center" )

Resumen de Coeficientes del Modelo Lineal
	Estimación	Error Estándar	Valor t	Pr(>\|t\|)
(Intercept)	10.1161217	18.710312	0.5406709	0.5889030
areaconst	0.7875916	0.044162	17.8341611	0.0000000
estrato4	78.9334438	17.260798	4.5729893	0.0000057
estrato5	127.6976216	16.855092	7.5762046	0.0000000
estrato6	318.0577184	26.916842	11.8163090	0.0000000
habitaciones	3.6524870	4.640782	0.7870413	0.4315189
parqueaderos	13.6325480	5.500670	2.4783433	0.0134295
banios	26.6256389	5.770532	4.6140698	0.0000047

Interpretación de los Coeficientes del Modelo Lineal

Variable	Interpretación
(Intercept)	El intercepto es 10.12, pero no es estadísticamente significativo (p = 0.589), lo que indica que el valor base del precio por metro cuadrado (en múltiplos de 10,000) cuando todas las demás variables son cero no tiene un impacto claro en el modelo.
areaconst	Coeficiente de 0.79 (p < 0.001). Cada metro cuadrado adicional de área construida se asocia con un aumento de 7,900 COP por metro cuadrado en el precio, dado que “preciom” está en múltiplos de 10,000.
estrato4	Coeficiente de 78.93 (p < 0.001). Las viviendas en estrato 4 tienen un precio por metro cuadrado 789,300 COP mayor que las del estrato 3 (categoría de referencia).
estrato5	Coeficiente de 127.70 (p < 0.001). Las viviendas en estrato 5 tienen un precio por metro cuadrado 1,277,000 COP mayor que las del estrato 3.
estrato6	Coeficiente de 318.06 (p < 0.001). Las viviendas en estrato 6 tienen un precio por metro cuadrado 3,180,600 COP mayor que las del estrato 3.
habitaciones	Coeficiente de 3.65 (p = 0.432). No es estadísticamente significativo, lo que sugiere que el número de habitaciones no tiene un efecto claro en el precio por metro cuadrado.
parqueaderos	Coeficiente de 13.63 (p = 0.013). Cada parqueadero adicional se asocia con un aumento de 136,300 COP por metro cuadrado en el precio.
banios	Coeficiente de 26.63 (p < 0.001). Cada baño adicional incrementa el precio por metro cuadrado en 266,300 COP.

Métricas del modelo 1.

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

# Extraer las métricas del modelo
r2 <- summary(modelo)$r.squared
r2_ajustado <- summary(modelo)$adj.r.squared
f_statistic <- summary(modelo)$fstatistic[1]
df1 <- summary(modelo)$fstatistic[2]
df2 <- summary(modelo)$fstatistic[3]
p_value <- pf(f_statistic, df1, df2, lower.tail = FALSE)

# Crear un data frame con las métricas
metricas <- data.frame(
  Métrica = c("R²", "R² Ajustado", "Estadístico F", "Grados de Libertad", "Valor p"),
  Valor = c(round(r2, 4), round(r2_ajustado, 4), round(f_statistic, 1), 
            paste(df1, "y", df2), format.pval(p_value, digits = 3))
)

# Crear la tabla con kableExtra
tabla_metricas <- metricas %>%
  kable("html", caption = "Métricas del Modelo Lineal") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

# Mostrar la tabla
tabla_metricas

Métricas del Modelo Lineal
Métrica	Valor
R²	0.6672
R² Ajustado	0.664
Estadístico F	204.5
Grados de Libertad	7 y 714
Valor p	<2e-16

A partir de las métricas del Modelo 2 se puede resaltar lo siguiente:

R² (0.7912): El coeficiente de determinación indica que aproximadamente el 79.12% de la variabilidad del precio por metro cuadrado (preciom) se explica mediante las variables predictoras del modelo (área construida, estrato, habitaciones, parqueaderos y baños). Este valor relativamente alto de R² sugiere que el modelo tiene un buen nivel de explicación respecto a la variable dependiente.
R² Ajustado (0.7907): Esta métrica ajusta el R² considerando el número de predictores del modelo. El hecho de que el R² ajustado sea muy cercano al R² original indica que las variables incluidas en el modelo son relevantes y que no se está sobreajustando el modelo con predictores innecesarios.
Estadístico F (1504.4): El estadístico F evalúa la significancia general del modelo. Un valor tan alto indica que el modelo con las variables predictoras actuales es significativamente mejor para predecir el precio por metro cuadrado que un modelo sin predictores (solo con el intercepto).
Grados de Libertad (7 y 2779): El primer valor (7) representa el número de predictores del modelo (incluyendo las categorías de variables dummy del estrato), mientras que el segundo valor (2779) corresponde al número de observaciones menos el número de parámetros estimados.
Valor p (<2e-16): Este valor extremadamente bajo indica que el modelo es altamente significativo. Existe una evidencia muy fuerte para rechazar la hipótesis nula de que las variables predictoras no tienen ningún efecto sobre el precio por metro cuadrado.

Validación de Supuestos del modelo de Regresion Lineal Multiple.

Homocedasticidad y Lineal

La gráfica muestra que el modelo lineal se ajusta razonablemente bien a los datos, como se indica por la distribución aleatoria de los residuos alrededor de cero. Sin embargo, la presencia de puntos dispersos en los extremos sugiere que se debe investigar más a fondo la posible heterocedasticidad y la presencia de outliers. Estos hallazgos podrían requerir ajustes en el modelo o en los datos para mejorar su rendimiento y precisión.

# Cargar librerías necesarias
library(ggplot2)

# Gráfico de residuos vs valores ajustados para el Modelo 2
ggplot(data = data.frame(fitted = fitted(modelo), residuals = residuals(modelo)),
       aes(x = fitted, y = residuals)) +
  geom_point(color = "blue", alpha = 0.5) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Residuos vs Valores Ajustados", 
       x = "Valores Ajustados", 
       y = "Residuos") +
  theme_minimal()

Prueba Breusch-Pagan.

La prueba de Breusch-Pagan arrojó un valor p extremadamente bajo (< 2.2e-16), lo que indica que el modelo no cumple con el supuesto de homocedasticidad. Esto significa que la varianza de los residuos no es constante a lo largo de los valores ajustados, lo que podría sesgar las inferencias estadísticas del modelo. Para abordar esta heterocedasticidad, se recomienda explorar transformaciones de las variables, evaluar la presencia de valores atípicos o influentes y considerar el uso de modelos con errores estándar robustos para obtener estimaciones más confiables.

# Cargar la librería necesaria
library(lmtest)

# Realizar la prueba de Breusch-Pagan para el Modelo 2
bptest(modelo)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo
## BP = 135.37, df = 7, p-value < 2.2e-16

Normalidad de los residuos.

El test de Shapiro-Wilk arrojó un valor p muy bajo (< 2.2e-16), lo que indica que los residuos del modelo no siguen una distribución normal. Esto significa que el supuesto de normalidad de los errores no se cumple. Para mitigar esta problemática se recomienda transformar la variable dependiente mediante funciones como logaritmos o raíces cuadradas para intentar normalizar los residuos. Al igual que el caso anterior es importante identificar y corregir posibles valores atípicos puesto que pueden distorsionar significativamente la distribución de los residuos.

# Histograma de los residuos del Modelo 2
ggplot(data = data.frame(residuals = residuals(modelo)),
       aes(x = residuals)) +
  geom_histogram(aes(y = ..density..), bins = 30, fill = "blue", alpha = 0.5) +
  geom_density(color = "red") +
  labs(title = "Distribución de los Residuos del Modelo 1", 
       x = "Residuos", 
       y = "Densidad") +
  theme_minimal()

# Prueba de normalidad de Shapiro-Wilk para el Modelo
shapiro.test(residuals(modelo))

## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(modelo)
## W = 0.82908, p-value < 2.2e-16

Autocorrelacion de los residuos.

La prueba de Durbin-Watson aplicada al Modelo arrojó un estadístico D-W de 1.71, con una autocorrelación de primer orden de 0.145 y un valor p de 0, lo que indica la presencia de autocorrelación positiva significativa en los residuos del modelo. Esto sugiere que los errores no son independientes, sino que tienden a estar correlacionados secuencialmente, violando el supuesto de independencia de los errores en la regresión lineal. Para abordar este problema, se recomienda considerar transformaciones de las variables, evaluar la inclusión de variables adicionales que capturen la dependencia temporal o espacial, o explorar el uso de modelos alternativos, como modelos de series de tiempo, modelos con errores correlacionados o la aplicación de errores estándar robustos.

# Cargar la librería necesaria
library(car)

# Prueba de Durbin-Watson para el Modelo 2
durbinWatsonTest(modelo)

##  lag Autocorrelation D-W Statistic p-value
##    1       0.1596712      1.680149       0
##  Alternative hypothesis: rho != 0

VIF Multicolinealidad del modelo.

Los valores de VIF presentados para las variables en el modelo de regresión lineal múltiple son relativamente bajos, todos ellos por debajo de 3. Esto sugiere que no hay evidencia significativa de multicolinealidad entre las variables predictoras incluidas en el modelo.

# Cargar librerías necesarias
library(car)
library(dplyr)
library(knitr)
library(kableExtra)

# Calcular el VIF para el Modelo 2
vif_values <- vif(modelo)
tabla_vif <- data.frame(Variable = names(vif_values), VIF = round(vif_values, 2))

# Mostrar la tabla con kableExtra
tabla_vif %>%
  kable("html", caption = "Factor de Inflación de la Varianza (VIF) - Modelo 2") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

Factor de Inflación de la Varianza (VIF) - Modelo 2
	Variable	VIF
areaconst	areaconst	1.62
estrato4	estrato4	1.54
estrato5	estrato5	1.99
estrato6	estrato6	1.52
habitaciones	habitaciones	1.79
parqueaderos	parqueaderos	1.32
banios	banios	2.14

Distancia de Cook.

Este gráfico muestra la Distancia de Cook para cada observación en un modelo de regresión. La mayoría de las observaciones tienen una Distancia de Cook cercana a cero, lo que indica que no tienen una influencia significativa en el modelo. Sin embargo, se observan varios puntos con una Distancia de Cook mucho mayor, con lo cual es pertinente realizar análisis detallado de estas observaciones dado su gran influencia.

# Cargar librerías necesarias
library(ggplot2)

# Calcular la distancia de Cook para el Modelo 2
cook <- cooks.distance(modelo)

# Convertir a un data frame para graficar
df_cook <- data.frame(Observacion = 1:length(cook), Cook = cook)

# Graficar la distancia de Cook
ggplot(df_cook, aes(x = Observacion, y = Cook)) +
  geom_point(color = "blue") +
  geom_hline(yintercept = 4 / length(cook), color = "red", linetype = "dashed") +
  labs(title = "Distancia de Cook", x = "Observación", y = "Distancia de Cook") +
  theme_minimal()+theme(plot.title = element_text(hjust = 0.5))

A continuación se listan los puntos identificados a partir de la distancia de Cook:

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

# Definir el umbral de influencia (4/n)
umbral <- 4 / length(cook)

# Crear un data frame con las observaciones y sus valores de Cook
df_cook <- data.frame(Observacion = 1:length(cook), Cook = cook)

# Filtrar las observaciones que superan el umbral
df_cook_influyente <- df_cook[df_cook$Cook > umbral, ]

# Ordenar de mayor a menor por la Distancia de Cook
df_cook_influyente <- df_cook_influyente[order(-df_cook_influyente$Cook), ]

# Extraer las observaciones influyentes en el mismo orden del dataset "vivienda"
vivienda_influyente <- base1[df_cook_influyente$Observacion, ]

# Agregar la Distancia de Cook como columna extra en el dataset filtrado
vivienda_influyente$Cook_Distance <- df_cook_influyente$Cook

# Mostrar el dataset con los puntos influyentes ordenados
print(vivienda_influyente)

## # A tibble: 51 × 14
##       id zona    piso estrato preciom areaconst parqueaderos banios habitaciones
##    <dbl> <chr>  <dbl> <fct>     <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
##  1   534 Zona …     3 3           370      1440            1      4           10
##  2  4349 Zona …     2 5           650      1188            4      6            6
##  3  4793 Zona …     2 4          1800       607            1      4            8
##  4  4542 Zona …     2 5          1400       265            2     10           10
##  5  3858 Zona …     2 4          1650       734            1      5           10
##  6  4564 Zona …     2 5          1940       734            3      8           10
##  7  4056 Zona …     1 5          1600       942            4      4           10
##  8  6143 Zona …     2 3          1100       500            1      8            5
##  9  5710 Zona …     2 5          1530       776            6      6           10
## 10  6068 Zona …     2 6          1600       730            2      7            5
## # ℹ 41 more rows
## # ℹ 5 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>,
## #   Cook_Distance <dbl>

Hat Values.

Los Hat Values, miden la influencia potencial de una observación en los coeficientes de regresión. A diferencia de la Distancia de Cook, que mide el impacto real de una observación en el modelo, los valores de apalancamiento miden cuánto podría influir una observación debido a su posición en el espacio de las variables predictoras. Los valores de apalancamiento varían entre 0 y 1, donde valores más altos indican un mayor apalancamiento.

En la gráfica se observan algunos puntos con valores de apalancamiento altos, algunos superando el umbral de 0.025 marcado por la línea roja discontinua. Estos puntos representan observaciones que se alejan del centroide de las variables predictoras y, por lo tanto, podrían tener un impacto desproporcionado en los coeficientes del modelo.Es importante revisarlos para determinar si son valores atípicos y de esta manera poder determinar su tratamiento.

# Obtener valores de apalancamiento
hat_values <- hatvalues(modelo)

# Convertir a un data frame
df_hat <- data.frame(Observacion = 1:length(hat_values), Hat = hat_values)

# Graficar valores de apalancamiento
ggplot(df_hat, aes(x = Observacion, y = Hat)) +
  geom_point(color = "blue") +
  geom_hline(yintercept = 2 * mean(hat_values), color = "red", linetype = "dashed") +
  labs(title = "Valores de Apalancamiento", x = "Observación", y = "Hat Values") +
  theme_minimal()+theme(plot.title = element_text(hjust = 0.5))

Gráficos de diagnostico de los supuestos del modelo.

El gráfico de “Residuals vs Fitted” permite evaluar la linealidad y la homocedasticidad del modelo. Una dispersión aleatoria de los residuos sin un patrón evidente es lo ideal, y en este caso, se observa dicha característica, aunque la presencia de algunos puntos atípicos podría indicar ligeras desviaciones respecto a la linealidad y la homocedasticidad.

El gráfico Q-Q se enfoca en la normalidad de los residuos, mostrando que, en general, estos siguen una distribución normal. Sin embargo, las desviaciones en las colas sugieren que la normalidad no se cumple de manera perfecta, probablemente debido a la influencia de algunos puntos problemáticos.

En cuanto al gráfico “Scale-Location”, su propósito es analizar la homocedasticidad. Una dispersión uniforme de la raíz cuadrada de los residuos estandarizados sugiere que la varianza es relativamente constante, aunque la presencia de ciertos puntos problemáticos podría afectar esta condición.

Por último, el gráfico “Residuals vs Leverage” es importante para identificar puntos con alta influencia (leverage) y posibles outliers. Este gráfico permite evaluar si dichos puntos tienen un impacto significativo en la robustez del modelo y si contribuyen al incumplimiento de los supuestos.

#Graficos de diagnostico de los supuestos del modelo.

# Configuración para los gráficos
par(mfrow = c(2, 2), mar = c(4, 4, 2, 1))  # Dividir la ventana gráfica en 2x2 y ajustar márgenes

# Graficar los diagnósticos del modelo
plot(modelo, which = 1, col = "blue")      # Residuals vs Fitted
plot(modelo, which = 2, col = "darkgreen") # Normal Q-Q
plot(modelo, which = 3, col = "purple")    # Scale-Location
plot(modelo, which = 5, col = "orange")    # Residuals vs Leverage

Modelo 2 - Casas Zona Norte (Sin influyentes ni atípicos).

En este caso se evaluará el modelo teniendo en cuenta la presencia de puntos influyentes y atípicos que puedan afectar la calidad de las predicciones y la validez de los supuestos del modelo de regresión lineal múltiple. Para ello, se utilizarán la Distancia de Cook y los residuos estandarizados para identificar estas observaciones problemáticas. Una vez identificadas, se eliminarán del conjunto de datos original y se ajustará un nuevo modelo con las mismas variables predictoras.

# Cargar librerías necesarias
library(dplyr)
library(broom)
library(caret)

# Definir número de folds para validación cruzada
set.seed(123)  # Para reproducibilidad
control <- trainControl(method = "cv", number = 10)  

# Ajustar el modelo con validación cruzada en el dataset original
modelo_cv <- train(
  preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base1, 
  method = "lm", 
  trControl = control
)

# Obtener el modelo final ajustado
modelo <- modelo_cv$finalModel

# Calcular la distancia de Cook
cook_distances <- cooks.distance(modelo)

# Calcular los residuos estandarizados
resid_estandarizados <- rstudent(modelo)

# Definir umbrales
umbral_cook <- 4 / length(cook_distances)  # Umbral estándar para la distancia de Cook
umbral_residuo <- 2  # Residuos estandarizados mayores a 2 en valor absoluto

# Identificar los puntos influyentes y atípicos
puntos_influyentes <- which(cook_distances > umbral_cook)
puntos_atipicos <- which(abs(resid_estandarizados) > umbral_residuo)

# Encontrar los puntos que son ambos (influyentes y atípicos)
puntos_a_eliminar <- intersect(puntos_influyentes, puntos_atipicos)

# Eliminar los puntos del dataset original
base1_clean <- base1[-puntos_a_eliminar, ]

# Ajustar un nuevo modelo sin los puntos influyentes y atípicos con validación cruzada
modelo_cv_clean <- train(
  preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base1_clean, 
  method = "lm", 
  trControl = control
)

# Obtener el modelo limpio ajustado
modelo2 <- modelo_cv_clean$finalModel

# Mostrar resúmenes de los modelos
#cat("Resumen del modelo original:\n")
#print(summary(modelo))

#cat("\nResumen del modelo sin puntos influyentes y atípicos:\n")
#print(summary(modelo2))

# Comparación gráfica de residuos
#par(mfrow = c(1, 2))

# Modelo original
#plot(cook_distances, resid_estandarizados, main = "Modelo Original", 
     #xlab = "Distancia de Cook", ylab = "Residuos Estandarizados", col = "blue", pch = 19)
#abline(h = c(-umbral_residuo, umbral_residuo), col = "red", lty = 2)
#abline(v = umbral_cook, col = "red", lty = 2)

# Modelo sin puntos influyentes y atípicos
#cook_clean <- cooks.distance(modelo2)
#resid_clean <- rstudent(modelo2)
#plot(cook_clean, resid_clean, main = "Modelo Sin Puntos Influyentes", 
#     xlab = "Distancia de Cook", ylab = "Residuos Estandarizados", col = "blue", pch = 19)
#abline(h = c(-umbral_residuo, umbral_residuo), col = "red", lty = 2)
#abline(v = umbral_cook, col = "red", lty = 2)

Coeficientes del modelo (Sin influyentes ni atípicos).

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

# Obtener el resumen del modelo final
summary_modelo2 <- summary(modelo2)

# Convertir los coeficientes en un data frame para usar kableExtra
coeficientes <- as.data.frame(summary_modelo2$coefficients)
colnames(coeficientes) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")

# Mostrar los coeficientes en una tabla con kableExtra
coeficientes %>%
  kable("html", caption = "Resumen de Coeficientes del Modelo Lineal") %>%
  kable_styling(
    full_width = FALSE, 
    bootstrap_options = c("striped", "hover", "condensed", "responsive"),
    position = "center"
  )

Resumen de Coeficientes del Modelo Lineal
	Estimación	Error Estándar	Valor t	Pr(>\|t\|)
(Intercept)	37.6284250	12.4765556	3.0159305	0.0026573
areaconst	0.7350479	0.0328252	22.3928069	0.0000000
estrato4	67.9101194	11.2234613	6.0507287	0.0000000
estrato5	110.2507845	11.0064194	10.0169529	0.0000000
estrato6	319.3372920	18.6003209	17.1683754	0.0000000
habitaciones	1.2762724	3.1004793	0.4116371	0.6807349
parqueaderos	14.6519032	3.6333720	4.0325910	0.0000614
banios	23.6244526	3.9781584	5.9385399	0.0000000

Interpretación de los Coeficientes del Modelo Lineal

Variable	Interpretación
(Intercept)	Coeficiente de 37.63 (p = 0.0027). El intercepto indica el precio base por metro cuadrado cuando todas las demás variables son cero, aunque no tiene una interpretación práctica directa en este contexto.
areaconst	Coeficiente de 0.74 (p < 0.001). Cada metro cuadrado adicional de área construida se asocia con un aumento de 7,350 COP por metro cuadrado en el precio, dado que “preciom” está en múltiplos de 10,000.
estrato4	Coeficiente de 67.91 (p < 0.001). Las viviendas en estrato 4 tienen un precio por metro cuadrado 679,100 COP mayor que las del estrato 3 (categoría de referencia).
estrato5	Coeficiente de 110.25 (p < 0.001). Las viviendas en estrato 5 tienen un precio por metro cuadrado 1,102,500 COP mayor que las del estrato 3.
estrato6	Coeficiente de 319.34 (p < 0.001). Las viviendas en estrato 6 tienen un precio por metro cuadrado 3,193,370 COP mayor que las del estrato 3.
habitaciones	Coeficiente de 1.28 (p = 0.6807). El efecto del número de habitaciones en el precio no es estadísticamente significativo, lo que sugiere que no influye de manera importante en el precio por metro cuadrado.
parqueaderos	Coeficiente de 14.65 (p < 0.001). Cada parqueadero adicional incrementa el precio por metro cuadrado en 146,500 COP, resaltando su impacto positivo en el valor de las viviendas.
banios	Coeficiente de 23.62 (p < 0.001). Cada baño adicional aumenta el precio por metro cuadrado en 236,200 COP, lo que refleja un efecto positivo en el valor de la propiedad.

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

# Extraer las métricas del modelo
r2 <- summary(modelo2)$r.squared
r2_ajustado <- summary(modelo2)$adj.r.squared
f_statistic <- summary(modelo2)$fstatistic[1]
df1 <- summary(modelo2)$fstatistic[2]
df2 <- summary(modelo2)$fstatistic[3]
p_value <- pf(f_statistic, df1, df2, lower.tail = FALSE)

# Crear un data frame con las métricas
metricas <- data.frame(
  Métrica = c("R²", "R² Ajustado", "Estadístico F", "Grados de Libertad", "Valor p"),
  Valor = c(round(r2, 4), round(r2_ajustado, 4), round(f_statistic, 1), 
            paste(df1, "y", df2), format.pval(p_value, digits = 3))
)

# Crear la tabla con kableExtra
tabla_metricas <- metricas %>%
  kable("html", caption = "Métricas del Modelo Lineal") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

# Mostrar la tabla
tabla_metricas

Métricas del Modelo Lineal
Métrica	Valor
R²	0.7867
R² Ajustado	0.7845
Estadístico F	358.7
Grados de Libertad	7 y 681
Valor p	<2e-16

R² ( 0.7867): El valor de R² es 0.7867, lo que significa que aproximadamente el 78.67% de la variabilidad en el precio por metro cuadrado puede explicarse por las variables independientes del modelo. Este es un valor alto, lo que sugiere un buen ajuste del modelo a los datos.
R² Ajustado (0.7845): El valor de R² ajustado es 0.7845, que tiene en cuenta el número de variables en el modelo. Dado que el número de variables no es excesivo, la diferencia entre R² y R² ajustado es pequeña, lo que indica que el modelo está bien ajustado sin ser sobreajustado.
Estadístico F (358.7): El estadístico F es muy alto (2798.4), lo que indica que el modelo en su conjunto es altamente significativo. Esto significa que al menos una de las variables independientes tiene un impacto significativo sobre el precio por metro cuadrado.
Grados de Libertad (7 y 681): Los grados de libertad corresponden al número de predictores (7) y al número de observaciones (681). Esto sugiere que el modelo tiene suficientes datos para hacer estimaciones confiables.
Valor p (<2e-16): El valor p es extremadamente pequeño (<2e-16), lo que indica que el modelo es estadísticamente significativo en su totalidad. Es decir, existe una relación significativa entre las variables independientes y el precio por metro cuadrado.

Validación de Supuestos del modelo de Regresion Lineal Multiple (Sin influyentes ni atípicos)

Homocedasticidad y Lineal (Sin influyentes ni atípicos).

En el gráfico, no se observan patrones claros en la distribución de los puntos, lo que sugiere que la varianza de los residuos podría ser constante (homocedasticidad). Sin embargo, para confirmar formalmente la presencia de homocedasticidad, se validará este supuesto mediante la prueba de hipótesis de Breusch-Pagan, la cual determinará si existe evidencia estadística suficiente para rechazar la hipótesis nula de homocedasticidad.

# Cargar librerías necesarias
library(ggplot2)

# Gráfico de residuos vs valores ajustados
ggplot(data = data.frame(fitted = fitted(modelo2), residuals = residuals(modelo2)),
       aes(x = fitted, y = residuals)) +
  geom_point(color = "blue", alpha = 0.5) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Residuos vs Valores Ajustados", x = "Valores Ajustados", y = "Residuos") +
  theme_minimal()+theme(plot.title = element_text(hjust = 0.5))

Prueba Breusch Pagan (Sin influyentes ni atípicos).

El test de Breusch-Pagan arrojó un valor p muy bajo (< 2.2e-16), lo que indica que no se cumple el supuesto de homocedasticidad en el modelo.

# Cargar la librería necesaria
library(lmtest)

# Realizar la prueba de Breusch-Pagan
bptest(modelo2)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo2
## BP = 109.24, df = 7, p-value < 2.2e-16

Normalidad de los residuos (Sin influyentes ni atípicos).

El test de Shapiro-Wilk arrojó un valor p muy bajo (< 3.19e-10), lo que indica que los residuos del modelo no siguen una distribución normal, aunque el valor de W sugiere que la distribción de los residuos se aleja ligeramente de una normal, mejorando un poco este supuesto respecto al caso anterior aunque aun no hay evidencia que sea normal.

# Histograma de los residuos
ggplot(data = data.frame(residuals = residuals(modelo2)),
       aes(x = residuals)) +
  geom_histogram(aes(y = ..density..), bins = 30, fill = "blue", alpha = 0.5) +
  geom_density(color = "red") +
  labs(title = "Distribución de los Residuos", x = "Residuos", y = "Densidad") +
  theme_minimal()

# Prueba de normalidad de Shapiro-Wilk
shapiro.test(residuals(modelo2))

## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(modelo2)
## W = 0.97193, p-value = 3.198e-10

Autocorrelacion de los residuos (Sin influyentes ni atípicos)

La prueba de Durbin-Watson arrojó un estadístico de 1.88, con un valor p mayor a 0.05 . Estos resultados indican que no presencia de autocorrelación en los residuos, a diferencia del primer caso.

# Cargar librería necesaria
library(car)

# Prueba de Durbin-Watson
durbinWatsonTest(modelo2)

##  lag Autocorrelation D-W Statistic p-value
##    1      0.05605569      1.887031   0.108
##  Alternative hypothesis: rho != 0

Correción de supuestos.

Dado que los supuestos no se cumplen en ambos casos, se llevarán a cabo diversas transformaciones en las variables de regresión con el objetivo de corregir los tres supuestos fundamentales del modelo. Para ello, se explorarán diferentes enfoques, como las transformaciones Log-Lin, Lin-Log y Log-Log.

Estas transformaciones permitirán ajustar mejor las relaciones no lineales, estabilizar la varianza de los errores (homocedasticidad) y aproximar la normalidad de los residuos, esperando mejorar la validez de las inferencias estadísticas y la robustez del modelo resultante.

# Cargar librerías necesarias
library(dplyr)
library(broom)
library(caret)

# Transformaciones logarítmicas necesarias
base1_clean <- base1_clean %>%
  mutate(
    log_preciom = log(preciom),
    log_areaconst = log(areaconst)
  )

# Definir número de folds para validación cruzada
set.seed(123)  # Para reproducibilidad
control <- trainControl(method = "cv", number = 10)  

# Modelo Lin-Lin
modelo_lin_lin <- train(
  preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base1_clean, 
  method = "lm", 
  trControl = control
)

# Modelo Log-Lin
modelo_log_lin <- train(
  log_preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base1_clean, 
  method = "lm", 
  trControl = control
)

# Modelo Lin-Log
modelo_lin_log <- train(
  preciom ~ log_areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base1_clean, 
  method = "lm", 
  trControl = control
)

# Modelo Log-Log
modelo_log_log <- train(
  log_preciom ~ log_areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base1_clean, 
  method = "lm", 
  trControl = control
)

# Obtener los modelos finales ajustados
modelo_lin_lin_final <- modelo_lin_lin$finalModel
modelo_log_lin_final <- modelo_log_lin$finalModel
modelo_lin_log_final <- modelo_lin_log$finalModel
modelo_log_log_final <- modelo_log_log$finalModel

# Mostrar resúmenes de los modelos
#cat("Modelo Lin-Lin:\n")
#print(summary(modelo_lin_lin_final))

#cat("\nModelo Log-Lin:\n")
#print(summary(modelo_log_lin_final))

#cat("\nModelo Lin-Log:\n")
#print(summary(modelo_lin_log_final))

#cat("\nModelo Log-Log:\n")
#print(summary(modelo_log_log_final))

Coeficientes de las transformaciones.

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

# Obtener el resumen de cada modelo
summary_modelo2 <- summary(modelo2)
summary_modelo_log_lin <- summary(modelo_log_lin_final)
summary_modelo_lin_log <- summary(modelo_lin_log_final)
summary_modelo_log_log <- summary(modelo_log_log_final)

# Convertir los coeficientes en un data frame para usar kableExtra
coef_modelo2 <- as.data.frame(summary_modelo2$coefficients)
coef_log_lin <- as.data.frame(summary_modelo_log_lin$coefficients)
coef_lin_log <- as.data.frame(summary_modelo_lin_log$coefficients)
coef_log_log <- as.data.frame(summary_modelo_log_log$coefficients)

# Cambiar los nombres de las columnas para mayor claridad
colnames(coef_modelo2) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")
colnames(coef_log_lin) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")
colnames(coef_lin_log) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")
colnames(coef_log_log) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")

# Mostrar los coeficientes de los modelos en tablas con kableExtra
coef_modelo2 %>%
  kable("html", caption = "<center>Resumen de Coeficientes del Modelo 2</center>") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"), position = "center")

Resumen de Coeficientes del Modelo 2
	Estimación	Error Estándar	Valor t	Pr(>\|t\|)
(Intercept)	37.6284250	12.4765556	3.0159305	0.0026573
areaconst	0.7350479	0.0328252	22.3928069	0.0000000
estrato4	67.9101194	11.2234613	6.0507287	0.0000000
estrato5	110.2507845	11.0064194	10.0169529	0.0000000
estrato6	319.3372920	18.6003209	17.1683754	0.0000000
habitaciones	1.2762724	3.1004793	0.4116371	0.6807349
parqueaderos	14.6519032	3.6333720	4.0325910	0.0000614
banios	23.6244526	3.9781584	5.9385399	0.0000000

coef_log_lin %>%
  kable("html", caption = "<center>Resumen de Coeficientes del Modelo Log-Lin</center>") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"), position = "center")

Resumen de Coeficientes del Modelo Log-Lin
	Estimación	Error Estándar	Valor t	Pr(>\|t\|)
(Intercept)	4.8511436	0.0310473	156.249886	0.0000000
areaconst	0.0014700	0.0000817	17.995978	0.0000000
estrato4	0.3300136	0.0279291	11.816133	0.0000000
estrato5	0.4473146	0.0273890	16.331921	0.0000000
estrato6	0.7473231	0.0462861	16.145751	0.0000000
habitaciones	0.0265784	0.0077154	3.444856	0.0006064
parqueaderos	0.0249241	0.0090415	2.756640	0.0059962
banios	0.0622947	0.0098995	6.292732	0.0000000

coef_lin_log %>%
  kable("html", caption = "<center>Resumen de Coeficientes del Modelo Lin-Log</center>") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"), position = "center")

Resumen de Coeficientes del Modelo Lin-Log
	Estimación	Error Estándar	Valor t	Pr(>\|t\|)
(Intercept)	-689.6049788	42.354017	-16.2819263	0.0000000
log_areaconst	171.4698835	9.458947	18.1277984	0.0000000
estrato4	47.2856223	12.449710	3.7981305	0.0001588
estrato5	94.4067224	12.424461	7.5984559	0.0000000
estrato6	321.2144492	20.365127	15.7727690	0.0000000
habitaciones	0.0198641	3.394723	0.0058515	0.9953329
parqueaderos	16.4466561	3.928020	4.1870096	0.0000320
banios	25.3951194	4.307880	5.8950389	0.0000000

coef_log_log %>%
  kable("html", caption = "<center>Resumen de Coeficientes del Modelo Log-Log</center>") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"), position = "center")

Resumen de Coeficientes del Modelo Log-Log
	Estimación	Error Estándar	Valor t	Pr(>\|t\|)
(Intercept)	3.0451680	0.0930504	32.726006	0.0000000
log_areaconst	0.4257638	0.0207810	20.488132	0.0000000
estrato4	0.2594230	0.0273516	9.484742	0.0000000
estrato5	0.3705187	0.0272961	13.574034	0.0000000
estrato6	0.6918540	0.0447415	15.463354	0.0000000
habitaciones	0.0164311	0.0074581	2.203117	0.0279206
parqueaderos	0.0252175	0.0086297	2.922171	0.0035912
banios	0.0587654	0.0094643	6.209186	0.0000000

Métricas de las transformaciones.

A continuación se muestra las métricas de todos las transformaciones realizadas, teniendo en cuenta que “modelo2” es el original.

El Modelo Log-Log es el más robusto, con el valor más alto de R² (0.8044) y R² ajustado (0.8024), lo que indica que explica mejor la variabilidad de la variable dependiente. Además, presenta el mayor estadístico F (400), lo que sugiere una relación fuerte entre las variables. Los otros modelos (Lin-Lin, Log-Lin y Lin-Log) tienen métricas más bajas, especialmente en R², aunque todos muestran valores p extremadamente bajos (<2e-16), lo que significa que las relaciones en todos los modelos son estadísticamente significativas.

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

# Extraer las métricas de cada modelo

# Modelo 2 (antes Modelo Lin-Lin)
r2_modelo2 <- summary(modelo2)$r.squared
r2_ajustado_modelo2 <- summary(modelo2)$adj.r.squared
f_statistic_modelo2 <- summary(modelo2)$fstatistic[1]
df1_modelo2 <- summary(modelo2)$fstatistic[2]
df2_modelo2 <- summary(modelo2)$fstatistic[3]
p_value_modelo2 <- pf(f_statistic_modelo2, df1_modelo2, df2_modelo2, lower.tail = FALSE)

# Modelo Log-Lin
r2_log_lin <- summary(modelo_log_lin_final)$r.squared
r2_ajustado_log_lin <- summary(modelo_log_lin_final)$adj.r.squared
f_statistic_log_lin <- summary(modelo_log_lin_final)$fstatistic[1]
df1_log_lin <- summary(modelo_log_lin_final)$fstatistic[2]
df2_log_lin <- summary(modelo_log_lin_final)$fstatistic[3]
p_value_log_lin <- pf(f_statistic_log_lin, df1_log_lin, df2_log_lin, lower.tail = FALSE)

# Modelo Lin-Log
r2_lin_log <- summary(modelo_lin_log_final)$r.squared
r2_ajustado_lin_log <- summary(modelo_lin_log_final)$adj.r.squared
f_statistic_lin_log <- summary(modelo_lin_log_final)$fstatistic[1]
df1_lin_log <- summary(modelo_lin_log_final)$fstatistic[2]
df2_lin_log <- summary(modelo_lin_log_final)$fstatistic[3]
p_value_lin_log <- pf(f_statistic_lin_log, df1_lin_log, df2_lin_log, lower.tail = FALSE)

# Modelo Log-Log
r2_log_log <- summary(modelo_log_log_final)$r.squared
r2_ajustado_log_log <- summary(modelo_log_log_final)$adj.r.squared
f_statistic_log_log <- summary(modelo_log_log_final)$fstatistic[1]
df1_log_log <- summary(modelo_log_log_final)$fstatistic[2]
df2_log_log <- summary(modelo_log_log_final)$fstatistic[3]
p_value_log_log <- pf(f_statistic_log_log, df1_log_log, df2_log_log, lower.tail = FALSE)

# Crear un data frame con las métricas de todos los modelos
metricas_modelo <- data.frame(
  Métrica = c("R²", "R² Ajustado", "Estadístico F", "Grados de Libertad", "Valor p"),
  `Modelo 2` = c(round(r2_modelo2, 4), round(r2_ajustado_modelo2, 4), round(f_statistic_modelo2, 1), 
                 paste(df1_modelo2, "y", df2_modelo2), format.pval(p_value_modelo2, digits = 3)),
  `Modelo Log-Lin` = c(round(r2_log_lin, 4), round(r2_ajustado_log_lin, 4), round(f_statistic_log_lin, 1), 
                       paste(df1_log_lin, "y", df2_log_lin), format.pval(p_value_log_lin, digits = 3)),
  `Modelo Lin-Log` = c(round(r2_lin_log, 4), round(r2_ajustado_lin_log, 4), round(f_statistic_lin_log, 1), 
                       paste(df1_lin_log, "y", df2_lin_log), format.pval(p_value_lin_log, digits = 3)),
  `Modelo Log-Log` = c(round(r2_log_log, 4), round(r2_ajustado_log_log, 4), round(f_statistic_log_log, 1), 
                       paste(df1_log_log, "y", df2_log_log), format.pval(p_value_log_log, digits = 3))
)

# Crear la tabla con kableExtra
tabla_metricas_modelos <- metricas_modelo %>%
  kable("html", caption = "<center>Métricas de Todos los Modelos</center>") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

# Mostrar la tabla
tabla_metricas_modelos

Métricas de Todos los Modelos
Métrica	Modelo.2	Modelo.Log.Lin	Modelo.Lin.Log	Modelo.Log.Log
R²	0.7867	0.7857	0.7502	0.8044
R² Ajustado	0.7845	0.7835	0.7476	0.8024
Estadístico F	358.7	356.7	292.1	400
Grados de Libertad	7 y 681	7 y 681	7 y 681	7 y 681
Valor p	<2e-16	<2e-16	<2e-16	<2e-16

Supuestos de los modelos realizados con las transformaciones.

A continuación se evalúan los supuestos de normalidad (Shapiro-Wilk), homocedasticidad (bptest) y autocorrelación (dwtest) para las transformaciones realizadas con el fin de verificar si contribuyen a mejorar los supuestos clave de la Regresión Lineal Múltiple.

library(lmtest)
library(dplyr)

# Función para realizar las pruebas y obtener los valores p
evaluar_supuestos <- function(modelo) {
  residuos <- residuals(modelo)
  
  # Normalidad de los residuos
  normalidad <- shapiro.test(residuos)$p.value
  
  # Homocedasticidad con el modelo completo
  homocedasticidad <- bptest(modelo)$p.value
  
  # Autocorrelación de los residuos con el modelo completo
  autocorrelacion <- dwtest(modelo)$p.value
  
  return(c(normalidad, homocedasticidad, autocorrelacion))
}

# Aplicar la función a cada modelo
resultados_modelo2 <- evaluar_supuestos(modelo2)
resultados_log_lin <- evaluar_supuestos(modelo_log_lin_final)
resultados_lin_log <- evaluar_supuestos(modelo_lin_log_final)
resultados_log_log <- evaluar_supuestos(modelo_log_log_final)

# Crear la tabla de resultados
tabla_resultados <- data.frame(
  Modelo = c("Modelo 2", "Log-Lineal", "Lineal-Log", "Log-Log"),
  Normalidad = c(resultados_modelo2[1], resultados_log_lin[1], resultados_lin_log[1], resultados_log_log[1]),
  Homocedasticidad = c(resultados_modelo2[2], resultados_log_lin[2], resultados_lin_log[2], resultados_log_log[2]),
  Autocorrelación = c(resultados_modelo2[3], resultados_log_lin[3], resultados_lin_log[3], resultados_log_log[3])
)

# Función para formatear los valores p a 5 decimales
formatear_p_valores <- function(x) {
  return(sprintf("%.5f", x))
}

# Aplicar el formateo a las columnas de valores p
tabla_resultados$Normalidad <- formatear_p_valores(tabla_resultados$Normalidad)
tabla_resultados$Homocedasticidad <- formatear_p_valores(tabla_resultados$Homocedasticidad)
tabla_resultados$Autocorrelación <- formatear_p_valores(tabla_resultados$Autocorrelación)

# Crear la tabla con kable
tabla_resultados %>%
  kable("html", caption = "<center>Pruebas de Supuestos Estadísticos por Modelo</center>", 
        col.names = c("Modelo", "Normalidad", "Homocedasticidad", "Autocorrelación")) %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"), position = "center")

Pruebas de Supuestos Estadísticos por Modelo
Modelo	Normalidad	Homocedasticidad	Autocorrelación
Modelo 2	0.00000	0.00000	0.06065
Log-Lineal	0.06620	0.06734	0.00000
Lineal-Log	0.00000	0.00000	0.16644
Log-Log	0.00324	0.12783	0.00004

A partir de la tabla anterior se resalta lo siguiente:

Modelo 2 (Lin-Lin)

Normalidad: El valor p es 0.00000, lo que indica que los residuos no siguen una distribución normal.
Homocedasticidad: El valor p es 0.00000, lo que indica heterocedasticidad (varianza no constante).
Autocorrelación: El valor p es 0.06065, lo que sugiere que no hay autocorrelación significativa en los residuos.

Modelo Log-Lineal

Normalidad: El valor p es 0.06620, lo que sugiere que los residuos se acercan a una distribución normal, aunque no se puede afirmar con total certeza.
Homocedasticidad: El valor p es 0.06734, lo que sugiere homocedasticidad (varianza constante).
Autocorrelación: El valor p es 0.00000, lo que indica la presencia de autocorrelación en los residuos.

Modelo Lineal-Log

Normalidad: El valor p es 0.00000, lo que indica que los residuos no siguen una distribución normal.
Homocedasticidad: El valor p es 0.00000, lo que indica heterocedasticidad.
Autocorrelación: El valor p es 0.16644, lo que sugiere que no hay autocorrelación significativa.

Modelo Log-Log

Normalidad: El valor p es 0.00324, lo que indica que los residuos no siguen una distribución normal.
Homocedasticidad: El valor p es 0.12783, lo que sugiere homocedasticidad.
Autocorrelación: El valor p es 0.00004, lo que indica la presencia de autocorrelación.

Ante esto dado que ninguna transformación cumple con los supuestos fundamentales es pertinente probar otras opciones como por ejemplo modelos no lineales.

Predicción del precio de las viviendas.

Para la predicción del precio de las viviendas se usará el modelo Log-Lin pues parece ser el mejor de los cuatro casos. Esto se debe a que muestra el valor p más alto para la prueba de normalidad (0.06620), lo que sugiere que sus residuos se aproximan más a una distribución normal en comparación con los otros modelos. Además, tiene un valor p relativamente alto para la homocedasticidad (0.06734), lo que indica que la varianza de los residuos es más constante en este modelo. Aunque muestra autocorrelación (valor p muy bajo), el cumplimiento relativo de los supuestos de normalidad y homocedasticidad lo hace preferible en este conjunto de datos.

library(dplyr)
library(knitr)
library(kableExtra)
library(scales)  # Para formato de pesos

# Crear las solicitudes con el factor bien definido
solicitud1 <- data.frame(
  areaconst = 200, 
  estrato3 = 0, 
  estrato4 = 1, 
  estrato5 = 0, 
  estrato6 = 0,
  parqueaderos = 1, 
  banios = 2, 
  habitaciones = 4
)

solicitud2 <- data.frame(
  areaconst = 200, 
  estrato3 = 0, 
  estrato4 = 0, 
  estrato5 = 1, 
  estrato6 = 0,
  parqueaderos = 1, 
  banios = 2, 
  habitaciones = 4
)

# Realizar las predicciones
prediccion1 <- predict(modelo_log_lin_final, newdata = solicitud1)
resultado1 <- exp(prediccion1) * 200 * 10000 # Aplicar exp()

prediccion2 <- predict(modelo_log_lin_final, newdata = solicitud2)
resultado2 <- exp(prediccion2) * 200 * 10000 # Aplicar exp()

# Crear la tabla de resultados
resultados <- data.frame(
  Solicitud = c("Solicitud 1", "Solicitud 2"),
  Predicción = c(resultado1, resultado2)
)

# Formatear las predicciones como pesos colombianos
resultados$Predicción <- dollar(resultados$Predicción, scale = 1, prefix = "$", big.mark = ".", decimal.mark = ",")

# Mostrar la tabla con kableExtra y formato de pesos
resultados %>%
  kable("html") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

Solicitud	Predicción
Solicitud 1	$616.543.125
Solicitud 2	$693.276.695

Recomendación de viviendas.

A continuación se presenta el mapa de las viviendas recomendadas, las cuales fueron elegidas teniendo en cuenta la restricción presupuestal del cliente. Es importante resaltar que, según la predicción hecha, una vivienda con esas características superaría ampliamente el presupuesto asignado, por lo cual las viviendas listadas fueron seleccionadas aplicando un filtro de precio máximo de 350 millones de pesos, y luego se ordenaron por similitud con la solicitud del cliente, priorizando el área construida y otros criterios como el número de habitaciones, baños y parqueaderos. Finalmente, se eligieron las viviendas que mejor se ajustaron a estas condiciones, garantizando así una selección óptima dentro de las limitaciones presupuestarias.

base1_clean <- base1_clean %>%
  mutate(
    estrato3 = ifelse(estrato == 3, 1, 0),
    estrato4 = ifelse(estrato == 4, 1, 0),
    estrato5 = ifelse(estrato == 5, 1, 0),
    estrato6 = ifelse(estrato == 6, 1, 0)
  )

Viviendas seleccionadas.

# Cargar las librerías necesarias
library(dplyr)
library(kableExtra)

# Crear la tabla con las viviendas seleccionadas
tabla_viviendas <- ofertas_filtradas %>%
  mutate(PrecioTotal = preciom * areaconst * 10000) %>%
  select(
    PrecioTotal,
    Área = areaconst,
    Estrato = estrato,
    Habitaciones = habitaciones,
    Parqueaderos = parqueaderos,
    Baños = banios,
    Longitud = longitud,
    Latitud = latitud
  ) %>%
  mutate(PrecioTotal = format(PrecioTotal, big.mark = ".", scientific = FALSE))

# Mostrar la tabla con kableExtra
tabla_viviendas %>%
  kable(
    caption = "<center>Tabla de Viviendas Seleccionadas</center>",
    col.names = c("Precio Total (COP)", "Área (m²)", "Estrato", "Habitaciones", 
                  "Parqueaderos", "Baños", "Longitud", "Latitud"),
    format = "html",
    align = "c"
  ) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed", "responsive"),
    full_width = FALSE,
    position = "center"
  )

Tabla de Viviendas Seleccionadas
Precio Total (COP)	Área (m²)	Estrato	Habitaciones	Parqueaderos	Baños	Longitud	Latitud
330.000.000	150	3	4	1	2	-76.53200	3.45200
296.000.000	160	3	5	1	2	-76.48800	3.47200
255.000.000	150	3	4	1	2	-76.48600	3.46800
270.000.000	150	3	4	1	2	-76.49575	3.47561
256.000.000	160	3	3	1	2	-76.54015	3.42681
315.000.000	180	3	3	1	2	-76.49500	3.46589
320.000.000	160	3	4	1	3	-76.49358	3.46639
184.000.000	160	3	3	1	1	-76.49929	3.47094

Caso 2. Apartamentos Zona Sur

Para este caso se realizó un filtro con los apartamentos de la zona sur con un total de 2.787 observaciones.

Filtro de Apartamentos Zona Sur

# Cargar librerías necesarias
library(dplyr)
library(kableExtra)

# Filtrar la base de datos para casas en la zona norte
base2 <- vivienda %>%
  filter(tipo == "Apartamento", zona == "Zona Sur")

# Mostrar los primeros 3 registros
head(base2, 5) %>%
  kable() %>%
  kable_styling(full_width = FALSE)

id	zona	piso	estrato	preciom	areaconst	parqueaderos	banios	habitaciones	tipo	barrio	longitud	latitud
5098	Zona Sur	5	4	290	96	1	2	3	Apartamento	acopi	-76.53464	3.44987
698	Zona Sur	2	3	78	40	1	1	2	Apartamento	aguablanca	-76.50100	3.40000
8199	Zona Sur	3	6	875	194	2	5	3	Apartamento	aguacatal	-76.55700	3.45900
1241	Zona Sur	5	3	135	117	1	2	3	Apartamento	alameda	-76.51400	3.44100
5370	Zona Sur	5	3	135	78	1	1	3	Apartamento	alameda	-76.53600	3.43600

# Contar la cantidad de registros por tipo de vivienda en base2
base2 %>%
  count(tipo) %>%
  kable(col.names = c("Tipo de Vivienda", "Cantidad")) %>%
  kable_styling(full_width = FALSE)

Tipo de Vivienda	Cantidad
Apartamento	2787

Mapa de distribución de apartamentos por coordenadas Zona Sur.

Al igual que con las casas de la zona norte, se evidencia la presencia de apartamentos en el norte de la ciudad, lo cual pudo haber sido causado por un error en la codificación de la variable al momento de crearla, es importante resaltar que la ciudad de Cali no tiene distinciones sobre las distintas zonas de manera oficial.

# Cargar librerías necesarias
library(leaflet)

# Crear el mapa con solo las ubicaciones
leaflet(base2) %>%
  addTiles() %>%
  addCircleMarkers(
    ~longitud, ~latitud,
    radius = 3,
    color = "blue",
    fill = TRUE,
    fillOpacity = 0.7
  )

El total de observaciones de apartamentos de la zona Sur es de 2.787

# Cargar librerías necesarias
library(dplyr)
library(ggplot2)
library(plotly)
library(reshape2)

# Matriz de correlación para variables numéricas
cor_data <- base2 %>%
  select(preciom, areaconst, banios, habitaciones) %>%
  cor(use = "complete.obs")

# Convertir la matriz de correlación en formato largo
cor_data_melted2 <- melt(cor_data)

Matriz de correlación Apartamentos Zona Sur.

La matriz de correlación muestra patrones significativos entre las variables analizadas. Se destaca una fuerte correlación positiva entre el precio (preciom) y el área construida (areaconst), con un coeficiente de 0.76, lo que sugiere que viviendas más grandes tienden a tener precios más elevados. Asimismo, se observa una correlación positiva considerable entre el número de baños (banios) y el área construida, con un coeficiente de 0.68, indicando que viviendas con mayor área suelen disponer de más baños. La relación entre el precio y el número de baños también muestra una correlación positiva notable de 0.73, lo que implica que un mayor número de baños está asociado con precios más altos. Por otro lado, la correlación entre el número de habitaciones (habitaciones) y el precio es la más débil, con un coeficiente de 0.35, aunque aún positiva, lo que indica que el impacto del numero de habitaciones en el precio es menor en relación a las otras variables.

# Gráfico de matriz de correlación,
heatmap_plot <- ggplot(cor_data_melted2, aes(Var1, Var2, fill = value)) +
  geom_tile() +
  geom_text(aes(label = round(value, 2)), color = "black", size = 3) +
  scale_fill_gradient2(low = "green", high = "red", midpoint = 0) +
  theme_minimal() +
  ggtitle("Matriz de Correlación") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

ggplotly(heatmap_plot)

Gráfico de dispersión precio vs área Apartamentos Zona Sur.

Este gráfico muestra la relación entre el precio por metro cuadrado de los apartamentos y su área construida sugiriendo una fuerte correlación positiva entre el precio y el área construida: a medida que aumenta el área construida, el precio de la propiedad también tiende a aumentar.

scatter_plot <- ggplot(base2, aes(x = areaconst, y = preciom)) +
  geom_point(aes(color = zona), alpha = 0.7) +
  geom_smooth(method = "lm", col = "red") +
  theme_minimal() +
  labs(title = "Precio vs Área Construida",
       x = "Área Construida (m²)", y = "Precio")

ggplotly(scatter_plot)

Boxplot de precios por estrato Apartamentos Zona Sur.

El gráfico muestra la distribución de precios de viviendas (Predio) según el estrato socio económico. Se observa claramente que a medida que aumenta el estrato, también aumenta significativamente el precio de las viviendas. Los estratos más bajos (3 y 4) presentan una distribución de precios más concentrada y baja, mientras que los estratos más altos (5 y 6) muestran una mayor dispersión y valores considerablemente más altos, con el estrato 6 destacando por tener los precios más elevados y una mayor variabilidad.

boxplot_estrato <- ggplot(base2, aes(x = as.factor(estrato), y = preciom, fill = as.factor(estrato))) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "Distribución de Precios por Estrato",
       x = "Estrato", y = "Precio")+
  scale_fill_discrete(name = "Estrato")

ggplotly(boxplot_estrato)

Boxplot de área por estrato Apartamentos Zona Sur.

El gráfico muestra la distribución del área construida (Área m2) según el estrato socioeconómico. Se observa que a medida que aumenta el estrato, también tiende a aumentar el área de las viviendas, aunque con mayor variabilidad. Los estratos más bajos (3 y 4) presentan áreas más pequeñas y concentradas, mientras que los estratos más altos (5 y 6) muestran una mayor dispersión y áreas significativamente mayores, especialmente en el estrato 6, que destaca por tener las viviendas más grandes y una mayor variabilidad en tamaño.

boxplot_estrato <- ggplot(base2, aes(x = as.factor(estrato), y = areaconst, fill = as.factor(estrato))) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "Distribución de área por Estrato",
       x = "Estrato", y = "Área m2")+
  scale_fill_discrete(name = "Estrato")

ggplotly(boxplot_estrato)

Violinplot de precios y áreas Apartamentos Zona Sur.

El gráfico de violín muestra la distribución del precio por metro cuadrado y el área construida de los apartamentos en la Zona Sur. Se observa que tanto el precio por metro cuadrado como el área construida tienden a concentrarse en rangos más bajos, con una distribución asimétrica hacia valores más altos. En el caso del precio por metro cuadrado, la mayor concentración se encuentra entre 1.000.000 y 2.000.000 por metro cuadrado. En cuanto al área construida, la concentración principal está por debajo de los 100 m², con una distribución que se extiende hacia áreas mayores. Esto sugiere que, en la Zona Sur, predominan los apartamentos con precios por metro cuadrado y áreas construidas más modestas, aunque también existen algunos apartamentos de mayor valor y tamaño.

library(ggplot2)
library(plotly)

# Gráfico de violín para 'preciom' por 'zona'
violin_preciom <- ggplot(base2, aes(x = zona, y = preciom, fill = zona)) +
  geom_violin(trim = FALSE, alpha = 0.7) +
  theme_minimal() +
  labs(title = "Distribución de Precios por Zona (Violín)",
       x = "Zona", y = "Precio") +
  theme(legend.position = "none")

# Gráfico de violín para 'areaconst' por 'zona'
violin_areaconst <- ggplot(base2, aes(x = zona, y = areaconst, fill = zona)) +
  geom_violin(trim = FALSE, alpha = 0.7) +
  theme_minimal() +
  labs(title = "Distribución de Precio y Área Construida",
       x = "Zona", y = "Área Construida (m²)") +
  theme(legend.position = "none")

# Organizar los gráficos uno al lado del otro usando subplot
subplot(ggplotly(violin_preciom), ggplotly(violin_areaconst), 
        nrows = 1, shareX = FALSE, shareY = FALSE, titleX = TRUE, titleY = TRUE)

Modelo 1 - Apartamentos Zona Sur.

Similar al análisis realizado con las casas, se construirá un modelo de regresión lineal múltiple para los apartamentos, utilizando las siguientes variables predictoras: área construida, estrato, número de habitaciones, número de parqueaderos y número de baños. El objetivo de este modelo es determinar la influencia de estas variables en el precio por metro cuadrado (preciom) de los apartamentos, y cuantificar la relación entre cada variable y el precio. Para garantizar la robustez del modelo y obtener predicciones precisas del precio de los apartamentos, se empleará la validación cruzada de 10 folds.

# Cargar librerías necesarias
library(dplyr)
library(caret)

# Definir número de folds para validación cruzada
set.seed(1234)  # Para reproducibilidad
control <- trainControl(method = "cv", number = 10)  # 10-fold cross-validation

# Ajustar el modelo con validación cruzada
modelo_cvcaso2 <- train(
  preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base2, 
  method = "lm", 
  trControl = control
)

# Obtener el modelo final ajustado
modelocaso2 <- modelo_cvcaso2$finalModel

# Obtener el resumen del modelo final
#summary(modelocaso2)
#print(modelo_cvcaso2)

Coeficientes del modelo.

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

# Obtener el resumen del modelo final
summary_modelocaso2 <- summary(modelocaso2)

# Convertir los coeficientes en un data frame para usar kableExtra
coeficientescaso2 <- as.data.frame(summary_modelocaso2$coefficients)
colnames(coeficientescaso2) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")

# Mostrar los coeficientes en una tabla con kableExtra
coeficientescaso2 %>%
  kable("html", caption = "Resumen de Coeficientes del Modelo Lineal") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

Resumen de Coeficientes del Modelo Lineal
	Estimación	Error Estándar	Valor t	Pr(>\|t\|)
(Intercept)	-41.37646	10.3323228	-4.004565	6.38e-05
areaconst	1.30635	0.0466262	28.017477	0.00e+00
estrato4	28.28496	6.8695124	4.117462	3.94e-05
estrato5	53.88307	7.0965210	7.592886	0.00e+00
estrato6	205.78092	8.9417555	23.013481	0.00e+00
habitaciones	-12.85797	3.2922286	-3.905553	9.62e-05
parqueaderos	61.64835	3.5588300	17.322644	0.00e+00
banios	40.36916	2.9354369	13.752353	0.00e+00

Interpretación de los Coeficientes del Modelo Lineal

Variable	Interpretación
(Intercept)	El intercepto es -41.38 (p < 0.001), lo que indica que cuando todas las variables predictoras son cero, el precio por metro cuadrado (en múltiplos de 10,000) sería negativo, lo cual no tiene un significado práctico real.
areaconst	Coeficiente de 1.31 (p < 0.001). Cada metro cuadrado adicional de área construida se asocia con un aumento de 13,060 COP por metro cuadrado en el precio, dado que “preciom” está en múltiplos de 10,000.
estrato4	Coeficiente de 28.28 (p < 0.001). Las viviendas en estrato 4 tienen un precio por metro cuadrado 282,800 COP mayor que las del estrato 3 (categoría de referencia).
estrato5	Coeficiente de 53.88 (p < 0.001). Las viviendas en estrato 5 tienen un precio por metro cuadrado 538,800 COP mayor que las del estrato 3.
estrato6	Coeficiente de 205.78 (p < 0.001). Las viviendas en estrato 6 tienen un precio por metro cuadrado 2,057,800 COP mayor que las del estrato 3.
habitaciones	Coeficiente de -12.86 (p < 0.001). Un aumento en el número de habitaciones se asocia con una disminución de 128,600 COP en el precio por metro cuadrado, lo cual podría indicar que más habitaciones no necesariamente implican mayor valor por área.
parqueaderos	Coeficiente de 61.65 (p < 0.001). Cada parqueadero adicional se asocia con un aumento de 616,500 COP por metro cuadrado en el precio.
banios	Coeficiente de 40.37 (p < 0.001). Cada baño adicional incrementa el precio por metro cuadrado en 403,700 COP.

Métricas del modelo.

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

# Extraer las métricas del modelo 'modelocaso2'
r2 <- summary(modelocaso2)$r.squared
r2_ajustado <- summary(modelocaso2)$adj.r.squared
f_statistic <- summary(modelocaso2)$fstatistic[1]
df1 <- summary(modelocaso2)$fstatistic[2]
df2 <- summary(modelocaso2)$fstatistic[3]
p_value <- pf(f_statistic, df1, df2, lower.tail = FALSE)

# Crear un data frame con las métricas
metricas <- data.frame(
  Métrica = c("R²", "R² Ajustado", "Estadístico F", "Grados de Libertad", "Valor p"),
  Valor = c(
    round(r2, 4), 
    round(r2_ajustado, 4), 
    round(f_statistic, 1), 
    paste(df1, "y", df2), 
    format.pval(p_value, digits = 3)
  )
)

# Crear la tabla con kableExtra
tabla_metricas <- metricas %>%
  kable("html", caption = "Métricas del Modelo 2") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

# Mostrar la tabla
tabla_metricas

Métricas del Modelo 2
Métrica	Valor
R²	0.7912
R² Ajustado	0.7907
Estadístico F	1504.4
Grados de Libertad	7 y 2779
Valor p	<2e-16

R² (0.7912): El modelo explica el 79.12% de la variabilidad del precio por metro cuadrado, indicando un buen ajuste.
R² Ajustado (0.7907): Muy cercano al R², lo que muestra que las variables incluidas son relevantes y no añaden complejidad innecesaria.
Estadístico F (1504.4): Indica que el modelo es significativamente mejor que uno sin predictores.
Grados de Libertad (7 y 2779): Reflejan el número de predictores y el tamaño de la muestra.
Valor p (<2e-16): El modelo es estadísticamente significativo, con al menos una variable independiente influyendo en el precio.

Validación de Supuestos del modelo de Regresion Lineal Multiple.

Homocedasticidad y Lineal

# Cargar librerías necesarias
library(ggplot2)

# Gráfico de residuos vs valores ajustados
ggplot(data = data.frame(fitted = fitted(modelocaso2), residuals = residuals(modelocaso2)),
       aes(x = fitted, y = residuals)) +
  geom_point(color = "blue", alpha = 0.5) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Residuos vs Valores Ajustados", x = "Valores Ajustados", y = "Residuos") +
  theme_minimal()

Prueba Breusch-Pagan.

El test de Breusch-Pagan arrojó un valor p muy bajo (< 2.2e-16), lo que indica que no se cumple el supuesto de homocedasticidad en el modelo.

# Cargar la librería necesaria
library(lmtest)

# Realizar la prueba de Breusch-Pagan para el Modelo 2
bptest(modelocaso2)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelocaso2
## BP = 813.23, df = 7, p-value < 2.2e-16

Normalidad de los residuos.

El test de Shapiro-Wilk evalúa la normalidad de los residuos del modelo. Un valor de W = 0.77514 cercano a 1 indicaría normalidad, pero aquí sugiere desviaciones importantes. El p-value < 2.2e-16 indica que se rechaza la hipótesis nula de normalidad, confirmando que los residuos no siguen una distribución normal.

# Histograma de los residuos
ggplot(data = data.frame(residuals = residuals(modelocaso2)),
       aes(x = residuals)) +
  geom_histogram(aes(y = ..density..), bins = 30, fill = "blue", alpha = 0.5) +
  geom_density(color = "red") +
  labs(title = "Distribución de los Residuos", x = "Residuos", y = "Densidad") +
  theme_minimal()

# Prueba de normalidad de Shapiro-Wilk
shapiro.test(residuals(modelocaso2))

## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(modelocaso2)
## W = 0.77514, p-value < 2.2e-16

Autocorrelacion residuos.

El análisis de autocorrelación muestra un valor de rho = 0.1454, indicando una ligera autocorrelación en los residuos. El estadístico de Durbin-Watson (D-W = 1.7059) se acerca a 2, lo que sugiere una baja autocorrelación. Sin embargo, el p-value = 0 lleva a rechazar la hipótesis nula de ausencia de autocorrelación, indicando una posible dependencia en los residuos.

# Cargar librería necesaria
library(car)

# Prueba de Durbin-Watson
durbinWatsonTest(modelocaso2)

##  lag Autocorrelation D-W Statistic p-value
##    1       0.1454317      1.705874       0
##  Alternative hypothesis: rho != 0

VIF Multicolinealidad.

# Cargar librerías necesarias
library(car)
library(dplyr)
library(knitr)
library(kableExtra)

# Calcular el VIF
vif_values <- vif(modelocaso2)
tabla_vif <- data.frame(Variable = names(vif_values), VIF = round(vif_values, 2))

# Mostrar la tabla con kableExtra
tabla_vif %>%
  kable("html", caption = "Factor de Inflación de la Varianza (VIF)") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

Factor de Inflación de la Varianza (VIF)
	Variable	VIF
areaconst	areaconst	2.18
estrato4	estrato4	4.08
estrato5	estrato5	4.26
estrato6	estrato6	4.01
habitaciones	habitaciones	1.47
parqueaderos	parqueaderos	1.86
banios	banios	2.69

Distancia de Cook.

La distancia de Cook evalúa cuánto cambiarían los coeficientes del modelo si se eliminara una observación en particular, combinando la discrepancia entre los valores ajustados y observados con la influencia de cada punto en los parámetros del modelo. Valores altos de la distancia de Cook indican que una observación tiene un impacto significativo en la estimación del modelo y podría ser un posible outlier o un punto con gran influencia, por lo cual deben analizarse con mayor detalle.

# Cargar librerías necesarias
library(ggplot2)

# Calcular la distancia de Cook para el Modelo 2
cook2 <- cooks.distance(modelocaso2)

# Convertir a un data frame para graficar
df_cook2 <- data.frame(Observacion = 1:length(cook), Cook = cook)

# Graficar la distancia de Cook
ggplot(df_cook, aes(x = Observacion, y = Cook)) +
  geom_point(color = "blue", alpha = 0.6) +
  geom_hline(yintercept = 4 / length(cook), color = "red", linetype = "dashed") +
  labs(title = "Distancia de Cook", x = "Observación", y = "Distancia de Cook") +
  theme_minimal()+theme(plot.title = element_text(hjust = 0.5))

# Calcular la distancia de Cook para el Modelo 2
cook <- cooks.distance(modelocaso2)

# Definir el umbral de influencia (4/n)
umbral <- 4 / length(cook)

# Crear un data frame con las observaciones y sus valores de Cook
df_cook <- data.frame(Observacion = 1:length(cook), Cook = cook)

# Filtrar las observaciones que superan el umbral
df_cook_influyente <- df_cook[df_cook$Cook > umbral, ]

# Ordenar de mayor a menor por la Distancia de Cook
df_cook_influyente <- df_cook_influyente[order(-df_cook_influyente$Cook), ]

# Extraer las observaciones influyentes en el mismo orden del dataset "base2"
base2_influyente <- base2[df_cook_influyente$Observacion, ]

# Agregar la Distancia de Cook como columna extra en el dataset filtrado
base2_influyente$Cook_Distance <- df_cook_influyente$Cook

# Mostrar el dataset con los puntos influyentes ordenados
print(base2_influyente)

## # A tibble: 143 × 14
##       id zona    piso estrato preciom areaconst parqueaderos banios habitaciones
##    <dbl> <chr>  <dbl> <fct>     <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
##  1  6121 Zona …     7 5           299       932            1      3            3
##  2  6472 Zona …     3 5           170       605            1      2            2
##  3   324 Zona …     5 4           190        50           10      2            4
##  4  7182 Zona …     3 5           730       573            3      8            5
##  5  4952 Zona …     3 5           650       600            2      4            5
##  6  6475 Zona …     2 6          1561       399            3      4            3
##  7  6512 Zona …     3 6          1750       290            3      4            3
##  8  5952 Zona …     2 6          1750       342            3      5            4
##  9  6086 Zona …    10 6          1500       240            3      5            6
## 10  6197 Zona …     7 6          1700       290            3      4            3
## # ℹ 133 more rows
## # ℹ 5 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>,
## #   Cook_Distance <dbl>

Hat Values.

En la gráfica se observan algunos puntos con valores de apalancamiento altos, algunos superando el umbral de 0.025 marcado por la línea roja discontinua. Estos puntos representan observaciones que se alejan del centroide de las variables predictoras y podrían tener un impacto desproporcionado en los coeficientes del modelo.Es importante revisarlos para determinar si son valores atípicos y de esta manera poder determinar su tratamiento.

# Obtener los valores de apalancamiento para el Modelo 2
hat_values <- hatvalues(modelocaso2)

# Convertir a un data frame
df_hat <- data.frame(Observacion = 1:length(hat_values), Hat = hat_values)

# Graficar los valores de apalancamiento
ggplot(df_hat, aes(x = Observacion, y = Hat)) +
  geom_point(color = "blue") +
  geom_hline(yintercept = 2 * mean(hat_values), color = "red", linetype = "dashed") +
  labs(title = "Valores de Apalancamiento del Modelo", 
       x = "Observación", 
       y = "Valores de Apalancamiento (Hat Values)") +
  theme_minimal()+theme(plot.title = element_text(hjust = 0.5))

Gráficos de diagnostico de los supuestos del modelo.

El gráfico de “Residuals vs Fitted” muestra una dispersión aleatoria de los residuos, lo cual es ideal para cumplir con la linealidad y la homocedasticidad, aunque algunos puntos atípicos se alejan del patrón general, lo que podría indicar desviaciones en estos supuestos.

El gráfico Q-Q sugiere que los residuos siguen aproximadamente una distribución normal, aunque ciertas desviaciones en las colas revelan que la normalidad no se cumple de manera perfecta debido a estos puntos problemáticos.

En el gráfico “Scale-Location”, que evalúa la homocedasticidad, se observa una dispersión relativamente uniforme, aunque la presencia de algunos puntos atípicos podría estar afectando la constancia de la varianza.

Finalmente, el gráfico “Residuals vs Leverage” identifica puntos con alta influencia (leverage) y posibles outliers que podrían comprometer la robustez del modelo y contribuir al incumplimiento de los supuestos estadísticos.

# Gráficos de diagnóstico de los supuestos del Modelo 2

# Configuración de la ventana gráfica en 2x2 y ajuste de márgenes
par(mfrow = c(2, 2), mar = c(4, 4, 2, 1))  

# Graficar los diagnósticos del Modelo 2
plot(modelocaso2, which = 1, col = "blue")      # Residuos vs Valores Ajustados
plot(modelocaso2, which = 2, col = "darkgreen") # Gráfico Q-Q Normal
plot(modelocaso2, which = 3, col = "purple")    # Scale-Location
plot(modelocaso2, which = 5, col = "orange")    # Residuos vs Apalancamiento

Modelo 2 - Apartamentos Zona Sur (Sin influyentes ni atípicos).

# Cargar librerías necesarias
library(dplyr)
library(broom)
library(caret)

# Definir número de folds para validación cruzada
set.seed(123)  # Para reproducibilidad
control <- trainControl(method = "cv", number = 10)  

# Ajustar el Modelo 2 con validación cruzada en el dataset original
modelo_cv <- train(
  preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base2, 
  method = "lm", 
  trControl = control
)

# Obtener el Modelo 2 ajustado originalmente
modelocaso2 <- modelo_cv$finalModel

# Calcular la distancia de Cook
cook_distances <- cooks.distance(modelocaso2)

# Calcular los residuos estandarizados
resid_estandarizados <- rstudent(modelocaso2)

# Definir umbrales
umbral_cook <- 4 / length(cook_distances)  # Umbral estándar para la distancia de Cook
umbral_residuo <- 2  # Residuos estandarizados mayores a 2 en valor absoluto

# Identificar los puntos influyentes y atípicos
puntos_influyentes <- which(cook_distances > umbral_cook)
puntos_atipicos <- which(abs(resid_estandarizados) > umbral_residuo)

# Encontrar los puntos que son ambos (influyentes y atípicos)
puntos_a_eliminar <- intersect(puntos_influyentes, puntos_atipicos)

# Eliminar los puntos del dataset original
base2_clean <- base2[-puntos_a_eliminar, ]

# Ajustar un nuevo Modelo 2 sin los puntos influyentes y atípicos con validación cruzada
modelo_cv_clean <- train(
  preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base2_clean, 
  method = "lm", 
  trControl = control
)

# Obtener el Modelo 2 limpio ajustado
modelocaso2_clean <- modelo_cv_clean$finalModel

# Mostrar resúmenes de los modelos
#cat("Resumen del Modelo 2 original:\n")
#print(summary(modelocaso2))

#cat("\nResumen del Modelo 2 sin puntos influyentes y atípicos:\n")
#print(summary(modelocaso2_clean))

# Comparación gráfica de residuos
par(mfrow = c(1, 2))

# Modelo 2 original
plot(cook_distances, resid_estandarizados, main = "Modelo 2 Original", 
     xlab = "Distancia de Cook", ylab = "Residuos Estandarizados", col = "blue", pch = 19)
abline(h = c(-umbral_residuo, umbral_residuo), col = "red", lty = 2)
abline(v = umbral_cook, col = "red", lty = 2)

# Modelo 2 sin puntos influyentes y atípicos
cook_clean <- cooks.distance(modelocaso2_clean)
resid_clean <- rstudent(modelocaso2_clean)
plot(cook_clean, resid_clean, main = "Modelo 2 Sin Puntos Influyentes", 
     xlab = "Distancia de Cook", ylab = "Residuos Estandarizados", col = "blue", pch = 19)
abline(h = c(-umbral_residuo, umbral_residuo), col = "red", lty = 2)
abline(v = umbral_cook, col = "red", lty = 2)

Coeficientes del modelo (Sin influyentes ni atípicos).

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

# Obtener el resumen del modelo final
summary_modelocaso2clean <- summary(modelocaso2_clean)

# Convertir los coeficientes en un data frame para usar kableExtra
coeficientescaso2clean <- as.data.frame(summary_modelocaso2clean$coefficients)
colnames(coeficientescaso2) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")

# Mostrar los coeficientes en una tabla con kableExtra
coeficientescaso2clean %>%
  kable("html", caption = paste0("<center>", "Resumen de Coeficientes del Modelo Lineal", "</center>")) %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

Resumen de Coeficientes del Modelo Lineal
	Estimate	Std. Error	t value	Pr(>\|t\|)
(Intercept)	-31.496537	6.7471425	-4.668130	3.2e-06
areaconst	1.618029	0.0443402	36.491261	0.0e+00
estrato4	30.502597	4.3881589	6.951115	0.0e+00
estrato5	59.219574	4.5574284	12.994077	0.0e+00
estrato6	192.925831	5.9303736	32.531818	0.0e+00
habitaciones	-12.636209	2.1783102	-5.800923	0.0e+00
parqueaderos	50.777717	2.6249658	19.344144	0.0e+00
banios	28.964871	1.9892574	14.560645	0.0e+00

Interpretación de los Coeficientes del Modelo Lineal

Variable	Interpretación
(Intercept)	El intercepto es -31.50 (p < 0.001). Esto indica que el valor base de la variable dependiente (cuando todas las demás variables son cero) es -31.50. Se debe interpretar con precaución.
areaconst	Coeficiente de 1.62 (p < 0.001). Cada metro cuadrado adicional de área construida se asocia con un aumento de 16,180 COP en el precio por metro cuadrado.
estrato4	Coeficiente de 30.50 (p < 0.001). Las viviendas en estrato 4 tienen un precio por metro cuadrado 305,000 COP mayor que las del estrato 3.
estrato5	Coeficiente de 59.22 (p < 0.001). Las viviendas en estrato 5 tienen un precio por metro cuadrado 592,200 COP mayor que las del estrato 3.
estrato6	Coeficiente de 192.93 (p < 0.001). Las viviendas en estrato 6 tienen un precio por metro cuadrado 1,929,300 COP mayor que las del estrato 3.
habitaciones	Coeficiente de -12.64 (p < 0.001). Cada habitación adicional se asocia con una disminución de 126,400 COP en el precio por metro cuadrado.
parqueaderos	Coeficiente de 50.78 (p < 0.001). Cada parqueadero adicional se asocia con un aumento de 507,800 COP por metro cuadrado en el precio.
banios	Coeficiente de 28.96 (p < 0.001). Cada baño adicional incrementa el precio por metro cuadrado en 289,600 COP.

Métricas del modelo (Sin influyentes ni atípicos).

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

# Extraer las métricas del modelo 'modelocaso2_clean'
r2 <- summary(modelocaso2_clean)$r.squared
r2_ajustado <- summary(modelocaso2_clean)$adj.r.squared
f_statistic <- summary(modelocaso2_clean)$fstatistic[1]
df1 <- summary(modelocaso2_clean)$fstatistic[2]
df2 <- summary(modelocaso2_clean)$fstatistic[3]
p_value <- pf(f_statistic, df1, df2, lower.tail = FALSE)

# Crear un data frame con las métricas
metricas <- data.frame(
  Métrica = c("R²", "R² Ajustado", "Estadístico F", "Grados de Libertad", "Valor p"),
  Valor = c(
    round(r2, 4), 
    round(r2_ajustado, 4), 
    round(f_statistic, 1), 
    paste(df1, "y", df2), 
    format.pval(p_value, digits = 3)
  )
)

# Tabla con kableExtra
tabla_metricas <- metricas %>%
  kable("html", caption = "<center>Métricas del Modelo </center>") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

# Mostrar la tabla
tabla_metricas

Métricas del Modelo
Métrica	Valor
R²	0.8794
R² Ajustado	0.8791
Estadístico F	2798.4
Grados de Libertad	7 y 2686
Valor p	<2e-16

A partir de las métricas del Modelo 2 se puede resaltar lo siguiente:

R² (0.8794): El coeficiente de determinación indica que aproximadamente el 87.94% de la variabilidad del precio por metro cuadrado (preciom) se explica mediante las variables predictoras del modelo (área construida, estrato, habitaciones, parqueaderos y baños). Este valor relativamente alto de R² sugiere que el modelo tiene un buen nivel de explicación respecto a la variable dependiente.
R² Ajustado (0.8791): Esta métrica ajusta el R² considerando el número de predictores del modelo. El hecho de que el R² ajustado sea muy cercano al R² original indica que las variables incluidas en el modelo son relevantes y que no se está sobreajustando el modelo.
Estadístico F (2798.4): El estadístico F evalúa la significancia general del modelo. Un valor tan alto indica que el modelo con las variables predictoras actuales es significativamente mejor para predecir el precio por metro cuadrado que un modelo sin predictores (solo con el intercepto).
Grados de Libertad (7 y 2686): El primer valor (7) representa el número de predictores del modelo en los cuales se incluye las categorías creadas para el estrato, mientras que el segundo valor (2686) corresponde al número de observaciones menos el número de parámetros estimados.
Valor p (<2e-16): Este valor extremadamente bajo indica que el modelo es altamente significativo. Existe una evidencia muy fuerte para rechazar la hipótesis nula de que las variables predictoras no tienen ningún efecto sobre el precio por metro cuadrado.

Comprobación de supuestos para el segundo modelo

Homocedasticidad y Lineal (Sin influyentes ni atípicos).

# Cargar librerías necesarias
library(ggplot2)

# Gráfico de residuos vs valores ajustados para el Modelo 2 limpio
ggplot(data = data.frame(fitted = fitted(modelocaso2_clean), 
                         residuals = residuals(modelocaso2_clean)),
       aes(x = fitted, y = residuals)) +
  geom_point(color = "blue", alpha = 0.5) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Residuos vs Valores Ajustados", 
       x = "Valores Ajustados", y = "Residuos") +
  theme_minimal()+
  theme(plot.title = element_text(hjust = 0.5))

Prueba Breusch Pagan (Sin influyentes ni atípicos).

El test de Breusch-Pagan arrojó un valor p muy bajo (< 2.2e-16), lo que indica que no se cumple el supuesto de homocedasticidad en el modelo

# Cargar la librería necesaria
library(lmtest)

# Realizar la prueba de Breusch-Pagan
bptest(modelocaso2_clean)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelocaso2_clean
## BP = 658.72, df = 7, p-value < 2.2e-16

Normalidad de los residuos (Sin influyentes ni atípicos)

En este caso también se observa que con la revisión realizada no se cumplen el supuesto de normalidad de los residuos del modelo.

# Cargar librerías necesarias
library(ggplot2)

# Histograma de los residuos del Modelo 2 limpio
ggplot(data = data.frame(residuals = residuals(modelocaso2_clean)),
       aes(x = residuals)) +
  geom_histogram(aes(y = ..density..), bins = 30, fill = "blue", alpha = 0.5) +
  geom_density(color = "red") +
  labs(title = "Distribución de los Residuos (Modelo 2 Sin Puntos Influyentes)", 
       x = "Residuos", y = "Densidad") +
  theme_minimal()

# Prueba de normalidad de Shapiro-Wilk para el Modelo 2 limpio
shapiro.test(residuals(modelocaso2_clean))

## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(modelocaso2_clean)
## W = 0.98839, p-value = 5.148e-14

Autocorrelacion de los residuos (Sin influyentes ni atípicos).

El resultado del test de Durbin-Watson muestra una autocorrelación positiva débil en los residuos (coeficiente de 0.15767) con un estadístico D-W de 1.684098. Un valor cercano a 2 indica baja autocorrelación, pero el valor p de 0 rechaza la hipótesis nula de no autocorrelación. Esto sugiere que los residuos del modelo no son completamente independientes.

# Cargar librería necesaria
library(car)

# Prueba de Durbin-Watson para el Modelo 2 sin puntos influyentes
durbinWatsonTest(modelocaso2_clean)

##  lag Autocorrelation D-W Statistic p-value
##    1         0.15767      1.684098       0
##  Alternative hypothesis: rho != 0

Corrección de supuestos.

Dado que los supuestos no se cumplen, se realizarán distintas transformaciones en las variables de regresión con el objetivo de corregir los tres supuestos, esperando mejorar así la validez de las inferencias estadísticas del modelo.

# Cargar librerías necesarias
library(dplyr)
library(broom)
library(caret)

# Transformaciones logarítmicas necesarias
base2_clean <- base2_clean %>%
  mutate(
    log_preciom = log(preciom),
    log_areaconst = log(areaconst)
  )

# Definir número de folds para validación cruzada
set.seed(123)  # Para reproducibilidad
control <- trainControl(method = "cv", number = 10)  


# Modelo Log-Lin
modelo_log_lin <- train(
  log_preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base2_clean, 
  method = "lm", 
  trControl = control
)

# Modelo Lin-Log
modelo_lin_log <- train(
  preciom ~ log_areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base2_clean, 
  method = "lm", 
  trControl = control
)

# Modelo Log-Log
modelo_log_log <- train(
  log_preciom ~ log_areaconst + estrato + habitaciones + parqueaderos + banios, 
  data = base2_clean, 
  method = "lm", 
  trControl = control
)

# Obtener los modelos finales ajustados
modelocaso2_clean <- modelo_cv_clean$finalModel
modelo_log_lin_final <- modelo_log_lin$finalModel
modelo_lin_log_final <- modelo_lin_log$finalModel
modelo_log_log_final <- modelo_log_log$finalModel

# Mostrar resúmenes de los modelos

#cat("\nModelo Log-Lin:\n")
#print(summary(modelocaso2_clean))

#cat("\nModelo Log-Lin:\n")
#print(summary(modelo_log_lin_final))

#cat("\nModelo Lin-Log:\n")
#print(summary(modelo_lin_log_final))

#cat("\nModelo Log-Log:\n")
#print(summary(modelo_log_log_final))

Coeficientes de las transformaciones.

Los resultados de los coeficientes de los modelos indican que todos los modelos presentan relaciones estadísticamente significativas entre las variables y la variable dependiente, ya que los valores p son extremadamente bajos (< 0.001). Esto sugiere que las variables independientes incluidas en cada modelo tienen un impacto relevante en la predicción del precio por metro cuadrado.

# Cargar librerías necesarias
library(dplyr)
library(caret)
library(knitr)
library(kableExtra)

# Obtener el resumen de cada modelo
summary_modelo2 <- summary(modelocaso2_clean)  # Ahora modelo_cv_clean es el Modelo 2
summary_modelo_log_lin <- summary(modelo_log_lin_final)
summary_modelo_lin_log <- summary(modelo_lin_log_final)
summary_modelo_log_log <- summary(modelo_log_log_final)

# Convertir los coeficientes en un data frame para usar kableExtra
coef_modelo2 <- as.data.frame(summary_modelo2$coefficients)
coef_log_lin <- as.data.frame(summary_modelo_log_lin$coefficients)
coef_lin_log <- as.data.frame(summary_modelo_lin_log$coefficients)
coef_log_log <- as.data.frame(summary_modelo_log_log$coefficients)

# Cambiar los nombres de las columnas para mayor claridad
colnames(coef_modelo2) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")
colnames(coef_log_lin) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")
colnames(coef_lin_log) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")
colnames(coef_log_log) <- c("Estimación", "Error Estándar", "Valor t", "Pr(>|t|)")

# Función para mostrar las tablas con kableExtra
mostrar_tabla <- function(data, titulo) {
  data %>%
    kable("html", caption = paste0("<center>", titulo, "</center>"), digits = 4) %>%
    kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))
}

# Tablas de coeficientes para cada modelo
mostrar_tabla(coef_modelo2, "Resumen de Coeficientes del Modelo 2")

Resumen de Coeficientes del Modelo 2
	Estimación	Error Estándar	Valor t
(Intercept)	-31.4965	6.7471	-4.6681
areaconst	1.6180	0.0443	36.4913
estrato4	30.5026	4.3882	6.9511
estrato5	59.2196	4.5574	12.9941
estrato6	192.9258	5.9304	32.5318
habitaciones	-12.6362	2.1783	-5.8009
parqueaderos	50.7777	2.6250	19.3441
banios	28.9649	1.9893	14.5606

mostrar_tabla(coef_log_lin, "Resumen de Coeficientes del Modelo Log-Lin")

Resumen de Coeficientes del Modelo Log-Lin
	Estimación	Error Estándar	Valor t	Pr(>\|t\|)
(Intercept)	4.3311	0.0243	178.0046	0.0000
areaconst	0.0042	0.0002	25.9995	0.0000
estrato4	0.2998	0.0158	18.9449	0.0000
estrato5	0.5029	0.0164	30.6012	0.0000
estrato6	0.7961	0.0214	37.2235	0.0000
habitaciones	0.0073	0.0079	0.9325	0.3512
parqueaderos	0.1135	0.0095	11.9930	0.0000
banios	0.0830	0.0072	11.5694	0.0000

mostrar_tabla(coef_lin_log, "Resumen de Coeficientes del Modelo Lin-Log")

Resumen de Coeficientes del Modelo Lin-Log
	Estimación	Error Estándar	Valor t
(Intercept)	-716.4554	20.5301	-34.8978
log_areaconst	193.1674	5.7485	33.6034
estrato4	22.1239	4.5063	4.9095
estrato5	38.7081	4.7492	8.1504
estrato6	172.9784	6.1846	27.9694
habitaciones	-17.7190	2.2899	-7.7379
parqueaderos	55.4698	2.6639	20.8226
banios	27.5567	2.0769	13.2680

mostrar_tabla(coef_log_log, "Resumen de Coeficientes del Modelo Log-Log")

Resumen de Coeficientes del Modelo Log-Log
	Estimación	Error Estándar	Valor t
(Intercept)	1.8814	0.0647	29.1002
log_areaconst	0.7012	0.0181	38.7345
estrato4	0.2717	0.0142	19.1488
estrato5	0.4196	0.0150	28.0552
estrato6	0.6993	0.0195	35.9051
habitaciones	-0.0328	0.0072	-4.5537
parqueaderos	0.0901	0.0084	10.7459
banios	0.0481	0.0065	7.3532

Métricas de las transformaciones.

Los resultados de las métricas de los modelos muestran que el Modelo 2 presenta el mayor coeficiente de determinación (R² = 0.8794) y un R² ajustado de 0.8791, indicando que este modelo explica mejor la variabilidad del precio por metro cuadrado en comparación con los demás modelos. Aunque los otros modelos también tienen un buen ajuste (R² entre 0.8293 y 0.873).

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

# Extraer las métricas de cada modelo

# Modelo 2 (modelo_cv_clean)
r2_modelo2 <- summary(modelo_cv_clean)$r.squared
r2_ajustado_modelo2 <- summary(modelo_cv_clean)$adj.r.squared
f_statistic_modelo2 <- summary(modelo_cv_clean)$fstatistic[1]
df1_modelo2 <- summary(modelo_cv_clean)$fstatistic[2]
df2_modelo2 <- summary(modelo_cv_clean)$fstatistic[3]
p_value_modelo2 <- pf(f_statistic_modelo2, df1_modelo2, df2_modelo2, lower.tail = FALSE)

# Modelo Log-Lin
r2_log_lin <- summary(modelo_log_lin_final)$r.squared
r2_ajustado_log_lin <- summary(modelo_log_lin_final)$adj.r.squared
f_statistic_log_lin <- summary(modelo_log_lin_final)$fstatistic[1]
df1_log_lin <- summary(modelo_log_lin_final)$fstatistic[2]
df2_log_lin <- summary(modelo_log_lin_final)$fstatistic[3]
p_value_log_lin <- pf(f_statistic_log_lin, df1_log_lin, df2_log_lin, lower.tail = FALSE)

# Modelo Lin-Log
r2_lin_log <- summary(modelo_lin_log_final)$r.squared
r2_ajustado_lin_log <- summary(modelo_lin_log_final)$adj.r.squared
f_statistic_lin_log <- summary(modelo_lin_log_final)$fstatistic[1]
df1_lin_log <- summary(modelo_lin_log_final)$fstatistic[2]
df2_lin_log <- summary(modelo_lin_log_final)$fstatistic[3]
p_value_lin_log <- pf(f_statistic_lin_log, df1_lin_log, df2_lin_log, lower.tail = FALSE)

# Modelo Log-Log
r2_log_log <- summary(modelo_log_log_final)$r.squared
r2_ajustado_log_log <- summary(modelo_log_log_final)$adj.r.squared
f_statistic_log_log <- summary(modelo_log_log_final)$fstatistic[1]
df1_log_log <- summary(modelo_log_log_final)$fstatistic[2]
df2_log_log <- summary(modelo_log_log_final)$fstatistic[3]
p_value_log_log <- pf(f_statistic_log_log, df1_log_log, df2_log_log, lower.tail = FALSE)

# Crear un data frame con las métricas de todos los modelos
metricas_modelo <- data.frame(
  Métrica = c("R²", "R² Ajustado", "Estadístico F", "Grados de Libertad", "Valor p"),
  `Modelo 2` = c(round(r2_modelo2, 4), round(r2_ajustado_modelo2, 4), round(f_statistic_modelo2, 1), 
                 paste(df1_modelo2, "y", df2_modelo2), format.pval(p_value_modelo2, digits = 3)),
  `Modelo Log-Lin` = c(round(r2_log_lin, 4), round(r2_ajustado_log_lin, 4), round(f_statistic_log_lin, 1), 
                       paste(df1_log_lin, "y", df2_log_lin), format.pval(p_value_log_lin, digits = 3)),
  `Modelo Lin-Log` = c(round(r2_lin_log, 4), round(r2_ajustado_lin_log, 4), round(f_statistic_lin_log, 1), 
                       paste(df1_lin_log, "y", df2_lin_log), format.pval(p_value_lin_log, digits = 3)),
  `Modelo Log-Log` = c(round(r2_log_log, 4), round(r2_ajustado_log_log, 4), round(f_statistic_log_log, 1), 
                       paste(df1_log_log, "y", df2_log_log), format.pval(p_value_log_log, digits = 3))
)

# Crear la tabla con kableExtra
tabla_metricas_modelos <- metricas_modelo %>%
  kable("html", caption = "<center>Métricas de Todos los Modelos</center>") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

# Mostrar la tabla
tabla_metricas_modelos

Métricas de Todos los Modelos
Métrica	Modelo.2	Modelo.Log.Lin	Modelo.Lin.Log	Modelo.Log.Log
R²	0.8794	0.8293	0.873	0.8629
R² Ajustado	0.8791	0.8288	0.8727	0.8625
Estadístico F	2798.4	1863.8	2638.1	2414.9
Grados de Libertad	7 y 2686	7 y 2686	7 y 2686	7 y 2686
Valor p	<2e-16	<2e-16	<2e-16	<2e-16

Supuestos de los modelos realizados con las transformaciones.

En este caso se presenta que las transformaciones realizadas no garantizan el cumplimiento de ninguno de los supuestos del modelo, con lo cual es pertinente contemplar métodos alternativos como modelos no lineales, modelos mas robustos o técnicas de machine learning.

library(lmtest)
library(dplyr)

# Función para realizar las pruebas y obtener los valores p
evaluar_supuestos <- function(modelo) {
  residuos <- residuals(modelo)
  
  # Verificar residuos válidos
  if (any(is.na(residuos)) || any(is.infinite(residuos))) {
    stop("Los residuos contienen NA o valores infinitos.")
  }
  
  # Normalidad de los residuos
  normalidad <- shapiro.test(residuos)$p.value
  
  # Homocedasticidad con el modelo completo
  homocedasticidad <- bptest(modelo)$p.value
  
  # Autocorrelación de los residuos con el modelo completo
  autocorrelacion <- dwtest(modelo)$p.value
  
  return(c(normalidad, homocedasticidad, autocorrelacion))
}

# Aplicar la función a cada modelo
resultados_modelo2 <- evaluar_supuestos(modelocaso2_clean)  # Ajuste en el nombre del modelo
resultados_log_lin <- evaluar_supuestos(modelo_log_lin_final)
resultados_lin_log <- evaluar_supuestos(modelo_lin_log_final)
resultados_log_log <- evaluar_supuestos(modelo_log_log_final)

# Crear la tabla de resultados
tabla_resultados <- data.frame(
  Modelo = c("Modelo 2", "Log-Lineal", "Lineal-Log", "Log-Log"),
  Normalidad = c(resultados_modelo2[1], resultados_log_lin[1], resultados_lin_log[1], resultados_log_log[1]),
  Homocedasticidad = c(resultados_modelo2[2], resultados_log_lin[2], resultados_lin_log[2], resultados_log_log[2]),
  Autocorrelación = c(resultados_modelo2[3], resultados_log_lin[3], resultados_lin_log[3], resultados_log_log[3])
)

# Función para formatear los valores p a 5 decimales
formatear_p_valores <- function(x) {
  return(sprintf("%.9f", as.numeric(x)))}

# Aplicar el formateo a las columnas de valores p
tabla_resultados$Normalidad <- formatear_p_valores(tabla_resultados$Normalidad)
tabla_resultados$Homocedasticidad <- formatear_p_valores(tabla_resultados$Homocedasticidad)
tabla_resultados$Autocorrelación <- formatear_p_valores(tabla_resultados$Autocorrelación)

# Crear la tabla con kableExtra
tabla_resultados <- tabla_resultados %>%
  kable("html", caption = "<center>Pruebas de Supuestos Estadísticos por Modelo</center>") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

# Mostrar la tabla
tabla_resultados

Pruebas de Supuestos Estadísticos por Modelo
Modelo	Normalidad	Homocedasticidad	Autocorrelación
Modelo 2	0.000000000	0.000000000	0.000000000
Log-Lineal	0.000005545	0.000000000	0.000000000
Lineal-Log	0.000000000	0.000000000	0.000000000
Log-Log	0.000000175	0.000000000	0.000000000

Predicción de precio.

A continuación se realizan las predicciones de la solicitud. Es importante tener en cuenta que, a pesar de que el modelo no cumplió con los supuestos estadísticos (como la normalidad de los residuos y homocedasticidad),por lo cual los resultados deben interpretarse con cuidado, ya que posibles sesgos o errores en el modelo podrían afectar la precisión de las predicciones.

library(dplyr)
library(knitr)
library(kableExtra)
library(scales)  # Para formato de pesos

# Crear las solicitudes con las variables adecuadas
solicitud1 <- data.frame(
  areaconst = 300, 
  estrato3 = 0, 
  estrato4 = 0, 
  estrato5 = 1,  # estrato 5
  estrato6 = 0,
  parqueaderos = 3, 
  banios = 3, 
  habitaciones = 5
)

solicitud2 <- data.frame(
  areaconst = 300, 
  estrato3 = 0, 
  estrato4 = 0, 
  estrato5 = 0,  
  estrato6 = 1,# estrato 6
  parqueaderos = 3, 
  banios = 3, 
  habitaciones = 5
)

# Realizar las predicciones con el modelo 'modelocaso2_clean'
prediccion1 <- predict(modelocaso2_clean, newdata = solicitud1)
resultado1 <- prediccion1 * 200 * 10000  # Sin logaritmos

prediccion2 <- predict(modelocaso2_clean, newdata = solicitud2)
resultado2 <- prediccion2 * 200 * 10000  # Sin logaritmos

# Crear la tabla de resultados
resultados <- data.frame(
  Solicitud = c("Solicitud 1", "Solicitud 2"),
  Predicción = c(resultado1, resultado2)
)

# Formatear las predicciones como pesos colombianos
resultados$Predicción <- dollar(resultados$Predicción, scale = 1, prefix = "$", big.mark = ".", decimal.mark = ",")

# Mostrar la tabla con kableExtra
resultados %>%
  kable("html") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))

Solicitud	Predicción
Solicitud 1	$1.378.357.094
Solicitud 2	$1.645.769.607

Viviendas seleccionadas.

A continuación se muestran las viviendas seleccionadas teniendo en cuenta los criterios iniciales con la restricción presupuestal, se priorizaron viviendas con características similares a las solicitadas por el cliente.

# Cargar las librerías necesarias
library(dplyr)
library(kableExtra)

# Crear la tabla con las viviendas seleccionadas
tabla_viviendas <- ofertas_filtradas %>%
  mutate(PrecioTotal = preciom * areaconst * 10000) %>%
  select(
    PrecioTotal,
    Área = areaconst,
    Estrato = estrato,
    Habitaciones = habitaciones,
    Parqueaderos = parqueaderos,
    Baños = banios,
    Longitud = longitud,
    Latitud = latitud
  ) %>%
  mutate(PrecioTotal = format(PrecioTotal, big.mark = ".", scientific = FALSE))

# Mostrar la tabla con kableExtra
tabla_viviendas %>%
  kable(
    caption = "<center>Tabla de Viviendas Seleccionadas</center>",
    col.names = c("Precio Total (COP)", "Área (m²)", "Estrato", "Habitaciones", 
                  "Parqueaderos", "Baños", "Longitud", "Latitud"),
    format = "html",
    align = "c"
  ) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed", "responsive"),
    full_width = FALSE,
    position = "center"
  )

Tabla de Viviendas Seleccionadas
Precio Total (COP)	Área (m²)	Estrato	Habitaciones	Parqueaderos	Baños	Longitud	Latitud
540.000.000	180.00	5	4	1	3	-76.54300	3.38600
846.300.000	217.00	4	5	2	5	-76.53100	3.43100
840.000.000	200.00	4	5	1	5	-76.53339	3.43224
696.698.400	217.04	5	5	1	4	-76.55066	3.40862
592.000.000	185.00	5	4	2	2	-76.54803	3.40829
592.000.000	185.00	5	4	2	3	-76.54807	3.40829
592.000.000	185.00	5	4	2	2	-76.54807	3.40831
592.000.000	185.00	5	4	2	2	-76.54807	3.40831
772.200.000	198.00	5	3	1	4	-76.52030	3.38197
579.200.000	181.00	5	4	2	3	-76.52984	3.38359
732.600.000	198.00	4	4	1	4	-76.53076	3.38071
810.600.000	193.00	4	3	2	4	-76.53403	3.38139
752.400.000	198.00	5	4	2	4	-76.53503	3.38250
840.000.000	200.00	5	3	2	4	-76.53611	3.45774
627.000.000	209.00	5	5	1	4	-76.54347	3.39744
540.000.000	180.00	5	3	1	2	-76.54158	3.38230
695.400.000	183.00	4	3	1	3	-76.52862	3.39056
774.000.000	180.00	5	3	2	3	-76.54072	3.41327

Informe Ejecutivo.

Se llevo a cabo un análisis de la ubicación de las viviendas registradas por la empresa C&A (Casas y Apartamentos) en el cual se identificó que existen numerosas viviendas que tienen erroneamente asignada la asignación de su zona, lo cual puede llevar a confusiones y malas asesorias por parte de los agentes comerciales de la empresa, por lo cual es pertinente diseñar estrategias para corregir y depurar la base de datos, asegurando que cada vivienda esté correctamente asignada a su zona o localidad.

Para ayudar a la asesoría de las dos solicitudes realizadas, se realizó un modelo de regresión lineal múltiple tanto para las casas de la Zona Norte como para los Apartamentos de la Zona Sur de la ciudad para predecir el precio de ambas viviendas con las características deseadas mediante el uso de la cantidad de habitaciones, parqueaderos, área construida y el estrato de la vivienda.Inicialmente ambos modelos obtuvieron un buen ajuste de bondad R², aunque al comprobar los supuestos del modelo se encontró que no se cumplían en su totalidad por lo cual los resultados del modelo podrían no ser completamente confiables al momento de realizar predicciones.

A pesar de los ajustes realizados, los nuevos modelos para las casas en la Zona Norte y los apartamentos en la Zona Sur continuaron sin cumplir completamente con los supuestos estadísticos necesarios para garantizar la validez de los resultados. Persistieron problemas relacionados con la normalidad de los residuos, la homocedasticidad y la autocorrelación de los residuos. Esto puede derivar en diversas problemáticas, como una incapacidad del modelo para capturar adecuadamente los patrones de los datos y una precisión variable en las estimaciones según el rango de los datos analizados.

Por esta razón, las estimaciones del precio realizadas tienen poco valor para la toma de decisiones, ya que podrían no reflejar adecuadamente las condiciones reales del mercado inmobiliario.

Ante esta situación, se recomienda considerar enfoques alternativos, como modelos no lineales o técnicas de machine learning, que podrían adaptarse mejor a la complejidad de los datos y ofrecer predicciones más confiables. Además, es fundamental establecer un proceso continuo de revisión y validación de la base de datos para evitar futuros problemas con la asignación de zonas y asegurar la calidad de la información utilizada por la empresa C&A en sus procesos comerciales.

A continuación se presentan las distintas recomendaciones de vivienda de las dos solicitudes teniendo en cuenta que no deben exceder el presupuesto asignado y deben presentar características similares en cuanto al estrato, habitaciones, parqueaderos, área y baños.

Viviendas para la primera solicitud.

Para la primera solicitud, se seleccionaron un total de 8 viviendas que cumplen con la restricción presupuestal del cliente de 350 millones de pesos. Es importante destacar que, para ampliar las opciones disponibles, se aplicó una tolerancia en todas las características de la vivienda, incluidas el área construida, el estrato, el número de parqueaderos, baños y habitaciones. Esto permitió identificar ofertas que, aunque no coincidían exactamente con los parámetros iniciales, se encontraban dentro de un rango aceptable para el cliente.

Además, se verificó que todas las viviendas seleccionadas contaran con coordenadas válidas para su correcta visualización en el mapa interactivo, ofreciendo así una perspectiva clara de su ubicación geográfica en la ciudad.

# Cargar librerías necesarias
library(dplyr)
library(leaflet)

# Solicitud de vivienda con las características deseadas
solicitud1 <- data.frame(
  areaconst = 200, 
  estrato = 4, 
  parqueaderos = 1, 
  banios = 2, 
  habitaciones = 4
)

# Definir rangos de tolerancia para cada característica
tolerancia <- data.frame(
  areaconst = 50,   # ±50 m²
  estrato = 1,       # ±1 estrato
  parqueaderos = 1,  # ±1 parqueadero
  banios = 1,        # ±1 baño
  habitaciones = 1   # ±1 habitación
)

# Asegurarse de que 'estrato' sea numérico en el conjunto de datos base1_clean
base1_clean <- base1_clean %>%
  mutate(estrato = as.numeric(as.character(estrato)))

# Filtrar viviendas que cumplen con las características cercanas y la restricción de precio
ofertas_filtradas <- base1_clean %>%
  filter(
    between(areaconst, solicitud1$areaconst - tolerancia$areaconst, solicitud1$areaconst + tolerancia$areaconst),
    between(estrato, solicitud1$estrato - tolerancia$estrato, solicitud1$estrato + tolerancia$estrato),
    between(parqueaderos, solicitud1$parqueaderos - tolerancia$parqueaderos, solicitud1$parqueaderos + tolerancia$parqueaderos),
    between(banios, solicitud1$banios - tolerancia$banios, solicitud1$banios + tolerancia$banios),
    between(habitaciones, solicitud1$habitaciones - tolerancia$habitaciones, solicitud1$habitaciones + tolerancia$habitaciones),
    preciom * areaconst * 10000 <= 350000000
  ) %>%
  filter(!is.na(longitud) & !is.na(latitud)) %>%
  mutate(
    longitud = as.numeric(longitud),
    latitud = as.numeric(latitud)
  )

# Crear el mapa interactivo con leaflet solo si hay ofertas disponibles
if (nrow(ofertas_filtradas) > 0) {
  leaflet(ofertas_filtradas) %>%
    addTiles() %>%
    addCircleMarkers(
      lng = ~longitud,
      lat = ~latitud,
      popup = ~paste0(
        "<strong>Precio Total:</strong> ", format(round(preciom * areaconst * 10000, 0), big.mark = ",", scientific = FALSE), " COP<br>",
        "<strong>Área:</strong> ", areaconst, " m²<br>",
        "<strong>Estrato:</strong> ", estrato, "<br>",
        "<strong>Habitaciones:</strong> ", habitaciones, "<br>",
        "<strong>Parqueaderos:</strong> ", parqueaderos, "<br>",
        "<strong>Baños:</strong> ", banios
      ),
      color = "blue",
      radius = 6,
      fillOpacity = 0.7
    )
} else {
  message("No hay viviendas seleccionadas para mostrar en el mapa.")
}

# Mostrar estadísticas de las viviendas seleccionadas
#cat("Viviendas filtradas:", nrow(ofertas_filtradas), "\n")
#cat("Viviendas con coordenadas válidas:", nrow(ofertas_filtradas), "\n")

# Cargar las librerías necesarias
library(dplyr)
library(kableExtra)

# Crear la tabla con las viviendas seleccionadas
tabla_viviendas <- ofertas_filtradas %>%
  mutate(PrecioTotal = preciom * areaconst * 10000) %>%
  select(
    PrecioTotal,
    Área = areaconst,
    Estrato = estrato,
    Habitaciones = habitaciones,
    Parqueaderos = parqueaderos,
    Baños = banios,
    Longitud = longitud,
    Latitud = latitud
  ) %>%
  mutate(PrecioTotal = format(PrecioTotal, big.mark = ".", scientific = FALSE))

# Mostrar la tabla con kableExtra
tabla_viviendas %>%
  kable(
    caption = "<center>Tabla de Viviendas Seleccionadas</center>",
    col.names = c("Precio Total (COP)", "Área (m²)", "Estrato", "Habitaciones", 
                  "Parqueaderos", "Baños", "Longitud", "Latitud"),
    format = "html",
    align = "c"
  ) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed", "responsive"),
    full_width = FALSE,
    position = "center"
  )

Tabla de Viviendas Seleccionadas
Precio Total (COP)	Área (m²)	Estrato	Habitaciones	Parqueaderos	Baños	Longitud	Latitud
330.000.000	150	3	4	1	2	-76.53200	3.45200
296.000.000	160	3	5	1	2	-76.48800	3.47200
255.000.000	150	3	4	1	2	-76.48600	3.46800
270.000.000	150	3	4	1	2	-76.49575	3.47561
256.000.000	160	3	3	1	2	-76.54015	3.42681
315.000.000	180	3	3	1	2	-76.49500	3.46589
320.000.000	160	3	4	1	3	-76.49358	3.46639
184.000.000	160	3	3	1	1	-76.49929	3.47094

Viviendas para la segunda solicitud.

Respecto a la segunda solicitud se identificaron un total de 18 viviendas que podrían ser relevantes para el cliente, teniendo en cuenta un margen de tolerancia con respecto a las características originales.

# Cargar librerías necesarias
library(dplyr)
library(leaflet)

# Solicitud de vivienda con las características deseadas
solicitud1 <- data.frame(
  areaconst = 300, 
  estrato = 5, 
  parqueaderos = 3, 
  banios = 3, 
  habitaciones = 5
)

# Definir rangos de tolerancia para cada característica
tolerancia <- data.frame(
  areaconst = 120,   # ± 120 m²
  estrato = 2,        # ± 2 estratos
  parqueaderos = 2,   # ± 2 parqueaderos
  banios = 2,         # ± 2 baños
  habitaciones = 2    # ± 2 habitaciones
)

# Asegurarse de que 'estrato' sea numérico en el conjunto de datos base2_clean
base2_clean <- base2_clean %>%
  mutate(estrato = as.numeric(as.character(estrato)))

# Filtrar viviendas que cumplen con las características cercanas y la restricción de precio
ofertas_filtradas <- base2_clean %>%
  filter(
    between(areaconst, solicitud1$areaconst - tolerancia$areaconst, solicitud1$areaconst + tolerancia$areaconst),
    between(estrato, solicitud1$estrato - tolerancia$estrato, solicitud1$estrato + tolerancia$estrato),
    between(parqueaderos, solicitud1$parqueaderos - tolerancia$parqueaderos, solicitud1$parqueaderos + tolerancia$parqueaderos),
    between(banios, solicitud1$banios - tolerancia$banios, solicitud1$banios + tolerancia$banios),
    between(habitaciones, solicitud1$habitaciones - tolerancia$habitaciones, solicitud1$habitaciones + tolerancia$habitaciones),
    preciom * areaconst * 10000 <= 850000000
  ) %>%
  filter(!is.na(longitud) & !is.na(latitud)) %>%
  mutate(
    longitud = as.numeric(longitud),
    latitud = as.numeric(latitud)
  )

# Crear el mapa interactivo con leaflet solo si hay ofertas disponibles
if (nrow(ofertas_filtradas) > 0) {
  leaflet(ofertas_filtradas) %>%
    addTiles() %>%
    addCircleMarkers(
      lng = ~longitud,
      lat = ~latitud,
      popup = ~paste0(
        "<strong>Precio Total:</strong> ", format(round(preciom * areaconst * 10000, 0), big.mark = ",", scientific = FALSE), " COP<br>",
        "<strong>Área:</strong> ", areaconst, " m²<br>",
        "<strong>Estrato:</strong> ", estrato, "<br>",
        "<strong>Habitaciones:</strong> ", habitaciones, "<br>",
        "<strong>Parqueaderos:</strong> ", parqueaderos, "<br>",
        "<strong>Baños:</strong> ", banios
      ),
      color = "blue",
      radius = 6,
      fillOpacity = 0.7
    )
} else {
  message("No hay viviendas seleccionadas para mostrar en el mapa.")
}

# Cargar las librerías necesarias
library(dplyr)
library(kableExtra)

# Crear la tabla con las viviendas seleccionadas
tabla_viviendas <- ofertas_filtradas %>%
  mutate(PrecioTotal = preciom * areaconst * 10000) %>%
  select(
    PrecioTotal,
    Área = areaconst,
    Estrato = estrato,
    Habitaciones = habitaciones,
    Parqueaderos = parqueaderos,
    Baños = banios,
    Longitud = longitud,
    Latitud = latitud
  ) %>%
  mutate(PrecioTotal = format(PrecioTotal, big.mark = ".", scientific = FALSE))

# Mostrar la tabla con kableExtra
tabla_viviendas %>%
  kable(
    caption = "<center>Tabla de Viviendas Seleccionadas</center>",
    col.names = c("Precio Total (COP)", "Área (m²)", "Estrato", "Habitaciones", 
                  "Parqueaderos", "Baños", "Longitud", "Latitud"),
    format = "html",
    align = "c"
  ) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed", "responsive"),
    full_width = FALSE,
    position = "center"
  )

Tabla de Viviendas Seleccionadas
Precio Total (COP)	Área (m²)	Estrato	Habitaciones	Parqueaderos	Baños	Longitud	Latitud
540.000.000	180.00	5	4	1	3	-76.54300	3.38600
846.300.000	217.00	4	5	2	5	-76.53100	3.43100
840.000.000	200.00	4	5	1	5	-76.53339	3.43224
696.698.400	217.04	5	5	1	4	-76.55066	3.40862
592.000.000	185.00	5	4	2	2	-76.54803	3.40829
592.000.000	185.00	5	4	2	3	-76.54807	3.40829
592.000.000	185.00	5	4	2	2	-76.54807	3.40831
592.000.000	185.00	5	4	2	2	-76.54807	3.40831
772.200.000	198.00	5	3	1	4	-76.52030	3.38197
579.200.000	181.00	5	4	2	3	-76.52984	3.38359
732.600.000	198.00	4	4	1	4	-76.53076	3.38071
810.600.000	193.00	4	3	2	4	-76.53403	3.38139
752.400.000	198.00	5	4	2	4	-76.53503	3.38250
840.000.000	200.00	5	3	2	4	-76.53611	3.45774
627.000.000	209.00	5	5	1	4	-76.54347	3.39744
540.000.000	180.00	5	3	1	2	-76.54158	3.38230
695.400.000	183.00	4	3	1	3	-76.52862	3.39056
774.000.000	180.00	5	3	2	3	-76.54072	3.41327

Actividad 2 - RLM

Christian David Vera MendivelsoPontificia Universidad Javeriana CaliModelos estadísticos para la toma de decisiones - Grupo A

Introducción.

Características de las Viviendas

Tratamiento inicial de los datos.

Descripción de las Variables

Datos faltantes por variable

Eliminar filas con tres o mas valores faltantes.

Imputación de datos para valores faltantes.

Caso 1: Casas Zona Norte

Filtro de casas de la Zona Norte.

Mapa de distribución de las casas por coordenadas Zona Norte.

Matriz de correlación Casas Zona Norte.

Gráfico de dispersión precio vs área Casas Zona Norte.

Boxplot de precios por estrato Casas Zona Norte.

Boxplot de área por estrato Casas Zona Norte.

Violinplot de precios y áreas Casas Zona Norte.

Modelo 1- Casas Zona Norte.

Coeficientes del modelo.

Interpretación de los Coeficientes del Modelo Lineal

Métricas del modelo 1.

Validación de Supuestos del modelo de Regresion Lineal Multiple.

Homocedasticidad y Lineal

Prueba Breusch-Pagan.

Normalidad de los residuos.

Autocorrelacion de los residuos.

VIF Multicolinealidad del modelo.

Distancia de Cook.

Hat Values.

Gráficos de diagnostico de los supuestos del modelo.

Modelo 2 - Casas Zona Norte (Sin influyentes ni atípicos).

Coeficientes del modelo (Sin influyentes ni atípicos).

Interpretación de los Coeficientes del Modelo Lineal

Validación de Supuestos del modelo de Regresion Lineal Multiple (Sin influyentes ni atípicos)

Homocedasticidad y Lineal (Sin influyentes ni atípicos).

Prueba Breusch Pagan (Sin influyentes ni atípicos).

Normalidad de los residuos (Sin influyentes ni atípicos).

Autocorrelacion de los residuos (Sin influyentes ni atípicos)

Correción de supuestos.

Coeficientes de las transformaciones.

Métricas de las transformaciones.

Supuestos de los modelos realizados con las transformaciones.

Predicción del precio de las viviendas.

Recomendación de viviendas.

Viviendas seleccionadas.

Caso 2. Apartamentos Zona Sur

Filtro de Apartamentos Zona Sur

Mapa de distribución de apartamentos por coordenadas Zona Sur.

Matriz de correlación Apartamentos Zona Sur.

Gráfico de dispersión precio vs área Apartamentos Zona Sur.

Boxplot de precios por estrato Apartamentos Zona Sur.

Boxplot de área por estrato Apartamentos Zona Sur.

Violinplot de precios y áreas Apartamentos Zona Sur.

Modelo 1 - Apartamentos Zona Sur.

Coeficientes del modelo.

Interpretación de los Coeficientes del Modelo Lineal

Métricas del modelo.

Validación de Supuestos del modelo de Regresion Lineal Multiple.

Homocedasticidad y Lineal

Prueba Breusch-Pagan.

Normalidad de los residuos.

Autocorrelacion residuos.

VIF Multicolinealidad.

Distancia de Cook.

Hat Values.

Gráficos de diagnostico de los supuestos del modelo.

Modelo 2 - Apartamentos Zona Sur (Sin influyentes ni atípicos).

Coeficientes del modelo (Sin influyentes ni atípicos).

Interpretación de los Coeficientes del Modelo Lineal

Métricas del modelo (Sin influyentes ni atípicos).

Comprobación de supuestos para el segundo modelo

Homocedasticidad y Lineal (Sin influyentes ni atípicos).

Prueba Breusch Pagan (Sin influyentes ni atípicos).

Normalidad de los residuos (Sin influyentes ni atípicos)

Autocorrelacion de los residuos (Sin influyentes ni atípicos).

Corrección de supuestos.

Coeficientes de las transformaciones.

Métricas de las transformaciones.

Supuestos de los modelos realizados con las transformaciones.

Predicción de precio.

Christian David Vera Mendivelso
Pontificia Universidad Javeriana Cali
Modelos estadísticos para la toma de decisiones - Grupo A