Analisis comparendo en el año 2010, Abril y Mayo

Esto es un analisis hecho por un aprendiz recnico del sena con el objetivo de aumentar sus habilidades usando RStudios, se esperan errores y mejoras en el proceso, continuacion se mostraran diversas conclusiones y analisis de los datos

Comparendos

Se estara trabajando con una tabla excel suministrada por el instructor, dichos datos con muy escasos, se esta manejando datos del año 2010 en los meses de mayo y abril, lamento mucho si los analisis son muy vagos esto se debe a la poca variedad de datos y al nivel de conocimiento.

importamos librerias que vamos a usar, “tidyverse” es especial ya que contiene muchas librerias dentro de ellas, en el codigo se anotaran los usos que les dare a las librerias exepto la anterior mencionada.

tambien vamos aproceder a añadir y reemplazar columnas ya que hay informacion erronea, desconozco como comvertir una serie de numeros a fecha.

options(repos = "[https://cloud.r-project.org](https://cloud.r-project.org)")
#librerias
install.packages("tidyverse")
install.packages("readxl")
install.packages("ggplot2")
install.packages("scales")
library(tidyverse)#esta libreria contiene mas librerias dentro
library(readxl)#libreria para leer excel
library(ggplot2)#ayuda para los graficos
library(scales)#hace ver los numeros grandes mucho mas faciles de ver

Tabla <- read_excel("C:/Users/User/Desktop/Informe/Comparendos.xlsx")#leer tabla excel base

#reemplazamos valores repetidos en VALOR A PAGAR de acuerdo al tipo de multa
Tabla <- Tabla %>% 
  mutate(VALOR_A_PAGAR = case_when
         (`COD. INFRACCION` == 64  | `COD. INFRACCION` == 67 ~ 257500,
           `COD. INFRACCION` == 76 | `COD. INFRACCION` == 77 ~ 515000,
           TRUE ~ NA))#aqui corregimos los valores de pago por infraccion
Tabla <- Tabla %>%
  mutate(`EJECUTADO` = 
           case_when(`EJECUTADO` == "AGROZOOCRIA LTDA." ~ "AGROZOOCRIA LTDA",
            `EJECUTADO` == "AMBIENTE & DISEÑO Y CIA S.EN C" ~ "AMBIENTE & DISEÑO Y CIA SEN C",
            `EJECUTADO` == "CONSULTORES DEL DESARROLLO S.A" ~ "CONSULTORES DEL DESARROLLO SA",
            `EJECUTADO` == "43 ELECTRO             AUTOMATISM" ~ "43 ELECTRO AUTOMATISM",`EJECUTADO` == "MONTACARGAS IBA?EZ LTDA" ~ "MONTACARGAS IBAÑEZ LTDA",
            `EJECUTADO` == "AGROZOOCRIA LTDA." ~ "AGROZOOCRIA LTDA",
            `EJECUTADO` == "PROYECTARCO S.A." ~ "PROYECTARCO SA",
            `EJECUTADO` == "TRANSPORTES BESIMOR & CIA LTDA" ~ "TRANSPORTES BESIMOR Y CIA LTDA",
            TRUE ~ `EJECUTADO`))%>%#aca corrigio algunos nombres de empresas
  mutate(NOM_INFRACCION = case_when(
    `COD. INFRACCION` == 64 ~ "max velocidad maxima",
    `COD. INFRACCION` == 67 ~ "pasa paso peatonal",
    `COD. INFRACCION` == 76 ~ "sentido contrario",
    `COD. INFRACCION` == 77 ~ "pasar luz roja/amarilla",
    TRUE ~ NA
  ))#y por aca le añadimos nombre a cada codigo de infraacion en una nueva columna

-Vehiculos y Años mas frecuentes

quiero empezar con la frecuencia con la que los vehiculos cometieron accidentes, por lo general las motos son las que mas violan estos permisos, tenia la idea en que las motos tendian un numero alto

vehiculos <- Tabla %>%
  group_by(`TIPO DE VEHICULO`,SEXO) %>% summarise(Cantidad = n()) %>% pivot_wider(names_from = SEXO, values_from = Cantidad)#pivot me vuelve los sexos como columnas en ves de valores
