Objetivo de Investigación

Analizar los datos de permisos de circulación vehicular en Calbuco para identificar patrones y tendencias, y proponer mejoras en la gestión de permisos.

Introducción

Descripción del Conjunto de Datos

l conjunto de datos proviene de los registros de permisos de circulación de la Municipalidad de Calbuco y contiene información detallada sobre vehículos y sus permisos de circulación, incluyendo variables como tipo de vehículo, año de fabricación, marca, modelo, color, tipo de combustible, y valor del permiso.

Objetivos del Análisis

El objetivo principal es investigar y comprender los patrones y tendencias en los permisos de circulación vehicular en Calbuco. Específicamente, se busca:

Identificar las características más comunes de los vehículos que obtienen permisos de circulación. Analizar la distribución temporal de la obtención de permisos. Explorar posibles relaciones entre las características de los vehículos y el costo del permiso. Realizar un modelo que permita estimar la cantidad de pagos que se recibirán en un periodo de tiempo.

Procesamiento de Datos

El preprocesamiento de datos es un paso crucial para garantizar que los datos estén limpios y listos para el análisis. A continuación, se detallan los pasos tomados para limpiar y preparar los datos

Carga Librerias

Se cargan las librerías necesarias para la manipulación de datos, visualización y modelado, como dplyr, stringr, caret, corrplot, xgboost, entre otras.

# Cargar librerías necesarias
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(stringr)
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
library(corrplot)
## corrplot 0.92 loaded
library(xgboost)
## 
## Attaching package: 'xgboost'
## The following object is masked from 'package:dplyr':
## 
##     slice
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(kableExtra)
## 
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
## 
##     group_rows
library(summarytools)
library(httr)
## 
## Attaching package: 'httr'
## The following object is masked from 'package:caret':
## 
##     progress
library(zoo)
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(ggcorrplot)
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(gridExtra)
## 
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
## 
##     combine
library(grid)
library(rlang)

Cargas funciones y base de datos

Se cargan funciones específicas desde un archivo de GitHub y los datos de permisos de circulación desde un CSV en GitHub.

# Enlace raw al archivo de funciones en GitHub
source("https://raw.githubusercontent.com/jkcrs1/R/main/funciones.R")

# Permisos circulación  pagados en la municipalidad de calbuco
url3 <- "https://github.com/jkcrs1/R/raw/main/permiso_circulacion_calbuco.csv"

# Prueba con diferentes codificaciones
permiso <- read.csv(url3, sep = ";", fileEncoding = "ISO-8859-1")

Tipos de Variables

Se utiliza el paquete summarytools para generar un resumen detallado de las variables del dataframe.

# Obtener un resumen de los datos utilizando summarytools y renderizar en HTML
dfSummary(permiso) %>%
  print(method = 'render')

Data Frame Summary

permiso

Dimensions: 63886 x 24
Duplicates: 0
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 Municipalidad [character] 1. Calbuco
63886(100.0%)
 63886 (100.0%) 0 (0.0%)
2 Grupo.Vehiculo [character]
1. Carga
2. Transporte Publico
3. Vehiculo Liviano
2901(4.5%)
3124(4.9%)
57861(90.6%)
 63886 (100.0%) 0 (0.0%)
3 Placa [character]
1. BPJC-93
2. DSJC-63
3. BGRR-94
4. CDWD-10
5. DSHK-87
6. FDFC-14
7. GCLT-91
8. GCVD-49
9. PC-2600
10. ZT-6085
[ 17858 others ]
18(0.0%)
18(0.0%)
17(0.0%)
17(0.0%)
17(0.0%)
17(0.0%)
17(0.0%)
17(0.0%)
17(0.0%)
17(0.0%)
63714(99.7%)
 63886 (100.0%) 0 (0.0%)
4 Digito [character]
1. 0
2. 5
3. 3
4. 7
5. 9
6. 1
7. 2
8. K
9. 4
10. 6
[ 3 others ]
6218(9.7%)
5914(9.3%)
5903(9.2%)
5820(9.1%)
5812(9.1%)
5809(9.1%)
5779(9.0%)
5707(8.9%)
5703(8.9%)
5603(8.8%)
5618(8.8%)
 63886 (100.0%) 0 (0.0%)
5 Codigo.SII [character]
1. NULL
2. SD050028314
3. SD050028214
4. CT176023711
5. SD050029415
6. HB050011513
7. SD050028313
8. CT235013714
9. CT235013313
10. CT235013314
[ 7950 others ]
6801(10.6%)
208(0.3%)
194(0.3%)
150(0.2%)
131(0.2%)
126(0.2%)
112(0.2%)
111(0.2%)
109(0.2%)
108(0.2%)
55836(87.4%)
 63886 (100.0%) 0 (0.0%)
6 Ano.Vehiculo [integer]
Mean (sd) : 2009.3 (7.6)
min ≤ med ≤ max:
1966 ≤ 2011 ≤ 2024
IQR (CV) : 10 (0)
 55 distinct values 63886 (100.0%) 0 (0.0%)
