1. Introducción

Objetivo. Resumir y segmentar el mercado inmobiliario urbano con: (i) ACP (PCA) para reducir dimensionalidad de variables cuantitativas; (ii) clústeres sobre componentes para identificar segmentos; (iii) Análisis de Correspondencia (CA/MCA) para relaciones entre categóricas (tipo, zona, barrio, estrato); y (iv) mapa para contrastar patrones espaciales.

Criterios de la guía.

Tipificar variables; tratar estrato como cualitativa ordinal.

No incluir cualitativas en PCA; estandarizar variables.

Manejar faltantes comparando varios métodos (mediana/moda, kNN, CART) y verificar antes vs. después.

Retener componentes que acumulen ~80% (criterio flexible).

Hacer clúster sobre scores del PCA; probar k-means, PAM y DBSCAN; auto-seleccionar k; caracterizar grupos.

Presentar resultados con narrativa y dejar la depuración en anexos.

1 Librerías

# Utilidades
library(tidyverse)
## Warning: package 'ggplot2' was built under R version 4.4.3
## Warning: package 'purrr' was built under R version 4.4.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.1.0     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(janitor)
## Warning: package 'janitor' was built under R version 4.4.3
## 
## Adjuntando el paquete: 'janitor'
## 
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test
library(skimr)
## Warning: package 'skimr' was built under R version 4.4.3
library(naniar)
## 
## Adjuntando el paquete: 'naniar'
## 
## The following object is masked from 'package:skimr':
## 
##     n_complete
library(ggpubr)
## Warning: package 'ggpubr' was built under R version 4.4.3
# Imputación
library(VIM)        # kNN
## Cargando paquete requerido: colorspace
## Cargando paquete requerido: grid
## VIM is ready to use.
## 
## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues
## 
## Adjuntando el paquete: 'VIM'
## 
## The following object is masked from 'package:datasets':
## 
##     sleep
library(mice)       # CART/PMM
## Warning: package 'mice' was built under R version 4.4.3
## 
## Adjuntando el paquete: 'mice'
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following objects are masked from 'package:base':
## 
##     cbind, rbind
# Multivariado
library(FactoMineR)
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.4.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(NbClust)
library(cluster)
## Warning: package 'cluster' was built under R version 4.4.3
library(dbscan)
## Warning: package 'dbscan' was built under R version 4.4.3
## 
## Adjuntando el paquete: 'dbscan'
## 
## The following object is masked from 'package:VIM':
## 
##     kNN
## 
## The following object is masked from 'package:stats':
## 
##     as.dendrogram
# Mapas
library(leaflet)
## Warning: package 'leaflet' was built under R version 4.4.3
# Datos del curso
library(paqueteMODELOS)
## Cargando paquete requerido: boot
## Cargando paquete requerido: broom
## Warning: package 'broom' was built under R version 4.4.3
## Cargando paquete requerido: GGally
## Warning: package 'GGally' was built under R version 4.4.3
## Cargando paquete requerido: gridExtra
## 
## Adjuntando el paquete: 'gridExtra'
## 
## The following object is masked from 'package:dplyr':
## 
##     combine
## 
## Cargando paquete requerido: knitr
## Warning: package 'knitr' was built under R version 4.4.3
## Cargando paquete requerido: summarytools
## Warning: package 'summarytools' was built under R version 4.4.3
## 
## Adjuntando el paquete: 'summarytools'
## 
## The following object is masked from 'package:tibble':
## 
##     view

2 Utilidades

# Moda segura (omite NA)
stat_mode <- function(x){
  x2 <- x[!is.na(x)]
  if(length(x2) == 0) return(NA)
  ux <- unique(x2)
  ux[which.max(tabulate(match(x2, ux)))]
}

# Limpia tabla de contingencia eliminando filas/columnas con suma 0
sanitize_xtab <- function(x){
  x <- x[rowSums(x) > 0, , drop = FALSE]
  x <- x[, colSums(x) > 0, drop = FALSE]
  x
}

