Modelo predictivo del mercado inmobiliario en CDMX

Problematica

El propósito de la evidencia 1 es conocer las variables críticas para pronosticar el valor de los inmuebles de la CDMX. Se nos proporcionó un caso en donde nos explican la importancia de realizar un análisis de mercado para determinar el valor de venta de inmuebles en la CDMX. Estamos trabajando con una inmobiliaria “Erich Zann y Asociados” la cual quiere mejorar su estimación de precios, por lo que su área de mercadotecnia recabó una muestra de 750 propiedades en CDMX y planea aplicar técnicas de minería de datos.

El caso nos dice que el sector inmobiliario representa alrededor del 11% del empleo en México y que su participación en el PIB ha crecido, por lo que es clave estimar bien los precios. Además, el caso explica que ante la gran oferta de desarrollos inmobiliarios en la CDMX, es clave que las inmobiliarias realicen un buen análisis de mercado para fijar precios de venta adecuados de las propiedades.

Se mencionan dos tipos de análisis:

• Análisis primario: Considera la ubicación geográfica, mediante datos censales e información sobre desarrollos urbanos. Analiza accesibilidad, competidores, nivel socioeconómico con SIG.

• Análisis secundario: Analiza características de la vivienda como tamaño, materiales, habitaciones, antigüedad, amenidades. También servicios y si es unifamiliar o multifamiliar.

El caso menciona la importancia de cruzar datos de bases públicas y privadas para obtener un estimado confiable. Describe un caso de una inmobiliaria que quiere mejorar su estimación de precios y la estrategia para lograrlo con análisis de datos.

Librerias

# Librerias
library(dplyr)
library(caret)
library(rpart)
library(rpart.plot)
library(party)
library(gmodels)
library(readr)
library(car)
library(factoextra)
library(lmtest)

Limpieza de datos

Valores faltantes

# Valores faltantes
missing_values = colSums(is.na(df))
missing_values

##        Alcaldia         Colonia              X1              X2              X3 
##               0               0               0               0               0 
##              X4              X5              X6              X7              X8 
##               0               0               0               0               0 
##              X9             X10    Cocina_equip        Gimnasio       Amueblado 
##               0               0               0               0               0 
##         Alberca         Terraza        Elevador   m2_construido           Banos 
##               0               0               0               0               0 
##       Recamaras Estacionamiento          Precio 
##               0               0               0

# No existen valores faltantes dentro de la base de datos

# Eliminar duplicados
df <- df %>% distinct()
# Se eliminaron 5 registros duplicados de la base de datos

Errores Ortográficos

# Errores conocidos
correcciones = list(
  "no" = "No",
  "no " = "No",
  "No " = "No",
  "NO" = "No",
  "si" = "Si",
  "si " = "Si",
  "Si " = "Si",
  "SI" = "Si"
)

# Correción de registros mal escritos
df <- df
for (error in names(correcciones)) {
  df[df == error] <- correcciones[[error]]
}

# Los errores de las variables binarias han sido corregidos y se pueden conventir en categoricas.

Corrección de tipo de variables

# Convertir variables que son porcentajes a numéricas
porcentaje_cols <- c("X1", "X2", "X3", "X4", "X5", "X6", "X7", "X8", "X9", "X10")
df[porcentaje_cols] <- lapply(df[porcentaje_cols], function(x) as.numeric(as.character(x)))

# Convertir características del departamento a numéricas
df$m2_construido <- as.numeric(as.character(df$m2_construido))
df$Banos <- as.numeric(as.character(df$Banos))
df$Recamaras <- as.numeric(as.character(df$Recamaras))
df$Estacionamiento <- as.numeric(as.character(df$Estacionamiento))

# El precio se convierte a numérico, asegurándose de eliminar los comas si los hubiera
df$Precio <- as.numeric(gsub(",", "", as.character(df$Precio)))

# Convertir variables binarias a factores
binarias_cols <- c("Cocina_equip", "Gimnasio", "Amueblado", "Alberca", "Terraza", "Elevador", "Colonia", "Alcaldia")
df[binarias_cols] <- lapply(df[binarias_cols], as.factor)

# Sustitución de valores nulos con la mediana de la variable
df$Estacionamiento[is.na(df$Estacionamiento)] = median(df$Estacionamiento,na.rm = TRUE)