7 Tasacion [character]
1. 1
2. 1,5
3. 0
4. 3
5. 0,5
6. 2
7. 1390000
8. 3350000
9. 1330000
10. 1080000
[ 10830 others ]
3628(5.7%)
933(1.5%)
686(1.1%)
611(1.0%)
517(0.8%)
422(0.7%)
158(0.2%)
129(0.2%)
127(0.2%)
125(0.2%)
56550(88.5%)
 63886 (100.0%) 0 (0.0%)
8 Tipo.de.Pago [character]
1. Internet
2. Presencial
11657(18.2%)
52229(81.8%)
 63886 (100.0%) 0 (0.0%)
9 Valor_Neto [character]
1. 32333
2. 23510
3. 23.115
4. 24.837
5. 24,837
6. 30885
7. 22478
8. 21599
9. 20.468
10. 30884
[ 26779 others ]
1334(2.1%)
1063(1.7%)
992(1.6%)
970(1.5%)
969(1.5%)
914(1.4%)
897(1.4%)
807(1.3%)
684(1.1%)
551(0.9%)
54705(85.6%)
 63886 (100.0%) 0 (0.0%)
10 Valor_IPC [character]
1. 0
2. 194
3. 46
4. 67
5. 86
6. 174
7. 47
8. 102
9. 309
10. 402
[ 2909 others ]
50977(79.8%)
260(0.4%)
231(0.4%)
212(0.3%)
191(0.3%)
173(0.3%)
167(0.3%)
163(0.3%)
117(0.2%)
97(0.2%)
11298(17.7%)
 63886 (100.0%) 0 (0.0%)
11 Valor_Multa [character]
1. 0
2. 463
3. 373
4. 488
5. 347
6. 338
7. 353
8. 745
9. 325
10. 309
[ 5982 others ]
47242(73.9%)
358(0.6%)
277(0.4%)
252(0.4%)
211(0.3%)
204(0.3%)
195(0.3%)
189(0.3%)
182(0.3%)
152(0.2%)
14624(22.9%)
 63886 (100.0%) 0 (0.0%)
12 Valor.Pagado [character]
1. 32333
2. 23510
3. 23.115
4. 24.837
5. 24,837
6. 30885
7. 22478
8. 21599
9. 20.468
10. 30884
[ 26852 others ]
1334(2.1%)
1063(1.7%)
992(1.6%)
970(1.5%)
969(1.5%)
914(1.4%)
897(1.4%)
807(1.3%)
684(1.1%)
551(0.9%)
54705(85.6%)
 63886 (100.0%) 0 (0.0%)
13 Forma.Pago [character]
1. 1ra. Cuota
2. 2da. Cuota
3. Total
13093(20.5%)
11094(17.4%)
39699(62.1%)
 63886 (100.0%) 0 (0.0%)
14 Fecha_Pago [character]
1. 27-04-24
2. 29-03-18
3. 31-03-17
4. 31-03-16
5. 2020-04-30T00:00:00
6. 30-04-20
7. 31-03-23
8. 31-03-14
9. 28-03-18
10. 31-03-15
[ 1901 others ]
724(1.1%)
482(0.8%)
466(0.7%)
426(0.7%)
398(0.6%)
398(0.6%)
395(0.6%)
382(0.6%)
380(0.6%)
373(0.6%)
59462(93.1%)
 63886 (100.0%) 0 (0.0%)
15 Ano.Permiso [integer]
Mean (sd) : 2018.9 (3.2)
min ≤ med ≤ max:
2007 ≤ 2019 ≤ 2024
IQR (CV) : 6 (0)
 18 distinct values 63886 (100.0%) 0 (0.0%)
16 Tipo.Vehiculo [character]
1. AUTOMOVIL
2. CAMIONETA
3. STATION WAGON
4. FURGON
5. CAMION
6. JEEP
7. MOTO
8. TAXI COLECTIVO
9. BUS
10. TAXI BASICO
[ 34 others ]
24370(38.1%)
20250(31.7%)
8643(13.5%)
1728(2.7%)
1575(2.5%)
907(1.4%)
888(1.4%)
812(1.3%)
703(1.1%)
631(1.0%)
3379(5.3%)
 63886 (100.0%) 0 (0.0%)
17 Marca [character]
1. CHEVROLET
2. NISSAN
3. TOYOTA
4. HYUNDAI
5. SUZUKI
6. MITSUBISHI
7. KIA MOTORS
8. FORD
9. PEUGEOT
10. RENAULT
[ 227 others ]
11297(17.7%)
8237(12.9%)
6516(10.2%)
5355(8.4%)
3759(5.9%)
3564(5.6%)
3329(5.2%)
2648(4.1%)
2253(3.5%)
1302(2.0%)
15626(24.5%)
 63886 (100.0%) 0 (0.0%)
