Bogotá bajo la lupa: población, territorio y denuncias en las UPZ

¿Cómo se relacionan la composición por rangos de edad de la población y el área territorial de las UPZ con la cantidad y la tasa de denuncias por delito en Bogotá?

Territorio y seguridad en Bogotá: un análisis de las denuncias por UPZ

Una exploración de las características demográficas y territoriales y su relación con las denuncias por delito en Bogotá

library(tidyverse)      # incluye dplyr, tidyr, readr, purrr y ggplot2
library(scales)
library(showtext)
library(sysfonts)
library(sf)
library(plotly)
library(kableExtra)
library(jsonlite)

fuente_editorial <- "Fira Sans"
font_add_google(name = fuente_editorial, family = fuente_editorial)
showtext_auto()

# 1. cargar datos
upz <- read_csv(file.path(ruta_input, "upz_variables.csv"), show_col_types = FALSE)

# 1.1 . Explorar Data set UPZ

# Dimensiones de la base
dim(upz)

# Nombres de las columnas
names(upz)

# glimpse(): ver TODAS las columnas, su tipo y los primeros valores en una pantalla.
glimpse(upz)

# Primeras observaciones
head(upz)

# Las columnas están agrupadas por prefijo. starts_with() selecciona por prefijo:
upz %>% select(upz_nombre, starts_with("tasa_")) %>% head()   # tasas de delitos /10.000 hab
upz %>% select(upz_nombre, starts_with("min_"))  %>% head()   # minutos caminando a servicios

# 1.2 validar faltantes en Dataset

faltantes <- upz |>
  summarise(across(everything(),
                   ~ sum(is.na(.x)))) |>
  pivot_longer(
    cols = everything(),
    names_to = "variable",
    values_to = "faltantes"
  ) |>
  arrange(desc(faltantes))

faltantes

## 2. cargar ´paleta de colores 
#--- Paleta y tema del curso (los mismos de todos los scripts) --------------
morado   <- "#351A4F"
magenta  <- "#D9006C"
turquesa <- "#168C86"
gris     <- "#D9D6DD"

tema_clase <- theme_minimal(base_size = 12) +
  theme(
    plot.title.position = "plot",
    plot.title = element_text(face = "bold", size = 15, hjust = 0),
    plot.subtitle = element_text(size = 10.5, color = "grey35", hjust = 0),
    panel.grid.minor = element_blank(),
    plot.caption = element_text(hjust = 0, color = "grey45", size = 8.5),
    plot.margin = margin(10, 20, 10, 10)
  )


estilo_plotly <- function(p) {
  p %>%
    config(displayModeBar = FALSE) %>%          
    layout(font = list(family = fuente_editorial)) 
}

tabla_bonita <- function(df, resaltar = NULL) {
  k <- df %>%
    kbl() %>%   
    kable_styling(bootstrap_options = c("hover", "condensed"), full_width = TRUE, font_size = 14) %>%
    row_spec(0, bold = TRUE, color = "white", background = morado)  # fila 0 = encabezado
  if (!is.null(resaltar)) {
    k <- k %>% row_spec(resaltar, background = "#F6EEF2", bold = TRUE, color = morado)
  }
  k
}

# --- Segmentación poblacional: nombres y colores (se usan en todo el informe) ---
grupos  <- c("Población baja", "Población media", "Población alta")
colores <- c("Población baja"  = "#F8766D",
             "Población media" = "#F2B84B",
             "Población alta"  = "#4C9F70")

# --- Formato de números y porcentajes (estilo colombiano) ---
num <- function(x, ...) scales::number(x, big.mark = ".", decimal.mark = ",", ...)
pc  <- function(x) scales::percent(x, accuracy = 0.1, decimal.mark = ",")

# --- Piezas de estilo plotly que se repetían en varios gráficos ---
hover_plotly <- list(bgcolor = morado, font = list(color = "white", size = 13), align = "left")

# Parte un título largo en varias líneas (plotly no baja de línea solo y el título se corta)
partir_titulo <- function(texto, ancho = 75) paste(strwrap(texto, width = ancho), collapse = "<br>")

titulo_plotly <- function(texto, ...) {
  c(list(text = texto, x = 0.01, xanchor = "left", y = 0.97, yanchor = "top",
         font = list(size = 18, color = morado)), list(...))
}

menu_plotly <- function(botones, x = 0, y = 1.04) {
  list(type = "dropdown", direction = "down", active = 0, showactive = TRUE,
       x = x, xanchor = "left", y = y, yanchor = "bottom", buttons = botones,
       bgcolor = "white", bordercolor = gris, font = list(color = morado, size = 13))
}

# --- Caja de comentarios debajo del gráfico (la usan 4.3 y 4.4) ---
js_comentarios <- "
function(el, x, datos) {
  var caja = document.createElement('div');
  caja.style.cssText = 'width:100%;box-sizing:border-box;padding:14px 18px;margin-top:6px;border-top:2px solid #D9D6DD;font-size:14px;line-height:1.5;color:#333;';
  el.parentNode.insertBefore(caja, el.nextSibling);
  var actual = -1;

  function pintar(i) {
    if (i === actual) return;
    actual = i;
    caja.innerHTML = '';
    var ul = document.createElement('ul');
    ul.style.cssText = 'margin:0;padding-left:20px;';
    [].concat(datos.comentarios[i]).forEach(function(t) {
      var li = document.createElement('li');
      li.style.marginBottom = '4px';
      li.innerHTML = t;
      ul.appendChild(li);
    });
    caja.appendChild(ul);
  }

  // devuelve el número de vista según qué traza de inicio está visible (datos.inicios = traza inicial de cada vista)
  function vista() {
    var d = el.data, ini = datos.inicios;
    for (var i = 0; i < ini.length; i++) {
      if (d[ini[i]] && d[ini[i]].visible === true) return i;
    }
    return 0;
  }

  pintar(0);
  el.on('plotly_afterplot', function() { pintar(vista()); });
}
"

1. Introducción

En este informe se analizan las 112 UPZ de Bogotá, con el propósito de explorar las características demográficas y territoriales de cada una, así como su relación con las denuncias registradas entre enero y julio de 2023. Además, se busca identificar posibles relaciones entre la composición de la población, las características del territorio y la cantidad y las tasas de denuncias asociadas a diferentes tipos de delito. De esta manera, se pretende reconocer patrones y diferencias entre las UPZ que permitan comprender mejor el comportamiento territorial de las denuncias en la ciudad.

Preguntas que guían el análisis

1. ¿Segmentar las UPZ por tamaño de población permite comparaciones más justas?
2. ¿Cómo varían las tasas de denuncias según el grupo de población y qué UPZ son atípicas?
3. ¿Qué delitos predominan en cada grupo y cambia su peso entre grupos?
4. ¿Cómo se relaciona la composición por edad con las tasas de delito y esa relación cambia según el grupo?
5. ¿Dónde se ubican las UPZ con mayores tasas y cómo se ven las segmentaciones en el territorio?

Variables seleccionadas y por qué

Se usan 14 variables agrupadas en tres bloques, porque cada bloque responde a una parte de las preguntas:

Bloque	Variables	Por qué se eligen
Territorial	area_km2, poblacion	Describen el tamaño y la población de cada UPZ. poblacion es la base de la segmentación (K-means) y del cálculo de tasas.
Demográfico	pct_0_14, pct_15_29, pct_30_59 (Se genera esta variable), pct_60_mas	Permiten ver si la estructura por edades se asocia con más o menos denuncias.
Delitos	casos_total, tasa_total, hurto_total (suma de 7 tipos de hurto), lesiones, homicidios, violencia_intrafamiliar y sus tasas	Son lo que se quiere explicar. Se usan tasas por cada 10.000 habitantes para comparar UPZ de distinto tamaño.

Nota: importante indicar que las cifras son denuncias registradas, no delitos ocurridos. Por eso se interpretan como asociaciones entre UPZ y no como causas.

2. Objetivos

Objetivo general: Analizar la relación entre las características demográficas y territoriales de las 112 UPZ de Bogotá y la cantidad y las tasas de denuncias registradas por diferentes tipos de delito, con el fin de identificar patrones y diferencias territoriales durante el periodo de estudio.

Objetivos específicos:

1. Segmentar las UPZ de Bogotá a partir de sus variables como la población, la composición por grupos de edad, el área y la densidad poblacional.

2. Describir y comparar la cantidad y las tasas de denuncias correspondientes a diferentes tipos de delito, identificando las UPZ que presentan mayores y menores registros.

3. Explorar las posibles relaciones entre las características poblacionales y territoriales de las UPZ y el comportamiento de las denuncias, mediante herramientas estadísticas y visualizaciones que permitan identificar patrones y diferencias espaciales.

3. Fuentes de información

3.1 Dataset de estudio UPZ Bogotá

3.1.1 Fuentes

1. Delitos: Secretaría Distrital de Seguridad, Convivencia y Justicia. Población y viviendas: proyecciones DANE (CNPV 2018).

2. Luminarias: Datos Abiertos Bogotá. Encuesta Multipropósito 2021: DANE.

3.1.2 Variables analisis de estudio

