1 Enunciado

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).

2 Datos, limpieza y exploración

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)
Diccionario de variables
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)
Data summary
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 ▇▃▁▁▁

3 Análisis de componentes principales (ACP)

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)

4 Segmentación por clúster (selección de k con silhouette)

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)
Medianas por clúster (k=2)
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

5 Análisis de correspondencias (CA)

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)")
}

6 Mapa interactivo

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²"))

7 Conclusiones y recomendaciones

  • Interpretación de componentes (ACP): Analice las variables con mayor contribución por componente. Habitualmente, el primer componente recoge tamaño y confort, y el segundo refleja diferencias de segmento o verticalidad.
  • Estrategia por segmentos (Clúster): Utilice las medianas por clúster como referencia de precio objetivo y priorice la captación en los barrios donde cada segmento es más denso.
  • Alineación oferta–territorio (CA): Relacione el tipo de inmueble con las zonas y barrios donde su oferta relativa es mayor, para enfocar campañas y portafolio.
  • Limitaciones del análisis: La base refleja oferta (no transacciones), puede contener sesgos de publicación y coordenadas faltantes. Los resultados describen la muestra disponible.

8 Anexos

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