EDA

# Analizar los datos
summary(df)

##               Alcaldia                   Colonia          X1       
##  Iztapalapa       : 92   Santa Fe            : 29   Min.   :0.350  
##  Alvaro Obregon   : 91   Polanco             : 22   1st Qu.:0.960  
##  Tlahuac          : 80   San Angel           : 13   Median :1.400  
##  Gustavo A. Madero: 79   San Jerónimo Líndice: 11   Mean   :1.354  
##  Coyoacan         : 45   Lomas Estrella      : 10   3rd Qu.:1.550  
##  Miguel Hidalgo   : 38   Miguel Hidalgo      : 10   Max.   :2.800  
##  (Other)          :228   (Other)             :558                  
##        X2              X3              X4              X5       
##  Min.   :3.810   Min.   :31.70   Min.   : 6.07   Min.   :18.46  
##  1st Qu.:4.980   1st Qu.:40.21   1st Qu.:15.50   1st Qu.:23.74  
##  Median :5.620   Median :42.85   Median :18.21   Median :25.42  
##  Mean   :5.372   Mean   :42.30   Mean   :17.21   Mean   :26.22  
##  3rd Qu.:5.680   3rd Qu.:46.56   3rd Qu.:20.05   3rd Qu.:28.25  
##  Max.   :6.780   Max.   :51.23   Max.   :23.46   Max.   :32.20  
##                                                                 
##        X6              X7               X8                X9        
##  Min.   :0.480   Min.   : 0.030   Min.   :0.02000   Min.   : 3.170  
##  1st Qu.:1.830   1st Qu.: 0.110   1st Qu.:0.03000   1st Qu.: 6.220  
##  Median :3.190   Median : 0.300   Median :0.05000   Median : 8.150  
##  Mean   :3.385   Mean   : 1.024   Mean   :0.07752   Mean   : 7.812  
##  3rd Qu.:4.540   3rd Qu.: 0.710   3rd Qu.:0.10000   3rd Qu.: 9.560  
##  Max.   :8.530   Max.   :10.210   Max.   :0.23000   Max.   :13.060  
##                                                                     
##       X10        Cocina_equip Gimnasio Amueblado Alberca  Terraza  Elevador
##  Min.   :15.15   No: 61       No:471   No:639    No:542   No:337   No:297  
##  1st Qu.:35.22   Si:592       Si:182   Si: 14    Si:111   Si:316   Si:356  
##  Median :39.65                                                             
##  Mean   :40.08                                                             
##  3rd Qu.:50.08                                                             
##  Max.   :63.97                                                             
##                                                                            
##  m2_construido       Banos         Recamaras     Estacionamiento
##  Min.   : 34.0   Min.   :1.000   Min.   :1.000   Min.   :0.000  
##  1st Qu.: 58.0   1st Qu.:1.000   1st Qu.:2.000   1st Qu.:1.000  
##  Median : 73.0   Median :1.000   Median :2.000   Median :1.000  
##  Mean   :103.1   Mean   :1.684   Mean   :2.315   Mean   :1.409  
##  3rd Qu.:120.0   3rd Qu.:2.000   3rd Qu.:3.000   3rd Qu.:2.000  
##  Max.   :500.0   Max.   :5.000   Max.   :5.000   Max.   :5.000  
##                                                                 
##      Precio      
##  Min.   :     1  
##  1st Qu.:   860  
##  Median :  1960  
##  Mean   :  4285  
##  3rd Qu.:  5548  
##  Max.   :128524  
## 

# Para la elaboración de esta gráfica se eliminaron los valores atípicos de la variable dependiente en este caso la del PRECIO*

# NOTA: Para la elaboración de esta gráfica se eliminaron los valores atípicos de la variable dependiente* 

Medias de variables socioeconomicas por alcaldía

