Marco Teórico

El análisis de datos de tráfico es esencial en el contexto urbano actual para mejorar la movilidad y la seguridad vial. Con el crecimiento constante de las ciudades y el aumento en el número de vehículos, es crucial utilizar herramientas y metodologías avanzadas para gestionar el tráfico de manera eficiente.

Las aplicaciones de navegación colaborativa como Waze han revolucionado la recopilación de datos de tráfico. A través de la participación activa de los usuarios, Waze proporciona información en tiempo real sobre las condiciones de las vías, incluyendo reportes de congestión, accidentes, peligros y cierres de vías. Estos datos son valiosos para las autoridades y planificadores urbanos, ya que permiten tomar decisiones informadas basadas en información actual y precisa.

El análisis de datos geoespaciales y la minería de datos son fundamentales para extraer conocimiento de grandes volúmenes de información. Herramientas como R y librerías especializadas como leaflet, spatstat y ggplot2 facilitan el procesamiento y visualización de datos espaciales, permitiendo identificar patrones y tendencias que pueden guiar estrategias para mejorar la infraestructura vial y la gestión del tráfico.

Introducción

El presente análisis se enfoca en el estudio de los eventos reportados por los usuarios a través de la aplicación Waze. Esta plataforma de navegación colaborativa proporciona datos valiosos sobre las condiciones del tráfico en tiempo real, incluyendo reportes de peligros, congestión, accidentes y cierres de vías. La información recopilada es esencial para la planificación urbana y la gestión eficiente del tráfico, permitiendo a las autoridades tomar decisiones informadas para mejorar la movilidad y la seguridad vial.

Objetivo

El objetivo de este análisis es estudiar la distribución espacial y temporal de la totalidad de los eventos reportados en Waze, sin restricción de fecha, analizando cada tipo de evento de forma independiente. El uso de K-means para la segmentación geográfica previa al análisis de cuadrantes permite obtener resultados más precisos y localizados, evitando el problema de ventanas globales con cuadrantes vacíos.

Metodología CRISP-DM

La metodología CRISP-DM (Cross-Industry Standard Process for Data Mining) es un estándar para la ejecución de proyectos de minería de datos. Consta de seis fases que guían el proceso desde la comprensión del negocio hasta el despliegue de los resultados.

Fase	Descripción
1. Comprensión del Negocio	Mejorar la movilidad y seguridad vial mediante el análisis de datos de Waze.
2. Comprensión de los Datos	Recopilación y exploración inicial de eventos reportados.
3. Preparación de los Datos	Limpieza, transformación y estandarización de coordenadas.
4. Modelado	K-means para segmentación geográfica + mapas interactivos y de calor por cluster.
5. Evaluación	Interpretación de resultados y validación de hallazgos.
6. Despliegue	Presentación de resultados e implementación de recomendaciones.

Metodología

En este análisis se han seguido los siguientes pasos metodológicos:

Obtención de Datos: Datos exportados desde Waze en formato Excel, con la totalidad del periodo disponible.
Carga y Preparación: Limpieza, conversión de fechas y estandarización de coordenadas.
Análisis Descriptivo: Frecuencia y distribución de tipos de eventos a lo largo del tiempo.
Segmentación por K-means: Identificación de grupos geográficos naturales en los datos antes del análisis espacial, aplicado a cada tipo de evento por separado.
Análisis Geoespacial por Cluster: Mapas interactivos y test de cuadrantes aplicados a cada grupo identificado.
Mapas de Densidad Global: Estimación de densidad espacial sobre el total de puntos de cada tipo de evento.
Consolidación: Vista unificada de todos los tipos de eventos.

Carga de Datos y Librerías Necesarias

En esta sección se realiza la carga y preparación de los datos obtenidos desde Waze. Se procesan las fechas de creación de cada evento y se traducen los tipos de eventos al español.

