knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)

Datos y preparación

data('vivienda')
raw <- vivienda %>% clean_names()
glimpse(raw)
## Rows: 8,322
## Columns: 13
## $ id           <dbl> 1147, 1169, 1350, 5992, 1212, 1724, 2326, 4386, 1209, 159…
## $ zona         <chr> "Zona Oriente", "Zona Oriente", "Zona Oriente", "Zona Sur…
## $ piso         <chr> NA, NA, NA, "02", "01", "01", "01", "01", "02", "02", "02…
## $ estrato      <dbl> 3, 3, 3, 4, 5, 5, 4, 5, 5, 5, 6, 4, 5, 6, 4, 5, 5, 4, 5, …
## $ preciom      <dbl> 250, 320, 350, 400, 260, 240, 220, 310, 320, 780, 750, 62…
## $ areaconst    <dbl> 70, 120, 220, 280, 90, 87, 52, 137, 150, 380, 445, 355, 2…
## $ parqueaderos <dbl> 1, 1, 2, 3, 1, 1, 2, 2, 2, 2, NA, 3, 2, 2, 1, 4, 2, 2, 2,…
## $ banios       <dbl> 3, 2, 2, 5, 2, 3, 2, 3, 4, 3, 7, 5, 6, 2, 4, 4, 4, 3, 2, …
## $ habitaciones <dbl> 6, 3, 4, 3, 3, 3, 3, 4, 6, 3, 6, 5, 6, 2, 5, 5, 4, 3, 3, …
## $ tipo         <chr> "Casa", "Casa", "Casa", "Casa", "Apartamento", "Apartamen…
## $ barrio       <chr> "20 de julio", "20 de julio", "20 de julio", "3 de julio"…
## $ longitud     <dbl> -76.51168, -76.51237, -76.51537, -76.54000, -76.51350, -7…
## $ latitud      <dbl> 3.43382, 3.43369, 3.43566, 3.43500, 3.45891, 3.36971, 3.4…
raw_model <- raw %>% drop_na(preciom, areaconst, estrato, habitaciones, parqueaderos, banios)

Segmento de interés y verificación geográfica

base1 <- raw %>% 
  filter(str_detect(tipo, regex('^Casa$', ignore_case = TRUE)),
         str_detect(zona, regex('norte', ignore_case = TRUE)))

cat("Primeros 3 registros de 'base1' (casas, Zona Norte):\n")
## Primeros 3 registros de 'base1' (casas, Zona Norte):
base1 %>% head(3) %>% kable() %>% kable_styling(full_width = FALSE)
id zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo barrio longitud latitud
1209 Zona Norte 02 5 320 150 2 4 6 Casa acopi -76.51341 3.47968
1592 Zona Norte 02 5 780 380 2 3 3 Casa acopi -76.51674 3.48721
4057 Zona Norte 02 6 750 445 NA 7 6 Casa acopi -76.52950 3.38527 
cat("\nConteo por zona dentro del filtro (verificación):\n")
## 
## Conteo por zona dentro del filtro (verificación):
base1 %>% count(zona, sort = TRUE) %>% kable() %>% kable_styling(full_width = FALSE)
zona n
Zona Norte 722 
cat("\nEstadísticos rápidos (medianas):\n")
## 
## Estadísticos rápidos (medianas):
base1 %>% summarise(n = n(),
                    med_area = median(areaconst, na.rm=TRUE),
                    med_precio = median(preciom,   na.rm=TRUE)) %>%
  kable() %>% kable_styling(full_width = FALSE)