18 Modelo [character]
1. HILUX
2. L200
3. TERRANO
4. YARIS
5. SAIL NB 1.4
6. ACCENT
7. SAIL
8. D-MAX
9. SAIL NB 1.4 LS
10. RANGER
[ 5191 others ]
943(1.5%)
914(1.4%)
603(0.9%)
497(0.8%)
458(0.7%)
452(0.7%)
404(0.6%)
324(0.5%)
319(0.5%)
290(0.5%)
58682(91.9%)
 63886 (100.0%) 0 (0.0%)
19 Color [character]
1. BLANCO
2. ROJO
3. PLATEADO
4. NEGRO
5. AZUL
6. PLATEADO PLATA
7. GRIS
8. ROJO METALICO
9. GRIS GRAFITO
10. VERDE
[ 1641 others ]
14505(22.7%)
5591(8.8%)
3379(5.3%)
2047(3.2%)
1906(3.0%)
1749(2.7%)
1695(2.7%)
1148(1.8%)
1128(1.8%)
1124(1.8%)
29614(46.4%)
 63886 (100.0%) 0 (0.0%)
20 Transmision [character]
1. Aut
2. AUT
3. CVT
4. DCT
5. Mec
6. MEC
7. NULL
4618(7.2%)
72(0.1%)
25(0.0%)
1(0.0%)
52381(82.0%)
1879(2.9%)
4910(7.7%)
 63886 (100.0%) 0 (0.0%)
21 Tipo.Combustible [character]
1. Benc
2. BENC
3. Dies
4. DIES
5. DUAL
6. Elec
7. GASN
8. Hibr
9. NULL
39927(62.5%)
1086(1.7%)
17027(26.7%)
1220(1.9%)
1(0.0%)
2(0.0%)
2(0.0%)
2(0.0%)
4619(7.2%)
 63886 (100.0%) 0 (0.0%)
22 Cilindrada [character]
1. 1600
2. 2500
3. 1400
4. 2400
5. 1500
6. NULL
7. 2000
8. 1200
9. 1300
10. 2200
[ 117 others ]
11389(17.8%)
8838(13.8%)
5635(8.8%)
4939(7.7%)
4881(7.6%)
4756(7.4%)
4155(6.5%)
2122(3.3%)
1942(3.0%)
1838(2.9%)
13391(21.0%)
 63886 (100.0%) 0 (0.0%)
23 Equipamiento [character]
1. Equi
2. EQUI
3. Full
4. FULL
5. Norm
6. NORM
7. NULL
14127(22.1%)
944(1.5%)
25060(39.2%)
494(0.8%)
14644(22.9%)
568(0.9%)
8049(12.6%)
 63886 (100.0%) 0 (0.0%)
24 Numero.Puertas [character]
1. 0
2. 1
3. 2
4. 3
5. 4
6. 5
7. NULL
5630(8.8%)
66(0.1%)
8280(13.0%)
284(0.4%)
48777(76.4%)
848(1.3%)
1(0.0%)
 63886 (100.0%) 0 (0.0%)

Generated by summarytools 1.0.1 (R version 4.4.0)
2024-06-26

Normalización de las Variables

Se normalizan y limpian las variables del conjunto de datos, recodificando variables categóricas, reemplazando valores nulos y transformando datos según sea necesario.

# Convertir permiso a data.frame (por si no lo es)
permiso <- data.frame(permiso)

# Cambio de nombres de columnas: reemplazar puntos por guiones bajos y convertir a minúsculas
colnames(permiso) <- colnames(permiso) %>% str_replace_all("\\.", "_") %>% tolower()

# Mapas de recodificación
tipo_vehiculo_mapeo <- c(
  "AMBULANCIA" = "AMBULANCIA", "AUTOMOVIL" = "AUTOMOVIL", "BUS" = "BUS",
  "Cabriolet" = "AUTOMOVIL", "CAMION" = "CAMION", "CAMIONETA" = "CAMIONETA",
  "CARRO ARRASTRE A" = "REMOLQUE", "CARRO BOMBA" = "CARRO BOMBA",
  "CASA RODANTE" = "CASA RODANTE", "Comercial" = "COMERCIAL", "CUATRIMOTO" = "CUATRIMOTO",
  "FURGON" = "FURGON", "GRUA" = "MAQUINA PESADA", "Hatchback" = "AUTOMOVIL",
  "JEEP" = "AUTOMOVIL", "MAQUINA INDUSTRIAL" = "MAQUINA INDUSTRIAL",
  "MINIBUS" = "MINIBUS", "MINIBUS ESCOLAR" = "MINIBUS", "MINIBUS PARTICULAR" = "MINIBUS",
  "MINIBUS PRIVADO" = "MINIBUS", "MINIBUS TURISMO" = "MINIBUS", "MOTO" = "MOTOCICLETA",
  "MOTOCICLETA" = "MOTOCICLETA", "OTROS" = "OTROS", "REMOLQUE A" = "REMOLQUE",
  "REMOLQUE B" = "REMOLQUE", "RETROEXCAVADORA" = "MAQUINA PESADA", "Sedan" = "AUTOMOVIL",
  "SEMI REMOLQUE" = "REMOLQUE", "STATION WAGON" = "AUTOMOVIL", "SUV" = "SUV",
  "TAXI EJECUTIVO" = "TAXI", "TAXI BASICO" = "TAXI", "TAXI COLECTIVO" = "TAXI",
  "TRACTOCAMION" = "CAMION", "TRACTOR" = "TRACTOR", "VAN" = "VAN"
)