# ── Librerías ──────────────────────────────────────────────────────────────────
library(readxl)         # Carga de datos desde archivos Excel
library(dplyr)          # Manipulación y transformación de datos
library(lubridate)      # Manejo y procesamiento de fechas y tiempos
library(leaflet)        # Creación de mapas interactivos
library(sf)             # Trabajo con datos geoespaciales
library(mapview)        # Visualización interactiva de mapas
library(spatstat)       # Análisis de patrones espaciales y densidad
library(terra)          # Manejo de datos raster y análisis espacial
library(leaflet.extras) # Funciones adicionales para mapas leaflet (heatmap)
library(ggplot2)        # Creación de gráficos y visualizaciones
library(leafsync)       # Sincronización de múltiples mapas interactivos
library(factoextra)     # Visualización de resultados de clustering

# ── Carga del archivo Excel ────────────────────────────────────────────────────
# AJUSTA esta ruta si tu archivo está en otra ubicación
#Trama_Waze <- read_excel("C:/Users/User/Downloads/Trama Waze.xlsx")
Trama_Waze <- read_excel("C:/Users/USER ADMIN/Downloads/Trama Waze.xlsx")


# ── Conversión de fechas ───────────────────────────────────────────────────────
Trama_Waze$fecha     <- as.Date(Trama_Waze$creation_Date, format = "%Y-%m-%d %H:%M")
fecha_hora           <- ymd_hms(Trama_Waze$creation_Date)
Trama_Waze$hora      <- hour(fecha_hora)
Trama_Waze$dia       <- day(fecha_hora)
Trama_Waze$mes       <- month(fecha_hora, label = TRUE)

# ── Traducción de tipos de eventos al español ──────────────────────────────────
Trama_Waze$tipo_evento <- recode(Trama_Waze$type,
                                 "ACCIDENT"    = "ACCIDENTE",
                                 "HAZARD"      = "PELIGRO",
                                 "JAM"         = "CONGESTIÓN",
                                 "ROAD_CLOSED" = "VÍA CERRADA")

# ── Vista previa ───────────────────────────────────────────────────────────────
head(Trama_Waze)

## # A tibble: 6 × 22
##      id waze_json_trama_id country reportRating reportByMunicipalityUser
##   <dbl>              <dbl> <chr>          <dbl> <lgl>                   
## 1    16                 14 CO                 2 FALSE                   
## 2    17                 14 CO                 3 FALSE                   
## 3    18                 14 CO                 0 FALSE                   
## 4    20                 15 CO                 2 FALSE                   
## 5    21                 15 CO                 3 FALSE                   
## 6    22                 15 CO                 0 FALSE                   
## # ℹ 17 more variables: confidence <dbl>, reliability <dbl>, type <chr>,
## #   uuid <chr>, roadType <dbl>, magvar <dbl>, subtype <chr>, street <chr>,
## #   location_x <dbl>, location_y <dbl>, pubMillis <dbl>, creation_Date <chr>,
## #   fecha <date>, hora <int>, dia <int>, mes <ord>, tipo_evento <chr>

Análisis Temporal de los Eventos

El análisis temporal permite identificar patrones en la distribución de eventos a lo largo del día y del periodo completo disponible en los datos.

# ── Gráfico de frecuencia por hora del día ─────────────────────────────────────
hora_factorizado <- factor(Trama_Waze$hora, levels = 0:23)

ggplot(mapping = aes(x = hora_factorizado)) +
  geom_bar(fill = "orange", color = "black") +
  labs(
    title = "Frecuencia de Eventos por Hora del Día (todos los días)",
    x     = "Hora del Día",
    y     = "Frecuencia (Conteo)"
  ) +
  theme_minimal() +
  scale_x_discrete(drop = FALSE)

# ── Tabla de frecuencia de tipos de eventos ────────────────────────────────────
cat("Distribución de eventos por tipo:\n")

## Distribución de eventos por tipo:

print(table(Trama_Waze$tipo_evento))

## 
##   ACCIDENTE  CONGESTIÓN     PELIGRO VÍA CERRADA 
##         125        3205         719        1021

Distribución de Eventos

Gráfico de barras con la frecuencia total de cada tipo de evento en el periodo completo.