n med_area med_precio
722 240 390 
base1_map <- base1 %>% filter(!is.na(longitud), !is.na(latitud))
if (nrow(base1_map) > 0) {
  leaflet(base1_map) %>% addTiles() %>%
    addCircleMarkers(~longitud, ~latitud, radius = 5, stroke = FALSE, fillOpacity = 0.7,
                     popup = ~paste0('<b>', tipo, '</b><br>Precio: ', round(preciom,1),
                                     ' M<br>Área: ', areaconst, ' m²<br>Estrato: ', estrato,
                                     '<br>Barrio: ', barrio)) %>%
    setView(lng = median(base1_map$longitud, na.rm=TRUE),
            lat = median(base1_map$latitud,  na.rm=TRUE), zoom = 12)
} else {
  cat("No hay coordenadas válidas para mapear en la Zona Norte con el filtro actual.")
}
# Chequeo rápido de consistencia geográfica por latitud (aproximado)
if (!all(is.na(raw$latitud))) {
  lat_med_global <- stats::median(raw$latitud, na.rm = TRUE)

  base1_chk <- base1 %>%
    dplyr::mutate(
      norte_aprox = dplyr::case_when(
        is.na(latitud)            ~ "Sin coordenada",
        latitud >= lat_med_global ~ "Norte-aprox",
        TRUE                      ~ "No-Norte-aprox"
      )
    )

  cat("\nVerificación aproximada por latitud (comparada con la mediana global):\n")
  knitr::kable(dplyr::count(base1_chk, norte_aprox, sort = TRUE))

  sospechosos <- base1_chk %>%
    dplyr::filter(norte_aprox == "No-Norte-aprox") %>%
    dplyr::select(zona, barrio, tipo, latitud, longitud, preciom, areaconst, estrato) %>%
    head(10)

  if (nrow(sospechosos) > 0) {
    cat("\nRegistros potencialmente inconsistentes (texto='Norte' pero latitud < mediana global):\n")
    knitr::kable(sospechosos)
  } else {
    cat("\nNo se detectaron inconsistencias obvias por latitud con esta verificación simple.\n")
  }
} else {
  cat("\nNo es posible hacer la verificación aproximada por latitud (faltan coordenadas en 'raw').\n")
}
## 
## Verificación aproximada por latitud (comparada con la mediana global):
## 
## Registros potencialmente inconsistentes (texto='Norte' pero latitud < mediana global):
zona barrio tipo latitud longitud preciom areaconst estrato
Zona Norte acopi Casa 3.38527 -76.52950 750 445 6
Zona Norte acopi Casa 3.40590 -76.53179 625 355 4
Zona Norte acopi Casa 3.36862 -76.54044 750 237 5
Zona Norte acopi Casa 3.40050 -76.55363 420 200 5
Zona Norte acopi Casa 3.37823 -76.52680 490 118 5
Zona Norte acopi Casa 3.38679 -76.51466 305 117 4
Zona Norte acopi Casa 3.36971 -76.51700 350 118 4
Zona Norte acopi Casa 3.38627 -76.51811 380 300 5
Zona Norte acopi Casa 3.38180 -76.51815 382 225 4
Zona Norte acopi Casa 3.38764 -76.51841 295 162 3

Análisis exploratorio interactivo

vars_num <- raw %>% select(preciom, areaconst, estrato, banios, habitaciones, parqueaderos)

# Matriz de dispersión
plot_ly(type = 'splom',
        dimensions = lapply(names(vars_num), function(v) list(label=v, values=vars_num[[v]])))
# Correlaciones con precio
cors <- vars_num %>%
  mutate(across(everything(), as.numeric)) %>%
  summarise(across(-preciom, ~ cor(preciom, .x, use='complete.obs', method='pearson'))) %>%
  pivot_longer(everything(), names_to='variable', values_to='correlacion') %>%
  arrange(desc(abs(correlacion)))
cat("Correlaciones (precio vs. variables):\n")
## Correlaciones (precio vs. variables):
cors %>% kable(digits=3) %>% kable_styling(full_width = FALSE)
variable correlacion
parqueaderos 0.689
areaconst 0.687
banios 0.669
estrato 0.610
habitaciones 0.264 
# Relaciones clave
plot_ly(raw, x=~areaconst, y=~preciom, color=~as.factor(estrato),
        type='scatter', mode='markers') %>%
  layout(title='Precio vs Área (color = estrato)',
         xaxis=list(title='Área (m²)'), yaxis=list(title='Precio (M COP)'))
plot_ly(raw, x=~as.factor(estrato), y=~preciom, type='box') %>%
  layout(title='Precio por estrato', xaxis=list(title='Estrato'), yaxis=list(title='Precio (M COP)'))