tipo_combustible_mapeo <- c(
  "Benc" = "Bencina", "Dies" = "Diesel", "NULL" = "NULL",
  "DUAL" = "Hibrido", "Hibr" = "Hibrido", "Elec" = "Electrico"
)

transmision_mapeo <- c(
  "Mec" = "Mecanica", "Aut" = "Automatica", "NULL" = "NULL",
  "CVT" = "Automatica", "DCT" = "Automatica"
)

# Mostrar la cantidad de registros iniciales
cat("La cantidad de registros:", nrow(permiso), "\n")
## La cantidad de registros: 63886
# Aplicar todas las transformaciones y normalizaciones
permiso <- permiso %>%
  mutate(
    # Recodificar las variables categóricas
    tipo_vehiculo = recode(tipo_vehiculo, !!!tipo_vehiculo_mapeo),
    tipo_combustible = recode(tipo_combustible, !!!tipo_combustible_mapeo),
    transmision = recode(transmision, !!!transmision_mapeo),
    
    # Reemplazar nulos en todas las variables
    across(everything(), reemplazar_nulos),
    
    # Convertir a título en variables específicas
    across(c(municipalidad, grupo_vehiculo, placa, digito, codigo_sii,
             forma_pago, tipo_vehiculo, marca, modelo, color,
             transmision, tipo_combustible, equipamiento), str_to_title),
    
    # Quitar las "," y "." de los campos de valores 
    across(c(valor_neto, valor_ipc, valor_multa, valor_pagado), 
                ~ as.numeric(gsub("[,\\.]", "", .))),
    
    # Convertir tipos de datos
    ano_vehiculo = as.integer(ano_vehiculo),
    fecha_pago = as.Date(fecha_pago, format = "%d-%m-%y"),
    ano_pago = as.integer(year(fecha_pago)),
    mes = month(fecha_pago, label = TRUE),
    mes_pago = as.integer(month(fecha_pago)),
    
    # Crear la variable Ano_Mes_Pago
    ano_mes_pago = paste(sprintf("%02d", mes_pago), substr(ano_pago, 3, 4), sep = "-")
  ) %>%
  # Filtrar y eliminar duplicados
  filter(!is.na(valor_pagado) & !is.na(fecha_pago) & valor_pagado > 0) %>%
  distinct()

# Mostrar la cantidad de registros válidos
cat("La cantidad de registros válidos:", nrow(permiso), "\n")
## La cantidad de registros válidos: 56566

Traformación de variables categoricas a Factor

Las variables categóricas se transforman a factores para asegurar un análisis adecuado.

# Transformar las variables a factor con los niveles definidos
permiso <- permiso %>%
  mutate(across(where(is.character), as.factor),
         fecha = as.Date(paste(ano_pago, mes_pago, "01", sep = "-"), format = "%Y-%m-%d"),
         ano_mes_pago = paste(sprintf("%02d", mes_pago), substr(ano_pago, 3, 4), sep = "-")) %>%
  arrange(fecha) %>%
  mutate(ano_mes_pago = factor(ano_mes_pago, levels = unique(ano_mes_pago))) %>%
  select(-fecha)

Análisis Exploratorio de Datos (EDA)

Seleccionar variables relevantes

Se seleccionan las variables relevantes para el análisis.

permiso_relevante <- permiso %>%
  select(grupo_vehiculo, ano_vehiculo, tipo_de_pago, fecha_pago, ano_pago, mes, mes_pago, ano_mes_pago, valor_neto, valor_ipc, valor_multa, valor_pagado, forma_pago, tipo_vehiculo, marca)

Muestreo

Se realiza un muestreo estratificado para asegurar una representación adecuada de cada grupo en los datos.

# Calcular la muestra aleatoria según Desviación Estándar
cant <- nrow(permiso_relevante)
sd <- sd(permiso_relevante$valor_pagado)
n <- tam.muestra(alfa = 0.05, epsilon = 1200, s = sd, N = cant)
set.seed(2)
cant <- sample(nrow(permiso_relevante), n)
permiso_muestra <- permiso_relevante[cant, ]

cat("La cantidad de registros de muestra es:", nrow(permiso_muestra))
## La cantidad de registros de muestra es: 13043

Distribucion de Pagos por Año y Meses

Se analiza la distribución de pagos de permisos de circulación por año y mes.

