Actividad 4

Convertimos la columna de fechas al formato adecuado

waze$fecha = as.Date(waze$creation_Date, format ="%Y-%m-%d %H:%M")

Verificamos los eventos que hay para asegurarnos de que no haya eventos mal escritos o nulos

eventos <- unique(waze$type)
eventos

## [1] "HAZARD"      "JAM"         "ACCIDENT"    "ROAD_CLOSED"

Se Cambian los nombres de los tipos de eventos a español

waze$tipo_evento <- recode(waze$type,
                                 "ACCIDENT" = "ACCIDENTE",
                                 "HAZARD" = "PELIGRO",
                                 "JAM" = "CONGESTIÓN",
                                 "ROAD_CLOSED" = "VÍA CERRADA")

Convertir la fecha y extraer la hora y el día

fecha_hora = ymd_hms(waze$creation_Date)
hora = hour(fecha_hora)
dia = day(fecha_hora)

Agregamos una columna llamada “hora” a los datos

waze$hora = hora

Tabla de frecuencia de tipos de eventos

table(waze$tipo_evento)

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

Mediante una gráfica de barras mostramos la frecuencia de cada tipo de evento en la data

frecuencia_eventos <- waze %>%
  group_by(tipo_evento) %>%                 # Agrupar por tipo de evento
  summarise(Frecuencia = n()) %>%     # Contar la frecuencia de cada tipo
  arrange(desc(Frecuencia))           # Ordenar por frecuencia descendente


ggplot(frecuencia_eventos, aes(x = tipo_evento, y = Frecuencia, fill = tipo_evento)) +
  geom_bar(stat = "identity") +
  theme_minimal() +
  labs(title = "Distribución de Tipos de Eventos en Trama Waze", 
       x = "Tipo de Evento", y = "Frecuencia") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +  # Rotar etiquetas para mejor visualización
  scale_fill_brewer(palette = "Set2")  # Utilizar una paleta de colores predefinida

Filtramos los eventos de “PELIGRO” del día 26:

pos <- which(waze$tipo_evento == "PELIGRO" & dia == 26)
peligro26 <- waze[pos,]
head(peligro26)

## # A tibble: 6 × 20
##      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                   
## # ℹ 15 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>, tipo_evento <chr>, hora <int>

Como las coordenadas vinenen mal formateadas desde el Excel se formatean mejor de la siguiente manera:

peligro26$lat <- peligro26$location_y / 10^(nchar(peligro26$location_y) - 1)
peligro26$long <- peligro26$location_x / 10^(nchar(peligro26$location_x) - 3)

Se filtran los eventos dentro del rango geográfico adecuado:

peligro26 <- peligro26[peligro26$lat > 4 & peligro26$lat < 5,]

Con leaflet se crea un mapa interactivo de los eventos “PELIGRO” filtrados para el día 26:

m26_peligro <- leaflet() %>%
  addTiles() %>%
  addCircleMarkers(lng = peligro26$long, lat = peligro26$lat,
                   clusterOptions = markerClusterOptions(),
                   label = peligro26$hora) %>%
  addControl(html = "<h3>Mapa de Riesgos</h3>", position = "topleft")

m26_peligro

peligro26 <- peligro26 %>%
  filter(lat > 4 & lat < 5, long > -75 & long < -73)  # Ajustar las coordenadas de interés

Con ayuda de Heatmap se puede mostrar en colores la gravedad del suceso:

leaflet(peligro26) %>%
  addProviderTiles("OpenStreetMap") %>%  # Añadir la capa base del mapa
  addHeatmap(
    lng = ~long, lat = ~lat,               # Especificar las columnas de longitud y latitud
    intensity = ~hora,                     # Intensidad opcional basada en la hora (o cualquier otra variable)
    blur = 20,                             # Nivel de desenfoque del mapa de calor
    max = 0.08,                            # Ajustar el valor máximo para la intensidad
    radius = 15                            # Radio de cada punto en el mapa de calor
  ) %>%
  addLegend("bottomright",                 # Añadir leyenda
            title = "Mapa de Calor de Riesgos",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Ahora filtramos por el evento “VÍA CERRADA” del día 26

pos <- which(waze$tipo_evento == "VÍA CERRADA" & dia == 26)
via_cerrada_26 <- waze[pos,]

Ajustamos otra vez las coordenadas de latitud y longitud

via_cerrada_26$lat <- via_cerrada_26$location_y / 10^(nchar(via_cerrada_26$location_y) - 1)
via_cerrada_26$long <- via_cerrada_26$location_x / 10^(nchar(via_cerrada_26$location_x) - 3)

Filtramos los eventos dentro del rango geográfico adecuado:

via_cerrada_26 <- via_cerrada_26[via_cerrada_26$lat > 4 & via_cerrada_26$lat < 5,]

Se crea con leaflet otro mapa que muestra los puntos de “VÍA CERRADA” del día 26:

m26_via_cerrada = leaflet(via_cerrada_26) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~long, lat = ~lat,
                   clusterOptions = markerClusterOptions(),
                   label = ~hora) %>%
  addControl(html = "<h3>Mapa de Cierre de Vías<h3>", position = "topleft")

