Se presenta un análisis multivariado con ACP, clúster y análisis de correspondencias para caracterizar y segmentar la oferta inmobiliaria urbana. El objetivo es apoyar decisiones de compra, venta y valoración con resultados claros y reproducibles.
Base de datos y variables (carga correcta):
# devtools::install_github("centromagis/paqueteMODELOS", force = TRUE)
library(paqueteMODELOS)
data("vivienda")
str(vivienda)
Nota sobre la base: En la actividad aparece
data("vivenda"). Pero es un error; la
carga correcta es vivienda (incluyendo
i).
Esta sección tipifica variables, trata faltantes mínimos y describe la muestra para dejar el conjunto listo para los análisis.
raw <- vivienda %>% janitor::clean_names()
# Diccionario de variables
dic <- tibble::tribble(
~variable, ~descripcion,
"id","Identificador del anuncio",
"zona","Zona geográfica de la ciudad",
"piso","Nivel del inmueble (si aplica)",
"estrato","Estrato socioeconómico",
"preciom","Precio en millones",
"areaconst","Área construida (m²)",
"parqueaderos","Número de parqueaderos",
"banios","Número de baños",
"habitaciones","Número de habitaciones",
"tipo","Tipo de inmueble (Casa o Apartamento)",
"barrio","Barrio reportado",
"longitud","Coordenada longitud",
"latitud","Coordenada latitud"
)
knitr::kable(dic, caption="Diccionario de variables") %>%
kable_styling(full_width = FALSE)
| variable | descripcion |
|---|---|
| id | Identificador del anuncio |
| zona | Zona geográfica de la ciudad |
| piso | Nivel del inmueble (si aplica) |
| estrato | Estrato socioeconómico |
| preciom | Precio en millones |
| areaconst | Área construida (m²) |
| parqueaderos | Número de parqueaderos |
| banios | Número de baños |
| habitaciones | Número de habitaciones |
| tipo | Tipo de inmueble (Casa o Apartamento) |
| barrio | Barrio reportado |
| longitud | Coordenada longitud |
| latitud | Coordenada latitud |
# Limpieza y conversión
dat <- raw %>%
mutate(
zona = as.factor(zona),
tipo = as.factor(tipo),
barrio= as.factor(barrio),
estrato = as.integer(estrato),
piso_num = suppressWarnings(as.numeric(piso))
) %>%
filter(
!is.na(preciom), !is.na(areaconst), !is.na(estrato),
!is.na(parqueaderos), !is.na(banios), !is.na(habitaciones)
)
skimr::skim(dat)
| Name | dat |
| Number of rows | 6717 |
| Number of columns | 14 |
| _______________________ | |
| Column type frequency: | |
| character | 1 |
| factor | 3 |
| numeric | 10 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| piso | 1909 | 0.72 | 2 | 2 | 0 | 12 | 0 |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| zona | 0 | 1 | FALSE | 5 | Zon: 4105, Zon: 1287, Zon: 1098, Zon: 163 |
| tipo | 0 | 1 | FALSE | 2 | Apa: 4231, Cas: 2486 |
| barrio | 0 | 1 | FALSE | 367 | val: 837, ciu: 494, pan: 397, la : 349 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| id | 0 | 1.00 | 4413.07 | 2323.72 | 1.00 | 2474.00 | 4474.00 | 6428.00 | 8319.00 | ▆▇▇▇▇ |
| estrato | 0 | 1.00 | 4.83 | 0.95 | 3.00 | 4.00 | 5.00 | 6.00 | 6.00 | ▂▅▁▇▆ |
| preciom | 0 | 1.00 | 468.88 | 335.04 | 58.00 | 248.00 | 355.00 | 580.00 | 1999.00 | ▇▃▁▁▁ |
| areaconst | 0 | 1.00 | 181.14 | 144.10 | 30.00 | 86.00 | 130.00 | 233.00 | 1745.00 | ▇▁▁▁▁ |
| parqueaderos | 0 | 1.00 | 1.84 | 1.12 | 1.00 | 1.00 | 2.00 | 2.00 | 10.00 | ▇▁▁▁▁ |
| banios | 0 | 1.00 | 3.26 | 1.38 | 0.00 | 2.00 | 3.00 | 4.00 | 10.00 | ▆▇▃▁▁ |
| habitaciones | 0 | 1.00 | 3.61 | 1.36 | 0.00 | 3.00 | 3.00 | 4.00 | 10.00 | ▁▇▂▁▁ |
| longitud | 0 | 1.00 | -76.53 | 0.02 | -76.59 | -76.54 | -76.53 | -76.52 | -76.46 | ▁▅▇▁▁ |
| latitud | 0 | 1.00 | 3.42 | 0.04 | 3.33 | 3.38 | 3.41 | 3.45 | 3.50 | ▃▇▅▇▅ |
| piso_num | 1909 | 0.72 | 3.89 | 2.67 | 1.00 | 2.00 | 3.00 | 5.00 | 12.00 | ▇▃▁▁▁ |
El ACP reduce la dimensionalidad usando variables numéricas estandarizadas. Se reporta la varianza explicada por componente, las cargas de las variables y la proyección de los inmuebles coloreados por zona.
vars_num <- dat %>%
select(preciom, areaconst, parqueaderos, banios, habitaciones, estrato, piso_num) %>%
drop_na()
X <- scale(vars_num)
acp <- FactoMineR::PCA(as.data.frame(X), graph = FALSE)
fviz_eig(acp, addlabels = TRUE)
fviz_pca_var(acp, col.var = "contrib", repel = TRUE)
idx <- as.integer(rownames(acp$ind$coord))
hab <- dat$zona[idx]
fviz_pca_ind(acp, geom = "point", habillage = hab,
addEllipses = TRUE, ellipse.level = 0.95, repel = TRUE)
El clúster se ajusta en el espacio PCA para evitar colinealidad y unificar escalas. El número de grupos se elige con silhouette en una muestra y luego se ajusta el modelo final con todo el conjunto.
nd <- which(cumsum(acp$eig[,2]) >= 70)[1]; if(is.na(nd)) nd <- 3
comp <- as.data.frame(acp$ind$coord[, 1:max(2, nd)])
# Silhouette en muestra
nmax <- 3000
set.seed(9026655)
comp_s <- if(nrow(comp)>nmax) comp[sample(1:nrow(comp), nmax), ] else comp
fviz_nbclust(comp_s, kmeans, method = "silhouette", k.max = 6)
# Selección programática de k
get_k <- function(X, kmin=2, kmax=6){
ks <- kmin:kmax; sils <- numeric(length(ks))
for(i in seq_along(ks)){
set.seed(9026655); km <- kmeans(X, centers=ks[i], nstart=10)
ss <- cluster::silhouette(km$cluster, dist(X))
sils[i] <- mean(ss[,3])
}
ks[which.max(sils)]
}
k_sel <- tryCatch(get_k(comp_s,2,6), error=function(e) 3)
# Ajuste final con todo el conjunto
set.seed(9026655)
km <- kmeans(comp, centers = k_sel, nstart = 25)
fviz_cluster(list(data = comp, cluster = km$cluster))
seg <- dat[as.integer(rownames(comp)), ] %>% mutate(cluster = factor(km$cluster))
perfil <- seg %>%
group_by(cluster) %>%
summarise(
n = n(),
precio_med = median(preciom),
area_med = median(areaconst),
estrato_med = median(estrato),
banios_med = median(banios),
parqueaderos_med = median(parqueaderos)
) %>% arrange(desc(precio_med))
knitr::kable(perfil, caption = paste0("Medianas por clúster (k=", k_sel, ")")) %>%
kable_styling(full_width = FALSE)
| cluster | n | precio_med | area_med | estrato_med | banios_med | parqueaderos_med |
|---|---|---|---|---|---|---|
| 1 | 3369 | 393 | 145 | 5 | 3 | 2 |
| 2 | 1439 | 360 | 125 | 5 | 3 | 2 |
El CA explora asociaciones entre categorías, especialmente tipo–zona y tipo–barrio. Se filtran categorías con poca frecuencia y, si la estructura es de una sola dimensión, se presenta un gráfico 1D; si no hay dimensiones interpretables, se informa de manera explícita.
# Función segura de CA
safe_ca_plot <- function(tab, title = "Correspondencias") {
tab <- tab[rowSums(tab) > 0, colSums(tab) > 0, drop = FALSE]
if (nrow(tab) < 2 || ncol(tab) < 2) {
return(ggplot() + labs(title = paste0(title, " — Sin variabilidad suficiente")))
}
ca <- FactoMineR::CA(tab, graph = FALSE)
ndim <- tryCatch(NCOL(ca$row$coord), error = function(e) 0)
if (is.na(ndim) || length(ndim) == 0) ndim <- 0
if (ndim >= 2) {
fviz_ca_biplot(ca, repel = TRUE) + ggtitle(title)
} else if (ndim == 1) {
df <- as.data.frame(ca$row$coord)
colnames(df)[1] <- "Dim1"; df$label <- rownames(df)
pvar <- tryCatch(round(ca$eig[1,2], 1), error = function(e) NA)
ggplot(df, aes(x = Dim1, y = 0, label = label)) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_point() +
ggrepel::geom_text_repel(min.segment.length = 0) +
labs(title = paste0(title, " (1D)"),
x = paste0("Dimensión 1", if(!is.na(pvar)) paste0(" — ", pvar, "% var") else ""),
y = NULL) +
theme_minimal() +
theme(axis.text.y = element_blank(), axis.ticks.y = element_blank(),
panel.grid.minor = element_blank())
} else {
ggplot() + labs(title = paste0(title, " — CA sin dimensiones interpretables"))
}
}
# Tipo × Zona
tz <- dat %>% dplyr::select(tipo, zona) %>% droplevels()
safe_ca_plot(table(tz$tipo, tz$zona), "Correspondencias: Tipo × Zona")
# Tipo × Barrio (frecuencia ≥ 30) — máscara consistente
freq_barr <- sort(table(dat$barrio), decreasing = TRUE)
b_sel <- names(freq_barr[freq_barr >= 30])
if(length(b_sel) == 0){
ggplot() + labs(title = "Correspondencias: Tipo × Barrios — Sin barrios con frecuencia ≥ 30")
} else {
df_tb <- dat[dat$barrio %in% b_sel, c("tipo","barrio")] %>% droplevels()
tb <- table(df_tb$tipo, df_tb$barrio)
safe_ca_plot(tb, "Correspondencias: Tipo × Barrios (frecuencia ≥ 30)")
}
El mapa ubica la oferta por coordenadas y permite identificar zonas de concentración y diferencias entre segmentos.
geo <- dat %>% filter(!is.na(latitud), !is.na(longitud))
leaflet(geo) |>
addTiles() |>
addCircleMarkers(~longitud, ~latitud, radius = 4, stroke = FALSE, fillOpacity = 0.7,
popup = ~paste0("<b>", tipo, "</b><br>Zona: ", zona,
"<br>Precio: ", scales::comma(preciom), " M<br>Área: ", areaconst, " m²"))
sessionInfo()
## R version 4.4.2 (2024-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 10 x64 (build 19045)
##
## Matrix products: default
##
##
## locale:
## [1] LC_COLLATE=Spanish_Colombia.utf8 LC_CTYPE=Spanish_Colombia.utf8
## [3] LC_MONETARY=Spanish_Colombia.utf8 LC_NUMERIC=C
## [5] LC_TIME=Spanish_Colombia.utf8
##
## time zone: America/Bogota
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] leaflet_2.2.2 kableExtra_1.4.0 ggrepel_0.9.6
## [4] cluster_2.1.8.1 factoextra_1.0.7 FactoMineR_2.12
## [7] paqueteMODELOS_0.1.0 summarytools_1.1.4 knitr_1.50
## [10] gridExtra_2.3 GGally_2.3.0 broom_1.0.9
## [13] boot_1.3-31 scales_1.4.0 janitor_2.2.1
## [16] skimr_2.2.1 lubridate_1.9.4 forcats_1.0.0
## [19] stringr_1.5.1 dplyr_1.1.4 purrr_1.1.0
## [22] readr_2.1.5 tidyr_1.3.1 tibble_3.3.0
## [25] ggplot2_3.5.2 tidyverse_2.0.0
##
## loaded via a namespace (and not attached):
## [1] tidyselect_1.2.1 viridisLite_0.4.2 farver_2.1.2
## [4] S7_0.2.0 fastmap_1.2.0 digest_0.6.37
## [7] timechange_0.3.0 estimability_1.5.1 lifecycle_1.0.4
## [10] multcompView_0.1-10 magrittr_2.0.3 compiler_4.4.2
## [13] rlang_1.1.6 sass_0.4.9 tools_4.4.2
## [16] yaml_2.3.10 ggsignif_0.6.4 labeling_0.4.3
## [19] htmlwidgets_1.6.4 scatterplot3d_0.3-44 xml2_1.3.6
## [22] plyr_1.8.9 repr_1.1.7 RColorBrewer_1.1-3
## [25] abind_1.4-8 withr_3.0.2 grid_4.4.2
## [28] ggpubr_0.6.1 xtable_1.8-4 emmeans_1.11.2
## [31] MASS_7.3-61 flashClust_1.01-2 cli_3.6.5
## [34] mvtnorm_1.3-3 rmarkdown_2.29 generics_0.1.4
## [37] rstudioapi_0.17.1 reshape2_1.4.4 tzdb_0.4.0
## [40] cachem_1.1.0 pander_0.6.6 matrixStats_1.5.0
## [43] base64enc_0.1-3 vctrs_0.6.5 carData_3.0-5
## [46] jsonlite_1.8.9 car_3.1-3 hms_1.1.3
## [49] rapportools_1.2 rstatix_0.7.2 Formula_1.2-5
## [52] crosstalk_1.2.1 systemfonts_1.2.1 magick_2.8.7
## [55] jquerylib_0.1.4 glue_1.8.0 ggstats_0.10.0
## [58] codetools_0.2-20 DT_0.33 stringi_1.8.7
## [61] gtable_0.3.6 pillar_1.11.0 htmltools_0.5.8.1
## [64] R6_2.6.1 tcltk_4.4.2 evaluate_1.0.4
## [67] lattice_0.22-6 backports_1.5.0 leaps_3.2
## [70] snakecase_0.11.1 pryr_0.1.6 bslib_0.8.0
## [73] Rcpp_1.1.0 svglite_2.1.3 checkmate_2.3.2
## [76] xfun_0.52 pkgconfig_2.0.3