# Preparar los datos para el gráfico de área
area_data <- permiso_muestra %>%
  group_by(ano_pago, mes) %>%
  summarise(count = n(), .groups = 'drop')

grafico1 <- grafico_histograma(permiso_muestra, "ano_pago")
grafico2 <- grafico_area(area_data, "mes", "count", "ano_pago")

mostrar_graficos(grafico1, grafico2, ncol = 2)

La distribución general muestra una tendencia creciente en la cantidad de pagos de un año a otro. Cabe destacar que por la pandimia, no se realizaron pagos de permisos de circulación durante los años 2020 - 2021.

Como era de esperar, existe un fuerte patrón estacional en los pagos de permisos de circulación, con la mayoría de los pagos concentrados en los primeros meses del año, particularmente en marzo y abril.

Variable: Grupo Vehículo.

Se crean gráficos para analizar la distribución de pagos por tipo de vehículo.

# Crear gráficos individuales
grafico1 <- grafico_anillo(permiso_muestra,"grupo_vehiculo")
grafico2 <- grafico_barras(permiso_muestra,"tipo_vehiculo")

# Mostrar los gráficos juntos
mostrar_graficos(grafico1, grafico2, ncol = 2)

El 90% de los permisos de circulación son pagados por vehiculos livianos,concentrándose, en su mayoría, en Automóvil y Camioneta.

Valor Pago por Categoria

vehiculo_liviano_dataset <- permiso_muestra %>% filter(`grupo_vehiculo` == "Vehiculo Liviano")
transporte_publico_dataset <- permiso_muestra %>% filter(`grupo_vehiculo` == "Transporte Publico")
carga_dataset <- permiso_muestra %>% filter(`grupo_vehiculo` == "Carga")


# Crear gráficos individuales
grafico1 <- grafico_boxplot(vehiculo_liviano_dataset, "valor_pagado","Vehiculo Liviano")
grafico2 <- grafico_boxplot(transporte_publico_dataset, "valor_pagado","Transporte Publico")
grafico3 <- grafico_boxplot(carga_dataset, "valor_pagado","Carga")



# Mostrar los gráficos juntos
mostrar_graficos(grafico1, grafico2,grafico3, ncol = 3)

BoxPlot por tipo de Vehiculo

grafico1 <- grafico_barras(vehiculo_liviano_dataset,"tipo_vehiculo")
grafico2 <- grafico_boxplot_dos_var(vehiculo_liviano_dataset, "tipo_vehiculo","valor_pagado")



# Mostrar los gráficos juntos
mostrar_graficos(grafico1, grafico2, ncol = 2)

## Selecionar Dataset de Automoviles y Camionetas

Debido a que concentran gran parte de los permisos de circulación que son pagados, en análisis se centrará en Automoviles y Camionetas.

vehiculo_dataset <- vehiculo_liviano_dataset %>% 
  filter(tipo_vehiculo == "Automovil" | tipo_vehiculo == "Camioneta")

grafico_anillo(vehiculo_dataset,"tipo_vehiculo")

Tratamiento de Outliers

Se identifican y eliminan outliers de los datos para asegurar un análisis más preciso.

automovil_dataset <- vehiculo_liviano_dataset %>% 
  filter(tipo_vehiculo == "Automovil")

camioneta_dataset <- vehiculo_liviano_dataset %>% 
  filter(tipo_vehiculo == "Camioneta")

resultado1 <- eliminar_outliers(automovil_dataset, "valor_pagado")
resultado2 <- eliminar_outliers(camioneta_dataset, "valor_pagado")

dataset_sin_outliers1 <- resultado1$dataset_sin_outliers
dataset_sin_outliers2 <- resultado2$dataset_sin_outliers


vehiculo_sin_outliers <- bind_rows(dataset_sin_outliers1, dataset_sin_outliers2)



cat("Número de registros originales:", nrow(vehiculo_dataset), "\n")
## Número de registros originales: 11030
cat("Número de registros sin outliers:", nrow(vehiculo_sin_outliers), "\n")
## Número de registros sin outliers: 10048
vehiculo_dataset<- vehiculo_sin_outliers

Boxplot por tipo de vehiculo

automovil_dataset <- vehiculo_dataset %>% filter(`tipo_vehiculo` == "Automovil")
camioneta_dataset <- vehiculo_dataset %>% filter(`tipo_vehiculo` == "Camioneta")

# Crear gráficos individuales
grafico1 <- grafico_boxplot(automovil_dataset, "valor_pagado","Automovil")
grafico2 <- grafico_boxplot(camioneta_dataset, "valor_pagado","Camioneta")



# Mostrar los gráficos juntos
mostrar_graficos(grafico1, grafico2, ncol = 2)

Matriz de correlacion

Se analiza la correlación entre las variables del conjunto de datos.