# ── Calcular frecuencia por tipo de evento ─────────────────────────────────────
frecuencia_eventos <- Trama_Waze %>%
  group_by(tipo_evento) %>%
  summarise(Frecuencia = n()) %>%
  arrange(desc(Frecuencia))

# ── Gráfico de barras ──────────────────────────────────────────────────────────
ggplot(frecuencia_eventos, aes(x = reorder(tipo_evento, -Frecuencia),
                               y = Frecuencia,
                               fill = tipo_evento)) +
  geom_bar(stat = "identity") +
  theme_minimal() +
  labs(
    title = "Distribución de Tipos de Eventos — Periodo Completo",
    x     = "Tipo de Evento",
    y     = "Frecuencia",
    fill  = "Tipo de Evento"
  ) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_brewer(palette = "Set2")

Función Auxiliar: Análisis Espacial por Cluster (K-means)

Se define una función reutilizable que:

Calcula el número de puntos únicos disponibles y ajusta los parámetros de forma automática.
Genera el gráfico del método del codo (cuando hay suficientes datos).
Aplica K-means y visualiza los clusters en un mapa interactivo.
Ejecuta el test de cuadrantes y la función K de Ripley para cada cluster con suficientes puntos.

analisis_kmeans_espacial <- function(datos,
                                     nombre_evento,
                                     k         = NULL,
                                     max_k     = 8,
                                     min_pts   = 5,
                                     margen    = 0.002,
                                     nx_grid   = 3,
                                     ny_grid   = 3) {

  coords   <- datos[, c("long", "lat")]
  n_unicos <- nrow(unique(coords))
  cat("\n── Evento:", nombre_evento, "| Puntos únicos:", n_unicos, "──\n")

  # ── Guardia: mínimo de puntos ──────────────────────────────────────────────
  if (n_unicos < 2) {
    cat("  ⚠ Menos de 2 puntos únicos. No es posible aplicar K-means.\n")
    datos$cluster <- factor(1)
    return(invisible(datos))
  }

  # Ajustar max_k y k al número real de puntos únicos disponibles
  max_k <- min(max_k, n_unicos - 1)
  if (!is.null(k)) k <- min(k, n_unicos)

  # ── 1. Método del codo ─────────────────────────────────────────────────────
  # fviz_nbclust requiere estrictamente más puntos únicos que k.max;
  # si no se cumple, se omite el gráfico y se usa k directamente.
  if (n_unicos > max_k) {
    print(
      fviz_nbclust(coords, kmeans, method = "wss", k.max = max_k) +
        labs(title = paste("Método del Codo —", nombre_evento))
    )
  } else {
    cat("  ⚠ Solo hay", n_unicos, "puntos únicos.",
        "Se omite el gráfico del codo (requiere n_unicos > max_k).\n")
  }

  # Valor por defecto de k si no se especifica
  if (is.null(k)) {
    k <- min(3, n_unicos)
    cat("  k no especificado. Se usará k =", k,
        "(ajusta según el gráfico del codo)\n")
  }

  # ── 2. K-means ─────────────────────────────────────────────────────────────
  set.seed(123)
  km            <- kmeans(coords, centers = k, nstart = 25)
  datos$cluster <- as.factor(km$cluster)

  # ── 3. Mapa interactivo con clusters coloreados ────────────────────────────
  pal <- colorFactor(palette = "Set1", domain = datos$cluster)

  m_cluster <- leaflet(datos) %>%
    addTiles() %>%
    addCircleMarkers(
      lng    = ~long,
      lat    = ~lat,
      color  = ~pal(cluster),
      radius = 5,
      label  = ~paste("Cluster", cluster, "| Hora:", hora)
    ) %>%
    addLegend("bottomright",
              pal    = pal,
              values = ~cluster,
              title  = paste("Clusters —", nombre_evento)) %>%
    addControl(html = paste0("<h3>Clusters — ", nombre_evento, "</h3>"),
               position = "topleft")

  print(m_cluster)

  # ── 4. Análisis espacial por cluster ──────────────────────────────────────
  for (cl in levels(datos$cluster)) {

    sub <- datos %>% filter(cluster == cl)
    n   <- nrow(sub)
    cat("\n  Cluster", cl, "— n =", n, "\n")

    if (n < min_pts) {
      cat("  ⚠ Cluster", cl, "tiene menos de", min_pts,
          "puntos. Se omite el análisis espacial.\n")
      next
    }

    # Zona ajustada al cluster con margen
    zona_cl <- owin(
      xrange = c(min(sub$long) - margen, max(sub$long) + margen),
      yrange = c(min(sub$lat)  - margen, max(sub$lat)  + margen)
    )

    # Crear patrón de puntos con manejo de errores
    patron_cl <- tryCatch(
      ppp(x = sub$long, y = sub$lat, window = zona_cl),
      error = function(e) {
        cat("  ✖ Error al crear ppp en Cluster", cl, ":", e$message, "\n")
        return(NULL)
      }
    )

    if (is.null(patron_cl)) next

    # Test de cuadrantes
    plot(quadratcount(patron_cl, nx = nx_grid, ny = ny_grid),
         main = paste("Cuadrantes —", nombre_evento, "| Cluster", cl,
                      "(n =", n, ")"))
    points(patron_cl, col = "red")

    # Función K de Ripley (solo con suficientes puntos)
    if (n >= 10) {
      tryCatch(
        plot(Kest(patron_cl),
             main = paste("Función K —", nombre_evento, "| Cluster", cl)),
        error = function(e) cat("  ⚠ Kest falló:", e$message, "\n")
      )
    } else {
      cat("  ⚠ n <10: se omite Kest.\n")
    }
  }

  invisible(datos)
}