if (any(!is.na(raw$zona))) {
  plot_ly(raw, x=~as.factor(zona), y=~preciom, type='box') %>%
    layout(title='Precio por zona', xaxis=list(title='Zona'), yaxis=list(title='Precio (M COP)'))
}
# Efecto de zona (eta² por ANOVA) + interpretación breve
if (any(!is.na(raw$zona))) {
  aov_z <- aov(preciom ~ as.factor(zona), data = raw)
  SS_total   <- sum((raw$preciom - mean(raw$preciom, na.rm=TRUE))^2, na.rm=TRUE)
  SS_between <- sum((tapply(raw$preciom, raw$zona, function(x) length(x)) *
                     (tapply(raw$preciom, raw$zona, mean, na.rm=TRUE) - mean(raw$preciom, na.rm=TRUE))^2), na.rm=TRUE)
  eta2_zona <- as.numeric(SS_between / SS_total)
  p_zona    <- summary(aov_z)[[1]][["Pr(>F)"]][1]
  cat(sprintf("\nEfecto de ZONA sobre precio (eta² ≈ %.3f, p=%.4f).\n", eta2_zona, p_zona))
}
## 
## Efecto de ZONA sobre precio (eta² ≈ 0.115, p=0.0000).
top_var <- cors %>% slice_max(abs(correlacion), n = 2)
if (nrow(top_var) >= 1) {
  cat(sprintf("- Correlación más alta: %s (r=%.2f).\n", top_var$variable[1], top_var$correlacion[1]))
}
## - Correlación más alta: parqueaderos (r=0.69).
if (nrow(top_var) >= 2) {
  cat(sprintf("- Segunda más alta: %s (r=%.2f).\n", top_var$variable[2], top_var$correlacion[2]))
}
## - Segunda más alta: areaconst (r=0.69).
if (exists("eta2_zona")) cat(sprintf("- Zona explica ≈ %.1f%% de la variación del precio.\n", 100*eta2_zona))
## - Zona explica ≈ 11.5% de la variación del precio.
cat("- Los boxplots sugieren que el precio tiende a subir con estrato y varía por zona.\n")
## - Los boxplots sugieren que el precio tiende a subir con estrato y varía por zona.

Modelado y estimación

# Split 70/30
split <- initial_split(raw_model, prop = 0.7)
train <- training(split); test <- testing(split)

# Enfoque A: estrato numérico
form_num <- preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios
m1_num <- lm(form_num, data = train)

# Enfoque B: estrato como factor (categórico)
train_fac <- train %>% mutate(estrato = factor(estrato))
form_fac <- preciom ~ areaconst + factor(estrato) + habitaciones + parqueaderos + banios
m1_fac <- lm(form_fac, data = train_fac)

# Predicción en prueba para ambos (respetando niveles en factor)
test_fac <- test %>% mutate(estrato = factor(estrato, levels = levels(train_fac$estrato)))
test_num_pred <- test %>% mutate(pred = predict(m1_num, newdata = .))
test_fac_pred <- test_fac %>% mutate(pred = predict(m1_fac, newdata = .))

met_num <- met(test_num_pred, truth = preciom, estimate = pred) %>% mutate(modelo = "Estrato numérico")
met_fac <- met(test_fac_pred, truth = preciom, estimate = pred) %>% mutate(modelo = "Estrato factor")

cat("Métricas en prueba (comparación enfoques de 'estrato'):\n")
## Métricas en prueba (comparación enfoques de 'estrato'):
bind_rows(met_num, met_fac) %>% 
  select(modelo, .metric, .estimate) %>% 
  pivot_wider(names_from = .metric, values_from = .estimate) %>%
  kable(digits=4) %>% kable_styling(full_width = FALSE)
modelo rmse mae rsq
Estrato numérico 174.7892 112.0831 0.7255
Estrato factor 166.7115 103.6188 0.7503 
# Selección automática por RMSE
best_is_factor <- (met_fac %>% filter(.metric=="rmse") %>% pull(.estimate)) <
                  (met_num %>% filter(.metric=="rmse") %>% pull(.estimate))

if (best_is_factor) {
  m_best <- m1_fac
  train_best <- train_fac
  test_best  <- test_fac
  best_tag   <- "factor (categórico)"
} else {
  m_best <- m1_num
  train_best <- train
  test_best  <- test
  best_tag   <- "numérico (lineal por estrato)"
}

cat("\nModelo elegido por RMSE en prueba: estrato tratado como **", best_tag, "**\n", sep="")
## 
## Modelo elegido por RMSE en prueba: estrato tratado como **factor (categórico)**
# Coeficientes del modelo elegido
tidy(m_best) %>% kable(digits=4) %>% kable_styling(full_width = FALSE)
term estimate std.error statistic p.value
(Intercept) -21.0738 11.3269 -1.8605 0.0629
areaconst 0.8096 0.0250 32.4203 0.0000
factor(estrato)4 37.7207 9.6117 3.9244 0.0001
factor(estrato)5 85.9230 9.3562 9.1835 0.0000
factor(estrato)6 300.7725 10.9335 27.5093 0.0000
habitaciones -24.5348 2.5700 -9.5467 0.0000
parqueaderos 69.1306 2.9638 23.3253 0.0000
banios 55.1505 3.0427 18.1255 0.0000