# CA a prueba de fallos: si hay <2 dims, muestra alternativa
ca_biplot_safe <- function(tab, title = "CA biplot"){
  tab <- sanitize_xtab(tab)

  # Filtro mínimo para CA
  if(nrow(tab) < 2 || ncol(tab) < 2){
    mosaicplot(tab, main = paste("Mosaico:", title), color = TRUE)
    return(invisible(NULL))
  }

  # CA
  res <- tryCatch(FactoMineR::CA(tab, graph = FALSE), error = function(e) NULL)
  if(is.null(res)){
    mosaicplot(tab, main = paste("Mosaico (CA no disponible):", title), color = TRUE)
    return(invisible(NULL))
  }

  # ¿Cuántas dimensiones útiles?
  eig_mat <- as.matrix(res$eig)
  if(nrow(eig_mat) == 0){
    mosaicplot(tab, main = paste("Mosaico (sin eigenvalues):", title), color = TRUE)
    return(invisible(NULL))
  }
  dims_avail <- sum(eig_mat[,1] > 1e-8)

  # Si hay ≥2 dims, graficamos el biplot
  if(!is.na(dims_avail) && dims_avail >= 2){
    return(
      factoextra::fviz_ca_biplot(res, repel = TRUE) +
        ggplot2::labs(title = title)
    )
  }

  # --- Alternativa: barras de contribución en Dim 1 ---
  # Intento 1: usar contrib de FactoMineR si existe
  get_first_col <- function(m){
    if(is.null(m)) return(NULL)
    mm <- tryCatch(as.matrix(m), error = function(e) NULL)
    if(is.null(mm)) return(NULL)
    if(ncol(mm) < 1) return(NULL)
    mm[, 1, drop = FALSE]
  }

  row_c1 <- get_first_col(res$row$contrib)
  col_c1 <- get_first_col(res$col$contrib)

  # Intento 2: si no existen, calcular contribuciones desde masas y coords
  # contrib (%) = 100 * mass * coord^2 / eig1
  if(is.null(row_c1) || is.null(col_c1)){
    eig1 <- as.numeric(eig_mat[1,1])
    if(!is.na(eig1) && eig1 > 0){
      # Filas
      if(is.null(row_c1) && !is.null(res$row$coord) && !is.null(res$row$mass)){
        rc <- tryCatch(as.matrix(res$row$coord), error = function(e) NULL)
        rmass <- tryCatch(as.numeric(res$row$mass), error = function(e) NULL)
        if(!is.null(rc) && ncol(rc) >= 1 && !is.null(rmass)){
          row_c1 <- matrix(100 * rmass * (rc[,1]^2) / eig1, ncol = 1)
          rownames(row_c1) <- rownames(rc)
          colnames(row_c1) <- "Dim1"
        }
      }
      # Columnas
      if(is.null(col_c1) && !is.null(res$col$coord) && !is.null(res$col$mass)){
        cc <- tryCatch(as.matrix(res$col$coord), error = function(e) NULL)
        cmass <- tryCatch(as.numeric(res$col$mass), error = function(e) NULL)
        if(!is.null(cc) && ncol(cc) >= 1 && !is.null(cmass)){
          col_c1 <- matrix(100 * cmass * (cc[,1]^2) / eig1, ncol = 1)
          rownames(col_c1) <- rownames(cc)
          colnames(col_c1) <- "Dim1"
        }
      }
    }
  }

  # Si seguimos sin contribuciones calculables, caer a mosaico
  if(is.null(row_c1) && is.null(col_c1)){
    mosaicplot(tab, main = paste("Mosaico (Dim < 2):", title), color = TRUE)
    return(invisible(NULL))
  }

  # Armar data frame de barras
  df <- dplyr::bind_rows(
    if(!is.null(row_c1))
      tibble::tibble(cat = rownames(row_c1), contrib = as.numeric(row_c1[,1]), tipo = "Filas")
    else NULL,
    if(!is.null(col_c1))
      tibble::tibble(cat = rownames(col_c1), contrib = as.numeric(col_c1[,1]), tipo = "Columnas")
    else NULL
  )

  if(nrow(df) == 0){
    mosaicplot(tab, main = paste("Mosaico (sin contrib calc.):", title), color = TRUE)
    return(invisible(NULL))
  }

  df <- df |>
    dplyr::arrange(dplyr::desc(contrib)) |>
    dplyr::slice_head(n = 20)

  ggplot2::ggplot(df, ggplot2::aes(x = reorder(cat, contrib), y = contrib, fill = tipo)) +
    ggplot2::geom_col() +
    ggplot2::coord_flip() +
    ggplot2::labs(title = paste("Contribuciones (Dim 1):", title),
                  x = NULL, y = "Contribución (%)") +
    ggplot2::theme_minimal()
}