Función Auxiliar: Preparación de Coordenadas

Función reutilizable para ajustar y filtrar coordenadas en todos los tipos de eventos.

preparar_coords <- function(datos, lat_min = 4, lat_max = 5,
                             long_min = -75, long_max = -73) {
  datos$lat  <- datos$location_y / 10^(nchar(datos$location_y) - 1)
  datos$long <- datos$location_x / 10^(nchar(datos$location_x) - 3)
  datos <- datos[datos$lat  > lat_min  & datos$lat  < lat_max  &
                 datos$long > long_min & datos$long < long_max, ]
  return(datos)
}

Análisis de Eventos PELIGRO

Filtrado y Mapa Interactivo

Se analizan todos los eventos de tipo PELIGRO del periodo completo, sin restricción de fecha.

# ── Filtrar todos los eventos PELIGRO ─────────────────────────────────────────
peligro <- Trama_Waze %>% filter(tipo_evento == "PELIGRO")
peligro  <- preparar_coords(peligro)

cat("Total de eventos PELIGRO:", nrow(peligro), "\n")

## Total de eventos PELIGRO: 702

cat("Rango de fechas:", as.character(min(peligro$fecha, na.rm = TRUE)),
    "→", as.character(max(peligro$fecha, na.rm = TRUE)), "\n")

## Rango de fechas: 2024-09-26 → 2024-09-28

# ── Mapa interactivo ───────────────────────────────────────────────────────────
m_peligro <- leaflet(peligro) %>%
  addTiles() %>%
  addCircleMarkers(
    lng            = ~long,
    lat            = ~lat,
    clusterOptions = markerClusterOptions(),
    label          = ~paste("Hora:", hora, "| Fecha:", fecha)
  ) %>%
  addControl(html = "<h3>Mapa de Riesgos</h3>", position = "topleft")

m_peligro

Mapa de Calor — PELIGRO

