Actividad 1, Modelos estadísticos para la toma de decisiones EMH
Esteban Marentes Herrera
2024-08-13
Introducción
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.
Análisis exploratorio y ajustes en los datos
summary(vivienda)## 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 :3str(vivienda)## spc_tbl_ [8,322 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ id : num [1:8322] 1147 1169 1350 5992 1212 ...
## $ zona : chr [1:8322] "Zona Oriente" "Zona Oriente" "Zona Oriente" "Zona Sur" ...
## $ piso : chr [1:8322] NA NA NA "02" ...
## $ estrato : num [1:8322] 3 3 3 4 5 5 4 5 5 5 ...
## $ preciom : num [1:8322] 250 320 350 400 260 240 220 310 320 780 ...
## $ areaconst : num [1:8322] 70 120 220 280 90 87 52 137 150 380 ...
## $ parqueaderos: num [1:8322] 1 1 2 3 1 1 2 2 2 2 ...
## $ banios : num [1:8322] 3 2 2 5 2 3 2 3 4 3 ...
## $ habitaciones: num [1:8322] 6 3 4 3 3 3 3 4 6 3 ...
## $ tipo : chr [1:8322] "Casa" "Casa" "Casa" "Casa" ...
## $ barrio : chr [1:8322] "20 de julio" "20 de julio" "20 de julio" "3 de julio" ...
## $ longitud : num [1:8322] -76.5 -76.5 -76.5 -76.5 -76.5 ...
## $ latitud : num [1:8322] 3.43 3.43 3.44 3.44 3.46 ...
## - attr(*, "spec")=
## .. cols(
## .. id = col_double(),
## .. zona = col_character(),
## .. piso = col_character(),
## .. estrato = col_double(),
## .. preciom = col_double(),
## .. areaconst = col_double(),
## .. parqueaderos = col_double(),
## .. banios = col_double(),
## .. habitaciones = col_double(),
## .. tipo = col_character(),
## .. barrio = col_character(),
## .. longitud = col_double(),
## .. latitud = col_double()
## .. )
## - attr(*, "problems")=<externalptr>La base de datos contiene 8.322 registros y 13 variables, cuatro de tipo cualitativo, ocho de tipo cuantitativo y una variable identificadora id.
Un primer análisis exploratorio nos permite observar algunas cifras generales y tener una idea de la vivienda promedio, que cuesta 433 millones, está ubicada en estrato 5, con un área construida de 175 metros cuadrados, tiene 2 parqueaderos, 3 baños y 3 habitaciones.
vivienda$tipo <- replace (vivienda$tipo, vivienda$tipo %in% c("casa","CASA","APARTAMENTO","apto"), c("Casa","Casa","Apartamento","Apartamento"))
md.pattern(vivienda)
## 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 4275viviendaSinNa = (vivienda[-c(8320,8321,8322),c('estrato','preciom','areaconst','banios','habitaciones','longitud','latitud')])
viviendaSinNaPiso = na.omit(viviendaSinNa)
viviendaSinNaCategorica= (vivienda[-c(8320,8321,8322),c('estrato','zona','piso','tipo','barrio')])
md.pattern(viviendaSinNa)## /\ /\
## { `---' }
## { O O }
## ==> V <== No need for mice. This data set is completely observed.
## \ \|/ /
## `-----'
## estrato preciom areaconst banios habitaciones longitud latitud
## 8319 1 1 1 1 1 1 1 0
## 0 0 0 0 0 0 0 0str(viviendaSinNa)## tibble [8,319 × 7] (S3: tbl_df/tbl/data.frame)
## $ estrato : num [1:8319] 3 3 3 4 5 5 4 5 5 5 ...
## $ preciom : num [1:8319] 250 320 350 400 260 240 220 310 320 780 ...
## $ areaconst : num [1:8319] 70 120 220 280 90 87 52 137 150 380 ...
## $ banios : num [1:8319] 3 2 2 5 2 3 2 3 4 3 ...
## $ habitaciones: num [1:8319] 6 3 4 3 3 3 3 4 6 3 ...
## $ longitud : num [1:8319] -76.5 -76.5 -76.5 -76.5 -76.5 ...
## $ latitud : num [1:8319] 3.43 3.43 3.44 3.44 3.46 ...Luego de la revisión de los datos, se eliminaron tres registros que tenían una gran cantidad de registros faltantes y luego se eliminaron los registros que tenían faltantes en el precio con la función na.omit.
1. Análisis de Componentes Principales.
Para comenzar el ACP se hace primero un escalamiento de las variables para que las que tienen mayores valores no afecten los datos.
viviendaEscalados= scale(viviendaSinNa)
res.pca <- prcomp(viviendaEscalados); res.pca## Standard deviations (1, .., p=7):
## [1] 1.7649945 1.2197986 0.9408170 0.8090903 0.6534211 0.4902176 0.4357175
##
## Rotation (n x k) = (7 x 7):
## PC1 PC2 PC3 PC4 PC5
## estrato 0.3596495 -0.46160840 0.29253122 -0.24988384 -0.47695341
## preciom 0.4947460 -0.06764679 0.25051923 -0.25237458 0.22943062
## areaconst 0.4556538 0.26756925 0.02809938 -0.12641620 0.64147176
## banios 0.4903682 0.18623745 -0.06882523 -0.01680433 -0.39400870
## habitaciones 0.2974110 0.54943309 -0.32731570 0.32355603 -0.33736244
## longitud -0.2672367 0.46217187 -0.01581921 -0.82481589 -0.17733905
## latitud -0.1338978 0.40072976 0.85950759 0.26942892 -0.08880096
## PC6 PC7
## estrato 0.501853021 0.17381740
## preciom -0.219896274 -0.72332891
## areaconst 0.292270190 0.45509101
## banios -0.652112622 0.37328490
## habitaciones 0.431734658 -0.31247031
## longitud 0.052076162 -0.01578471
## latitud -0.003114001 0.04739724fviz_pca_var(res.pca,
col.var = "contrib", # Color by contributions to the PC
gradient.cols = c("#FF7F00", "#034D94"),
repel = TRUE # Avoid text overlapping
)
fviz_eig(res.pca, addlabels = TRUE)
En la gráfica de varianza explicada, se muestra que en los dos primeros componentes se explican casi el 65% de la varianza, por esto es posible utilizar estos dos componentes.
Al realizar el análisis visual de los componentes, es posible ver que el primer componente esta influenciado mayormente por el precio de forma positiva, por el área construida y el número de baños, este se puede nombrar como tamaño.
El segundo componente está constituido principalmente por el valor positivo de número de habitaciones, latitud y longitud de de forma negativa de estrato, por lo que se puede llamar ubicación.
2. Análisis de Conglomerados.
viviendaEscalados= scale(viviendaSinNa)
viviendaEscalados = as.data.frame(viviendaEscalados)
dist_emp <- dist(viviendaEscalados, method = "euclidean")
# distancia euclidiana
dist_emp <- dist(viviendaEscalados, 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 = 4)
# asignamos los clusters
assigned_cluster <- viviendaEscalados %>% mutate(cluster = as.factor(cluster_assigments))
plot(hc_emp, cex = 0.6, main = "Dendograma de precios", las=1,
ylab = "Distancia euclidiana", xlab = "Grupos")
rect.hclust(hc_emp, k = 2, border = 2:5)
ggplot(assigned_cluster, aes(x = estrato, y = viviendaEscalados$preciom, color = cluster)) +
geom_point(size = 4) +
geom_text(aes(label = cluster), vjust = -.8) + # Agregar etiquetas del clúster
theme_classic()
Luego de realizar un dendograma para los estratos según el precio, se evidencia que en k=4 ocurre la mayor cantidad de particiones, por este motivo se utiliza este número para seleccionar el número de clusters. En la gráfica se pueden ver los clustes por estrato, se observa que no hay clusters creados por estrato, sino que están dispersos a lo largo de los distintos estratos, lo que indica que las caracteristicas de las viviendas están repartadidas a lo largo de los distintos estratos.
viviendaSinNaZona = (vivienda[-c(8320,8321,8322),c('estrato','preciom','areaconst','banios','habitaciones','longitud','latitud','zona')])
# distancia euclidiana
dist_emp <- dist(viviendaEscalados, 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 = 5)
# asignamos los clusters
assigned_cluster <- viviendaEscalados %>% mutate(cluster = as.factor(cluster_assigments))
ggplot(assigned_cluster, aes(x = viviendaSinNaZona$zona, y = viviendaEscalados$preciom, color = cluster)) +
geom_point(size = 5) +
geom_text(aes(label = cluster), vjust = -.8) + # Agregar etiquetas del clúster
theme_classic()
# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(viviendaEscalados))
sil_avg <- mean(sil[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=5 : ", sil_avg)## Coeficiente de Silhouette promedio k=5 : 0.1749581Con respecto a la zona, se puede evidenciar que el cluster 1 y 2 están presentes en todas las zonas, mientras que el 4 solamente está presente en la zona norte y sur, indicando que tienen alguana caracterísitcas en común. Para revisarla en detalle, se realiza una visuzalización de los mismos en los ejes del ACP:
results <- res.pca$x
km1<-eclust(results, "kmeans", hc_metric="eucliden",k=5)
Estos conglomerados presentan una superposición importante y no es sencillo realizar la separación de los mismos, aunquese puede observar que el cluster 1 y 4 son los que están más alejados.
3. Análisis de Correspondencia.
Antes de realizar el análisis de correspondencia se eliminaron los valores faltantes de las variables categóricas:
viviendaSinNaCategorica$estrato <- as.factor(viviendaSinNaCategorica$estrato)
md.pattern(viviendaSinNaCategorica, rotate.names = TRUE)
## estrato zona tipo barrio piso
## 5684 1 1 1 1 1 0
## 2635 1 1 1 1 0 1
## 0 0 0 0 2635 2635viviendaSinNaCategorica <- na.omit(viviendaSinNaCategorica)
grafico <-md.pattern(viviendaSinNaCategorica, rotate.names = TRUE)## /\ /\
## { `---' }
## { O O }
## ==> V <== No need for mice. This data set is completely observed.
## \ \|/ /
## `-----'
tabla <- table(viviendaSinNaCategorica$zona, viviendaSinNaCategorica$estrato)
colnames(tabla) <- c("Estrato3", "Estrato4", "Estrato5", "Estrato6" )
tabla##
## Estrato3 Estrato4 Estrato5 Estrato6
## Zona Centro 61 8 0 0
## Zona Norte 318 231 505 85
## Zona Oeste 36 64 192 513
## Zona Oriente 199 7 2 0
## Zona Sur 264 1206 1259 734chisq.test(tabla)##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 2584.6, df = 12, p-value < 2.2e-16resultados_ac <- CA(tabla)
valores_prop <-resultados_ac$eig ; valores_prop## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.31044273 68.270974 68.27097
## dim 2 0.12927420 28.429320 96.70029
## dim 3 0.01500447 3.299707 100.00000En este análisis, se puede observar que el estrato más alto está relacionado con la zona oeste, mientras que el estrato más bajo está presentes en la zona oriente y centro. Los estratos 4 y 5 están asociados a la zona Sur y Norte.
Dado que la categoría tipo es binomial, no es posible realizar una gráfica tipo CA factor, pero se puede analizar la tabla de relaciones:
tabla <- table(viviendaSinNaCategorica$tipo, viviendaSinNaCategorica$estrato)
colnames(tabla) <- c("Estrato3", "Estrato4", "Estrato5", "Estrato6" )
tabla##
## Estrato3 Estrato4 Estrato5 Estrato6
## Apartamento 441 1056 1328 894
## Casa 437 460 630 438chisq.test(tabla)##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 108.32, df = 3, p-value < 2.2e-16resultados_ac <- CA(tabla)
valores_prop <-resultados_ac$eig ; valores_prop## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.01905717 100 100El tipo de vivienda solamente está igualmente distribuido en el estrato más bajo 3, en el resto de ocasiones el apartamento es casi el doble de abundante en los otros estratos.
tabla <- table(viviendaSinNaCategorica$barrio, viviendaSinNaCategorica$estrato)
colnames(tabla) <- c("Estrato3", "Estrato4", "Estrato5", "Estrato6" )
chisq.test(tabla)## Warning in chisq.test(tabla): Chi-squared approximation may be incorrect##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 10322, df = 954, p-value < 2.2e-16resultados_ac <- CA(tabla)
valores_prop <-resultados_ac$eig ; valores_prop## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.8206338 45.18794 45.18794
## dim 2 0.6962889 38.34093 83.52887
## dim 3 0.2991233 16.47113 100.00000Al analizar los barrios con el estrato, se puede ver que el estrato 5 es el que presenta una mayor cantidad de barrios asociados, haciendolo mucho más diverso. Por el contrario el estrato 6 es más exclusivo y solo tienen un par de barrios asociados.
Conclusión
Luego de realizar este análisis exploratorio, se identifica que es posible enfocarse en el estrato 6, que está ubicado en una sola zona y tienen un menor númer de barrios, lo que facilita el trabajo. Adicionalmente, se identificó que el número de baños y habitaciones tienen un impacto grande en el momento de realizar la reducción de dimensionalidad.