Oferta Inmobiliaria

Problema

Una empresa inmobiliaria líder en una gran ciudad está buscando comprender en profundidad el mercado de viviendas urbanas para tomar decisiones estratégicas más informadas. La empresa posee una base de datos extensa que contiene información detallada sobre diversas propiedades residenciales disponibles en el mercado. Se requiere realizar un análisis holístico de estos datos para identificar patrones, relaciones y segmentaciones relevantes que permitan mejorar la toma de decisiones en cuanto a la compra, venta y valoración de propiedades.

Exploración de la base de datos:

Encontramos un dataset con 8322 filas y 13 columnas

data("vivenda")
data <- as.data.frame(vivienda)
#str(data)
print (head(data))

    id         zona piso estrato preciom areaconst parqueaderos banios
1 1147 Zona Oriente <NA>       3     250        70            1      3
2 1169 Zona Oriente <NA>       3     320       120            1      2
3 1350 Zona Oriente <NA>       3     350       220            2      2
4 5992     Zona Sur   02       4     400       280            3      5
5 1212   Zona Norte   01       5     260        90            1      2
6 1724   Zona Norte   01       5     240        87            1      3
  habitaciones        tipo      barrio  longitud latitud
1            6        Casa 20 de julio -76.51168 3.43382
2            3        Casa 20 de julio -76.51237 3.43369
3            4        Casa 20 de julio -76.51537 3.43566
4            3        Casa  3 de julio -76.54000 3.43500
5            3 Apartamento       acopi -76.51350 3.45891
6            3 Apartamento       acopi -76.51700 3.36971

print(dim(data))

[1] 8322   13

#view(dfSummary(data))

Validaciòn de datos faltantes:

print(md.pattern(data))

     preciom id zona estrato 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
1          1  0    0       0         0      0            0    0      0        0
2          0  0    0       0         0      0            0    0      0        0
           2  3    3       3         3      3            3    3      3        3
     latitud parqueaderos piso     
4808       1            1    1    0
1909       1            1    0    1
876        1            0    1    1
726        1            0    0    2
1          0            0    0   12
2          0            0    0   13
           3         1605 2638 4275

Limpieza de la base de datos:

• Se elimina la variable ID del modelo.
• Para las variables piso y parqueadero con 2.635 y 1.602 datos faltantes respectivamente no se tendrán en cuenta en el analisis ya que podría interferir en los resultados.
• Se identifican ademas 14 apartamentos y 31 casas con 0 baños. se imputa con la moda de cada tipo Apartameno o casa
• Se identifican 21 apartamentos y 45 casas con 0 habitaciones. se imputa con la moda de cada tipo Apartameno o casa

La base limpia contiene 8.319 filas y 10 columnas

data <- data[, !(names(data) %in% c('id', 'piso', 'parqueaderos'))]

nas = sapply(data, function(x) sum(is.na(x)))
#print(nas)

#head(data)
# aliminar 3 registros que en su mayoría de variables es NA, para esto se filtra los que son NA en zona y se sacan del modelo
data <- data[!is.na(data$zona), ]
#table(data$piso,data$tipo)
#table(data$parqueaderos)

#table(data$banios,data$tipo)
#table(data$habitaciones,data$tipo)
#table(data$barrio,data$estrato)

data <- data %>%
  group_by(tipo) %>%
  mutate(
    # Calcular la moda de 'bancos' y reemplazar ceros
    banios = ifelse(banios == 0, Mode(banios[banios != 0]), banios),
    
    # Calcular la moda de 'habitaciones' y reemplazar ceros
    habitaciones = ifelse(habitaciones == 0, Mode(habitaciones[habitaciones != 0]), habitaciones)
  ) %>%
  ungroup()

print(head(data))

# A tibble: 6 × 10
  zona       estrato preciom areaconst banios habitaciones tipo  barrio longitud
  <chr>        <dbl>   <dbl>     <dbl>  <dbl>        <dbl> <chr> <chr>     <dbl>