#agrupo por vehiculos y sexo y el summarise suma la cantidad de veces que aparecen

knitr::kable(vehiculos, align = "lcccc")#le añado su flow, la libreria multible cuenta con esto para embellecer las tablas, el alig es para ordenar las columnas, las l son left, c center y r right, se pone en orden igual a las columnas
TIPO DE VEHICULO CÉDULA NUEVA EMPRESA HOMBRE MUJER
CARRO 81 455 526 876
MOTO 7 17 89 69

como se puede observar, el resultado va contra mis pronosticos, este resultado y los siguientes apoyan una teoria que no puedo confirmar por la falta de datos, estos resultados pueden ser debidos a que las motos no conducen muy a menudo por las calles en las que se encuentran los medidores de infracciones, las motos son mas vistas en lugares mas rurales como barrios o ciudades.

si estos datos fueron sacados por un oficiales de transito tambien me atrevo a decir que los oficiales de transito tiran parar a aquellos que puedan contener mas dinero para asi atreverce a la probabilidad de un doborno porparte del conductor, me gustaria recalcar que son teorias, estoy tratando de tocar el tema de sobre la mediocridad de los sueldos y situaciones precarias en colombia.

#a menudo voy a estar creando tablas porcentajes por separado para mantener un orden, estas son usadas especialmente para crear los graficos pie
vehiculos_pocentaje <- Tabla %>% #uso la tabla central directamente
  group_by(SEXO) %>% #agrupo por sexo
  summarise(n = n()) %>%#sumo la cantidad de veces que aparece
  mutate(porcentaje = n / sum(n)) %>% # devido el valor anterior por la cantidad de registros de comparendos
  mutate(etiqueta = paste0(round(porcentaje * 100), "%"))#este se usa para ponerlo de valor en el grafico, es solo una etiqueta, para que se entieda a las personas

ggplot(vehiculos_pocentaje, aes(x = "", y = n, fill = as.factor(SEXO))) +
  #elojo de factor las columnas que estan agrupadas osea sexo, la x es vacia ya que por lo general no se esa este en graficos pie
  geom_bar(width = 1, stat = "identity") +
  geom_text(aes(label = etiqueta), #los valores que van a estar escritos en cada columna por etiquetas creadas
            position = position_stack(vjust = 0.5)) +#modifica la posicion del texto
  coord_polar(theta = "y", start = 0) +#convierte las columnas en un grafico pie
  theme_void() +
  labs(title = "cantidad de sexos comparendos",fill = "SEXO") # titulo del grafico y de contenido del grafico 

#se repite proceso
carros_pocentaje <- Tabla %>%
  filter(`TIPO DE VEHICULO` == "CARRO") %>%# necesito solo los sexos de personas que manejan carros
  group_by(SEXO) %>%
  summarise(n = n()) %>%
  mutate(porcentaje = n / sum(n)) %>%
  mutate(etiqueta = paste0(round(porcentaje * 100), "%"))

ggplot(carros_pocentaje, aes(x = "", y = n, fill = as.factor(SEXO))) +
  geom_bar(width = 1, stat = "identity") +
  geom_text(aes(label = etiqueta),
            position = position_stack(vjust = 0.5)) +
  coord_polar(theta = "y", start = 0) +
  theme_void() +
  labs(title = "cantidad de carros por sexo comparendos",fill = "SEXO")

#se repite proceso

motos_pocentaje <- Tabla %>%
  filter(`TIPO DE VEHICULO` == "MOTO") %>%
  group_by(SEXO) %>%
  summarise(n = n()) %>%
  mutate(porcentaje = n / sum(n)) %>%
  mutate(etiqueta = paste0(round(porcentaje * 100), "%"))

ggplot(motos_pocentaje, aes(x = "", y = n, fill = as.factor(SEXO))) +
  geom_bar(width = 1, stat = "identity") +
  geom_text(aes(label = etiqueta),
            position = position_stack(vjust = 0.5)) +
  coord_polar(theta = "y", start = 0) +
  theme_void() +
  labs(title = "cantidad de motos por sexo comparendos",fill = "SEXO")

