Análisis de patrones puntuales con reportes Waze
Luis Castillo
1 Introducción
Este documento desarrolla un análisis de patrones puntuales espaciales usando reportes ciudadanos de Waze relacionados con movilidad. Para mantener coherencia metodológica con el caso original, primero se realiza la limpieza y exploración general de la base y después se aplica el filtro al día 26 para el análisis espacial de patrones puntuales con categorías como PELIGRO, CONGESTIÓN, ACCIDENTE y VÍA CERRADA.
2 Objetivos
2.1 Objetivo general
Analizar la distribución espacial y temporal de los reportes ciudadanos de Waze mediante herramientas de patrones puntuales, con el fin de identificar concentración espacial de eventos, horarios críticos y zonas prioritarias para la planeación de la movilidad.
2.2 Objetivos específicos
- Cargar, limpiar y estandarizar los datos de reportes Waze desde un archivo Excel.
- Realizar primero la exploración general y aplicar posteriormente el filtro al día 26, de acuerdo con el orden metodológico del caso base.
- Clasificar los eventos en las categorías principales: ACCIDENTE, CONGESTIÓN, PELIGRO y VÍA CERRADA.
- Construir un objeto geográfico
sfy transformar las coordenadas a un sistema UTM para calcular distancias en metros. - Crear un patrón puntual
pppconspatstat. - Analizar intensidad espacial, densidad kernel, prueba de cuadrantes, vecino más cercano, Clark-Evans y funciones K, L, G, F y J.
- Generar mapas, tablas, gráficos e interpretaciones útiles para la toma de decisiones.
3 Metodología
El flujo metodológico sigue una adaptación de CRISP-DM aplicada a análisis espacial:
- Comprensión del negocio: identificar problemas de movilidad a partir de reportes ciudadanos.
- Comprensión de los datos: revisar columnas, fechas, tipos de evento y coordenadas.
- Preparación de datos: limpiar fechas, coordenadas y categorías.
- Modelado espacial: crear geodata, patrón puntual y funciones espaciales.
- Evaluación: contrastar resultados contra aleatoriedad espacial completa.
- Despliegue: generar mapas, tablas e interpretaciones para planeación urbana.
4 Configuración general
archivo_excel <- "trama_waze.xlsx"
hoja_excel <- "hoja_1"
# Día de análisis según el caso base.
dia_objetivo <- 26
# Tipos de evento centrales.
eventos_interes <- c("PELIGRO", "CONGESTION", "ACCIDENTE", "VIA CERRADA")
# Filtro geográfico aproximado usado para depurar datos en la zona del caso.
aplicar_filtro_geografico <- TRUE
lat_min <- 4
lat_max <- 5
lon_min <- -75
lon_max <- -73
# Parámetros de análisis espacial.
nsim_envelopes <- 99
nx_cuadrantes <- 5
ny_cuadrantes <- 5
usar_ventana_convexa <- TRUE
buffer_ventana_m <- NULL
# Carpetas de salida.
dir_salida <- "resultados_waze_patrones_puntuales_rmd"
dir_figuras <- file.path(dir_salida, "figuras")
dir_tablas <- file.path(dir_salida, "tablas")
dir_mapas <- file.path(dir_salida, "mapas_html")
dir_texto <- file.path(dir_salida, "interpretaciones")
for (d in c(dir_salida, dir_figuras, dir_tablas, dir_mapas, dir_texto)) {
dir.create(d, showWarnings = FALSE, recursive = TRUE)
}5 Carga de paquetes
options(repos = c(CRAN = "https://cloud.r-project.org"))
paquetes_obligatorios <- c(
"readxl", "dplyr", "tidyr", "stringr", "lubridate", "janitor",
"ggplot2", "sf", "sp", "forcats", "stringi", "spatstat.geom",
"spatstat.explore", "spatstat.random", "viridis", "readr", "purrr",
"tibble", "scales", "leaflet", "leaflet.extras", "htmlwidgets",
"knitr", "kableExtra", "htmltools"
)
paquetes_opcionales <- c("leafsync", "DT")
instalar_si_falta <- function(pkg) {
if (!requireNamespace(pkg, quietly = TRUE)) {
install.packages(pkg, dependencies = TRUE)
}
}
invisible(lapply(paquetes_obligatorios, instalar_si_falta))
invisible(lapply(paquetes_obligatorios, library, character.only = TRUE))
for (pkg in paquetes_opcionales) {
if (!requireNamespace(pkg, quietly = TRUE)) {
message("Paquete opcional no instalado: ", pkg, ". Se omitirán salidas asociadas.")
}
}6 Funciones auxiliares
detectar_archivo_excel <- function() {
archivos <- list.files(pattern = "\\.xlsx$|\\.xls$", ignore.case = TRUE)
archivos <- archivos[!grepl("^~\\$", basename(archivos))]
if (length(archivos) == 0) {
stop(
"No se encontró ningún archivo Excel en la carpeta de trabajo. ",
"Guarde el Excel de Waze junto a este RMarkdown o asigne archivo_excel manualmente."
)
}
candidatos <- archivos[grepl("waze|trama|movilidad|reporte|alert|evento", archivos, ignore.case = TRUE)]
if (length(candidatos) > 0) return(candidatos[1])
archivos[1]
}
buscar_columna <- function(nombres, patrones) {
nombres_limpios <- janitor::make_clean_names(nombres)
for (patron in patrones) {
pos <- which(stringr::str_detect(nombres_limpios, stringr::regex(patron, ignore_case = TRUE)))
if (length(pos) > 0) return(nombres_limpios[pos[1]])
}
NA_character_
}
parsear_fecha_segura <- function(x) {
if (inherits(x, "POSIXct") || inherits(x, "POSIXt")) return(as.POSIXct(x, tz = "UTC"))
if (inherits(x, "Date")) return(as.POSIXct(x, tz = "UTC"))
if (is.numeric(x)) {
mx <- suppressWarnings(max(x, na.rm = TRUE))
if (is.finite(mx) && mx > 100000000000) {
return(as.POSIXct(x / 1000, origin = "1970-01-01", tz = "UTC"))
}
if (is.finite(mx) && mx > 1000000000) {
return(as.POSIXct(x, origin = "1970-01-01", tz = "UTC"))
}
return(as.POSIXct(as.Date(x, origin = "1899-12-30"), tz = "UTC"))
}
x_txt <- as.character(x)
x_txt <- stringr::str_replace_all(x_txt, "\\u00A0", " ")
x_txt <- stringr::str_squish(x_txt)
suppressWarnings(lubridate::parse_date_time(
x_txt,
orders = c(
"ymd HMS", "ymd HM", "ymd",
"dmy HMS", "dmy HM", "dmy",
"mdy HMS", "mdy HM", "mdy",
"Ymd HMS", "Ymd HM", "Ymd",
"ymd IMS p", "dmy IMS p", "mdy IMS p"
),
tz = "UTC"
))
}
normalizar_texto_evento <- function(x) {
x <- as.character(x)
x <- stringr::str_to_upper(x)
x <- stringr::str_replace_all(x, "_", " ")
x <- stringr::str_squish(x)
x <- stringi::stri_trans_general(x, "Latin-ASCII")
x
}
traducir_tipo_waze <- function(x) {
x0 <- normalizar_texto_evento(x)
dplyr::case_when(
is.na(x0) | x0 == "" | x0 == "NA" ~ "SIN TIPO",
stringr::str_detect(x0, "ACCIDENT|ACCIDENTE|CRASH|COLLISION|CHOQUE|SINIESTRO") ~ "ACCIDENTE",
stringr::str_detect(x0, "JAM|CONGEST|TRAFFIC|TRAFICO|TRANSITO|TRANCON|TRANCO|TAPON|EMBOTELL") ~ "CONGESTION",
stringr::str_detect(x0, "HAZARD|PELIGRO|RIESGO|ROAD HAZARD|OBJECT|OBSTACLE|POTHOLE|HUECO|VEHICLE STOPPED") ~ "PELIGRO",
stringr::str_detect(x0, "ROAD CLOSED|ROAD CLOSURE|CLOSED|VIA CERRADA|CIERRE|CIERRE VIA|CLOSURE") ~ "VIA CERRADA",
stringr::str_detect(x0, "POLICE|POLICIA") ~ "POLICIA",
stringr::str_detect(x0, "WEATHER|CLIMA") ~ "CLIMA",
TRUE ~ x0
)
}
seleccionar_divisor_coord <- function(v, tipo = c("lat", "lon"), usar_rango_objetivo = TRUE) {
tipo <- match.arg(tipo)
v_num <- suppressWarnings(as.numeric(v))
if (all(is.na(v_num))) return(0)
exponentes <- 0:12
score_exp <- function(e) {
val <- v_num / (10^e)
if (tipo == "lat") {
valido_general <- val >= -90 & val <= 90
valido_objetivo <- val >= lat_min & val <= lat_max
} else {
valido_general <- val >= -180 & val <= 180
valido_objetivo <- val >= lon_min & val <= lon_max
}
if (usar_rango_objetivo) {
mean(valido_objetivo, na.rm = TRUE) + 0.1 * mean(valido_general, na.rm = TRUE)
} else {
mean(valido_general, na.rm = TRUE)
}
}
scores <- vapply(exponentes, score_exp, numeric(1))
exponentes[which.max(scores)]
}
normalizar_coord <- function(v, tipo = c("lat", "lon"), usar_rango_objetivo = TRUE) {
tipo <- match.arg(tipo)
v_num <- suppressWarnings(as.numeric(v))
exp_sel <- seleccionar_divisor_coord(v_num, tipo, usar_rango_objetivo)
v_norm <- v_num / (10^exp_sel)
attr(v_norm, "exponente_usado") <- exp_sel
v_norm
}
utm_epsg_desde_lonlat <- function(lon, lat) {
zona <- floor((lon + 180) / 6) + 1
if (lat >= 0) 32600 + zona else 32700 + zona
}
guardar_grafico <- function(grafico, nombre, ancho = 10, alto = 6, dpi = 140) {
ruta <- file.path(dir_figuras, nombre)
print(grafico)
ggplot2::ggsave(ruta, grafico, width = ancho, height = alto, dpi = dpi)
invisible(ruta)
}
guardar_base_plot <- function(nombre, expr, ancho = 1200, alto = 850, res = 130) {
ruta <- file.path(dir_figuras, nombre)
png(ruta, width = ancho, height = alto, res = res)
on.exit(dev.off(), add = TRUE)
force(expr)
invisible(ruta)
}
preparar_envelope_df <- function(env) {
df <- as.data.frame(env)
names(df) <- janitor::make_clean_names(names(df))
columnas_necesarias <- c("r", "obs", "lo", "hi")
faltantes <- setdiff(columnas_necesarias, names(df))
if (length(faltantes) > 0) {
stop(
"El objeto envelope no tiene las columnas esperadas: ",
paste(faltantes, collapse = ", "),
". Columnas disponibles: ",
paste(names(df), collapse = ", ")
)
}
df
}
graficar_envelope_ggplot <- function(env, titulo, y_label = "Función", restar_r = FALSE, linea_cero = FALSE) {
df <- preparar_envelope_df(env)
if (restar_r) {
df <- df |>
dplyr::mutate(
obs = obs - r,
lo = lo - r,
hi = hi - r,
theo = if ("theo" %in% names(df)) theo - r else NA_real_
)
}
grafico <- ggplot2::ggplot(df, ggplot2::aes(x = r)) +
ggplot2::geom_ribbon(ggplot2::aes(ymin = lo, ymax = hi), alpha = 0.25) +
ggplot2::geom_line(ggplot2::aes(y = obs), linewidth = 0.9) +
ggplot2::labs(
title = titulo,
x = "Distancia r, metros",
y = y_label,
caption = "Banda sombreada: envelope Monte Carlo bajo CSR. Línea: función observada."
) +
ggplot2::theme_minimal()
if ("theo" %in% names(df)) {
grafico <- grafico + ggplot2::geom_line(ggplot2::aes(y = theo), linetype = "dashed", linewidth = 0.7)
}
if (linea_cero) {
grafico <- grafico + ggplot2::geom_hline(yintercept = 0, linetype = "dotted")
}
grafico
}
escribir_txt <- function(lineas, nombre) {
writeLines(lineas, con = file.path(dir_texto, nombre), useBytes = TRUE)
}
interpretar_pvalue_csr <- function(p_value) {
if (is.na(p_value)) return("No fue posible obtener valor p para esta prueba.")
if (p_value < 0.05) {
"Se rechaza CSR al 5%; hay evidencia de que el patrón no es completamente aleatorio."
} else {
"No se rechaza CSR al 5%; la prueba no encuentra evidencia suficiente contra aleatoriedad espacial completa."
}
}
interpretar_clark <- function(r, p_value) {
if (is.na(r) || is.na(p_value)) return("No fue posible interpretar Clark-Evans.")
if (p_value < 0.05 && r < 1) {
"Patrón agregado: las distancias al vecino más cercano son menores que las esperadas bajo CSR."
} else if (p_value < 0.05 && r > 1) {
"Patrón regular: las distancias al vecino más cercano son mayores que las esperadas bajo CSR."
} else {
"No hay evidencia estadística suficiente para diferenciar el patrón de CSR con Clark-Evans."
}
}
crear_mapa_leaflet_puntos <- function(datos, titulo = "Mapa Waze", archivo = "mapa.html") {
pal <- leaflet::colorFactor(
palette = "Set2",
domain = datos$tipo_evento,
na.color = "#999999"
)
mapa <- leaflet::leaflet(datos) |>
leaflet::addProviderTiles(leaflet::providers$OpenStreetMap) |>
leaflet::addCircleMarkers(
lng = ~lon,
lat = ~lat,
radius = 4,
stroke = TRUE,
weight = 0.5,
color = ~pal(tipo_evento),
fillOpacity = 0.75,
clusterOptions = leaflet::markerClusterOptions(),
popup = ~paste0(
"<b>Tipo:</b> ", tipo_evento,
"<br><b>Tipo original:</b> ", tipo_original,
"<br><b>Fecha/hora:</b> ", fecha_hora,
"<br><b>Hora:</b> ", hora,
"<br><b>Lat:</b> ", round(lat, 6),
"<br><b>Lon:</b> ", round(lon, 6)
)
) |>
leaflet::addLegend(
position = "bottomright",
pal = pal,
values = ~tipo_evento,
title = "Tipo de evento"
) |>
leaflet::addControl(
html = htmltools::HTML(paste0("<h3>", titulo, "</h3>")),
position = "topleft"
)
htmlwidgets::saveWidget(mapa, file.path(dir_mapas, archivo), selfcontained = TRUE)
mapa
}
crear_mapa_heatmap <- function(datos, titulo = "Mapa de calor", archivo = "heatmap.html", radio = 18, blur = 20) {
mapa <- leaflet::leaflet(datos) |>
leaflet::addProviderTiles(leaflet::providers$OpenStreetMap) |>
leaflet.extras::addHeatmap(
lng = ~lon,
lat = ~lat,
intensity = rep(1, nrow(datos)),
blur = blur,
max = 0.05,
radius = radio
) |>
leaflet::addCircleMarkers(
lng = ~lon,
lat = ~lat,
radius = 2,
stroke = FALSE,
fillOpacity = 0.35
) |>
leaflet::addControl(
html = htmltools::HTML(paste0("<h3>", titulo, "</h3>")),
position = "topleft"
)
htmlwidgets::saveWidget(mapa, file.path(dir_mapas, archivo), selfcontained = TRUE)
mapa
}7 Carga y comprensión de los datos
if (is.null(archivo_excel)) {
archivo_excel <- detectar_archivo_excel()
}
if (!file.exists(archivo_excel)) {
stop("No se encontró el archivo Excel especificado: ", archivo_excel)
}
hojas_disponibles <- readxl::excel_sheets(archivo_excel)
if (is.null(hoja_excel)) hoja_excel <- hojas_disponibles[1]
datos_raw <- readxl::read_excel(archivo_excel, sheet = hoja_excel) |>
janitor::clean_names()
catalogo_variables <- tibble::tibble(
numero = seq_along(names(datos_raw)),
variable = names(datos_raw)
)
readr::write_csv(catalogo_variables, file.path(dir_tablas, "01_catalogo_variables.csv"))
tibble::tibble(
archivo_usado = archivo_excel,
hoja_usada = hoja_excel,
registros = nrow(datos_raw),
variables = ncol(datos_raw)
) |>
knitr::kable(caption = "Resumen inicial del archivo cargado") |>
kableExtra::kable_styling(full_width = FALSE)| archivo_usado | hoja_usada | registros | variables |
|---|---|---|---|
| trama_waze.xlsx | hoja_1 | 5070 | 17 |
catalogo_variables |>
knitr::kable(caption = "Catálogo de variables detectadas") |>
kableExtra::kable_styling(full_width = FALSE)| numero | variable |
|---|---|
| 1 | id |
| 2 | waze_json_trama_id |
| 3 | country |
| 4 | report_rating |
| 5 | report_by_municipality_user |
| 6 | confidence |
| 7 | reliability |
| 8 | type |
| 9 | uuid |
| 10 | road_type |
| 11 | magvar |
| 12 | subtype |
| 13 | street |
| 14 | location_x |
| 15 | location_y |
| 16 | pub_millis |
| 17 | creation_date |
8 Detección de columnas clave
nombres <- names(datos_raw)
lat_col <- buscar_columna(
nombres,
c("^lat$", "latitud", "latitude", "location_y", "ubicacion_y", "^y$", "coord.*y", "coordenada.*y", "geo.*lat")
)
lon_col <- buscar_columna(
nombres,
c("^lon$", "^lng$", "longitud", "longitude", "location_x", "ubicacion_x", "^x$", "coord.*x", "coordenada.*x", "geo.*lon")
)
fecha_col <- buscar_columna(
nombres,
c("creation_date", "created", "fecha", "date", "time", "timestamp", "pub.*millis", "report.*time", "publication")
)
tipo_col <- buscar_columna(
nombres,
c("^type$", "tipo", "tipo_evento", "alert.*type", "report.*type", "categoria", "category", "clase", "evento")
)
subtipo_col <- buscar_columna(
nombres,
c("subtype", "sub_tipo", "subtipo", "sub_categoria", "sub_category", "detalle", "descripcion", "description")
)
uuid_col <- buscar_columna(
nombres,
c("uuid", "id", "identificador", "report.*id", "event.*id")
)
confiabilidad_col <- buscar_columna(
nombres,
c("reliability", "confidence", "confianza", "confiabilidad", "thumbs", "likes", "ranking")
)
if (is.na(lat_col) || is.na(lon_col)) {
stop(
"No fue posible detectar columnas de latitud y longitud. Columnas disponibles: ",
paste(nombres, collapse = ", ")
)
}
columnas_detectadas <- tibble::tibble(
campo_logico = c("latitud", "longitud", "fecha_hora", "tipo_evento", "subtipo", "id", "confiabilidad"),
columna_detectada = c(lat_col, lon_col, fecha_col, tipo_col, subtipo_col, uuid_col, confiabilidad_col)
)
readr::write_csv(columnas_detectadas, file.path(dir_tablas, "02_columnas_detectadas.csv"))
columnas_detectadas |>
knitr::kable(caption = "Columnas clave detectadas automáticamente") |>
kableExtra::kable_styling(full_width = FALSE)| campo_logico | columna_detectada |
|---|---|
| latitud | location_y |
| longitud | location_x |
| fecha_hora | creation_date |
| tipo_evento | type |
| subtipo | subtype |
| id | uuid |
| confiabilidad | reliability |
9 Limpieza y normalización de datos
En esta etapa se realiza la limpieza general de la base completa: normalización de coordenadas, depuración geográfica, estandarización de fechas y homologación de tipos de evento.
Primero se revisan y resumen los datos disponibles de forma general; posteriormente se filtra el día 26 para el análisis espacial específico de patrones puntuales.
lat_norm <- normalizar_coord(datos_raw[[lat_col]], "lat", usar_rango_objetivo = aplicar_filtro_geografico)
lon_norm <- normalizar_coord(datos_raw[[lon_col]], "lon", usar_rango_objetivo = aplicar_filtro_geografico)
exp_lat <- attr(lat_norm, "exponente_usado")
exp_lon <- attr(lon_norm, "exponente_usado")
if (!is.na(fecha_col)) {
fecha_hora <- parsear_fecha_segura(datos_raw[[fecha_col]])
} else {
fecha_hora <- as.POSIXct(rep(NA, nrow(datos_raw)), origin = "1970-01-01", tz = "UTC")
}
if (!is.na(tipo_col)) {
tipo_original <- as.character(datos_raw[[tipo_col]])
} else {
tipo_original <- rep("SIN TIPO", nrow(datos_raw))
}
if (!is.na(subtipo_col)) {
subtipo_original <- as.character(datos_raw[[subtipo_col]])
} else {
subtipo_original <- rep(NA_character_, nrow(datos_raw))
}
if (!is.na(uuid_col)) {
id_evento <- as.character(datos_raw[[uuid_col]])
} else {
id_evento <- as.character(seq_len(nrow(datos_raw)))
}
if (!is.na(confiabilidad_col)) {
confiabilidad <- suppressWarnings(as.numeric(datos_raw[[confiabilidad_col]]))
} else {
confiabilidad <- rep(NA_real_, nrow(datos_raw))
}
datos_base <- datos_raw |>
mutate(
id_evento = id_evento,
lat = lat_norm,
lon = lon_norm,
fecha_hora = fecha_hora,
fecha = as.Date(fecha_hora),
dia = lubridate::day(fecha_hora),
hora = lubridate::hour(fecha_hora),
dia_semana = lubridate::wday(fecha_hora, label = TRUE, abbr = FALSE, week_start = 1),
tipo_original = tipo_original,
subtipo_original = subtipo_original,
tipo_evento = traducir_tipo_waze(tipo_original),
confiabilidad = confiabilidad,
id_coord = paste(round(lon, 7), round(lat, 7), sep = "_")
)
diagnostico_tipos_originales <- datos_base |>
dplyr::count(tipo_original, tipo_evento, name = "frecuencia") |>
dplyr::arrange(dplyr::desc(frecuencia))
readr::write_csv(
diagnostico_tipos_originales,
file.path(dir_tablas, "04b_diagnostico_tipos_originales_homologados.csv")
)
conteos_esperados_base <- tibble::tibble(
tipo_evento = c("ACCIDENTE", "CONGESTION", "PELIGRO", "VIA CERRADA"),
frecuencia_esperada_analisis_base = c(125, 3285, 719, 1021)
)
# Validación estrictamente comparable con el informe base:
# se calcula sobre la base general después de homologar el tipo de evento,
# pero antes de filtrar el día 26 y antes de eliminar registros por coordenadas.
conteos_observados_base <- datos_base |>
filter(tipo_evento %in% eventos_interes) |>
count(tipo_evento, name = "frecuencia_observada_base_general") |>
right_join(conteos_esperados_base, by = "tipo_evento") |>
mutate(
frecuencia_observada_base_general = tidyr::replace_na(frecuencia_observada_base_general, 0L),
diferencia = frecuencia_observada_base_general - frecuencia_esperada_analisis_base,
coincide_con_analisis_base = diferencia == 0
) |>
arrange(desc(frecuencia_observada_base_general))
# A partir de este punto se construye la base espacial: aquí sí se depuran coordenadas,
# porque los análisis de patrones puntuales, mapas, densidades y funciones espaciales
# necesitan ubicaciones válidas.
datos_limpios <- datos_base |>
filter(
!is.na(lat), !is.na(lon),
lat >= -90, lat <= 90,
lon >= -180, lon <= 180
)
if (aplicar_filtro_geografico) {
datos_limpios <- datos_limpios |>
filter(
lat >= lat_min, lat <= lat_max,
lon >= lon_min, lon <= lon_max
)
}
# Base general espacial de eventos de interés, todavía sin filtrar el día 26.
datos_interes <- datos_limpios |>
filter(tipo_evento %in% eventos_interes)
if (nrow(datos_interes) == 0) {
stop(
"Después de limpiar coordenadas y tipos de interés no quedaron registros. ",
"Revise la normalización de coordenadas, el filtro geográfico o la homologación de tipos de evento."
)
}
conteos_observados_base_espacial <- datos_interes |>
count(tipo_evento, name = "frecuencia_con_coordenadas_validas") |>
right_join(conteos_esperados_base, by = "tipo_evento") |>
mutate(
frecuencia_con_coordenadas_validas = tidyr::replace_na(frecuencia_con_coordenadas_validas, 0L),
registros_descartados_por_coordenadas = frecuencia_esperada_analisis_base - frecuencia_con_coordenadas_validas
) |>
arrange(desc(frecuencia_con_coordenadas_validas))
resumen_limpieza <- tibble::tibble(
registros_iniciales = nrow(datos_raw),
registros_eventos_interes_base_general = sum(conteos_observados_base$frecuencia_observada_base_general, na.rm = TRUE),
registros_con_coordenadas_validas = nrow(datos_limpios),
registros_eventos_interes_con_coordenadas_validas_sin_filtrar_dia = nrow(datos_interes),
coordenadas_unicas_sin_filtrar_dia = dplyr::n_distinct(datos_interes$id_coord),
coordenadas_duplicadas_sin_filtrar_dia = nrow(datos_interes) - dplyr::n_distinct(datos_interes$id_coord),
tipos_evento_interes = dplyr::n_distinct(datos_interes$tipo_evento),
fecha_minima = as.character(min(datos_interes$fecha, na.rm = TRUE)),
fecha_maxima = as.character(max(datos_interes$fecha, na.rm = TRUE)),
dias_disponibles = dplyr::n_distinct(datos_interes$dia),
exponente_latitud = exp_lat,
exponente_longitud = exp_lon,
filtro_geografico_aplicado = aplicar_filtro_geografico
)
readr::write_csv(datos_interes, file.path(dir_tablas, "03_datos_limpios_eventos_interes_sin_filtrar_dia.csv"))
readr::write_csv(resumen_limpieza, file.path(dir_tablas, "04_resumen_limpieza_general.csv"))
readr::write_csv(conteos_observados_base, file.path(dir_tablas, "05_validacion_conteos_analisis_base_sin_filtrar_dia.csv"))
readr::write_csv(conteos_observados_base_espacial, file.path(dir_tablas, "05b_conteos_eventos_interes_con_coordenadas_validas.csv"))
resumen_limpieza |>
knitr::kable(caption = "Resumen de limpieza general sin filtro al día 26") |>
kableExtra::kable_styling(full_width = FALSE)| registros_iniciales | registros_eventos_interes_base_general | registros_con_coordenadas_validas | registros_eventos_interes_con_coordenadas_validas_sin_filtrar_dia | coordenadas_unicas_sin_filtrar_dia | coordenadas_duplicadas_sin_filtrar_dia | tipos_evento_interes | fecha_minima | fecha_maxima | dias_disponibles | exponente_latitud | exponente_longitud | filtro_geografico_aplicado |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 5070 | 5070 | 3815 | 3815 | 284 | 3531 | 4 | 2024-09-26 | 2024-09-28 | 3 | 6 | 6 | TRUE |
conteos_observados_base |>
knitr::kable(caption = "Validación contra conteos del análisis base antes de filtrar el día 26") |>
kableExtra::kable_styling(full_width = FALSE)| tipo_evento | frecuencia_observada_base_general | frecuencia_esperada_analisis_base | diferencia | coincide_con_analisis_base |
|---|---|---|---|---|
| CONGESTION | 3205 | 3285 | -80 | FALSE |
| VIA CERRADA | 1021 | 1021 | 0 | TRUE |
| PELIGRO | 719 | 719 | 0 | TRUE |
| ACCIDENTE | 125 | 125 | 0 | TRUE |
Estas cifras corresponden a los eventos de interés después de
homologar el tipo de evento, pero antes de filtrar el día 26 y antes de
excluir registros por coordenadas. Para la categoría CONGESTION se
aplican equivalencias amplias como JAM, TRAFFIC
JAM, CONGESTION, TRAFICO,
TRANCON y expresiones relacionadas.
diagnostico_tipos_originales |>
dplyr::filter(
tipo_evento %in% eventos_interes |
stringr::str_detect(
normalizar_texto_evento(tipo_original),
"JAM|CONGEST|TRAFFIC|TRAFICO|TRANCON|TRANCO|TAPON|EMBOTELL"
)
) |>
dplyr::arrange(tipo_evento, dplyr::desc(frecuencia)) |>
knitr::kable(caption = "Diagnóstico de homologación de tipos originales de Waze") |>
kableExtra::kable_styling(full_width = FALSE)| tipo_original | tipo_evento | frecuencia |
|---|---|---|
| ACCIDENT | ACCIDENTE | 125 |
| JAM | CONGESTION | 3205 |
| HAZARD | PELIGRO | 719 |
| ROAD_CLOSED | VIA CERRADA | 1021 |
Esta tabla de diagnóstico permite verificar de dónde provienen los conteos de cada categoría y facilita detectar variantes de texto que deban homologarse antes del análisis espacial.
conteos_observados_base_espacial |>
knitr::kable(caption = "Eventos de interés que quedan disponibles para análisis espacial, antes de filtrar el día 26") |>
kableExtra::kable_styling(full_width = FALSE)| tipo_evento | frecuencia_con_coordenadas_validas | frecuencia_esperada_analisis_base | registros_descartados_por_coordenadas |
|---|---|---|---|
| CONGESTION | 2619 | 3285 | 666 |
| PELIGRO | 565 | 719 | 154 |
| VIA CERRADA | 531 | 1021 | 490 |
| ACCIDENTE | 100 | 125 | 25 |
10 Análisis descriptivo y temporal general
10.1 Frecuencia general por tipo de evento
tabla_tipo_general <- datos_interes |>
count(tipo_evento, sort = TRUE) |>
mutate(
porcentaje = n / sum(n),
porcentaje_label = scales::percent(porcentaje, accuracy = 0.1)
)
readr::write_csv(tabla_tipo_general, file.path(dir_tablas, "06_frecuencia_tipo_evento_general.csv"))
tabla_tipo_general |>
knitr::kable(caption = "Frecuencia general de reportes por tipo de evento, sin filtro al día 26") |>
kableExtra::kable_styling(full_width = FALSE)| tipo_evento | n | porcentaje | porcentaje_label |
|---|---|---|---|
| CONGESTION | 2619 | 0.6865007 | 68.7% |
| PELIGRO | 565 | 0.1480996 | 14.8% |
| VIA CERRADA | 531 | 0.1391874 | 13.9% |
| ACCIDENTE | 100 | 0.0262123 | 2.6% |
graf_tipo_general <- tabla_tipo_general |>
mutate(tipo_evento = forcats::fct_reorder(tipo_evento, n)) |>
ggplot(aes(x = tipo_evento, y = n, fill = tipo_evento)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = paste0(scales::comma(n), " (", porcentaje_label, ")")), hjust = -0.05, size = 4) +
coord_flip() +
scale_y_continuous(labels = scales::comma, expand = expansion(mult = c(0, 0.18))) +
labs(
title = "Distribución general de tipos de eventos Waze",
subtitle = "Conteo sobre la base limpia, antes del filtro al día 26",
x = "Tipo de evento",
y = "Cantidad de reportes"
) +
theme_minimal()
guardar_grafico(graf_tipo_general, "01_distribucion_general_tipos_evento.png", ancho = 10, alto = 6)
Antes de filtrar el día 26, la base limpia contiene principalmente reportes de CONGESTIÓN, con 2.619 eventos, equivalentes al 68.7 % del total analizado. En segundo lugar se encuentran los reportes de PELIGRO, con 565 eventos y una participación del 14.8 %. Posteriormente aparecen los reportes de VÍA CERRADA, con 531 eventos, correspondientes al 13.9 %, y finalmente los reportes de ACCIDENTE, con 100 eventos, equivalentes al 2.6 %.
Estos resultados muestran que la problemática dominante en los datos de Waze está asociada a la congestión vehicular. Esto es coherente con el uso de Waze como plataforma de reporte ciudadano en tiempo real, donde los usuarios suelen reportar con mayor frecuencia trancones, demoras y condiciones de tráfico lento.
Desde el punto de vista de planeación de movilidad, la alta proporción de eventos de congestión indica que el análisis espacial debe enfocarse principalmente en identificar corredores viales con acumulación recurrente de reportes. Los eventos de peligro, cierres viales y accidentes, aunque menos frecuentes, siguen siendo relevantes porque pueden explicar o intensificar la congestión en determinados puntos.
10.2 Frecuencia por día
tabla_dia <- datos_interes |>
filter(!is.na(dia)) |>
count(dia, name = "n") |>
arrange(dia) |>
mutate(
porcentaje = n / sum(n),
porcentaje_label = scales::percent(porcentaje, accuracy = 0.1),
dia_objetivo_logico = dia == dia_objetivo
)
readr::write_csv(tabla_dia, file.path(dir_tablas, "07_frecuencia_por_dia.csv"))
tabla_dia |>
knitr::kable(caption = "Frecuencia de eventos por día disponible en la base") |>
kableExtra::kable_styling(full_width = FALSE)| dia | n | porcentaje | porcentaje_label | dia_objetivo_logico |
|---|---|---|---|---|
| 26 | 1162 | 0.3045872 | 30.5% | TRUE |
| 27 | 1815 | 0.4757536 | 47.6% | FALSE |
| 28 | 838 | 0.2196592 | 22.0% | FALSE |
graf_dia <- ggplot(tabla_dia, aes(x = dia, y = n, fill = dia_objetivo_logico)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = n), vjust = -0.25, size = 3) +
scale_x_continuous(breaks = sort(unique(tabla_dia$dia))) +
scale_y_continuous(labels = scales::comma, expand = expansion(mult = c(0, 0.12))) +
labs(
title = "Distribución temporal de eventos por día",
subtitle = paste0("El día ", dia_objetivo, " se selecciona posteriormente para el análisis de patrones puntuales"),
x = "Día del mes",
y = "Cantidad de reportes"
) +
theme_minimal()
guardar_grafico(graf_dia, "02_frecuencia_eventos_por_dia.png", ancho = 11, alto = 6)
La distribución temporal por día muestra que los eventos se concentran en tres días: 26, 27 y 28. El día con mayor cantidad de reportes es el día 27, con 1.815 eventos, equivalente al 47.6 %. El día 26, seleccionado para el análisis espacial de patrones puntuales, presenta 1.162 eventos, equivalentes al 30.5 %. Finalmente, el día 28 registra 838 eventos, equivalentes al 22.0 %.
Aunque el día 27 presenta el mayor volumen de reportes, el día 26 conserva una cantidad suficiente de observaciones para realizar análisis espacial. La selección del día 26 permite replicar el enfoque metodológico del caso base, evitando mezclar eventos de varios días y reduciendo el efecto temporal sobre el análisis espacial.
En términos metodológicos, esta separación es importante porque los eventos de movilidad pueden cambiar significativamente de un día a otro. Al trabajar con un solo día, el patrón puntual representa una ventana temporal más controlada.
11 Filtro metodológico al día 26
Después de revisar la base general, se aplica el filtro metodológico al día 26. A partir de este punto, el análisis espacial de patrones puntuales se desarrolla exclusivamente con los eventos de interés de ese día.
datos_dia <- datos_limpios |>
filter(dia == dia_objetivo)
datos_dia_interes <- datos_dia |>
filter(tipo_evento %in% eventos_interes)
if (nrow(datos_dia_interes) == 0) {
stop(
"Después de aplicar el filtro al día objetivo y tipos de interés no quedaron registros. ",
"Revise el día objetivo, el parseo de fechas o los tipos de evento."
)
}
conteos_dia_26 <- datos_dia_interes |>
count(tipo_evento, name = "frecuencia_dia_26") |>
mutate(
porcentaje = frecuencia_dia_26 / sum(frecuencia_dia_26),
porcentaje_label = scales::percent(porcentaje, accuracy = 0.1)
) |>
arrange(desc(frecuencia_dia_26))
resumen_dia_26 <- tibble::tibble(
dia_objetivo = dia_objetivo,
registros_dia_objetivo_todos_los_tipos = nrow(datos_dia),
registros_dia_objetivo_tipos_interes = nrow(datos_dia_interes),
coordenadas_unicas_dia_26 = dplyr::n_distinct(datos_dia_interes$id_coord),
coordenadas_duplicadas_dia_26 = nrow(datos_dia_interes) - dplyr::n_distinct(datos_dia_interes$id_coord),
tipos_evento_interes_dia_26 = dplyr::n_distinct(datos_dia_interes$tipo_evento),
hora_minima = min(datos_dia_interes$hora, na.rm = TRUE),
hora_maxima = max(datos_dia_interes$hora, na.rm = TRUE)
)
readr::write_csv(datos_dia_interes, file.path(dir_tablas, "08_datos_limpios_dia_26.csv"))
readr::write_csv(resumen_dia_26, file.path(dir_tablas, "09_resumen_filtro_dia_26.csv"))
readr::write_csv(conteos_dia_26, file.path(dir_tablas, "10_conteos_tipo_evento_dia_26.csv"))
resumen_dia_26 |>
knitr::kable(caption = paste0("Resumen del filtro metodológico al día ", dia_objetivo)) |>
kableExtra::kable_styling(full_width = FALSE)| dia_objetivo | registros_dia_objetivo_todos_los_tipos | registros_dia_objetivo_tipos_interes | coordenadas_unicas_dia_26 | coordenadas_duplicadas_dia_26 | tipos_evento_interes_dia_26 | hora_minima | hora_maxima |
|---|---|---|---|---|---|---|---|
| 26 | 1162 | 1162 | 79 | 1083 | 4 | 1 | 23 |
conteos_dia_26 |>
knitr::kable(caption = paste0("Frecuencia por tipo de evento después de filtrar el día ", dia_objetivo)) |>
kableExtra::kable_styling(full_width = FALSE)| tipo_evento | frecuencia_dia_26 | porcentaje | porcentaje_label |
|---|---|---|---|
| CONGESTION | 727 | 0.6256454 | 62.6% |
| VIA CERRADA | 318 | 0.2736661 | 27.4% |
| PELIGRO | 96 | 0.0826162 | 8.3% |
| ACCIDENTE | 21 | 0.0180723 | 1.8% |
Después de aplicar el filtro al día 26, quedan 1.162 reportes de interés. La totalidad de los eventos del día corresponde a las categorías principales del análisis: CONGESTIÓN, VÍA CERRADA, PELIGRO y ACCIDENTE.
La categoría más frecuente en el día 26 es CONGESTIÓN, con 727 eventos, equivalente al 62.6 %. En segundo lugar aparece VÍA CERRADA, con 318 eventos, equivalente al 27.4 %. Luego se ubican PELIGRO, con 96 eventos y 8.3 %, y ACCIDENTE, con 21 eventos y 1.8 %.
Estos resultados confirman que, para el día 26, el fenómeno principal sigue siendo la congestión. Sin embargo, la alta participación de cierres viales es especialmente relevante, porque puede indicar afectaciones estructurales o eventos prolongados que influyen directamente en la movilidad del sector.
Un punto técnico importante es que el resumen muestra solo 79 coordenadas únicas para 1.162 reportes, lo que indica una alta repetición de ubicaciones. Esto puede ocurrir porque varios usuarios reportan el mismo evento, porque Waze agrupa reportes sobre puntos específicos de la vía o porque algunos eventos se repiten durante varias horas en la misma ubicación. Esta característica debe tenerse en cuenta al interpretar las pruebas de patrones puntuales.
12 Análisis temporal específico del día 26
12.1 Frecuencia por hora
tabla_hora <- datos_dia_interes |>
filter(!is.na(hora)) |>
count(hora) |>
tidyr::complete(hora = 0:23, fill = list(n = 0)) |>
mutate(porcentaje = n / sum(n))
readr::write_csv(tabla_hora, file.path(dir_tablas, "11_frecuencia_por_hora_dia_26.csv"))
tabla_hora |>
knitr::kable(caption = paste0("Frecuencia de eventos por hora para el día ", dia_objetivo)) |>
kableExtra::kable_styling(full_width = FALSE)| hora | n | porcentaje |
|---|---|---|
| 0 | 0 | 0.0000000 |
| 1 | 8 | 0.0068847 |
| 2 | 12 | 0.0103270 |
| 3 | 0 | 0.0000000 |
| 4 | 0 | 0.0000000 |
| 5 | 0 | 0.0000000 |
| 6 | 0 | 0.0000000 |
| 7 | 0 | 0.0000000 |
| 8 | 0 | 0.0000000 |
| 9 | 0 | 0.0000000 |
| 10 | 17 | 0.0146299 |
| 11 | 105 | 0.0903614 |
| 12 | 95 | 0.0817556 |
| 13 | 32 | 0.0275387 |
| 14 | 30 | 0.0258176 |
| 15 | 33 | 0.0283993 |
| 16 | 63 | 0.0542169 |
| 17 | 119 | 0.1024096 |
| 18 | 79 | 0.0679862 |
| 19 | 109 | 0.0938038 |
| 20 | 67 | 0.0576592 |
| 21 | 108 | 0.0929432 |
| 22 | 99 | 0.0851979 |
| 23 | 186 | 0.1600688 |
graf_hora <- ggplot(tabla_hora, aes(x = hora, y = n)) +
geom_col(fill = "orange", color = "black") +
geom_text(aes(label = ifelse(n > 0, n, "")), vjust = -0.25, size = 3) +
scale_x_continuous(breaks = 0:23) +
scale_y_continuous(labels = scales::comma, expand = expansion(mult = c(0, 0.12))) +
labs(
title = paste0("Frecuencia de eventos por hora del día - día ", dia_objetivo),
subtitle = "Permite identificar horas pico y franjas críticas de movilidad",
x = "Hora del día",
y = "Frecuencia"
) +
theme_minimal()
guardar_grafico(graf_hora, "03_frecuencia_eventos_por_hora_dia_26.png", ancho = 11, alto = 6)
El análisis horario muestra que los reportes no se distribuyen de manera uniforme a lo largo del día. Se observan valores muy bajos durante la madrugada y la mañana temprana, mientras que la mayor concentración de eventos ocurre entre las 11:00 y las 23:00.
Las horas con mayor cantidad de reportes son:
23:00, con 186 eventos. 17:00, con 119 eventos. 19:00, con 109 eventos. 21:00, con 108 eventos. 11:00, con 105 eventos. 22:00, con 99 eventos. 12:00, con 95 eventos.
Este comportamiento evidencia una concentración importante en la franja de la tarde y la noche. El pico de las 23:00 es particularmente llamativo y puede estar asociado a eventos persistentes, congestión acumulada, cierres viales prolongados o reportes repetidos en ubicaciones específicas.
Desde una perspectiva de movilidad, estos horarios pueden interpretarse como franjas críticas para monitoreo operativo, gestión de tráfico y priorización de recursos.
12.2 Frecuencia por hora y tipo de evento
tabla_hora_tipo <- datos_dia_interes |>
filter(!is.na(hora)) |>
count(tipo_evento, hora) |>
group_by(tipo_evento) |>
tidyr::complete(hora = 0:23, fill = list(n = 0)) |>
ungroup()
readr::write_csv(tabla_hora_tipo, file.path(dir_tablas, "12_frecuencia_hora_tipo_dia_26.csv"))
graf_hora_tipo <- ggplot(tabla_hora_tipo, aes(x = hora, y = n, fill = tipo_evento)) +
geom_col(show.legend = FALSE) +
facet_wrap(~tipo_evento, scales = "free_y") +
scale_x_continuous(breaks = seq(0, 23, by = 3)) +
scale_y_continuous(labels = scales::comma) +
labs(
title = paste0("Perfil horario por tipo de evento - día ", dia_objetivo),
x = "Hora del día",
y = "Frecuencia"
) +
theme_minimal()
guardar_grafico(graf_hora_tipo, "04_frecuencia_hora_por_tipo_dia_26.png", ancho = 12, alto = 7)
Al analizar la frecuencia horaria por tipo de evento se observan diferencias importantes entre categorías.
En CONGESTIÓN, los reportes se concentran principalmente entre las 11:00 y las 23:00, con mayor intensidad en la tarde y noche. Esto sugiere que los problemas de tráfico no son puntuales, sino que se mantienen durante varias horas del día.
En VÍA CERRADA, se observa un comportamiento casi constante en varias horas, especialmente desde la tarde hasta la noche. Esta regularidad sugiere que puede tratarse de cierres persistentes o reportes repetidos sobre los mismos puntos. Este resultado es importante porque un cierre vial sostenido puede explicar parte de la congestión observada.
En PELIGRO, los reportes aparecen en horas específicas, especialmente en la noche. Esto puede estar asociado a obstáculos, condiciones riesgosas de la vía o eventos reportados por usuarios en puntos determinados.
En ACCIDENTE, la frecuencia es baja en comparación con las demás categorías. Los accidentes se concentran en pocas horas, lo cual es esperable porque suelen ser eventos más puntuales y menos frecuentes que la congestión o los cierres viales.
En conjunto, el análisis horario por tipo permite concluir que la congestión es el fenómeno dominante, pero los cierres viales y peligros pueden actuar como factores explicativos o agravantes de las condiciones de movilidad.
13 Creación del geodata
datos_sf <- datos_dia_interes |>
sf::st_as_sf(coords = c("lon", "lat"), crs = 4326, remove = FALSE)
lon_mediana <- median(datos_dia_interes$lon, na.rm = TRUE)
lat_mediana <- median(datos_dia_interes$lat, na.rm = TRUE)
crs_utm <- utm_epsg_desde_lonlat(lon_mediana, lat_mediana)
datos_utm <- datos_sf |>
sf::st_transform(crs_utm)
coords_utm <- sf::st_coordinates(datos_utm)
datos_utm <- datos_utm |>
mutate(
x = coords_utm[, 1],
y = coords_utm[, 2]
)
resumen_geodata <- datos_utm |>
sf::st_drop_geometry() |>
summarise(
n_eventos = n(),
min_lon = min(lon),
max_lon = max(lon),
min_lat = min(lat),
max_lat = max(lat),
min_x = min(x),
max_x = max(x),
rango_x_metros = max(x) - min(x),
min_y = min(y),
max_y = max(y),
rango_y_metros = max(y) - min(y),
crs_utm_epsg = crs_utm
)
readr::write_csv(datos_utm |> sf::st_drop_geometry(), file.path(dir_tablas, "09_datos_geodata_utm.csv"))
readr::write_csv(resumen_geodata, file.path(dir_tablas, "10_resumen_geodata.csv"))
resumen_geodata |>
knitr::kable(caption = "Resumen del geodata y coordenadas proyectadas") |>
kableExtra::kable_styling(full_width = FALSE)| n_eventos | min_lon | max_lon | min_lat | max_lat | min_x | max_x | rango_x_metros | min_y | max_y | rango_y_metros | crs_utm_epsg |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1162 | -74.04304 | -73.99613 | 4.888059 | 4.948128 | 606105.5 | 611300.9 | 5195.34 | 540366 | 547011.4 | 6645.378 | 32618 |
La creación del geodata permitió transformar los reportes de Waze en objetos espaciales. Los datos se encuentran en un rango aproximado de longitud entre -74.04304 y -73.99613, y latitud entre 4.888059 y 4.948128.
Posteriormente, las coordenadas fueron transformadas al sistema proyectado UTM EPSG:32618, lo cual es adecuado para calcular distancias en metros. El área de análisis tiene una extensión aproximada de:
5.195 metros en el eje X. 6.645 metros en el eje Y.
Esta transformación es fundamental porque las técnicas de patrones puntuales, como distancia al vecino más cercano, función K, función L y densidad kernel, requieren trabajar con distancias métricas.
14 Exploración espacial inicial
graf_mapa_puntos <- ggplot(datos_dia_interes, aes(x = lon, y = lat, color = tipo_evento)) +
geom_point(alpha = 0.65, size = 1.5) +
coord_equal() +
labs(
title = paste0("Distribución espacial de eventos Waze - día ", dia_objetivo),
subtitle = "Puntos observados en coordenadas geográficas",
x = "Longitud",
y = "Latitud",
color = "Tipo de evento"
) +
theme_minimal()
guardar_grafico(graf_mapa_puntos, "04_mapa_puntos_por_tipo.png", ancho = 10, alto = 8)
El mapa de distribución espacial muestra que los reportes no están dispersos de forma aleatoria en todo el territorio, sino que se concentran sobre corredores viales específicos. Esto es esperable, ya que los eventos de Waze están asociados a movilidad y, por tanto, se ubican principalmente sobre vías.
La mayor parte de los puntos corresponde a eventos de CONGESTIÓN, mientras que los eventos de ACCIDENTE son escasos y aparecen de manera más aislada. Los eventos de PELIGRO y VÍA CERRADA también aparecen concentrados en ciertos sectores.
Esta visualización inicial sugiere la existencia de patrones de agrupamiento espacial.
15 Mapas interactivos
15.1 Mapa general con agrupamiento
mapa_general <- crear_mapa_leaflet_puntos(
datos_dia_interes,
titulo = paste0("Reportes Waze - Día ", dia_objetivo),
archivo = "01_mapa_general_reportes_waze.html"
)
mapa_generalEl mapa interactivo con agrupamiento permite identificar zonas con alta concentración de reportes. Se observan clústeres importantes con valores como 318, 135, 41, 38 y 24 reportes en ubicaciones específicas.
El clúster de 318 reportes es especialmente relevante porque indica una concentración muy alta de eventos en un punto o zona reducida. Este valor podría estar relacionado con cierres viales persistentes, congestión recurrente o reportes repetidos durante varias horas.
El uso de agrupamiento facilita la lectura del mapa porque evita la sobreposición excesiva de puntos y permite detectar rápidamente zonas críticas. Desde el punto de vista operativo, estos clústeres pueden priorizarse para revisar condiciones de movilidad, infraestructura vial, señalización o afectaciones temporales.
15.2 Mapa general de calor
mapa_heat_general <- crear_mapa_heatmap(
datos_dia_interes,
titulo = paste0("Mapa de calor de reportes Waze - Día ", dia_objetivo),
archivo = "02_mapa_calor_general_waze.html",
radio = 18,
blur = 24
)
mapa_heat_generalEl mapa de calor evidencia varios focos de concentración espacial de reportes. Las zonas de mayor intensidad se ubican sobre corredores viales principales y sectores de conexión entre áreas urbanas y vías de salida o ingreso.
Las áreas en colores cálidos representan zonas donde se acumulan más reportes, lo que sugiere puntos críticos de movilidad. Estas zonas pueden interpretarse como sectores con mayor probabilidad de congestión, cierres, peligros o incidentes reportados por usuarios.
16 Creación formal del patrón puntual
rango_x <- diff(range(datos_utm$x, na.rm = TRUE))
rango_y <- diff(range(datos_utm$y, na.rm = TRUE))
if (is.null(buffer_ventana_m)) {
buffer_ventana_m <- max(25, 0.03 * max(rango_x, rango_y))
}
W_rect <- spatstat.geom::owin(
xrange = range(datos_utm$x, na.rm = TRUE) + c(-buffer_ventana_m, buffer_ventana_m),
yrange = range(datos_utm$y, na.rm = TRUE) + c(-buffer_ventana_m, buffer_ventana_m)
)
W <- W_rect
ventana_descripcion <- "rectangular"
if (usar_ventana_convexa && nrow(datos_utm) >= 3) {
poligono_convexo <- datos_utm |>
sf::st_union() |>
sf::st_convex_hull() |>
sf::st_buffer(dist = buffer_ventana_m)
W_try <- tryCatch(
spatstat.geom::as.owin(as(poligono_convexo, "Spatial")),
error = function(e) NULL
)
if (!is.null(W_try)) {
W <- W_try
ventana_descripcion <- "casco convexo con buffer"
}
}
pp_waze <- spatstat.geom::ppp(
x = datos_utm$x,
y = datos_utm$y,
window = W,
marks = as.factor(datos_utm$tipo_evento),
checkdup = FALSE
)
hay_duplicados <- any(duplicated(data.frame(x = round(datos_utm$x, 3), y = round(datos_utm$y, 3))))
pp_analisis <- if (hay_duplicados) {
# rjitter pertenece actualmente a spatstat.geom.
# Se usa para separar ligeramente puntos duplicados y evitar problemas en pruebas espaciales.
spatstat.geom::rjitter(pp_waze, radius = 0.5, retry = TRUE)
} else {
pp_waze
}
area_ventana_m2 <- spatstat.geom::area.owin(W)
area_ventana_km2 <- area_ventana_m2 / 1000000
intensidad_global_km2 <- spatstat.geom::npoints(pp_analisis) / area_ventana_km2
resumen_ppp <- tibble::tibble(
n_puntos = spatstat.geom::npoints(pp_analisis),
area_ventana_m2 = area_ventana_m2,
area_ventana_km2 = area_ventana_km2,
intensidad_reportes_por_km2 = intensidad_global_km2,
ventana_observacion = ventana_descripcion,
buffer_ventana_m = buffer_ventana_m,
puntos_duplicados_detectados = hay_duplicados
)
readr::write_csv(resumen_ppp, file.path(dir_tablas, "11_resumen_patron_puntual.csv"))
resumen_ppp |>
knitr::kable(caption = "Resumen del patrón puntual") |>
kableExtra::kable_styling(full_width = FALSE)| n_puntos | area_ventana_m2 | area_ventana_km2 | intensidad_reportes_por_km2 | ventana_observacion | buffer_ventana_m | puntos_duplicados_detectados |
|---|---|---|---|---|---|---|
| 1162 | 39405140 | 39.40514 | 29.48854 | rectangular | 199.3613 | TRUE |
guardar_base_plot(
"05_patron_puntual_general_ppp.png",
{
plot(pp_analisis, main = "Patrón puntual marcado de reportes Waze", pch = 16, cex = 0.45)
}
)
plot(pp_analisis, main = "Patrón puntual marcado de reportes Waze", pch = 16, cex = 0.45)
El patrón puntual se construyó con 1.162 puntos dentro de una ventana de observación rectangular de aproximadamente 39.41 km². La intensidad global estimada fue de 29.49 reportes por km².
Este valor representa la densidad promedio de reportes dentro de la ventana de estudio. Sin embargo, la intensidad promedio debe interpretarse con precaución porque los reportes no están distribuidos de manera homogénea. En realidad, el mapa muestra concentración en corredores específicos y amplias zonas sin eventos.
Además, se detectaron puntos duplicados. Esto es metodológicamente importante porque las pruebas de patrones puntuales suelen asumir patrones simples, es decir, sin múltiples eventos exactamente en la misma coordenada. En este caso, la duplicidad representa una característica real de la fuente Waze, donde múltiples reportes pueden concentrarse en el mismo punto. No obstante, esta duplicidad puede intensificar artificialmente la evidencia de agrupamiento en pruebas como Clark-Evans, función G y función K.
17 Intensidad espacial y densidad kernel
sigma_kernel <- tryCatch(
spatstat.explore::bw.diggle(pp_analisis),
error = function(e) {
med_nnd <- median(spatstat.geom::nndist(pp_analisis), na.rm = TRUE)
ifelse(is.finite(med_nnd) && med_nnd > 0, med_nnd * 2, max(rango_x, rango_y) / 20)
}
)
densidad_kernel <- spatstat.explore::density.ppp(
pp_analisis,
sigma = sigma_kernel,
edge = TRUE,
at = "pixels"
)
guardar_base_plot(
"06_densidad_kernel_global.png",
{
plot(densidad_kernel, main = paste0("Densidad kernel global | sigma = ", round(sigma_kernel, 2), " m"))
plot(pp_analisis, add = TRUE, pch = 16, cex = 0.22)
}
)
plot(densidad_kernel, main = paste0("Densidad kernel global | sigma = ", round(sigma_kernel, 2), " m"))
plot(pp_analisis, add = TRUE, pch = 16, cex = 0.22)
graf_densidad_gg <- ggplot(sf::st_drop_geometry(datos_utm), aes(x = x, y = y)) +
stat_density_2d(aes(fill = after_stat(level)), geom = "polygon", alpha = 0.78) +
geom_point(size = 0.45, alpha = 0.4) +
coord_equal() +
scale_fill_viridis_c(option = "C") +
labs(
title = paste0("Mapa de calor de reportes Waze - día ", dia_objetivo),
subtitle = "Estimación visual de zonas de mayor concentración de eventos",
x = "Coordenada X UTM, metros",
y = "Coordenada Y UTM, metros",
fill = "Nivel\nde densidad"
) +
theme_minimal()
guardar_grafico(graf_densidad_gg, "07_mapa_calor_ggplot_global.png", ancho = 10, alto = 8)
El primer mapa de densidad kernel muestra un valor de suavizamiento automático de sigma = 1.37 metros. Este valor es demasiado pequeño para un análisis de movilidad urbana, ya que genera una superficie poco interpretable y excesivamente dependiente de puntos casi coincidentes.
El segundo mapa de calor generado con ggplot2 resulta más útil visualmente, ya que muestra concentraciones espaciales más claras. En este mapa se observa un foco principal de alta densidad en el sector inferior izquierdo del área de estudio, además de otros focos menores distribuidos en diferentes sectores.
18 Evaluación de aleatoriedad espacial completa \(CSR\)
La hipótesis de referencia en patrones puntuales es la aleatoriedad espacial completa o CSR. Bajo CSR, los eventos ocurren de forma independiente y con intensidad constante dentro de la ventana de observación. Cuando se rechaza CSR, se puede inferir que existe agregación, regularidad o heterogeneidad espacial.
18.1 Prueba de cuadrantes
cuadrantes <- spatstat.geom::quadratcount(pp_analisis, nx = nx_cuadrantes, ny = ny_cuadrantes)
prueba_cuadrantes <- spatstat.explore::quadrat.test(pp_analisis, nx = nx_cuadrantes, ny = ny_cuadrantes)
escribir_txt(capture.output(prueba_cuadrantes), "01_prueba_cuadrantes_global.txt")
# Convertir el objeto quadratcount a tabla de forma robusta.
# En algunas versiones de spatstat/R, las columnas no se llaman Var1, Var2 y Freq.
# Por eso se renombran por posición, evitando errores de compatibilidad.
tabla_cuadrantes <- as.data.frame(as.table(cuadrantes), stringsAsFactors = FALSE) |>
tibble::as_tibble()
if (ncol(tabla_cuadrantes) >= 3) {
names(tabla_cuadrantes)[1:3] <- c("cuadrante_x", "cuadrante_y", "conteo")
} else {
stop("No fue posible convertir el conteo de cuadrantes en una tabla válida.")
}
tabla_cuadrantes <- tabla_cuadrantes |>
mutate(
cuadrante_x = as.character(cuadrante_x),
cuadrante_y = as.character(cuadrante_y),
conteo = as.numeric(conteo)
)
readr::write_csv(tabla_cuadrantes, file.path(dir_tablas, "12_conteo_cuadrantes_global.csv"))
prueba_cuadrantes##
## Chi-squared test of CSR using quadrat counts
##
## data: pp_analisis
## X2 = 3036.7, df = 24, p-value < 0.00000000000000022
## alternative hypothesis: two.sided
##
## Quadrats: 5 by 5 grid of tilesguardar_base_plot(
"08_conteo_cuadrantes_global.png",
{
plot(pp_analisis, main = "Conteo de eventos por cuadrantes", pch = 16, cex = 0.35)
plot(cuadrantes, add = TRUE, col = "red", cex = 1.2)
}
)
plot(pp_analisis, main = "Conteo de eventos por cuadrantes", pch = 16, cex = 0.35)
plot(cuadrantes, add = TRUE, col = "red", cex = 1.2)
La prueba de cuadrantes arrojó un estadístico X² = 3036.7, con 24 grados de libertad y un valor p menor a 0.05. Por tanto, se rechaza la hipótesis de aleatoriedad espacial completa, conocida como CSR.
Esto significa que los eventos no se distribuyen de forma aleatoria dentro de la ventana de observación. Por el contrario, existe evidencia estadística fuerte de concentración espacial.
El gráfico de cuadrantes confirma visualmente este resultado. Algunos cuadrantes concentran valores altos, como 334, 171, 149, 83, 75 y 72 eventos, mientras que varios cuadrantes tienen conteos iguales a cero. Esta diferencia entre cuadrantes evidencia una distribución espacial heterogénea, dominada por zonas de acumulación de reportes y zonas sin eventos.
En términos de movilidad, esto indica que los reportes se agrupan en corredores o zonas específicas, lo cual es coherente con la naturaleza vial de los datos.
18.2 Distancia al vecino más cercano y Clark-Evans
dist_nn <- spatstat.geom::nndist(pp_analisis)
tabla_nn <- tibble::tibble(distancia_vecino_mas_cercano_m = dist_nn)
readr::write_csv(tabla_nn, file.path(dir_tablas, "13_distancia_vecino_mas_cercano_global.csv"))
resumen_nn <- tabla_nn |>
summarise(
n = n(),
minimo = min(distancia_vecino_mas_cercano_m, na.rm = TRUE),
q1 = quantile(distancia_vecino_mas_cercano_m, 0.25, na.rm = TRUE),
media = mean(distancia_vecino_mas_cercano_m, na.rm = TRUE),
mediana = median(distancia_vecino_mas_cercano_m, na.rm = TRUE),
q3 = quantile(distancia_vecino_mas_cercano_m, 0.75, na.rm = TRUE),
maximo = max(distancia_vecino_mas_cercano_m, na.rm = TRUE)
)
readr::write_csv(resumen_nn, file.path(dir_tablas, "14_resumen_vecino_mas_cercano_global.csv"))
prueba_clark_evans <- tryCatch(
spatstat.explore::clarkevans.test(pp_analisis, correction = "Donnelly"),
error = function(e) NULL
)
if (!is.null(prueba_clark_evans)) {
escribir_txt(capture.output(prueba_clark_evans), "02_prueba_clark_evans_global.txt")
}
resumen_nn |>
knitr::kable(caption = "Resumen de distancias al vecino más cercano") |>
kableExtra::kable_styling(full_width = FALSE)| n | minimo | q1 | media | mediana | q3 | maximo |
|---|---|---|---|---|---|---|
| 1162 | 0.0020894 | 0.0357403 | 0.686639 | 0.0832556 | 0.1523871 | 465.8063 |
##
## Clark-Evans test
## Donnelly correction
## Z-test
##
## data: pp_analisis
## R = 0.0073658, p-value < 0.00000000000000022
## alternative hypothesis: two-sidedgraf_nn <- ggplot(tabla_nn, aes(x = distancia_vecino_mas_cercano_m)) +
geom_histogram(bins = 35, color = "white") +
labs(
title = "Distribución de distancias al vecino más cercano",
subtitle = "Distancias calculadas en metros sobre coordenadas UTM",
x = "Distancia al vecino más cercano, metros",
y = "Frecuencia"
) +
theme_minimal()
guardar_grafico(graf_nn, "09_histograma_vecino_mas_cercano.png", ancho = 10, alto = 6)
El resumen de distancias al vecino más cercano muestra una mediana de aproximadamente 0.083 metros y una media de 0.687 metros. Estos valores son extremadamente pequeños y reflejan la presencia de puntos duplicados o casi duplicados.
La prueba de Clark-Evans reportó un valor R = 0.0074, con valor p menor a 0.05. Como el valor de R es mucho menor que 1, el resultado indica un patrón fuertemente agregado.
18.3 Funciones K, L, G, F y J
K_waze <- spatstat.explore::Kest(pp_analisis, correction = "border")
L_waze <- spatstat.explore::Lest(pp_analisis, correction = "border")
G_waze <- spatstat.explore::Gest(pp_analisis, correction = "rs")
F_waze <- spatstat.explore::Fest(pp_analisis, correction = "rs")
J_waze <- spatstat.explore::Jest(pp_analisis, correction = "rs")guardar_base_plot("10_funcion_k_global.png", { plot(K_waze, main = "Función K de Ripley - patrón global") })
plot(K_waze, main = "Función K de Ripley - patrón global")
La función K observada se encuentra muy por encima de la función teórica esperada bajo aleatoriedad espacial completa. Esto indica que, a diferentes escalas de distancia, hay más eventos alrededor de cada punto de los que se esperarían bajo un patrón aleatorio.
Este resultado confirma la existencia de agregación espacial. Los reportes tienden a ubicarse cerca de otros reportes, lo cual es coherente con eventos concentrados sobre vías, intersecciones o sectores críticos de movilidad.
guardar_base_plot("11_funcion_l_menos_r_global.png", {
plot(L_waze, . - r ~ r, main = "Función L(r) - r - patrón global")
abline(h = 0, lty = 2, col = "red")
})
plot(L_waze, . - r ~ r, main = "Función L(r) - r - patrón global")
abline(h = 0, lty = 2, col = "red")
La función L(r) - r se mantiene por encima de cero en prácticamente todo el rango de distancias analizado. Bajo CSR, esta función debería ubicarse cerca de cero. Cuando se ubica por encima de cero, indica agregación espacial.
Por tanto, el resultado confirma que el patrón de reportes Waze presenta agrupamiento a múltiples escalas espaciales. Esto significa que no se trata solamente de puntos aislados, sino de zonas o corredores donde los eventos se acumulan sistemáticamente.
La caída o cambio de pendiente observado en algunos tramos puede estar relacionado con la geometría de la ventana de análisis, la concentración de puntos sobre vías y la existencia de sectores vacíos dentro del área.
guardar_base_plot("12_funcion_g_global.png", { plot(G_waze, main = "Función G - vecino más cercano") })## Error in bestlegendpos(...) : All objects were empty
## Error in bestlegendpos(...) : All objects were emptyguardar_base_plot("13_funcion_f_global.png", { plot(F_waze, main = "Función F - espacios vacíos") })
plot(F_waze, main = "Función F - espacios vacíos")
guardar_base_plot("14_funcion_j_global.png", { plot(J_waze, main = "Función J - diagnóstico de agregación") })
plot(J_waze, main = "Función J - diagnóstico de agregación")
18.4 Envelopes Monte Carlo bajo CSR
Los envelopes Monte Carlo permiten comparar el patrón observado contra patrones simulados bajo la hipótesis de aleatoriedad espacial completa, conocida como CSR. En este caso se realizaron 99 simulaciones, generando una banda de referencia alrededor del comportamiento esperado si los eventos estuvieran distribuidos aleatoriamente dentro de la ventana de observación.
env_L <- spatstat.explore::envelope(
pp_analisis,
fun = spatstat.explore::Lest,
nsim = nsim_envelopes,
correction = "border",
verbose = FALSE
)
g_env_L <- graficar_envelope_ggplot(
env_L,
titulo = paste0("Envelope CSR para L(r)-r | nsim = ", nsim_envelopes),
y_label = "L(r) - r",
restar_r = TRUE,
linea_cero = TRUE
)
guardar_grafico(g_env_L, "15_envelope_l_global.png", ancho = 10, alto = 6)
En el envelope de la función L(r) - r, la línea observada se encuentra muy por encima de la banda simulada bajo CSR en prácticamente todo el rango de distancias. Esto indica que hay muchos más eventos cercanos entre sí de los que se esperarían en un patrón aleatorio. Por tanto, se rechaza la hipótesis de CSR y se confirma una estructura espacial fuertemente agregada.
El resultado es coherente con los mapas de calor, la prueba de cuadrantes y la prueba de Clark-Evans. Los reportes Waze no se distribuyen de manera homogénea en toda el área de estudio, sino que se concentran en corredores viales y puntos específicos. La magnitud elevada de la curva observada también está influenciada por la presencia de múltiples reportes en coordenadas iguales o muy cercanas.
env_G <- spatstat.explore::envelope(
pp_analisis,
fun = spatstat.explore::Gest,
nsim = nsim_envelopes,
correction = "rs",
verbose = FALSE
)
g_env_G <- graficar_envelope_ggplot(
env_G,
titulo = paste0("Envelope CSR para G(r) | nsim = ", nsim_envelopes),
y_label = "G(r)",
restar_r = FALSE,
linea_cero = FALSE
)
guardar_grafico(g_env_G, "16_envelope_g_global.png", ancho = 10, alto = 6)
En el envelope de la función G(r), la línea observada alcanza valores cercanos a 1 desde distancias muy pequeñas, mientras que la referencia bajo CSR crece de forma gradual. Esto significa que una proporción muy alta de puntos tiene un vecino más cercano a una distancia extremadamente corta. Este comportamiento es típico de patrones agregados y, en este caso, también refleja la existencia de reportes repetidos en las mismas ubicaciones.
En conjunto, los envelopes refuerzan la conclusión de que el patrón puntual de reportes Waze del día 26 no es aleatorio. Hay evidencia clara de concentración espacial a corta y mediana distancia, lo cual permite identificar zonas críticas para la planeación y gestión de movilidad.
19 Análisis por tipo de evento
analizar_tipo_evento <- function(tipo_i) {
pp_i <- pp_analisis[spatstat.geom::marks(pp_analisis) == tipo_i]
n_i <- spatstat.geom::npoints(pp_i)
nombre_seguro <- janitor::make_clean_names(tipo_i)
if (n_i < 5) {
return(tibble::tibble(
tipo_evento = tipo_i,
n = n_i,
area_km2 = area_ventana_km2,
intensidad_km2 = n_i / area_ventana_km2,
sigma_kernel_m = NA_real_,
p_cuadrantes = NA_real_,
interpretacion_cuadrantes = "Muy pocos puntos para realizar pruebas estables.",
clark_evans_r = NA_real_,
clark_evans_p = NA_real_,
interpretacion_clark_evans = "Muy pocos puntos para realizar pruebas estables."
))
}
sigma_i <- tryCatch(
spatstat.explore::bw.diggle(pp_i),
error = function(e) sigma_kernel
)
dens_i <- spatstat.explore::density.ppp(pp_i, sigma = sigma_i, edge = TRUE, at = "pixels")
guardar_base_plot(
paste0("17_densidad_kernel_", nombre_seguro, ".png"),
{
plot(dens_i, main = paste0("Densidad kernel - ", tipo_i, " | sigma = ", round(sigma_i, 2), " m"))
plot(pp_i, add = TRUE, pch = 16, cex = 0.25)
}
)
q_i <- spatstat.geom::quadratcount(pp_i, nx = nx_cuadrantes, ny = ny_cuadrantes)
qt_i <- tryCatch(
spatstat.explore::quadrat.test(pp_i, nx = nx_cuadrantes, ny = ny_cuadrantes),
error = function(e) NULL
)
if (!is.null(qt_i)) {
escribir_txt(capture.output(qt_i), paste0("03_prueba_cuadrantes_", nombre_seguro, ".txt"))
}
guardar_base_plot(
paste0("18_cuadrantes_", nombre_seguro, ".png"),
{
plot(pp_i, main = paste0("Cuadrantes - ", tipo_i), pch = 16, cex = 0.45)
plot(q_i, add = TRUE, col = "red", cex = 1.1)
}
)
ce_i <- tryCatch(
spatstat.explore::clarkevans.test(pp_i, correction = "Donnelly"),
error = function(e) NULL
)
if (!is.null(ce_i)) {
escribir_txt(capture.output(ce_i), paste0("04_clark_evans_", nombre_seguro, ".txt"))
}
K_i <- tryCatch(spatstat.explore::Kest(pp_i, correction = "border"), error = function(e) NULL)
L_i <- tryCatch(spatstat.explore::Lest(pp_i, correction = "border"), error = function(e) NULL)
if (!is.null(K_i)) {
guardar_base_plot(paste0("19_funcion_k_", nombre_seguro, ".png"), {
plot(K_i, main = paste0("Función K - ", tipo_i))
})
}
if (!is.null(L_i)) {
guardar_base_plot(paste0("20_funcion_l_menos_r_", nombre_seguro, ".png"), {
plot(L_i, . - r ~ r, main = paste0("Función L(r)-r - ", tipo_i))
abline(h = 0, lty = 2, col = "red")
})
}
if (n_i >= 30) {
env_i <- tryCatch(
spatstat.explore::envelope(
pp_i,
fun = spatstat.explore::Lest,
nsim = nsim_envelopes,
correction = "border",
verbose = FALSE
),
error = function(e) NULL
)
if (!is.null(env_i)) {
g_env_i <- graficar_envelope_ggplot(
env_i,
titulo = paste0("Envelope CSR L(r)-r - ", tipo_i),
y_label = "L(r) - r",
restar_r = TRUE,
linea_cero = TRUE
)
ggplot2::ggsave(
file.path(dir_figuras, paste0("21_envelope_l_", nombre_seguro, ".png")),
g_env_i,
width = 10,
height = 6,
dpi = 140
)
}
}
p_q <- if (!is.null(qt_i)) qt_i$p.value else NA_real_
r_ce <- if (!is.null(ce_i)) as.numeric(ce_i$statistic[1]) else NA_real_
p_ce <- if (!is.null(ce_i)) ce_i$p.value else NA_real_
tibble::tibble(
tipo_evento = tipo_i,
n = n_i,
area_km2 = area_ventana_km2,
intensidad_km2 = n_i / area_ventana_km2,
sigma_kernel_m = as.numeric(sigma_i),
p_cuadrantes = p_q,
interpretacion_cuadrantes = interpretar_pvalue_csr(p_q),
clark_evans_r = r_ce,
clark_evans_p = p_ce,
interpretacion_clark_evans = interpretar_clark(r_ce, p_ce)
)
}resumen_por_tipo_ppp <- purrr::map_dfr(eventos_interes, analizar_tipo_evento)
readr::write_csv(resumen_por_tipo_ppp, file.path(dir_tablas, "15_resumen_patron_puntual_por_tipo.csv"))
resumen_por_tipo_ppp |>
knitr::kable(caption = "Resumen estadístico del patrón puntual por tipo de evento") |>
kableExtra::kable_styling(full_width = FALSE)| tipo_evento | n | area_km2 | intensidad_km2 | sigma_kernel_m | p_cuadrantes | interpretacion_cuadrantes | clark_evans_r | clark_evans_p | interpretacion_clark_evans |
|---|---|---|---|---|---|---|---|---|---|
| PELIGRO | 96 | 39.40514 | 2.4362304 | 1.368411 | 0 | Se rechaza CSR al 5%; hay evidencia de que el patrón no es completamente aleatorio. | 0.0005323 | 0 | Patrón agregado: las distancias al vecino más cercano son menores que las esperadas bajo CSR. |
| CONGESTION | 727 | 39.40514 | 18.4493696 | 1.368411 | 0 | Se rechaza CSR al 5%; hay evidencia de que el patrón no es completamente aleatorio. | 0.0035355 | 0 | Patrón agregado: las distancias al vecino más cercano son menores que las esperadas bajo CSR. |
| ACCIDENTE | 21 | 39.40514 | 0.5329254 | 1.368411 | 0 | Se rechaza CSR al 5%; hay evidencia de que el patrón no es completamente aleatorio. | 0.0593058 | 0 | Patrón agregado: las distancias al vecino más cercano son menores que las esperadas bajo CSR. |
| VIA CERRADA | 318 | 39.40514 | 8.0700131 | 1.368411 | 0 | Se rechaza CSR al 5%; hay evidencia de que el patrón no es completamente aleatorio. | 0.0001412 | 0 | Patrón agregado: las distancias al vecino más cercano son menores que las esperadas bajo CSR. |
El análisis por tipo de evento muestra diferencias importantes en volumen e intensidad espacial.
La categoría con mayor número de registros es CONGESTIÓN, con 727 reportes, una intensidad aproximada de 18.45 reportes por km². Esta categoría domina el patrón general y representa el principal fenómeno de movilidad observado en el día 26.
La categoría VÍA CERRADA presenta 318 reportes, con una intensidad aproximada de 8.07 reportes por km². Aunque tiene menos registros que congestión, su concentración espacial es muy relevante porque todos los reportes se agrupan en una zona puntual. Esto sugiere un cierre vial persistente o reportado repetidamente en el mismo sector.
La categoría PELIGRO registra 96 reportes, con una intensidad aproximada de 2.44 reportes por km². Su distribución se observa en varios puntos del área, con focos localizados que pueden representar obstáculos, riesgos en vía o condiciones peligrosas reportadas por los usuarios.
La categoría ACCIDENTE tiene 21 reportes, con una intensidad aproximada de 0.53 reportes por km². Es la categoría menos frecuente, pero su análisis sigue siendo importante porque los accidentes pueden tener alto impacto operativo aunque ocurran en menor cantidad.
En todos los tipos de evento, las pruebas de cuadrantes rechazan CSR al 5 %, y la prueba de Clark-Evans clasifica los patrones como agregados. Esto significa que cada categoría presenta concentración espacial significativa, aunque con diferentes magnitudes e implicaciones operativas.
20 Mapas por tipo de evento
En esta sección se muestran los mapas individuales por categoría. Para cada tipo de evento se presenta un mapa interactivo con agrupamiento de puntos y un mapa de calor.
mapas_tipo <- list()
mapas_calor_tipo <- list()
resumen_mapas_tipo <- list()
for (tipo_i in eventos_interes) {
datos_i <- datos_dia_interes |>
filter(tipo_evento == tipo_i)
if (nrow(datos_i) > 0) {
nombre_seguro <- janitor::make_clean_names(tipo_i)
mapas_tipo[[tipo_i]] <- crear_mapa_leaflet_puntos(
datos_i,
titulo = paste0("Mapa interactivo - ", tipo_i, " - Día ", dia_objetivo),
archivo = paste0("03_mapa_puntos_", nombre_seguro, ".html")
)
mapas_calor_tipo[[tipo_i]] <- crear_mapa_heatmap(
datos_i,
titulo = paste0("Mapa de calor - ", tipo_i, " - Día ", dia_objetivo),
archivo = paste0("04_mapa_calor_", nombre_seguro, ".html"),
radio = ifelse(tipo_i == "CONGESTION", 28, 18),
blur = ifelse(tipo_i == "CONGESTION", 34, 22)
)
resumen_mapas_tipo[[tipo_i]] <- tibble::tibble(
tipo_evento = tipo_i,
registros = nrow(datos_i),
mapa_puntos_html = file.path(dir_mapas, paste0("03_mapa_puntos_", nombre_seguro, ".html")),
mapa_calor_html = file.path(dir_mapas, paste0("04_mapa_calor_", nombre_seguro, ".html"))
)
}
}
resumen_mapas_tipo <- dplyr::bind_rows(resumen_mapas_tipo)
readr::write_csv(resumen_mapas_tipo, file.path(dir_tablas, "15b_mapas_generados_por_tipo.csv"))
resumen_mapas_tipo |>
knitr::kable(caption = "Mapas generados por tipo de evento") |>
kableExtra::kable_styling(full_width = FALSE)| tipo_evento | registros | mapa_puntos_html | mapa_calor_html |
|---|---|---|---|
| PELIGRO | 96 | resultados_waze_patrones_puntuales_rmd/mapas_html/03_mapa_puntos_peligro.html | resultados_waze_patrones_puntuales_rmd/mapas_html/04_mapa_calor_peligro.html |
| CONGESTION | 727 | resultados_waze_patrones_puntuales_rmd/mapas_html/03_mapa_puntos_congestion.html | resultados_waze_patrones_puntuales_rmd/mapas_html/04_mapa_calor_congestion.html |
| ACCIDENTE | 21 | resultados_waze_patrones_puntuales_rmd/mapas_html/03_mapa_puntos_accidente.html | resultados_waze_patrones_puntuales_rmd/mapas_html/04_mapa_calor_accidente.html |
| VIA CERRADA | 318 | resultados_waze_patrones_puntuales_rmd/mapas_html/03_mapa_puntos_via_cerrada.html | resultados_waze_patrones_puntuales_rmd/mapas_html/04_mapa_calor_via_cerrada.html |
# Nota técnica:
# En versiones específicas de htmlwidgets/leafsync, el guardado del mapa sincronizado
# puede fallar con el error: invalid type/length (symbol/0) in vector allocation.
# Para garantizar que el Knit compile correctamente, los mapas por tipo se muestran
# directamente en el informe y también se guardan como HTML individuales.
crear_mapa_sincronizado <- FALSE
if (crear_mapa_sincronizado && requireNamespace("leafsync", quietly = TRUE) && length(mapas_tipo) >= 2) {
mapa_sync <- tryCatch(
do.call(leafsync::sync, mapas_tipo),
error = function(e) {
message("No fue posible construir el mapa sincronizado con leafsync: ", e$message)
NULL
}
)
if (!is.null(mapa_sync)) {
tryCatch(
htmlwidgets::saveWidget(
mapa_sync,
file.path(dir_mapas, "05_mapa_sincronizado_tipos_waze.html"),
selfcontained = FALSE
),
error = function(e) {
message("No fue posible guardar el mapa sincronizado. Se continúa con los mapas individuales: ", e$message)
}
)
}
}
mapas_visibles <- purrr::map(names(mapas_tipo), function(tipo_i) {
htmltools::tagList(
htmltools::tags$div(
class = "mejor-box",
htmltools::tags$h3(paste0("Tipo de evento: ", tipo_i)),
htmltools::tags$p(paste0(
"Total de reportes del día ", dia_objetivo, " para esta categoría: ",
scales::comma(sum(datos_dia_interes$tipo_evento == tipo_i, na.rm = TRUE)), "."
))
),
htmltools::tags$h4("Mapa interactivo de puntos con agrupamiento"),
mapas_tipo[[tipo_i]],
htmltools::tags$h4("Mapa de calor de concentración espacial"),
mapas_calor_tipo[[tipo_i]],
htmltools::tags$hr()
)
})
htmltools::browsable(htmltools::tagList(mapas_visibles))Tipo de evento: PELIGRO
Total de reportes del día 26 para esta categoría: 96.
Mapa interactivo de puntos con agrupamiento
Mapa de calor de concentración espacial
Tipo de evento: CONGESTION
Total de reportes del día 26 para esta categoría: 727.
Mapa interactivo de puntos con agrupamiento
Mapa de calor de concentración espacial
Tipo de evento: ACCIDENTE
Total de reportes del día 26 para esta categoría: 21.
Mapa interactivo de puntos con agrupamiento
Mapa de calor de concentración espacial
Tipo de evento: VIA CERRADA
Total de reportes del día 26 para esta categoría: 318.
Mapa interactivo de puntos con agrupamiento
Mapa de calor de concentración espacial
- PELIGRO
Para la categoría PELIGRO se identifican 96 reportes. El mapa de puntos muestra varios clústeres distribuidos principalmente cerca de Cajicá, Hato Grande, Yerbabuena Bajo y algunos corredores de conexión.
El mapa de calor confirma la existencia de varios focos de concentración, no un único punto dominante. Esto indica que los peligros reportados están asociados a diferentes sectores de la red vial. Desde el punto de vista operativo, estos focos deberían revisarse para identificar posibles obstáculos, fallas de infraestructura, riesgos temporales o condiciones recurrentes que afecten la seguridad vial.
- CONGESTIÓN
La categoría CONGESTIÓN concentra 727 reportes, siendo la más importante del análisis. El mapa interactivo muestra varios clústeres relevantes, con acumulaciones superiores a 100 reportes en diferentes sectores.
El mapa de calor evidencia una concentración fuerte en el corredor occidental y en sectores cercanos a Cajicá y Hato Grande. Esto sugiere que la congestión no se presenta como eventos aislados, sino como una problemática extendida en varios tramos viales. Esta categoría debe considerarse prioritaria para planeación de tráfico, revisión de semáforos, gestión de desvíos y análisis de capacidad vial.
- ACCIDENTE
La categoría ACCIDENTE presenta 21 reportes, por lo que su volumen es bajo en comparación con las demás categorías. El mapa muestra dos agrupaciones principales: una con mayor concentración y otra menor.
El mapa de calor permite identificar un foco predominante de accidentes en el sector inferior del área visualizada. Aunque la cantidad total de reportes es baja, este tipo de evento tiene alta importancia para seguridad vial. Por tanto, las zonas donde aparecen accidentes deberían evaluarse con mayor detalle en términos de señalización, visibilidad, cruces, velocidad y condiciones de infraestructura.
- VÍA CERRADA
La categoría VÍA CERRADA contiene 318 reportes, y el mapa muestra una concentración prácticamente única en un sector específico. El mapa de calor confirma un foco altamente localizado.
Este resultado sugiere que los cierres viales del día 26 estuvieron asociados a un punto o tramo específico, probablemente persistente durante varias horas. Esta categoría es especialmente importante porque un cierre vial localizado puede generar congestión en corredores alternos y afectar la movilidad general de la zona.
21 Asociación entre tipo de evento y zona espacial
datos_celdas <- datos_utm |>
sf::st_drop_geometry() |>
mutate(
celda_x = cut(x, breaks = nx_cuadrantes, include.lowest = TRUE),
celda_y = cut(y, breaks = ny_cuadrantes, include.lowest = TRUE),
celda = paste(celda_x, celda_y, sep = " | ")
)
tabla_tipo_celda <- table(datos_celdas$tipo_evento, datos_celdas$celda)
prueba_tipo_celda <- tryCatch(
suppressWarnings(chisq.test(tabla_tipo_celda)),
error = function(e) NULL
)
if (!is.null(prueba_tipo_celda)) {
escribir_txt(capture.output(prueba_tipo_celda), "05_prueba_asociacion_tipo_cuadrante.txt")
resultado_asociacion <- tibble::tibble(
estadistico_chi2 = as.numeric(prueba_tipo_celda$statistic),
grados_libertad = as.numeric(prueba_tipo_celda$parameter),
p_value = prueba_tipo_celda$p.value,
interpretacion = ifelse(
prueba_tipo_celda$p.value < 0.05,
"La distribución espacial por cuadrantes difiere entre tipos de evento.",
"No hay evidencia suficiente de diferencias por cuadrante entre tipos de evento."
)
)
readr::write_csv(resultado_asociacion, file.path(dir_tablas, "16_prueba_asociacion_tipo_cuadrante.csv"))
resultado_asociacion |>
knitr::kable(caption = "Prueba de asociación entre tipo de evento y celda espacial") |>
kableExtra::kable_styling(full_width = FALSE)
} else {
cat("No fue posible ejecutar la prueba de asociación tipo-celda.")
}| estadistico_chi2 | grados_libertad | p_value | interpretacion |
|---|---|---|---|
| 2342.26 | 39 | 0 | La distribución espacial por cuadrantes difiere entre tipos de evento. |
La prueba de asociación entre tipo de evento y celda espacial arrojó un estadístico chi-cuadrado de 2342.26, con 39 grados de libertad y un valor p reportado como 0. En términos estadísticos, este valor debe interpretarse como p < 0.001.
Este resultado indica que la distribución espacial no es igual para todos los tipos de evento. Es decir, los accidentes, peligros, congestiones y cierres viales no se ubican de forma homogénea en las mismas zonas. Cada tipo de evento tiene un patrón espacial particular.
Desde la perspectiva de movilidad, este hallazgo es importante porque permite diferenciar acciones de intervención. Las zonas críticas de congestión pueden requerir medidas de gestión de tráfico, mientras que las zonas con peligros o accidentes pueden requerir intervenciones de seguridad vial. Los cierres viales, por su parte, demandan estrategias de desvío, información al usuario y coordinación operativa.
22 Ranking de zonas críticas
ranking_celdas <- datos_celdas |>
count(celda, celda_x, celda_y, sort = TRUE) |>
mutate(
ranking = row_number(),
porcentaje = n / sum(n),
criticidad = case_when(
porcentaje >= quantile(porcentaje, 0.90, na.rm = TRUE) ~ "Muy alta",
porcentaje >= quantile(porcentaje, 0.75, na.rm = TRUE) ~ "Alta",
porcentaje >= quantile(porcentaje, 0.50, na.rm = TRUE) ~ "Media",
TRUE ~ "Baja"
)
)
readr::write_csv(ranking_celdas, file.path(dir_tablas, "17_ranking_celdas_criticas.csv"))
ranking_celdas |>
slice_head(n = 15) |>
knitr::kable(caption = "Top 15 celdas espaciales con mayor concentración de reportes") |>
kableExtra::kable_styling(full_width = FALSE)| celda | celda_x | celda_y | n | ranking | porcentaje | criticidad |
|---|---|---|---|---|---|---|
| [6.06e+05,6.07e+05] | (5.42e+05,5.43e+05] | [6.06e+05,6.07e+05] | (5.42e+05,5.43e+05] | 318 | 1 | 0.2736661 | Muy alta |
| (6.08e+05,6.09e+05] | (5.46e+05,5.47e+05] | (6.08e+05,6.09e+05] | (5.46e+05,5.47e+05] | 171 | 2 | 0.1471601 | Muy alta |
| (6.07e+05,6.08e+05] | (5.42e+05,5.43e+05] | (6.07e+05,6.08e+05] | (5.42e+05,5.43e+05] | 132 | 3 | 0.1135972 | Alta |
| (6.07e+05,6.08e+05] | [5.4e+05,5.42e+05] | (6.07e+05,6.08e+05] | [5.4e+05,5.42e+05] | 89 | 4 | 0.0765921 | Alta |
| (6.09e+05,6.1e+05] | (5.43e+05,5.44e+05] | (6.09e+05,6.1e+05] | (5.43e+05,5.44e+05] | 88 | 5 | 0.0757315 | Media |
| (6.07e+05,6.08e+05] | (5.43e+05,5.44e+05] | (6.07e+05,6.08e+05] | (5.43e+05,5.44e+05] | 84 | 6 | 0.0722892 | Media |
| [6.06e+05,6.07e+05] | (5.43e+05,5.44e+05] | [6.06e+05,6.07e+05] | (5.43e+05,5.44e+05] | 69 | 7 | 0.0593804 | Media |
| (6.08e+05,6.09e+05] | (5.43e+05,5.44e+05] | (6.08e+05,6.09e+05] | (5.43e+05,5.44e+05] | 53 | 8 | 0.0456110 | Baja |
| (6.1e+05,6.11e+05] | (5.43e+05,5.44e+05] | (6.1e+05,6.11e+05] | (5.43e+05,5.44e+05] | 52 | 9 | 0.0447504 | Baja |
| [6.06e+05,6.07e+05] | [5.4e+05,5.42e+05] | [6.06e+05,6.07e+05] | [5.4e+05,5.42e+05] | 35 | 10 | 0.0301205 | Baja |
| (6.1e+05,6.11e+05] | (5.44e+05,5.46e+05] | (6.1e+05,6.11e+05] | (5.44e+05,5.46e+05] | 29 | 11 | 0.0249570 | Baja |
| (6.1e+05,6.11e+05] | (5.42e+05,5.43e+05] | (6.1e+05,6.11e+05] | (5.42e+05,5.43e+05] | 27 | 12 | 0.0232358 | Baja |
| (6.08e+05,6.09e+05] | (5.44e+05,5.46e+05] | (6.08e+05,6.09e+05] | (5.44e+05,5.46e+05] | 10 | 13 | 0.0086059 | Baja |
| (6.09e+05,6.1e+05] | (5.44e+05,5.46e+05] | (6.09e+05,6.1e+05] | (5.44e+05,5.46e+05] | 5 | 14 | 0.0043029 | Baja |
graf_ranking <- ranking_celdas |>
slice_head(n = 15) |>
mutate(celda = forcats::fct_reorder(celda, n)) |>
ggplot(aes(x = celda, y = n, fill = criticidad)) +
geom_col() +
coord_flip() +
scale_y_continuous(labels = scales::comma) +
labs(
title = "Ranking de celdas con mayor concentración de reportes",
subtitle = "Salida operativa para identificar zonas prioritarias de intervención",
x = "Celda espacial",
y = "Cantidad de reportes",
fill = "Criticidad"
) +
theme_minimal()
guardar_grafico(graf_ranking, "22_ranking_celdas_criticas.png", ancho = 12, alto = 7)
El ranking de zonas críticas identifica las celdas espaciales con mayor concentración de reportes. La celda con mayor cantidad de eventos registra 318 reportes, equivalente al 27.37 % del total del día 26, y se clasifica como de criticidad muy alta.
La segunda celda registra 171 reportes, equivalente al 14.72 %, también clasificada como muy alta. Luego aparecen celdas con 132, 89, 88, 84 y 69 reportes, con niveles de criticidad alta y media.
Este resultado muestra que una proporción importante de los reportes se concentra en pocas celdas espaciales. En términos operativos, esto permite priorizar las zonas donde las autoridades o analistas de movilidad deberían enfocar acciones de revisión, monitoreo o intervención.
El gráfico de barras confirma visualmente esta concentración: las dos primeras celdas sobresalen claramente frente al resto, lo que indica que no todas las zonas tienen la misma importancia para la gestión de movilidad. La primera celda coincide con el patrón observado en los mapas de VÍA CERRADA, mientras que otras celdas relevantes parecen estar asociadas con zonas de congestión.
23 Conclusiones
Conclusión 1. El análisis permitió construir un patrón puntual formal de los reportes Waze del día 26, integrando limpieza de datos, homologación de categorías, georreferenciación y transformación a coordenadas métricas UTM. Esta transformación fue fundamental para calcular distancias, intensidades, densidades y funciones espaciales de manera técnicamente adecuada.
Conclusión 2. La categoría dominante fue CONGESTIÓN, con 727 reportes, equivalente al 62.6 % de los eventos del día 26. En segundo lugar se ubicó VÍA CERRADA, con 318 reportes, equivalente al 27.4 %. Esto indica que la problemática principal del día analizado estuvo asociada a tráfico lento y afectaciones viales persistentes.
Conclusión 3. El análisis temporal mostró que los reportes se concentran principalmente entre las 11:00 y las 23:00, con un pico máximo a las 23:00, donde se registraron 186 eventos. Esta franja debe considerarse crítica para monitoreo operativo y gestión de movilidad.
Conclusión 4. Las pruebas de patrones puntuales evidencian una fuerte concentración espacial. La prueba de cuadrantes rechazó CSR con un valor p menor a 0.001, Clark-Evans mostró valores de R menores que 1 y las funciones K, L, G y J confirmaron un patrón agregado. Por tanto, los reportes Waze no se distribuyen aleatoriamente, sino que se agrupan en zonas específicas.
Conclusión 5. Los mapas de calor y los mapas por tipo de evento permiten identificar focos críticos diferenciados. La congestión presenta varios focos distribuidos en corredores viales, mientras que los cierres viales se concentran en un punto específico. Los peligros y accidentes tienen menor frecuencia, pero aportan información relevante para seguridad vial.
Conclusión 6. La prueba de asociación entre tipo de evento y zona espacial evidenció que la distribución espacial cambia según el tipo de reporte. Esto significa que no todas las categorías se concentran en las mismas zonas, por lo que las intervenciones deben diferenciarse según la naturaleza del evento.
Conclusión 7. El ranking de zonas críticas muestra que pocas celdas concentran una proporción importante de los reportes. La celda principal reúne 318 eventos, equivalente al 27.37 % del total, lo que la convierte en una zona prioritaria para análisis operativo, revisión de cierres, gestión de desvíos y evaluación de impactos sobre la movilidad.
Conclusión 8. La alta cantidad de coordenadas duplicadas indica que varios reportes se repiten en las mismas ubicaciones. Esto no invalida el análisis, pero exige interpretar los resultados como concentración de reportes ciudadanos y no necesariamente como eventos físicos independientes.
Conclusión final. El análisis de patrones puntuales aplicado a reportes Waze permite identificar concentración espacial y temporal de eventos de movilidad. Los resultados ofrecen una base útil para priorizar zonas de intervención, monitorear corredores críticos, evaluar cierres viales y apoyar la toma de decisiones orientadas a mejorar la movilidad y la seguridad vial.