## # A tibble: 16 × 11
##    Alcaldia             X1    X2    X3    X4    X5    X6    X7    X8    X9   X10
##    <fct>             <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1 Alvaro Obregon     1.34  5.68  42.8 17.8   23.7  3.19  0.28  0.03  6.98  36.6
##  2 Azcapotzalco       0.96  5.97  39.0 15.5   20.6  1.83  0.46  0.03  7.57  35.2
##  3 Benito Juárez      0.35  6.23  31.7  6.07  20.1  0.48  0.03  0.02  3.17  15.2
##  4 Coyoacan           0.77  4.98  32.9 11.0   24.6  1.7   0.05  0.03  5.47  25.7
##  5 Cuahtemoc          0.9   6.78  42.1 12.2   26.8  1.7   0.11  0.05  6.21  30.7
##  6 Cuajimalpa         1.55  5.76  44.4 18.9   24.4  4.17  0.43  0.06  6.68  39.6
##  7 Gustavo A. Madero  1.4   4.99  40.2 18.2   25.4  2.92  0.3   0.05  9.53  43.9
##  8 Iztacalco          1.13  4.47  41.4 17.0   27.0  2.92  0.07  0.05  7.68  39.1
##  9 Iztapalapa         1.86  5.62  47.8 21.7   32.2  4.54  0.71  0.17  9.56  50.1
## 10 La Magdalena Con…  1.86  5.62  47.8 21.7   32.2  4.54  0.71  0.17  9.56  50.1
## 11 Miguel Hidalgo     0.61  5.57  35.5 10.5   18.5  1.06  0.07  0.03  4.5   20.1
## 12 Milpa alta         2.8   3.81  51.2 23.5   30.3  8.53  6.47  0.23 13.1   64.0
## 13 Tlahuac            1.54  4.5   46.6 20.0   26.8  5.04  0.96  0.1   9.61  52.8
## 14 Tlalpan            1.39  4.6   40.3 16.5   27.9  3.71  3.91  0.08  6.22  36.8
## 15 Venustiano Carra…  1.02  6.37  43.6 16.4   28.2  2.28  0.06  0.04  8.15  39.1
## 16 Xochimilco         2.3   4.57  46.7 21.3   32.1  6.81 10.2   0.17  8.25  50.1

Varianza de medias de variables socioeconimicas por alcaldía

## # A tibble: 1 × 10
##      X1    X2    X3    X4    X5    X6    X7      X8    X9   X10
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>   <dbl> <dbl> <dbl>
## 1 0.400 0.668  30.0  22.8  18.2  4.52  8.36 0.00436  5.65  160.

ANOVA por alcaldía

anova_resultado <- aov(Precio ~ Alcaldia, data = df)
print(summary(anova_resultado))

##              Df    Sum Sq   Mean Sq F value Pr(>F)    
## Alcaldia     15 1.240e+10 826540606   27.21 <2e-16 ***
## Residuals   637 1.935e+10  30378199                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Identificación de variables significantes

# Con esta matriz de correlación se pueden ver dos segmentos en morado, donde hay mayor relación entre las variables. Se destacan por ser las variables Númericas que son características más sociales de las alcadías que en comparación con el otro segmento se pueden ver las variables de los inmuebles como lo son baños, mts de construcción, recámaras, etc. A continuación se hará una regresión con las variables que más relevancia pueden tener en base a su correlación para lograr predecir de mejor manera.

# Construir el modelo de regresión lineal usando todas las variables predictoras
modelo <- lm(Precio ~ + m2_construido + X5 + X9, data = df)

# Mostrar el resumen del modelo
summary(modelo)

## 
## Call:
## lm(formula = Precio ~ +m2_construido + X5 + X9, data = df)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -10924  -1253   -248    781 124006 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   7549.919   1598.967   4.722 2.87e-06 ***
## m2_construido   49.074      3.044  16.119  < 2e-16 ***
## X5            -190.125     72.932  -2.607  0.00935 ** 
## X9            -427.547    148.644  -2.876  0.00416 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5396 on 649 degrees of freedom
## Multiple R-squared:  0.4047, Adjusted R-squared:  0.402 
## F-statistic: 147.1 on 3 and 649 DF,  p-value: < 2.2e-16

# Análisis de multiconlinealidad del modelo
vif(modelo)

## m2_construido            X5            X9 
##      1.166020      1.870508      1.972881

# El resultado obtenido al calcular el VIF (variance inflation factor) en R muestra los valores de inflación de la varianza para cada predictor en el modelo. En este caso, los valores son 1.166 para "m2_construido", 1.870508 para "X5", y 1.972881 para "X9".

