Modelo seguridad vial
2025-02-22
Modelo de seguridad vial
Cargar librerías necesarias
library(tidyverse) # Manipulación de datos## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(readxl) # Leer archivos Excel
library(sf) # Manejo de datos espaciales## Linking to GEOS 3.13.0, GDAL 3.10.1, PROJ 9.5.1; sf_use_s2() is TRUElibrary(spdep) # Modelos espaciales## Loading required package: spData
## To access larger datasets in this package, install the spDataLarge
## package with: `install.packages('spDataLarge',
## repos='https://nowosad.github.io/drat/', type='source')`library(car) # Diagnóstico de modelos## Loading required package: carData
##
## Attaching package: 'car'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## somelibrary(MASS) # Modelos generalizados##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## selectlibrary(spgwr) # Regresión Ponderada Geográficamente (GWR)## Loading required package: sp
## NOTE: This package does not constitute approval of GWR
## as a method of spatial analysis; see example(gwr)library(lmtest) # Pruebas estadísticas## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(caret) # Evaluación de modelos## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## liftlibrary(ggplot2) # Gráficos
library(knitr) # Reportes en Markdown
library(mgcv) # Modelos aditivos generalizados## Loading required package: nlme
##
## Attaching package: 'nlme'
##
## The following object is masked from 'package:dplyr':
##
## collapse
##
## This is mgcv 1.9-1. For overview type 'help("mgcv-package")'.library(GWmodel) # Modelos ponderados geográficamente## Loading required package: robustbase
## Loading required package: Rcpp
## Welcome to GWmodel version 2.4-2.library(randomForest) # Random Forest## randomForest 4.7-1.2
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
##
## The following object is masked from 'package:dplyr':
##
## combine
##
## The following object is masked from 'package:ggplot2':
##
## marginlibrary(brms) # Modelos bayesianos## Loading 'brms' package (version 2.22.0). Useful instructions
## can be found by typing help('brms'). A more detailed introduction
## to the package is available through vignette('brms_overview').
##
## Attaching package: 'brms'
##
## The following object is masked from 'package:robustbase':
##
## epilepsy
##
## The following objects are masked from 'package:mgcv':
##
## s, t2
##
## The following object is masked from 'package:stats':
##
## arlibrary(forcats)Cargar Base de datos
df <- read_excel("C:/Users/tomas/Documents/ArcGIS/Projects/Caso 1 Seguridad Vial/Siniestros_ciclistas_modelo.xlsx")Exploración de datos
df <- df %>%
dplyr::select(
# Variables de tiempo y accidente
MES_OCURRE, CLASE_ACC, GRAVEDAD,
# Variables de persona
EDAD, GENERO,
# Variables de vía / infraestructura
TIPOMALLA, ESTADO, ESTAASHTO, Tipo, NUMEROCARR,
# Socioeconómicas / entorno
mean_ESTRATO, mean_V_REF, mean_Denpob, mean_Denemp,
# SITP
COUNT_SITP,
# Ciclorrutas
NEAR_DIST_CICL,
# Coordenadas (para GWR)
POINT_X, POINT_Y
)
str(df) # Ver estructura## tibble [8,034 × 18] (S3: tbl_df/tbl/data.frame)
## $ MES_OCURRE : chr [1:8034] "JUNIO" "JUNIO" "MAYO" "ABRIL" ...
## $ CLASE_ACC : chr [1:8034] "CHOQUE" "CHOQUE" "CHOQUE" "CHOQUE" ...
## $ GRAVEDAD : chr [1:8034] "MUERTO" "MUERTO" "MUERTO" "MUERTO" ...
## $ EDAD : num [1:8034] 56 21 45 57 25 21 65 38 34 20 ...
## $ GENERO : chr [1:8034] "MASCULINO" "MASCULINO" "MASCULINO" "MASCULINO" ...
## $ TIPOMALLA : chr [1:8034] "IN" "AR" "AR" "TR" ...
## $ ESTADO : num [1:8034] 8 1 1 8 1 8 1 8 8 8 ...
## $ ESTAASHTO : chr [1:8034] "BUENO" "BUENO" "ACEPTABLE" "BUENO" ...
## $ Tipo : chr [1:8034] "Residential" "Residential" "Sin Construir" "Residential" ...
## $ NUMEROCARR : num [1:8034] 2 3 3 5 1 3 0 5 2 3 ...
## $ mean_ESTRATO : num [1:8034] 4.274 2.158 0.459 3.37 1.462 ...
## $ mean_V_REF : num [1:8034] 1707804 1299442 1512951 1418039 596600 ...
## $ mean_Denpob : num [1:8034] 117.6 190.4 11.8 294.7 680.1 ...
## $ mean_Denemp : num [1:8034] 29 143.8 2.9 20.3 46.1 ...
## $ COUNT_SITP : num [1:8034] NA 2 121 138 30 48 23 33 3 1 ...
## $ NEAR_DIST_CICL: num [1:8034] 3.29e-05 7.42e-05 5.82e-05 4.55e-05 6.58e-05 ...
## $ POINT_X : num [1:8034] -74.1 -74.1 -74.1 -74.1 -74.2 ...
## $ POINT_Y : num [1:8034] 4.72 4.61 4.72 4.63 4.62 ...summary(df) # Estadísticas descriptivas## MES_OCURRE CLASE_ACC GRAVEDAD EDAD
## Length:8034 Length:8034 Length:8034 Min. : 0.00
## Class :character Class :character Class :character 1st Qu.: 22.00
## Mode :character Mode :character Mode :character Median : 30.00
## Mean : 33.89
## 3rd Qu.: 43.00
## Max. :124.00
##
## GENERO TIPOMALLA ESTADO ESTAASHTO
## Length:8034 Length:8034 Min. :1.000 Length:8034
## Class :character Class :character 1st Qu.:1.000 Class :character
## Mode :character Mode :character Median :8.000 Mode :character
## Mean :5.322
## 3rd Qu.:8.000
## Max. :8.000
## NA's :6526
## Tipo NUMEROCARR mean_ESTRATO mean_V_REF
## Length:8034 Min. :0.000 Min. :0.000 Min. : 0
## Class :character 1st Qu.:1.000 1st Qu.:1.570 1st Qu.: 813263
## Mode :character Median :2.000 Median :2.204 Median :1124399
## Mean :1.812 Mean :2.198 Mean :1175546
## 3rd Qu.:3.000 3rd Qu.:2.786 3rd Qu.:1407347
## Max. :6.000 Max. :6.000 Max. :7411032
## NA's :796 NA's :24 NA's :21
## mean_Denpob mean_Denemp COUNT_SITP NEAR_DIST_CICL
## Min. : 0.0 Min. : 0.00 Min. : 1.00 Min. :-1.0000000
## 1st Qu.:163.4 1st Qu.: 22.88 1st Qu.: 11.00 1st Qu.:-1.0000000
## Median :304.1 Median : 43.13 Median : 28.00 Median :-1.0000000
## Mean :317.0 Mean : 72.32 Mean : 52.25 Mean :-0.8122893
## 3rd Qu.:442.1 3rd Qu.: 82.99 3rd Qu.: 68.00 3rd Qu.:-1.0000000
## Max. :965.2 Max. :1005.31 Max. :337.00 Max. : 0.0000899
## NA's :26 NA's :26 NA's :1439
## POINT_X POINT_Y
## Min. :-74.21 Min. :4.463
## 1st Qu.:-74.15 1st Qu.:4.608
## Median :-74.12 Median :4.634
## Mean :-74.12 Mean :4.646
## 3rd Qu.:-74.09 3rd Qu.:4.687
## Max. :-74.02 Max. :4.821
## sum(is.na(df)) # Verificar cantidad de valores NA## [1] 16515Preprocesamiento de datos
En esta parte se realizan las siguientes transformaciones:
Se convierte GRAVEDAD en factor binario: “LESIONADO” y “MUERTO”. Se crea GRAVEDAD_NUM como variable numérica (0 y 1). Se recodifican variables de infraestructura (TIPOMALLA, ESTADO, ESTAASHTO, etc.). Se generan variables indicadoras (dummies) para el uso del suelo y el estrato socioeconómico. Se define una variable binaria (HAY_CICLORRUTA) que indica la presencia de ciclorruta cerca del siniestro. Se definen variables para género y grupos etarios (para los modelos segregados posteriores).
df <- df %>%
mutate(
# Variable dependiente en formato factor y numérico
GRAVEDAD = factor(GRAVEDAD, levels = c("LESIONADO", "MUERTO")),
GRAVEDAD_NUM = ifelse(GRAVEDAD == "MUERTO", 1, 0),
# Variables categóricas
MES_OCURRE = factor(MES_OCURRE),
CLASE_ACC = fct_collapse(
as.factor(CLASE_ACC),
OTROS = c("CAIDA DE OCUPANTE", "OTRO") # se unen en una sola categoría
),
# Recodificación de TIPOMALLA: "AR" (Arterial), "TR" (Troncal)
TIPOFUNCIO_PRINCIPAL = ifelse(TIPOMALLA %in% c("AR", "TR"), 1, 0),
# Recodificación de ESTADO (1 a 8): supongamos 1-4 es buen estado, 5-8 es mal estado
SUPERFICIE_BUENA = ifelse(ESTADO %in% c(1, 2, 3, 4), 1, 0),
# Recodificación de ESTAASHTO
ESTAASHTO_BUENO = ifelse(ESTAASHTO %in% c("ACEPTABLE", "BUENO", "SATISFACTORIO"), 1, 0),
# Dummies para uso de suelo
TIPO_OFICIAL = ifelse(Tipo == "Oficial", 1, 0),
TIPO_COMERCIAL = ifelse(Tipo == "Comercial", 1, 0),
TIPO_RESIDENTIAL = ifelse(Tipo == "Residential", 1, 0),
TIPO_INDUSTRIAL = ifelse(Tipo == "Industrial", 1, 0),
TIPO_ZONA_HISTORICA = ifelse(Tipo == "Zona Histórica", 1, 0),
TIPO_OTROS = ifelse(!(Tipo %in% c("Oficial", "Comercial", "Residential",
"Industrial", "Zona Histórica")), 1, 0),
# Variable binaria para número de carriles
VIA_ANCHA = ifelse(NUMEROCARR >= 3, 1, 0),
# Variables de estrato socioeconómico
ESTRATO_BAJO = ifelse(mean_ESTRATO <= 2, 1, 0),
ESTRATO_MEDIO = ifelse(mean_ESTRATO > 2 & mean_ESTRATO <= 5, 1, 0),
ESTRATO_ALTO = ifelse(mean_ESTRATO > 5, 1, 0),
ESTRATO_3CAT = case_when(
mean_ESTRATO <= 2 ~ "Bajo",
mean_ESTRATO > 2 & mean_ESTRATO <= 5 ~ "Medio",
mean_ESTRATO > 5 ~ "Alto",
TRUE ~ NA_character_
) %>% factor(levels = c("Bajo","Medio","Alto")),
# Variables de ciclorruta
HAY_CICLORRUTA = ifelse(NEAR_DIST_CICL == -1, 0, 1),
# Nueva variable binaria de género: 1 = Masculino, 0 = Femenino
GENERO_BIN = ifelse(GENERO == "MASCULINO", 1, 0),
# Nueva variable de grupos etarios
GRUPO_ETARIO = case_when(
EDAD >= 0 & EDAD <= 17 ~ "JOVEN",
EDAD >= 18 & EDAD <= 59 ~ "ADULTO",
EDAD >= 60 ~ "ADULTO_MAYOR",
TRUE ~ NA_character_
)
)
summary(df) # Estadísticas descriptivas## MES_OCURRE CLASE_ACC GRAVEDAD EDAD
## FEBRERO: 790 ATROPELLO : 91 LESIONADO:7740 Min. : 0.00
## MARZO : 774 OTROS : 22 MUERTO : 294 1st Qu.: 22.00
## MAYO : 742 CHOQUE :7782 Median : 30.00
## ABRIL : 740 VOLCAMIENTO: 139 Mean : 33.89
## AGOSTO : 738 3rd Qu.: 43.00
## JULIO : 699 Max. :124.00
## (Other):3551
## GENERO TIPOMALLA ESTADO ESTAASHTO
## Length:8034 Length:8034 Min. :1.000 Length:8034
## Class :character Class :character 1st Qu.:1.000 Class :character
## Mode :character Mode :character Median :8.000 Mode :character
## Mean :5.322
## 3rd Qu.:8.000
## Max. :8.000
## NA's :6526
## Tipo NUMEROCARR mean_ESTRATO mean_V_REF
## Length:8034 Min. :0.000 Min. :0.000 Min. : 0
## Class :character 1st Qu.:1.000 1st Qu.:1.570 1st Qu.: 813263
## Mode :character Median :2.000 Median :2.204 Median :1124399
## Mean :1.812 Mean :2.198 Mean :1175546
## 3rd Qu.:3.000 3rd Qu.:2.786 3rd Qu.:1407347
## Max. :6.000 Max. :6.000 Max. :7411032
## NA's :796 NA's :24 NA's :21
## mean_Denpob mean_Denemp COUNT_SITP NEAR_DIST_CICL
## Min. : 0.0 Min. : 0.00 Min. : 1.00 Min. :-1.0000000
## 1st Qu.:163.4 1st Qu.: 22.88 1st Qu.: 11.00 1st Qu.:-1.0000000
## Median :304.1 Median : 43.13 Median : 28.00 Median :-1.0000000
## Mean :317.0 Mean : 72.32 Mean : 52.25 Mean :-0.8122893
## 3rd Qu.:442.1 3rd Qu.: 82.99 3rd Qu.: 68.00 3rd Qu.:-1.0000000
## Max. :965.2 Max. :1005.31 Max. :337.00 Max. : 0.0000899
## NA's :26 NA's :26 NA's :1439
## POINT_X POINT_Y GRAVEDAD_NUM TIPOFUNCIO_PRINCIPAL
## Min. :-74.21 Min. :4.463 Min. :0.00000 Min. :0.000
## 1st Qu.:-74.15 1st Qu.:4.608 1st Qu.:0.00000 1st Qu.:0.000
## Median :-74.12 Median :4.634 Median :0.00000 Median :0.000
## Mean :-74.12 Mean :4.646 Mean :0.03659 Mean :0.119
## 3rd Qu.:-74.09 3rd Qu.:4.687 3rd Qu.:0.00000 3rd Qu.:0.000
## Max. :-74.02 Max. :4.821 Max. :1.00000 Max. :1.000
##
## SUPERFICIE_BUENA ESTAASHTO_BUENO TIPO_OFICIAL TIPO_COMERCIAL
## Min. :0.00000 Min. :0.0000 Min. :0.00000 Min. :0.0000
## 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.0000
## Median :0.00000 Median :1.0000 Median :0.00000 Median :0.0000
## Mean :0.07456 Mean :0.7462 Mean :0.04084 Mean :0.1286
## 3rd Qu.:0.00000 3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.0000
## Max. :1.00000 Max. :1.0000 Max. :1.00000 Max. :1.0000
## NA's :174 NA's :174
## TIPO_RESIDENTIAL TIPO_INDUSTRIAL TIPO_ZONA_HISTORICA TIPO_OTROS
## Min. :0.0000 Min. :0.00000 Min. :0.00000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.0000
## Median :1.0000 Median :0.00000 Median :0.00000 Median :0.0000
## Mean :0.6286 Mean :0.06819 Mean :0.01603 Mean :0.1368
## 3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.0000
## Max. :1.0000 Max. :1.00000 Max. :1.00000 Max. :1.0000
## NA's :174 NA's :174 NA's :174
## VIA_ANCHA ESTRATO_BAJO ESTRATO_MEDIO ESTRATO_ALTO
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.00000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.00000
## Median :0.0000 Median :0.0000 Median :1.0000 Median :0.00000
## Mean :0.2666 Mean :0.4581 Mean :0.5282 Mean :0.01373
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.00000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.00000
## NA's :796 NA's :24 NA's :24 NA's :24
## ESTRATO_3CAT HAY_CICLORRUTA GENERO_BIN GRUPO_ETARIO
## Bajo :3669 Min. :0.0000 Min. :0.0000 Length:8034
## Medio:4231 1st Qu.:0.0000 1st Qu.:0.0000 Class :character
## Alto : 110 Median :0.0000 Median :1.0000 Mode :character
## NA's : 24 Mean :0.1877 Mean :0.7313
## 3rd Qu.:0.0000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000
## NA's :29sum(is.na(df)) # Verificar cantidad de valores NA## [1] 183061. Modelo de regresión logística (Base)
La regresión logística es un modelo utilizado para predecir variables dicotómicas, como la gravedad del siniestro (lesionado o muerto). Se basa en la función logística para estimar la probabilidad de ocurrencia de uno de los valores de la variable dependiente.
df_logit <- df %>%
dplyr::select(
GRAVEDAD, # Factor con 2 niveles
MES_OCURRE, CLASE_ACC,
TIPOFUNCIO_PRINCIPAL, VIA_ANCHA, COUNT_SITP,
mean_V_REF, mean_Denpob, mean_Denemp,
ESTRATO_3CAT, # factor con "Bajo","Medio","Alto"
TIPO_OFICIAL, TIPO_COMERCIAL, TIPO_RESIDENTIAL,
TIPO_INDUSTRIAL, TIPO_ZONA_HISTORICA, TIPO_OTROS,
HAY_CICLORRUTA
) %>%
drop_na(
GRAVEDAD, MES_OCURRE, CLASE_ACC,
TIPOFUNCIO_PRINCIPAL, VIA_ANCHA, COUNT_SITP,
mean_V_REF, mean_Denpob, mean_Denemp,
ESTRATO_3CAT,
TIPO_OFICIAL, TIPO_COMERCIAL, TIPO_RESIDENTIAL,
TIPO_INDUSTRIAL, TIPO_ZONA_HISTORICA, TIPO_OTROS,
HAY_CICLORRUTA
) %>%
droplevels()
nrow(df_logit)## [1] 6471summary(df_logit)## GRAVEDAD MES_OCURRE CLASE_ACC TIPOFUNCIO_PRINCIPAL
## LESIONADO:6224 FEBRERO: 671 ATROPELLO : 70 Min. :0.0000
## MUERTO : 247 MARZO : 605 OTROS : 13 1st Qu.:0.0000
## MAYO : 596 CHOQUE :6284 Median :0.0000
## ABRIL : 587 VOLCAMIENTO: 104 Mean :0.1354
## JULIO : 569 3rd Qu.:0.0000
## AGOSTO : 566 Max. :1.0000
## (Other):2877
## VIA_ANCHA COUNT_SITP mean_V_REF mean_Denpob
## Min. :0.0000 Min. : 1.00 Min. : 312 Min. : 0.0
## 1st Qu.:0.0000 1st Qu.: 11.00 1st Qu.: 844171 1st Qu.:171.9
## Median :0.0000 Median : 29.00 Median :1166004 Median :305.7
## Mean :0.2828 Mean : 52.55 Mean :1207724 Mean :319.3
## 3rd Qu.:1.0000 3rd Qu.: 69.00 3rd Qu.:1415285 3rd Qu.:440.8
## Max. :1.0000 Max. :337.00 Max. :7411032 Max. :965.2
##
## mean_Denemp ESTRATO_3CAT TIPO_OFICIAL TIPO_COMERCIAL
## Min. : 0.00 Bajo :2828 Min. :0.00000 Min. :0.0000
## 1st Qu.: 24.89 Medio:3551 1st Qu.:0.00000 1st Qu.:0.0000
## Median : 45.60 Alto : 92 Median :0.00000 Median :0.0000
## Mean : 74.81 Mean :0.04126 Mean :0.1324
## 3rd Qu.: 88.13 3rd Qu.:0.00000 3rd Qu.:0.0000
## Max. :1005.31 Max. :1.00000 Max. :1.0000
##
## TIPO_RESIDENTIAL TIPO_INDUSTRIAL TIPO_ZONA_HISTORICA TIPO_OTROS
## Min. :0.0000 Min. :0.00000 Min. :0.00000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.0000
## Median :1.0000 Median :0.00000 Median :0.00000 Median :0.0000
## Mean :0.6307 Mean :0.06861 Mean :0.01746 Mean :0.1096
## 3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.0000
## Max. :1.0000 Max. :1.00000 Max. :1.00000 Max. :1.0000
##
## HAY_CICLORRUTA
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.2094
## 3rd Qu.:0.0000
## Max. :1.0000
## logit_model <- glm(
GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA +
ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob +
mean_Denemp + ESTRATO_BAJO + ESTRATO_MEDIO + ESTRATO_ALTO + TIPO_OFICIAL +
TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
TIPO_OTROS + HAY_CICLORRUTA,
data = df, family = binomial(link = "logit")
)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logit_model)##
## Call:
## glm(formula = GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
## SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP +
## mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_BAJO + ESTRATO_MEDIO +
## ESTRATO_ALTO + TIPO_OFICIAL + TIPO_COMERCIAL + TIPO_RESIDENTIAL +
## TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA + TIPO_OTROS + HAY_CICLORRUTA,
## family = binomial(link = "logit"), data = df)
##
## Coefficients: (2 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.344e+15 1.277e+07 -340230116 <2e-16 ***
## MES_OCURREAGOSTO -1.484e+14 3.956e+06 -37516185 <2e-16 ***
## MES_OCURREDICIEMBRE 2.655e+13 4.302e+06 6171244 <2e-16 ***
## MES_OCURREENERO -9.597e+13 4.034e+06 -23788976 <2e-16 ***
## MES_OCURREFEBRERO 1.641e+13 3.796e+06 4322123 <2e-16 ***
## MES_OCURREJULIO -8.885e+13 3.950e+06 -22492143 <2e-16 ***
## MES_OCURREJUNIO 2.185e+14 4.017e+06 54388631 <2e-16 ***
## MES_OCURREMARZO -7.118e+13 3.894e+06 -18280334 <2e-16 ***
## MES_OCURREMAYO -1.680e+14 3.905e+06 -43022713 <2e-16 ***
## MES_OCURRENOVIEMBRE -4.141e+13 4.150e+06 -9977841 <2e-16 ***
## MES_OCURREOCTUBRE 4.751e+13 4.168e+06 11399103 <2e-16 ***
## MES_OCURRESEPTIEMBRE 1.982e+14 4.182e+06 47398215 <2e-16 ***
## CLASE_ACCOTROS -2.421e+13 2.033e+07 -1190928 <2e-16 ***
## CLASE_ACCCHOQUE 4.777e+14 8.091e+06 59039097 <2e-16 ***
## CLASE_ACCVOLCAMIENTO 1.467e+15 1.040e+07 141040369 <2e-16 ***
## TIPOFUNCIO_PRINCIPAL -6.078e+13 3.890e+06 -15623780 <2e-16 ***
## SUPERFICIE_BUENA 6.054e+13 3.798e+06 15941895 <2e-16 ***
## ESTAASHTO_BUENO 9.658e+13 2.294e+06 42090949 <2e-16 ***
## VIA_ANCHA -1.918e+13 1.870e+06 -10255188 <2e-16 ***
## COUNT_SITP -5.355e+11 1.369e+04 -39113762 <2e-16 ***
## mean_V_REF -1.457e+08 1.986e+00 -73339841 <2e-16 ***
## mean_Denpob -2.286e+11 4.788e+03 -47739223 <2e-16 ***
## mean_Denemp 5.715e+10 1.249e+04 4576255 <2e-16 ***
## ESTRATO_BAJO -1.226e+13 8.455e+06 -1449954 <2e-16 ***
## ESTRATO_MEDIO 6.250e+13 7.992e+06 7820215 <2e-16 ***
## ESTRATO_ALTO NA NA NA NA
## TIPO_OFICIAL 2.279e+14 4.840e+06 47086710 <2e-16 ***
## TIPO_COMERCIAL 1.571e+14 3.738e+06 42009329 <2e-16 ***
## TIPO_RESIDENTIAL 2.198e+13 2.918e+06 7532808 <2e-16 ***
## TIPO_INDUSTRIAL 2.014e+14 4.212e+06 47810316 <2e-16 ***
## TIPO_ZONA_HISTORICA 9.212e+13 7.147e+06 12890015 <2e-16 ***
## TIPO_OTROS NA NA NA NA
## HAY_CICLORRUTA -7.403e+12 3.416e+06 -2167172 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2097.7 on 6470 degrees of freedom
## Residual deviance: 17805.6 on 6440 degrees of freedom
## (1563 observations deleted due to missingness)
## AIC: 17868
##
## Number of Fisher Scoring iterations: 222. Regresión Logística con Ponderación Geográfica (GWLR)
La regresión logística ponderada geográficamente (GWLR) permite estimar coeficientes específicos para cada punto en el espacio, lo que ayuda a analizar si los factores que afectan la gravedad del siniestro varían por ubicación. ESTE MODELO ESTÁ MUY PESADO PARA CORRER.
3. Modelo Random Forest
El modelo Random Forest es un método de aprendizaje de máquina basado en árboles de decisión. Es útil cuando hay relaciones no lineales en los datos y cuando se busca una alta precisión predictiva. El modelo Random Forest es un algoritmo de aprendizaje supervisado que se basa en la construcción de múltiples árboles de decisión y la combinación de sus predicciones para mejorar la precisión y reducir el sobreajuste.
set.seed(123) # Asegurar reproducibilidad
rf_model <- randomForest(
GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA +
ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob +
mean_Denemp + ESTRATO_BAJO + ESTRATO_MEDIO + ESTRATO_ALTO + TIPO_OFICIAL +
TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
TIPO_OTROS + HAY_CICLORRUTA,
data = df,
ntree = 500,
importance = TRUE,
na.action = na.omit
)
print(rf_model)##
## Call:
## randomForest(formula = GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_BAJO + ESTRATO_MEDIO + ESTRATO_ALTO + TIPO_OFICIAL + TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA + TIPO_OTROS + HAY_CICLORRUTA, data = df, ntree = 500, importance = TRUE, na.action = na.omit)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 4
##
## OOB estimate of error rate: 3.89%
## Confusion matrix:
## LESIONADO MUERTO class.error
## LESIONADO 6219 5 0.0008033419
## MUERTO 247 0 1.0000000000varImpPlot(rf_model) # Importancia de las variables
4. Modelo Bayesiano
El modelo bayesiano usa inferencia probabilística para estimar los efectos de las variables en la gravedad del siniestro. Es útil cuando los datos son escasos o cuando se desea incluir información previa en la estimación.
bayes_model <- brm(
formula = GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA +
ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob +
mean_Denemp + ESTRATO_BAJO + ESTRATO_MEDIO + ESTRATO_ALTO + TIPO_OFICIAL +
TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
TIPO_OTROS + HAY_CICLORRUTA,
data = df,
family = bernoulli(),
chains = 4,
iter = 2000
)## Warning: Rows containing NAs were excluded from the model.## Compiling Stan program...## Start sampling##
## SAMPLING FOR MODEL 'anon_model' NOW (CHAIN 1).
## Chain 1:
## Chain 1: Gradient evaluation took 0.00024 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 2.4 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1:
## Chain 1:
## Chain 1: Iteration: 1 / 2000 [ 0%] (Warmup)
## Chain 1: Iteration: 200 / 2000 [ 10%] (Warmup)
## Chain 1: Iteration: 400 / 2000 [ 20%] (Warmup)
## Chain 1: Iteration: 600 / 2000 [ 30%] (Warmup)
## Chain 1: Iteration: 800 / 2000 [ 40%] (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%] (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%] (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%] (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%] (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%] (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%] (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%] (Sampling)
## Chain 1:
## Chain 1: Elapsed Time: 10.369 seconds (Warm-up)
## Chain 1: 112.473 seconds (Sampling)
## Chain 1: 122.842 seconds (Total)
## Chain 1:
##
## SAMPLING FOR MODEL 'anon_model' NOW (CHAIN 2).
## Chain 2:
## Chain 2: Gradient evaluation took 0.000332 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 3.32 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2:
## Chain 2:
## Chain 2: Iteration: 1 / 2000 [ 0%] (Warmup)
## Chain 2: Iteration: 200 / 2000 [ 10%] (Warmup)
## Chain 2: Iteration: 400 / 2000 [ 20%] (Warmup)
## Chain 2: Iteration: 600 / 2000 [ 30%] (Warmup)
## Chain 2: Iteration: 800 / 2000 [ 40%] (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%] (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%] (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%] (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%] (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%] (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%] (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%] (Sampling)
## Chain 2:
## Chain 2: Elapsed Time: 78.153 seconds (Warm-up)
## Chain 2: 4.883 seconds (Sampling)
## Chain 2: 83.036 seconds (Total)
## Chain 2:
##
## SAMPLING FOR MODEL 'anon_model' NOW (CHAIN 3).
## Chain 3:
## Chain 3: Gradient evaluation took 0.000369 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 3.69 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3:
## Chain 3:
## Chain 3: Iteration: 1 / 2000 [ 0%] (Warmup)
## Chain 3: Iteration: 200 / 2000 [ 10%] (Warmup)
## Chain 3: Iteration: 400 / 2000 [ 20%] (Warmup)
## Chain 3: Iteration: 600 / 2000 [ 30%] (Warmup)
## Chain 3: Iteration: 800 / 2000 [ 40%] (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%] (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%] (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%] (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%] (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%] (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%] (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%] (Sampling)
## Chain 3:
## Chain 3: Elapsed Time: 8.122 seconds (Warm-up)
## Chain 3: 126.012 seconds (Sampling)
## Chain 3: 134.134 seconds (Total)
## Chain 3:
##
## SAMPLING FOR MODEL 'anon_model' NOW (CHAIN 4).
## Chain 4:
## Chain 4: Gradient evaluation took 0.000471 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 4.71 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4:
## Chain 4:
## Chain 4: Iteration: 1 / 2000 [ 0%] (Warmup)
## Chain 4: Iteration: 200 / 2000 [ 10%] (Warmup)
## Chain 4: Iteration: 400 / 2000 [ 20%] (Warmup)
## Chain 4: Iteration: 600 / 2000 [ 30%] (Warmup)
## Chain 4: Iteration: 800 / 2000 [ 40%] (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%] (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%] (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%] (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%] (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%] (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%] (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%] (Sampling)
## Chain 4:
## Chain 4: Elapsed Time: 115.476 seconds (Warm-up)
## Chain 4: 374.547 seconds (Sampling)
## Chain 4: 490.023 seconds (Total)
## Chain 4:## Warning: There were 1240 divergent transitions after warmup. See
## https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
## to find out why this is a problem and how to eliminate them.## Warning: There were 1408 transitions after warmup that exceeded the maximum treedepth. Increase max_treedepth above 10. See
## https://mc-stan.org/misc/warnings.html#maximum-treedepth-exceeded## Warning: There were 3 chains where the estimated Bayesian Fraction of Missing Information was low. See
## https://mc-stan.org/misc/warnings.html#bfmi-low## Warning: Examine the pairs() plot to diagnose sampling problems## Warning: The largest R-hat is 4.15, indicating chains have not mixed.
## Running the chains for more iterations may help. See
## https://mc-stan.org/misc/warnings.html#r-hat## Warning: Bulk Effective Samples Size (ESS) is too low, indicating posterior means and medians may be unreliable.
## Running the chains for more iterations may help. See
## https://mc-stan.org/misc/warnings.html#bulk-ess## Warning: Tail Effective Samples Size (ESS) is too low, indicating posterior variances and tail quantiles may be unreliable.
## Running the chains for more iterations may help. See
## https://mc-stan.org/misc/warnings.html#tail-esssummary(bayes_model)## Warning: Parts of the model have not converged (some Rhats are > 1.05). Be
## careful when analysing the results! We recommend running more iterations and/or
## setting stronger priors.## Warning: There were 1240 divergent transitions after warmup. Increasing
## adapt_delta above 0.8 may help. See
## http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup## Family: bernoulli
## Links: mu = logit
## Formula: GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_BAJO + ESTRATO_MEDIO + ESTRATO_ALTO + TIPO_OFICIAL + TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA + TIPO_OTROS + HAY_CICLORRUTA
## Data: df (Number of observations: 6471)
## Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
## total post-warmup draws = 4000
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -7.19 29.66 -71.12 26.22 3.70 4
## MES_OCURREAGOSTO -0.19 1.10 -1.18 1.64 3.35 4
## MES_OCURREDICIEMBRE 0.57 1.14 -0.77 1.99 4.03 4
## MES_OCURREENERO -0.58 0.69 -1.61 0.11 3.32 4
## MES_OCURREFEBRERO 0.34 0.56 -0.39 0.94 3.10 5
## MES_OCURREJULIO 0.48 1.20 -1.12 2.00 3.92 4
## MES_OCURREJUNIO -1.10 0.87 -1.91 0.37 3.38 4
## MES_OCURREMARZO -0.08 1.16 -0.98 1.87 3.77 4
## MES_OCURREMAYO -0.72 0.64 -1.31 0.27 3.49 4
## MES_OCURRENOVIEMBRE -0.13 1.00 -1.55 1.19 4.11 4
## MES_OCURREOCTUBRE -1.11 0.62 -1.67 -0.08 4.01 4
## MES_OCURRESEPTIEMBRE -0.39 0.93 -1.83 0.74 3.40 4
## CLASE_ACCOTROS 0.25 1.19 -1.03 1.62 3.42 4
## CLASE_ACCCHOQUE 0.12 0.94 -0.43 1.76 3.23 4
## CLASE_ACCVOLCAMIENTO -0.10 0.44 -0.70 0.51 3.46 4
## TIPOFUNCIO_PRINCIPAL -0.37 0.80 -1.34 0.50 3.66 4
## SUPERFICIE_BUENA -0.15 0.65 -1.09 0.76 3.72 4
## ESTAASHTO_BUENO -0.47 1.02 -1.93 0.94 3.22 4
## VIA_ANCHA -0.10 1.10 -1.26 1.29 3.71 4
## COUNT_SITP 0.20 0.58 -0.43 1.72 3.66 4
## mean_V_REF 0.00 0.00 -0.00 0.00 4.16 4
## mean_Denpob 0.01 0.04 -0.05 0.10 4.15 4
## mean_Denemp -0.11 0.59 -1.61 0.78 3.75 4
## ESTRATO_BAJO -1.22 0.28 -1.40 -0.74 3.52 4
## ESTRATO_MEDIO -0.05 0.56 -0.60 0.82 3.63 4
## ESTRATO_ALTO 0.36 1.00 -0.48 1.98 3.49 4
## TIPO_OFICIAL -0.34 1.23 -1.36 1.76 3.41 4
## TIPO_COMERCIAL -0.45 1.31 -1.98 1.27 3.47 4
## TIPO_RESIDENTIAL 1.01 1.08 -0.83 1.95 3.34 4
## TIPO_INDUSTRIAL -0.68 1.21 -1.74 1.29 3.56 4
## TIPO_ZONA_HISTORICA -0.17 1.01 -1.83 0.86 3.04 5
## TIPO_OTROS 0.72 1.12 -1.11 1.89 3.42 4
## HAY_CICLORRUTA 1.24 0.56 0.39 1.77 3.27 4
## Tail_ESS
## Intercept 11
## MES_OCURREAGOSTO 12
## MES_OCURREDICIEMBRE 11
## MES_OCURREENERO 11
## MES_OCURREFEBRERO 14
## MES_OCURREJULIO 11
## MES_OCURREJUNIO 11
## MES_OCURREMARZO 13
## MES_OCURREMAYO 11
## MES_OCURRENOVIEMBRE 14
## MES_OCURREOCTUBRE 14
## MES_OCURRESEPTIEMBRE 12
## CLASE_ACCOTROS 11
## CLASE_ACCCHOQUE 11
## CLASE_ACCVOLCAMIENTO 14
## TIPOFUNCIO_PRINCIPAL 16
## SUPERFICIE_BUENA 11
## ESTAASHTO_BUENO 11
## VIA_ANCHA 11
## COUNT_SITP 11
## mean_V_REF 11
## mean_Denpob 11
## mean_Denemp 11
## ESTRATO_BAJO 11
## ESTRATO_MEDIO 13
## ESTRATO_ALTO 13
## TIPO_OFICIAL 11
## TIPO_COMERCIAL 19
## TIPO_RESIDENTIAL 13
## TIPO_INDUSTRIAL 13
## TIPO_ZONA_HISTORICA 12
## TIPO_OTROS 13
## HAY_CICLORRUTA 13
##
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).plot(bayes_model)
## 5. Modelo GAM Los modelos aditivos generalizados (GAM) permiten
capturar relaciones no lineales entre las variables independientes y la
variable dependiente. Son útiles cuando se sospecha que la relación
entre las variables no es lineal.
gam_model <- gam(
GRAVEDAD ~ s(mean_V_REF) + s(mean_Denpob) + s(mean_Denemp) +
TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA + ESTAASHTO_BUENO +
VIA_ANCHA + COUNT_SITP + ESTRATO_BAJO + ESTRATO_MEDIO +
ESTRATO_ALTO +
HAY_CICLORRUTA, family = binomial, data = df
)
summary(gam_model)##
## Family: binomial
## Link function: logit
##
## Formula:
## GRAVEDAD ~ s(mean_V_REF) + s(mean_Denpob) + s(mean_Denemp) +
## TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA + ESTAASHTO_BUENO +
## VIA_ANCHA + COUNT_SITP + ESTRATO_BAJO + ESTRATO_MEDIO + ESTRATO_ALTO +
## HAY_CICLORRUTA
##
## Parametric coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.113e+01 6.250e+05 0.000 1.000
## TIPOFUNCIO_PRINCIPAL -1.522e-01 2.914e-01 -0.522 0.602
## SUPERFICIE_BUENA 2.333e-02 2.956e-01 0.079 0.937
## ESTAASHTO_BUENO 1.713e-01 1.797e-01 0.954 0.340
## VIA_ANCHA -6.751e-02 1.441e-01 -0.468 0.640
## COUNT_SITP -9.740e-04 1.096e-03 -0.889 0.374
## ESTRATO_BAJO 2.771e+01 6.250e+05 0.000 1.000
## ESTRATO_MEDIO 2.795e+01 6.250e+05 0.000 1.000
## ESTRATO_ALTO 0.000e+00 0.000e+00 NaN NaN
## HAY_CICLORRUTA 8.254e-02 2.445e-01 0.338 0.736
##
## Approximate significance of smooth terms:
## edf Ref.df Chi.sq p-value
## s(mean_V_REF) 2.278 2.958 13.979 0.00333 **
## s(mean_Denpob) 1.003 1.005 2.892 0.08918 .
## s(mean_Denemp) 1.002 1.004 1.154 0.28348
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Rank: 36/37
## R-sq.(adj) = 0.00269 Deviance explained = 1.39%
## UBRE = -0.6694 Scale est. = 1 n = 65726. Modelo Poisson
El modelo de regresión de Poisson es útil cuando la variable dependiente es una cuenta de eventos, como el número de siniestros fatales. Se basa en la distribución de Poisson para modelar la relación entre las variables independientes y la frecuencia de los eventos.
# 1) Subconjunto para Poisson
df_pois <- df %>%
dplyr::select(
GRAVEDAD_NUM, MES_OCURRE, CLASE_ACC, TIPOFUNCIO_PRINCIPAL, VIA_ANCHA,
COUNT_SITP, mean_V_REF, mean_Denpob, mean_Denemp, ESTRATO_3CAT,
TIPO_OFICIAL, TIPO_COMERCIAL, TIPO_RESIDENTIAL, TIPO_INDUSTRIAL,
TIPO_ZONA_HISTORICA, TIPO_OTROS, HAY_CICLORRUTA
) %>%
drop_na(
GRAVEDAD_NUM, MES_OCURRE, CLASE_ACC, TIPOFUNCIO_PRINCIPAL, VIA_ANCHA,
COUNT_SITP, mean_V_REF, mean_Denpob, mean_Denemp, ESTRATO_3CAT,
TIPO_OFICIAL, TIPO_COMERCIAL, TIPO_RESIDENTIAL, TIPO_INDUSTRIAL,
TIPO_ZONA_HISTORICA, TIPO_OTROS, HAY_CICLORRUTA
) %>%
droplevels()
# 2) Modelo Poisson
poisson_model <- glm(
GRAVEDAD_NUM ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + VIA_ANCHA +
COUNT_SITP + mean_V_REF + mean_Denpob + mean_Denemp +
ESTRATO_3CAT + TIPO_OFICIAL + TIPO_COMERCIAL +
TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
TIPO_OTROS + HAY_CICLORRUTA,
family = poisson,
data = df_pois
)## Warning: glm.fit: fitted rates numerically 0 occurredsummary(poisson_model)##
## Call:
## glm(formula = GRAVEDAD_NUM ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
## VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob + mean_Denemp +
## ESTRATO_3CAT + TIPO_OFICIAL + TIPO_COMERCIAL + TIPO_RESIDENTIAL +
## TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA + TIPO_OTROS + HAY_CICLORRUTA,
## family = poisson, data = df_pois)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.775e+01 6.684e+02 -0.027 0.9788
## MES_OCURREAGOSTO -3.176e-01 3.258e-01 -0.975 0.3297
## MES_OCURREDICIEMBRE 6.289e-02 3.201e-01 0.196 0.8442
## MES_OCURREENERO -1.962e-01 3.202e-01 -0.613 0.5401
## MES_OCURREFEBRERO 1.217e-02 2.840e-01 0.043 0.9658
## MES_OCURREJULIO -1.786e-01 3.102e-01 -0.576 0.5647
## MES_OCURREJUNIO 3.439e-01 2.795e-01 1.230 0.2187
## MES_OCURREMARZO -1.536e-01 3.023e-01 -0.508 0.6114
## MES_OCURREMAYO -3.836e-01 3.258e-01 -1.177 0.2391
## MES_OCURRENOVIEMBRE -7.497e-02 3.201e-01 -0.234 0.8148
## MES_OCURREOCTUBRE 9.224e-02 3.061e-01 0.301 0.7631
## MES_OCURRESEPTIEMBRE 3.270e-01 2.892e-01 1.131 0.2582
## CLASE_ACCOTROS -3.148e-02 1.663e+03 0.000 1.0000
## CLASE_ACCCHOQUE 1.490e+01 6.684e+02 0.022 0.9822
## CLASE_ACCVOLCAMIENTO 1.584e+01 6.684e+02 0.024 0.9811
## TIPOFUNCIO_PRINCIPAL -9.513e-02 3.018e-01 -0.315 0.7526
## VIA_ANCHA -3.154e-02 1.432e-01 -0.220 0.8257
## COUNT_SITP -9.816e-04 1.092e-03 -0.899 0.3686
## mean_V_REF -3.553e-07 1.802e-07 -1.971 0.0487 *
## mean_Denpob -4.670e-04 3.683e-04 -1.268 0.2048
## mean_Denemp 2.220e-04 9.973e-04 0.223 0.8239
## ESTRATO_3CATMedio 1.719e-01 1.545e-01 1.113 0.2658
## ESTRATO_3CATAlto -1.436e+01 5.609e+02 -0.026 0.9796
## TIPO_OFICIAL 3.925e-01 3.327e-01 1.180 0.2382
## TIPO_COMERCIAL 3.190e-01 2.802e-01 1.138 0.2550
## TIPO_RESIDENTIAL 4.893e-02 2.282e-01 0.214 0.8302
## TIPO_INDUSTRIAL 3.502e-01 2.979e-01 1.176 0.2397
## TIPO_ZONA_HISTORICA 2.083e-01 5.123e-01 0.407 0.6843
## TIPO_OTROS NA NA NA NA
## HAY_CICLORRUTA 1.246e-02 2.477e-01 0.050 0.9599
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 1613.3 on 6470 degrees of freedom
## Residual deviance: 1569.4 on 6442 degrees of freedom
## AIC: 2121.4
##
## Number of Fisher Scoring iterations: 167. Modelo Binomial Negativo
El modelo binomial negativo es una extensión del modelo de Poisson que permite modelar la sobredispersión en los datos. Es útil cuando la varianza de la variable dependiente es mayor que la media, lo que indica una mayor variabilidad en los datos.
# 1) Subconjunto
df_nb <- df_pois # Usamos el mismo
# 2) Modelo NB
nb_model <- glm.nb(
GRAVEDAD_NUM ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + VIA_ANCHA +
COUNT_SITP + mean_V_REF + mean_Denpob + mean_Denemp +
ESTRATO_3CAT + TIPO_OFICIAL + TIPO_COMERCIAL +
TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
TIPO_OTROS + HAY_CICLORRUTA,
data = df_nb
)## Warning: glm.fit: fitted rates numerically 0 occurred## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached## Warning in glm.nb(GRAVEDAD_NUM ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL
## + : alternation limit reachedsummary(nb_model)##
## Call:
## glm.nb(formula = GRAVEDAD_NUM ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
## VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob + mean_Denemp +
## ESTRATO_3CAT + TIPO_OFICIAL + TIPO_COMERCIAL + TIPO_RESIDENTIAL +
## TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA + TIPO_OTROS + HAY_CICLORRUTA,
## data = df_nb, init.theta = 815.0970916, link = log)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.137e+01 5.868e+05 0.000 1.0000
## MES_OCURREAGOSTO -3.176e-01 3.258e-01 -0.975 0.3297
## MES_OCURREDICIEMBRE 6.290e-02 3.201e-01 0.196 0.8442
## MES_OCURREENERO -1.961e-01 3.202e-01 -0.613 0.5401
## MES_OCURREFEBRERO 1.217e-02 2.840e-01 0.043 0.9658
## MES_OCURREJULIO -1.786e-01 3.102e-01 -0.576 0.5647
## MES_OCURREJUNIO 3.439e-01 2.796e-01 1.230 0.2187
## MES_OCURREMARZO -1.536e-01 3.023e-01 -0.508 0.6115
## MES_OCURREMAYO -3.836e-01 3.258e-01 -1.177 0.2391
## MES_OCURRENOVIEMBRE -7.496e-02 3.201e-01 -0.234 0.8149
## MES_OCURREOCTUBRE 9.225e-02 3.061e-01 0.301 0.7631
## MES_OCURRESEPTIEMBRE 3.270e-01 2.892e-01 1.131 0.2582
## CLASE_ACCOTROS -3.340e+00 1.174e+07 0.000 1.0000
## CLASE_ACCCHOQUE 2.852e+01 5.868e+05 0.000 1.0000
## CLASE_ACCVOLCAMIENTO 2.946e+01 5.868e+05 0.000 1.0000
## TIPOFUNCIO_PRINCIPAL -9.512e-02 3.018e-01 -0.315 0.7526
## VIA_ANCHA -3.154e-02 1.433e-01 -0.220 0.8257
## COUNT_SITP -9.816e-04 1.092e-03 -0.899 0.3686
## mean_V_REF -3.553e-07 1.802e-07 -1.971 0.0487 *
## mean_Denpob -4.670e-04 3.683e-04 -1.268 0.2048
## mean_Denemp 2.220e-04 9.974e-04 0.223 0.8239
## ESTRATO_3CATMedio 1.719e-01 1.545e-01 1.113 0.2658
## ESTRATO_3CATAlto -3.196e+01 5.747e+06 0.000 1.0000
## TIPO_OFICIAL 3.925e-01 3.328e-01 1.179 0.2382
## TIPO_COMERCIAL 3.190e-01 2.802e-01 1.138 0.2550
## TIPO_RESIDENTIAL 4.892e-02 2.282e-01 0.214 0.8303
## TIPO_INDUSTRIAL 3.502e-01 2.979e-01 1.176 0.2397
## TIPO_ZONA_HISTORICA 2.083e-01 5.123e-01 0.407 0.6843
## TIPO_OTROS NA NA NA NA
## HAY_CICLORRUTA 1.246e-02 2.477e-01 0.050 0.9599
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for Negative Binomial(815.0971) family taken to be 1)
##
## Null deviance: 1613.0 on 6470 degrees of freedom
## Residual deviance: 1569.1 on 6442 degrees of freedom
## AIC: 2123.4
##
## Number of Fisher Scoring iterations: 1
##
##
## Theta: 815
## Std. Err.: 3791
## Warning while fitting theta: alternation limit reached
##
## 2 x log-likelihood: -2063.4258. Comparación de modelos
Para comparar los modelos, se puede utilizar el criterio de información de Akaike (AIC), que penaliza los modelos con más parámetros. Un AIC más bajo indica un mejor ajuste del modelo.
# Comparación AIC (solo modelos de clases compatibles con AIC)
AIC(logit_model, nb_model, poisson_model, gam_model)## df AIC
## logit_model 31.00000 17867.565
## nb_model 30.00000 2123.425
## poisson_model 29.00000 2121.411
## gam_model 13.28226 2172.674# Comparación bayesiana con Leave-One-Out (LOO)
res <- try(loo_bayes <- lloo(bayes_model, reloo = TRUE))## Error in lloo(bayes_model, reloo = TRUE) : could not find function "lloo"if(inherits(res, "try-error")) {
cat("No se pudo calcular loo por valores Inf/NA en la log-verosimilitud.\n")
} else {
loo_bayes
}## No se pudo calcular loo por valores Inf/NA en la log-verosimilitud.10 Modelos segregados por género y grupos etarios
Para analizar si los factores de riesgo varían por género y grupos etarios, se pueden ajustar modelos segregados para cada grupo. Esto permite identificar diferencias en los efectos de las variables independientes en la gravedad del siniestro.
10.1 Modelo segregado por género
# Subconjuntos según género
df_male <- df %>% filter(GENERO_BIN == 1)
df_female <- df %>% filter(GENERO_BIN == 0)
# Modelo para Hombres
logit_male <- glm(
GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP +
mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_3CAT +
TIPO_OFICIAL + TIPO_COMERCIAL + TIPO_RESIDENTIAL +
TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA + TIPO_OTROS +
HAY_CICLORRUTA,
data = df_male,
family = binomial(link = "logit")
)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logit_male)##
## Call:
## glm(formula = GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
## SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP +
## mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_3CAT + TIPO_OFICIAL +
## TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
## TIPO_OTROS + HAY_CICLORRUTA, family = binomial(link = "logit"),
## data = df_male)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.703e+01 5.252e+02 -0.032 0.974
## MES_OCURREAGOSTO -3.115e-01 3.440e-01 -0.906 0.365
## MES_OCURREDICIEMBRE -1.255e-01 3.520e-01 -0.357 0.721
## MES_OCURREENERO -2.931e-01 3.444e-01 -0.851 0.395
## MES_OCURREFEBRERO -9.094e-02 3.077e-01 -0.296 0.768
## MES_OCURREJULIO -1.055e-01 3.224e-01 -0.327 0.743
## MES_OCURREJUNIO 2.899e-01 3.030e-01 0.957 0.339
## MES_OCURREMARZO -2.333e-01 3.275e-01 -0.712 0.476
## MES_OCURREMAYO -5.269e-01 3.578e-01 -1.473 0.141
## MES_OCURRENOVIEMBRE -3.015e-01 3.588e-01 -0.840 0.401
## MES_OCURREOCTUBRE -1.088e-01 3.452e-01 -0.315 0.753
## MES_OCURRESEPTIEMBRE 1.729e-01 3.196e-01 0.541 0.588
## CLASE_ACCOTROS -1.744e-01 1.579e+03 0.000 1.000
## CLASE_ACCCHOQUE 1.436e+01 5.252e+02 0.027 0.978
## CLASE_ACCVOLCAMIENTO 1.558e+01 5.252e+02 0.030 0.976
## TIPOFUNCIO_PRINCIPAL -1.996e-01 3.518e-01 -0.567 0.570
## SUPERFICIE_BUENA 2.415e-01 3.481e-01 0.694 0.488
## ESTAASHTO_BUENO 1.909e-01 2.005e-01 0.952 0.341
## VIA_ANCHA -7.357e-02 1.603e-01 -0.459 0.646
## COUNT_SITP -5.985e-04 1.184e-03 -0.505 0.613
## mean_V_REF -2.942e-07 1.980e-07 -1.486 0.137
## mean_Denpob -4.959e-04 4.081e-04 -1.215 0.224
## mean_Denemp 2.603e-04 1.089e-03 0.239 0.811
## ESTRATO_3CATMedio 1.635e-01 1.714e-01 0.954 0.340
## ESTRATO_3CATAlto -1.391e+01 4.780e+02 -0.029 0.977
## TIPO_OFICIAL 3.811e-01 3.615e-01 1.054 0.292
## TIPO_COMERCIAL -1.287e-02 3.224e-01 -0.040 0.968
## TIPO_RESIDENTIAL -1.078e-02 2.502e-01 -0.043 0.966
## TIPO_INDUSTRIAL 2.298e-01 3.289e-01 0.699 0.485
## TIPO_ZONA_HISTORICA 2.013e-01 5.442e-01 0.370 0.711
## TIPO_OTROS NA NA NA NA
## HAY_CICLORRUTA -1.373e-01 2.995e-01 -0.459 0.647
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1729.3 on 4711 degrees of freedom
## Residual deviance: 1688.1 on 4681 degrees of freedom
## (1142 observations deleted due to missingness)
## AIC: 1750.1
##
## Number of Fisher Scoring iterations: 16# Modelo para Mujeres
logit_female <- glm(
GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP +
mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_3CAT +
TIPO_OFICIAL + TIPO_COMERCIAL + TIPO_RESIDENTIAL +
TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA + TIPO_OTROS +
HAY_CICLORRUTA,
data = df_female,
family = binomial(link = "logit")
)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logit_female)##
## Call:
## glm(formula = GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
## SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP +
## mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_3CAT + TIPO_OFICIAL +
## TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
## TIPO_OTROS + HAY_CICLORRUTA, family = binomial(link = "logit"),
## data = df_female)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.205e+01 4.488e+03 -0.005 0.996
## MES_OCURREAGOSTO -7.920e-02 1.426e+00 -0.056 0.956
## MES_OCURREDICIEMBRE 1.066e+00 1.240e+00 0.859 0.390
## MES_OCURREENERO 7.231e-01 1.238e+00 0.584 0.559
## MES_OCURREFEBRERO 1.249e+00 1.129e+00 1.105 0.269
## MES_OCURREJULIO -1.546e+01 1.381e+03 -0.011 0.991
## MES_OCURREJUNIO 1.056e+00 1.168e+00 0.905 0.366
## MES_OCURREMARZO 9.464e-01 1.167e+00 0.811 0.418
## MES_OCURREMAYO 1.044e+00 1.169e+00 0.893 0.372
## MES_OCURRENOVIEMBRE 1.343e+00 1.168e+00 1.150 0.250
## MES_OCURREOCTUBRE 1.095e+00 1.169e+00 0.937 0.349
## MES_OCURRESEPTIEMBRE 1.569e+00 1.132e+00 1.386 0.166
## CLASE_ACCOTROS -3.041e-01 8.191e+03 0.000 1.000
## CLASE_ACCCHOQUE 1.648e+01 4.488e+03 0.004 0.997
## CLASE_ACCVOLCAMIENTO 2.907e-01 5.353e+03 0.000 1.000
## TIPOFUNCIO_PRINCIPAL 5.348e-01 8.490e-01 0.630 0.529
## SUPERFICIE_BUENA -6.653e-01 8.416e-01 -0.791 0.429
## ESTAASHTO_BUENO 7.780e-01 7.484e-01 1.039 0.299
## VIA_ANCHA 2.766e-01 4.078e-01 0.678 0.498
## COUNT_SITP -5.103e-03 3.966e-03 -1.287 0.198
## mean_V_REF -3.245e-07 5.013e-07 -0.647 0.517
## mean_Denpob -5.239e-04 1.127e-03 -0.465 0.642
## mean_Denemp -2.059e-03 3.320e-03 -0.620 0.535
## ESTRATO_3CATMedio 4.782e-01 4.705e-01 1.016 0.309
## ESTRATO_3CATAlto -1.548e+01 3.064e+03 -0.005 0.996
## TIPO_OFICIAL 1.978e-01 1.178e+00 0.168 0.867
## TIPO_COMERCIAL 1.238e+00 7.905e-01 1.566 0.117
## TIPO_RESIDENTIAL 1.871e-01 6.894e-01 0.271 0.786
## TIPO_INDUSTRIAL 1.037e+00 8.813e-01 1.177 0.239
## TIPO_ZONA_HISTORICA -1.577e+01 3.333e+03 -0.005 0.996
## TIPO_OTROS NA NA NA NA
## HAY_CICLORRUTA 1.984e-01 7.803e-01 0.254 0.799
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 294.75 on 1732 degrees of freedom
## Residual deviance: 270.05 on 1702 degrees of freedom
## (418 observations deleted due to missingness)
## AIC: 332.05
##
## Number of Fisher Scoring iterations: 1910.2 Modelo segregado por grupos etarios
df_joven <- df %>% filter(GRUPO_ETARIO == "JOVEN")
df_adulto <- df %>% filter(GRUPO_ETARIO == "ADULTO")
df_adulto_mayor <- df %>% filter(GRUPO_ETARIO == "ADULTO_MAYOR")
# Modelo Jóvenes
logit_joven <- glm(
GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA +
ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob +
mean_Denemp + ESTRATO_3CAT + TIPO_OFICIAL + TIPO_COMERCIAL +
TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
TIPO_OTROS + HAY_CICLORRUTA,
data = df_joven,
family = binomial(link = "logit")
)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logit_joven)##
## Call:
## glm(formula = GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
## SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP +
## mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_3CAT + TIPO_OFICIAL +
## TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
## TIPO_OTROS + HAY_CICLORRUTA, family = binomial(link = "logit"),
## data = df_joven)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.193e+01 1.073e+04 -0.002 0.99837
## MES_OCURREAGOSTO -1.840e+01 3.755e+03 -0.005 0.99609
## MES_OCURREDICIEMBRE -1.177e+00 1.523e+00 -0.773 0.43972
## MES_OCURREENERO -2.913e-01 1.324e+00 -0.220 0.82586
## MES_OCURREFEBRERO -1.889e+01 3.310e+03 -0.006 0.99545
## MES_OCURREJULIO 3.042e-01 1.157e+00 0.263 0.79262
## MES_OCURREJUNIO 7.272e-01 1.036e+00 0.702 0.48261
## MES_OCURREMARZO -1.855e+01 3.481e+03 -0.005 0.99575
## MES_OCURREMAYO -1.885e+00 1.437e+00 -1.312 0.18962
## MES_OCURRENOVIEMBRE -4.555e-01 1.336e+00 -0.341 0.73308
## MES_OCURREOCTUBRE 4.531e-01 1.173e+00 0.386 0.69939
## MES_OCURRESEPTIEMBRE -7.264e-01 1.389e+00 -0.523 0.60089
## CLASE_ACCOTROS 2.387e+01 3.162e+04 0.001 0.99940
## CLASE_ACCCHOQUE 1.788e+01 1.073e+04 0.002 0.99867
## CLASE_ACCVOLCAMIENTO 2.552e+00 1.335e+04 0.000 0.99985
## TIPOFUNCIO_PRINCIPAL -9.850e-01 1.311e+00 -0.751 0.45252
## SUPERFICIE_BUENA -3.278e-01 1.334e+00 -0.246 0.80590
## ESTAASHTO_BUENO 2.677e+00 1.367e+00 1.958 0.05024 .
## VIA_ANCHA -9.557e-01 9.815e-01 -0.974 0.33018
## COUNT_SITP -6.560e-03 6.443e-03 -1.018 0.30865
## mean_V_REF -2.042e-06 1.114e-06 -1.832 0.06690 .
## mean_Denpob -1.279e-03 1.857e-03 -0.689 0.49095
## mean_Denemp -1.465e-02 1.141e-02 -1.284 0.19915
## ESTRATO_3CATMedio 7.301e-01 7.643e-01 0.955 0.33944
## ESTRATO_3CATAlto -5.635e+00 1.075e+04 -0.001 0.99958
## TIPO_OFICIAL 1.905e+00 1.745e+00 1.091 0.27508
## TIPO_COMERCIAL 5.304e+00 1.827e+00 2.903 0.00369 **
## TIPO_RESIDENTIAL 1.128e+00 1.336e+00 0.844 0.39858
## TIPO_INDUSTRIAL 2.832e+00 1.874e+00 1.511 0.13067
## TIPO_ZONA_HISTORICA -1.633e+01 5.494e+03 -0.003 0.99763
## TIPO_OTROS NA NA NA NA
## HAY_CICLORRUTA 1.518e+00 1.186e+00 1.280 0.20044
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 136.228 on 524 degrees of freedom
## Residual deviance: 89.093 on 494 degrees of freedom
## (182 observations deleted due to missingness)
## AIC: 151.09
##
## Number of Fisher Scoring iterations: 20# Modelo Adultos
logit_adulto <- glm(
GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA +
ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob +
mean_Denemp + ESTRATO_3CAT + TIPO_OFICIAL + TIPO_COMERCIAL +
TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
TIPO_OTROS + HAY_CICLORRUTA,
data = df_adulto,
family = binomial(link = "logit")
)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logit_adulto)##
## Call:
## glm(formula = GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
## SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP +
## mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_3CAT + TIPO_OFICIAL +
## TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
## TIPO_OTROS + HAY_CICLORRUTA, family = binomial(link = "logit"),
## data = df_adulto)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.700e+01 5.151e+02 -0.033 0.9737
## MES_OCURREAGOSTO -6.255e-01 3.791e-01 -1.650 0.0990 .
## MES_OCURREDICIEMBRE -1.867e-01 3.707e-01 -0.504 0.6145
## MES_OCURREENERO -4.934e-01 3.696e-01 -1.335 0.1819
## MES_OCURREFEBRERO -1.188e-01 3.133e-01 -0.379 0.7045
## MES_OCURREJULIO -5.993e-01 3.689e-01 -1.625 0.1042
## MES_OCURREJUNIO -8.374e-02 3.296e-01 -0.254 0.7994
## MES_OCURREMARZO -3.503e-01 3.402e-01 -1.030 0.3032
## MES_OCURREMAYO -6.434e-01 3.791e-01 -1.697 0.0897 .
## MES_OCURRENOVIEMBRE -1.653e-01 3.534e-01 -0.468 0.6400
## MES_OCURREOCTUBRE -1.950e-01 3.536e-01 -0.552 0.5812
## MES_OCURRESEPTIEMBRE 2.594e-02 3.353e-01 0.077 0.9383
## CLASE_ACCOTROS -1.083e-01 1.270e+03 0.000 0.9999
## CLASE_ACCCHOQUE 1.403e+01 5.151e+02 0.027 0.9783
## CLASE_ACCVOLCAMIENTO 1.502e+01 5.151e+02 0.029 0.9767
## TIPOFUNCIO_PRINCIPAL 5.485e-01 4.179e-01 1.313 0.1893
## SUPERFICIE_BUENA 8.781e-03 3.639e-01 0.024 0.9807
## ESTAASHTO_BUENO 3.298e-01 2.376e-01 1.388 0.1651
## VIA_ANCHA 7.444e-02 1.670e-01 0.446 0.6557
## COUNT_SITP -9.756e-04 1.313e-03 -0.743 0.4575
## mean_V_REF -4.834e-07 2.215e-07 -2.183 0.0291 *
## mean_Denpob -2.041e-04 4.316e-04 -0.473 0.6363
## mean_Denemp 3.586e-04 1.197e-03 0.300 0.7645
## ESTRATO_3CATMedio 1.701e-01 1.864e-01 0.913 0.3613
## ESTRATO_3CATAlto -1.330e+01 4.089e+02 -0.033 0.9741
## TIPO_OFICIAL 4.313e-01 4.022e-01 1.072 0.2836
## TIPO_COMERCIAL 2.683e-01 3.380e-01 0.794 0.4273
## TIPO_RESIDENTIAL 6.333e-02 2.727e-01 0.232 0.8163
## TIPO_INDUSTRIAL 4.405e-01 3.460e-01 1.273 0.2030
## TIPO_ZONA_HISTORICA 6.047e-01 5.944e-01 1.017 0.3090
## TIPO_OTROS NA NA NA NA
## HAY_CICLORRUTA -5.178e-01 3.865e-01 -1.340 0.1803
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1578.5 on 5401 degrees of freedom
## Residual deviance: 1537.9 on 5371 degrees of freedom
## (1286 observations deleted due to missingness)
## AIC: 1599.9
##
## Number of Fisher Scoring iterations: 16# Modelo Adultos Mayores
logit_adulto_mayor <- glm(
GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL + SUPERFICIE_BUENA +
ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP + mean_V_REF + mean_Denpob +
mean_Denemp + ESTRATO_3CAT + TIPO_OFICIAL + TIPO_COMERCIAL +
TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
TIPO_OTROS + HAY_CICLORRUTA,
data = df_adulto_mayor,
family = binomial(link = "logit")
)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logit_adulto_mayor)##
## Call:
## glm(formula = GRAVEDAD ~ MES_OCURRE + CLASE_ACC + TIPOFUNCIO_PRINCIPAL +
## SUPERFICIE_BUENA + ESTAASHTO_BUENO + VIA_ANCHA + COUNT_SITP +
## mean_V_REF + mean_Denpob + mean_Denemp + ESTRATO_3CAT + TIPO_OFICIAL +
## TIPO_COMERCIAL + TIPO_RESIDENTIAL + TIPO_INDUSTRIAL + TIPO_ZONA_HISTORICA +
## TIPO_OTROS + HAY_CICLORRUTA, family = binomial(link = "logit"),
## data = df_adulto_mayor)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.430e+01 2.352e+03 -0.015 0.98836
## MES_OCURREAGOSTO 1.621e+01 8.621e+02 0.019 0.98500
## MES_OCURREDICIEMBRE 1.608e+01 8.621e+02 0.019 0.98512
## MES_OCURREENERO 1.612e+01 8.621e+02 0.019 0.98508
## MES_OCURREFEBRERO 1.625e+01 8.621e+02 0.019 0.98496
## MES_OCURREJULIO 1.645e+01 8.621e+02 0.019 0.98477
## MES_OCURREJUNIO 1.712e+01 8.621e+02 0.020 0.98415
## MES_OCURREMARZO 1.677e+01 8.621e+02 0.019 0.98448
## MES_OCURREMAYO 1.575e+01 8.621e+02 0.018 0.98543
## MES_OCURRENOVIEMBRE 1.515e+01 8.621e+02 0.018 0.98598
## MES_OCURREOCTUBRE 1.601e+01 8.621e+02 0.019 0.98518
## MES_OCURRESEPTIEMBRE 1.712e+01 8.621e+02 0.020 0.98415
## CLASE_ACCOTROS -6.634e-01 6.880e+03 0.000 0.99992
## CLASE_ACCCHOQUE 1.628e+01 2.188e+03 0.007 0.99406
## CLASE_ACCVOLCAMIENTO 1.787e+01 2.188e+03 0.008 0.99348
## TIPOFUNCIO_PRINCIPAL -2.587e+00 8.771e-01 -2.950 0.00318 **
## SUPERFICIE_BUENA 7.825e-01 7.896e-01 0.991 0.32168
## ESTAASHTO_BUENO -2.832e-01 3.876e-01 -0.731 0.46506
## VIA_ANCHA -2.382e-01 3.840e-01 -0.620 0.53500
## COUNT_SITP -2.276e-03 2.640e-03 -0.862 0.38863
## mean_V_REF 5.828e-07 3.994e-07 1.459 0.14452
## mean_Denpob -1.765e-03 9.796e-04 -1.801 0.07165 .
## mean_Denemp -1.909e-03 2.597e-03 -0.735 0.46213
## ESTRATO_3CATMedio 3.703e-01 3.760e-01 0.985 0.32465
## ESTRATO_3CATAlto -1.526e+01 2.852e+03 -0.005 0.99573
## TIPO_OFICIAL -1.322e-01 8.239e-01 -0.161 0.87248
## TIPO_COMERCIAL -5.134e-01 7.072e-01 -0.726 0.46788
## TIPO_RESIDENTIAL -3.279e-01 5.463e-01 -0.600 0.54837
## TIPO_INDUSTRIAL -1.126e-01 8.324e-01 -0.135 0.89236
## TIPO_ZONA_HISTORICA -7.802e-01 1.382e+00 -0.565 0.57236
## TIPO_OTROS NA NA NA NA
## HAY_CICLORRUTA 9.078e-01 5.502e-01 1.650 0.09894 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 343.02 on 543 degrees of freedom
## Residual deviance: 298.64 on 513 degrees of freedom
## (95 observations deleted due to missingness)
## AIC: 360.64
##
## Number of Fisher Scoring iterations: 17