m26_via_cerrada

Ahora se define una zona de interés para posicionar los puntos de via cerrada en los cuadrantes para estudiarlos:

zona <- owin(xrange = c(-74.04331, -73.9929), yrange = c(4.885736, 4.948562))

Se crea un patrón de puntos espaciales a partir de los eventos VÍA CERRADA:

patron_via_cerrada <- ppp(x = via_cerrada_26$long, y = via_cerrada_26$lat, window = zona)

## Warning: data contain duplicated points

Test de cuadrantes

plot(quadratcount(patron_via_cerrada), main = "Patrón de Puntos y Test de Cuadrantes")
points(patron_via_cerrada, col = "red")

Gráfico de K-Estimación

plot(Kest(patron_via_cerrada), main = "Función K-Estimación")

Aseguramos de de que el objeto patron_via_cerrada esté correctamente definido Se crea un patrón de puntos espaciales utilizando los datos correctos (via_cerrada_26)

zona <- owin(xrange = c(-74.04331, -73.9929), yrange = c(4.885736, 4.948562))
patron_via_cerrada <- ppp(x = via_cerrada_26$long, y = via_cerrada_26$lat, window = zona)

## Warning: data contain duplicated points

Densidad espacial en dicha area

im1 <- density(patron_via_cerrada, sigma = 0.01)  # Ajusta sigma según sea necesario

Se convierte la densidad a un objeto raster usando terra

mapa_via_cerrada <- rast(im1)

Se convierte el raster a data.frame para leaflet

df_via_cerrada <- as.data.frame(mapa_via_cerrada, xy = TRUE)
colnames(df_via_cerrada) <- c("long", "lat", "intensity")

Se normalizan los valores de intensidad entre 0 y 1

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

Se crea un mapa interactivo usando leaflet con mapa de calor

leaflet(df_via_cerrada) %>%
  addProviderTiles("OpenStreetMap") %>%  # Añadir la capa base
  addHeatmap(
    lng = ~long, lat = ~lat,              # Coordenadas de longitud y latitud
    intensity = ~intensity,               # Intensidad normalizada
    blur = 20,                            # Nivel de desenfoque
    max = 1,                              # Valor máximo de la intensidad normalizada
    radius = 15                           # Radio para reflejar la densidad
  ) %>%
  addLegend("bottomright",                # Añadir la leyenda
            title = "Mapa de Calor de Cierres de Vías",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Ahora filtramos los eventos “ACCIDENTE” del día 26

pos <- which(waze$tipo_evento == "ACCIDENTE" & dia == 26)
accidente_26 <- waze[pos,]

Se ajustan nuevamente las coordenadas de latitud y longitud

accidente_26$lat <- accidente_26$location_y / 10^(nchar(accidente_26$location_y) - 1)
accidente_26$long <- accidente_26$location_x / 10^(nchar(accidente_26$location_x) - 3)

Se filtran los eventos dentro del rango geográfico adecuado

accidente_26 <- accidente_26[accidente_26$lat > 4 & accidente_26$lat < 5,]

Se crea el mapa interactivo con leaflet:

m26_accidente <- leaflet(accidente_26) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~long, lat = ~lat,
                   clusterOptions = markerClusterOptions(),
                   label = ~hora) %>%
  addControl(html = "<h3>Mapa de Accidentes</h3>", position = "topleft")

m26_accidente

Se define la zona de interés:

zona = owin(xrange = c(-74.04331, -73.9929), yrange = c(4.885736, 4.948562))
# Crear un patrón de puntos espaciales a partir de los eventos ACCIDENTE
patron_accidente = ppp(x = accidente_26$long, y = accidente_26$lat, window = zona)

## Warning: data contain duplicated points

# Gráfico combinado: Test de Cuadrantes y Patrón de Puntos
par(mfrow = c(1, 1))  # Asegurarse de que solo haya una gráfica
# Graficar el test de cuadrantes
plot(quadratcount(patron_accidente), main = "Patrón de Puntos y Test de Cuadrantes")
# Superponer los puntos sobre los cuadrantes
points(patron_accidente, col = "red" )

Cálculo de la función K-estimación

plot(Kest(patron_accidente))

Aseguramos que el objeto patron “ACCIDENTE” esté correctamente definido Se Usan las coordenadas correctas de los accidentes:

zona <- owin(xrange = c(-74.04331, -73.9929), yrange = c(4.885736, 4.948562))
patron_accidente <- ppp(x = accidente_26$long, y = accidente_26$lat, window = zona)

## Warning: data contain duplicated points

Cálculo de la densidad espacial:

im1 <- density(patron_accidente)

Se convierte la densidad a un objeto raster usando terra:

mapa_accidente <- rast(im1)

Converción del raster a data.frame para leaflet

df_accidente <- as.data.frame(mapa_accidente, xy = TRUE)
colnames(df_accidente) <- c("long", "lat", "intensity")

Se normalizan los valores de intensidad entre 0 y 1

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

Creación mapa interactivo usando leaflet con mapa de calor:

leaflet(df_accidente) %>%
  addProviderTiles("OpenStreetMap") %>%  # Añadir la capa base
  addHeatmap(
    lng = ~long, lat = ~lat,              # Coordenadas de longitud y latitud
    intensity = ~intensity,               # Intensidad normalizada
    blur = 15,                            # Nivel de desenfoque
    max = 0.5,                              # Valor máximo de la intensidad normalizada
    radius = 10                           # Ajustar el radio de los puntos
  ) %>%
  addLegend("bottomright",                # Añadir la leyenda para interpretar el mapa de calor
            title = "Mapa de Calor de Accidentes",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Ahora Filtramos los eventos “CONGESTION” del día 26:

pos <- which(waze$tipo_evento == "CONGESTIÓN" & dia == 26)
congestion_26 <- waze[pos,]

Ajuste de las coordenadas de latitud y longitud

congestion_26$lat <- congestion_26$location_y / 10^(nchar(congestion_26$location_y) - 1)
congestion_26$long <- congestion_26$location_x / 10^(nchar(congestion_26$location_x) - 3)

Se Filtran eventos dentro del rango geográfico adecuado

congestion_26 <- congestion_26[congestion_26$lat > 4 & congestion_26$lat < 5,]

Creación del mapa interactivo

m26_congestion <- leaflet(congestion_26) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~long, lat = ~lat,
                   clusterOptions = markerClusterOptions(),
                   label = ~hora) %>%
  addControl(html = "<h3>Mapa de Congestión</h3>", position = "topleft")

m26_congestion

Zonas de interés con coordenadas:

zona <- owin(xrange = c(-74.04331, -73.9929), yrange = c(4.885736, 4.948562))
# Crear un patrón de puntos espaciales a partir de los eventos CONGESTIÓN
patron_congestion <- ppp(x = congestion_26$long, y = congestion_26$lat, window = zona)

## Warning: data contain duplicated points

# Visualizar el patrón de puntos
par(mfrow = c(1, 1))  # Asegurarse de que solo haya una gráfica
# Graficar el test de cuadrantes
plot(quadratcount(patron_congestion), main = "Patrón de Puntos y Test de Cuadrantes")
# Superponer los puntos sobre los cuadrantes
points(patron_congestion, col = "red")

Cálculo de la función K-estimación

plot(Kest(patron_congestion))

Se define el patrón de puntos:

zona <- owin(xrange = c(-74.04331, -73.9929), yrange = c(4.885736, 4.948562))
patron_congestion <- ppp(x = congestion_26$long, y = congestion_26$lat, window = zona)

## Warning: data contain duplicated points

Cálculo de la densidad espacial del patrón de puntos:

im1 <- density(patron_congestion)

Conversión de la densidad en un raster utilizando terra

mapa_congestion <- rast(im1)

Se convierte el objeto raster a un data.frame para usarlo en leaflet:

df_congestion <- as.data.frame(mapa_congestion, xy = TRUE)
colnames(df_congestion) <- c("long", "lat", "intensity")

Normalización de los valores de intensidad entre 0 y 1

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

Mapa interactivo de calor usando leaflet

leaflet(df_congestion) %>%
  addProviderTiles("OpenStreetMap") %>%  # Añadir la capa base
  addHeatmap(
    lng = ~long, lat = ~lat,              # Coordenadas de longitud y latitud
    intensity = ~intensity,               # Intensidad normalizada
    blur = 35,                            # Incrementar el desenfoque para suavizar el mapa
    max = max(df_congestion$intensity) * 2,  # Ajustar el valor máximo de intensidad
    radius = 25                           # Aumentar el radio para que se vea más suave
  ) %>%
  addLegend("bottomright",                # Añadir la leyenda para interpretar el mapa de calor
            title = "Mapa de Calor de Congestión",
            colors = c("blue", "green", "yellow", "red"),
            labels = c("Bajo", "Moderado", "Alto", "Muy Alto"))

Finalmente sincronización los mapas interactivos de distintos tipos de eventos:

leafsync::sync(m26_peligro, m26_accidente, m26_congestion, m26_via_cerrada)