# Las 8 variables de estudio con su descripción (una sola vez: también se usa en la tabla descriptiva)
descripcion_variables <- c(
  area_km2         = "Área territorial de la UPZ en kilómetros cuadrados",
  poblacion        = "Cantidad de habitantes de la UPZ",
  densidad_hab_km2 = "Densidad de habitantes por kilómetro cuadrado",
  pct_0_14         = "Porcentaje de población entre 0 y 14 años",
  pct_15_29        = "Porcentaje de población entre 15 y 29 años",
  pct_60_mas       = "Porcentaje de población mas de 60 años",
  casos_total      = "Cantidad total de denuncias registradas",
  tasa_total       = "Tasa total de denuncias por cada 10.000 habitantes"
)

variables <- names(descripcion_variables)

tibble(
  Variable    = variables,
  Descripcion = unname(descripcion_variables)
) %>%
  tabla_bonita(resaltar = c(1,2))

Variable	Descripcion
area_km2	Área territorial de la UPZ en kilómetros cuadrados
poblacion	Cantidad de habitantes de la UPZ
densidad_hab_km2	Densidad de habitantes por kilómetro cuadrado
pct_0_14	Porcentaje de población entre 0 y 14 años
pct_15_29	Porcentaje de población entre 15 y 29 años
pct_60_mas	Porcentaje de población mas de 60 años
casos_total	Cantidad total de denuncias registradas
tasa_total	Tasa total de denuncias por cada 10.000 habitantes

Datos importantes del dataset a tener en cuenta

n_upz <- n_distinct(upz$upz_cod)

poblacion_total <- sum(upz$poblacion, na.rm = TRUE)

area_total <- sum(upz$area_km2, na.rm = TRUE)

total_denuncias <- sum(upz$casos_total, na.rm = TRUE)

paste0(
  n_upz, " UPZ analizadas · ",
  comma(poblacion_total, big.mark = "."), " habitantes · ",
  comma(round(area_total, 2), big.mark = "."), " km² de extensión · ",
  comma(total_denuncias, big.mark = "."), " denuncias registradas","  Periodo: enero-julio de 2023"
)

## [1] "112 UPZ analizadas · 7.936.532 habitantes · 415 km² de extensión · 162.835 denuncias registradas  Periodo: enero-julio de 2023"

Bogotá en cifras: una mirada estadística a las UPZ:

# "variables" viene de la tabla de variables (sección 3.1.2)

tabla_descriptiva <- data.frame(
  Media = sapply(upz[variables], mean, na.rm = TRUE),
  Mediana = sapply(upz[variables], median, na.rm = TRUE),
  Desviacion = sapply(upz[variables], sd, na.rm = TRUE),
  Minimo = sapply(upz[variables], min, na.rm = TRUE),
  Maximo = sapply(upz[variables], max, na.rm = TRUE)
)

# Redondear las estadísticas a 1 decimal
tabla_descriptiva[] <- lapply(tabla_descriptiva, round, digits = 1)

# Mostrar tabla
tabla_descriptiva %>%
  tabla_bonita(resaltar = c(1, 2))

	Media	Mediana	Desviacion	Minimo	Maximo
area_km2	3.7	3.5	1.7	0.9	9.3
poblacion	70861.9	54102.5	58406.4	30.0	305907.0
densidad_hab_km2	19119.4	20180.2	10801.9	9.4	46156.9
pct_0_14	17.3	16.7	4.8	7.4	31.0
pct_15_29	24.1	24.0	4.5	14.8	51.9
pct_60_mas	15.7	14.6	5.1	7.5	29.9
casos_total	1453.9	1222.0	1023.1	16.0	5441.0
tasa_total	503.6	192.5	1263.4	64.5	11333.3

4. Analisis poblacional y territorial de las upz

4.1 ¿La segmentación de las poblaciones permite realizar un análisis más preciso y profundo de la información?

p_poblacion_area <- ggplot(upz, aes(x = area_km2, y = poblacion)) +
  geom_point(
    color = "#6B4C8A",
    size = 2.5,
    alpha = 0.7,
    aes(text = paste0(
      "UPZ: ", upz_nombre,
      "<br>Área: ", round(area_km2, 2), " km²",
      "<br>Población: ",
      format(round(poblacion), big.mark = ".", decimal.mark = ",",
             scientific = FALSE)
    ))
  ) +
  geom_smooth(
    method = "lm",
    se = FALSE,
    color = "#D17A22"
  ) +
  scale_y_continuous(
    labels = scales::label_comma(
      big.mark = ".",
      decimal.mark = ","
    )
  ) +
  labs(
    x = "Área territorial (km²)",
    y = "Población (habitantes)"
  ) +
  tema_clase +
  theme(
    panel.grid.major.x = element_blank()
  )

ggplotly(p_poblacion_area, tooltip = "text") %>%
  estilo_plotly() %>%
  layout(
    title = titulo_plotly(
      paste0(
        "<b>", partir_titulo("El área y la población se relacionan de manera moderada: algunas UPZ pequeñas tienen más población que otras más grandes"), "</b>",
        "<br><sup>Cada punto representa una UPZ. Pasa el cursor sobre cada punto para consultar sus cifras.</sup>"
      ),
      xref = "container"
    ),
    margin = list(t = 125)
  )

Al revisar los datos, se evidencia que la población presenta una diferencia bastante amplia entre el valor mínimo y el máximo. Por esta razón, considero necesario dividir las UPZ en tres grupos: población baja, población media y población alta. Esto permitirá realizar comparaciones entre UPZ que tengan características poblacionales similares y analizar de una mejor manera las tasas de denuncias, teniendo en cuenta que estas pueden variar bastante dependiendo de la cantidad de habitantes de cada territorio.

4.2 ¿Cómo varían las tasas de denuncias según el grupo de población y qué UPZ son atípicas?

Teniendo en cuenta el hallazgo anterior y generada la segmentación por medio de K-Means se evidencia lo siguiente.

Estadisticas descriptivas segmentación generada

# K-means # modelo de clusters
set.seed(123)

modelo <- kmeans(
  scale(upz["poblacion"]),
  centers = 3,
  nstart = 25
)

# Identificar el orden de los grupos según su población promedio
orden_grupos <- order(modelo$centers[, 1])

# Asignar las categorías a cada UPZ (los nombres de los grupos se definen en el chunk "estilo")
upz <- upz %>%
  mutate(
    grupo_poblacion = factor(
      grupos[match(modelo$cluster, orden_grupos)],
      levels = grupos
    )
  )

# Variables derivadas que se usan en 4.3, 4.4 y el mapa (se calculan una sola vez)
cols_hurto <- c("casos_hurto_personas", "casos_hurto_residencias", "casos_hurto_automotor",
                "casos_hurto_bicicletas", "casos_hurto_comercio", "casos_hurto_celulares",
                "casos_hurto_motos")

upz <- upz %>%
  mutate(
    casos_hurto_total = rowSums(across(all_of(cols_hurto))),
    tasa_hurto_total  = casos_hurto_total / poblacion * 10000,
    pct_30_59         = 100 - (pct_0_14 + pct_15_29 + pct_60_mas)   # lo que falta para llegar a 100 %
  )

k_atipico <- 1.5   # límite atípico: Q3 + 1,5 × IQR
k_extremo <- 3     # límite extremo: Q3 + 3 × IQR

# Agregar n a las etiquetas (grupo_poblacion ya es factor ordenado desde el K-means)
upz <- upz %>%
  group_by(grupo_poblacion) %>%
  mutate(
    # todo se calcula con las tasas reales (sin log)
    q1_g = quantile(tasa_total, 0.25),
    q3_g = quantile(tasa_total, 0.75),
    iqr_g = q3_g - q1_g,
    lim_atipico = q3_g + k_atipico * iqr_g,
    lim_extremo = q3_g + k_extremo * iqr_g,
    es_atipico  = tasa_total > lim_atipico | tasa_total < q1_g - k_atipico * iqr_g,
    es_extremo  = tasa_total > lim_extremo | tasa_total < q1_g - k_extremo * iqr_g,
    etiqueta = paste0(grupo_poblacion, "<br>(n = ", n(), ")")
  ) %>%
  ungroup() %>%
  mutate(
    etiqueta = factor(etiqueta, levels = unique(etiqueta[order(grupo_poblacion)])),
    pos = as.numeric(etiqueta),
    texto = paste0(
      "<b>", upz_nombre, "</b>",
      "<br>Localidad: ", localidad,
      "<br>Población: ", scales::comma(poblacion),
      "<br>Tasa total: ", round(tasa_total, 1),
      ifelse(es_extremo, "<br><i>Atípico extremo</i>", "<br><i>Atípico</i>")
    )
  )

# límites por grupo (para que los revises)
upz %>% distinct(grupo_poblacion, q1_g, q3_g, iqr_g, lim_atipico, lim_extremo)%>%
  tabla_bonita(resaltar = c())

grupo_poblacion	q1_g	q3_g	iqr_g	lim_atipico	lim_extremo
Población baja	163.1525	479.1225	315.97	953.0775	1427.033
Población media	106.4600	192.2100	85.75	320.8350	449.460
Población alta	113.9600	138.5400	24.58	175.4100	212.280

