Modelos Estadisticos Toma Decisiones

Evaluación de la oferta inmobiliaria urbana

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.

Resumen Inicial de los datos

#>        id           zona               piso              estrato     
#>  Min.   :   1   Length:8322        Length:8322        Min.   :3.000  
#>  1st Qu.:2080   Class :character   Class :character   1st Qu.:4.000  
#>  Median :4160   Mode  :character   Mode  :character   Median :5.000  
#>  Mean   :4160                                         Mean   :4.634  
#>  3rd Qu.:6240                                         3rd Qu.:5.000  
#>  Max.   :8319                                         Max.   :6.000  
#>  NA's   :3                                            NA's   :3      
#>     preciom         areaconst       parqueaderos        banios      
#>  Min.   :  58.0   Min.   :  30.0   Min.   : 1.000   Min.   : 0.000  
#>  1st Qu.: 220.0   1st Qu.:  80.0   1st Qu.: 1.000   1st Qu.: 2.000  
#>  Median : 330.0   Median : 123.0   Median : 2.000   Median : 3.000  
#>  Mean   : 433.9   Mean   : 174.9   Mean   : 1.835   Mean   : 3.111  
#>  3rd Qu.: 540.0   3rd Qu.: 229.0   3rd Qu.: 2.000   3rd Qu.: 4.000  
#>  Max.   :1999.0   Max.   :1745.0   Max.   :10.000   Max.   :10.000  
#>  NA's   :2        NA's   :3        NA's   :1605     NA's   :3       
#>   habitaciones        tipo              barrio             longitud     
#>  Min.   : 0.000   Length:8322        Length:8322        Min.   :-76.59  
#>  1st Qu.: 3.000   Class :character   Class :character   1st Qu.:-76.54  
#>  Median : 3.000   Mode  :character   Mode  :character   Median :-76.53  
#>  Mean   : 3.605                                         Mean   :-76.53  
#>  3rd Qu.: 4.000                                         3rd Qu.:-76.52  
#>  Max.   :10.000                                         Max.   :-76.46  
#>  NA's   :3                                              NA's   :3       
#>     latitud     
#>  Min.   :3.333  
#>  1st Qu.:3.381  
#>  Median :3.416  
#>  Mean   :3.418  
#>  3rd Qu.:3.452  
#>  Max.   :3.498  
#>  NA's   :3

Analisis x variable

Zonas:

zone_counter <- table(places$zona)
zone_df <- data.frame(zone_counter)
zone_df
#>           Var1 Freq
#> 1  Zona Centro  124
#> 2   Zona Norte 1920
#> 3   Zona Oeste 1198
#> 4 Zona Oriente  351
#> 5     Zona Sur 4726

Tipo Vivienda:


kind_counter <- table(places$tipo)
kind_df <- data.frame(kind_counter)
kind_df
#>          Var1 Freq
#> 1 Apartamento 5100
#> 2        Casa 3219

Columnas con NA

sum(is.na(places))
#> [1] 4275

distribuidos asi:

colSums(is.na(places))
#>           id         zona         piso      estrato      preciom    areaconst 
#>            3            3         2638            3            2            3 
#> parqueaderos       banios habitaciones         tipo       barrio     longitud 
#>         1605            3            3            3            3            3 
#>      latitud 
#>            3

Remuevo columnas que no me generan valor y si ruido

to_delete <- c("id", "longitud","latitud", "barrio")
places_clean <- places[ , !(names(places) %in% to_delete)]

colSums(is.na(places_clean))
#>         zona         piso      estrato      preciom    areaconst parqueaderos 
#>            3         2638            3            2            3         1605 
#>       banios habitaciones         tipo 
#>            3            3            3

Elimino registros cuya mayoria de datos estan incompletos


places_clean_na <- subset(places_clean, !is.na(places_clean$zona) & !is.na(places_clean$estrato) & !is.na(places_clean$preciom))