En anteriores analisis que hice acerca de comparendos encontraba el mismo resultado, las mujeres cometian mayor cantidad de infracciones, las mujeres se encontraron en mayor cantidad con carros y en hombres en mayor cantidad con motos, los datos que la mujer haya cometido una cantidad grande de infracciones es o porque no tienen tanta soltura con el aprendizaje al manejar un carro o porque era un blanco mas apetecible para los policias de transito, ademas la mayoria de mujeres prefieren un carro en vez de moto, esto es muy comun de encontrar debido a los peligros que se expone el cuerpo del conductor de una moto

#infracciones por mes
años <- Tabla %>% group_by(`NOMBRE DEL MES`) %>% summarise(`NUMINFRACCIONES` = n())

knitr::kable(años, align = "llc")
NOMBRE DEL MES NUMINFRACCIONES
Abril 712
Mayo 1408 
#se repite proceso
porcentaje_meses <- Tabla %>%
  group_by(`NOMBRE DEL MES`) %>%
  summarise(Cantidad_total = n()) %>%
  mutate(porcentaje = Cantidad_total / sum(Cantidad_total)) %>%
  mutate(etiqueta = paste0(round(porcentaje * 100), "%"))

ggplot(porcentaje_meses,
       aes(x = "", y = Cantidad_total, fill = `NOMBRE DEL MES`)) +
  geom_bar(width = 1, stat = "identity") +
  geom_text(aes(label = etiqueta),
            position = position_stack(vjust = 0.5)) +
  coord_polar(theta = "y", start = 0) +
  theme_void() +
  labs(
    title = "Distribución de Comparendos por Mes",
    fill = "Meses"
  )

En realidad no tengo mucho que añadir, estos datos son del 2010, no cuento con la informacion de los lugares en que se cometieron estas infracciones, mayo tiene el doble que abril en infracciones

-Comparendos por Genero y Empresas

GENERO

#comparendos por sexo en diferentes meses
pagos <- Tabla %>%
  group_by(`NOMBRE DEL MES`,`SEXO`) %>%
  summarise(TOTAL = sum(`VALOR_A_PAGAR`)) %>% #sumo valor a pagar para que me de los precios de las infracciones
  pivot_wider(names_from = SEXO, values_from = TOTAL)

knitr::kable(pagos, align = "lcccc")
NOMBRE DEL MES CÉDULA NUEVA EMPRESA HOMBRE MUJER
Abril 12102500 56907500 68752500 81112500
Mayo 15192500 87292500 116647500 208060000 
#creo tablas diferentes porque quiero ver los sexos por meses separados
abril_pagos <- Tabla %>%
  filter(`NOMBRE DEL MES` == "Abril") %>%
  group_by(SEXO)%>%
  summarise(TOTAL = sum(VALOR_A_PAGAR))
#grafico de columnas
ggplot(abril_pagos,
       aes(x= SEXO,
           y= `TOTAL`)) + #x y son valores en plano carteciano, valores como yo quiero que se reflegen en mi grafico
  scale_y_continuous(labels = comma) + #lo uso para simplificar valores que se mostraban muy complejos al publico
  geom_col(fill = "lightgreen", color = "black") +#colores del grafico
  theme_classic() +
  labs(x = "Sexo",#nombre de x
       y = "Pagos por comparendo",#nombre de y
       title = "Total pagos de comparendo por sexo en ABRIL") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) + 
  geom_text(aes(label = comma(`TOTAL`)), vjust = -0.5, size = 3)#aca ajusto los valores y las columnas del grafico

#se repite el proceso
mayo_pagos <- Tabla %>%
  filter(`NOMBRE DEL MES` == "Mayo") %>%
  group_by(SEXO)%>%
  summarise(TOTAL = sum(VALOR_A_PAGAR))