rgba <- function(col, a) { m <- col2rgb(col); sprintf("rgba(%d,%d,%d,%.2f)", m[1], m[2], m[3], a) }

g <- plot_ly()

# 1. cajas: los bigotes terminan en el límite superior/inferior (no en el máximo)
#    los puntos propios de la caja se ocultan; los atípicos que se ven son los de abajo
for (gr in levels(upz$grupo_poblacion)) {
  d <- upz %>% filter(grupo_poblacion == gr)
  g <- g %>% add_trace(
    data = d, type = "box",
    x = ~pos, y = ~tasa_total, width = 0.6,
    fillcolor = rgba(colores[[gr]], 0.5),
    line = list(color = "grey20", width = 1.5),
    boxpoints = "outliers",
    marker = list(opacity = 0, size = 1),   # puntos de la caja invisibles
    quartilemethod = "linear",
    hoveron = "boxes",                      # el cuadro del mouse solo sale sobre la caja
    hoverinfo = "y", showlegend = FALSE
  )
}

# 2. atípicos (negros)
set.seed(123)
negros <- upz %>% filter(es_atipico, !es_extremo) %>%
  mutate(xj = pos + runif(n(), -0.07, 0.07))

g <- g %>% add_trace(
  data = negros, type = "scatter", mode = "markers",
  x = ~xj, y = ~tasa_total,
  marker = list(color = "grey20", size = 7, opacity = 0.75),
  hovertext = ~texto, hoverinfo = "text", showlegend = FALSE
)

# 3. atípicos extremos (rojos)
rojos <- upz %>% filter(es_extremo) %>%
  mutate(xj = pos + runif(n(), -0.07, 0.07))

g <- g %>% add_trace(
  data = rojos, type = "scatter", mode = "markers",
  x = ~xj, y = ~tasa_total,
  marker = list(color = "red", size = 10, opacity = 0.9),
  hovertext = ~texto, hoverinfo = "text", showlegend = FALSE
)

# 4. escala log solo para la vista
marcas <- c(50, 100, 200, 500, 1000, 2000, 5000, 10000)
etiquetas_x <- levels(upz$etiqueta)

g <- g %>%
  layout(
    title = list(
      text = paste0("<b>", partir_titulo("Poblacion baja tiene los atipicos extremos, aumentando la tasa de delitos, Poblacion media y alta son homogéneas"), "</b>",
                    "<br><sup>Método K-means · puntos negros = atípicos (> Q3 + 1,5 × IQR) · ",
                    "puntos rojos = atípicos extremos (> Q3 + 3 × IQR) · pasa el cursor para ver los valores</sup>"),
      x = 0.01, xanchor = "left"
    ),
    xaxis = list(title = "Grupo de población", showgrid = FALSE, zeroline = FALSE,
                 tickvals = seq_along(etiquetas_x), ticktext = etiquetas_x,
                 range = c(0.4, length(etiquetas_x) + 0.6)),
    yaxis = list(title = "Tasa total de delitos (escala log)", type = "log",
                 tickvals = marcas, ticktext = format(marcas, big.mark = ".", scientific = FALSE),
                 hoverformat = ".1f"),
    hoverlabel = list(align = "left"),
    margin = list(t = 125)
  ) %>%
  estilo_plotly()

g

En las poblaciones media y alta no se identifican valores atípicos que puedan afectar significativamente el análisis de correlación entre el tamaño de la población y las tasas de delito. Sin embargo, en la población baja se identifican varios valores atipicos extremos, como se muestran en la tabla a continuacion.

Estos valores merecen especial atención, ya que podrían influir en los resultados del análisis de correlación y afectar la interpretación de la relación entre el tamaño de la población y las tasas de delito.

4.3 ¿Qué delitos predominan en cada grupo y cambia su peso entre grupos?

Tabla de UPZ con valores atípicos en las tasas de denuncias por delitos.

# 1. El hurto total y su tasa (por 10.000 hab.) se calculan en el chunk "preparar_datos"

# 2. Funciones de apoyo ----
orden_delitos <- c("Hurto", "Lesiones", "Homicidios", "Violencia intrafamiliar")

resumir <- function(datos) {
  datos %>%
    summarise(
      poblacion  = sum(poblacion),
      Hurto      = sum(casos_hurto_total),
      Lesiones   = sum(casos_lesiones),
      Homicidios = sum(casos_homicidios),
      `Violencia intrafamiliar` = sum(casos_violencia_intrafamiliar)
    ) %>%
    pivot_longer(all_of(orden_delitos), names_to = "delito", values_to = "casos") %>%
    mutate(tasa = casos / poblacion * 10000)
}

expandir <- function(d, rango, n_pts = 40) {
  p <- d[rep(seq_len(nrow(d)), each = n_pts), ]
  p$x <- rep(seq(0, rango, length.out = n_pts), times = nrow(d))
  p
}

# 3. Vista 1: población baja con vs sin atípicos extremos ----
# es_extremo ya viene calculado en el boxplot (Q3 + 3 × IQR, con tasas reales y por segmentación)
baja_con <- upz %>% filter(grupo_poblacion == "Población baja")

atipicos <- baja_con %>%
  filter(es_extremo) %>%
  arrange(desc(tasa_total))

n_atip   <- nrow(atipicos)
baja_sin <- baja_con %>% filter(!(upz_cod %in% atipicos$upz_cod))

comp <- resumir(baja_con) %>%
  select(delito, casos_con = casos, tasa_con = tasa) %>%
  left_join(resumir(baja_sin) %>% select(delito, casos_sin = casos, tasa_sin = tasa), by = "delito") %>%
  mutate(
    dif_casos = ifelse(casos_con == 0, 0, casos_sin / casos_con - 1),
    es_max    = casos_con == max(casos_con),
    etiqueta  = ifelse(es_max, paste0(delito, "  ★"), delito),
    texto = paste0(
      "<b>", delito, "</b>",
      "<br>Con atípicos extremos: ", num(casos_con), " casos · tasa ", num(tasa_con, accuracy = 0.1),
      "<br>Sin atípicos extremos: ", num(casos_sin), " casos · tasa ", num(tasa_sin, accuracy = 0.1),
      "<br>Cambio en casos: ", pc(dif_casos)
    )
  ) %>%
  arrange(desc(casos_con))

rango_baja  <- max(comp$casos_con) * 1.1
puntos_baja <- expandir(comp, rango_baja)

prom_con <- mean(baja_con$tasa_total);   prom_sin <- mean(baja_sin$tasa_total)
med_con  <- median(baja_con$tasa_total); med_sin  <- median(baja_sin$tasa_total)
pct_pob_ext <- sum(atipicos$poblacion) / sum(baja_con$poblacion)

#3.1 tabla de atipicos extremos

tabla_extremos <- atipicos %>%      # ya viene ordenada de mayor a menor tasa
  transmute(
    `#`          = row_number(),
    UPZ          = upz_nombre,
    Localidad    = localidad,
    Población    = num(poblacion),
    `Casos totales` = num(casos_total),
    `Tasa total (por 10.000 hab.)` = num(tasa_total, accuracy = 0.1),
    `Veces la mediana del grupo`   = paste0(num(tasa_total / median(baja_con$tasa_total),
                                                accuracy = 0.1), "x")
  )

tabla_bonita(tabla_extremos)

#	UPZ	Localidad	Población	Casos totales	Tasa total (por 10.000 hab.)	Veces la mediana del grupo
1	El Mochuelo	Ciudad Bolívar	30	34	11.333,3	43,5x
2	Aeropuerto El Dorado	Fontibón	883	545	6.172,1	23,7x
3	Parque Simon Bolivar - Can	Teusaquillo	3.323	958	2.882,9	11,1x
4	Zona Industrial	Puente Aranda	6.666	1.573	2.359,7	9,1x
5	Las Nieves	Santa Fe	17.203	4.033	2.344,4	9,0x
6	Parque Salitre	Barrios Unidos	1.442	233	1.615,8	6,2x
7	Sagrado Corazon	Santa Fe	11.247	1.707	1.517,7	5,8x

# 4. Vistas 2 y 3: población media y alta ----
preparar <- function(g) {
  resumir(upz %>% filter(grupo_poblacion == g)) %>%
    mutate(
      pct      = casos / sum(casos),
      es_max   = casos == max(casos),
      etiqueta = ifelse(es_max, paste0(delito, "  ★"), delito),
      texto = paste0("<b>", delito, "</b>",
                     "<br>Casos: ", num(casos), " (", pc(pct), " del total)",
                     "<br>Tasa: ", num(tasa, accuracy = 0.1), " por 10.000 hab.")
    ) %>%
    arrange(desc(casos))
}

d_media <- preparar("Población media")
d_alta  <- preparar("Población alta")

stopifnot(
  sum(baja_con$casos_hurto_total) == comp$casos_con[comp$delito == "Hurto"],
  sum(baja_sin$casos_hurto_total) == comp$casos_sin[comp$delito == "Hurto"],
  nrow(baja_con) - nrow(baja_sin) == n_atip,
  sum(d_media$casos) == sum(upz$casos_total[upz$grupo_poblacion == "Población media"]),
  sum(d_alta$casos)  == sum(upz$casos_total[upz$grupo_poblacion == "Población alta"])
)

