Análisis multitemporal de siniestros viales en Bogotá - Colombia
Daniel Tobalina
2025
Especialización en Big Data e Inteligencia Territorial - FLACSO, Argentina.
Ciudad: Bogotá, Colombia
Fuente de datos: https://datosabiertos.bogota.gov.co/
CONSIGNA: PARTE 1
- Abrir en este RMarkdown el dataset siniestros_viales.csv que corresponde a los siniestros viales registrados en Bogotá por la Secretaría Distrital de Movilidad durante el año 2020.
siniestros <- read.csv("data/siniestros_viales.csv",
stringsAsFactors = TRUE)- Realizar las funciones necesarias para poder manipular con lubridate la columna de fecha.
Paso 1.- Activar las librerias que vamos a usar.
library(tidyverse)
library(lubridate)
library(sf)
library(ggmap) Paso 2.- Modificamos la variable fecha.
Pasamos de factor a date.
#Cambiamos la estructura de fecha
siniestros <- siniestros |>
mutate(FECHA = ymd(FECHA))
#Revisamos el cambio
str(siniestros$FECHA)## Date[1:22411], format: "2020-11-19" "2020-11-10" "2020-08-03" "2020-11-23" "2020-09-14" ...- Agregar 3 nuevas columnas que contengan mes, año y día de la semana.
siniestros <- siniestros |>
mutate( mes = month(FECHA, label = TRUE, abbr = FALSE, locale = "es_ES.UTF-8"),
year = year(FECHA),
dia = wday(FECHA, label = TRUE, abbr = FALSE, locale = "es_ES.UTF-8"))Pasamos de 9 variables a 12 agregando las 3 columnas adicionales.
- Análisis temporal: Utilizar ggplot() para realizar al menos 1 gráfico que permita analizar la temporalidad de los datos. ¿Detectan algún patrón temporal? ¿A qué puede deberse?
ANALISIS MENSUAL
#Reviso la distribucion de los siniestros
summary(siniestros)## CODIGO_ACC FECHA HORA GRAVEDAD
## Min. :10507453 Min. :2020-01-01 13:30:00: 236 CON HERIDOS: 8438
## 1st Qu.:10513187 1st Qu.:2020-03-05 13:00:00: 225 CON MUERTOS: 370
## Median :10519082 Median :2020-07-18 17:00:00: 207 SOLO DANOS :13603
## Mean :10519073 Mean :2020-07-06 15:00:00: 203
## 3rd Qu.:10524891 3rd Qu.:2020-10-19 15:30:00: 202
## Max. :10537008 Max. :2020-12-31 14:30:00: 201
## (Other) :21137
## CLASE_ACC LOCALIDAD
## ATROPELLO : 1866 KENNEDY : 2762
## CAIDA DE OCUPANTE: 392 ENGATIVA : 2132
## CHOQUE :19649 SUBA : 2057
## INCENDIO : 4 USAQUEN : 1897
## OTRO : 79 PUENTE ARANDA: 1773
## VOLCAMIENTO : 421 FONTIBON : 1706
## (Other) :10084
## DIRECCION LONGITUD LATITUD
## KR 80-CL 2 51 : 34 Min. :-74.21 Min. :4.455
## CL 13-KR 72 02 : 29 1st Qu.:-74.14 1st Qu.:4.600
## CL 80-KR 72 02 : 21 Median :-74.11 Median :4.635
## KR 3-CL 91 E 02 : 21 Mean :-74.11 Mean :4.643
## KR 30-CL 26 02 : 21 3rd Qu.:-74.08 3rd Qu.:4.687
## AV AVENIDA BOYACA-KR 24 02: 20 Max. :-74.02 Max. :4.828
## (Other) :22265
## mes year dia
## febrero :2795 Min. :2020 domingo :2318
## diciembre :2361 1st Qu.:2020 lunes :2969
## noviembre :2301 Median :2020 martes :3396
## enero :2284 Mean :2020 miércoles:3357
## octubre :2264 3rd Qu.:2020 jueves :3293
## septiembre:2022 Max. :2020 viernes :3614
## (Other) :8384 sábado :3464#Grafico de barra mensual.
ggplot() +
geom_bar(data = siniestros, aes(x = mes, fill = str_to_title(CLASE_ACC)), position = "dodge") +
labs(title = "Evolución mensual de hechos de tránsito",
subtitle = "Ciudad de Bogotá - 2020",
fill = "Tipo",
x = "Mes",
y = "Cantidad") +
scale_fill_manual(values = c("#f94144", "#f8961e", "#f9c74f", "#43aa8b", "#577590", "#277da1")) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 13),
axis.title.x = element_text(face = "bold"),
axis.title.y = element_text(face = "bold"))
Podemos ver que Choque, es el accidente que más predomina en todo el año. Se teniendo valores mínimo en abril y valores máximos en febrero, seguido de diciembre. También Atropello es el segundo más representativo durante el año, alcanzando valores mínimos en abril y máximos en febrero y enero.
Vamos a realizar el análisis diario de forma general primero. Es decir, incluyendo todos los eventos sin separarlo por tipoligía.
ANALISIS DIARIO
#Agrupamos los datos de forma diaria
siniestros_dia <- siniestros |>
group_by(FECHA) |>
summarise(cantidad = n())
#Vemos la media de los eventos para usarlo en el gráfico
summary(siniestros_dia)## FECHA cantidad
## Min. :2020-01-01 Min. : 3.00
## 1st Qu.:2020-04-01 1st Qu.: 42.00
## Median :2020-07-01 Median : 62.00
## Mean :2020-07-01 Mean : 61.23
## 3rd Qu.:2020-09-30 3rd Qu.: 80.00
## Max. :2020-12-31 Max. :134.00#Grafico lineal diario con el valor de la media.
ggplot() +
geom_line(data = siniestros_dia, aes(x = FECHA, y = cantidad)) +
geom_hline(yintercept = 61.23, color = "red") +
labs(title = "Evolución diaria de hechos de tránsito",
subtitle = "Ciudad de Bogotá - 2020",
x = "Dia",
y = "Cantidad") +
theme_bw() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 13),
axis.title.x = element_text(face = "bold"),
axis.title.y = element_text(face = "bold"))
Se evalua por tipo de evento diario para identificar un patrón diferente en los datos.
ggplot() +
geom_line(data = siniestros |>
group_by(FECHA, CLASE_ACC) |>
summarise(Cantidad = n()),
aes(x = FECHA, y = Cantidad, color = str_to_title(CLASE_ACC))) +
labs(title = "Evolución diaria de hechos de tránsito por tipologia",
subtitle = "Ciudad de Bogotá - 2020 ",
x = "Día",
y = "Cantidad",
color = "Tipo") +
scale_color_manual (values = c("#f94144", "#f8961e", "#f9c74f", "#43aa8b", "#577590", "#277da1")) +
scale_x_date(date_breaks = "1 month", date_labels = "%d-%m") +
theme(legend.position="bottom",
legend.justification = "center",
title=element_text(size=10, face = "bold"),
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 13),
legend.text=element_text(size=7),
axis.title.x = element_text(size = 8),
axis.title.y = element_text(size = 8),
axis.text.y = element_text(size = 7),
axis.text.x = element_text(size = 7, angle = 90),
plot.caption=element_text(face = "italic", colour = "gray35",size=7))
Aquí ya se puede observar que lo que vimo en el gráfico inicial de barra sobre el evento Choque es el que más se dio durante el año 2020, aunque haya tenido una disminución significativa en el mes de abril.
También podemos notar que los otros eventos aparecen en menores cantidades.
Por último graficamos con un face_wrap para ver mes y día
#Grafica por mes y dia de la semana y por tipo de evento
siniestros_dia_tipo <- siniestros |>
group_by(mes, dia, CLASE_ACC) |>
summarise(cantidad = n())
ggplot() +
geom_bar(data = siniestros, aes(x = dia, fill=str_to_title(CLASE_ACC))) +
labs(title = "Cantidad de hechos de tránsito por día y tipo",
subtitle = "Ciudad de Bogotá - 2020",
fill = "Tipo",
x = "Día de la semana",
y = "Cantidad") +
scale_fill_manual(values = c("#f94144", "#f8961e", "#f9c74f", "#43aa8b", "#577590", "#277da1")) +
facet_wrap(~mes, ncol= 4) +
theme_minimal() +
theme(axis.text.x = element_text(size = 7, angle = 90),
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 13))
CONSIGNA: PARTE 2
- Descargar un mapa base que nos ayude a contextualizar la ubicación de los datos.
#Creamos un bounding box
siniestros_bbox <- make_bbox(siniestros$LONGITUD, siniestros$LATITUD)
#Creamos el mapa base
mapa_base <- get_stadiamap(bbox = siniestros_bbox,
maptype = "stamen_terrain",
zoom = 11)
#Graficamos el mapa anterior usando tambien GGMAP y tipo de evento
ggmap(mapa_base) +
geom_point( data = siniestros, aes(x = LONGITUD, y = LATITUD, color = CLASE_ACC),
alpha = 0.6, size = 0.8) +
labs(title = "Cantidad de hechos de tránsito",
subtitle = "Ciudad de Bogotá - 2020",
color = "Tipología",
x = "",
y = "",
) +
facet_wrap(~CLASE_ACC) +
theme_bw() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 13),
axis.text = element_blank(), # Quitar los números de los ejes
axis.ticks = element_blank(), # Quitar las líneas de ticks
panel.grid = element_blank() # Quitar líneas de la grilla si quieres aún más limpieza
)
- Análisis Espacial: Analizar la distribución espacial de los datos a partir de al menos 1 mapa de densidad que muestre donde se concentran la mayor cantidad de hechos de tránsito.
Revisamos los hechos de tránsito por concentración general
ggmap(mapa_base) +
stat_density2d(
data = siniestros,
aes(x = LONGITUD, y = LATITUD, fill = after_stat(level)),
geom = "polygon",
alpha = 0.75,
show.legend = TRUE
) +
labs(
title="Densidad de hechos de tránsito general",
subtitle = "Ciudad de Bogotá - 2020"
) +
scale_fill_distiller(palette = "Spectral", direction = -1) +
theme_void() +
theme(,
plot.title = element_text(hjust = 0.5, size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 12)
)
Los separamos por tipología
#Concentración de hechos de transito por tipología
ggmap(mapa_base) +
stat_density2d(
data = siniestros,
aes(x = LONGITUD, y = LATITUD, fill = after_stat(level)),
geom = "polygon",
alpha = 0.75,
show.legend = TRUE
) +
labs(
title="Densidad de hechos de tránsito por tipologia",
subtitle = "Ciudad de Bogotá - 2020"
) +
scale_fill_distiller(palette = "Spectral", direction = -1) +
facet_wrap(~CLASE_ACC, ncol = 3) +
theme_void() +
theme(,
plot.title = element_text(hjust = 0.5, size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 12)
)
Vemos que la mayoría de los hechos de tránsito abarcan casi toda la ciudad, menos Incendio.
- Análisis espacial y temporal: Comparar la densidad de los datos en el tiempo (facetar). ¿Los patrones espaciales de los datos elegidos se mantienen o varían en el tiempo?
#Mapa de densidad de kernel por mes con bandwidth de 8.8km
ggmap(mapa_base) +
stat_density2d(
data = siniestros,
aes(x = LONGITUD, y = LATITUD, fill = after_stat(level)),
geom = "polygon",
alpha = 0.75,
show.legend = TRUE
) +
labs(
title = "Densidad de hechos de tránsito mensual",
subtitle = " Ciudad de Bogotá - 2020"
) +
scale_fill_distiller(palette = "Spectral", direction = -1) +
facet_wrap(~mes, ncol = 4) +
theme_void() +
theme(,
plot.title = element_text(hjust = 0.5, size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 12)
)
Podemos ver que la concentración de hechos de tránsito por mes varia de de ubicación y dirección. Podemos apreciar que el mes de Agosto, noviembre y diciembre fueron los meses con mayor concentración de incidentes. Siendo junio y enero los de menor incidencia.
Veamos como se distribuyen diariamente.
ggmap(mapa_base) +
stat_density2d(
data = siniestros,
aes(x = LONGITUD, y = LATITUD, fill = after_stat(level)),
geom = "polygon",
alpha = 0.75,
show.legend = TRUE
) +
labs(
title = "Densidad de hechos de tránsito diario",
subtitle = " Ciudad de Bogotá - 2020"
) +
scale_fill_distiller(palette = "Spectral", direction = -1) +
facet_wrap(~dia, ncol = 4) +
theme_void() +
theme(,
plot.title = element_text(hjust = 0.5, size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 12)
)
Para darle movimiento al mapa de densidad para ver su distribución dinámica en el tiempo usamos un mapa dinámico.
#Activamos libreria gganimate para formar la transición
library(gganimate)Corremos el código para la animación.
#Para crear el mapa de kernel animado por mes
mapa_animado_2024 <- ggmap(mapa_base) +
stat_density2d(
data = siniestros,
aes(x = LONGITUD, y = LATITUD, fill = after_stat(level)),
geom = "polygon",
alpha = 0.5,
show.legend = TRUE
) +
theme_void() +
scale_fill_distiller(palette = "Spectral") +
labs(title = "Densidad de hechos de tránsito mensual",
subtitle = "Bogota - 2020 | Mes: {closest_state}") +
theme(
plot.title = element_text(hjust = 0.5, size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 12)) +
transition_states(mes)
#Activamos la animacion
animate(mapa_animado_2024, duration = 30, fps = 10)# 30 segundos totales, con 10 cuadros/segundo
Si queremos guardar el mapa dinámico podemos usar:
#Permite guardar la animacion en formato gif
#anim_save("mapa_animado_2024.gif", animation = last_animation())