places_clean_na
#> # A tibble: 8,319 × 9
#>    zona   piso  estrato preciom areaconst parqueaderos banios habitaciones tipo 
#>    <chr>  <chr>   <dbl>   <dbl>     <dbl>        <dbl>  <dbl>        <dbl> <chr>
#>  1 Zona … <NA>        3     250        70            1      3            6 Casa 
#>  2 Zona … <NA>        3     320       120            1      2            3 Casa 
#>  3 Zona … <NA>        3     350       220            2      2            4 Casa 
#>  4 Zona … 02          4     400       280            3      5            3 Casa 
#>  5 Zona … 01          5     260        90            1      2            3 Apar…
#>  6 Zona … 01          5     240        87            1      3            3 Apar…
#>  7 Zona … 01          4     220        52            2      2            3 Apar…
#>  8 Zona … 01          5     310       137            2      3            4 Apar…
#>  9 Zona … 02          5     320       150            2      4            6 Casa 
#> 10 Zona … 02          5     780       380            2      3            3 Casa 
#> # ℹ 8,309 more rows

Quedando asi los valores NA:

colSums(is.na(places_clean_na))
#>         zona         piso      estrato      preciom    areaconst parqueaderos 
#>            0         2635            0            0            0         1602 
#>       banios habitaciones         tipo 
#>            0            0            0

Caso Tipo:

Convierto las variables categoricas a numericas, puesto que el futuro PCA solo funciona con variables numericas

Casa= 1 Apartamento = 2

places_clean_na$tipo <- ifelse(places_clean_na$tipo == 'Casa', 1,2)

Caso Zonas:

norte= 1 sur= 2 oriente= 3 oeste= 4 centro= 5

places_clean_na$zona <- ifelse(places_clean_na$zona == "Zona Norte", 1,
                  ifelse(places_clean_na$zona == "Zona Sur", 2,
                         ifelse(places_clean_na$zona == "Zona Oriente", 3,
                                 ifelse(places_clean_na$zona == "Zona Oeste", 4,
                                        ifelse(places_clean_na$zona == "Zona Centro", 5, places_clean_na$zona)))))

Caso Pisos:

Convierto los valores del piso a entero

places_clean_na$piso <- as.integer(places_clean_na$piso)

Caso Parqueaderos:

Teniendo como referente el POT de Cali del año 2000 el Acuerdo 193-06 de 2006 [1] segun lo expuesto en la pagina 11 indica que segun el estrato y area del bien, el numero o proporcion de parquederos, y por otra parte se observa que en las caracteristicas de los inmuebles analizados no se encuentra la antiguedad para determinar asi su valor mas exacto, se procede asi:

Estrato 3:
- Apartamentos: los valores NA se actualizaran a “0”, puesto que es mayor el numero de apartamentos en este estrato que no reporta informacion y la aplicacion de las reglas del POT., entendiendo que si no lo reportaron es por que no tiene.

places_clean_na$parqueaderos <- ifelse(places_clean_na$estrato == 3  & is.na(places_clean_na$parqueaderos), 0, places_clean_na$parqueaderos)

Evaluo la mejor opcion para imputar el resto de parqueaderos faltantes:

mice_imputed <- data.frame(
  original = places_clean_na$parqueaderos,
  imputed_parking_pmm = complete(mice(places_clean_na, method = "pmm"))$parqueaderos,
  imputed_parking_cart = complete(mice(places_clean_na, method = "cart"))$parqueaderos,
  imputed_parking_lasso = complete(mice(places_clean_na, method = "lasso.norm"))$parqueaderos,
  imputed_parking_normalp = complete(mice(places_clean_na, method = "norm.predict"))$parqueaderos,
  zona = places_clean_na$zona,
  preciom =places_clean_na$preciom,
  tipo =places_clean_na$tipo,
  habitaciones =places_clean_na$habitaciones,
  estrato =places_clean_na$estrato
)
#> 
#>  iter imp variable
#>   1   1  piso  parqueaderos
#>   1   2  piso  parqueaderos
#>   1   3  piso  parqueaderos
#>   1   4  piso  parqueaderos
#>   1   5  piso  parqueaderos
#>   2   1  piso  parqueaderos
#>   2   2  piso  parqueaderos
#>   2   3  piso  parqueaderos
#>   2   4  piso  parqueaderos
#>   2   5  piso  parqueaderos
#>   3   1  piso  parqueaderos
#>   3   2  piso  parqueaderos
#>   3   3  piso  parqueaderos
#>   3   4  piso  parqueaderos
#>   3   5  piso  parqueaderos
#>   4   1  piso  parqueaderos
#>   4   2  piso  parqueaderos
#>   4   3  piso  parqueaderos
#>   4   4  piso  parqueaderos
#>   4   5  piso  parqueaderos
#>   5   1  piso  parqueaderos
#>   5   2  piso  parqueaderos
#>   5   3  piso  parqueaderos
#>   5   4  piso  parqueaderos
#>   5   5  piso  parqueaderos
#> Warning: Number of logged events: 1
#> 
#>  iter imp variable
#>   1   1  piso  parqueaderos
#>   1   2  piso  parqueaderos
#>   1   3  piso  parqueaderos
#>   1   4  piso  parqueaderos
#>   1   5  piso  parqueaderos
#>   2   1  piso  parqueaderos
#>   2   2  piso  parqueaderos
#>   2   3  piso  parqueaderos
#>   2   4  piso  parqueaderos
#>   2   5  piso  parqueaderos
#>   3   1  piso  parqueaderos
#>   3   2  piso  parqueaderos
#>   3   3  piso  parqueaderos
#>   3   4  piso  parqueaderos
#>   3   5  piso  parqueaderos
#>   4   1  piso  parqueaderos
#>   4   2  piso  parqueaderos
#>   4   3  piso  parqueaderos
#>   4   4  piso  parqueaderos
#>   4   5  piso  parqueaderos
#>   5   1  piso  parqueaderos
#>   5   2  piso  parqueaderos
#>   5   3  piso  parqueaderos
#>   5   4  piso  parqueaderos
#>   5   5  piso  parqueaderos
#> Warning: Number of logged events: 1
#> 
#>  iter imp variable
#>   1   1  piso  parqueaderos
#>   1   2  piso  parqueaderos
#>   1   3  piso  parqueaderos
#>   1   4  piso  parqueaderos
#>   1   5  piso  parqueaderos
#>   2   1  piso  parqueaderos
#>   2   2  piso  parqueaderos
#>   2   3  piso  parqueaderos
#>   2   4  piso  parqueaderos
#>   2   5  piso  parqueaderos
#>   3   1  piso  parqueaderos
#>   3   2  piso  parqueaderos
#>   3   3  piso  parqueaderos
#>   3   4  piso  parqueaderos
#>   3   5  piso  parqueaderos
#>   4   1  piso  parqueaderos
#>   4   2  piso  parqueaderos
#>   4   3  piso  parqueaderos
#>   4   4  piso  parqueaderos
#>   4   5  piso  parqueaderos
#>   5   1  piso  parqueaderos
#>   5   2  piso  parqueaderos
#>   5   3  piso  parqueaderos
#>   5   4  piso  parqueaderos
#>   5   5  piso  parqueaderos
#> Warning: Number of logged events: 1
#> 
#>  iter imp variable
#>   1   1  piso  parqueaderos
#>   1   2  piso  parqueaderos
#>   1   3  piso  parqueaderos
#>   1   4  piso  parqueaderos
#>   1   5  piso  parqueaderos
#>   2   1  piso  parqueaderos
#>   2   2  piso  parqueaderos
#>   2   3  piso  parqueaderos
#>   2   4  piso  parqueaderos
#>   2   5  piso  parqueaderos
#>   3   1  piso  parqueaderos
#>   3   2  piso  parqueaderos
#>   3   3  piso  parqueaderos
#>   3   4  piso  parqueaderos
#>   3   5  piso  parqueaderos
#>   4   1  piso  parqueaderos
#>   4   2  piso  parqueaderos
#>   4   3  piso  parqueaderos
#>   4   4  piso  parqueaderos
#>   4   5  piso  parqueaderos
#>   5   1  piso  parqueaderos
#>   5   2  piso  parqueaderos
#>   5   3  piso  parqueaderos
#>   5   4  piso  parqueaderos
#>   5   5  piso  parqueaderos
#> Warning: Number of logged events: 1