rango_media <- max(d_media$casos) * 1.1
rango_alta  <- max(d_alta$casos) * 1.1

puntos_media <- expandir(d_media, rango_media)
puntos_alta  <- expandir(d_alta, rango_alta)

# 5. COMENTARIOS ----
# >>> AQUÍ ESCRIBES TU COMENTARIO PARA CADA VISTA (puede ser tan largo como quieras) <<<
# Se muestra completo, de lado a lado, solo cuando eliges esa vista en el menú.
# Déjalo "" si no quieres agregar nada.
mis_comentarios <- c(
  "Población baja: con vs sin atípicos" = "Si se quitan los 7 atípicos extremos no genera un cambio de ranking entre delitos en la población baja, pero lo que sí cambia son las tasas de delitos y los promedios, en donde los casos de hurto bajan de tasa 288.5 a 261.5 por cada 10.000 habitantes, este cambio en la tasa pasa debido que estas UPZ tienen muy pocas personas y muchas más denuncias, en los otros delitos, se presenta variación pero no es tan considerable como el resultado de Hurto",
  "Población media"                     = "Frente a población baja, la tasa de hurto baja a menos de la mitad (288,5 > 122,4). Además, aquí no hay valores atípicos: las UPZ se parecen bastante entre sí, con tasas totales que van de 72 a 312.",
  "Población alta"                      = "Lo que sí cambia es el peso de la violencia intrafamiliar: pasa de 6,6 % en población baja a 19,9 % aquí, y su tasa 23,9 es la más alta de los tres grupos, siendos solo 5 UPZ."
)

mostrar_automatico <- TRUE   # FALSE = muestra solo tus comentarios

vistas <- names(mis_comentarios)

# vista 1
top_b <- comp %>% filter(es_max)
nombres_atip <- paste0(atipicos$upz_nombre, " (", num(atipicos$poblacion), " hab.)", collapse = ", ")
pct_top_con  <- top_b$casos_con / sum(comp$casos_con)
pct_top_sin  <- top_b$casos_sin / sum(comp$casos_sin)

comentario_baja <- c(
  if (mostrar_automatico) c(
    paste0("<b>Atípicos extremos retirados (", n_atip, "):</b> ", nombres_atip,
           ". Juntos tienen solo el ", pc(pct_pob_ext), " de la población del grupo."),
    paste0("<b>Efecto en los totales:</b> el ", tolower(top_b$delito), " pasa de ",
           num(top_b$casos_con), " a ", num(top_b$casos_sin), " casos (", pc(top_b$dif_casos),
           ") y su tasa de ", num(top_b$tasa_con, accuracy = 0.1), " a ", num(top_b$tasa_sin, accuracy = 0.1), "."),
    paste0("<b>Lo que no cambia:</b> el ", tolower(top_b$delito), " sigue siendo el delito más frecuente (",
           pc(pct_top_con), " del total con atípicos y ", pc(pct_top_sin), " sin ellos)."),
    paste0("<b>Promedio vs mediana de la tasa por UPZ:</b> el promedio pasa de ", num(prom_con, accuracy = 0.1),
           " a ", num(prom_sin, accuracy = 0.1), " (", pc(prom_sin / prom_con - 1),
           "), mientras la mediana pasa de ", num(med_con, accuracy = 0.1), " a ",
           num(med_sin, accuracy = 0.1), " (", pc(med_sin / med_con - 1), ").")
  ),
  if (nzchar(mis_comentarios[[vistas[1]]])) paste0("<b>Comentario:</b> ", mis_comentarios[[vistas[1]]])
)

# vistas 2 y 3
comentario_grupo <- function(g, d) {
  top <- d[1, ]; seg <- d[2, ]; ult <- d[nrow(d), ]
  n_upz <- sum(upz$grupo_poblacion == g)
  c(
    if (mostrar_automatico) c(
      paste0("<b>Contexto:</b> ", n_upz, " UPZ y ", num(top$poblacion), " habitantes en este grupo."),
      paste0("<b>Más frecuente:</b> ", tolower(top$delito), ", con ", num(top$casos),
             " casos (", pc(top$pct), " del total) y una tasa de ", num(top$tasa, accuracy = 0.1),
             " por cada 10.000 habitantes."),
      paste0("<b>Le sigue:</b> ", tolower(seg$delito), ", con ", num(seg$casos),
             " casos (", pc(seg$pct), ")."),
      paste0("<b>Menos frecuente:</b> ", tolower(ult$delito), ", con ", num(ult$casos),
             " casos (", pc(ult$pct), ").")
    ),
    if (nzchar(mis_comentarios[[g]])) paste0("<b>Comentario:</b> ", mis_comentarios[[g]])
  )
}

comentarios <- list(comentario_baja,
                    comentario_grupo("Población media", d_media),
                    comentario_grupo("Población alta",  d_alta))

# 6. Gráfico ----
op <- function(d) ifelse(d$es_max, 1, 0.45)   # el delito más frecuente queda resaltado
invisible_marker <- list(color = "rgba(0,0,0,0)", size = 12)

# vistas 2 y 3: barras + puntos invisibles para el cuadro del mouse (misma estructura, cambian datos y color)
barras_vista <- function(fig, d, puntos, nombre, color) {
  fig %>%
    add_trace(data = d, type = "bar", orientation = "h", name = nombre,
              x = ~casos, y = ~etiqueta,
              marker = list(color = color, opacity = op(d)),
              hoverinfo = "skip", visible = FALSE, showlegend = FALSE) %>%
    add_trace(data = puntos, type = "scatter", mode = "markers",
              x = ~x, y = ~etiqueta, marker = invisible_marker,
              hovertext = ~texto, hoverinfo = "text", visible = FALSE, showlegend = FALSE)
}

fig <- plot_ly() %>%
  # --- vista 1 (trazas 1-3)
  add_trace(data = comp, type = "bar", orientation = "h", name = "Con atípicos extremos",
            x = ~casos_con, y = ~etiqueta,
            marker = list(color = magenta, opacity = op(comp)),
            hoverinfo = "skip", visible = TRUE, showlegend = TRUE) %>%
  add_trace(data = comp, type = "bar", orientation = "h", name = "Sin atípicos extremos",
            x = ~casos_sin, y = ~etiqueta,
            marker = list(color = morado, opacity = op(comp)),
            hoverinfo = "skip", visible = TRUE, showlegend = TRUE) %>%
  add_trace(data = puntos_baja, type = "scatter", mode = "markers",
            x = ~x, y = ~etiqueta, marker = invisible_marker,
            hovertext = ~texto, hoverinfo = "text", visible = TRUE, showlegend = FALSE) %>%
  # --- vista 2: población media (trazas 4-5) y vista 3: población alta (trazas 6-7)
  barras_vista(d_media, puntos_media, "Población media", turquesa) %>%
  barras_vista(d_alta,  puntos_alta,  "Población alta",  morado)

titulos <- c(paste0("Delitos Población baja: con y sin los ", n_atip, " valores atípicos extremos, Hurto: Delito que predomina con y sin los ", n_atip, " atípicos extremos."),
             "Delitos en población media, Hurto contiene el 80% de los casos.",
             "Delitos en población alta, Hurto predomina, pero violencia intrafamiliar presenta 20% de los casos siendo solo 5 UPZ.")
subtitulos <- c("Cantidad de casos · ★ y color fuerte = el delito que más se presenta · pasa el cursor para ver el detalle",
                "Cantidad de casos · ★ y color fuerte = el delito que más se presenta · pasa el cursor para ver casos y tasa",
                "Cantidad de casos · ★ y color fuerte = el delito que más se presenta · pasa el cursor para ver casos y tasa")
rangos  <- c(rango_baja, rango_media, rango_alta)
ordenes <- list(comp$etiqueta, d_media$etiqueta, d_alta$etiqueta)

titulo <- function(i) paste0("<b>", partir_titulo(titulos[i]), "</b><br><sup>", subtitulos[i], "</sup>")

# 7 trazas: 1-3 vista 1, 4-5 vista 2, 6-7 vista 3
trazas_por_vista <- c(3, 2, 2)
visibilidad <- function(i) rep(seq_along(vistas) == i, times = trazas_por_vista)

botones <- lapply(seq_along(vistas), function(i) {
  list(
    method = "update",
    label  = vistas[i],
    args   = list(
      list(visible = visibilidad(i)),
      list("title.text"          = titulo(i),
           "xaxis.range"         = list(0, rangos[i]),
           "yaxis.categoryarray" = rev(ordenes[[i]]))
    )
  )
})

fig <- fig %>%
  layout(
    height = 520,
    title  = titulo_plotly(titulo(1)),
    xaxis  = list(title = "Cantidad de casos", range = c(0, rangos[1]),
                  gridcolor = "#EEEBF0", zeroline = FALSE),
    yaxis  = list(title = "", categoryorder = "array",
                  categoryarray = rev(ordenes[[1]]), tickfont = list(size = 13)),
    barmode = "group",
    bargap  = 0.3,
    hovermode     = "closest",
    hoverdistance = 40,
    hoverlabel = hover_plotly,
    updatemenus = list(menu_plotly(botones)),
    legend = list(orientation = "h", x = 1, xanchor = "right", y = 1.04, yanchor = "bottom"),
    margin = list(t = 140, b = 70, l = 10, r = 30),
    showlegend = TRUE
  ) %>%
  estilo_plotly()