Comparaciones adicionales y ANOVA

m2_log  <- lm(log(preciom) ~ areaconst + estrato + habitaciones + parqueaderos + banios, data=train)
m3_full <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios + zona + tipo, data=train)

cmp <- bind_rows(
  glance(m1_num)  %>% mutate(modelo="M1: estrato numérico"),
  glance(m1_fac)  %>% mutate(modelo="M1*: estrato factor"),
  glance(m2_log)  %>% mutate(modelo="M2: log(precio)"),
  glance(m3_full) %>% mutate(modelo="M3: + zona + tipo")
) %>% select(modelo, r.squared, adj.r.squared, sigma, AIC, BIC)

cat("Comparación de alternativas (glance):\n")
## Comparación de alternativas (glance):
cmp %>% kable(digits=4) %>% kable_styling(full_width = FALSE)
modelo r.squared adj.r.squared sigma AIC BIC
M1: estrato numérico 0.7184 0.7181 178.2365 62080.469 62125.66
M1*: estrato factor 0.7393 0.7389 171.5323 61721.994 61780.09
M2: log(precio) 0.7874 0.7872 0.2906 1731.391 1776.58
M3: + zona + tipo 0.7365 0.7359 172.4984 61777.795 61855.26 
cat("ANOVA — modelo elegido:\n")
## ANOVA — modelo elegido:
anova(m_best)

Validación cruzada (10-fold)

set.seed(params$seed)
folds <- vfold_cv(train, v = 10)

fit_cv <- function(folds, formula, use_factor = FALSE){
  purrr::map_dfr(folds$splits, function(s){
    tr <- analysis(s); vl <- assessment(s)
    if (use_factor) {
      tr$estrato <- factor(tr$estrato)
      vl$estrato <- factor(vl$estrato, levels = levels(tr$estrato))
    }
    fit <- lm(formula, data = tr)
    tibble(truth = vl$preciom, estimate = predict(fit, newdata = vl))
  }) %>% yardstick::metric_set(rmse, rsq)(., truth = truth, estimate = estimate) %>%
    select(.metric, .estimate)
}

cv_num <- fit_cv(folds, form_num,  use_factor = FALSE) %>% mutate(modelo = "M1 numérico")
cv_fac <- fit_cv(folds, form_fac,  use_factor = TRUE ) %>% mutate(modelo = "M1* factor")
cat("Validación cruzada (10-fold):\n")
## Validación cruzada (10-fold):
bind_rows(cv_num, cv_fac) %>% kable(digits=4) %>% kable_styling(full_width = FALSE)
.metric .estimate modelo
rmse 178.6506 M1 numérico
rsq 0.7167 M1 numérico
rmse 172.0315 M1* factor
rsq 0.7373 M1* factor

Supuestos del modelo elegido

par(mfrow=c(2,2)); plot(m_best); par(mfrow=c(1,1))

res_m <- residuals(m_best)
shapiro <- shapiro.test(sample(res_m, size = min(length(res_m), 5000)))
bp <- bptest(m_best); vifs <- car::vif(m_best); dw <- lmtest::dwtest(m_best)

list(
  Shapiro_p = shapiro$p.value,          # normalidad
  Breusch_Pagan_p = bp$p.value,         # homocedasticidad
  Durbin_Watson_p = dw$p.value,         # independencia
  VIFs = vifs                           # multicolinealidad
)
## $Shapiro_p
## [1] 0.00000000000000000000000000000000000000000000000000001644058
## 
## $Breusch_Pagan_p
##                                                                                                                                                                                                             BP 
## 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002302915 
## 
## $Durbin_Watson_p
## [1] 0.9028665
## 
## $VIFs
##                     GVIF Df GVIF^(1/(2*Df))
## areaconst       2.124066  1        1.457418
## factor(estrato) 1.636978  3        1.085610
## habitaciones    2.040663  1        1.428518
## parqueaderos    1.800928  1        1.341986
## banios          2.852879  1        1.689047

Predicciones y sensibilidad