finalmente imputo los datos de parqueadero y piso por prediccion media predicha pmm


numeric_places_clean_na <- sapply(places_clean_na, as.numeric)

column_names <- names(places_clean_na)
columns<-column_names


impute_arg1  <- mice(places_clean_na[,names(places_clean_na) %in% columns],m = 3,maxit = 5, method = "pmm",seed = 2018,print=F)
#> Warning: Number of logged events: 1
impute_arg <- mice::complete(impute_arg1)
df <- sapply(impute_arg, as.numeric)


xyplot(impute_arg1,parqueaderos~preciom)

xyplot(impute_arg1,parqueaderos~piso)

Actuales columnas NA:

colSums(is.na(df))
#>         zona         piso      estrato      preciom    areaconst parqueaderos 
#>            0            0            0            0            0            0 
#>       banios habitaciones         tipo 
#>            0            0            0

Matriz de correlacion:

numeric_df <- sapply(df, as.numeric)
correlation_matrix <- cor(df, use = "pairwise.complete.obs")
corrplot(correlation_matrix, tl.col = "black", tl.srt = 20)

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.

md.pattern(df, rotate.names = TRUE)
#>  /\     /\
#> {  `---'  }
#> {  O   O  }
#> ==>  V <==  No need for mice. This data set is completely observed.
#>  \  \|/  /
#>   `-----'

#>      zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
#> 8319    1    1       1       1         1            1      1            1    1
#>         0    0       0       0         0            0      0            0    0
#>       
#> 8319 0
#>      0


df_pca= scale(df)
str(df_pca)
#>  num [1:8319, 1:9] 0.872 0.872 0.872 -0.147 -1.166 ...
#>  - attr(*, "dimnames")=List of 2
#>   ..$ : NULL
#>   ..$ : chr [1:9] "zona" "piso" "estrato" "preciom" ...
#>  - attr(*, "scaled:center")= Named num [1:9] 2.14 3.63 4.63 433.9 174.93 ...
#>   ..- attr(*, "names")= chr [1:9] "zona" "piso" "estrato" "preciom" ...
#>  - attr(*, "scaled:scale")= Named num [1:9] 0.981 2.529 1.029 328.665 142.964 ...
#>   ..- attr(*, "names")= chr [1:9] "zona" "piso" "estrato" "preciom" ...

