El presente informe examina una base de datos de comparendos de tránsito, con el propósito de comprender su estructura, características principales y algunos patrones relevantes en el comportamiento de las infracciones. El estudio se desarrolla bajo un enfoque descriptivo y exploratorio, permitiendo que los datos hablen con claridad propia y dejen ver sus tendencias internas.
Este documento está construido en un entorno reproducible utilizando RStudio y un proyecto estructurado, lo que garantiza que pueda abrirse sin contratiempos en otros equipos. Se emplean varias librerías especializadas, cada una aportando capacidades particulares para la lectura, ordenamiento, análisis y visualización de la información.
El objetivo de este informe es realizar una caracterización general de los comparendos de tránsito contenidos en la base de datos. Se busca identificar las variables más relevantes, su distribución, el tipo de infracciones más frecuentes, el perfil demográfico de las personas sancionadas y otros comportamientos derivados del conjunto de datos. Todo ello permitirá obtener una comprensión clara y fundamentada del fenómeno observado.
Para garantizar un análisis ordenado, limpio y reproducible, se utilizaron las siguientes librerías:
tidyverse: Conjunto esencial para manipulación avanzada de datos y visualización.
dplyr: Herramientas para filtrar, ordenar, seleccionar columnas y transformar datos.
tidyr: Funciones para reorganizar y limpiar estructuras tabulares.
readr: Lectura eficiente de archivos de texto.
readxl: Importación directa de archivos Excel sin necesidad de software adicional.
here: Administración segura de rutas internas del proyecto.
kableExtra: Mejora la presentación de tablas para informes profesionales.
knitr: Motor encargado de renderizar el documento con control del formato y ejecución de código.
La base de datos analizada proviene del archivo
BSCOMPARENDOS.xlsx y contiene información estructurada
sobre comparendos realizados por autoridades de tránsito. Cada fila
representa un registro individual con características como sexo del
infractor, tipo de vehículo, fecha del comparendo, tipo de infracción,
entre otras variables esenciales para el análisis.
A
continuación, se presentan detalles técnicos sobre la estructura del
conjunto de datos, incluyendo número de observaciones, columnas
disponibles y el tipo de cada una.
names(BD_COMPARENDOS)
## [1] "No. MANDAMIENTO DE PAGO" "FECHA MANDAMIENTO DE PAGO"
## [3] "EJECUTADO" "TIPO DE IDENTIFICACION"
## [5] "No. IDENTIFICACION" "SEXO"
## [7] "COD. INFRACCION" "COMPARENDO"
## [9] "FECHA DE COMPARENDO" "FECHA"
## [11] "AÑO" "DIA"
## [13] "MES" "NOMBRE DEL MES"
## [15] "PACA DE VEHICULO" "TIPO DE VEHICULO"
## [17] "VALOR A PAGAR REAL"
Número de registros: 2,120 comparendos
Número de variables: 17 columnas
summary(BD_COMPARENDOS)
## No. MANDAMIENTO DE PAGO FECHA MANDAMIENTO DE PAGO EJECUTADO
## Length:2120 Length:2120 Length:2120
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## TIPO DE IDENTIFICACION No. IDENTIFICACION SEXO COD. INFRACCION
## Length:2120 Min. :2.358e+05 Length:2120 Min. :64.00
## Class :character 1st Qu.:3.273e+07 Class :character 1st Qu.:64.00
## Mode :character Median :7.214e+07 Mode :character Median :64.00
## Mean :8.476e+08 Mean :66.53
## 3rd Qu.:8.002e+08 3rd Qu.:64.00
## Max. :9.003e+09 Max. :77.00
## COMPARENDO FECHA DE COMPARENDO FECHA
## Length:2120 Min. :2010-04-12 00:00:00 Min. :2010-05-04 00:00:00
## Class :character 1st Qu.:2010-04-27 00:00:00 1st Qu.:2011-10-15 18:00:00
## Mode :character Median :2010-05-06 00:00:00 Median :2013-03-28 12:00:00
## Mean :2010-05-05 16:27:37 Mean :2013-03-28 12:00:00
## 3rd Qu.:2010-05-16 00:00:00 3rd Qu.:2014-09-09 06:00:00
## Max. :2010-05-27 00:00:00 Max. :2016-02-21 00:00:00
## AÑO DIA MES NOMBRE DEL MES
## Min. :2010 Min. : 1.00 Min. :4.000 Length:2120
## 1st Qu.:2010 1st Qu.: 9.00 1st Qu.:4.000 Class :character
## Median :2010 Median :16.00 Median :5.000 Mode :character
## Mean :2010 Mean :15.76 Mean :4.664
## 3rd Qu.:2010 3rd Qu.:23.00 3rd Qu.:5.000
## Max. :2010 Max. :30.00 Max. :5.000
## PACA DE VEHICULO TIPO DE VEHICULO VALOR A PAGAR REAL
## Length:2120 Length:2120 Min. :257500
## Class :character Class :character 1st Qu.:257500
## Mode :character Mode :character Median :257500
## Mean :304749
## 3rd Qu.:257500
## Max. :515000
library(kableExtra)
BD_COMPARENDOS %>%
head(10) %>%
kbl(
caption = "MUESTRA: Primeras 10 filas de la base de datos de comparendos",
align = "c"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = TRUE,
font_size = 13
) %>%
row_spec(0, background = "#FF6B6B", color = "white", bold = TRUE) %>% # ROJO CLARO
scroll_box(width = "100%", height = "450px", extra_css = "border: 2px solid #FF6B6B;")
| No. MANDAMIENTO DE PAGO | FECHA MANDAMIENTO DE PAGO | EJECUTADO | TIPO DE IDENTIFICACION | No. IDENTIFICACION | SEXO | COD. INFRACCION | COMPARENDO | FECHA DE COMPARENDO | FECHA | AÑO | DIA | MES | NOMBRE DEL MES | PACA DE VEHICULO | TIPO DE VEHICULO | VALOR A PAGAR REAL |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| F00002658 | 19/08/2010 | RAMIRO ANTONIO PEREZ HERRERA | Cedula de Ciudadanía | 72127412 | HOMBRE | 67 | F00007946 | 2010-05-04 | 2010-05-04 | 2010 | 4 | 5 | Mayo | QHO294 | CARRO | 257500 |
| F00004304 | 19/08/2010 | TRANSPORTES MST Y CIA S. EN C | Nit | 9001288484 | EMPRESA | 64 | F0000469 | 2010-04-13 | 2010-05-05 | 2010 | 13 | 4 | Abril | UYU967 | CARRO | 257500 |
| F00001544 | 19/08/2010 | NANCY ANGELICA GARCIA DUARTE | Cedula de Ciudadanía | 22692743 | MUJER | 64 | F0000925 | 2010-04-15 | 2010-05-06 | 2010 | 15 | 4 | Abril | UYZ604 | CARRO | 257500 |
| F00001578 | 19/08/2010 | FILOMENA DEL SOCORRO MARTINEZ ROMERO | Cedula de Ciudadanía | 23179461 | MUJER | 64 | F0000160 | 2010-04-12 | 2010-05-07 | 2010 | 12 | 4 | Abril | EDN17B | MOTO | 257500 |
| F00001372 | 19/08/2010 | SHENYS PAOLA RICO OSPINO | Cedula de Ciudadanía | 22516592 | MUJER | 64 | F00004537 | 2010-04-26 | 2010-05-08 | 2010 | 26 | 4 | Abril | BXF75A | MOTO | 257500 |
| F00001401 | 19/08/2010 | LISBETH MARTINEZ SARMIENTO | Cedula de Ciudadanía | 22533914 | MUJER | 64 | F00005427 | 2010-04-30 | 2010-05-09 | 2010 | 30 | 4 | Abril | BVZ71A | MOTO | 257500 |
| F00001473 | 19/08/2010 | MERY DEL CARMEN PACHECO SERRANO | Cedula de Ciudadanía | 22615434 | MUJER | 64 | F00014363 | 2010-05-23 | 2010-05-10 | 2010 | 23 | 5 | Mayo | BWX93A | MOTO | 257500 |
| F00002953 | 19/08/2010 | MIGUEL HERNANDO GARAY CALLE | Cedula de Ciudadanía | 72222136 | HOMBRE | 76 | F00000693 | 2010-04-14 | 2010-05-11 | 2010 | 14 | 4 | Abril | BSB95A | MOTO | 515000 |
| F00003518 | 19/08/2010 | COOTRANSCO LTDA | Nit | 800161062 | EMPRESA | 77 | F00014863 | 2010-05-24 | 2010-05-12 | 2010 | 24 | 5 | Mayo | UYN964 | CARRO | 515000 |
| F00003542 | 19/08/2010 | COOTRAB | Nit | 800222724 | EMPRESA | 77 | F00001740 | 2010-04-18 | 2010-05-13 | 2010 | 18 | 4 | Abril | UYM220 | CARRO | 515000 |
# Mostrar tabla completa con estilo Bootstrap
# Resumen estadístico de variables numéricas
library(kableExtra)
BD_COMPARENDOS %>%
select(where(is.numeric)) %>%
summary() %>%
kbl(
caption = "Resumen estadístico de las variables numéricas",
align = "c"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = TRUE,
font_size = 13
) %>%
row_spec(0, background = "#FF6B6B", color = "white", bold = TRUE) # ROJO CLARO
| No. IDENTIFICACION | COD. INFRACCION | AÑO | DIA | MES | VALOR A PAGAR REAL | |
|---|---|---|---|---|---|---|
| Min. :2.358e+05 | Min. :64.00 | Min. :2010 | Min. : 1.00 | Min. :4.000 | Min. :257500 | |
| 1st Qu.:3.273e+07 | 1st Qu.:64.00 | 1st Qu.:2010 | 1st Qu.: 9.00 | 1st Qu.:4.000 | 1st Qu.:257500 | |
| Median :7.214e+07 | Median :64.00 | Median :2010 | Median :16.00 | Median :5.000 | Median :257500 | |
| Mean :8.476e+08 | Mean :66.53 | Mean :2010 | Mean :15.76 | Mean :4.664 | Mean :304749 | |
| 3rd Qu.:8.002e+08 | 3rd Qu.:64.00 | 3rd Qu.:2010 | 3rd Qu.:23.00 | 3rd Qu.:5.000 | 3rd Qu.:257500 | |
| Max. :9.003e+09 | Max. :77.00 | Max. :2010 | Max. :30.00 | Max. :5.000 | Max. :515000 |
conteo_sexo <- as.data.frame(table(BD_COMPARENDOS$SEXO))
names(conteo_sexo) <- c("Género", "Cantidad")
conteo_sexo %>%
kbl(
caption = "Conteo de comparendos por género",
align = "c"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
font_size = 13
) %>%
row_spec(0, background = "#FF6B6B", color = "white", bold = TRUE) # ROJO CLARO
| Género | Cantidad |
|---|---|
| CÉDULA NUEVA | 88 |
| EMPRESA | 472 |
| HOMBRE | 615 |
| MUJER | 945 |
conteo_vehiculo <- as.data.frame(table(BD_COMPARENDOS$`TIPO DE VEHICULO`))
names(conteo_vehiculo) <- c("Tipo de Vehículo", "Cantidad")
conteo_vehiculo %>%
kbl(
caption = "Conteo de comparendos por tipo de vehículo",
align = "c"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
font_size = 13
) %>%
row_spec(0, background = "#FF6B6B", color = "white", bold = TRUE) # ROJO CLARO
| Tipo de Vehículo | Cantidad |
|---|---|
| CARRO | 1938 |
| MOTO | 182 |
total_valor_a_pagar <- sum(BD_COMPARENDOS$`VALOR A PAGAR REAL`)
valor_table <- data.frame(
Descripción = "Valor Total a Pagar REAL",
Valor = paste("$", format(total_valor_a_pagar, big.mark = ",", scientific = FALSE))
)
valor_table %>%
kbl(
caption = "Valor total recaudado por comparendos",
align = "c"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
font_size = 13
) %>%
row_spec(0, background = "#FF6B6B", color = "white", bold = TRUE) # ROJO CLARO
| Descripción | Valor |
|---|---|
| Valor Total a Pagar REAL | $ 646,067,500 |
library(ggplot2)
library(dplyr)
comparendos_genero <- BD_COMPARENDOS %>%
filter(SEXO %in% c("HOMBRE", "MUJER")) %>%
count(SEXO) %>%
mutate(
porcentaje = n / sum(n) * 100,
etiqueta = paste0(round(porcentaje, 1), "%")
)
ggplot(comparendos_genero, aes(x = "", y = n, fill = SEXO)) +
geom_bar(stat = "identity", width = 1, alpha = 0.9) +
coord_polar("y", start = 0) +
geom_text(aes(label = etiqueta),
position = position_stack(vjust = 0.5),
size = 5,
color = "white",
fontface = "bold") +
labs(
title = "Distribución de comparendos por género",
x = NULL,
y = NULL,
fill = "Género"
) +
theme_minimal() +
scale_fill_manual(values = c("#FF6B6B", "#4ECDC4")) +
theme(
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"),
legend.position = "bottom"
)
comparendos_vehiculo <- BD_COMPARENDOS %>%
count(`TIPO DE VEHICULO`) %>%
mutate(
porcentaje = n / sum(n) * 100,
etiqueta = paste0(round(porcentaje, 1), "%")
)
ggplot(comparendos_vehiculo, aes(x = "", y = n, fill = `TIPO DE VEHICULO`)) +
geom_bar(stat = "identity", width = 1, alpha = 0.9) +
coord_polar("y", start = 0) +
geom_text(aes(label = etiqueta),
position = position_stack(vjust = 0.5),
size = 4,
color = "white",
fontface = "bold") +
labs(
title = "Distribución de comparendos por tipo de vehículo",
x = NULL,
y = NULL,
fill = "Tipo de Vehículo"
) +
theme_minimal() +
scale_fill_manual(values = c("#FF6B6B", "#4ECDC4", "#45B7D1", "#96CEB4", "#FECA57", "#FF9FF3")) +
theme(
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"),
legend.position = "bottom"
)
recaudacion_infraccion <- BD_COMPARENDOS %>%
group_by(`COD. INFRACCION`) %>%
summarise(Total_Recaudado = sum(`VALOR A PAGAR REAL`, na.rm = TRUE)) %>%
mutate(`COD. INFRACCION` = as.factor(`COD. INFRACCION`))
# Gráfico de barras horizontales
ggplot(recaudacion_infraccion, aes(x = reorder(`COD. INFRACCION`, Total_Recaudado),
y = Total_Recaudado,
fill = `COD. INFRACCION`)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = scales::dollar(Total_Recaudado, prefix = "$", big.mark = ",")),
hjust = -0.1, size = 4, color = "black") +
coord_flip() +
scale_y_continuous(labels = scales::dollar) +
labs(
title = "Total recaudado por tipo de infracción",
subtitle = "Suma de todos los comparendos por código de infracción",
x = "Código de infracción",
y = "Total recaudado ($)"
) +
theme_minimal() +
expand_limits(y = max(recaudacion_infraccion$Total_Recaudado) * 1.15) +
scale_fill_manual(values = c("#FF6B6B", "#4ECDC4", "#45B7D1", "#96CEB4"))
valor_total <- BD_COMPARENDOS %>%
group_by(`TIPO DE VEHICULO`) %>%
summarise(Total_Pagar = sum(`VALOR A PAGAR REAL`, na.rm = TRUE))
# Gráfico con etiquetas y barras horizontales
ggplot(valor_total, aes(x = reorder(`TIPO DE VEHICULO`, Total_Pagar),
y = Total_Pagar, fill = `TIPO DE VEHICULO`)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = scales::comma(round(Total_Pagar, 0))), # Agrega etiquetas con separador de miles
hjust = -0.1, size = 3.5, color = "black") +
coord_flip() +
scale_y_continuous(labels = scales::comma) +
labs(
title = "Valor total de comparendos por tipo de vehículo",
x = "Tipo de vehículo",
y = "Valor total ($)"
) +
theme_minimal() +
expand_limits(y = max(valor_total$Total_Pagar) * 1.1) + # Deja espacio para las etiquetas
scale_fill_manual(values = rep(c("#FF6B6B", "#4ECDC4", "#45B7D1"), length.out = nrow(valor_total)))
comparendos_mensuales_detalle <- BD_COMPARENDOS %>%
group_by(`NOMBRE DEL MES`) %>%
summarise(
Cantidad = n(),
Porcentaje = round(n() / nrow(BD_COMPARENDOS) * 100, 1),
Valor_Total = sum(`VALOR A PAGAR REAL`),
.groups = 'drop'
)
ggplot(comparendos_mensuales_detalle, aes(x = `NOMBRE DEL MES`, y = Cantidad, fill = `NOMBRE DEL MES`)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = paste0(Cantidad, " (", Porcentaje, "%)")),
vjust = -0.5, size = 4, color = "black") +
labs(
title = "Distribución de comparendos por mes - 2010",
subtitle = "Abril vs Mayo: Cantidad y porcentaje",
x = "Mes",
y = "Cantidad de comparendos"
) +
theme_minimal() +
scale_fill_manual(values = c("#FF6B6B", "#4ECDC4")) +
expand_limits(y = max(comparendos_mensuales_detalle$Cantidad) * 1.15)
BD_COMPARENDOS %>%
mutate(Dia_Semana = case_when(
DIA %% 7 == 1 ~ "LUNES",
DIA %% 7 == 2 ~ "MARTES",
DIA %% 7 == 3 ~ "MIÉRCOLES",
DIA %% 7 == 4 ~ "JUEVES",
DIA %% 7 == 5 ~ "VIERNES",
DIA %% 7 == 6 ~ "SÁBADO",
DIA %% 7 == 0 ~ "DOMINGO"
)) %>%
count(Dia_Semana) %>%
mutate(Dia_Semana = factor(Dia_Semana,
levels = c("LUNES", "MARTES", "MIÉRCOLES",
"JUEVES", "VIERNES", "SÁBADO", "DOMINGO"))) %>%
ggplot(aes(x = Dia_Semana, y = n, fill = Dia_Semana)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = n), vjust = -0.5, size = 4, color = "black") +
labs(title = "Comparendos por día de la semana",
x = "Día de la semana",
y = "Número de comparendos") +
theme_minimal() +
expand_limits(y = max(BD_COMPARENDOS$n) * 1.1) +
scale_fill_manual(values = rep(c("#FF6B6B", "#4ECDC4", "#45B7D1", "#96CEB4"), length.out = 7))
BD_COMPARENDOS %>%
filter(SEXO == "EMPRESA") %>%
count(EJECUTADO, sort = TRUE) %>%
head(10) %>%
ggplot(aes(x = reorder(EJECUTADO, n), y = n, fill = EJECUTADO)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = n), hjust = -0.1, size = 4, color = "black") +
coord_flip() +
labs(title = "Top 10 Empresas con más comparendos",
x = "Empresa",
y = "Cantidad de comparendos") +
theme_minimal() +
expand_limits(y = max(BD_COMPARENDOS$n) * 1.1) +
scale_fill_manual(values = rep(c("#FF6B6B", "#4ECDC4", "#45B7D1", "#96CEB4"), length.out = 10))
El análisis de 2,120 comparendos revela una concentración significativa en el código de infracción 64, representando 1,850 casos (87.3%) del total. La distribución demográfica muestra predominio femenino con 945 comparendos (44.6%), superando en 1.5 veces a los hombres.
El impacto económico asciende a $645 millones, con valores entre $257,500 y $515,000. Se identificaron 472 comparendos a empresas, evidenciando la necesidad de controles corporativos. Temporalmente, los meses de abril (980) y mayo (1,140) concentran la totalidad de infracciones.
Recomendación estratégica: Implementar intervenciones focalizadas en el código 64 y desarrollar programas específicos para conductoras, optimizando recursos hacia donde el impacto será máximo.