# Métricas en prueba del modelo elegido
test_best <- test_best %>% mutate(pred = predict(m_best, newdata = test_best))
met_prueba <- met(test_best, truth = preciom, estimate = pred)
cat("Métricas en prueba (modelo elegido):\n")
## Métricas en prueba (modelo elegido):
met_prueba %>% kable(digits=4) %>% kable_styling(full_width = FALSE)
.metric .estimator .estimate
rmse standard 166.7115
mae standard 103.6188
rsq standard 0.7503 
# Helper para newdata
lev_est <- if (best_is_factor) levels(train_best$estrato) else NULL
newdata_case <- function(area, estr_min, estr_max, hab, park, ban){
  if (best_is_factor) {
    tibble(areaconst=area,
           estrato=factor(c(estr_min, estr_max), levels=lev_est),
           habitaciones=hab, parqueaderos=park, banios=ban)
  } else {
    tibble(areaconst=area,
           estrato=c(estr_min, estr_max),
           habitaciones=hab, parqueaderos=park, banios=ban)
  }
}

# V1
new_v1 <- newdata_case(params$v1$area, params$v1$estrato_min, params$v1$estrato_max,
                       params$v1$habitaciones, params$v1$parqueaderos, params$v1$banios)
pred_v1 <- bind_cols(new_v1, as_tibble(predict(m_best, new_v1, interval='prediction', level=0.90))) %>%
  rename(pred.fit=fit, pred.lwr=lwr, pred.upr=upr)
cat("Predicción Vivienda 1 (millones):\n")
## Predicción Vivienda 1 (millones):
pred_v1 %>% kable(digits=1) %>% kable_styling(full_width = FALSE)
areaconst estrato habitaciones parqueaderos banios pred.fit pred.lwr pred.upr
200 4 4 1 2 259.9 -22.5 542.3
200 5 4 1 2 308.1 25.7 590.4 
# V2
new_v2 <- newdata_case(params$v2$area, params$v2$estrato_min, params$v2$estrato_max,
                       params$v2$habitaciones, params$v2$parqueaderos, params$v2$banios)
pred_v2 <- bind_cols(new_v2, as_tibble(predict(m_best, new_v2, interval='prediction', level=0.90))) %>%
  rename(pred.fit=fit, pred.lwr=lwr, pred.upr=upr)
cat("Predicción Vivienda 2 (millones):\n")
## Predicción Vivienda 2 (millones):
pred_v2 %>% kable(digits=1) %>% kable_styling(full_width = FALSE)
areaconst estrato habitaciones parqueaderos banios pred.fit pred.lwr pred.upr
300 5 5 3 3 557.9 275.5 840.3
300 6 5 3 3 772.7 490.2 1055.3 
# Chequeo de presupuesto (predicción media vs crédito)
mid_v1 <- mean(range(pred_v1$pred.fit))
mid_v2 <- mean(range(pred_v2$pred.fit))
cat(sprintf("\nPresupuesto V1 (≤ %d M): pred. media ≈ %.0f M — %s.\n", params$v1$credito, mid_v1,
            ifelse(mid_v1 <= params$v1$credito, "viable dentro del crédito", "podría exceder el crédito")))
## 
## Presupuesto V1 (≤ 350 M): pred. media ≈ 284 M — viable dentro del crédito.
cat(sprintf("Presupuesto V2 (≤ %d M): pred. media ≈ %.0f M — %s.\n", params$v2$credito, mid_v2,
            ifelse(mid_v2 <= params$v2$credito, "viable dentro del crédito", "podría exceder el crédito")))
## Presupuesto V2 (≤ 850 M): pred. media ≈ 665 M — viable dentro del crédito.
# Sensibilidad: producto cartesiano (arreglo del error)
mk_grid <- function(area, estr_min, estr_max, hab, park, ban, best_is_factor = FALSE, lev_est = NULL){
  g <- tidyr::expand_grid(
    areaconst = area * c(0.9, 1, 1.1),
    estrato   = c(estr_min, estr_max)
  )
  if (best_is_factor) g <- g %>% mutate(estrato = factor(estrato, levels = lev_est))
  g %>% mutate(habitaciones = hab, parqueaderos = park, banios = ban)
}

grid_v1 <- mk_grid(
  area = params$v1$area,
  estr_min = params$v1$estrato_min, estr_max = params$v1$estrato_max,
  hab = params$v1$habitaciones, park = params$v1$parqueaderos, ban = params$v1$banios,
  best_is_factor = best_is_factor, lev_est = lev_est
)