1 Zona Orie…       3     250        70      3            6 Casa  20 de…    -76.5
2 Zona Orie…       3     320       120      2            3 Casa  20 de…    -76.5
3 Zona Orie…       3     350       220      2            4 Casa  20 de…    -76.5
4 Zona Sur         4     400       280      5            3 Casa  3 de …    -76.5
5 Zona Norte       5     260        90      2            3 Apar… acopi     -76.5
6 Zona Norte       5     240        87      3            3 Apar… acopi     -76.5
# ℹ 1 more variable: latitud <dbl>

print(dim(data))

[1] 8319   10

1. Análisis de Componentes Principales:

Reducir la dimensionalidad del conjunto de datos y visualizar la estructura de las variables en componentes principales para identificar características clave que influyen en la variación de precios y oferta del mercado.

• Para el ACP seleccionamos las variables: Estrato, preciom, areaconst, banios, y habitaciones. Se escalan las variables numericas en un df llamado data_num_es

data_num <- data %>%
  select(estrato,preciom,areaconst,banios,habitaciones)
# escalar el dataset

data_num_es <- scale(data_num)

acp <- prcomp(data_num_es)
#acp$sdev
print(acp)

Standard deviations (1, .., p=5):
[1] 1.7210777 1.0963791 0.6408450 0.4859796 0.4347250

Rotation (n x k) = (5 x 5):
                   PC1        PC2        PC3        PC4        PC5
estrato      0.3226310 -0.6833161  0.4139012 -0.4906084  0.1302979
preciom      0.5045557 -0.2798188 -0.3176140  0.2667007 -0.7036455
areaconst    0.4969704  0.1723718 -0.6398386 -0.3334911  0.4502207
banios       0.5201932  0.0942639  0.3813961  0.6404150  0.4061022
habitaciones 0.3517844  0.6451224  0.4158734 -0.4084439 -0.3468252

#importancia de los componentes
fviz_eig(acp, addlabels = TRUE, color = "red")

Los dos primeros componentes principales explican el 83,2% de la varianza total. Esto es bastante bueno, ya que podemos reducir la dimensionalidad a 2 sin perder información.

⦿ Componente 1: Explica el 59,2% de la varianza y las varibles banios, areaconst y preciom están altamente correlacionadas entre sì y son las que influyen en este componente ⦿ Componente 2: Explica el 24% de la varianza, el número de habitaciones tiene una fuerte influencia sobte este componente. Por otra parte, estrato tiene una carga negativa.

# circoide corr
fviz_pca_var(acp,
col.var = "contrib", # Color by contributions to the PC
gradient.cols = c("#FF7F00",  "#034D94"),
repel = TRUE     # Avoid text overlapping
)

#contribuciòn de la variable al componente
fviz_contrib(acp, choice = "var", axes=1)

fviz_contrib(acp, choice = "var", axes=2)

Para darle sentido a los ejes se seleccionan 4 casos extremos

#gràfica de puntos
#fviz_pca_ind(acp, col.ind = "blue",max.overlap= 50)

# analiszar casos especìficos
casos1 <- rbind(acp$x[8073,1:2],acp$x[5022,1:2]) # CP1
rownames(casos1) = c("8073","5022")
casos1 <- as.data.frame(casos1)

casos2 <- rbind(acp$x[357,1:2], acp$x[2110,1:2]) # CP2
rownames(casos2) = c("357","2110")
casos2 <- as.data.frame(casos2)

fviz_pca_biplot(acp, col.ind = "#DEDEDE") +
  geom_point(data = casos1, aes(x = PC1, y = PC2), color = "red", size = 3) +
  geom_point(data = casos2, aes(x = PC1, y = PC2), color = "blue", size = 3)

datos_extremos <- rbind(data[8073, ],
                data[5022, ],
                data[357, ],
                data[2110, ])