prcomp(df_pca)
#> Standard deviations (1, .., p=9):
#> [1] 1.9471861 1.3777793 0.9679469 0.9041736 0.6777235 0.5912756 0.5723267
#> [8] 0.4894825 0.4238776
#> 
#> Rotation (n x k) = (9 x 9):
#>                      PC1          PC2         PC3         PC4         PC5
#> zona         -0.09330381  0.240404550 -0.94838648 -0.08685435  0.07495735
#> piso          0.11576714  0.449883241  0.07815604  0.77001469  0.32808476
#> estrato      -0.26344977  0.495233612  0.14373493 -0.23748336 -0.42351264
#> preciom      -0.43392411  0.249642635  0.02153557 -0.07141308  0.21056525
#> areaconst    -0.43797872 -0.105617319  0.03300018  0.04852539  0.45484613
#> parqueaderos -0.38990548  0.236129207  0.21810334 -0.16909961  0.14907281
#> banios       -0.44328419 -0.003279038  0.01134736  0.24362301 -0.38448109
#> habitaciones -0.30654072 -0.370332698 -0.15499599  0.49141712 -0.42587779
#> tipo          0.29304730  0.477665015  0.02281665  0.07901378 -0.32362912
#>                      PC6         PC7         PC8         PC9
#> zona         -0.07812492  0.08360215  0.01105476 -0.08766877
#> piso          0.06113034  0.26357779  0.06457352 -0.01235007
#> estrato       0.38197068  0.24200319  0.46426318 -0.09438971
#> preciom       0.17423461 -0.24507376 -0.22746640  0.74654355
#> areaconst     0.23688228 -0.48468234  0.25362152 -0.48097489
#> parqueaderos -0.80438474  0.18006011  0.05512891 -0.10646415
#> banios        0.11146187  0.08987984 -0.68328987 -0.32984019
#> habitaciones -0.21904799 -0.13671711  0.43552761  0.25620727
#> tipo         -0.22438022 -0.71470425 -0.06704011 -0.09389781

res.pca <- prcomp(df_pca)
fviz_eig(res.pca, addlabels = TRUE)

en lo anterior podemos concluir que las 4 primeras dimensiones describen el conjunto de datos sobre un 80%

fviz_pca_var(res.pca,
col.var = "contrib", 
gradient.cols = c("blue",  "red"),
repel = TRUE    
)

fviz_pca_biplot(res.pca,
                repel=FALSE,
                col.var='red',
                col.ind='blue')

fviz_contrib(res.pca, choice = "var", axes = 1, top = 10)

Tambien se observa que las variables que mas contribuyen a describir los datos son: - Bannio - Area - Precio - Parqueadero

library(psych)
KMO(df)
#> Kaiser-Meyer-Olkin factor adequacy
#> Call: KMO(r = df)
#> Overall MSA =  0.8
#> MSA for each item = 
#>         zona         piso      estrato      preciom    areaconst parqueaderos 
#>         0.67         0.68         0.75         0.79         0.84         0.89 
#>       banios habitaciones         tipo 
#>         0.82         0.73         0.77

Aqui utilizando el indicador KMO nos fijamos en los variables mas cercanas a 1

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.


df_conglomerade= df
df_conglomerade =scale(df)
df_conglomerade = as.data.frame(df_conglomerade)

fviz_nbclust(df_conglomerade, kmeans, method = "wss") + geom_vline(xintercept = 2, linetype = 3)

Segun lo anterior trabajare con 2 clusters puesto que con 4 el valor Silhouette fue muy bajo

modelkmeans <- kmeans(df_conglomerade, 2)
df_conglomeradeF <- data.frame(df_conglomerade, cluster = modelkmeans$cluster)
grouped_results <- aggregate(. ~ cluster, data = df_conglomeradeF[, -1], FUN = median)
grouped_results
#>   cluster       piso    estrato    preciom  areaconst parqueaderos     banios
#> 1       1 -0.6461078  0.3559875  0.5966426  0.6649575    0.3102386  0.6222393
#> 2       2 -0.2507440 -0.6156201 -0.5595498 -0.5940997   -0.5329090 -0.7781148
#>   habitaciones       tipo
#> 1    0.2703863 -1.2586312
#> 2   -0.4147626  0.7944184

registros por cluster:

table(df_conglomeradeF$cluster)
#> 
#>    1    2 
#> 2980 5339

fviz_cluster(list(data = df_conglomeradeF[1:7],  cluster = df_conglomeradeF$cluster),    palette = c( "blue", "red"),
             repel = FALSE,   show.clust.cent = FALSE,  ggtheme = theme_classic())

Por medio de valor de Silhouette, validamos que los cluster esten bien agrupados:

library(tidyverse)
#> Warning: package 'tidyr' was built under R version 4.3.2
#> ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
#> ✔ dplyr     1.1.4     ✔ readr     2.1.5
#> ✔ forcats   1.0.0     ✔ stringr   1.5.1
#> ✔ lubridate 1.9.3     ✔ tibble    3.2.1
#> ✔ purrr     1.0.2     ✔ tidyr     1.3.1
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ psych::%+%()     masks ggplot2::%+%()
#> ✖ psych::alpha()   masks ggplot2::alpha()
#> ✖ dplyr::combine() masks gridExtra::combine()
#> ✖ dplyr::filter()  masks mice::filter(), stats::filter()
#> ✖ dplyr::lag()     masks stats::lag()
#> ✖ tibble::view()   masks summarytools::view()
#> ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(cluster)
# distancia euclidiana
dist_emp <- dist(df_conglomeradeF, method = 'euclidean')

# Cluster jerarquico con el método complete
hc_emp <- hclust(dist_emp, method = 'complete')

# Determinamos a dónde pertenece cada observación
cluster_assigments <- cutree(hc_emp, k = 2)

# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(df_conglomeradeF))
sil_avg <- mean(sil[,3])

# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=2 : ", sil_avg)
#> Coeficiente de Silhouette promedio k=2 :  0.6162379

Anteriormente estaba con 4 y el valor que arrojaba este coeficiente era menor a 0.35, entre mas cercano a 1 mejor.

Distribucion visual del cluster por area y precio

ggplot(df_conglomeradeF, aes(x = preciom, y = areaconst, color = cluster)) +
geom_point(size = 4) +
geom_text(aes(label = cluster), vjust = -1)

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.

df_correspondence= impute_arg


df_correspondence$zona <- ifelse(places_clean_na$zona ==1 , "Zona Norte",
                  ifelse(df_correspondence$zona == 2, "Zona Sur",
                         ifelse(df_correspondence$zona == 3 , "Zona Oriente",
                                 ifelse(df_correspondence$zona == 4 , "Zona Oeste",
                                        ifelse(df_correspondence$zona == 5 , "Zona Centro", places_clean_na$zona)))))


library(FactoMineR)
#> 
#> Attaching package: 'FactoMineR'
#> The following object is masked from 'package:ade4':
#> 
#>     reconst
tabla <- table(df_correspondence$zona, df_correspondence$estrato)
colnames(tabla) <- c("Estrato3", "Estrato4", "Estrato5", "Estrato6" )
tabla
#>               
#>                Estrato3 Estrato4 Estrato5 Estrato6
#>   Zona Centro       105       14        4        1
#>   Zona Norte        572      407      769      172
#>   Zona Oeste         54       84      290      770
#>   Zona Oriente      340        8        2        1
#>   Zona Sur          382     1616     1685     1043

chisq.test(tabla)
#> 
#>  Pearson's Chi-squared test
#> 
#> data:  tabla
#> X-squared = 3830.4, df = 12, p-value < 2.2e-16

library(FactoMineR)
library(factoextra)
library(gridExtra)
resultados_ac <- CA(tabla)

El gráfico nos permite establecer relaciones y validarlas como son:

El estrato 6 se encuentra ubicado en la Zona Oeste
Los estratos 4 y 5 están ubicados principalmente en la Zona Sur y Norte
El estrato 3 está presente en las Zonas Oriente y Centro

valores_prop <-resultados_ac$eig ; valores_prop
#>       eigenvalue percentage of variance cumulative percentage of variance
#> dim 1 0.32215213              69.965515                          69.96551
#> dim 2 0.12745096              27.680002                          97.64552
#> dim 3 0.01084108               2.354483                         100.00000

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

Los resultados indican que el primer componente resume el 70%% y los dos primeros componentes prepresentados en el plano factoria un resumen un 97.7% de los datos