ggplot(mayo_pagos,
       aes(x= SEXO,
           y= `TOTAL`)) + 
  scale_y_continuous(labels = comma) +
  geom_col(fill = "lightgreen", color = "black") +
  theme_classic() +
  labs(x = "Sexo",
       y = "Pagos por comparendo",
       title = "Total pagos de comparendo por sexo en MAYO") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) + 
  geom_text(aes(label = comma(`TOTAL`)), vjust = -0.5, size = 3)

Este calculo fue hecho para detectar alguna anomalia en los datos, suele pasar que a pesar de que un genero colecte una gran cantidad de numero de infracciones, otro genero tenga un numero alto de gastos, se puede deber a que el costo de las otras infracciones son altas a diferencia de las cometidas por el genero con mayor numero de infracciones, este no es el caso, los datos son al nivel de el mes y el genero en cantidad y gastos.

A continuacion analizaremos las empresas y comparendos

EMPRESA

#empresas y gastos de ellas
empresas_altos <- Tabla %>%
  filter(`SEXO` == "EMPRESA") %>%#me da solo las empresas
  group_by(`EJECUTADO`,`NOMBRE DEL MES`) %>%#me da el nombre y el mes
  summarise(TOTAL = sum(`VALOR_A_PAGAR`)) %>%
  pivot_wider(names_from = `NOMBRE DEL MES`, values_from = (TOTAL), values_fill = 0)%>%
  mutate(`TOTAL` = Abril + Mayo)%>%#uso mutate en las tablas me crea o me modifica una columna de mi tabla
  arrange(desc(TOTAL))%>%#me la da en forma decendente
  head(10)#me da los 10 primeros

knitr::kable(empresas_altos, align = "lccc")
EJECUTADO Abril Mayo TOTAL
LEASING DE CREDITO SA 13647500 21630000 35277500
TRANSPORTES MST Y CIA S. EN C 4377500 9527500 13905000
FINANCIERA INTERNACIONAL S.A 2060000 8497500 10557500
GMAC FINANCIERA DE COLOMBI 3347500 2832500 6180000
UINON FAMILIAR CHARRIS S.EN C 1030000 3090000 4120000
BENEMOTORS S.A. 1545000 1030000 2575000
FRANCISCO COLLAVINI CIA LTDA. 2060000 515000 2575000
COOTRANSCO LTDA 0 2317500 2317500
TRANSURBAR LTDA 1545000 772500 2317500
TRANSPORTES SAN CARLOS LTDA 1030000 772500 1802500 
#repito el proceso
empresas_bajos <- Tabla %>%
  filter(`SEXO` == "EMPRESA") %>%
  group_by(`EJECUTADO`,`NOMBRE DEL MES`) %>%
  summarise(TOTAL = sum(`VALOR_A_PAGAR`)) %>%
  pivot_wider(names_from = `NOMBRE DEL MES`, values_from = TOTAL, values_fill = 0)%>%#valies fill me cambia los valores en NA por 0
  mutate(`TOTAL` = Abril + Mayo)%>%
  arrange(desc(TOTAL))%>%
  tail(10)#me da los 10 ultimos
knitr::kable(empresas_bajos, align = "lccc")
EJECUTADO Abril Mayo TOTAL
PRODUCTOS JULIAO Y CIA. LTDA 257500 0 257500
PROMOTORA KOSMOS SA 0 257500 257500
PROQUIMICOS S.A. 0 257500 257500
RAMIREZ GARNICA & CIA. S. EN 257500 0 257500
RAMOS GOMEZ S EN C 0 257500 257500
SOCDE ACUED ALCANT Y ASEO DE 257500 0 257500
TECNIJURIDICA LTDA 0 257500 257500
TRANSPORTE AUTO TAXI EJECUTIVO 0 257500 257500
TRANSPORTES JICARIBE LTDA 257500 0 257500
TRANSPORTES SERVI ESPECIALES Y 0 257500 257500 
#se repite el proceso
ggplot(empresas_altos,
       aes(x= reorder(`EJECUTADO`, desc(`TOTAL`)),
           y= `TOTAL`)) + 
  scale_y_continuous(labels = comma) +
  geom_col(fill = "lightgreen", color = "black") +
  theme_classic() +
  labs(x = "Empresas",
       y = "Pagos por comparendo",
       title = "top 10 Empresa pagos altos en los dos Meses") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) + 
  geom_text(aes(label = comma(`TOTAL`)), vjust = -0.5, size = 3)