datos_extremos <- as.data.frame(datos_extremos)
rownames(datos_extremos) = c("Inmueble 8073", "Inmueble 5022", "Inmueble 357", "Inmueble 2110")
datos_extremos

                     zona estrato preciom areaconst banios habitaciones
Inmueble 8073  Zona Norte       3     370      1440      4           10
Inmueble 5022    Zona Sur       6    1650      1500      5            3
Inmueble 357  Zona Centro       3     350       340      4           10
Inmueble 2110    Zona Sur       5     165        45      1            1
                     tipo          barrio  longitud latitud
Inmueble 8073        Casa villa del prado -76.49815 3.46343
Inmueble 5022        Casa           pance -76.49299 3.46805
Inmueble 357         Casa        aranjuez -76.53126 3.43908
Inmueble 2110 Apartamento cuarto de legua -76.55066 3.40979

Inmueble 5022 està mas relacionado con las variables de CP1, alto precio y area construida pero con pocas habitaciones Inmueble 2110 bajo precio y area construida

2 .Análisis de Conglomerados:

Agrupar las propiedades residenciales en segmentos homogéneos con características similares para entender las dinámicas de las ofertas específicas en diferentes partes de la ciudad y en diferentes estratos socioeconómicos.

Partimos de df escalado que calculamos anteriormente y calculamos las distancias euclidianas

# creamos una variable que agrupe el precio por metro cuadrado para poder segmentar mejor

head(data)

# A tibble: 6 × 10
  zona       estrato preciom areaconst banios habitaciones tipo  barrio longitud
  <chr>        <dbl>   <dbl>     <dbl>  <dbl>        <dbl> <chr> <chr>     <dbl>
1 Zona Orie…       3     250        70      3            6 Casa  20 de…    -76.5
2 Zona Orie…       3     320       120      2            3 Casa  20 de…    -76.5
3 Zona Orie…       3     350       220      2            4 Casa  20 de…    -76.5
4 Zona Sur         4     400       280      5            3 Casa  3 de …    -76.5
5 Zona Norte       5     260        90      2            3 Apar… acopi     -76.5
6 Zona Norte       5     240        87      3            3 Apar… acopi     -76.5
# ℹ 1 more variable: latitud <dbl>

data_agrupa = data

#table5 = table(data_agrupa$zona,data_agrupa$tipo)

data_agrupa$pxm2 =  data_agrupa$preciom/data_agrupa$areaconst

# RF 
#rf = randomForest(preciom~ ., data = data_agrupa, importance = TRUE)
#varImpPlot(rf)

#corrplot(cor(data_agrupa %>% select_if(is.numeric)), method = "number")

data_agrupada_filtrada = data_agrupa %>%
  select(estrato, preciom,areaconst,banios,longitud,latitud)

d_a_f_e = scale(data_agrupada_filtrada)

fviz_nbclust(d_a_f_e, hcut, method = "wss")

# 1. Calcular la distancia euclidiana
dist_viv <- dist(d_a_f_e, method = 'euclidean')

# 2. Clúster jerárquico con método complete
hc_viv <- hclust(dist_viv, method = 'complete')

# 3. Asignar clusters (k = 4)
cluster_assignments <- cutree(hc_viv, k = 4)

# 4. Convertir matriz a dataframe y asignar los clusters
data_agrupa$cluster <- as.factor(cluster_assignments)

# 5. Visualizar los clusters
ggplot(data_agrupa, aes(x = preciom, y = areaconst, color = cluster)) +
  geom_point(size = 4) +
  geom_text(aes(label = cluster), vjust = -0.8) +
  theme_classic() +
  labs(title = "Clusters de Propiedades Residenciales",
       x = "Precio (Millones)",
       y = "Área Construida (m²)")

assigned_clusters_summary <- data_agrupa %>%
  group_by(cluster) %>%
  summarise(
    promedio_precio = round(mean(preciom, na.rm = TRUE),1),
    promedio_area = round(mean(areaconst, na.rm = TRUE),1),
    promedio_estrato = round(mean(estrato, na.rm = TRUE),1),
    promedio_banios = round(mean(banios, na.rm = TRUE),0),
    promedio_habitaciones = round(mean(habitaciones, na.rm = TRUE),1),
    promedio_pxm = round(mean(pxm2, na.rm = TRUE),1),
    cantidad_propiedades = n()
  )