# Crear gráficos individuales
grafico1 <- grafico_matriz_correlacion( vehiculo_dataset)
grafico2 <- grafico_dispersion(vehiculo_dataset, "ano_vehiculo","valor_pagado")

# Mostrar los gráficos juntos
mostrar_graficos(grafico1, grafico2, ncol = 2)

Distribución de Pagos en Grupos de Vehículos por Meses Relativos

Se genera un resumen de las variables normalizadas utilizando summarytools.

# Filtrar y transformar los datos

vehiculo_dataset <- vehiculo_dataset %>%
  arrange(fecha_pago) %>%
  group_by(tipo_vehiculo) %>%
  mutate(
    fecha_relativa = as.yearmon(fecha_pago),
    mes_relativo = as.integer((min(fecha_relativa) - fecha_relativa) * 12)*-1
  ) %>%
  ungroup()

# Resumir los datos por mes relativo y grupo de vehículo
pagos_por_mes_relativo <- vehiculo_dataset %>%
  group_by(tipo_vehiculo, mes_relativo) %>%
  summarise(Cantidad_Pagos = n(), .groups = 'drop')

grafico_lineas(pagos_por_mes_relativo, "mes_relativo", "Cantidad_Pagos", "tipo_vehiculo")

Se observa una tendencia proporcionada entre ambos tipos de vehículos, donde ambos tienen un comportamiento similar.

Valores Nulos y reemplazar por la Mediana

En caso que se encuentren valores, se reemplazan por el valor de la mediana de cada variable.

#Imputar valores nulos por la mediana
vehiculo_dataset <- vehiculo_dataset %>%
  mutate(across(everything(), reemplazar_por_mediana))

Descripcion de Variables normalizadas

# Obtener un resumen de los datos utilizando summarytools y renderizar en HTML
dfSummary(vehiculo_dataset) %>%
  print(method = 'render')

Data Frame Summary

vehiculo_dataset

Dimensions: 10048 x 17
Duplicates: 98
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 grupo_vehiculo [factor]
1. Carga
2. Transporte Publico
3. Vehiculo Liviano
0(0.0%)
0(0.0%)
10048(100.0%)
 10048 (100.0%) 0 (0.0%)
2 ano_vehiculo [integer]
Mean (sd) : 2008.1 (7.5)
min ≤ med ≤ max:
1966 ≤ 2010 ≤ 2024
IQR (CV) : 11 (0)
 50 distinct values 10048 (100.0%) 0 (0.0%)
3 tipo_de_pago [factor]
1. Internet
2. Presencial
1951(19.4%)
8097(80.6%)
 10048 (100.0%) 0 (0.0%)
4 fecha_pago [Date]
min : 2014-01-07
med : 2018-03-28
max : 2024-05-11
range : 10y 4m 4d
 1224 distinct values 10048 (100.0%) 0 (0.0%)
5 ano_pago [integer]
Mean (sd) : 2018.7 (3.3)
min ≤ med ≤ max:
2014 ≤ 2018 ≤ 2024
IQR (CV) : 7 (0)
2014:941(9.4%)
2015:1058(10.5%)
2016:1222(12.2%)
2017:1205(12.0%)
2018:1372(13.7%)
2020:1448(14.4%)
2023:1743(17.3%)
2024:1059(10.5%)
 10048 (100.0%) 0 (0.0%)
6 mes [ordered, factor]
1. Jan
2. Feb
3. Mar
4. Apr
5. May
6. Jun
7. Jul
8. Aug
9. Sep
10. Oct
[ 2 others ]
101(1.0%)
220(2.2%)
4578(45.6%)
1725(17.2%)
567(5.6%)
364(3.6%)
245(2.4%)
1005(10.0%)
824(8.2%)
205(2.0%)
214(2.1%)
 10048 (100.0%) 0 (0.0%)
7 mes_pago [integer]
Mean (sd) : 4.8 (2.5)
min ≤ med ≤ max:
1 ≤ 4 ≤ 12
IQR (CV) : 3 (0.5)
 12 distinct values 10048 (100.0%) 0 (0.0%)
8 ano_mes_pago [factor]
1. 01-14
2. 02-14
3. 03-14
4. 04-14
5. 05-14
6. 06-14
7. 07-14
8. 08-14
9. 09-14
10. 10-14
[ 81 others ]
8(0.1%)
16(0.2%)
530(5.3%)
101(1.0%)
15(0.1%)
15(0.1%)
9(0.1%)
120(1.2%)
95(0.9%)
16(0.2%)
9123(90.8%)
 10048 (100.0%) 0 (0.0%)
9 valor_neto [numeric]
Mean (sd) : 45422.3 (33141.4)
min ≤ med ≤ max:
61 ≤ 32333 ≤ 195347
IQR (CV) : 33561.8 (0.7)
 5757 distinct values 10048 (100.0%) 0 (0.0%)
10 valor_ipc [numeric]
Mean (sd) : 155.2 (670.4)
min ≤ med ≤ max:
0 ≤ 0 ≤ 12625
IQR (CV) : 0 (4.3)
 863 distinct values 10048 (100.0%) 0 (0.0%)