# Un VIF de 1 indica que no hay multicolinealidad y generalmente, valores por encima de 5 o 10 son motivo de preocupación. Pero en este caso, los valores son relativamente bajos, lo que nos dice que la multicolinealidad no es un problema significativo entre las variables "m2_construido", "X5", y "X9".

Realización de modelo predictivo

División de clusters

# Seleccionar y normalizar solo las variables numéricas
df_num <- df[, c("X1","X2","X3","X4","X5","X6", "X7", "X8","X9","X10")]
df_norm <- scale(df_num)

# Método del Codo para determinar el número óptimo de clusters
wss <- numeric(15)
for (i in 2:15) {
  wss[i] <- sum(kmeans(df_norm, centers = i, nstart = 25)$withinss)
}
plot(1:15, wss, type = "b", xlab = "Número de Clusters", ylab = "Suma de Cuadrados Internos")

# Este método nos ayuda a identificar el número ideal de clusters que mejor segmenta los datos, ya que más allá de ese punto los clusters marginales no aportan una mejora en la agrupación de los datos. Es una técnica gráfica sencilla pero muy útil en clustering, como lo vimos en clase.

# Ejecutar K-means con el número óptimo de clusters
set.seed(123)
kmeans_result <- kmeans(df_norm, centers = 4, nstart = 25)

# Visualizar los clusters
fviz_cluster(kmeans_result, data = df_norm)

# Identificamos los registros por su agrupación
df$Cluster = kmeans_result$cluster

# El código fija una semilla aleatoria de 123 para asegurar que los resultados sean reproducibles. Luego, especifica que se usarán 4 centros iniciales para el agrupamiento, escogiendo al azar 4 filas de los datos escalados para utilizarlas como centros iniciales en el algoritmo de agrupamiento k-means.

Separación por numero de cluster

dataframes_divididos <- split(df, df$Cluster)

df1 = dataframes_divididos[[1]]
df2 = dataframes_divididos[[2]]
df3 = dataframes_divididos[[3]]
df4 = dataframes_divididos[[4]]

# Realizar K-means con 4 clusters
kmeans_result <- kmeans(df_norm, centers = 4)
kmeans_result$centers

##            X1         X2         X3         X4         X5          X6
## 1  0.05794808 -0.1463918 -0.1187613  0.1599367 -0.3043652 -0.08103771
## 2 -1.52489938  0.1697685 -1.7832512 -1.8151525 -1.2260080 -1.35368284
## 3  1.00107548 -0.5346552  1.0405275  0.9447134  0.9985613  1.09007040
## 4 -0.80331178  1.5035155 -0.1394220 -0.5703822 -0.2371310 -0.87951970
##           X7         X8          X9         X10
## 1 -0.1278372 -0.5367075 -0.02864148 -0.05192223
## 2 -0.4625695 -0.8734920 -1.61674686 -1.71347196
## 3  0.5094918  1.2344243  0.89995396  1.05776719
## 4 -0.3882318 -0.6625426 -0.21894816 -0.43709982

# Clasificación Socioeconómica y de Infraestructura Urbana

#Nombres de los Clústeres:
#1. Clúster de Desventaja Educativa y de Salud Pública
#2. Clúster de Retos en Educación Juvenil y Acceso a Recursos Hídricos
#3. Clúster de Desafíos de Infraestructura Habitacional y Servicios Básicos
#4. Clúster de Relativa Estabilidad en Educación Infantil

# La agrupación por clusters puede ayudarnos a identificar patrones intrínsecos en los datos que podrían no ser evidentes de otra manera. Se pueden ver los grupos de observaciones que comparten similitudes en sus características. Como lo vimos en clase, con un ejemplo de Marketing,  la agrupación por clusters se utiliza para segmentar a los clientes en grupos homogéneos. Esto permite personalizar estrategias de marketing para cada segmento, ya que se espera que los clientes dentro del mismo clúster tengan comportamientos y preferencias similares. Y en este caso nos permitió agrupar por clusters socioeconomicos las variables y poder conocer aspectos más sociales para poder predecir en base a qué características se conforma el precio correcto.

Segmento 1

trainIndex1_1 <- createDataPartition(df1$Precio, p = 0.5, list = FALSE, times = 1)
train1 <- df1[trainIndex1_1, ]
temp1 <- df1[-trainIndex1_1, ]