# 7. Caja de comentarios de lado a lado (debajo del gráfico) ----
# Se cambia sola según la segmentación elegida en el menú (js_comentarios está en el chunk "estilo")
fig <- htmlwidgets::onRender(
  fig, js_comentarios,
  data = list(comentarios = comentarios,
              inicios = c(0, cumsum(trazas_por_vista)[-length(trazas_por_vista)]))   # traza inicial de cada vista
)

fig

4.4 ¿Cómo se relaciona la composición por edad con las tasas de delito y esa relación cambia según el grupo poblacional?

# 1. Variables: grupos de edad y delitos (hurto total y pct_30_59 se crean en el chunk "preparar_datos") ----

edades <- c(pct_0_14   = "0–14 años",
            pct_15_29  = "15–29 años",
            pct_30_59  = "30–59 años",
            pct_60_mas = "60 años o más")

delitos_corr <- c(tasa_hurto_total            = "Hurto",
                  tasa_lesiones               = "Lesiones",
                  tasa_homicidios             = "Homicidios",
                  tasa_violencia_intrafamiliar = "Violencia intrafamiliar")

# 2. Correlación de Spearman por segmentación ----
cor_spearman <- function(x, y) {
  r <- tryCatch(suppressWarnings(cor.test(x, y, method = "spearman", exact = FALSE)),
                error = function(e) NULL)
  if (is.null(r)) c(rho = NA_real_, p = NA_real_)
  else c(rho = unname(r$estimate), p = r$p.value)
}

fuerza <- function(r) {
  a <- abs(r)
  ifelse(is.na(r), "sin dato",
  ifelse(a < 0.2, "muy débil",
  ifelse(a < 0.4, "débil",
  ifelse(a < 0.6, "moderada",
  ifelse(a < 0.8, "fuerte", "muy fuerte")))))
}

correlaciones <- expand_grid(grupo = grupos, vd = names(delitos_corr), ve = names(edades)) %>%
  mutate(
    r      = pmap(list(grupo, vd, ve), function(g, vd, ve) {
               s <- upz[upz$grupo_poblacion == g, ]
               cor_spearman(s[[ve]], s[[vd]])
             }),
    rho    = map_dbl(r, ~ .x[["rho"]]),
    p      = map_dbl(r, ~ .x[["p"]]),
    n      = map_int(grupo, ~ sum(upz$grupo_poblacion == .x)),
    delito = unname(delitos_corr[vd]),
    edad   = unname(edades[ve])
  ) %>%
  select(grupo, delito, edad, rho, p, n) %>%
  mutate(
    signif = !is.na(p) & p < 0.05,
    etiqueta_celda = case_when(
      is.na(rho) ~ "",
      signif     ~ paste0("<b>", num(rho, accuracy = 0.01), "*</b>"),
      TRUE       ~ num(rho, accuracy = 0.01)
    ),
    texto = paste0(
      "<b>", delito, " · ", edad, "</b>",
      "<br>Correlación (Spearman): ", num(rho, accuracy = 0.01),
      "<br>Relación ", fuerza(rho), ifelse(rho >= 0, " positiva", " negativa"),
      "<br>p-valor: ", ifelse(p < 0.001, "< 0,001", num(p, accuracy = 0.001)),
      "<br>", ifelse(signif, "Estadísticamente significativa", "No significativa"),
      "<br>UPZ analizadas: ", n
    )
  )

# 3. COMENTARIOS ----
# >>> AQUÍ ESCRIBES TU COMENTARIO PARA CADA POBLACIÓN (puede ser tan largo como quieras) <<<
# Se muestra completo, de lado a lado, solo cuando eliges esa población en el menú.
# Déjalo "" si no quieres agregar nada.
mis_comentarios <- c(
  "Población baja"  = "El hurto es menor donde hay más niños y niñas, mayor donde predomina la población de 30–59 años. La violencia intrafamiliar y lesiones suben con más población de 15–29 años y baja con más población de 30–59., estas asociaciones son generales de las UPZ en este grupo poblacional, pero no asegura que la edad genere el aumento en las denuncias.",
  "Población media" = "es donde se generan las relaciones mas fuertes, donde si aumentan las personas de 60 años, las denuncias en hurto aumentan, por el contrario los homicidios y la violencia intrafamiliar baja en los grupos de igual o mas de 30 años, en contraparte, aumenta en los jovenes estos dos delitos. importante aclarar que Relación no es causalidad",
  "Población alta"  = "Solo tiene 5 UPZ, y esto puede generar cambios drasticos es las correlaciones con solo aumentar en una UPZ, por tal motivo es importante indicar en los jovenes el hurto es bajo y la violencia intrafamiliar cumple el mismo patron en el grupo de 30 - 59 años, aunque se debe validar mas al detalle estos datos, debido que no se cuenta con datos estables que puedan generalizar."
)

mostrar_automatico <- FALSE #ALSE = muestra solo tus comentarios

comentario_corr <- function(g) {
  d <- correlaciones %>% filter(grupo == g, !is.na(rho))
  n <- d$n[1]
  pos <- d %>% slice_max(rho, n = 1, with_ties = FALSE)
  neg <- d %>% slice_min(rho, n = 1, with_ties = FALSE)

  c(
    if (mostrar_automatico) c(
      paste0("<b>Cómo leerlo:</b> ", n, " UPZ en este grupo. Cada celda es la correlación de Spearman ",
             "entre el % de población de ese grupo de edad y la tasa del delito (por 10.000 habitantes). ",
             "Va de -1 a 1; las celdas en negrita con * son estadísticamente significativas (p < 0,05)."),
      if (pos$rho > 0) paste0("<b>Relación positiva más fuerte:</b> ", tolower(pos$delito), " con ", pos$edad,
             " (", num(pos$rho, accuracy = 0.01), "): las UPZ con más población de esa edad tienden a tener tasas más altas."),
      if (neg$rho < 0) paste0("<b>Relación negativa más fuerte:</b> ", tolower(neg$delito), " con ", neg$edad,
             " (", num(neg$rho, accuracy = 0.01), "): las UPZ con más población de esa edad tienden a tener tasas más bajas."),
      paste0("<b>Relaciones significativas:</b> ", sum(d$signif), " de ", nrow(d), "."),
      if (n < 10) paste0("<b>Ojo:</b> con solo ", n, " UPZ las correlaciones son poco confiables ",
             "(basta con que una UPZ cambie para que el resultado cambie). Tómalas solo como referencia."),
      paste0("<b>Recuerda:</b> correlación no es causalidad; muestra que dos cosas suben o bajan juntas, ",
             "no que un grupo de edad cause el delito. Además los cuatro grupos de edad suman 100 %, ",
             "por eso 30–59 años suele moverse al revés que los demás.")
    ),
    if (nzchar(mis_comentarios[[g]])) paste0("<b>Comentarios:</b> ", mis_comentarios[[g]])
  )
}

comentarios <- lapply(grupos, comentario_corr)

# 4. Gráfico: mapa de calor con menú ----
a_matriz <- function(d, col) {
  d %>%
    select(delito, edad, all_of(col)) %>%
    pivot_wider(names_from = edad, values_from = all_of(col)) %>%
    arrange(match(delito, delitos_corr)) %>%
    select(all_of(unname(edades))) %>%
    as.matrix()
}

fig <- plot_ly()

for (i in seq_along(grupos)) {
  d <- correlaciones %>% filter(grupo == grupos[i])
  fig <- fig %>% add_trace(
    type = "heatmap",
    x = unname(edades), y = unname(delitos_corr),
    z = a_matriz(d, "rho"), text = a_matriz(d, "texto"),
    hoverinfo = "text", xgap = 3, ygap = 3,
    zmin = -1, zmax = 1,
    colorscale = list(c(0, turquesa), c(0.5, "#FFFFFF"), c(1, magenta)),
    colorbar = list(title = "Correlación<br>(Spearman)", len = 0.8, thickness = 14,
                    tickvals = c(-1, -0.5, 0, 0.5, 1)),
    showscale = TRUE, visible = (i == 1)
  )
}

# número escrito dentro de cada celda (en negrita si es significativa)
anotaciones_celdas <- function(g) {
  d <- correlaciones %>% filter(grupo == g)
  lapply(seq_len(nrow(d)), function(k) list(
    x = d$edad[k], y = d$delito[k], xref = "x", yref = "y",
    text = d$etiqueta_celda[k], showarrow = FALSE,
    font = list(size = 15,
                color = ifelse(!is.na(d$rho[k]) && abs(d$rho[k]) > 0.55, "white", "#333333"))
  ))
}

titulo <- function(i) {
  paste0("<b>", partir_titulo("En poblaciones jóvenes la violencia intrafamiliar tiende a subir y el hurto a bajar; esto aplica a población baja y media"), "</b>",
         "<br><sup>", grupos[i], " · Correlación de Spearman entre el % de población por edad y la tasa de delitos de cada UPZ",
         " · * = significativa (p < 0,05)</sup>")
}