grid_v2 <- mk_grid(
  area = params$v2$area,
  estr_min = params$v2$estrato_min, estr_max = params$v2$estrato_max,
  hab = params$v2$habitaciones, park = params$v2$parqueaderos, ban = params$v2$banios,
  best_is_factor = best_is_factor, lev_est = lev_est
)

sens_v1 <- bind_cols(
  grid_v1,
  as_tibble(predict(m_best, grid_v1, interval = "prediction", level = 0.90))
) %>% rename(pred.fit = fit, pred.lwr = lwr, pred.upr = upr)

sens_v2 <- bind_cols(
  grid_v2,
  as_tibble(predict(m_best, grid_v2, interval = "prediction", level = 0.90))
) %>% rename(pred.fit = fit, pred.lwr = lwr, pred.upr = upr)

cat("Sensibilidad — Vivienda 1:\n")
## Sensibilidad — Vivienda 1:
sens_v1 %>% kable(digits=1) %>% kable_styling(full_width = FALSE)
areaconst estrato habitaciones parqueaderos banios pred.fit pred.lwr pred.upr
180 4 4 1 2 243.7 -38.7 526.1
180 5 4 1 2 291.9 9.5 574.2
200 4 4 1 2 259.9 -22.5 542.3
200 5 4 1 2 308.1 25.7 590.4
220 4 4 1 2 276.1 -6.4 558.5
220 5 4 1 2 324.3 41.9 606.6 
cat("\nSensibilidad — Vivienda 2:\n")
## 
## Sensibilidad — Vivienda 2:
sens_v2 %>% kable(digits=1) %>% kable_styling(full_width = FALSE)
areaconst estrato habitaciones parqueaderos banios pred.fit pred.lwr pred.upr
270 5 5 3 3 533.6 251.2 816.0
270 6 5 3 3 748.5 466.0 1031.0
300 5 5 3 3 557.9 275.5 840.3
300 6 5 3 3 772.7 490.2 1055.3
330 5 5 3 3 582.2 299.8 864.6
330 6 5 3 3 797.0 514.5 1079.6

Ofertas potenciales y mapas

# Scoring de cercanía al perfil
score_oferta <- function(df, area, hab, ban, park){
  df %>% mutate(
    s_area = abs(areaconst - area)/pmax(area,1),
    s_hab  = abs(habitaciones - hab),
    s_ban  = abs(banios - ban),
    s_park = pmax(0, parqueaderos - park),
    score  = s_area + 0.5*s_hab + 0.5*s_ban + 0.25*s_park
  )
}

filtrar_candidatas <- function(data, tipo_key, zona_key, credito, area, hab, ban, park, estr_min, estr_max){
  data %>%
    filter(
      str_detect(tipo, regex(tipo_key, ignore_case = TRUE)),
      str_detect(zona, regex(zona_key, ignore_case = TRUE)),
      preciom <= credito,
      estrato >= estr_min, estrato <= estr_max,
      habitaciones >= pmax(1, hab-1), habitaciones <= hab+1,
      banios >= pmax(1, ban-1),        banios <= ban+1,
      parqueaderos >= park,
      areaconst >= area*0.85, areaconst <= area*1.15
    ) %>%
    score_oferta(area, hab, ban, park) %>%
    arrange(score, preciom)
}
cand_v1 <- filtrar_candidatas(
  raw,
  tipo_key=params$v1$tipo, zona_key=params$v1$zona, credito=params$v1$credito,
  area=params$v1$area, hab=params$v1$habitaciones, ban=params$v1$banios, park=params$v1$parqueaderos,
  estr_min=params$v1$estrato_min, estr_max=params$v1$estrato_max
)
cand_v1_top5 <- cand_v1 %>% slice_head(n=5)
cat("Top 5 ofertas — Vivienda 1:\n")
## Top 5 ofertas — Vivienda 1:
cand_v1_top5 %>% select(zona, barrio, tipo, estrato, areaconst, habitaciones, banios, parqueaderos, preciom, score) %>%
  kable(digits=2) %>% kable_styling(full_width = FALSE)