trainIndex2_1 <- createDataPartition(temp1$Precio, p = 0.5, list = FALSE, times = 1)
validation1 <- temp1[trainIndex2_1, ]
test1 <- temp1[-trainIndex2_1, ]

# Ajustar los parámetros de control de rpart para permitir un árbol más complejo
tree1 <- rpart(Precio ~ . -Colonia, data = train1, method = "anova",
              control = rpart.control(cp = 0.001, minsplit = 20, maxdepth = 10))
rpart.plot(tree1)

# Visualizar la curva de complejidad de costo
plotcp(tree1)

################ Validación Cruzada  ##################################

#### Imputar valores faltantes
preproc <- preProcess(validation1, method = "medianImpute")
validation_clean1 <- predict(preproc, df1)


# Definir el método de control de entrenamiento para la validación cruzada k-fold
ctrl <- trainControl(method = "cv", number = 10)

# Entrenar el modelo con validación cruzada para regresión
tree_model_cv1 <- train(Precio ~ ., data = validation_clean1, 
                       method = "rpart", 
                       trControl = ctrl,
                       tuneLength = 10)

## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.

# Ver los resultados
print(tree_model_cv1)

## CART 
## 
## 109 samples
##  23 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 97, 100, 99, 98, 99, 98, ... 
## Resampling results across tuning parameters:
## 
##   cp           RMSE      Rsquared   MAE     
##   0.000862914  3558.663  0.7787767  2173.039
##   0.001034499  3558.663  0.7787767  2173.039
##   0.001050670  3557.650  0.7789515  2169.601
##   0.001191702  3554.616  0.7791650  2170.853
##   0.003205475  3476.372  0.7894267  2148.103
##   0.005102365  3470.912  0.7902859  2143.445
##   0.008537861  3522.204  0.7779497  2181.761
##   0.010591626  3529.130  0.7745540  2177.496
##   0.101778000  3709.956  0.7718408  2215.812
##   0.630286231  6037.144  0.5639961  4624.777
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.005102365.

# Ajusta el valor de cp según los resultados de la validación cruzada para explorar un árbol más complejo
optimal_cp1 <- tree_model_cv1$results$cp[which.min(tree_model_cv1$results$RMSE)]
pruned_tree1 <- prune(tree1, cp = optimal_cp1)

# Visualizar el árbol podado
rpart.plot(pruned_tree1)

# Realizar predicciones en el conjunto de prueba con el árbol podado
predictions1 <- predict(pruned_tree1, newdata = test1)

# Calcular e imprimir las métricas de evaluación para el modelo podado
postResample(pred = predictions1, obs = test1$Precio)

##         RMSE     Rsquared          MAE 
## 4498.8373975    0.6689129 2487.2600866

# Para el cluster 1 (Desventaja Educativa y de Salud Pública), se alcanza una cobertura del 38% cuando la variable X5 (Porcentaje de población sin derechohabiencia a servicio de salud) supera el 19%, y los espacios de estacionamiento de vivienda son inferiores a 2, obteniendo precios de 2559.

# Evaluar el modelo podado
rmse <- sqrt(mean((predictions1 - test1$Precio)^2))
r2 <- cor(predictions1, test1$Precio)^2

cat("RMSE:", rmse, "\n")

## RMSE: 4498.837

cat("R-squared:", r2, "\n")

## R-squared: 0.6689129

Segmento 2

trainIndex1_2 <- createDataPartition(df2$Precio, p = 0.5, list = FALSE, times = 1)
train2 <- df2[trainIndex1_2, ]
temp2 <- df2[-trainIndex1_2, ]

trainIndex2_2 <- createDataPartition(temp2$Precio, p = 0.5, list = FALSE, times = 1)
validation2 <- temp2[trainIndex2_2, ]
test2 <- temp2[-trainIndex2_2, ]

# Ajustar los parámetros de control de rpart para permitir un árbol más complejo
tree2 <- rpart(Precio ~ . -Colonia, data = train2, method = "anova",
              control = rpart.control(cp = 0.001, minsplit = 20, maxdepth = 10))
rpart.plot(tree2)

# Visualizar la curva de complejidad de costo
plotcp(tree2)

################ Validación Cruzada  ##################################