#print(assigned_clusters_summary)
kable(head(assigned_clusters_summary), caption = "Tabla: Resumen de datos clusters")

Tabla: Resumen de datos clusters

cluster	promedio_precio	promedio_area	promedio_estrato	promedio_banios	promedio_habitaciones	promedio_pxm	cantidad_propiedades
1	374.7	145.4	4.6	3	3.5	2.7	7568
2	1001.9	414.5	5.2	6	5.3	2.6	657
3	1245.3	828.8	5.4	5	5.6	1.6	87
4	1053.6	1533.7	4.7	4	4.7	0.7	7

Se hace la segmentacion en 3 grupos:

⦿ Grupo 1: El que mayor número de predios tiene, con área promedio mas baja lo que lleva a tener el menor numero de habitaciones y baños. El precio promedio por metro cuadrado está en $2,6 M

⦿ Grupo 2: con 1851 registros corresponde al grupo con mayor precio por metro cuadrado, estrato 5,5 con precio promedio por metro cuadrado de $3,1, el mas alto de los 3 grupos

⦿ Grupo 3: 35 registros con las caracteristica de mayor precio promedio en estrato relacionado con el tamaño del predio, sin embargo el precio por metro cuadrado es el más bajo de todos.

# Ver distribución de zonas por cluster
# Mapa de Clusters (Si tienes datos geoespaciales)
ggplot(data_agrupa, aes(x = longitud, y = latitud, color = cluster)) +
  geom_point() +
  labs(title = "Mapa de Clusters", x = "Longitud", y = "Latitud", color = "Cluster") +
  theme_minimal()

sil <- silhouette(cluster_assignments, dist(data_agrupada_filtrada))
sil_avg <- mean(sil[,3])
print(sil_avg)

[1] 0.5336013

2.1 .Análisis de Conglomerados a los componentes principales del punto 1: :

Ahora se realizará analisis de conglomerados teniendo en cuenta el analisis de componentes principales del punto 2. Se usan los dos primeros componentes:

# Obtener los scores de los primeros 2 o 3 componentes
pca_data <- as.data.frame(acp$x[, 1:2]) 
# Calcular matriz de distancias y aplicar clustering jerárquico
dist_matrix <- dist(pca_data, method = "euclidean")
hclust_model <- hclust(dist_matrix, method = "ward.D2")

# Visualizar el dendrograma
plot(hclust_model, labels = FALSE, hang = -1)
rect.hclust(hclust_model, k = 4, border = "red")  # Resaltar los clusters

data_agrupa2 =data_agrupa

# Definir número de clusters (ajustar según análisis)
num_clusters <- 4  # Cambia este valor según tu segmentación

# Obtener los clusters para cada observación
clusters <- cutree(hclust_model, k = num_clusters)

# Ver los primeros valores asignados
#head(clusters)

# Agregar la columna de clusters al dataframe original
data_agrupa2$cluster <- as.factor(clusters)

# Verificar que la asignación sea correcta
#head(data_agrupa2)



ggplot(data_agrupa2, aes(x = preciom, y = areaconst, color = cluster)) +
  geom_point() +
  theme_minimal()

assigned_clusters_summary <- data_agrupa2 %>%
  group_by(cluster) %>%
  summarise(
    promedio_precio = round(mean(preciom, na.rm = TRUE),1),
    promedio_area = round(mean(areaconst, na.rm = TRUE),1),
    promedio_estrato = round(mean(estrato, na.rm = TRUE),1),
    promedio_banios = round(mean(banios, na.rm = TRUE),0),
    promedio_habitaciones = round(mean(habitaciones, na.rm = TRUE),1),
    promedio_pxm = round(mean(pxm2, na.rm = TRUE),1),
    cantidad_propiedades = n()
  )