botones <- lapply(seq_along(grupos), function(i) {
  list(
    method = "update",
    label  = grupos[i],
    args   = list(
      list(visible = seq_along(grupos) == i),
      list("title.text" = titulo(i),
           annotations  = anotaciones_celdas(grupos[i]))
    )
  )
})

fig <- fig %>%
  layout(
    height = 520,
    title  = titulo_plotly(titulo(1)),
    xaxis = list(title = "Grupo de edad (% de habitantes de la UPZ)", side = "bottom"),
    yaxis = list(title = "", autorange = "reversed", tickfont = list(size = 13), automargin = TRUE),
    annotations = anotaciones_celdas(grupos[1]),
    hoverlabel = hover_plotly,
    updatemenus = list(menu_plotly(botones)),
    margin = list(t = 140, b = 80, l = 10, r = 30)
  ) %>%
  estilo_plotly()

# 5. Caja de comentarios de lado a lado (debajo del gráfico) ----
# (js_comentarios está en el chunk "estilo")
fig <- htmlwidgets::onRender(
  fig, js_comentarios,
  data = list(comentarios = comentarios, inicios = seq_along(grupos) - 1)   # una traza por grupo
)

fig

Conclusión de correlación

En esta seccion se mantienen los casos atipicos extremos en el analisis, aunque son asociaciones entre UPZ, no explican por qué ocurren y no significan que la edad cause el delito, para mayor analisis seria importante tener la data por denuncias realizadas por edad, junto con el delito a denunciar, de esta manera se podria comprobar positiva o negativamente la correlación.

4.5 ¿Dónde se ubican las UPZ con mayores tasas y cómo se ven las segmentaciones en el territorio?

# mapa bogota upz
ruta_shp <- file.path(ruta_input, "shp", "upz_bogota.shp")
upz_shp <- st_read(ruta_shp, quiet = TRUE)
loc_shp <- st_read(ruta_shp, quiet = TRUE)  # recortadas al área urbana

# 1. Geometría + datos de cada UPZ ----
mapa <- upz_shp %>%
  select(upz_cod) %>%
  left_join(
    upz %>% select(upz_cod, upz_nombre, localidad, grupo_poblacion, poblacion,
                   casos_total, tasa_total,
                   casos_hurto_total, tasa_hurto_total,
                   casos_lesiones, tasa_lesiones,
                   casos_homicidios, tasa_homicidios,
                   casos_violencia_intrafamiliar, tasa_violencia_intrafamiliar),
    by = "upz_cod"
  ) %>%
  mutate(id_upz = as.character(upz_cod))

stopifnot("Hay UPZ sin segmentación: corre primero el chunk de K-means" = !anyNA(mapa$grupo_poblacion))

# se aligera la geometría para que el HTML pese poco
mapa <- mapa %>%
  st_make_valid() %>%
  st_transform(3116) %>%
  st_simplify(dTolerance = 30, preserveTopology = TRUE) %>%
  st_transform(4326)

# límites exactos de Bogotá para que el mapa llene el espacio
bb  <- st_bbox(mapa)
pad <- 0.005
rango_lon <- c(unname(bb["xmin"]) - pad, unname(bb["xmax"]) + pad)
rango_lat <- c(unname(bb["ymin"]) - pad, unname(bb["ymax"]) + pad)

a_geojson <- function(x) {
  tmp <- tempfile(fileext = ".geojson")
  st_write(x[, "id_upz"], tmp, driver = "GeoJSON", quiet = TRUE)
  out <- read_json(tmp)
  unlink(tmp)
  out
}

# 2. Segmentación y delitos ----
n_grupo <- sapply(grupos, function(g) sum(mapa$grupo_poblacion == g))

delitos_mapa <- list(
  "Total de delitos"        = c("casos_total", "tasa_total"),
  "Hurto"                   = c("casos_hurto_total", "tasa_hurto_total"),
  "Lesiones"                = c("casos_lesiones", "tasa_lesiones"),
  "Homicidios"              = c("casos_homicidios", "tasa_homicidios"),
  "Violencia intrafamiliar" = c("casos_violencia_intrafamiliar", "tasa_violencia_intrafamiliar")
)

crear_texto <- function(d, delito) {
  v <- delitos_mapa[[delito]]
  paste0(
    "<b>", d$upz_nombre, "</b>",
    "<br>Localidad: ", d$localidad,
    "<br>Segmentación: ", d$grupo_poblacion,
    "<br>Población: ", num(d$poblacion),
    "<br>Total de delitos: ", num(d$casos_total), " casos · tasa ", num(d$tasa_total, accuracy = 0.1),
    if (delito != "Total de delitos")
      paste0("<br><b>", delito, ":</b> ", num(d[[v[1]]]), " casos · tasa ", num(d[[v[2]]], accuracy = 0.1))
    else ""
  )
}

datos_g <- lapply(grupos, function(g) mapa %>% filter(grupo_poblacion == g))
textos  <- lapply(names(delitos_mapa), function(dl) {
  lapply(datos_g, function(dg) crear_texto(st_drop_geometry(dg), dl))
})
names(textos) <- names(delitos_mapa)

# 3. Mapa: base gris (todas las UPZ) + una capa por segmentación ----
alto_mapa <- 950

fig <- plot_ly(height = alto_mapa) %>%
  add_trace(
    type = "choropleth", name = "base",                       # <<< NUEVO: nombre de la traza
    geojson = a_geojson(mapa), featureidkey = "properties.id_upz",
    locations = mapa$id_upz, z = rep(1, nrow(mapa)), zmin = 0, zmax = 1,
    colorscale = list(c(0, gris), c(1, gris)), showscale = FALSE,
    marker = list(line = list(color = "white", width = 0.5)),
    hoverinfo = "skip"
  )

for (i in seq_along(grupos)) {
  dg <- datos_g[[i]]
  fig <- fig %>% add_trace(
    type = "choropleth", name = grupos[i],                    # <<< NUEVO: la tabla lee este nombre
    geojson = a_geojson(dg), featureidkey = "properties.id_upz",
    locations = dg$id_upz, z = rep(1, nrow(dg)), zmin = 0, zmax = 1,
    colorscale = list(c(0, colores[[grupos[i]]]), c(1, colores[[grupos[i]]])), showscale = FALSE,
    marker = list(line = list(color = "white", width = 0.8)),
    text = textos[["Total de delitos"]][[i]], hoverinfo = "text"
  )
}

# 4. Selectores ----
botones_seg <- lapply(c("Todas", grupos), function(s) {
  list(method = "restyle",
       label  = if (s == "Todas") paste0("Todas (", sum(n_grupo), " UPZ)") else paste0(s, " (", n_grupo[[s]], " UPZ)"),
       args   = list(list(visible = (grupos == s) | (s == "Todas")), c(1, 2, 3)))
})

botones_delito <- lapply(names(delitos_mapa), function(dl) {
  list(method = "restyle", label = dl,
       args   = list(list(text = lapply(textos[[dl]], as.list)), c(1, 2, 3)))
})

leyenda <- paste0(
  paste0("<span style='color:", colores, "'>■</span> ", grupos, " (", n_grupo, ")", collapse = "      "),
  "      <span style='color:#BDBAC4'>■</span> UPZ no seleccionadas"
)

# 5. Diseño del mapa ----
fig <- fig %>%
  layout(
    height = alto_mapa,
    title = titulo_plotly(
      paste0("<b>Mapa de las UPZ de Bogotá según segmentación poblacional</b>",
             "<br><sup>Elige la segmentación y el delito · pasa el cursor sobre cada UPZ · ",
             "tasas por cada 10.000 habitantes</sup>"),
      xref = "container"
    ),
    geo = list(
      projection = list(type = "mercator"),
      lonaxis = list(range = rango_lon),
      lataxis = list(range = rango_lat),
      visible = FALSE, bgcolor = "rgba(0,0,0,0)",
      domain = list(x = c(0, 1), y = c(0, 1))
    ),
    hoverlabel = hover_plotly,
    updatemenus = list(
      menu_plotly(botones_seg,    x = 0,    y = 1.02),
      menu_plotly(botones_delito, x = 0.42, y = 1.02)
    ),
    annotations = list(
      list(text = "Segmentación poblacional", x = 0, y = 1.10, xref = "paper", yref = "paper",
           xanchor = "left", yanchor = "bottom", showarrow = FALSE, font = list(size = 12, color = "grey40")),
      list(text = "Delito (en el cuadro del mouse)", x = 0.42, y = 1.10, xref = "paper", yref = "paper",
           xanchor = "left", yanchor = "bottom", showarrow = FALSE, font = list(size = 12, color = "grey40")),
      list(text = leyenda, x = 0, y = -0.02, xref = "paper", yref = "paper",
           xanchor = "left", yanchor = "top", showarrow = FALSE, font = list(size = 13, color = "grey25"))
    ),
    margin = list(t = 140, b = 50, l = 0, r = 0)
  ) %>%
  estilo_plotly()

# 6. datos del ranking ----
top_n <- 15   # cuántas UPZ muestra la tabla