#### Imputar valores faltantes
validation_clean2 <- predict(preproc, df2)

# Entrenar el modelo con validación cruzada para regresión
tree_model_cv2 <- train(Precio ~ ., data = validation_clean2, 
                       method = "rpart", 
                       trControl = ctrl,
                       tuneLength = 10)

## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.

# Ver los resultados
print(tree_model_cv2)

## CART 
## 
## 190 samples
##  23 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 171, 171, 171, 171, 171, 171, ... 
## Resampling results across tuning parameters:
## 
##   cp            RMSE      Rsquared   MAE     
##   1.658470e-05  1064.604  0.7853324  600.6890
##   8.188744e-05  1063.909  0.7859570  598.7646
##   8.260644e-05  1063.909  0.7859570  598.7646
##   9.996674e-05  1063.731  0.7859990  598.0906
##   2.927415e-04  1062.131  0.7849509  600.0742
##   8.207020e-04  1060.186  0.7871990  598.4109
##   1.843812e-03  1057.008  0.7803459  589.5088
##   4.119036e-03  1064.772  0.7765501  599.6884
##   1.841149e-02  1110.727  0.7869518  641.1212
##   6.828715e-01  1489.478  0.7212388  871.2762
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.001843812.

# Ajusta el valor de cp según los resultados de la validación cruzada para explorar un árbol más complejo
optimal_cp2 <- tree_model_cv2$results$cp[which.min(tree_model_cv2$results$RMSE)]
pruned_tree2 <- prune(tree2, cp = optimal_cp2)

# Visualizar el árbol podado
rpart.plot(pruned_tree2)

# Realizar predicciones en el conjunto de prueba con el árbol podado
predictions2 <- predict(pruned_tree2, newdata = test2)

# Calcular e imprimir las métricas de evaluación para el modelo podado
postResample(pred = predictions2, obs = test2$Precio)

##       RMSE   Rsquared        MAE 
## 948.903581   0.753492 569.128288

# El cluster 2 (Retos en Educación Juvenil y Acceso a Recursos Hídricos) presenta una cobertura superior al 36% de los casos, con un precio de 869 cuando los metros cuadrados construidos son menores a 83, la vivienda tiene 3 recámaras y se encuentra en la alcaldía de Iztapalapa.

# Evaluar el modelo podado
rmse <- sqrt(mean((predictions2 - test2$Precio)^2))
r2 <- cor(predictions2, test2$Precio)^2

cat("RMSE:", rmse, "\n")

## RMSE: 948.9036

cat("R-squared:", r2, "\n")

## R-squared: 0.753492

Segmento 3

# Separar las variables numericas
datos_numericos3 <- df3[sapply(df3, is.numeric)]
  
# Calcular la matriz de correlación
matriz_correlacion3 <- cor(datos_numericos3)

## Warning in cor(datos_numericos3): the standard deviation is zero

# Mostrar la matriz de correlación
ggplot(data = reshape2::melt(matriz_correlacion3)) +
  geom_tile(aes(Var2, Var1, fill = value)) +
  scale_fill_gradient2(low = "pink", mid = "white", high = "purple", midpoint = 0, limits = c(-1, 1)) +
  labs(title = "Matriz de correlación ") +
  theme_minimal()

# Construir el modelo de regresión lineal usando todas las variables predictoras
modelo3 <- lm(Precio ~ + m2_construido + Banos + Recamaras + Amueblado + Cocina_equip + Estacionamiento, data = df3)

# Mostrar el resumen del modelo
summary(modelo3)

## 
## Call:
## lm(formula = Precio ~ +m2_construido + Banos + Recamaras + Amueblado + 
##     Cocina_equip + Estacionamiento, data = df3)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1338.64  -371.87    30.54   407.63  1461.36 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -829.484    517.643  -1.602   0.1203    
## m2_construido     32.308      5.737   5.631 4.96e-06 ***
## Banos            274.171    362.042   0.757   0.4552    
## Recamaras       -447.189    232.843  -1.921   0.0650 .  
## AmuebladoSi     -554.078    757.986  -0.731   0.4709    
## Cocina_equipSi   837.030    325.514   2.571   0.0157 *  
## Estacionamiento  485.913    354.620   1.370   0.1815    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 714.6 on 28 degrees of freedom
## Multiple R-squared:  0.7571, Adjusted R-squared:  0.7051 
## F-statistic: 14.55 on 6 and 28 DF,  p-value: 1.784e-07