11 valor_multa [numeric]
Mean (sd) : 658.5 (2277.3)
min ≤ med ≤ max:
0 ≤ 0 ≤ 36686
IQR (CV) : 235 (3.5)
 1432 distinct values 10048 (100.0%) 0 (0.0%)
12 valor_pagado [numeric]
Mean (sd) : 46235.9 (33531.2)
min ≤ med ≤ max:
61 ≤ 32996 ≤ 195347
IQR (CV) : 34475.2 (0.7)
 5790 distinct values 10048 (100.0%) 0 (0.0%)
13 forma_pago [factor]
1. 1ra. Cuota
2. 2da. Cuota
3. Total
2363(23.5%)
2016(20.1%)
5669(56.4%)
 10048 (100.0%) 0 (0.0%)
14 tipo_vehiculo [factor]
1. Ambulancia
2. Automovil
3. Bicimoto
4. Bus
5. Camion
6. Camioneta
7. Cargador Frontal
8. Carro Bomba
9. Carro De Arrastre B
10. Casa Rodante
[ 18 others ]
0(0.0%)
6205(61.8%)
0(0.0%)
0(0.0%)
0(0.0%)
3843(38.2%)
0(0.0%)
0(0.0%)
0(0.0%)
0(0.0%)
0(0.0%)
 10048 (100.0%) 0 (0.0%)
15 marca [factor]
1. 208
2. Aerovan
3. Agrale
4. Ale
5. Alfa Romero
6. American Motors
7. Asia Motors
8. Audi
9. Austin
10. Autorrad
[ 226 others ]
0(0.0%)
0(0.0%)
0(0.0%)
0(0.0%)
0(0.0%)
4(0.0%)
0(0.0%)
3(0.0%)
0(0.0%)
2(0.0%)
10039(99.9%)
 10048 (100.0%) 0 (0.0%)
16 fecha_relativa [yearmon] 89 distinct values 10048 (100.0%) 0 (0.0%)
17 mes_relativo [numeric]
Mean (sd) : 60.4 (40.2)
min ≤ med ≤ max:
0 ≤ 50 ≤ 123
IQR (CV) : 84 (0.7)
 59 distinct values 10048 (100.0%) 0 (0.0%)

Generated by summarytools 1.0.1 (R version 4.4.0)
2024-06-26

4. Modelado de Datos

Aplicación de técnicas de modelado de datos y algoritmos de aprendizaje automático para estimar la cantidad de permisos que se pagarán en los próximos 6 meses por grupo y tipo de vehículo.

Técnicas y Algoritmos

1. Selección del Modelo

Se selecciona el modelo XGBoost para estimar la cantidad de permisos que se pagarán en los próximos 6 meses por grupo y tipo de vehículo.

2. Entrenamiento y Evaluación

Se entrena el modelo XGBoost con los datos y se evalúa su rendimiento utilizando métricas como RMSE y R2. est ### Seleccionar los datos

# Configurar semilla para reproducibilidad
set.seed(123)

# Filtrar los datos hasta el año 2018
dataset_modelo <- vehiculo_dataset %>%
  filter(ano_pago <= 2018)

# Definir el tamaño de la muestra por cada categoría de tipo_vehiculo
tamano_muestra <- min(dataset_modelo %>% count(tipo_vehiculo) %>% pull(n))

# Muestreo estratificado para asegurar la misma cantidad de datos por categoría
dataset_modelo <- dataset_modelo %>%
  group_by(tipo_vehiculo) %>%
  sample_n(tamano_muestra) %>%
  ungroup()

grafico_torta(dataset_modelo, "tipo_vehiculo")

Seleccionar Datos

# Calcular el mes relativo
dataset_modelo <- dataset_modelo %>%
  arrange(fecha_pago) %>%
  group_by(tipo_vehiculo) %>%
  mutate(
    fecha_relativa = as.yearmon(fecha_pago),
    mes_relativo = as.integer((min(fecha_relativa) - fecha_relativa) * 12)*-1
  ) %>%
  ungroup()

# Crear la variable de cantidad de permisos por grupo de vehículo
cantidad_permisos <- dataset_modelo %>%
  group_by(tipo_vehiculo, mes_relativo) %>%
  summarise(cantidad_permisos = n(), .groups = 'drop')

# Preparar datos con todas las variables
datos_completos <- dataset_modelo %>%
  left_join(cantidad_permisos, by = c("tipo_vehiculo", "mes_relativo"))

# Convertir variables categóricas a factores
datos_completos <- datos_completos %>%
  mutate_if(is.character, as.factor)

# Dividir los datos en conjuntos de entrenamiento (80%) y prueba (20%)
set.seed(1234)
trainIndex <- createDataPartition(datos_completos$cantidad_permisos, p = .8, 
                                  list = FALSE, 
                                  times = 1)