# es_extremo ya viene calculado en el boxplot (Q3 + 3 × IQR, tasas reales, por segmentación)
ranking_datos <- upz %>%
  transmute(
    upz_nombre,
    grupo_poblacion = as.character(grupo_poblacion),
    area_km2, poblacion,
    tasa_hurto_total, tasa_lesiones, tasa_homicidios, tasa_violencia_intrafamiliar, tasa_total,
    es_extremo
  )

cfg <- list(
  morado = morado, magenta = magenta, gris = gris,
  top_n = top_n, grupos = grupos, colores = as.list(colores),
  n_ext = sum(ranking_datos$es_extremo),
  n_cero_hom = sum(ranking_datos$tasa_homicidios == 0)
)

# 7. tabla ranking conectada (en los dos sentidos) con el selector de segmentación del mapa ----
js_ranking <- r"---(
function(el, x, datos) {
  var reg = JSON.parse(datos.registros);
  var cfg = JSON.parse(datos.cfg);

  function f(v, dec) {
    return new Intl.NumberFormat('es-CO', {minimumFractionDigits: dec, maximumFractionDigits: dec}).format(v);
  }
  function esc(s) {
    return String(s).replace(/&/g, '&amp;').replace(/</g, '&lt;').replace(/>/g, '&gt;');
  }

  var cols = [
    {k: 'upz_nombre',                   t: 'UPZ',                         num: false},
    {k: 'grupo_poblacion',              t: 'Segmentación',                num: false},
    {k: 'area_km2',                     t: 'Área (km²)',                  num: true, d: 2},
    {k: 'poblacion',                    t: 'Población',                   num: true, d: 0},
    {k: 'tasa_hurto_total',             t: 'Tasa hurto',                  num: true, d: 1},
    {k: 'tasa_lesiones',                t: 'Tasa lesiones',               num: true, d: 1},
    {k: 'tasa_homicidios',              t: 'Tasa homicidios',             num: true, d: 2},
    {k: 'tasa_violencia_intrafamiliar', t: 'Tasa violencia intrafamiliar', num: true, d: 1},
    {k: 'tasa_total',                   t: 'Tasa total',                  num: true, d: 1}
  ];
  var ordenables = cols.filter(function(c) { return c.num; });
  var estado = {k: 'tasa_total', dir: 'desc', firma: null};

  // estilo (mismo look que tabla_bonita: encabezado morado, fila resaltada rosada, hover)
  var css = document.createElement('style');
  css.textContent =
    '.rk-cont{margin-top:14px;width:100%;box-sizing:border-box;padding:0 10px;font-family:inherit;color:#333}' +
    '.rk-titulo{font-size:18px;color:' + cfg.morado + ';line-height:1.4;margin-bottom:8px}' +
    '.rk-titulo span{font-size:13px;color:#555}' +
    '.rk-ctrl{display:flex;gap:16px;flex-wrap:wrap;align-items:center;margin-bottom:10px;font-size:13px;color:#555}' +
    '.rk-ctrl select{padding:5px 8px;border:1px solid ' + cfg.gris + ';border-radius:4px;color:' + cfg.morado + ';background:#fff;font-size:13px}' +
    '.rk-wrap{overflow-x:auto}' +
    '.rk-tabla{width:100%;border-collapse:collapse;font-size:14px}' +
    '.rk-tabla th{background:' + cfg.morado + ';color:#fff;font-weight:bold;padding:7px 9px;text-align:left;white-space:nowrap}' +
    '.rk-tabla th.rk-num{text-align:right}' +
    '.rk-tabla th.rk-ord{cursor:pointer}' +
    '.rk-tabla th.rk-ord:hover{filter:brightness(1.25)}' +
    '.rk-tabla td{padding:6px 9px;border-top:1px solid #ddd}' +
    '.rk-tabla td.rk-num{text-align:right;white-space:nowrap}' +
    '.rk-tabla td.rk-pos{text-align:center;font-weight:bold;color:' + cfg.morado + ';width:42px}' +
    '.rk-tabla tbody tr:hover{background:#f5f5f5}' +
    '.rk-tabla tbody tr.rk-primero{background:#F6EEF2;font-weight:bold;color:' + cfg.morado + '}' +
    '.rk-tabla tbody tr.rk-ext td{border-top:2px solid ' + cfg.magenta + ';border-bottom:2px solid ' + cfg.magenta + '}' +
    '.rk-tabla tbody tr.rk-ext td:first-child{border-left:2px solid ' + cfg.magenta + '}' +
    '.rk-tabla tbody tr.rk-ext td:last-child{border-right:2px solid ' + cfg.magenta + '}' +
    '.rk-nota{margin-top:12px;font-size:13px;line-height:1.5;color:#444;border-top:2px solid ' + cfg.gris + ';padding-top:10px}' +
    '.rk-nota ul{margin:6px 0 0 0;padding-left:20px}' +
    '.rk-nota li{margin-bottom:4px}' +
    '.rk-sw{display:inline-block;width:22px;height:11px;vertical-align:middle;margin-right:4px;box-sizing:border-box}' +
    '.rk-sw-ext{border:2px solid ' + cfg.magenta + '}' +
    '.rk-sw-prim{background:#F6EEF2;border:1px solid ' + cfg.gris + '}';
  document.head.appendChild(css);

  // estructura
  var cont = document.createElement('div');
  cont.className = 'rk-cont';
  el.parentNode.insertBefore(cont, el.nextSibling);

  var titulo = document.createElement('div');
  titulo.className = 'rk-titulo';
  cont.appendChild(titulo);

  var ctrl = document.createElement('div');
  ctrl.className = 'rk-ctrl';

  // <<< NUEVO: cuántas UPZ tiene cada segmentación (para el selector)
  var conteo = {};
  reg.forEach(function(r) { conteo[r.grupo_poblacion] = (conteo[r.grupo_poblacion] || 0) + 1; });

  ctrl.innerHTML =
    // <<< NUEVO: selector de segmentación dentro de la tabla
    '<label>Segmentación&nbsp;<select class="rk-sel-seg">' +
    '<option value="Todas">Todas (' + reg.length + ' UPZ)</option>' +
    cfg.grupos.map(function(g) { return '<option value="' + g + '">' + g + ' (' + (conteo[g] || 0) + ' UPZ)</option>'; }).join('') +
    '</select></label>' +
    '<label>Ordenar por&nbsp;<select class="rk-sel-k">' +
    ordenables.map(function(c) { return '<option value="' + c.k + '">' + c.t + '</option>'; }).join('') +
    '</select></label>' +
    '<label>Orden&nbsp;<select class="rk-sel-dir">' +
    '<option value="desc">De mayor a menor</option><option value="asc">De menor a mayor</option>' +
    '</select></label>' +
    '<span>También puedes hacer clic en el encabezado de una columna.</span>';
  cont.appendChild(ctrl);
  var selSeg = ctrl.querySelector('.rk-sel-seg');   // <<< NUEVO
  var selK = ctrl.querySelector('.rk-sel-k');
  var selDir = ctrl.querySelector('.rk-sel-dir');
  selK.value = estado.k;
  selDir.value = estado.dir;

  var wrap = document.createElement('div');
  wrap.className = 'rk-wrap';
  cont.appendChild(wrap);

  var nota = document.createElement('div');
  nota.className = 'rk-nota';
  nota.innerHTML =
    '<b>Cómo leer esta tabla</b><ul>' +
    '<li><span class="rk-sw rk-sw-ext"></span><b>Borde magenta:</b> atípico extremo, es decir, una UPZ cuya tasa total supera Q3 + 3 × IQR dentro de la segmentación poblacional generada (hoy son ' + cfg.n_ext + '). Se resalta siempre que aparezca en el ranking.</li>' +
    '<li>Las tasas de delitos son por cada 10.000 habitantes.</li></ul>';
  cont.appendChild(nota);

  // segmentaciones visibles en el mapa
  function seleccion() {
    var s = [];
    (el.data || []).forEach(function(t) {
      if (cfg.grupos.indexOf(t.name) >= 0 && t.visible !== false && t.visible !== 'legendonly') s.push(t.name);
    });
    return s;
  }

  // <<< NUEVO: tabla -> mapa: muestra solo la segmentación elegida y actualiza el menú del mapa
  function aplicarAlMapa(valor) {
    if (typeof Plotly === 'undefined') return;
    var vis = cfg.grupos.map(function(g) { return valor === 'Todas' || g === valor; });
    var idx = cfg.grupos.map(function(g) {
      for (var i = 0; i < el.data.length; i++) { if (el.data[i].name === g) return i; }
      return -1;
    });
    if (idx.indexOf(-1) >= 0) return;
    var pos = (valor === 'Todas') ? 0 : cfg.grupos.indexOf(valor) + 1;
    Plotly.restyle(el, {visible: vis}, idx).then(function() {
      return Plotly.relayout(el, {'updatemenus[0].active': pos});
    });
  }

  function render(forzar) {
    var sel = seleccion();
    selSeg.value = (sel.length === 1) ? sel[0] : 'Todas';   // <<< NUEVO: mapa -> tabla (sincroniza el selector)
    var firma = sel.join('|') + '#' + estado.k + '#' + estado.dir;
    if (!forzar && firma === estado.firma) return;
    estado.firma = firma;

    var d = reg.filter(function(r) { return sel.indexOf(r.grupo_poblacion) >= 0; });
    var sgn = estado.dir === 'desc' ? -1 : 1;
    d.sort(function(a, b) {
      var dif = (a[estado.k] - b[estado.k]) * sgn;
      return dif !== 0 ? dif : a.upz_nombre.localeCompare(b.upz_nombre, 'es');
    });
    var top = d.slice(0, cfg.top_n);

    var col = ordenables.filter(function(c) { return c.k === estado.k; })[0];
    var txtSel = (sel.length === cfg.grupos.length) ? 'todas las segmentaciones'
               : (sel.length ? sel.join(', ').toLowerCase() : 'ninguna segmentación');
    titulo.innerHTML = '<b>Ranking de UPZ</b> · Top ' + top.length + ' de ' + d.length + ' UPZ · ' + txtSel +
      '<br><span>Ordenado por <b>' + col.t.toLowerCase() + '</b> ' +
      (estado.dir === 'desc' ? '(de mayor a menor)' : '(de menor a mayor)') + '</span>';

    var h = '<table class="rk-tabla"><thead><tr><th class="rk-num" style="text-align:center">#</th>';
    cols.forEach(function(c) {
      var flecha = (c.k === estado.k) ? (estado.dir === 'desc' ? ' ▼' : ' ▲') : '';
      h += '<th class="' + (c.num ? 'rk-num rk-ord' : '') + '"' + (c.num ? ' data-k="' + c.k + '"' : '') + '>' + c.t + flecha + '</th>';
    });
    h += '</tr></thead><tbody>';
    top.forEach(function(r, i) {
      var clases = (i === 0 ? 'rk-primero ' : '') + (r.es_extremo ? 'rk-ext' : '');
      h += '<tr class="' + clases + '"><td class="rk-pos">' + (i + 1) + '</td>';
      cols.forEach(function(c) {
        if (c.k === 'grupo_poblacion') {
          h += '<td><span style="color:' + (cfg.colores[r.grupo_poblacion] || '#999') + '">■</span> ' + esc(r.grupo_poblacion) + '</td>';
        } else if (c.num) {
          h += '<td class="rk-num">' + f(r[c.k], c.d) + '</td>';
        } else {
          h += '<td>' + esc(r[c.k]) + '</td>';
        }
      });
      h += '</tr>';
    });
    h += '</tbody></table>';
    wrap.innerHTML = h;
  }

  // <<< NUEVO: al cambiar la segmentación en la tabla, se mueve el mapa
  selSeg.addEventListener('change', function() { aplicarAlMapa(selSeg.value); render(true); });
  selK.addEventListener('change', function() { estado.k = selK.value; render(true); });
  selDir.addEventListener('change', function() { estado.dir = selDir.value; render(true); });
  wrap.addEventListener('click', function(e) {
    var th = e.target.closest ? e.target.closest('th.rk-ord') : null;
    if (!th) return;
    var k = th.getAttribute('data-k');
    if (estado.k === k) { estado.dir = (estado.dir === 'desc' ? 'asc' : 'desc'); }
    else { estado.k = k; estado.dir = 'desc'; }
    selK.value = estado.k;
    selDir.value = estado.dir;
    render(true);
  });

  render(true);
  el.on('plotly_afterplot', function() { render(false); });
}
)---"