print(assigned_clusters_summary)

# A tibble: 4 × 8
  cluster promedio_precio promedio_area promedio_estrato promedio_banios
  <fct>             <dbl>         <dbl>            <dbl>           <dbl>
1 1                  209.          86.6              3.9               2
2 2                  478.         293.               4.3               4
3 3                  548.         170                5.5               3
4 4                 1330.         501                5.8               6
# ℹ 3 more variables: promedio_habitaciones <dbl>, promedio_pxm <dbl>,
#   cantidad_propiedades <int>

# Mapa de Clusters (Si tienes datos geoespaciales)
ggplot(data_agrupa2, aes(x = longitud, y = latitud, color = cluster)) +
  geom_point() +
  labs(title = "Mapa de Clusters", x = "Longitud", y = "Latitud", color = "Cluster") +
  theme_minimal()

# Mapa de Clusters (Si tienes datos geoespaciales)
ggplot(data_agrupa2, aes(x = longitud, y = latitud, color = estrato)) +
  geom_point() +
  labs(title = "Mapa de estratos", x = "Longitud", y = "Latitud", color = "estrato") +
  theme_minimal()

# Mapa de Clusters (Si tienes datos geoespaciales)
ggplot(data_agrupa2, aes(x = longitud, y = latitud, color = pxm2)) +
  geom_point() +
  labs(title = "Mapa de Precio x m 2", x = "Longitud", y = "Latitud", color = "pxm2") +
  theme_minimal()

# Calcular el índice de Silhouette
silhouette_score <- silhouette(clusters, dist_matrix)

# Visualizar el índice de Silhouette
fviz_silhouette(silhouette_score)

  cluster size ave.sil.width
1       1 3548          0.53
2       2 1497          0.17
3       3 2814          0.26
4       4  460          0.42

** Resultado segmetnación con el PCA

AL realizar la segmentación con los dos primeros componentes principales se obtienen resultados más contundentes al reducir la dimensionalidad:

⦿ Cluster 3 y 4 corresponde a niveles socioeconómicos altos, con mayor precio por metro cuadrado, lo que los diferencia a estos dos clusters es el área y la cantidad de baños y habitaciones, en el cluster 4 es mayor

⦿ El cluenter 1 representa en promedio a las propiedades mas baratas, sin embargo esto es por el tamaño del precio, ya que es el más bajo (promedio 86 metros) lo que lo lleva a tener la menor cantidad de baños y habitaciones.

⦿ El cluenter 2 corres ponde a las propiedades con el menor precio por metro cuadrado, sin embargo son propiedades grandes lo cual las lleva a tener un precio total promedio más alto.

3. Análisis de Correspondencia :

Examinar la relación entre las variables categóricas (tipo de vivienda, zona y barrio), para identificar patrones de comportamiento de la oferta en mercado inmobiliario.

data_2 <- data

data_2$estrato <- as.factor(data_2$estrato)
tabla <- table(data_2$zona,data_2$estrato)
chisq.test(tabla)

    Pearson's Chi-squared test

data:  tabla
X-squared = 3830.4, df = 12, p-value < 2.2e-16

El resultado del test indica que hay una relacion entre las variables estrato y zona, se rechaza la h0

result_ac <- CA(tabla)

El gráfico nos ayuda a establecer relaciones como:

⦿ Estrato 6 se encuentra en la zona oeste ⦿ Estratos 4 y 5 se encuentran en las zonas sur y Norte ⦿ Estrato 3 en las zonas centro y oriente

Dimension 1 explica el 69,97% de la variabilidad y la 2 explica el 27,68%

fviz_screeplot(result_ac, addlabels = TRUE, ylim = c(0, 80), col = "deeppink") +
  ggtitle("") +
  ylab("Porcentaje de varianza explicado") +
  xlab("Ejes")

Las dos dimensiones explican el 97.7% de la varianza de los datos.