# MCA a prueba de fallos: si hay <2 dims, muestra contribuciones
mca_biplot_safe <- function(df_cat, title = "MCA biplot"){
  df_cat <- droplevels(df_cat)
  bad <- vapply(df_cat, function(z) nlevels(z) < 2, logical(1))
  if(any(bad)){
    stop(sprintf("Variables categóricas con <2 niveles: %s",
                 paste(names(df_cat)[bad], collapse = ", ")))
  }
  res <- FactoMineR::MCA(df_cat, graph = FALSE)
  dims_avail <- sum(res$eig[,1] > 1e-8)
  if(is.na(dims_avail) || dims_avail < 2){
    contr <- tibble::as_tibble(res$var$contrib[,1], rownames = "categoria")
    names(contr)[2] <- "contrib"
    contr <- contr |> dplyr::arrange(dplyr::desc(contrib)) |> dplyr::slice_head(n = 25)
    ggplot2::ggplot(contr, aes(x = reorder(categoria, contrib), y = contrib)) +
      ggplot2::geom_col() + ggplot2::coord_flip() +
      ggplot2::labs(title = paste("Contribuciones (Dim 1):", title),
                    x = NULL, y = "Contribución (%)") +
      ggplot2::theme_minimal()
  } else {
    factoextra::fviz_mca_biplot(res, repel = TRUE) +
      ggplot2::labs(title = title)
  }
}

3 Datos y tipificación

raw <- vivienda %>% clean_names()
# Vista general
skim(raw)
Data summary
Name raw
Number of rows 8322
Number of columns 13
_______________________
Column type frequency:
character 4
numeric 9
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
zona 3 1.00 8 12 0 5 0
piso 2638 0.68 2 2 0 12 0
tipo 3 1.00 4 11 0 2 0
barrio 3 1.00 4 29 0 436 0

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
id 3 1.00 4160.00 2401.63 1.00 2080.50 4160.00 6239.50 8319.00 ▇▇▇▇▇
estrato 3 1.00 4.63 1.03 3.00 4.00 5.00 5.00 6.00 ▅▆▁▇▆
preciom 2 1.00 433.89 328.65 58.00 220.00 330.00 540.00 1999.00 ▇▂▁▁▁
areaconst 3 1.00 174.93 142.96 30.00 80.00 123.00 229.00 1745.00 ▇▁▁▁▁
parqueaderos 1605 0.81 1.84 1.12 1.00 1.00 2.00 2.00 10.00 ▇▁▁▁▁
banios 3 1.00 3.11 1.43 0.00 2.00 3.00 4.00 10.00 ▇▇▃▁▁
habitaciones 3 1.00 3.61 1.46 0.00 3.00 3.00 4.00 10.00 ▂▇▂▁▁
longitud 3 1.00 -76.53 0.02 -76.59 -76.54 -76.53 -76.52 -76.46 ▁▅▇▂▁
latitud 3 1.00 3.42 0.04 3.33 3.38 3.42 3.45 3.50 ▃▇▅▇▅ 
# Tipificación
base <- raw %>%
  mutate(
    zona   = factor(zona),
    tipo   = factor(tipo),
    barrio = factor(barrio),
    # Estrato como cualitativa ordinal (NO entra al PCA)
    estrato = factor(estrato, levels = sort(unique(estrato)), ordered = TRUE),
    # Piso es ambiguo (nivel vs #plantas); se documenta y se excluye de modelado
    piso = as.character(piso)
  ) %>%
  distinct()  # elimina duplicados verdaderos

n_dup <- raw %>% count(id) %>% filter(n > 1) %>% nrow()
cat('Duplicados por id (antes de distinct):', n_dup, '\n')
## Duplicados por id (antes de distinct): 1

Criterio sobre piso. La definición es ambigua (nivel de edificio vs # de plantas). Hasta no contar con un diccionario preciso se excluye del modelado principal y se deja recomendación para su estandarización.

preciom (precio en millones) Varía entre 58 y 1.999 millones. Media de 433,9 y mediana de 330 → indica asimetría positiva (la media es mayor que la mediana). Hay 2 valores faltantes (NA).

areaconst (área construida) Rango muy amplio: de 30 m² a 1.745 m². Media 174,9 m² y mediana 123 m² → también hay asimetría positiva. 3 valores faltantes.

parqueaderos De 1 a 10 parqueaderos, con media de 1,83. La moda aparente es 1–2 parqueaderos. Gran cantidad de datos faltantes: 1.605.

banios Entre 0 y 10 baños, media 3,11 y mediana 3. 3 valores faltantes.

habitaciones Entre 0 y 10 habitaciones, media 3,6 y mediana 3. 3 valores faltantes.

Varias variables presentan asimetría positiva, por lo que en imputaciones futuras aplicare mediana parqueaderos tiene un porcentaje alto de NA, lo que debo establecer si imputo (p. ej. moda) o excluyo del modelado. Existen valores atípicos plausibles (ej. áreas muy grandes o precios extremadamente altos) que podrían requerir análisis adicional antes de aplicar PCA o clustering.

3.1 Variables para PCA (solo cuantitativas)

vars_num <- c("preciom","areaconst","parqueaderos","banios","habitaciones")
summary(base[vars_num])
##     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   :1        NA's   :2        NA's   :1604     NA's   :2       
##   habitaciones   
##  Min.   : 0.000  
##  1st Qu.: 3.000  
##  Median : 3.000  
##  Mean   : 3.605  
##  3rd Qu.: 4.000  
##  Max.   :10.000  
##  NA's   :2

4 Faltantes: comparación de métodos

4.1 Exploración de faltantes

vis_miss(base[, c(vars_num, 'zona','tipo','barrio','estrato')])

sapply(base[vars_num], \(x) mean(is.na(x)))
##      preciom    areaconst parqueaderos       banios habitaciones 
## 0.0001201779 0.0002403557 0.1927652926 0.0002403557 0.0002403557

Hallazgos. Faltantes totales ~2.2%, concentrados en parqueaderos (~19%). Resto ~0.02%.

En la base de datos se identificó 1 caso con id repetido, lo que indica que existe al menos un registro asociado a la misma clave identificadora. Posteriormente se eliminaron las filas completamente idénticas (duplicados verdaderos), dejando una versión depurada del conjunto de datos sin repeticiones exactas.

Este paso asegura que cada propiedad tenga un registro único y evita sesgos en los análisis posteriores, especialmente en técnicas como PCA o clustering, donde los duplicados pueden afectar la variabilidad y la segmentación.

4.2 Estrategias de imputación

Definimos y comparamos tres enfoques:

Mediana/moda (robusto a asimetría); 2) kNN (VIM::kNN, k=5); 3) CART (mice, método cart).