## Análisis de multiconlinealidad del modelo
vif(modelo3)

##   m2_construido           Banos       Recamaras       Amueblado    Cocina_equip 
##        1.644633        2.229561        1.717008        1.093026        1.482204 
## Estacionamiento 
##        1.365079

# No existe algún problema de multicolinealidad en el modelo.

## Análisis de homocedasticidad en los errores (Breusch-Pagan Test)
bptest(modelo3)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo3
## BP = 6.7183, df = 6, p-value = 0.3477

# No se puede rechazar la H0 debido al p-value, esto nos ayuda a concluir que existe homocedasticidad en los errores.

## Análisis de normalización de residuales
histogram(modelo3$residuals)

# Se puede observar que existe una normalización en la distribución de los residuales.

# En el cluster 3 (Desafíos de Infraestructura Habitacional y Servicios Básicos), se desarrolló un modelo de regresión lineal para analizar la correlación entre las variables determinantes en el modelo. Esto se respaldó con una matriz de correlación, simplificando la visualización de los datos. El modelo incluyó la variable dependiente "precio" junto con las independientes "m2_construido, baños, recámaras, amueblado, cocina_equip y estacionamiento". Identificando la correlación, se observó que la variable "Baños" tiene un impacto significativo.

Segmento 4

trainIndex1_4 <- createDataPartition(df4$Precio, p = 0.5, list = FALSE, times = 1)
train4 <- df4[trainIndex1_4, ]
temp4 <- df4[-trainIndex1_4, ]

trainIndex2_4 <- createDataPartition(temp4$Precio, p = 0.5, list = FALSE, times = 1)
validation4 <- temp4[trainIndex2_4, ]
test4 <- temp4[-trainIndex2_4, ]

# Ajustar los parámetros de control de rpart para permitir un árbol más complejo
tree4 <- rpart(Precio ~ . -Colonia, data = train4, method = "anova",
              control = rpart.control(cp = 0.001, minsplit = 20, maxdepth = 10))
rpart.plot(tree4)

# Visualizar la curva de complejidad de costo
plotcp(tree4)

################ Validación Cruzada  ##################################

#### Imputar valores faltantes
validation_clean4 <- predict(preproc, df4)

# Entrenar el modelo con validación cruzada para regresión
tree_model_cv4 <- train(Precio ~ ., data = validation_clean4, 
                       method = "rpart", 
                       trControl = ctrl,
                       tuneLength = 10)

## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.

# Ver los resultados
print(tree_model_cv4)

## CART 
## 
## 319 samples
##  23 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 287, 287, 288, 287, 286, 288, ... 
## Resampling results across tuning parameters:
## 
##   cp            RMSE      Rsquared      MAE     
##   0.0008376187  4987.434  0.6067136262  1871.282
##   0.0018941079  5029.156  0.5969331197  1933.948
##   0.0038855643  5083.861  0.5856555151  2071.333
##   0.0039479366  5083.972  0.5851421503  2070.564
##   0.0039905487  5083.972  0.5851421503  2070.564
##   0.0063104432  5158.789  0.5667411094  2166.044
##   0.0120987553  5407.065  0.5131624259  2499.374
##   0.0182638754  5539.105  0.4710009559  2583.173
##   0.0540082126  5386.398  0.4653672350  2627.427
##   0.2112042613  6519.024  0.0009837559  4012.099
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.0008376187.

# Ajusta el valor de cp según los resultados de la validación cruzada para explorar un árbol más complejo
optimal_cp4 <- tree_model_cv4$results$cp[which.min(tree_model_cv4$results$RMSE)]
pruned_tree4 <- prune(tree4, cp = optimal_cp4)

# Visualizar el árbol podado
rpart.plot(pruned_tree4)

# Realizar predicciones en el conjunto de prueba con el árbol podado
predictions4 <- predict(pruned_tree4, newdata = test4)

# Calcular e imprimir las métricas de evaluación para el modelo podado
postResample(pred = predictions4, obs = test4$Precio)