ggplot(empresas_bajos,
       aes(x= reorder(`EJECUTADO`, desc(`TOTAL`)),
           y= `TOTAL`)) + 
  scale_y_continuous(labels = comma) +
  geom_col(fill = "lightblue", color = "black") +
  theme_classic() +
  labs(x = "Empresas",
       y = "Pagos por comparendo",
       title = "top 10 Empresa pagos bajos en los dos Meses") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) + 
  geom_text(aes(label = comma(`TOTAL`)), vjust = -0.5, size = 3)

Las 10 empresas con mas gastos destacan empresas financieras y empresa de cootransco, LEASIND DE CREDITO SA en muy frecuente y ha generado grandes gastos, en las 10 menore no muestran diferencias, son muy uniformes, como mucho solo han cometido una infraccion, es probable que seqan mas de las 10 menores empresas las cuales sigan estando uniformes

-Infracciones mas frecuente

#se repite proceso
tipo_comparendo <- Tabla %>%
  group_by(`AÑO`, `NOMBRE DEL MES`, SEXO, `NOM_INFRACCION`)%>%
  summarise(CANTIDAD = n())%>%
  pivot_wider(names_from = `NOM_INFRACCION`, values_from = CANTIDAD, values_fill = 0)

knitr::kable(tipo_comparendo, align = "lllcccc")
AÑO NOMBRE DEL MES SEXO max velocidad maxima pasa paso peatonal pasar luz roja/amarilla sentido contrario
2010 Abril CÉDULA NUEVA 26 1 10 0
2010 Abril EMPRESA 151 10 30 0
2010 Abril HOMBRE 172 13 38 3
2010 Abril MUJER 182 19 56 1
2010 Mayo CÉDULA NUEVA 43 0 8 0
2010 Mayo EMPRESA 202 21 58 0
2010 Mayo HOMBRE 315 10 64 0
2010 Mayo MUJER 535 31 121 0 
#se repite proceso

infraccion_pocentaje <- Tabla %>%
  group_by(NOM_INFRACCION) %>%
  summarise(n = n()) %>%
  mutate(porcentaje = n / sum(n)) %>%
  mutate(etiqueta = paste0(round(porcentaje * 100), "%"))

ggplot(infraccion_pocentaje, aes(x = "", y = n, fill = as.factor(NOM_INFRACCION))) +
  geom_bar(width = 1, stat = "identity") +
  geom_text(aes(label = etiqueta),
            position = position_stack(vjust = 0.5)) +
  coord_polar(theta = "y", start = 0) +
  theme_void() +
  labs(title = "Distribución de Comparendos por infraccon",fill = "NOMBRE DE INFRACCION")

el 0% no significa que no hay infracciones cometidas, es solo que numero de estas es muy pequeño en comparacion al total y ni aun asi al dividir en 100 muestra los decimales, a continuacion una imagen de los datos del 0%

el tipo de infraccion de pasar la luz roja confira que estos datos tambien pueden provenir de lugares mas adentro de la ciudad o que son datos tomados por policias de trancito, es muy comun encontrar el exceso de velocidad es uno de los mas cometidos, y pasar la luz roja o amarilla en colombia, este tipo de comparendos en 2010 se basan acerca de la desesperacion en las calles por encia de la seguridad de los demas conductores y el conductor.

-Conclusion

los datos importantes que podemos obtener de estos son que las mujeres en carro y los hombres en moto cometen muchas infracciones y las infracciones son basadas en la prisa, los datos que se puedan deducir de la informacion van de posibles extorciones, inrresponsabilidad del conductor con la velocidad, empresa que es muy comun en cometer infracciones y empresas que se matienen muy uniforme, como ultimo y no menos importante la precariedad y los sucesos del pais SI se materializan en la calle, la falta de datos me obliga solo a usar datos globales de colombia pero en sectores si puede afectar

fuentes

-POLITICA DATA BASE OF AMERICA

-BASE DE DATOS COMPARENDOS