# (a) Mediana/moda
imp_med <- base %>% mutate(
  across(all_of(c('preciom','areaconst','banios','habitaciones')), ~ ifelse(is.na(.x), median(.x, na.rm=TRUE), .x)),
  parqueaderos = ifelse(is.na(parqueaderos), as.numeric(names(which.max(table(parqueaderos)))), parqueaderos)
)

# (b) kNN imput (solo numéricas)
set.seed(123)
imp_knn <- base
imp_knn[vars_num] <- VIM::kNN(base[vars_num], k = 5, imp_var = FALSE)

# (c) CART con mice (1 iteración suficiente por baja tasa de NA)
set.seed(123)
ini <- mice(base[, vars_num], m = 1, method = 'cart', maxit = 5, printFlag = FALSE)
comp_cart <- complete(ini)
imp_cart <- base; imp_cart[vars_num] <- comp_cart

4.3 Verificación antes vs. después

Comparamos densidades (no distorsión) y medias/medianas.

compare_dens <- function(df0, df1, var){
  tibble(valor = c(df0[[var]], df1[[var]]),
         estado = rep(c('Antes','Después'), c(nrow(df0), nrow(df1)))) %>%
    ggplot(aes(valor, after_stat(density), linetype = estado))+
    geom_density() + labs(title = paste('Distribución', var, 'antes vs. después')) + theme_minimal()
}
plots_med <- lapply(vars_num, \(v) compare_dens(base, imp_med, v))
plots_knn <- lapply(vars_num, \(v) compare_dens(base, imp_knn, v))
plots_cart<- lapply(vars_num, \(v) compare_dens(base, imp_cart, v))
# Mostrar ejemplo
ggpubr::ggarrange(plotlist = plots_med, ncol = 2, nrow = 3)
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_density()`).
## Warning: Removed 2 rows containing non-finite outside the scale range
## (`stat_density()`).
## Warning: Removed 1604 rows containing non-finite outside the scale range
## (`stat_density()`).
## Warning: Removed 2 rows containing non-finite outside the scale range
## (`stat_density()`).
## Removed 2 rows containing non-finite outside the scale range
## (`stat_density()`).

# Resumen numérico
res_sum <- function(df){
  df %>% summarise(across(all_of(vars_num), list(media = mean, mediana = median), na.rm=TRUE, .names = '{.col}_{.fn}'))
}
bind_rows(
  res_sum(base) %>% mutate(metodo='Original'),
  res_sum(imp_med)%>% mutate(metodo='Mediana/Moda'),
  res_sum(imp_knn)%>% mutate(metodo='kNN'),
  res_sum(imp_cart)%>% mutate(metodo='CART')
) %>% relocate(metodo)
## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `across(...)`.
## Caused by warning:
## ! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
## Supply arguments directly to `.fns` through an anonymous function instead.
## 
##   # Previously
##   across(a:b, mean, na.rm = TRUE)
## 
##   # Now
##   across(a:b, \(x) mean(x, na.rm = TRUE))
## # A tibble: 4 × 11
##   metodo       preciom_media preciom_mediana areaconst_media areaconst_mediana
##   <chr>                <dbl>           <dbl>           <dbl>             <dbl>
## 1 Original              434.             330            175.               123
## 2 Mediana/Moda          434.             330            175.               123
## 3 kNN                   434.             330            175.               123
## 4 CART                  434.             330            175.               123
## # ℹ 6 more variables: parqueaderos_media <dbl>, parqueaderos_mediana <dbl>,
## #   banios_media <dbl>, banios_mediana <dbl>, habitaciones_media <dbl>,
## #   habitaciones_mediana <dbl>

Elección. Dadas las asimetrías positivas en preciom y areaconst, y por mínima distorsión en densidades, se selecciona Mediana/Moda para el flujo principal. (Los otros métodos se conservan en Anexos para trazabilidad.)

Se realizó imputación de valores faltantes en las variables numéricas preciom, areaconst, parqueaderos, banios y habitaciones utilizando la mediana como estadístico de reemplazo. Este criterio se fundamenta en que la mediana es más robusta frente a valores atípicos y preserva mejor la forma de la distribución, especialmente en variables con asimetría.

El análisis gráfico de cada variable muestra que las curvas de densidad antes y después de imputar se superponen prácticamente por completo. Esto evidencia que el proceso no alteró de forma significativa la estructura estadística de las variables, asegurando que las características originales de los datos se mantengan.

Este resultado respalda la elección de la mediana como método de imputación, ya que logra minimizar distorsiones, manteniendo la coherencia de los datos y reconociendo que el valor imputado es solo una aproximación al dato real perdido.

5 Análisis de Componentes Principales (ACP/PCA)

5.1 Preparación y estimación

X <- imp_med %>% select(all_of(vars_num)) %>% scale()
res_pca <- PCA(X, graph = FALSE)

# Varianza explicada
fviz_eig(res_pca, addlabels = TRUE, barcolor = 'grey20', barfill = 'steelblue')

eig <- res_pca$eig
acum <- cumsum(eig[,2])
ncomp <- which(acum >= 80)[1]; if (is.na(ncomp)) ncomp <- 3
cat('Componentes retenidos:', ncomp, ' | Varianza acumulada:', round(acum[ncomp],1),'%\n')
## Componentes retenidos: 2  | Varianza acumulada: 81.4 %

5.2 Interpretación (círculo de correlaciones y contribuciones)

# Círculo de correlaciones
fviz_pca_var(res_pca, col.var = "contrib", repel = TRUE) +
  scale_color_gradient(low = "grey70", high = "red3")

# Contribuciones
round(res_pca$var$contrib, 2)
##              Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## preciom      22.63 14.25 11.01  6.53 45.57
## areaconst    23.34  0.36 31.87 30.30 14.13
## parqueaderos 17.79 23.21 47.74 10.13  1.13
## banios       23.97  2.96  0.50 49.50 23.07
## habitaciones 12.27 59.22  8.88  3.54 16.09

Ejes propuestos.

CP1 – Tamaño/Valor: mayor aporte de areaconst, preciom y banios/parqueaderos.

CP2 – Confort interno: habitaciones y banios.

CP1 tiene 62.6% de la variabilidad.

CP2 tiene 17.7% adicional.

Si sumamos CP1+CP2 llegamos mas o menos 80.3% (62.6 + 17.7), que cumple la regla práctica de 70–80% para retener componentes.

CP3 aporta 8.9% (acumulado 89.2%). A partir de ahí los aportes son pequeños (6.9%, 3.9%): rendimientos decrecientes.

El gráfico de sedimentación (scree plot) muestra un “codo” marcado en la segunda componente. Las dos primeras componentes explican aproximadamente 80% de la variabilidad total, por lo que se retienen dos componentes para interpretación y visualización. Si se requiere mayor detalle, puede considerarse un tercer componente (≈89% acumulado), aunque su ganancia marginal es moderada.

6 Clusterización sobre componentes

Se realiza sobre scores de los primeros ncomp componentes (ortogonales), con escalado previo.

scores  <- as.data.frame(res_pca$ind$coord)
scoresK <- scale(scores[, 1:ncomp, drop = FALSE])

6.1 Selección automática de k

Dos caminos complementarios: NbClust (múltiples índices) y HCPC (FactoMineR) que sugiere k y caracteriza.

nb <- NbClust(data = scoresK, distance = 'euclidean',
              min.nc = 2, max.nc = 8, method = 'kmeans', index = 'silhouette')
k_nb <- nb$Best.nc[1]

hcpc <- HCPC(data.frame(scoresK), nb.clust = -1, graph = FALSE)
k_hcpc <- length(unique(hcpc$data.clust$clust))

k_opt <- as.integer(names(sort(table(c(k_nb, k_hcpc)), decreasing = TRUE)[1]))
cat('k (NbClust)=', k_nb, ' | k (HCPC)=', k_hcpc, ' | k elegido=', k_opt, '\n')
## k (NbClust)= 3  | k (HCPC)= 3  | k elegido= 3

6.2 k-means, PAM y DBSCAN

km  <- kmeans(scoresK, centers = k_opt, nstart = 50)
pam <- pam(scoresK, k = k_opt)

# DBSCAN sobre (PC1,PC2) con heurística para eps (ajusta si es necesario)
kNNdistplot(scoresK[,1:2], k = 5); abline(h = 0.8, lty = 2)

db  <- dbscan(scoresK[,1:2], eps = 0.8, minPts = 10)

# Silhouette promedio (k-means y PAM)
D   <- dist(scoresK)
sil_km  <- summary(silhouette(km$cluster,  D))$avg.width
sil_pam <- summary(silhouette(pam$clustering, D))$avg.width
c(kmeans = sil_km, pam = sil_pam)
##    kmeans       pam 
## 0.5384227 0.4310958

6.3 Segmentos y visualización

seg <- imp_med %>% bind_cols(as_tibble(scores[,1:ncomp])) %>%
  mutate(
    cl_km  = factor(km$cluster),
    cl_pam = factor(pam$clustering),
    cl_db  = factor(ifelse(db$cluster==0, 'ruido', paste0('C', db$cluster)))
  )

fviz_cluster(list(data = scoresK[,1:2], cluster = km$cluster),
             geom = 'point', ellipse.type = 't') +
  labs(title = paste('k-means en componentes (k =', k_opt, ')'))

6.4 Caracterización de clústeres (guía: describir perfiles)

carac_num <- seg %>% group_by(cl_km) %>%
  summarise(across(all_of(vars_num),
                   list(media = mean, mediana = median),
                   .names = '{.col}_{.fn}'),
            n = n(), .groups = 'drop')

carac_cat <- seg %>% group_by(cl_km) %>%
  summarise(
    zona_mas_frec    = names(which.max(table(zona))),
    tipo_mas_frec    = names(which.max(table(tipo))),
    estrato_mas_frec = names(which.max(table(estrato))),
    .groups = 'drop'
  )

carac_num
## # A tibble: 3 × 12
##   cl_km preciom_media preciom_mediana areaconst_media areaconst_mediana
##   <fct>         <dbl>           <dbl>           <dbl>             <dbl>
## 1 1              305.             275            115.                96
## 2 2              480.             430            305.               280
## 3 3             1038.             960            357.               300
## # ℹ 7 more variables: parqueaderos_media <dbl>, parqueaderos_mediana <dbl>,
## #   banios_media <dbl>, banios_mediana <dbl>, habitaciones_media <dbl>,
## #   habitaciones_mediana <dbl>, n <int>
carac_cat
## # A tibble: 3 × 4
##   cl_km zona_mas_frec tipo_mas_frec estrato_mas_frec
##   <fct> <chr>         <chr>         <chr>           
## 1 1     Zona Sur      Apartamento   5               
## 2 2     Zona Sur      Casa          3               
## 3 3     Zona Sur      Casa          6
# Discriminación (eta²) vía HCPC
head(hcpc$desc.var$quanti)
## $`1`
##          v.test Mean in category  Overall mean sd in category Overall sd
## Dim.2 -14.63191      -0.09890035 -1.429317e-17      0.4708377  0.9999399
## Dim.1 -71.04320      -0.48019694  4.872590e-18      0.4897627  0.9999399
##            p.value
## Dim.2 1.757921e-48
## Dim.1 0.000000e+00
## 
## $`2`
##         v.test Mean in category  Overall mean sd in category Overall sd
## Dim.2 62.93686        1.7705284 -1.429317e-17      0.9651085  0.9999399
## Dim.1 32.05664        0.9018114  4.872590e-18      0.7408753  0.9999399
##            p.value
## Dim.2  0.00000e+00
## Dim.1 1.77433e-225
## 
## $`3`
##          v.test Mean in category  Overall mean sd in category Overall sd
## Dim.1  59.57483         1.594829  4.872590e-18      0.8915553  0.9999399
## Dim.2 -42.07516        -1.126359 -1.429317e-17      0.8905664  0.9999399
##       p.value
## Dim.1       0
## Dim.2       0
# Boxplot de precio por clúster
seg %>% ggplot(aes(x = cl_km, y = preciom)) + geom_boxplot() +
  labs(x = 'Clúster (k-means)', y = 'Precio (millones)') + theme_minimal()

C1 (económico) menor precio m² y área construida pequeña (preciom y areaconst son las variables en el PCA/cluster). Moda (categoría más frecuente): apartamento, estrato 5. Esto significa que este grupo está formado mayormente por apartamentos de tamaño reducido, en estrato medio-alto, con precio por m² bajo.

C2 (premium) mayor precio m² y área construida grande. Moda: casa, estrato 6. Representa propiedades amplias y costosas, ubicadas en el estrato más alto.

C3 (intermedio) Valores medios en precio m² y área construida. Moda: casa, estrato 5. Es un segmento de viviendas en la mitad del rango tanto de precio como de tamaño.

Calidad de la segmentación Separación baja (silhouette ~0.45–0.55) El coeficiente silhouette mide qué tan bien diferenciados están los clústeres (0 a 1). Entre 0.45 y 0.55 indica separación aceptable pero no excelente — hay cierto traslape entre grupos.

7 Correspondencia (CA y MCA)

7.1 CA: tipo × zona (+ prueba χ²)

df_clean <- imp_med %>% filter(!is.na(tipo), !is.na(zona))
TAB_tz <- table(droplevels(df_clean$tipo), droplevels(df_clean$zona))

if(nrow(TAB_tz) >= 2 && ncol(TAB_tz) >= 2){
  print(chisq.test(TAB_tz))
} else {
  message("TAB_tz < 2x2; omito χ².")
}
## 
##  Pearson's Chi-squared test
## 
## data:  TAB_tz
## X-squared = 690.93, df = 4, p-value < 2.2e-16
ca_biplot_safe(TAB_tz, title = "CA: tipo vs zona")

### MCA: tipo, zona, barrio (opcional: estrato)

# Para legibilidad y estabilidad, usar barrios más frecuentes (p.ej., top 30)
top_barrios <- imp_med %>% count(barrio, sort = TRUE) %>% slice_head(n = 30) %>% pull(barrio)
df_mca <- imp_med %>%
  filter(barrio %in% top_barrios) %>%
  select(tipo, zona, barrio) %>%
  droplevels()

mca_biplot_safe(df_mca, title = "MCA: tipo, zona y (top) barrio")

En el Análisis de Correspondencias Múltiples (MCA) se observó que la varianza explicada por los dos primeros ejes fue relativamente baja. Esto es un comportamiento esperado cuando se incluyen variables con un gran número de categorías, como ocurre con el atributo barrio. Al existir tantos barrios distintos, la información se reparte entre muchas dimensiones y la capacidad de los primeros ejes para concentrar la variabilidad disminuye.

Para futuras iteraciones, podría ser útil agrupar los barrios en categorías más amplias (por ejemplo, zonas o sectores) o trabajar únicamente con los barrios más frecuentes. Esta simplificación permitiría concentrar más varianza en los primeros ejes y mejorar la legibilidad e interpretación de los gráficos resultantes. ## Mapa de clústeres

if (!requireNamespace("RColorBrewer", quietly = TRUE)) {
  install.packages("RColorBrewer")
}
library(RColorBrewer)

pal <- colorFactor(brewer.pal(max(3, k_opt), 'Set2'), seg$cl_km)

leaflet(seg) %>% addTiles() %>%
  addCircleMarkers(~longitud, ~latitud, radius = 4, stroke = FALSE,
                   fillOpacity = 0.6, color = ~pal(cl_km),
                   popup = ~paste0('<b>Tipo:</b> ', tipo,
                                    '<br><b>Zona:</b> ', zona,
                                    '<br><b>Precio (M):</b> ', round(preciom,1),
                                    '<br><b>Área:</b> ', round(areaconst,1),
                                    '<br><b>Clúster:</b> ', cl_km)) %>%
  addLegend('bottomright', pal = pal, values = ~cl_km, title = 'Clúster')
## Warning in validateCoords(lng, lat, funcName): Data contains 2 rows with either
## missing or invalid lat/lon values and will be ignored

8 Resultados y discusión

El Análisis de Componentes Principales (PCA) reveló que los dos primeros ejes capturan la mayor parte de la variabilidad del conjunto de datos: el primero se asocia principalmente con el tamaño y el valor de las propiedades, mientras que el segundo está relacionado con aspectos de confort. La proporción de varianza explicada se mantuvo estable incluso al aplicar distintos métodos de imputación (mediana y moda), lo que indica que la estructura del modelo es robusta.

En la segmentación por clústeres, el número óptimo de grupos fue determinado automáticamente mediante métodos como NbClust y HCPC. Tanto k-means como PAM arrojaron perfiles consistentes, con coeficientes silhouette similares, lo que refuerza la estabilidad de los resultados. La caracterización final sugiere tres segmentos bien definidos: económico, intermedio y premium, cada uno con patrones geográficos diferenciados que pueden observarse en los mapas.

El análisis de correspondencias mostró una asociación significativa entre el tipo de propiedad y la zona, confirmada por la prueba χ². Sin embargo, en el MCA la varianza inicial de los ejes fue baja, debido a la gran dispersión de categorías (especialmente en la variable barrio). Esto podría mejorarse agrupando o filtrando categorías poco frecuentes.

Finalmente, la representación cartográfica permitió identificar áreas con alta concentración del segmento premium, lo que ofrece una oportunidad de validación cruzada con la información de estrato y zona para orientar estrategias comerciales más focalizadas.

9 Recomendaciones para la toma de decisiones

Estrategia por segmento. Se recomienda diseñar campañas y ofertas diferenciadas según el perfil identificado: C1 (económico), orientado a propiedades de menor precio y tamaño; C2 (premium), enfocado en inmuebles de alto valor y mayor área; y C3 (intermedio), que combina características de ambos extremos.

Política de precios. La fijación de precios puede basarse en las dimensiones detectadas en el PCA: CP1 (tamaño/valor) y CP2 (confort), ajustando las tarifas de acuerdo con la zona y el estrato socioeconómico.

Expansión geográfica. Para maximizar el impacto comercial, se sugiere priorizar los barrios y zonas que presentan una alta concentración del segmento objetivo, tal como se evidencia en el análisis cartográfico

10 Metodología

Tipificación: estrato como factor ordenado; piso excluida por ambigüedad.

Faltantes: comparación Mediana/Moda, kNN, CART con verificación de densidades y resúmenes.

PCA: solo cuantitativas, escaladas. Retención por ≥~80% acumulado.

Clúster: sobre scores PCA; k por NbClust/HCPC; comparación k-means vs PAM; DBSCAN para densidad/ruido.

CA/MCA: χ², biplots y varianza de ejes.

Mapa: leaflet con colores por clúster.

11 Anexos: limpieza y pruebas adicionales

11.1 A1. Outliers univariados (IQR)

detect_outliers <- function(x){
  q1 <- quantile(x, 0.25, na.rm = TRUE)
  q3 <- quantile(x, 0.75, na.rm = TRUE)
  iqr <- q3 - q1
  low <- q1 - 1.5*iqr
  high<- q3 + 1.5*iqr
  tibble(valor = x, outlier = x < low | x > high)
}
lapply(imp_med[vars_num], detect_outliers)[1]
## $preciom
## # A tibble: 8,321 × 2
##    valor outlier
##    <dbl> <lgl>  
##  1   250 FALSE  
##  2   320 FALSE  
##  3   350 FALSE  
##  4   400 FALSE  
##  5   260 FALSE  
##  6   240 FALSE  
##  7   220 FALSE  
##  8   310 FALSE  
##  9   320 FALSE  
## 10   780 FALSE  
## # ℹ 8,311 more rows

11.2 A2. Sensibilidad de PCA a la imputación

# Repite PCA con kNN y CART para chequear estabilidad de cargas en PC1–PC2
stab <- function(df){
  s <- PCA(scale(df[,vars_num]), graph = FALSE)$var$contrib[,1:2]
  as_tibble(round(s,2), rownames = 'var')
}
list(
  MedianaModa = stab(imp_med),
  kNN         = stab(imp_knn),
  CART        = stab(imp_cart)
)
## $MedianaModa
## # A tibble: 5 × 3
##   var          Dim.1 Dim.2
##   <chr>        <dbl> <dbl>
## 1 preciom       22.6 14.2 
## 2 areaconst     23.3  0.36
## 3 parqueaderos  17.8 23.2 
## 4 banios        24.0  2.96
## 5 habitaciones  12.3 59.2 
## 
## $kNN
## # A tibble: 5 × 3
##   var          Dim.1 Dim.2
##   <chr>        <dbl> <dbl>
## 1 preciom       22.2 16.4 
## 2 areaconst     22.9  0.15
## 3 parqueaderos  19.6 17.6 
## 4 banios        23.4  2.93
## 5 habitaciones  12.0 63.0 
## 
## $CART
## # A tibble: 5 × 3
##   var          Dim.1 Dim.2
##   <chr>        <dbl> <dbl>
## 1 preciom       22.1 16.7 
## 2 areaconst     23.0  0.12
## 3 parqueaderos  19.2 17.7 
## 4 banios        23.4  2.99
## 5 habitaciones  12.2 62.5

11.3 Alternativa: selección de k por silueta global

set.seed(123)
ks <- 2:8
sil_vec <- sapply(ks, function(k){
  kmk <- kmeans(scoresK, centers = k, nstart = 30)
  summary(silhouette(kmk$cluster, dist(scoresK)))$avg.width
})
tibble(k = ks, silhouette = sil_vec) %>% ggplot(aes(k, silhouette))+
  geom_line() + geom_point() + theme_minimal()