zona barrio tipo estrato areaconst habitaciones banios parqueaderos preciom score
Zona Norte la merced Casa 5 216 4 2 2 350 0.33
Zona Norte vipasa Casa 5 203 4 3 2 340 0.76
Zona Norte el bosque Casa 5 203 5 2 2 350 0.76
Zona Norte el bosque Casa 5 200 4 3 3 350 1.00
Zona Norte la flora Casa 5 190 3 3 1 350 1.05 
cand_v1_map <- cand_v1_top5 %>% filter(!is.na(longitud), !is.na(latitud))
if (nrow(cand_v1_map) > 0) {
  leaflet(cand_v1_map) %>% addTiles() %>%
    addMarkers(~longitud, ~latitud,
               popup = ~paste0('<b>', tipo, '</b> — ', zona,
                               '<br><b>Precio:</b> ', round(preciom,1), ' M',
                               '<br><b>Área:</b> ', areaconst, ' m²',
                               '<br><b>Estrato:</b> ', estrato,
                               '<br><b>Habitaciones/Baños:</b> ', habitaciones,' / ', banios,
                               '<br><b>Parqueaderos:</b> ', parqueaderos,
                               '<br><b>Barrio:</b> ', barrio)) %>%
    setView(lng = median(cand_v1_map$longitud, na.rm=TRUE),
            lat = median(cand_v1_map$latitud,  na.rm=TRUE), zoom = 12)
}
cand_v2 <- filtrar_candidatas(
  raw,
  tipo_key=params$v2$tipo, zona_key=params$v2$zona, credito=params$v2$credito,
  area=params$v2$area, hab=params$v2$habitaciones, ban=params$v2$banios, park=params$v2$parqueaderos,
  estr_min=params$v2$estrato_min, estr_max=params$v2$estrato_max
)
cand_v2_top5 <- cand_v2 %>% slice_head(n=5)
cat("Top 5 ofertas — Vivienda 2:\n")
## Top 5 ofertas — Vivienda 2:
cand_v2_top5 %>% select(zona, barrio, tipo, estrato, areaconst, habitaciones, banios, parqueaderos, preciom, score) %>%
  kable(digits=2) %>% kable_styling(full_width = FALSE)
zona barrio tipo estrato areaconst habitaciones banios parqueaderos preciom score
Zona Sur capri Apartamento 5 270 4 3 3 350 0.6 
cand_v2_map <- cand_v2_top5 %>% filter(!is.na(longitud), !is.na(latitud))
if (nrow(cand_v2_map) > 0) {
  leaflet(cand_v2_map) %>% addTiles() %>%
    addMarkers(~longitud, ~latitud,
               popup = ~paste0('<b>', tipo, '</b> — ', zona,
                               '<br><b>Precio:</b> ', round(preciom,1), ' M',
                               '<br><b>Área:</b> ', areaconst, ' m²',
                               '<br><b>Estrato:</b> ', estrato,
                               '<br><b>Habitaciones/Baños:</b> ', habitaciones,' / ', banios,
                               '<br><b>Parqueaderos:</b> ', parqueaderos,
                               '<br><b>Barrio:</b> ', barrio)) %>%
    setView(lng = median(cand_v2_map$longitud, na.rm=TRUE),
            lat = median(cand_v2_map$latitud,  na.rm=TRUE), zoom = 12)
}

Shortlist ejecutiva

shortlist <- bind_rows(
  cand_v1_top5 %>% mutate(solicitud = 'Vivienda 1'),
  cand_v2_top5 %>% mutate(solicitud = 'Vivienda 2')
) %>% select(solicitud, zona, barrio, tipo, estrato, areaconst, habitaciones, banios, parqueaderos, preciom, score) %>%
  arrange(solicitud, score, preciom)
shortlist %>% kable(digits=2) %>% kable_styling(full_width = FALSE)
solicitud zona barrio tipo estrato areaconst habitaciones banios parqueaderos preciom score
Vivienda 1 Zona Norte la merced Casa 5 216 4 2 2 350 0.33
Vivienda 1 Zona Norte vipasa Casa 5 203 4 3 2 340 0.76
Vivienda 1 Zona Norte el bosque Casa 5 203 5 2 2 350 0.76
Vivienda 1 Zona Norte el bosque Casa 5 200 4 3 3 350 1.00
Vivienda 1 Zona Norte la flora Casa 5 190 3 3 1 350 1.05
Vivienda 2 Zona Sur capri Apartamento 5 270 4 3 3 350 0.60

Resumen numérico

v1_range <- range(pred_v1$pred.fit)
v2_range <- range(pred_v2$pred.fit)