permisoTrain <- datos_completos[trainIndex,]
permisoTest  <- datos_completos[-trainIndex,]

# Asegurar que los niveles de las variables categóricas sean consistentes entre entrenamiento y prueba
permisoTest <- permisoTest %>%
  mutate(across(where(is.factor), ~ factor(.x, levels = levels(permisoTrain[[cur_column()]]))))

# Convertir variables categóricas a indicadores binarios (dummies)
permisoTrain_matrix <- model.matrix(~ . - 1, data = permisoTrain %>% select(-cantidad_permisos))
permisoTest_matrix <- model.matrix(~ . - 1, data = permisoTest %>% select(-cantidad_permisos))

# Crear DMatrix para XGBoost
dtrain_cantidad <- xgb.DMatrix(data = permisoTrain_matrix, label = permisoTrain$cantidad_permisos)
dtest_cantidad <- xgb.DMatrix(data = permisoTest_matrix, label = permisoTest$cantidad_permisos)

# Definir parámetros para el modelo XGBoost
params <- list(booster = "gbtree", objective = "reg:squarederror", eta = 0.3, max_depth = 6)

# Entrenar el modelo XGBoost
modelo_xgb_cantidad <- xgb.train(params, dtrain_cantidad, nrounds = 100)

# Evaluar el modelo
pred_xgb_cantidad <- predict(modelo_xgb_cantidad, dtest_cantidad)
rmse_xgb_cantidad <- RMSE(pred_xgb_cantidad, permisoTest$cantidad_permisos)
rsq_xgb_cantidad <- R2(pred_xgb_cantidad, permisoTest$cantidad_permisos)

# Mostrar resultados del modelo
resultados_cantidad <- tibble(
  Modelo = "XGBoost",
  RMSE = rmse_xgb_cantidad,
  R2 = rsq_xgb_cantidad
)

print(resultados_cantidad)
## # A tibble: 1 × 3
##   Modelo   RMSE    R2
##   <chr>   <dbl> <dbl>
## 1 XGBoost 0.405  1.00
# Predicciones vs. Valores Reales
pred_df <- data.frame(
  Actual = permisoTest$cantidad_permisos,
  Predicted = pred_xgb_cantidad
)

grafico_pred_vs_real <- ggplot(pred_df, aes(x = Actual, y = Predicted)) +
  geom_point(alpha = 0.5) +
  geom_abline(slope = 1, intercept = 0, color = "red") +
  labs(title = "Predicciones vs. Valores Reales", x = "Valores Reales", y = "Predicciones") +
  theme_minimal()


# Residuos
residuals <- pred_df$Actual - pred_df$Predicted

grafico_residuos <- ggplot(pred_df, aes(x = Predicted, y = residuals)) +
  geom_point(alpha = 0.5) +
  geom_hline(yintercept = 0, color = "red") +
  labs(title = "Gráfico de Residuos", x = "Predicciones", y = "Residuos") +
  theme_minimal()



mostrar_graficos(grafico_pred_vs_real, grafico_residuos, ncol = 2)

La mayoría de los puntos están alineados a lo largo de la línea roja, lo que indica que las predicciones del modelo son muy precisas. La mayoría de los residuos están cerca de la línea roja horizontal (residuo = 0), lo que indica que las predicciones son precisas y los errores son pequeños.

# Importancia en las variables
importance_matrix <- xgb.importance(feature_names = colnames(permisoTrain_matrix), model = modelo_xgb_cantidad)
xgb.plot.importance(importance_matrix, top_n = 15)

La variable “mes^7” es la más influyente, con una importancia mucho mayor que las demás. Esto sugiere que la variación en el mes tiene un impacto significativo en la predicción de la cantidad de permisos.

5. Interpretación de Resultados

La evaluación del modelo XGBoost ha arrojado resultados muy positivos, con un RMSE (Root Mean Square Error) de 0.4046614 y un R² de 0.9999835. Estos valores indican que el modelo tiene un desempeño excelente en la predicción de la cantidad de permisos de circulación.

RMSE (Root Mean Square Error): El RMSE es una métrica que mide el error promedio de las predicciones del modelo. Un RMSE de 0.4046614 sugiere que el modelo comete un error muy bajo al predecir la cantidad de permisos, lo cual es un resultado muy favorable.

R² (Coeficiente de Determinación): El R² de 0.9999835 indica que el modelo explica el 99.99835% de la variabilidad en los datos de permisos de circulación. Un R² tan cercano a 1 implica que el modelo tiene una precisión extremadamente alta y que las predicciones están muy bien alineadas con los valores reales.

Conclusión

El análisis de los datos de permisos de circulación vehicular en Calbuco mediante el modelo XGBoost ha demostrado ser muy eficaz. Los resultados sugieren que el modelo puede predecir con gran precisión la cantidad de permisos que se pagarán en el futuro, lo cual es una herramienta valiosa para la planificación y gestión de recursos en la municipalidad.