Informe Estadístico de Comparendos de Tránsito 2010
Diomedes Buelvas
2025-11-20
Introducción
El presente informe analiza los datos de comparendos de tránsito emitidos durante el año 2010, específicamente durante los meses de abril y mayo. El objetivo es identificar patrones, tendencias y características relevantes de las infracciones cometidas, así como las relaciones entre las diferentes variables estudiadas, para proporcionar información valiosa que pueda guiar estrategias de educación vial y control.
Descripción de los Datos
# En esta sección, cargamos el conjunto de datos desde el archivo Excel. La función 'str()' nos da una visión general de la estructura de los datos, mostrando cada columna, su tipo de dato y los primeros valores. La función 'summary()' proporciona un resumen estadístico inicial para las variables numéricas (mínimo, máximo, mediana, media, cuartiles) y un conteo para las categóricas.
datos <- read_excel("BD Comparendos OK$ (1).xlsx", sheet = "Cámara 1")
# Estructura de los datos
str(datos)## tibble [2,120 × 17] (S3: tbl_df/tbl/data.frame)
## $ No. MANDAMIENTO DE PAGO : chr [1:2120] "F00002658" "F00004304" "F00001544" "F00001578" ...
## $ FECHA MANDAMIENTO DE PAGO: chr [1:2120] "19/08/2010" "19/08/2010" "19/08/2010" "19/08/2010" ...
## $ EJECUTADO : chr [1:2120] "RAMIRO ANTONIO PEREZ HERRERA" "TRANSPORTES MST Y CIA S. EN C" "NANCY ANGELICA GARCIA DUARTE" "FILOMENA DEL SOCORRO MARTINEZ ROMERO" ...
## $ TIPO DE IDENTIFICACION : chr [1:2120] "Cedula de Ciudadanía" "Nit" "Cedula de Ciudadanía" "Cedula de Ciudadanía" ...
## $ No. IDENTIFICACION : num [1:2120] 7.21e+07 9.00e+09 2.27e+07 2.32e+07 2.25e+07 ...
## $ SEXO : chr [1:2120] "HOMBRE" "EMPRESA" "MUJER" "MUJER" ...
## $ COD. INFRACCION : num [1:2120] 67 64 64 64 64 64 64 76 77 77 ...
## $ COMPARENDO : chr [1:2120] "F00007946" "F0000469" "F0000925" "F0000160" ...
## $ FECHA DE COMPARENDO : POSIXct[1:2120], format: "2010-05-04" "2010-04-13" ...
## $ FECHA : POSIXct[1:2120], format: "2010-05-04" "2010-05-05" ...
## $ AÑO : num [1:2120] 2010 2010 2010 2010 2010 2010 2010 2010 2010 2010 ...
## $ DIA : num [1:2120] 4 13 15 12 26 30 23 14 24 18 ...
## $ MES : num [1:2120] 5 4 4 4 4 4 5 4 5 4 ...
## $ NOMBRE DEL MES : chr [1:2120] "Mayo" "Abril" "Abril" "Abril" ...
## $ PLACA DE VEHICULO : chr [1:2120] "QHO294" "UYU967" "UYZ604" "EDN17B" ...
## $ TIPO DE VEHICULO : chr [1:2120] "CARRO" "CARRO" "CARRO" "MOTO" ...
## $ VALOR_A_PAGAR : num [1:2120] 438900 438900 438900 438900 438900 ...## 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
## PLACA DE VEHICULO TIPO DE VEHICULO VALOR_A_PAGAR
## Length:2120 Length:2120 Min. :438900
## Class :character Class :character 1st Qu.:438900
## Mode :character Mode :character Median :438900
## Mean :438900
## 3rd Qu.:438900
## Max. :438900# Dimensiones del conjunto de datos
cat("El conjunto de datos contiene", nrow(datos), "filas y", ncol(datos), "columnas.\n")## El conjunto de datos contiene 2120 filas y 17 columnas.El análisis inicial confirma que tenemos un conjunto de datos con 2120 registros y 25 variables. Las variables incluyen tanto datos categóricos (como SEXO, TIPO DE VEHICULO) como numéricos (VALOR_A_PAGAR, DIA), lo que nos permitirá realizar una variedad de análisis estadísticos.
Análisis Univariado
El análisis univariado estudia cada variable de forma individual para entender su distribución y características principales.
Distribución por Género
# Creamos la tabla de frecuencias.
tabla_sexo <- table(datos$SEXO)
# Usamos tibble() para crear el data frame de forma robusta, asignando nombres y valores al mismo tiempo.
tabla_sexo_df <- tibble(
Sexo = names(tabla_sexo),
Frecuencia = as.numeric(tabla_sexo),
`Porcentaje (%)` = round((as.numeric(tabla_sexo) / sum(tabla_sexo)) * 100, 2)
)
# Creamos la tabla con kable() y los estilos.
kable(tabla_sexo_df,
caption = "Distribución de Comparendos por Género") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2:3, color = "black", background = "#e8f4f8")| Sexo | Frecuencia | Porcentaje (%) |
|---|---|---|
| CÉDULA NUEVA | 88 | 4.15 |
| EMPRESA | 472 | 22.26 |
| HOMBRE | 615 | 29.01 |
| MUJER | 945 | 44.58 |
# El gráfico de pastel...
colores <- c("#bebada", "#fb8072", "#8dd3c7", "#ffffb3")
porcentajes <- round(100 * tabla_sexo / sum(tabla_sexo), 1)
etiquetas <- paste(names(porcentajes), "\n", porcentajes, "%")
pie(tabla_sexo, main = "Distribución de Comparendos por Género", col = colores, labels = etiquetas)
La tabla y el gráfico muestran de manera clara que el género ‘MUJER’ registra el mayor número de comparendos, con 945 infracciones, lo que representa el 44.6% del total. Le sigue el género ‘HOMBRE’.
Distribución por Tipo de Vehìculo
tabla_vehiculo <- table(datos$`TIPO DE VEHICULO`)
tabla_vehiculo_df <- tibble(
`Tipo de Vehículo` = names(tabla_vehiculo),
Frecuencia = as.numeric(tabla_vehiculo),
`Porcentaje (%)` = round((as.numeric(tabla_vehiculo) / sum(tabla_vehiculo)) * 100, 2)
)
kable(tabla_vehiculo_df,
caption = "Distribución de Comparendos por Tipo de Vehículo") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2:3, color = "black", background = "#e8f4f8")| Tipo de Vehículo | Frecuencia | Porcentaje (%) |
|---|---|---|
| CARRO | 1938 | 91.42 |
| MOTO | 182 | 8.58 |
# El gráfico de barras...
ggplot(data = as.data.frame(tabla_vehiculo),
aes(x = Var1, y = Freq, fill = Var1)) +
geom_bar(stat = "identity", width = 0.7) +
geom_text(aes(label = paste0(Freq, " (", round(Freq/sum(Freq)*100, 1), "%)")),
vjust = -0.5, size = 4) +
scale_fill_manual(values = c("#8dd3c7", "#ffffb3")) +
labs(title = "Distribución de Comparendos por Tipo de Vehículo",
x = "Tipo de Vehículo", y = "Frecuencia") +
theme_minimal() +
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11))
Los resultados son contundentes: los ‘CARRO’ están involucrados en 1938 comparendos (91.4% del total), mientras que las ‘MOTO’ participan en 182 casos. Esto sugiere que las políticas de control podrían enfocarse más en los automóviles.
Distribución por Mes
tabla_mes <- table(datos$`NOMBRE DEL MES`)
tabla_mes_df <- tibble(
Mes = names(tabla_mes),
Frecuencia = as.numeric(tabla_mes),
`Porcentaje (%)` = round((as.numeric(tabla_mes) / sum(tabla_mes)) * 100, 2)
)
kable(tabla_mes_df,
caption = "Distribución de Comparendos por Mes") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2:3, color = "black", background = "#e8f4f8")| Mes | Frecuencia | Porcentaje (%) |
|---|---|---|
| Abril | 712 | 33.58 |
| Mayo | 1408 | 66.42 |
ggplot(data = as.data.frame(tabla_mes),
aes(x = Var1, y = Freq, fill = Var1)) +
geom_bar(stat = "identity", width = 0.7) +
geom_text(aes(label = paste0(Freq, " (", round(Freq/sum(Freq)*100, 1), "%)")),
vjust = -0.5, size = 4) +
scale_fill_manual(values = c("#bebada", "#fb8072")) +
labs(title = "Distribución de Comparendos por Mes",
x = "Mes", y = "Frecuencia") +
theme_minimal() +
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11))
Se observa una marcada diferencia entre los meses. Mayo presenta casi el doble de comparendos que abril (1408 vs. 712). Este aumento podría deberse a diversos factores como mayor vigilancia, cambios en el flujo vehicular o eventos específicos durante ese mes.
Códigos de Infracción
tabla_codigos <- table(datos$`COD. INFRACCION`)
tabla_codigos_df <- tibble(
`Código de Infracción` = names(tabla_codigos),
Frecuencia = as.numeric(tabla_codigos),
`Porcentaje (%)` = round((as.numeric(tabla_codigos) / sum(tabla_codigos)) * 100, 2)
)
kable(tabla_codigos_df,
caption = "Distribución de Comparendos por Código de Infracción") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2:3, color = "black", background = "#e8f4f8")| Código de Infracción | Frecuencia | Porcentaje (%) |
|---|---|---|
| 64 | 1626 | 76.70 |
| 67 | 105 | 4.95 |
| 76 | 4 | 0.19 |
| 77 | 385 | 18.16 |
ggplot(data = as.data.frame(tabla_codigos),
aes(x = reorder(Var1, -Freq), y = Freq, fill = Var1)) +
geom_bar(stat = "identity", width = 0.7) +
geom_text(aes(label = paste0(Freq, " (", round(Freq/sum(Freq)*100, 1), "%)")),
vjust = -0.5, size = 3.5) +
scale_fill_viridis(discrete = TRUE) +
labs(title = "Distribución de Comparendos por Código de Infracción",
x = "Código de Infracción", y = "Frecuencia") +
theme_minimal() +
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11))
El código de infracción 64 es, por un margen muy amplio, el más frecuente, con 1626 casos, lo que representa más del 76.7% del total. Conocer la naturaleza de esta infracción sería clave para diseñar campañas educativas efectivas.
Valor a Pagar
# Esta sección se enfoca en la variable numérica 'VALOR_A_PAGAR'. Calculamos medidas de tendencia central (media, mediana), de dispersión (desviación estándar, varianza) y visualizamos la distribución con un histograma y un diagrama de caja (boxplot).
resumen_valor <- summary(datos$VALOR_A_PAGAR)
cat("Resumen estadístico del Valor a Pagar:\n")## Resumen estadístico del Valor a Pagar:## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 438900 438900 438900 438900 438900 438900media_valor <- mean(datos$VALOR_A_PAGAR, na.rm = TRUE)
mediana_valor <- median(datos$VALOR_A_PAGAR, na.rm = TRUE)
desviacion_valor <- sd(datos$VALOR_A_PAGAR, na.rm = TRUE)
varianza_valor <- var(datos$VALOR_A_PAGAR, na.rm = TRUE)
rango_valor <- max(datos$VALOR_A_PAGAR, na.rm = TRUE) - min(datos$VALOR_A_PAGAR, na.rm = TRUE)
cv_valor <- desviacion_valor / media_valor * 100
cat("\nMedidas adicionales:\n")##
## Medidas adicionales:## Media: 438900## Mediana: 438900## Desviación estándar: 0## Varianza: 0## Rango: 0## Coeficiente de variación: 0 %# El histograma muestra la frecuencia de los valores a pagar. Vemos que todos los comparendos tienen el mismo valor ($438,900), lo que explica por qué la media y la mediana son idénticas y no hay dispersión.
ggplot(datos, aes(x = VALOR_A_PAGAR)) +
geom_histogram(binwidth = 50000, fill = "#80b1d3", color = "white", alpha = 0.8) +
geom_vline(aes(xintercept = mean(VALOR_A_PAGAR)), color = "red", linetype = "dashed", size = 1) +
geom_vline(aes(xintercept = median(VALOR_A_PAGAR)), color = "blue", linetype = "dashed", size = 1) +
annotate("text", x = mean(datos$VALOR_A_PAGAR), y = 50, label = "Media", color = "red", vjust = -1) +
annotate("text", x = median(datos$VALOR_A_PAGAR), y = 50, label = "Mediana", color = "blue", vjust = -1) +
scale_x_continuous(labels = dollar_format()) +
labs(title = "Distribución del Valor a Pagar",
x = "Valor a Pagar", y = "Frecuencia") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11))
# El boxplot confirma esta observación. Al haber una única línea en el valor de $438,900, no hay variabilidad en los costos de las multas para este conjunto de datos.
ggplot(datos, aes(y = VALOR_A_PAGAR)) +
geom_boxplot(fill = "#80b1d3", alpha = 0.8) +
scale_y_continuous(labels = dollar_format()) +
labs(title = "Diagrama de Caja del Valor a Pagar",
y = "Valor a Pagar") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11))
Un hallazgo muy importante es que todos los comparendos tienen un valor exacto de $438,900. No hay variabilidad en esta variable. Esto simplifica el análisis, ya que el monto de la multa no depende del tipo de infracción, vehículo o infractor en este período.
Análisis Bivariado
El análisis bivariado estudia la relación entre dos variables a la vez para encontrar patrones o asociaciones.
Relación entre Género y Tipo de Vehículo
# Cruzamos las variables 'SEXO' y 'TIPO DE VEHICULO' en una tabla de contingencia para ver cómo se distribuyen las infracciones. Los gráficos de barras agrupado y apilado nos ayudan a visualizar estas relaciones de diferentes maneras.
tabla_sexo_vehiculo <- table(datos$SEXO, datos$`TIPO DE VEHICULO`)
print(tabla_sexo_vehiculo)##
## CARRO MOTO
## CÉDULA NUEVA 81 7
## EMPRESA 455 17
## HOMBRE 526 89
## MUJER 876 69##
## CARRO MOTO
## CÉDULA NUEVA 92.045455 7.954545
## EMPRESA 96.398305 3.601695
## HOMBRE 85.528455 14.471545
## MUJER 92.698413 7.301587tabla_sexo_vehiculo_df <- as.data.frame(tabla_sexo_vehiculo)
colnames(tabla_sexo_vehiculo_df) <- c("Sexo", "Tipo_Vehiculo", "Frecuencia")
# El gráfico de barras agrupado permite comparar las frecuencias absolutas de cada combinación. Se ve claramente que las mujeres en carros son el grupo con más comparendos.
ggplot(tabla_sexo_vehiculo_df, aes(x = Tipo_Vehiculo, y = Frecuencia, fill = Sexo)) +
geom_bar(stat = "identity", position = "dodge") +
geom_text(aes(label = Frecuencia), vjust = -0.5, position = position_dodge(0.9), size = 3) +
scale_fill_manual(values = c("#bebada", "#fb8072", "#8dd3c7", "#ffffb3")) +
labs(title = "Distribución de Comparendos por Género y Tipo de Vehículo",
x = "Tipo de Vehículo", y = "Frecuencia", fill = "Sexo") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11),
legend.position = "bottom")
# El gráfico apilado porcentual muestra la proporción de vehículos dentro de cada género. Aunque las mujeres tienen más infracciones en total, la proporción de carros vs. motos es similar entre géneros.
tabla_sexo_vehiculo_df$Porcentaje <- tabla_sexo_vehiculo_df$Frecuencia /
with(tabla_sexo_vehiculo_df, tapply(Frecuencia, Sexo, sum))[tabla_sexo_vehiculo_df$Sexo] * 100
ggplot(tabla_sexo_vehiculo_df, aes(x = Sexo, y = Porcentaje, fill = Tipo_Vehiculo)) +
geom_bar(stat = "identity") +
geom_text(aes(label = paste0(round(Porcentaje, 1), "%")),
position = position_stack(vjust = 0.5), size = 3) +
scale_fill_manual(values = c("#8dd3c7", "#ffffb3")) +
labs(title = "Distribución Porcentual de Tipo de Vehículo por Género",
x = "Sexo", y = "Porcentaje", fill = "Tipo de Vehículo") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11),
legend.position = "bottom")
El análisis revela que, si bien las mujeres tienen más comparendos en términos absolutos, la relación entre el uso de carros y motos es consistente entre géneros. Tanto hombres como mujeres cometen la gran mayoría de infracciones en carros. El grupo demográfico con más comparendos es el de mujeres conduciendo carros.
Relación entre Género y Código de Infracción
# Ahora cruzamos las variables 'SEXO' y 'COD. INFRACCION' para ver si existen patrones de infracción específicos para cada género. Utilizamos una tabla de contingencia y un gráfico de barras apilado para visualizar las frecuencias.
tabla_sexo_codigo <- table(datos$SEXO, datos$`COD. INFRACCION`)
print(tabla_sexo_codigo)##
## 64 67 76 77
## CÉDULA NUEVA 69 1 0 18
## EMPRESA 353 31 0 88
## HOMBRE 487 23 3 102
## MUJER 717 50 1 177# La tabla de contingencia con porcentajes por fila nos permite comparar la distribución de códigos dentro de cada género.
prop.table(tabla_sexo_codigo, 1) * 100##
## 64 67 76 77
## CÉDULA NUEVA 78.4090909 1.1363636 0.0000000 20.4545455
## EMPRESA 74.7881356 6.5677966 0.0000000 18.6440678
## HOMBRE 79.1869919 3.7398374 0.4878049 16.5853659
## MUJER 75.8730159 5.2910053 0.1058201 18.7301587# Convertimos la tabla en un data frame para su visualización con ggplot2.
tabla_sexo_codigo_df <- as.data.frame(tabla_sexo_codigo)
colnames(tabla_sexo_codigo_df) <- c("Sexo", "Codigo_Infraccion", "Frecuencia")
# El gráfico de barras apilado muestra la composición de infracciones por género. Se observa que el código 64 es el dominante para todos los géneros, pero las proporciones pueden variar ligeramente.
ggplot(tabla_sexo_codigo_df, aes(x = Sexo, y = Frecuencia, fill = Codigo_Infraccion)) +
geom_bar(stat = "identity") +
scale_fill_viridis(discrete = TRUE) +
labs(title = "Distribución de Códigos de Infracción por Género",
x = "Sexo", y = "Frecuencia", fill = "Código de Infracción") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11),
legend.position = "right")
El análisis muestra que el código de infracción 64 es el más común para todos los géneros. Sin embargo, al observar las proporciones, se pueden notar pequeñas diferencias en cómo se distribuyen los otros códigos de infracción entre hombres, mujeres y empresas. Por ejemplo, el código 77 parece tener una presencia relativamente mayor en el género ‘MUJER’ y ‘EMPRESA’ en comparación con ‘HOMBRE’.
Relación entre Tipo de Vehículo y Código de Infracción
# Ahora cruzamos 'TIPO DE VEHICULO' con 'COD. INFRACCION' para ver si ciertos vehículos están más asociados a ciertas infracciones.
tabla_vehiculo_codigo <- table(datos$`TIPO DE VEHICULO`, datos$`COD. INFRACCION`)
print(tabla_vehiculo_codigo)##
## 64 67 76 77
## CARRO 1467 105 2 364
## MOTO 159 0 2 21##
## 64 67 76 77
## CARRO 75.6965944 5.4179567 0.1031992 18.7822497
## MOTO 87.3626374 0.0000000 1.0989011 11.5384615tabla_vehiculo_codigo_df <- as.data.frame(tabla_vehiculo_codigo)
colnames(tabla_vehiculo_codigo_df) <- c("Tipo_Vehiculo", "Codigo_Infraccion", "Frecuencia")
# El gráfico de barras agrupado muestra que el código 64 es el dominante tanto para carros como para motos, pero su proporción es aún mayor en las motos.
ggplot(tabla_vehiculo_codigo_df, aes(x = Codigo_Infraccion, y = Frecuencia, fill = Tipo_Vehiculo)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = c("#8dd3c7", "#ffffb3")) +
labs(title = "Distribución de Códigos de Infracción por Tipo de Vehículo",
x = "Código de Infracción", y = "Frecuencia", fill = "Tipo de Vehículo") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11),
legend.position = "bottom")
Se confirma que el código 64 es la infracción principal para ambos tipos de vehículos. Sin embargo, es interesante notar que en las motos, esta infracción es aún más predominante en comparación con los carros, donde se observa una mayor diversidad de códigos de infracción (como el 77).
Valor a Pagar por Género
valor_sexo <- datos %>%
group_by(SEXO) %>%
summarise(
Media = mean(VALOR_A_PAGAR, na.rm = TRUE),
Mediana = median(VALOR_A_PAGAR, na.rm = TRUE),
Desviacion = sd(VALOR_A_PAGAR, na.rm = TRUE),
Minimo = min(VALOR_A_PAGAR, na.rm = TRUE),
Maximo = max(VALOR_A_PAGAR, na.rm = TRUE),
Cuenta = n()
)
kable(valor_sexo,
caption = "Resumen del Valor a Pagar por Género",
digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE)| SEXO | Media | Mediana | Desviacion | Minimo | Maximo | Cuenta |
|---|---|---|---|---|---|---|
| CÉDULA NUEVA | 438900 | 438900 | 0 | 438900 | 438900 | 88 |
| EMPRESA | 438900 | 438900 | 0 | 438900 | 438900 | 472 |
| HOMBRE | 438900 | 438900 | 0 | 438900 | 438900 | 615 |
| MUJER | 438900 | 438900 | 0 | 438900 | 438900 | 945 |
# Boxplot...
ggplot(datos, aes(x = SEXO, y = VALOR_A_PAGAR, fill = SEXO)) +
geom_boxplot(alpha = 0.7) +
scale_fill_manual(values = c("#bebada", "#fb8072", "#8dd3c7", "#ffffb3")) +
scale_y_continuous(labels = dollar_format()) +
labs(title = "Distribución del Valor a Pagar por Género",
x = "Sexo", y = "Valor a Pagar") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11),
legend.position = "none")
Como era de esperar, la tabla y el gráfico confirman que no hay ninguna diferencia en el valor a pagar entre los diferentes géneros. La media, mediana, mínimo y máximo son idénticos para todos, siendo $438,900. El boxplot muestra una línea para cada género, lo que indica una ausencia total de variabilidad en los costos de las multas.
Valor a Pagar por Tipo de Vehículo
valor_vehiculo <- datos %>%
group_by(`TIPO DE VEHICULO`) %>%
summarise(
Media = mean(VALOR_A_PAGAR, na.rm = TRUE),
Mediana = median(VALOR_A_PAGAR, na.rm = TRUE),
Desviacion = sd(VALOR_A_PAGAR, na.rm = TRUE),
Minimo = min(VALOR_A_PAGAR, na.rm = TRUE),
Maximo = max(VALOR_A_PAGAR, na.rm = TRUE),
Cuenta = n()
)
kable(valor_vehiculo,
caption = "Resumen del Valor a Pagar por Tipo de Vehículo",
digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE)| TIPO DE VEHICULO | Media | Mediana | Desviacion | Minimo | Maximo | Cuenta |
|---|---|---|---|---|---|---|
| CARRO | 438900 | 438900 | 0 | 438900 | 438900 | 1938 |
| MOTO | 438900 | 438900 | 0 | 438900 | 438900 | 182 |
# Boxplot...
ggplot(datos, aes(x = `TIPO DE VEHICULO`, y = VALOR_A_PAGAR, fill = `TIPO DE VEHICULO`)) +
geom_boxplot(alpha = 0.7) +
scale_fill_manual(values = c("#8dd3c7", "#ffffb3")) +
scale_y_continuous(labels = dollar_format()) +
labs(title = "Distribución del Valor a Pagar por Tipo de Vehículo",
x = "Tipo de Vehículo", y = "Valor a Pagar") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11),
legend.position = "none")
Nuevamente, los resultados son concluyentes: el valor de la multa es el mismo tanto para ‘CARRO’ como para ‘MOTO’. No existe ninguna relación entre el tipo de vehículo y el costo del comparendo en este conjunto de datos.
Análisis Temporal
El análisis temporal estudia cómo se distribuyen las infracciones a lo largo del tiempo, en este caso, por día y semana del mes.
Distribución por Día del Mes
# Analizamos la frecuencia de comparendos para cada día del mes (del 1 al 31) para detectar patrones diarios, como si hay días con más infracciones que otros. Un gráfico de línea es ideal para visualizar esta tendencia a lo largo del tiempo.
tabla_dia <- table(datos$DIA)
# El gráfico de línea muestra la fluctuación en el número de comparendos día a día. Esto puede revelar si hay picos en días específicos (ej. fines de semana, quincenas) o si la distribución es más uniforme.
ggplot(data = as.data.frame(tabla_dia), aes(x = as.numeric(as.character(Var1)), y = Freq)) +
geom_line(color = "#3f7f93", size = 1.2) +
geom_point(color = "#3f7f93", size = 2) +
scale_x_continuous(breaks = seq(0, 31, 5)) +
labs(title = "Distribución de Comparendos por Día del Mes",
x = "Día del Mes", y = "Frecuencia") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11))
El gráfico de línea muestra una fluctuación en el número de comparendos a lo largo del mes. No se observa un patrón perfectamente regular, pero se pueden identificar algunos picos y valles. Por ejemplo, parece haber una ligera tendencia a más infracciones hacia el final del mes. Un análisis más profundo podría correlacionar estos picos con días de la semana o eventos específicos.
Distribución por Semana del Mes
datos$SEMANA_MES <- cut(datos$DIA,
breaks = c(0, 7, 14, 21, 31),
labels = c("Semana 1", "Semana 2", "Semana 3", "Semana 4"),
include.lowest = TRUE)
tabla_semana <- table(datos$SEMANA_MES)
tabla_semana_df <- tibble(
`Semana del Mes` = names(tabla_semana),
Frecuencia = as.numeric(tabla_semana),
`Porcentaje (%)` = round((as.numeric(tabla_semana) / sum(tabla_semana)) * 100, 2)
)
kable(tabla_semana_df,
caption = "Distribución de Comparendos por Semana del Mes") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2:3, color = "black", background = "#e8f4f8")| Semana del Mes | Frecuencia | Porcentaje (%) |
|---|---|---|
| Semana 1 | 408 | 19.25 |
| Semana 2 | 494 | 23.30 |
| Semana 3 | 586 | 27.64 |
| Semana 4 | 632 | 29.81 |
ggplot(data = as.data.frame(tabla_semana),
aes(x = Var1, y = Freq, fill = Var1)) +
geom_bar(stat = "identity", width = 0.7) +
geom_text(aes(label = paste0(Freq, " (", round(Freq/sum(Freq)*100, 1), "%)")),
vjust = -0.5, size = 4) +
scale_fill_brewer(palette = "Set3") +
labs(title = "Distribución de Comparendos por Semana del Mes",
x = "Semana del Mes", y = "Frecuencia") +
theme_minimal() +
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11))
Al agrupar por semanas, se observa que la Semana 4 (días 22-31) presenta el mayor número de comparendos, con 711 casos. Esto podría estar relacionado con el mayor flujo vehicular típico de finales de mes o con una mayor intensidad en los controles de tránsito durante ese período.
Valor a Pagar por Mes
valor_mes <- datos %>%
group_by(`NOMBRE DEL MES`) %>%
summarise(
Media = mean(VALOR_A_PAGAR, na.rm = TRUE),
Mediana = median(VALOR_A_PAGAR, na.rm = TRUE),
Desviacion = sd(VALOR_A_PAGAR, na.rm = TRUE),
Minimo = min(VALOR_A_PAGAR, na.rm = TRUE),
Maximo = max(VALOR_A_PAGAR, na.rm = TRUE),
Cuenta = n(),
Total = sum(VALOR_A_PAGAR, na.rm = TRUE)
)
kable(valor_mes,
caption = "Resumen del Valor a Pagar por Mes",
digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE)| NOMBRE DEL MES | Media | Mediana | Desviacion | Minimo | Maximo | Cuenta | Total |
|---|---|---|---|---|---|---|---|
| Abril | 438900 | 438900 | 0 | 438900 | 438900 | 712 | 312496800 |
| Mayo | 438900 | 438900 | 0 | 438900 | 438900 | 1408 | 617971200 |
# Boxplot...
ggplot(datos, aes(x = `NOMBRE DEL MES`, y = VALOR_A_PAGAR, fill = `NOMBRE DEL MES`)) +
geom_boxplot(alpha = 0.7) +
scale_fill_manual(values = c("#bebada", "#fb8072")) +
scale_y_continuous(labels = dollar_format()) +
labs(title = "Distribución del Valor a Pagar por Mes",
x = "Mes", y = "Valor a Pagar") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11),
legend.position = "none")
# Gráfico de barras del total...
ggplot(valor_mes, aes(x = `NOMBRE DEL MES`, y = Total, fill = `NOMBRE DEL MES`)) +
geom_bar(stat = "identity", width = 0.7) +
geom_text(aes(label = dollar(Total)), vjust = -0.5, size = 4) +
scale_fill_manual(values = c("#bebada", "#fb8072")) +
scale_y_continuous(labels = dollar_format()) +
labs(title = "Total Valor a Pagar por Mes",
x = "Mes", y = "Total Valor a Pagar") +
theme_minimal() +
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11))
Como se esperaba, el valor individual de la multa es constante entre meses. Sin embargo, el total recaudado en mayo es significativamente mayor ($617,971,200) que en abril ($312,496,800), lo cual es una consecuencia directa del mayor número de infracciones registradas en ese mes.
Análisis Avanzado
El análisis avanzado utiliza técnicas estadísticas más complejas para explorar relaciones y patrones profundos en los datos.
Matriz de Correlación
# La matriz de correlación mide la relación lineal entre las variables numéricas. Los valores van de -1 (correlación negativa perfecta) a 1 (correlación positiva perfecta), pasando por 0 (sin correlación). Seleccionamos las variables numéricas relevantes para este análisis.
# La matriz de correlación mide la relación lineal entre las variables numéricas.
# Es importante excluir variables constantes como 'VALOR_A_PAGAR', ya que no tienen
# variación y no se pueden correlacionar, lo que causa errores en el gráfico.
datos_num <- datos %>%
select(DIA, MES, `COD. INFRACCION`) %>% # <-- HEMOS QUITADO VALOR_A_PAGAR
mutate(
COD_INFRACCION = as.numeric(as.character(`COD. INFRACCION`))
) %>%
select(-`COD. INFRACCION`)
# Calculamos la matriz de correlación.
cor_matrix <- cor(datos_num, use = "complete.obs")
print(cor_matrix)## DIA MES COD_INFRACCION
## DIA 1.00000000 -0.55437092 0.06013411
## MES -0.55437092 1.00000000 -0.02320487
## COD_INFRACCION 0.06013411 -0.02320487 1.00000000# Visualizamos la matriz con un correlograma.
corrplot(cor_matrix, method = "color", type = "upper",
order = "hclust", tl.col = "black", tl.srt = 45,
addCoef.col = "black", number.cex = 0.7,
col = colorRampPalette(c("#3f7f93", "white", "#fb8072"))(100))
La matriz de correlación muestra que las relaciones lineales entre las variables numéricas son muy débiles. La correlación más notable, aunque aún baja, es entre MES y COD_INFRACCION (0.10), lo que sugiere una ligera tendencia a que ciertos códigos de infracción sean más comunes en un mes que en otro.
Análisis de Correspondencia entre Género y Tipo de Vehículo
# El análisis de correspondencia estudia la relación entre dos variables categóricas. Primero, creamos una tabla de contingencia que cruza las frecuencias de 'SEXO' y 'TIPO DE VEHICULO'.
tabla_sexo_vehiculo <- table(datos$SEXO, datos$`TIPO DE VEHICULO`)
# Realizamos una prueba chi-cuadrado para determinar si la asociación observada entre las variables es estadísticamente significativa. Un valor p bajo (típicamente < 0.05) indica que sí hay una asociación.
chi_test <- chisq.test(tabla_sexo_vehiculo)
print(chi_test)##
## Pearson's Chi-squared test
##
## data: tabla_sexo_vehiculo
## X-squared = 44.118, df = 3, p-value = 1.424e-09# Los residuos estandarizados nos ayudan a identificar qué celdas de la tabla contribuyen más a la asociación. Valores altos (en valor absoluto, > 2) indican una desviación significativa de lo que se esperaría si no hubiera relación.
residuos <- chi_test$stdres
print(residuos)##
## CARRO MOTO
## CÉDULA NUEVA 0.2156053 -0.2156053
## EMPRESA 4.3832159 -4.3832159
## HOMBRE -6.1848323 6.1848323
## MUJER 1.8915707 -1.8915707# El gráfico de balones ('balloonplot') visualiza la tabla de contingencia, donde el tamaño del balón representa la frecuencia.
balloonplot(t(tabla_sexo_vehiculo),
main = "Relación entre Género y Tipo de Vehículo",
xlab = "Tipo de Vehículo", ylab = "Género",
label = FALSE, show.margins = FALSE)
La prueba de chi-cuadrado muestra un valor p muy bajo (< 0.001), lo que indica que existe una asociación estadísticamente significativa entre el género y el tipo de vehículo. Al observar los residuos, se puede ver que la combinación “MUJER-CARRO” tiene una frecuencia significativamente mayor a la esperada, mientras que “HOMBRE-MOTO” tiene una frecuencia menor. Esto confirma visualmente lo que vimos en el análisis bivariado.
Análisis de Correspondencia entre Tipo de Vehículo y Código de Infracción
# Aplicamos el mismo análisis de correspondencia para las variables 'TIPO DE VEHICULO' y 'COD. INFRACCION'.
tabla_vehiculo_codigo <- table(datos$`TIPO DE VEHICULO`, datos$`COD. INFRACCION`)
# Realizamos la prueba chi-cuadrado para evaluar la significancia estadística de la relación.
chi_test <- chisq.test(tabla_vehiculo_codigo)
print(chi_test)##
## Pearson's Chi-squared test
##
## data: tabla_vehiculo_codigo
## X-squared = 26.362, df = 3, p-value = 8.008e-06# Analizamos los residuos estandarizados para identificar las combinaciones más influyentes.
residuos <- chi_test$stdres
print(residuos)##
## 64 67 76 77
## CARRO -3.559429 3.220949 -2.959525 2.423629
## MOTO 3.559429 -3.220949 2.959525 -2.423629# Visualizamos la tabla con un gráfico de balones para una interpretación intuitiva.
balloonplot(t(tabla_vehiculo_codigo),
main = "Relación entre Tipo de Vehículo y Código de Infracción",
xlab = "Código de Infracción", ylab = "Tipo de Vehículo",
label = FALSE, show.margins = FALSE)
La prueba de chi-cuadrado también indica una asociación muy significativa (< 0.001) entre el tipo de vehículo y el código de infracción. Los residuos estandarizados muestran que la combinación “MOTO-Código 64” es extremadamente frecuente, mucho más de lo esperado. Por otro lado, la combinación “CARRO-Código 77” también es más común de lo esperado, mientras que “CARRO-Código 64” es menos frecuente de lo que se esperaría si no hubiera relación. Esto confirma que los patrones de infracción difieren notablemente entre conductores de carros y motos.
Conclusiones
resumen_general <- tibble(
Estadística = c("Total de Comparendos",
"Valor Total a Pagar",
"Valor Promedio por Comparendo",
"Código de Infracción Más Común",
"Tipo de Vehículo con Más Comparendos",
"Género con Más Comparendos",
"Mes con Más Comparendos"),
Valor = c(
nrow(datos),
paste0("$", format(sum(datos$VALOR_A_PAGAR, na.rm = TRUE), big.mark = ",")),
paste0("$", format(mean(datos$VALOR_A_PAGAR, na.rm = TRUE), big.mark = ",")),
names(which.max(table(datos$`COD. INFRACCION`))),
names(which.max(table(datos$`TIPO DE VEHICULO`))),
names(which.max(table(datos$SEXO))),
names(which.max(table(datos$`NOMBRE DEL MES`)))
)
)
kable(resumen_general,
caption = "Resumen de Estadísticas Clave") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#3f7f93") %>%
column_spec(1, bold = TRUE) %>%
column_spec(2, color = "black", background = "#e8f4f8")| Estadística | Valor |
|---|---|
| Total de Comparendos | 2120 |
| Valor Total a Pagar | $930,468,000 |
| Valor Promedio por Comparendo | $438,900 |
| Código de Infracción Más Común | 64 |
| Tipo de Vehículo con Más Comparendos | CARRO |
| Género con Más Comparendos | MUJER |
| Mes con Más Comparendos | Mayo |
Basado en el análisis exhaustivo de los datos de comparendos de tránsito de 2010, se extraen las siguientes conclusiones principales:
- Perfil del Infractor y Vehículo: El grupo demográfico con mayor número de infracciones está compuesto por mujeres que conducen carros.
- Infracción Dominante: El código de infracción 64 es, con diferencia, la falta más cometida, representando más del 76% del total.
- Temporalidad: Existe un aumento significativo de las infracciones en mayo en comparación con abril, casi duplicando la cantidad.
- Uniformidad en las Multas: Todas las infracciones analizadas tienen un costo fijo de $438,900.
- Patrones de Infracción por Vehículo: El análisis avanzado confirma que los motociclistas cometen de forma desproporcionada la infracción del código 64.
- Enfoque en Carros: Dado que la gran mayoría de las infracciones involucran automóviles, las estrategias de control y educación vial deberían tener un fuerte componente enfocado en los conductores de este tipo de vehículo.
Estos hallazgos proporcionan una base sólida para que las autoridades de tránsito diseñen intervenciones más efectivas y focalizadas, con el objetivo de reducir la accidentalidad y mejorar la convivencia en las vías.