list(
  'Componentes_analisis' = c('EDA interactivo', 'Modelo lineal', 'Supuestos', 'Predicciones', 'Ofertas con mapa'),
  'Modelo_elegido' = c(paste('Estrato tratado como', best_tag)),
  'Glance' = glance(m_best)[c('r.squared','adj.r.squared','sigma','AIC','BIC')],
  'Coef_signif' = tidy(m_best) %>% filter(p.value < 0.05) %>% select(term, estimate),
  'Metricas_prueba' = met_prueba,
  'Prediccion_V1_millones' = v1_range,
  'Prediccion_V2_millones' = v2_range,
  'Ofertas_V1_n' = nrow(cand_v1_top5),
  'Ofertas_V2_n' = nrow(cand_v2_top5)
)
## $Componentes_analisis
## [1] "EDA interactivo"  "Modelo lineal"    "Supuestos"        "Predicciones"    
## [5] "Ofertas con mapa"
## 
## $Modelo_elegido
## [1] "Estrato tratado como factor (categórico)"
## 
## $Glance
## # A tibble: 1 × 5
##   r.squared adj.r.squared sigma    AIC    BIC
##       <dbl>         <dbl> <dbl>  <dbl>  <dbl>
## 1     0.739         0.739  172. 61722. 61780.
## 
## $Coef_signif
## # A tibble: 7 × 2
##   term             estimate
##   <chr>               <dbl>
## 1 areaconst           0.810
## 2 factor(estrato)4   37.7  
## 3 factor(estrato)5   85.9  
## 4 factor(estrato)6  301.   
## 5 habitaciones      -24.5  
## 6 parqueaderos       69.1  
## 7 banios             55.2  
## 
## $Metricas_prueba
## # A tibble: 3 × 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 rmse    standard     167.   
## 2 mae     standard     104.   
## 3 rsq     standard       0.750
## 
## $Prediccion_V1_millones
## [1] 259.8593 308.0617
## 
## $Prediccion_V2_millones
## [1] 557.8985 772.7480
## 
## $Ofertas_V1_n
## [1] 5
## 
## $Ofertas_V2_n
## [1] 1

Informe ejecutivo

mp <- met_prueba %>% select(.metric, .estimate) %>%
  tidyr::pivot_wider(names_from=.metric, values_from=.estimate)
v1r <- range(pred_v1$pred.fit); v2r <- range(pred_v2$pred.fit)

cat("**Contexto.** Se ajustó un modelo de regresión lineal múltiple (RLM) para explicar el precio (M COP) con área, estrato, habitaciones, parqueaderos y baños. Estrato se trató como **", best_tag, "**.\n\n", sep="")

Contexto. Se ajustó un modelo de regresión lineal múltiple (RLM) para explicar el precio (M COP) con área, estrato, habitaciones, parqueaderos y baños. Estrato se trató como factor (categórico).

cat("**Hallazgos.** Área y estrato muestran asociación positiva. ",
    "Prueba — RMSE: ", sprintf('%.2f', mp$rmse),
    ", MAE: ", sprintf('%.2f', mp$mae),
    ", R²: ", sprintf('%.3f', mp$rsq), ". ",
    "Predicción V1 (Casa, Norte, estrato 4–5): **", sprintf('%.0f–%.0f', v1r[1], v1r[2]), " M**. ",
    "Predicción V2 (Apto, Sur, estrato 5–6): **", sprintf('%.0f–%.0f', v2r[1], v2r[2]), " M**.\n\n", sep="")

Hallazgos. Área y estrato muestran asociación positiva. Prueba — RMSE: 166.71, MAE: 103.62, R²: 0.750. Predicción V1 (Casa, Norte, estrato 4–5): 260–308 M. Predicción V2 (Apto, Sur, estrato 5–6): 558–773 M.

cat("**Recomendación.** V1: priorizar 180–220 m², estrato 4–5, ≥2 baños, ≤350 M en Zona Norte. ",
    "V2: aptos ~300 m², estrato 5–6, ≤850 M en Zona Sur. ",
    "Ver mapas y shortlist ejecutiva.\n")

Recomendación. V1: priorizar 180–220 m², estrato 4–5, ≥2 baños, ≤350 M en Zona Norte. V2: aptos ~300 m², estrato 5–6, ≤850 M en Zona Sur. Ver mapas y shortlist ejecutiva.