##         RMSE     Rsquared          MAE 
## 4219.6530688    0.4482395 1879.9165939

# Evaluar el modelo podado
rmse <- sqrt(mean((predictions4 - test4$Precio)^2))
r2 <- cor(predictions4, test4$Precio)^2

cat("RMSE:", rmse, "\n")

## RMSE: 4219.653

cat("R-squared:", r2, "\n")

## R-squared: 0.4482395

# Dentro del cluster 4 (Relativa Estabilidad en Educación Infantil), hay ramas más diversas, pero la rama de mayor pureza es del 10%, con un precio de 4194 cuando los metros cuadrados construidos son menores a 92 y se encuentra en las alcaldías de Álvaro Obregón, Cuauhtémoc o Cuajimalpa. A continuación, se identificaron tres ramas con el mismo porcentaje de pureza pero en tres grupos diferentes, con metros cuadrados construidos menores a 92, entre 125 a 191 y de 191 a 288. Los últimos dos cumplen la condición de tener más de 2.3 baños, mientras que el primero cumple con la misma condición y se encuentra en las alcaldías mencionadas anteriormente.

#Interpretaciones finales
# Para el cluster 1 (Desventaja Educativa y de Salud Pública), se llega a un rango de cobertura de 23% cuando la variable X5 (Porcentaje de población sin derechohabiencia a servicio de salud) sobrepasa el 19% y el los m2 de construcción son menores a 185 obteniendo los precios de 16e+3. 

# El cluster 2 (Retos en Educación Juvenil y Acceso a Recursos Hídricos) presenta una cobertura mayor del 53% de los casos con un precio de 853 cuando los m2 construidos son menores a 66, la vivienda cuenta con menos de 3 recamaras.

# En el cluster 3 (Desafíos de Infraestructura Habitacional y Servicios Básicos) se creó un modelo de regresión lineal para analizar la correlación entre las variables detonantes en el modelo, esto fue sustentado por una matriz de correlación haciendo más sencilla la visualización de los datos. El modelo contaba con la variable dependiente de “precio” junto con las independientes de “m2_construido, baños, recámaras, amueblado, cocina_equip y estacionamiento”. Identificando la correlación de las variables, se logra observar que la que genera mayor impacto o relación con la variable dependiente es la de “Baños” al tener un valor de 2.2295.

# Dentro del cluster 4 (Relativa Estabilidad en Educación Infantil) cuenta con mayores ramas variadas, sin embargo, la rama de mayor pureza es del 37% con un precio de 720 cuando X9 () es mayor o igual a 7.6 y se encuentra dentro de las alcaldías de Azcapotzalco, Gustavo A, Iztacalco, Tlalpan Venustiano. Después con los m2 construidos menores a 130 con precios de 4560.

# ¿Como se icieron las interpretaciones de los árboles?

# Se inició el análisis del árbol mediante la configuración inicial de parámetros de control, permitiendo trabajar con un árbol más complejo. Utilizando la función Rpart, se definieron los parámetros para la regresión, siendo "Precio" la variable de respuesta frente a "Colonia", que actúa como variable predictora. Tras crear la visualización mediante "Rpart.plot", se procedió a la validación cruzada. Se empleó la función preProcess para imputar valores faltantes en el modelo, facilitando la implementación de técnicas de preprocesamiento antes del entrenamiento de modelos. Luego, se estableció el método de control para la validación k-fold utilizando trainControl, seguido de la capacitación del modelo mediante validación cruzada para regresión, y se imprimieron los resultados. En los cuatro segmentos analizados para los árboles, se obtuvieron resultados eficientes en los porcentajes de pureza durante el proceso de podado. 

# Las principales ventajas de este método son su interpretabilidad, pues nos da un conjunto de reglas a partir de las cuales se pueden tomar decisiones. Este es un algoritmo que no es demandante en poder de cómputo comparado con procedimientos más sofisticados y, a pesar de ello, que tiende a dar buenos resultados de predicción para muchos tipos de datos.

# Sus principales desventajas son que este en tipo de clasificación “débil”, pues sus resultados pueden variar mucho dependiendo de la muestra de datos usados para entrenar un modelo. Además es fácil sobre ajustar los modelos, esto es, hacerlos excelentes para clasificar datos que conocemos, pero deficientes para datos conocidos.