leaflet(peligro) %>%
  addProviderTiles("OpenStreetMap") %>%
  addHeatmap(
    lng       = ~long,
    lat       = ~lat,
    intensity = ~hora,
    blur      = 20,
    max       = 0.08,
    radius    = 15
  ) %>%
  addLegend("bottomright",
            title  = "Mapa de Calor de Riesgos",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Segmentación K-means y Análisis Espacial por Cluster — PELIGRO

Se identifican zonas geográficas naturales mediante K-means y se aplica el análisis de cuadrantes y la función K de Ripley de forma independiente en cada zona.

Instrucción: observa el gráfico del codo y ajusta k al número donde la curva deja de descender bruscamente.

peligro_cl <- analisis_kmeans_espacial(
  datos         = peligro,
  nombre_evento = "PELIGRO",
  k             = 3,     # <-- Ajusta según el gráfico del codo
  max_k         = 8,
  min_pts       = 5,
  margen        = 0.002,
  nx_grid       = 3,
  ny_grid       = 3
)

## 
## ── Evento: PELIGRO | Puntos únicos: 63 ──

## 
##   Cluster 1 — n = 258

## 
##   Cluster 2 — n = 289

## 
##   Cluster 3 — n = 155

Mapa de Densidad Global — PELIGRO

margen_p <- 0.001
zona_p   <- owin(
  xrange = c(min(peligro$long) - margen_p, max(peligro$long) + margen_p),
  yrange = c(min(peligro$lat)  - margen_p, max(peligro$lat)  + margen_p)
)

patron_p <- ppp(x = peligro$long, y = peligro$lat, window = zona_p)
im_p     <- density(patron_p, sigma = bw.diggle(patron_p))
mapa_p   <- rast(im_p)
df_p     <- as.data.frame(mapa_p, xy = TRUE)
colnames(df_p) <- c("long", "lat", "intensity")

df_p$intensity <- (df_p$intensity - min(df_p$intensity)) /
                  (max(df_p$intensity) - min(df_p$intensity))

leaflet(df_p) %>%
  addProviderTiles("OpenStreetMap") %>%
  addHeatmap(lng = ~long, lat = ~lat, intensity = ~intensity,
             blur = 20, max = 1, radius = 15) %>%
  addLegend("bottomright",
            title  = "Densidad de Riesgos",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Análisis de Cierres de Vías

Filtrado y Mapa Interactivo

Se analizan todos los eventos de tipo VÍA CERRADA del periodo completo.

# ── Filtrar todos los eventos VÍA CERRADA ─────────────────────────────────────
via_cerrada <- Trama_Waze %>% filter(tipo_evento == "VÍA CERRADA")
via_cerrada  <- preparar_coords(via_cerrada)

cat("Total de eventos VÍA CERRADA:", nrow(via_cerrada), "\n")

## Total de eventos VÍA CERRADA: 1021

cat("Rango de fechas:", as.character(min(via_cerrada$fecha, na.rm = TRUE)),
    "→", as.character(max(via_cerrada$fecha, na.rm = TRUE)), "\n")

## Rango de fechas: 2024-09-26 → 2024-09-28

# ── Mapa interactivo ───────────────────────────────────────────────────────────
m_via_cerrada <- leaflet(via_cerrada) %>%
  addTiles() %>%
  addCircleMarkers(
    lng            = ~long,
    lat            = ~lat,
    clusterOptions = markerClusterOptions(),
    label          = ~paste("Hora:", hora, "| Fecha:", fecha)
  ) %>%
  addControl(html = "<h3>Mapa de Cierre de Vías</h3>", position = "topleft")

m_via_cerrada

Mapa de Calor — VÍA CERRADA

leaflet(via_cerrada) %>%
  addProviderTiles("OpenStreetMap") %>%
  addHeatmap(
    lng       = ~long,
    lat       = ~lat,
    intensity = ~hora,
    blur      = 20,
    max       = 0.08,
    radius    = 15
  ) %>%
  addLegend("bottomright",
            title  = "Mapa de Calor de Cierres de Vías",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Segmentación K-means y Análisis Espacial por Cluster — VÍA CERRADA

via_cerrada_cl <- analisis_kmeans_espacial(
  datos         = via_cerrada,
  nombre_evento = "VÍA CERRADA",
  k             = 3,     # <-- Ajusta según el gráfico del codo
  max_k         = 8,
  min_pts       = 5,
  margen        = 0.002,
  nx_grid       = 3,
  ny_grid       = 3
)

## 
## ── Evento: VÍA CERRADA | Puntos únicos: 5 ──

## 
##   Cluster 1 — n = 938

## 
##   Cluster 2 — n = 62

## 
##   Cluster 3 — n = 21

Mapa de Densidad Global — VÍA CERRADA

margen_vc <- 0.001
zona_vc   <- owin(
  xrange = c(min(via_cerrada$long) - margen_vc, max(via_cerrada$long) + margen_vc),
  yrange = c(min(via_cerrada$lat)  - margen_vc, max(via_cerrada$lat)  + margen_vc)
)

patron_vc <- ppp(x = via_cerrada$long, y = via_cerrada$lat, window = zona_vc)
im_vc     <- density(patron_vc, sigma = 0.01)
mapa_vc   <- rast(im_vc)
df_vc     <- as.data.frame(mapa_vc, xy = TRUE)
colnames(df_vc) <- c("long", "lat", "intensity")

df_vc$intensity <- (df_vc$intensity - min(df_vc$intensity)) /
                   (max(df_vc$intensity) - min(df_vc$intensity))

leaflet(df_vc) %>%
  addProviderTiles("OpenStreetMap") %>%
  addHeatmap(lng = ~long, lat = ~lat, intensity = ~intensity,
             blur = 20, max = 1, radius = 15) %>%
  addLegend("bottomright",
            title  = "Densidad de Cierres de Vías",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Análisis de Accidentes

Filtrado y Mapa Interactivo

Se analizan todos los eventos de tipo ACCIDENTE del periodo completo.

# ── Filtrar todos los eventos ACCIDENTE ───────────────────────────────────────
accidente <- Trama_Waze %>% filter(tipo_evento == "ACCIDENTE")
accidente  <- preparar_coords(accidente)

cat("Total de eventos ACCIDENTE:", nrow(accidente), "\n")

## Total de eventos ACCIDENTE: 122

cat("Rango de fechas:", as.character(min(accidente$fecha, na.rm = TRUE)),
    "→", as.character(max(accidente$fecha, na.rm = TRUE)), "\n")

## Rango de fechas: 2024-09-26 → 2024-09-28

# ── Mapa interactivo ───────────────────────────────────────────────────────────
m_accidente <- leaflet(accidente) %>%
  addTiles() %>%
  addCircleMarkers(
    lng            = ~long,
    lat            = ~lat,
    clusterOptions = markerClusterOptions(),
    label          = ~paste("Hora:", hora, "| Fecha:", fecha)
  ) %>%
  addControl(html = "<h3>Mapa de Accidentes</h3>", position = "topleft")

m_accidente

Mapa de Calor — ACCIDENTE

leaflet(accidente) %>%
  addProviderTiles("OpenStreetMap") %>%
  addHeatmap(
    lng       = ~long,
    lat       = ~lat,
    intensity = ~hora,
    blur      = 15,
    max       = 0.5,
    radius    = 10
  ) %>%
  addLegend("bottomright",
            title  = "Mapa de Calor de Accidentes",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Segmentación K-means y Análisis Espacial por Cluster — ACCIDENTE

accidente_cl <- analisis_kmeans_espacial(
  datos         = accidente,
  nombre_evento = "ACCIDENTE",
  k             = 3,     # <-- Ajusta según el gráfico del codo
  max_k         = 8,
  min_pts       = 5,
  margen        = 0.002,
  nx_grid       = 3,
  ny_grid       = 3
)

## 
## ── Evento: ACCIDENTE | Puntos únicos: 15 ──

## 
##   Cluster 1 — n = 37

## 
##   Cluster 2 — n = 33

## 
##   Cluster 3 — n = 52

Mapa de Densidad Global — ACCIDENTE

margen_ac <- 0.001
zona_ac   <- owin(
  xrange = c(min(accidente$long) - margen_ac, max(accidente$long) + margen_ac),
  yrange = c(min(accidente$lat)  - margen_ac, max(accidente$lat)  + margen_ac)
)

patron_ac <- ppp(x = accidente$long, y = accidente$lat, window = zona_ac)
im_ac     <- density(patron_ac)
mapa_ac   <- rast(im_ac)
df_ac     <- as.data.frame(mapa_ac, xy = TRUE)
colnames(df_ac) <- c("long", "lat", "intensity")

df_ac$intensity <- (df_ac$intensity - min(df_ac$intensity)) /
                   (max(df_ac$intensity) - min(df_ac$intensity))

leaflet(df_ac) %>%
  addProviderTiles("OpenStreetMap") %>%
  addHeatmap(lng = ~long, lat = ~lat, intensity = ~intensity,
             blur = 15, max = 0.5, radius = 10) %>%
  addLegend("bottomright",
            title  = "Densidad de Accidentes",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Análisis de Congestión

Filtrado y Mapa Interactivo

Se analizan todos los eventos de tipo CONGESTIÓN del periodo completo.

# ── Filtrar todos los eventos CONGESTIÓN ──────────────────────────────────────
congestion <- Trama_Waze %>% filter(tipo_evento == "CONGESTIÓN")
congestion  <- preparar_coords(congestion)

cat("Total de eventos CONGESTIÓN:", nrow(congestion), "\n")

## Total de eventos CONGESTIÓN: 3151

cat("Rango de fechas:", as.character(min(congestion$fecha, na.rm = TRUE)),
    "→", as.character(max(congestion$fecha, na.rm = TRUE)), "\n")

## Rango de fechas: 2024-09-26 → 2024-09-28

# ── Mapa interactivo ───────────────────────────────────────────────────────────
m_congestion <- leaflet(congestion) %>%
  addTiles() %>%
  addCircleMarkers(
    lng            = ~long,
    lat            = ~lat,
    clusterOptions = markerClusterOptions(),
    label          = ~paste("Hora:", hora, "| Fecha:", fecha)
  ) %>%
  addControl(html = "<h3>Mapa de Congestión</h3>", position = "topleft")

m_congestion

Mapa de Calor — CONGESTIÓN

leaflet(congestion) %>%
  addProviderTiles("OpenStreetMap") %>%
  addHeatmap(
    lng       = ~long,
    lat       = ~lat,
    intensity = ~hora,
    blur      = 35,
    max       = 0.08,
    radius    = 25
  ) %>%
  addLegend("bottomright",
            title  = "Mapa de Calor de Congestión",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Segmentación K-means y Análisis Espacial por Cluster — CONGESTIÓN

La congestión suele presentar patrones de agrupamiento muy marcados en corredores viales principales e intersecciones críticas. K-means permite identificar y analizar cada corredor de forma independiente.

congestion_cl <- analisis_kmeans_espacial(
  datos         = congestion,
  nombre_evento = "CONGESTIÓN",
  k             = 3,     # <-- Ajusta según el gráfico del codo
  max_k         = 8,
  min_pts       = 5,
  margen        = 0.002,
  nx_grid       = 3,
  ny_grid       = 3
)

## 
## ── Evento: CONGESTIÓN | Puntos únicos: 264 ──

## 
##   Cluster 1 — n = 718

## 
##   Cluster 2 — n = 854

## 
##   Cluster 3 — n = 1579

Mapa de Densidad Global — CONGESTIÓN

margen_cg <- 0.001
zona_cg   <- owin(
  xrange = c(min(congestion$long) - margen_cg, max(congestion$long) + margen_cg),
  yrange = c(min(congestion$lat)  - margen_cg, max(congestion$lat)  + margen_cg)
)

patron_cg <- ppp(x = congestion$long, y = congestion$lat, window = zona_cg)
im_cg     <- density(patron_cg)
mapa_cg   <- rast(im_cg)
df_cg     <- as.data.frame(mapa_cg, xy = TRUE)
colnames(df_cg) <- c("long", "lat", "intensity")

df_cg$intensity <- (df_cg$intensity - min(df_cg$intensity)) /
                   (max(df_cg$intensity) - min(df_cg$intensity))

leaflet(df_cg) %>%
  addProviderTiles("OpenStreetMap") %>%
  addHeatmap(lng = ~long, lat = ~lat, intensity = ~intensity,
             blur = 35, max = max(df_cg$intensity) * 2, radius = 25) %>%
  addLegend("bottomright",
            title  = "Densidad de Congestión",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Consolidación de Mapas

En esta última sección se consolidan los cuatro mapas interactivos en una vista sincronizada. Al desplazarse o hacer zoom en uno de los mapas, los demás se sincronizan, permitiendo comparar la distribución espacial de todos los tipos de eventos simultáneamente.

leafsync::sync(m_peligro, m_accidente, m_congestion, m_via_cerrada)

Conclusión

El análisis realizado sobre la totalidad de los datos de Waze, sin restricción de fecha, permite obtener una visión más completa y representativa de los patrones de movilidad urbana.

Ventajas del Enfoque K-means + Grids

La combinación de K-means con el análisis de cuadrantes resuelve un problema fundamental: cuando los eventos se concentran en pocas zonas de una ciudad extensa, una ventana global produce cuadrantes mayoritariamente vacíos. Al segmentar primero por clusters, cada análisis espacial opera sobre una ventana ajustada a donde realmente ocurren los eventos.

Puntos Clave

Distribución de Eventos: Los trancones y los peligros en las vías son los eventos más frecuentes, resaltando la necesidad de un enfoque coordinado en la gestión del tráfico.
Zonas Críticas por Cluster: Los mapas de cuadrantes por cluster muestran con mayor claridad la concentración local de eventos dentro de cada agrupamiento geográfico.
Congestión: Los clusters de congestión suelen corresponder a corredores viales principales, facilitando la priorización de intervenciones por corredor.
Riesgos y Cierres de Vías: Al estar muy localizados, estos eventos se benefician especialmente del enfoque por cluster, permitiendo un análisis detallado de cada foco.

Recomendaciones

Ajustar k por tipo de evento: El número óptimo de clusters puede diferir entre tipos de eventos. Usa el gráfico del codo de cada sección para elegir el k más adecuado.
Planificación de Rutas Alternativas: Crear rutas alternas y mejorar la señalización en los clusters de mayor congestión y cierres de vías.
Mejoras en la Infraestructura Vial: Priorizar intervenciones en los clusters con mayor concentración de accidentes y peligros.
Monitoreo Continuo: Integrar los datos de Waze en tiempo real en los sistemas de gestión de tráfico para una respuesta más rápida ante situaciones de emergencia.

Análisis realizado con R y la metodología CRISP-DM. Datos fuente: Waze — Trama Waze.xlsx

Informe Actividad 4 - AIGE CCLR

Pontificia universidad Javeriana Cali - 2026-I

Cindy Lugo

Marco Teórico

Introducción

Objetivo

Metodología CRISP-DM

Metodología

Carga de Datos y Librerías Necesarias

Análisis Temporal de los Eventos

Distribución de Eventos

Función Auxiliar: Análisis Espacial por Cluster (K-means)

Función Auxiliar: Preparación de Coordenadas

Análisis de Eventos PELIGRO

Filtrado y Mapa Interactivo

Mapa de Calor — PELIGRO

Segmentación K-means y Análisis Espacial por Cluster — PELIGRO

Mapa de Densidad Global — PELIGRO

Análisis de Cierres de Vías

Filtrado y Mapa Interactivo

Mapa de Calor — VÍA CERRADA

Segmentación K-means y Análisis Espacial por Cluster — VÍA CERRADA

Mapa de Densidad Global — VÍA CERRADA

Análisis de Accidentes

Filtrado y Mapa Interactivo

Mapa de Calor — ACCIDENTE

Segmentación K-means y Análisis Espacial por Cluster — ACCIDENTE

Mapa de Densidad Global — ACCIDENTE

Análisis de Congestión

Filtrado y Mapa Interactivo

Mapa de Calor — CONGESTIÓN

Segmentación K-means y Análisis Espacial por Cluster — CONGESTIÓN

Mapa de Densidad Global — CONGESTIÓN

Consolidación de Mapas

Conclusión

Ventajas del Enfoque K-means + Grids

Puntos Clave

Recomendaciones