fig <- htmlwidgets::onRender(
  fig, js_ranking,
  data = list(
    registros = as.character(toJSON(ranking_datos, dataframe = "rows", auto_unbox = TRUE, digits = NA)),
    cfg       = as.character(toJSON(cfg, auto_unbox = TRUE))
  )
)

fig

# Cifras de la sección de Hallazgos: se calculan aquí y el texto las llama con `r ...`,
# así el informe se actualiza solo si cambian los datos, la semilla o los umbrales.
pct <- function(x) paste0(num(100 * x, accuracy = 0.1), " %")

# Correlación (Spearman) de la matriz del apartado 4.4, con el signo menos tipográfico
rho_txt <- function(g, d_, e_) {
  r <- correlaciones$rho[correlaciones$grupo == g & correlaciones$delito == d_ & correlaciones$edad == e_]
  sub("-", "−", num(r, accuracy = 0.01))
}

# Por grupo: cantidad de UPZ y peso de cada delito (sobre hurto + lesiones + homicidios + violencia intrafamiliar)
por_grupo <- upz %>%
  group_by(grupo_poblacion) %>%
  summarise(
    n         = n(),
    delitos4  = sum(casos_hurto_total + casos_lesiones + casos_homicidios + casos_violencia_intrafamiliar),
    pct_hurto = sum(casos_hurto_total) / delitos4,
    pct_vif   = sum(casos_violencia_intrafamiliar) / delitos4,
    .groups = "drop"
  ) %>%
  split(.$grupo_poblacion)

g_baja  <- por_grupo[["Población baja"]]
g_media <- por_grupo[["Población media"]]
g_alta  <- por_grupo[["Población alta"]]

# Ranking: composición del top de mayores y de menores tasas totales
top_may <- upz %>% slice_max(tasa_total, n = top_n, with_ties = FALSE)
top_men <- upz %>% slice_min(tasa_total, n = top_n, with_ties = FALSE)
n_may_baja  <- sum(top_may$grupo_poblacion == "Población baja")
n_men_media <- sum(top_men$grupo_poblacion == "Población media")

# Alerta: si cambian los datos y alguna afirmación cualitativa del texto deja de ser cierta, el tejido avisa
stopifnot(
  "Los atípicos extremos ya no están solo en población baja: revisa el texto de Hallazgos" =
    all(upz$grupo_poblacion[upz$es_extremo] == "Población baja"),
  "El top de mayores tasas ya no es todo de población baja: revisa el texto de Hallazgos" =
    n_may_baja == top_n,
  "En el top de menores tasas ya no predomina población media: revisa el texto de Hallazgos" =
    n_men_media == max(table(top_men$grupo_poblacion))
)

5 Hallazgos

• Se evidencia que la segmentación mediante K-means permite dividir la población de Bogotá de una manera más acorde con la cantidad de habitantes. Sin embargo, el grupo de población alta queda conformado por solo 5 UPZ. Esto permite plantear que, en futuros análisis, se estudie esta segmentación de manera individual por UPZ.

• Los atípicos extremos se presentan únicamente en el grupo de población baja. Según el análisis, estos generan un aumento considerable en la tasa total de delitos. Al analizar con mayor detalle los resultados, se observa que su efecto se concentra principalmente en el delito de hurto. Sin embargo, es importante tener presente esta información para estudiar estas 7 UPZ y conocer los motivos detrás de la cantidad de denuncias registradas.

• El hurto predomina en los tres grupos poblacionales, pero pesa menos a medida que crece la población: 88,3 % en población baja, 80,4 % en media y 70,7 % en alta. Lo contrario pasa con la violencia intrafamiliar, que sube de 6,6 % a 12,0 % y 19,9 %.

• En el ranking top 15 de mayores tasas de denuncias totales, solo se evidencian UPZ categorizadas como “poblacion baja”, pero cuando se valida al top 15 de menores tasas de denuncias totales, predomina poblacion media con 9 UPZ de 15, siendo estas el 25,7 % de toda las categorizadas por poblacion media (35 UPZ).

• En población baja y media, más población joven se asocia con más violencia intrafamiliar y menos hurto, por ejemplo, en poblacion media, en el grupo 0–14 años con violencia intrafamiliar la correlacion es ρ = 0,78 y con hurto ρ = −0,77. Son asociaciones entre UPZ, no causas.

6 Limitaciones

• Se identifica una oportunidad de mejora en los datos disponibles: contar con un mayor desglose de las denuncias por edad y tipo de delito permitiría, como se mencionó anteriormente, realizar un análisis de correlación más detallado entre estas variables.

• El periodo de análisis de las denuncias y las tasas comprende únicamente 7 meses, dejando por fuera los últimos meses del año. Estos meses podrían ser relevantes, considerando que corresponden a una época en la que se generan más interacciones entre los habitantes de Bogotá. Esto plantea una pregunta: ¿se mantendrían las tendencias observadas durante esos 5 meses o se presentarían aumentos o disminuciones considerables en las tasas de denuncias por delitos?

7 Conclusion

La seguridad en las UPZ, según lo validado en el análisis, presenta varias observaciones a tener en cuenta. Una es que, entre más población, más casos de denuncias; sin embargo, esto no aplica del todo cuando se evidencian atípicos extremos, en los cuales la población era mucho menor. Además, teniendo en cuenta la población, tampoco es viable decir que el área se relaciona directamente con la cantidad de personas que habitan la UPZ, debido a que hay casos en los que una UPZ es pequeña en comparación con otras más grandes. Sí se puede indicar que las denuncias por hurto predominan a nivel general y por segmento poblacional.

Con respecto a las correlaciones, es necesario entender que en estos casos se buscó generar una asociación, que directamente no indica causalidad. Para poder afirmar estas relaciones, es necesario contar con el detalle de la edad y de las denuncias generadas por cada delito. Es decir, para un primer análisis el informe es muy útil, aunque abre la puerta a un mayor detalle y entendimiento, como por ejemplo en las UPZ atípicas extremas en tasa total de delitos.