Mineria de dades: PRA1 - Selecció i preparació d’un joc de dades
Autor: Joan Manel Ramírez Jávega
8 de Maig del 2024
1 Enunciat
Tot estudi analític ha de néixer d’una necessitat per part del negoci o d’una voluntat de dotar-lo d’un coneixement i contingut en les dades que només podrem obtenir a través d’una col·lecció de bones pràctiques basades en la Mineria de Dades.
El món de l’analítica de dades es sustenta en 3 eixos:
Un d’ells és el profund coneixement que hauríem de tenir del negoci a què tractem de donar respostes mitjançant els estudis analítics.
L’altre gran eix és sens dubte les capacitats analítiques que siguem capaços de desplegar i en aquest sentit, les dues pràctiques d’aquesta assignatura pretenen que l’estudiant realitzi un recorregut sòlid per aquest segon eix.
El tercer eix són les Dades. Les necessitats del negoci s’han de concretar amb preguntes analítiques que al seu torn siguin viables respondre a partir de les dades de què disposem. La tasca d’analitzar les dades és sens dubte important, però la tasca d’identificar-los i obtenir-los ha de ser per a un analista un repte permanent.
Com primera part de l’estudi analític que ens disposem a realitzar, es demana a l’estudiant que completi els següents passos:
Plantejar un problema de analítica de dades detallant-ne els objectius analítics i explicant una metodologia per a resoldre’ls d’acord amb lo practicat en les PAC anteriors i també d’acord a lo que s’ha aprés en el material didàctic.
Seleccionar un joc de dades i justificar-ne l’elecció. El joc de dades haurà de tenir capacitats perquè se li puguin aplicar algorismes supervisats i algorismes no supervisats a la PRA2 i haurà d’estar alineat amb el problema analític plantejat al pas anterior.
Requisit mínim: El joc de dades ha de tenir com a mínim 500 observacions amb un mínim de 5 variables numèriques, 2 categòriques i 1 binària. A més ha de ser diferent, és important que no sigui un dataset usat a les PAC anteriors.
Adjuntem aquí una llista de portals de dades obertes per seleccionar el joc de dades. Es poden utilitzar altres fonts per obtenir el vostre joc de dades, però recordeu de citar-les:
- Dades obertes:
- Conjunts de dades per a aprenentatge automàtic i investigació
Realitzar una anàlisi exploratòria de el joc de dades seleccionat.
Realitzar tasques de neteja i condicionat per poder ser usat en processos de modelatge.
Realitzar mètodes de discretització
Aplicar un estudi PCA sobre el joc de dades. Tot i no estar explicat en el material didàctic, es valorarà si en lloc de PCA investigueu pel vostre compte i apliqueu SVD (Single Value Decomposition).
- Alguns recursos
Per a totes les PRA cal documentar a cada apartat de l’exercici pràctic que s’ha fet, perquè s’ha fet i com s’ha fet. Així mateix, totes les decisions i conclusions hauran de ser presentades de forma raonada i clara, contextualitzant els resultats, és a dir, especificant tots i cadascun dels passos que s’hagin dut a terme per resoldre’ls. Finalment, incloeu una conclusió final resumint els resultats obtinguts en la pràctica i indiqueu eventuals citacions bibliogràfiques, fonts internes/externes i materials de recerca.
- Document lliurable
S’han de lliurar tant el fitxer RMD com el fitxer HTML resultant d’executar el document R/Python amb Rmarkdown mitjançant el comando Knit. Cal fer-ho amb el següent nom 75.584-PRA1-NomEstudiant.html
1.1 Recursos de programació
- Incloem en aquest apartat una llista de recursos de programació per a mineria de dades on podreu trobar exemples, idees i inspiració:
2 Objecte de l’anàlisi
2.1 Definició dels objectius
En una gran ciutat com Barcelona és habitual que cada dia tinguin lloc dotzenes d’accidents de trànsit. Amb aproximadament 1,66 milions d’habitants empadronats segons les dades del padró municipal a 1 de Gener del 2023 i de fins 2,288 milions de persones presents en algun moment al llarg del passat 22 de Març del 2024, que és el darrer dia laborable recollit en les dades recopilades de La ciutat al dia de l’Oficina Municipal de Dades de l’Ajuntament de Barcelona, això representa també centenars de miles de vehicles de tota mena - turismes, furgonetes, bicicletes…- utilitzats per tot aquell que té necessitat de desplaçar-se. En aquest cas cerquem explorar, a partir de les dades recopilades per la Guàrdia Urbana de Barcelona, un model predictiu que permeti analitzar i obtenir conclusions sobre els conductors implicats en accidents de trànsit amb algun tipus de lessió, incloses també les víctimes mortals. D’aquesta manera, es podrien obtenir conclusions que conduisin, per citar només una acció concreta, a impulsar campanyes especifícament adreçades a determinats comportaments o col·lectius detectats en aquest projecte.
L’objectiu final serà poder disposar, en aquesta primera etapa del projecte, d’un conjunt de dades ja preparat per poder bastir diversos tipus de modelització per la seva classificació mitjançant tècniques d’aprenentatge automàtic supervisat i no supervisat. Aquests mètodes entenem que permetran estudiar i obtenir conclusions també a partir de variables categòriques (MONTOLIU COLÁS, 2021) com, per exemple, el motiu conegut pel que es realitzava el trajecte per part del conductor o conductors implicats en l’accident. En aquesta línia, dues hipòtesis de treball que ens plantejem, per una banda, si les variables que estudiarem presenten alguna relació estadísticament significativa amb si els conductors implicats ho feien per alguna causa imputable al món del treball - de camí a la feina - in itinere, com descriu el Diccionario de la Real Academia Española o companyies asseguradores com Allianz- o bé durant el transcurs de la mateixa. Finalment, també estimem possible poder avaluar si les dades resulten d’utilitat o no per aquestes finalitats en el cas, per exemple, de detectar algun tipus de biaix.
2.2 Comprensió i descripció de l’origen del conjunt de dades
Cada accident de trànsit és documentat per part de la patrulla de la Guàrdia Urbana que hi intervé mitjançant l’atestat qe es prepara durant la seva intervenció, donant lloc posteriorment a l’acte administratiu de l’obertura de l’expedient corresponent, tenint cadascun d’aquests la seva pròpia codificació única. Per tant, cada registre corresponent a un accident es correspon a un event de caràcter aleatori i no previsible. Generalment, la intervenció de la corresponent patrulla de Guàrdia Urbana és perque es dóna avís a un equip d’emergència sanitària perque s’informa d’una víctima mortal o amb lesions, tot i que de vegades també s’hi intervé i s’aixeca un atestat en el cas que hi hagi un conflicte entre conductors o circumstàncies d’altra mena (GUÀRDIA URBANA DE BARCELONA, 2024a; RAMÍREZ JÁVEGA, 2024).
En l’expedient obert s’hi inclouen també les dades identificatives bàsiques referents de totes les persones involucrades en l’accident, ja siguin conductors o vianants, a més d’anotar-se si, s’escau, va resultar mort o amb lessions, recollint-se en aquest darrer cas també quin tipus d’atenció sanitària va requerir (GUÀRDIA URBANA DE BARCELONA 2024b; RAMÍREZ JÁVEGA, 2024). També es documenta la tipologia, model i altres característiques dels vehicles involucrats com també el tipus de permís de conducció del seu conductor i la seva antiguitat (GUÀRDIA URBANA DE BARCELONA, 2024c). En el moment de l’accident, la patrulla de la Guàrdia Urbana també anota l’adreça postal del lloc on va tenir l’accident i, mitjançant el seu dispositiu PDA, també es recopilen les geocoordenades del punt de referència de l’indret on va tenir lloc l’accident (RAMÍREZ JÁVEGA, 2024). Cal observar també que les taules dels subconjunts de dades corresponents a les persones implicades, vehicles implicats i motius immediats i mediats no inclouen una clau primària amb un codi identificador únic, es a dir, la referència a l’expedient hi pot aparèixer repetida.
Per aquest projecte en concret es tener en consideració cinc fonts de dades, cadascuna en format d’un fitxer de text pla CSV allotjat en el portal Open Data BCN, espai on s’allotgen per la seva consulta pública les dades d’accés obert tant de l’Ajuntament de Barcelona com també dels serveis municipals que en depenen, inclòs el cos de policia local de la Guàrdia Urbana de Barcelona, que és qui té la competència en qúestions de seguretat viària dins del terme municipal de Barcelona.
2.3 Anàlisi exploratòria
En primer lloc, presentem quines variables escollirem treballar:
Numero_expedient: Cadena de caràcters. Categòrica nominal. Aquest atribut serveix com clau forana que referencia a l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Codi_districte: Valor numèric discret. Categòrica nominal. Aquesta variable serveix per classificar en quin dels Districtes, que és l’unitat administrativa territorial del municipi de Barcelona, s’ubica l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Nom_districte: Cadena de caràcters. Categòrica nominal. Aquesta variable serveix per classificar en quin dels Districtes, que és l’unitat administrativa territorial del municipi de Barcelona, s’ubica l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Codi_barri: Valor numèric discret. Categòrica nominal. Aquesta variable serveix per classificar en quin dels barris, que és la subdivisió territorial dels Districtes del municipi de Barcelona, s’ubica l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Nom_barri: Cadena de caràcters. Categòrica nominal. Aquesta variable serveix per classificar en quin dels barris, que és la subdivisió territorial dels Districtes del municipi de Barcelona, s’ubica l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Codi_carrer: Valor numèric discret. Categòrica nominal. Aquesta variable serveix per classificar en quin carrer s’ubica l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Nom_carrer: Cadena de caràcters. Categòrica nominal. Aquesta variable serveix per classificar en quin dels barris, que és la subdivisió territorial dels Districtes del municipi de Barcelona, s’ubica l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Num_postal: Cadena de caràcters. Categòrica nominal. Variable que complementa l’adreça postal on s’ubica l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Descripcio_dia: Cadena de caràcters que referencia al tipus data. Variable que indica en quin dia de la setmana va tenir lloc l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
NK_Any: Valor quantitatiu discret que referencia al tipus data. Variable que indica en quin any va tenir lloc l’accident al que referencia l’expedient. En el cas d’aquest estudi, serà sempre l’any 2023. Comú amb la resta de subconjunts de dades.
Mes_any: Valor quantitatiu discret que referencia al tipus data. Variable que indica en quin mes va tenir lloc l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Nom_mes: Cadena de caràcters que referencia al tipus data. Variable que indica en quin mes va tenir lloc l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Dia_mes: Valor numèric discret que referencia al tipus data. Variable que indica en quin dia del mes va tenir lloc l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Hora_dia: Valor quantitatiu discret que referencia al tipus data. Variable que indica en quin hora del dia va tenir lloc l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Descripcio_torn: Cadena de caràcters. Variable categòrica nominal que indica a quin torn - Matí, Tarda o Nit- pertanyien els agents de la patrulla de Guàrdia Urbana que van intervenir i axecar l’atestat de l’accident al que referencia l’expedient. Comú amb la resta de subconjunts de dades.
Descripcio_causa vianant: Cadena de caràcters. Variable categòrica nominal que, segons es descriu en les metadades d’aquest subconjunt de dades (GUÀRDIA URBANA, 2024a) correspon a la descripció de la causa per part del vianant.
Desc_Tipus_vehicle_implicat: Cadena de caràcters. Variable categòrica nominal que descriu el tipus de vehicle implicat.
Descripcio_sexe: Cadena de caràcters. Variable categòrica nominal binària que descriu el sexe biològic de la persona implicada.
Descripcio_tipus_persona: Cadena de caràcters. Variable categòrica nominal que descriu si la persona implicada era conductor, passatger o vianant.
Descripcio_Lloc_atropellament_vianant: Cadena de caràcters. Variable categòrica nominal que descriu el lloc de desplaçament del vianant, si s’escau.
Descripcio_Motiu_desplaçament_conductor: Cadena de caràcters. Variable categòrica nominal que descriu el motiu de desplaçament del conductor.
Numero_expedient: Cadena de caràcters. Categòrica nominal. Aquest atribut serveix com clau forana que referencia a l’accident al que referencia l’expedient.
Descripcio_model: Cadena de caràcters. Categòrica nominal. Descripció del model comercial del vehicle.
Descripcio_marca: Cadena de caràcters. Categòrica nominal. Descripció de la marca comercial del vehicle.
Descripcio_color: Cadena de caràcters. Variable categòrica nominal que descriu del color del vehicle.
Descripcio_carnet: Cadena de caràcters. Variable categòrica nominal que indica el permís de conducció del conductor del vehicle.
Antiguitat_carnet: Valor quantitatiu continu que indica els anys sencers transcorreguts entre la data d’alta del permís de conducció del conductor del vehicle i la data de l’accident.
- Fitxer 2023_accidents_gu_bcn.csv:
Numero_expedient: Cadena de caràcters. Categòrica nominal. Aquest atribut serveix com clau primària i referencia al codi l’expedient corresponent a l’accident succeït.
Numero_morts: Valor quantitatiu continu. Variable que indica el nombre de víctimes mortals en el moment de l’accident o bé durant les següents 24 hores posteriors a l’accident (RAMÍREZ JÁVEGA, 2024).
Numero_lesionats_lleus: Valor quantitatiu continu. Variable que indica el nombre de víctimes que, o bé només van requerir d’atenció sanitària en el lloc de l’accident o bé només de forma contínua durant les 24 hores immediatament posteriors a l’accident (RAMÍREZ JÁVEGA, 2024).
Numero_lesionats_greus: Valor quantitatiu continu. Variable que indica el nombre de víctimes que van requerir d’atenció sanitària contínua més enllà de les 24 hores posteriors a l’accident (RAMÍREZ JÁVEGA, 2024).
Numero_victimes: Valor quantitatiu continu. Variable que indica el nombre de víctimes total comptabilitzades com morts, ferits greus o lleus.
Numero_vehicles_implicats: Valor quantitatiu continu. Variable que indica el nombre de vehicles implicats.
- Fitxer 2023_accidents_causes_gu_bcn.csv:
Numero_expedient: Cadena de caràcters. Categòrica nominal. Aquest atribut serveix com clau primària i referencia al codi l’expedient corresponent a l’accident succeït.
Descripcio_causa_mediata: Cadena de caràcters. Categòrica nominal. Aquesta variable detalla la causa mediata identificada per la corresponent patrulla de la Guàrdia Urbana que fer l’atestat de l’accident, fent referència a si es va detectar un cas d’alcoholèmia en algun dels conductors, hi havia objectes en la calçada, etcètera.
Numero_expedient: Cadena de caràcters. Categòrica nominal. Aquest atribut serveix com clau primària i referencia al codi l’expedient corresponent a l’accident succeït.
Descripcio_causa_mediata: Cadena de caràcters. Categòrica nominal. Aquesta variable detalla la causa mediata identificada per la corresponent patrulla de la Guàrdia Urbana que fer l’atestat de l’accident, fent referència al tipus de maniobra o circumstància immediata que va causar l’accident.
2.4 Exploració del conjunt de dades
Procedim a carregar les dades i comptabilitzar el nombre d’observacions en cadascun dels tres subconjunts de dades amb els que treballarem. El primer subconjunt serà el dels expedients oberts d’accidents de trànsit durant l’any 2023, tot cercant-hi també possibles registres duplicats i eliminant-los:
# Subdataset d'accidents:
filenameAccidents <- "https://opendata-ajuntament.barcelona.cat/data/dataset/e769eb9d-d778-4cd7-9e3a-5858bba49b20/resource/d12c8a6f-feb0-4c3e-bcf1-46b8a8b3d651/download/2023_accidents_gu_bcn.csv"
# Cerquem automatitzar el procés per aplicar l'encoder correcte al fitxer:
encoding <- guess_encoding(filenameAccidents, n_max = 1000)
dadesAccidents <- read.csv(filenameAccidents, sep=",", header=TRUE,
fileEncoding=paste(encoding[1,1]))
maskDuplicats <- duplicated(dadesAccidents$Numero_expedient)
nDuplicats <- nrow(dadesAccidents[maskDuplicats, ])
print(glue("Detectem {nDuplicats} registres duplicats i que eliminem."))## Detectem 3 registres duplicats i que eliminem.dadesAccidents <- dadesAccidents[!maskDuplicats, ]
nAccidents <- nrow(dadesAccidents)
print(glue("En total van tenir lloc a Barcelona {nAccidents} accidents en els que hi va intervenir
la Guàrdia Urbana durant l'any 2023."))## En total van tenir lloc a Barcelona 7721 accidents en els que hi va intervenir
## la Guàrdia Urbana durant l'any 2023.Ara estudiarem algunes de les característiques de les variables més rellevants. Per les etiquetes de colors emprades hem consultat aquest tutorial de R graph gallery, a més d’aquesta solució en StackOverflow per ordenar l’eix X:
level_districtes <- c("Desconegut", "Ciutat Vella", "Eixample", "Sants-Montjuïc", "Les Corts",
"Sarrià-Sant Gervasi", "Gràcia", "Horta-Guinardó", "Nou Barris",
"Sant Andreu", "Sant Martí")
ggplot(data=dadesAccidents, aes(Nom_districte)) +
geom_histogram(stat="count",
fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 1. Accidents amb intervenció de Guàrdia Urbana per Districtes.")) +
xlab("Districtes") +
ylab("Nombre d'accidents") + scale_x_discrete(limits = level_districtes) +
theme(axis.text.x = element_text(angle = 290, vjust = 0.6, hjust = 0.1))
cols <- data.frame(b = c("Numero_morts", "Numero_lesionats_greus",
"Numero_lesionats_lleus","Numero_victimes"),
names = c("Nombre d'accidents amb morts",
"Nombre d'accidents amb lesionats greus",
"Nombre d'accidents amb lesionats lleus",
"Nombre d'accidents agrupats en funció del nombre total de víctimes"),
colors = c('blue', 'lightblue', 'steelblue', 'darkslateblue'),
type = c("morts", "lesionats greus", "lesionats lleus",
"víctimes de tots els tipus"))
for (i in seq(1, nrow(cols), 1)){
col <- cols[i, 1]
label <- cols[i, 2]
string <- glue("Fig. 2.{i}. {label}.")
max_ <- max(dadesAccidents[col])
bins <- max_ + 1
print(ggplot(data=dadesAccidents, aes_string(x=col)) +
geom_histogram(bins=bins,
fill = cols[i, 3], color = "black") +
ggtitle(string) +
xlab(glue("{label}")) +
ylab("Freqüències") + scale_x_continuous(breaks = seq(0, max_, 1)))
maskPlusZero <- dadesAccidents[col] > 0
nPlusZero <- nrow(dadesAccidents[maskPlusZero, ])
propPlusZero <- round((nPlusZero / nAccidents) * 100, 3)
print(glue("En la variable {col} es compten {nPlusZero} observacions
superiors a zero, es a dir, el {propPlusZero} % del total.
El detall de les mètriques d'aquesta variable és:"))
print(summary(dadesAccidents[col]))
print(glue("\n\n"))
}
## En la variable Numero_morts es compten 21 observacions
## superiors a zero, es a dir, el 0.272 % del total.
##
## El detall de les mètriques d'aquesta variable és:
## Numero_morts
## Min. :0.00000
## 1st Qu.:0.00000
## Median :0.00000
## Mean :0.00272
## 3rd Qu.:0.00000
## Max. :1.00000
## En la variable Numero_lesionats_greus es compten 211 observacions
## superiors a zero, es a dir, el 2.733 % del total.
##
## El detall de les mètriques d'aquesta variable és:
## Numero_lesionats_greus
## Min. :0.00000
## 1st Qu.:0.00000
## Median :0.00000
## Mean :0.02927
## 3rd Qu.:0.00000
## Max. :3.00000
## En la variable Numero_lesionats_lleus es compten 6696 observacions
## superiors a zero, es a dir, el 86.725 % del total.
##
## El detall de les mètriques d'aquesta variable és:
## Numero_lesionats_lleus
## Min. : 0.000
## 1st Qu.: 1.000
## Median : 1.000
## Mean : 1.107
## 3rd Qu.: 1.000
## Max. :25.000
## En la variable Numero_victimes es compten 6867 observacions
## superiors a zero, es a dir, el 88.939 % del total.
##
## El detall de les mètriques d'aquesta variable és:
## Numero_victimes
## Min. : 0.000
## 1st Qu.: 1.000
## Median : 1.000
## Mean : 1.139
## 3rd Qu.: 1.000
## Max. :26.000maxVehicles <- max(dadesAccidents$Numero_vehicles_implicats)
ggplot(data=dadesAccidents, aes(x=Numero_vehicles_implicats)) +
geom_histogram(stat="count",
fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 3. Accidents amb intervenció de Guàrdia Urbana per nombre de vehicles implicats.")) +
xlab("Nombre de vehicles implicats") +
ylab("Nombre d'accidents") +
theme(axis.text.x = element_text(angle = 290, vjust = 0.6, hjust = 0.1) +
scale_x_continuous(breaks = seq(0, maxVehicles, 1)))
level_mesos <- c("Gener", "Febrer", "Març", "Abril", "Maig", "Juny", "Juliol", "Agost",
"Setembre", "Octubre", "Novembre", "Desembre")
ggplot(data=dadesAccidents, aes(x=Nom_mes)) +
geom_histogram(stat="count",
fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 4.1. Accidents amb intervenció de Guàrdia Urbana per mes quan va tenir lloc
el succés.")) +
xlab("Mesos") + scale_x_discrete(limits = level_mesos) +
ylab("Nombre d'accidents") +
theme(axis.text.x = element_text(vjust = 0.6, hjust = 0.1) +
scale_x_continuous(breaks = seq(0, 12, 1)))
ggplot(data=dadesAccidents, aes(x=Hora_dia)) +
geom_histogram(stat="count",
fill = "steelblue", color = "black") +
ggtitle(glue("Fig. 4.2. Accidents amb intervenció de Guàrdia Urbana per hora del dia del succés.")) +
xlab("Hora del dia") +
ylab("Nombre d'accidents") +
theme(axis.text.x = element_text(vjust = 0.6, hjust = 0.1) +
scale_x_continuous(breaks = seq(0, 24, 1)))
level_setmana <- c('Dilluns', 'Dimarts', 'Dimecres', 'Dijous', 'Divendres', 'Dissabte', 'Diumenge')
ggplot(data=dadesAccidents, aes(x=Descripcio_dia_setmana)) +
geom_histogram(stat="count",
fill = "darkslateblue", color = "black") +
ggtitle(glue("Fig. 4.3. Accidents amb intervenció de Guàrdia Urbana per dia de la setmana del succés.")) +
xlab("Dia de la setmana") +
ylab("Nombre d'accidents") + scale_x_discrete(limits = level_setmana) +
theme(axis.text.x = element_text(vjust = 0.6, hjust = 0.1) +
scale_x_continuous(breaks = seq(0, 7, 1)))
En general, la distribució territorial dels accidents (Figura 1) sembla correspondre amb la seva densitat urbana - el cas pardigmàtic seria l’Eixample- o la extensió en superfície dels districtes, sent això coherent amb el fet que els districtes de l’Eixample, Sant Martí, Sarrià-Sant Gervasi i Sants-Montjuic siguin també els quatre que s’han comptabilitzat més accidents en que ha intervingut la Guàrdia Urbana. En canvi, crida l’atenció que Les Corts, que és un districte més reduït en densitat de població i superfícies urbanitzades, en canvi tingui comptabilitzats pràcticament el mateix nombre d’accidents de trànsit que Horta-Guinardó, que està més densament poblat i també és més extens. També s’observa un cert nombre d’accidents que, per algun motiu, no s’indica en quin Districte van tenir lloc.
Per altra banda, a l’hora d’estudiar les quatre variables quantitatives que es refereixen al nombre de víctimes i si aquestes van ser o bé mortals o bé lesionades greus o lleus, s’observa que en la gran majoria d’accidents hi va haver-hi al menys una víctima - el 88.939 % del total- i es pot concloure que la gran majoria és pel fet que hi hagués al menys 1 ferit lleu, atès que aquest va ser el cas del 86.725 % dels accidents on hi van intervener-hi la Guàrdia Urbana, sent molt menor el nombre d’accidents reportats amb cap víctima de qualsevol tipus (v. Figura 2.4). Això coincideix amb el coneixement que teníem de la forma de recopilar les dades que ja indicava el caràcter residual dels expedients oberts per accidents de trànsit sense ferits (v. apartat 2.2, supra) i ens condueix a que, a l’hora de netejar les dades, és oportú descartar aquests registres ja que introduïrien soroll a l’hora de modelitzar el conjunt poblacional objecte d’estudi, es a dir, les persones conductores involucrades en accidents amb algun tipus de víctima mortal o que requerís d’atenció sanitària. També cal apreciar que en la majoria d’accidents de trànsit va haver-hi només 1 persona lesionada de forma lleu (v. Figura 2.3) i, en tots els casos, s’aprecia una distribució esbiaxada cap a l’esquerra de valors corresponents a zero - excepte en el cas deles lesionats lleus, atès que el criteri per crear un expedient és generalment que hi hagi com mínim una persona que requereixi d’atenció sanitària (RAMÍREZ JÁVEGA, 2024)- i amb una cua llarga cap al dreta, especialment observable en el cas del nombre de flesionats lleus i del nombre de persones o vehicles implicats (Figures 2.3, 2.4 i 3). Un cas similar s’observa en el cas de la variable del nombre de vehicles implicats (v. Figura 3), tot mostrant un nombre molt reduït d’accidents amb cap vehicle implicat i que, possiblement, sigui fruït d’algun tipus d’anomalia en aquest subconjunt de dades i, per tant, que també sembla oportú excloure aquestes observacions de l’anàlisi.
Finalment, també cerquem fer una primera exploració de la distribució dels accidents atès al mes, a l’hora del dia i el dia de la setmana, tot observant-se que els accidents tendeixen a ser menys freqüents durant l’horari nocturn i els caps de setmana. també s’observa que va ser l’agost el mes amb menys accidents on hi va intervenir-hi la Guàrdia Urbana. En aquest sentit, posteriorment cercarem complementar aquestes dades etiquetant cada si accident en funció de si era un dia intersetmanal laborable o no - tot consultant el calendari laboral del 2023 (SEGURA, 2023)-; i, finalment, també si era cap de setmana o no.
A continuació, procedim a explorar el subconjunt de dades corresponent als vehicles implicats en accidents de trànsit durant l’any 2023, tot eliminant prèviament alguns registres erronis - “” - detectats:
# Subdataset dels vehicles implicats:
filenameVehicles <- "https://opendata-ajuntament.barcelona.cat/data/dataset/317e3743-fb79-4d2f-a128-5f12d2c9a55a/resource/e7f52bf9-30a7-41d3-a15d-cac3f2da7025/download/2023_accidents_vehicles_gu_bcn.csv"
encoding <- guess_encoding(filenameVehicles, n_max = 1000)
dadesVehicles <- read.csv(filenameVehicles, sep=",", header=TRUE,
fileEncoding=paste(encoding[1,1]))
maskVehiclesErrors <- dadesVehicles$Numero_expedient == ""
dadesVehicles <- dadesVehicles[!maskVehiclesErrors, ]
nVehicles <- nrow(dadesVehicles)
nAccidentsVehicles <- length(unique(dadesVehicles$Numero_expedient))
print(glue("En total {nVehicles} vehicles es van veure implicats en {nAccidentsVehicles} accidents en els
que hi va intervenir la Guàrdia Urbana durant l'any 2023."))## En total 14357 vehicles es van veure implicats en 7717 accidents en els
## que hi va intervenir la Guàrdia Urbana durant l'any 2023.Atès a l’absència d’una veritable clau primària que ens permeti identificar inequívocament al conductor d’un vehicle determinat amb el subconjunt de dades de les persones implicades en un accident, no en podem extreure directament profit pel present problema analític tot i que sí les podrem aprofitar mitjançant la seva agrupació o agregació en la fase de neteja de dades. Per això, també en fem la seva exploració per disposar de més informació que ens serveixi per enriquir l’anàlisi. Prèviament cal fer aquí una petita neteja de les dades per descartar aquells registres que presenten el valor sentinella “Desconegut” al en el cas de la variable “Antiguitat_carnet” que ens permeti conèixer la seva distribució i comparar-la, posteriorment, amb la variable de l’edat del subconjunt de dades de les persones implicades en els accidents:
ggplot(data=dadesVehicles, aes(x=Descripcio_tipus_vehicle)) +
geom_histogram(stat="count",
fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 5. Vehicles implicats en accidents amb intervenció de Guàrdia Urbana
agrupats per tipus de vehicle.")) +
xlab("Tipus de vehicles") +
ylab("Nombre d'accidents") +
theme(axis.text.x = element_text(angle = 275, vjust = 0.6, hjust = 0.1))
maskDesconegut <- dadesVehicles$Antiguitat_carnet == "Desconegut"
nDesconegutsAntiguitat <- length(dadesVehicles$Antiguitat_carnet[maskDesconegut])
print(glue("Hem descartat {nDesconegutsAntiguitat} registres dels que es desconeixia
l'antiguitat del permís de conduir."))## Hem descartat 2873 registres dels que es desconeixia
## l'antiguitat del permís de conduir.dadesVehicles <- dadesVehicles[maskDesconegut == FALSE, ]
dadesVehicles$Antiguitat_carnet <- as.integer(dadesVehicles$Antiguitat_carnet)
ggplot(data=dadesVehicles, aes(x=Antiguitat_carnet)) +
geom_histogram(bins=16,
fill = "lightblue", color = "black") +
ggtitle("Fig. 6. Grups d'anys complets d'antiguitat del permís de conducció dels conductors
implicats en accidents amb intervenció de Guàrdia Urbana.") +
xlab("Grups d'anys d'antiguitat del permís de conduir") +
ylab("Freqüències") + scale_x_continuous(breaks = seq(0, 80, 5))
En primer lloc, en la Figura 5 s’observa que els tipus de vehicles que presenten més elevada sinistralitat són els turismes, les motocicletes, les furgonetes, les bicicletes i els Vehicles de mobilitat personal (VMP) amb motor. Per altra banda, en la Figura 6 s’observa que els anys d’antiguitat dels permisos de conduir coneguts es distribueix mostrant un cert biaix cap a l’esquerra, observant-se que la cohort de conductors més novells, es a dir, aquells amb menys de 5 anys d’antiguitat del permís de conduir. Resulta oportú poder estudiar aquesta variable juntament amb la representació de les cohorts en funció de l’edat de les persones implicades la Figura 9 (infra).
En tot cas i a partir de l’observació dels resultats de la Figura 5, cercarem també aturar-nos per estudiar el nombre d’accidents en funció del nombre de motocicletes i turismes implicats mitjanaçant la seva agrupació, tot seguint aquests mètodes proposats - 1, 2 i 3- en el site StackOverflow. Atès que, posteriorment, estandaritzarem les classes dels tipus de vehicles per poder-ne fer l’agregació i fer-ne posteriorment la combinació:
xx <- dadesVehicles %>% count(Numero_expedient, Descripcio_tipus_vehicle)
groupbyTipusVehicle <- pivot_wider(xx, names_from = c('Descripcio_tipus_vehicle'), values_from = 'n')
groupbyTipusVehicle <- groupbyTipusVehicle %>%
mutate(across(everything(), replace_na, 0))
maxMotos <- max(groupbyTipusVehicle$Motocicleta)
ggplot(data=groupbyTipusVehicle, aes(x=Motocicleta)) +
geom_histogram(bins=maxMotos, fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 7.1. Agrupació per nombre de motocicletes implicades en accidents amb
intervenció de Guàrdia Urbana en funció de quantes motocicletes hi van
estar implicades.")) +
xlab("Nombre de motocicletes") +
ylab("Freqüències") + scale_x_continuous(breaks = seq(0, maxMotos, 1))
maxTurismes <- max(groupbyTipusVehicle$Turisme)
ggplot(data=groupbyTipusVehicle, aes(x=Turisme)) +
geom_histogram(bins=maxTurismes, fill = "steelblue", color = "black") +
ggtitle(glue("Fig. 7.2. Agrupació per nombre de turismes implicats en accidents amb
intervenció de Guàrdia Urbana.")) +
xlab("Nombre de turismes") +
ylab("Freqüències") + scale_x_continuous(breaks = seq(0, maxTurismes, 1))
També procedim a realitzar l’exploració corresponent al subconjunt de dades corresponent a les persones involucrades en accidents, tot procedint a descartar un cert nombre de registres dels que s’ha detectat que contenien dades errònies amb referències de geocoordenades en la variable “Descripcio_victimitzacio”:
# Persones involucrades:
filenamePersones <- "https://opendata-ajuntament.barcelona.cat/data/dataset/87aa433e-fef8-4ff4-8f9a-d66e9beefff6/resource/00ff4482-841d-4dcf-8f2d-59237b2ec517/download/2023_accidents_persones_gu_bcn.csv"
encoding <- guess_encoding(filenamePersones, n_max = 1000)
dadesPersones <- read.csv(filenamePersones, sep=",", header=TRUE,
fileEncoding=paste(encoding[1,1]))
nDadesPersones <- nrow(dadesPersones)
nAccidentsPersones <- length(unique(dadesPersones$Numero_expedient))
maskPersonesError <- grepl("[0-9].[0-9]", dadesPersones$Descripcio_victimitzacio)
dadesPersonesError <- dadesPersones[maskPersonesError, ]
nErrors <- nrow(dadesPersonesError)
dadesPersones <- dadesPersones[maskPersonesError==FALSE, ]
#length(!duplicated(dadesPersones$Descripcio_victimitzacio[grepl("Mort", dadesPersones$Descripcio_victimitzacio)]))
print(glue("Durant l'any 2023 van haver-hi en total {nDadesPersones} persones involucrades en {nAccidentsPersones}
accidents de trànsit que van requerir de la intervenció de la Guàrdia Urbana,
descartant-ne {nErrors} observacions per errors detectats en aquest subconjunt de dades."))## Durant l'any 2023 van haver-hi en total 8776 persones involucrades en 6867
## accidents de trànsit que van requerir de la intervenció de la Guàrdia Urbana,
## descartant-ne 27 observacions per errors detectats en aquest subconjunt de dades.ggplot(data=dadesPersones, aes(x=Descripcio_sexe)) +
geom_histogram(stat="count",
fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 8. Sexe biològic de les persones implicades en accidents amb intervenció de
Guàrdia Urbana.")) +
xlab("Sexe biològic") +
ylab("Nombre de persones") +
theme(axis.text.x = element_text(angle = 275, vjust = 0.6, hjust = 0.1))
En el cas de la variable categòrica nominal binària del sexe biològic, constatem que la majoria de persones implicades en un accident de trànsit van ser homes. Pel cas de la variable “Edat” torna a ser necessari filtrar aquells registres amb el valor sentinella “Desconegut”:
maskDesconegutEdat <- dadesPersones$Edat == "Desconegut"
nDesconegutsEdat <- length(dadesVehicles$Antiguitat_carnet[maskDesconegutEdat])
print(glue("Hem descartat {nDesconegutsEdat} registres dels que es desconeixia
l'edat de la persona."))## Hem descartat 11 registres dels que es desconeixia
## l'edat de la persona.dadesPersonesEdatConeguda <- dadesPersones[maskDesconegutEdat == FALSE, ]
dadesPersonesEdatConeguda$Edat <- as.integer(dadesPersonesEdatConeguda$Edat)
ggplot(data=dadesPersonesEdatConeguda, aes(x=Edat)) +
geom_histogram(bins=20,
fill = "lightblue", color = "black") +
ggtitle("Fig. 9. Grups d'edat de les persones implicades en accidents
amb intervenció de Guàrdia Urbana.") +
xlab("Grups d'edat") +
ylab("Freqüències") + scale_x_continuous(breaks = seq(0, 100, 5))
Atès que el que el cerquem estudiar és el cas dels conductors, resulta oportú, encara que sigui només una pinzellada, fer l’anàlisi descriptiva de les variables que treballarem en aquests dos grups:
ggplot(data=dadesPersones, aes(x=Descripció_tipus_persona)) +
geom_histogram(stat="count",
fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 10. Agrupació de les persones implicades en accidents amb intervenció
de Guàrdia Urbana en funció si eren conductors, vianants o passatgers.")) +
xlab("Tipus") +
ylab("Nombre de persones") +
theme(axis.text.x = element_text(angle = 275, vjust = 0.6, hjust = 0.1))
tipus <- unique(dadesPersones$Descripció_tipus_persona)
colors <- c('lightblue', 'steelblue', 'darkslateblue')
for (i in seq(1, length(tipus), 1)){
t <- tipus[i]
c <- colors[i]
mask_tipus <- dadesPersonesEdatConeguda$Descripció_tipus_persona == t
df <- dadesPersonesEdatConeguda[mask_tipus, ]
nTipus <- nrow(df)
print(glue("En total van estar involucrades {nTipus} persones en accidents amb intervenció
de Guàrdia Urbana i sent classificades com: {t}.\n\n"))
print(ggplot(data=df, aes(x=Edat)) +
geom_histogram(bins=20, fill = c, color = "black") +
ggtitle(glue("Fig. 11.{i}. Agrupació per edat de les persones implicades en accidents amb
intervenció de Guàrdia Urbana en funció si era: {t}.")) +
xlab("Grups d'edat") +
ylab("Freqüències") + scale_x_continuous(breaks = seq(0, 100, 5)))
}## En total van estar involucrades 962 persones en accidents amb intervenció
## de Guàrdia Urbana i sent classificades com: Vianant.
## En total van estar involucrades 6028 persones en accidents amb intervenció
## de Guàrdia Urbana i sent classificades com: Conductor.
## En total van estar involucrades 1750 persones en accidents amb intervenció
## de Guàrdia Urbana i sent classificades com: Passatger.
S’observa clarament que es tracta de 3 poblacions que presenten diferències molts substancials en la distribució per grups d’edat. En el cas concret de la cohort de conductors, s’observa un cert desequilibri cap a l’esquerra, es a dir , cap als conductors més joves. Per altra banda, si bé l’edat mínima per poder disposar d’un permís de conduir són els 18 anys - 16 en el cas dels ciclomotors-, presumiblement els grups d’edat inferior corresponen al cas de conductors de bicicletes, VMP amb motor i altres tipus de vehicles que no requereixen de cap permís de conducció (v. Figura 6, supra). Finalment, s’observaria que la sinistralitat entre els conductors menors de 30 anys és força inferior al dels grups compresos entre els 30 i 39 anys d’edat, sent aquests els grups més nombrosos. Això ens convida a a que una nova variable a crear podria ser una de caràcter binari Si/No (1/0) preguntant-nos si en l’accident on el conductor va estar implicar hi havia algun conductor amb un permís de conducció (v. Figura 7, supra) inferior als 5 anys d’antiguitat per incloure en la futura modelització, d’aquesta manera, si la implicació d’un conductor novell és un factor de risc per que es produeixi o no un accident. Per això, també cerquem identificar quins són els seus rangs interquartils:
cols <- c("Descripcio_causa_vianant", "Desc_Tipus_vehicle_implicat", "Descripcio_sexe",
"Descripcio_Lloc_atropellament_vianant", "Descripcio_Motiu_desplacament_conductor",
"Descripcio_victimitzacio")
maskConductor <- dadesPersonesEdatConeguda$Descripció_tipus_persona == "Conductor"
dadesConductors <- dadesPersonesEdatConeguda[maskConductor, ]
summary(dadesConductors$Edat)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 28.0 37.0 39.1 49.0 89.0S’observa que els rangs interquartils s’aproximen força a l’anàl·lisi anteriorment compartit i també que la mitjana està força condicionada per la presència d’un ampli rang de valors extrems, atès que el rang del grup pertanyent al tercer quartil abasta des dels 49 fins als 89 anys d’edat , per tant, ens justificaria conduir a una classificació d’acord als rangs interquartils o IQR (BRUCE, BRUCE i GEDECK, 2022: 18).
A continuació, també estudiem la resta de variables categòriques - 6 en total- però només pel grup de conductors mitjançant un diagrama de barres apilades stacked bar chart - tal i com es proposa en aquest article de STHDA, tot executant el mètode dins d’una iteració, inspirant-nos en aquestes solucions (1 i 2) proposades en el site StackOverflow:
for (i in seq(1, length(cols), 1)){
col <- cols[i]
df <- dadesConductors[c("Numero_expedient", col)]
agg <- aggregate(df$Numero_expedient, by=df[col], FUN=length)
colnames(agg) <- c("Variable", "x")
print(ggplot(agg, aes(x="", y=x, fill=Variable)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(glue("Fig. 12.{i} Diagrama de barres apilades del recompte
dels grups corresponents a la variable
{col}.")) +
xlab(glue("{col}")) +
ylab("Nombre"))
}
Si comparem el resultat de les Figures 12.1 i 12.4, constatem que la variable “Descripcio_Lloc_atropellament_vianant” resulta més informativa i útil que “Descripcio_causa_vianant” a l’hora d’identificar si l’accident en qüestió va ser un atropellament a un vianant o no, atès que en la primera sí s’hi inclouen tots els atropellament, mentre en el segon cas no es diferencia entre si va haver un atropellament o bé aquest no va ser causat pel vianant. La Figura 12.2 no deixa de ser una representació en format diferent del ja observat en la Figura 5, excepte en el fet que en la Figura 12.2 hi ha comptabilitzades més motocicletes que turismes, en clara discrepància que la Figura 6. Tal i com vam fer amb les Figures 7.1 i 7.2, ens aturem de nou per comprovar si hi ha un canvi de comportament:
xx <- dadesConductors %>% count(Numero_expedient, Desc_Tipus_vehicle_implicat)
groupbyTipusVehicle_ <- pivot_wider(xx, names_from = c('Desc_Tipus_vehicle_implicat'),
values_from = 'n')
groupbyTipusVehicle_ <- groupbyTipusVehicle_ %>%
mutate(across(everything(), replace_na, 0))
maxMotos_ <- max(groupbyTipusVehicle_$Motocicleta)
ggplot(data=groupbyTipusVehicle_, aes(x=Motocicleta)) +
geom_histogram(bins=maxMotos_, fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 12.7. Agrupació per edat de les persones implicades en accidents amb
intervenció de Guàrdia Urbana en funció de quantes motocicletes hi van
estar implicades.")) +
xlab("Nombre de motocicletes") +
ylab("Freqüències") + scale_x_continuous(breaks = seq(0, maxMotos_, 1))
maxTurismes_ <- max(groupbyTipusVehicle_$Turisme)
ggplot(data=groupbyTipusVehicle_, aes(x=Turisme)) +
geom_histogram(bins=maxTurismes_, fill = "steelblue", color = "black") +
ggtitle(glue("Fig. 12.8. Agrupació per edat de les persones implicades en accidents amb
intervenció de Guàrdia Urbana en funció de quants turismes hi van
estar implicats.")) +
xlab("Nombre de turismes") +
ylab("Freqüències") + scale_x_continuous(breaks = seq(0, maxTurismes_, 1))
I, efectivament, constatem un canvi del comportament del grup de conductors, observant ara que en el cas dels turismes ara és més freqüent que no hi hagi cap conductor de vehicles tipus turisme amb algun tipus de victimització (v. 7.2) i, en canvi, es manté la tendència en el cas dels conductors de motocicletes (v. Figura 7.1). Això s’explica per que en aquest grup es recopilen aquells individus que han patit algun tipus de victimització (v. Figura 12.6) i també pel fet que el conductor d’una motocicleta compta amb molt menys protecció en cas d’accident que el conductor d’un turisme. En tot cas, realitzarem l’estandarització de les classes de tipus de vehicle del grup de conductors a només quatre categories (v. infra).
També en la Figura 12.3 es constata que la gran majoria de conductors implicats en aquests accidents de trànsit van ser homes. En el cas de la Figura 12.6, que representa el tamany dels grups del tipus de victimització, es constata la necessitat d’estandaritzar les categories a només tres (v. infra) i constatant que no s’han recopilat les dades d’aquells conductors implicats en accidents que han resultat il·lesos.
En relació al cas de la variable “Descripcio_Motiu_desplacament_conductor” constatem que es desconeix el motiu del seu desplaçament en quasi la mateitat dels conductors involucrats en accidents de trànsit. atès als apunts d’estudi (GIRONÉS ROIG, 2021: 11-12), l’opció més raonable en el context d’aquest projecte és descartar aquests registres en gran mesura per que disposarem encara d’un volum més que suficient de dades de prou qualitat, tot i que una altra opció podria ser fer-ne’n la imputació mitjançant un model predictiu de la família dels arbres de classificació i regressió del Bosc aleatori - Random forest- (SALERNO, 2020; BRUCE, BRUCE i GEDECK, 2022: 244-246) o bé mitjançant la Regressió logística. En aquest cas i atès que l’objectiu del nostre projecte és cercar predir si els accidents estan relacionats amb el món del treball, aquesta variable la emparem per la seva posterior codificació reduint-la a una variable categòrica binària Si/No en referència ala pregunta: Es tracta d’un accident de trànsit relacionat amb el món del treball? (Es_mon_treball).
Finalment, procedim a l’anàl·lisi del subconjunt de dades corresponent a la causes de cada accident imputables a un conductor. En aquest cas, pot donar-se el cas que els registres estiguin duplicats atès que en un mateix accident cadascun dels conductors pot haver realitzat una maniobra diferent. també representarem gràficament els diversos grups existents en aquesta variable:
filenameCauses <- "https://opendata-ajuntament.barcelona.cat/data/dataset/719b1054-4166-4692-b63e-622b621b4293/resource/9cc9f943-4a2a-4a31-9957-7041794b267c/download/2023_accidents_causes_gu_bcn_.csv"
encoding <- guess_encoding(filenameCauses, n_max = 1000)
dadesCauses <- read.csv(filenameCauses, sep=",", header=TRUE,
fileEncoding=paste(encoding[1,1]))
aggCauses <- aggregate(dadesCauses$Numero_expedient,
by=dadesCauses["Descripcio_causa_mediata"], FUN=length)
ggplot(aggCauses, aes(x="", y=x, fill=Descripcio_causa_mediata)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(glue("Fig. 13. Diagrama de barres apilades del recompte dels
grups corresponents a les causes dels accident de trànsit.")) +
xlab(glue("Causes")) +
ylab("Nombre")
En la variable categòrica de “Descripció de la causa mediata” observem que la classe predominant és No hi ha causa mediata, significant que no existeix una causa identificable més enllà de la infracció de trànsit que es descriu en el subconjunt de dades de causes imputables al conductor. Atès que tampocno s’indica en el cas de les causes mediates relacionades amb les condicions de la persona, com són el consum d’alcohol o de drogues, corresponen o no a un conductor - que és l’objecte del nostre anàl·lisi-, valorem excloure aquesta variable del model.
filenameManiobra <- "https://opendata-ajuntament.barcelona.cat/data/dataset/29d1b774-a83e-4c1e-91f7-1b9ad042ea83/resource/5a040155-38b3-4b19-a4b0-c84a0618d363/download/2023_accidents_causa_conductor_gu_bcn_.csv"
encoding <- guess_encoding(filenameManiobra, n_max = 1000)
dadesManiobra <- read.csv(filenameManiobra, sep=",", header=TRUE,
fileEncoding=paste(encoding[1,1]))
aggManiobra <- aggregate(dadesManiobra$Numero_expedient,
by=dadesManiobra["Descripcio_causa_mediata"], FUN=length)
ggplot(aggManiobra, aes(x="", y=x, fill=Descripcio_causa_mediata)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(glue("Fig. 14. Diagrama de barres apilades del recompte dels
grups corresponents a les causes immediates
dels accidents de trànsit.")) +
xlab(glue("Causes")) +
ylab("Nombre")
nAccidentsManiobra <- length(unique(dadesManiobra$Numero_expedient))
nDadesManiobra <- nrow(dadesManiobra)
maskDuplicatsManiobra <- duplicated(dadesManiobra$Numero_expedient)
nDuplicatsManiobra <- nrow(dadesManiobra[maskDuplicatsManiobra, ])
print(glue("\nEs detecten {nDuplicatsManiobra} registres duplicats del total de {nDadesManiobra} del subconjunt de dades
de les causes immediates de {nAccidentsManiobra} accidents amb intervenció de Guàrdia Urbana."))## Es detecten 1176 registres duplicats del total de 8897 del subconjunt de dades
## de les causes immediates de 7721 accidents amb intervenció de Guàrdia Urbana.En aquesta darrera variable s’observa la presència de determinades categories com No determinada, Desconegut o Altres que valorem que no aporten un veritable valor analític i que, per tant, serà oportú descartar. Al no disposar d’un criteri que ens informi de cap priorització, optarem per conservar només aquells registres duplicats que hi apareguin per primer cop.
3 Preprocessament i gestió de característiques
3.1 Neteja
Procedim ara fer la neteja de les dades i procedirem variable per variable, exceptuant totes aquelles que tenen un caràcter descriptiu del registre, com seria el número de l’expedient, ubicació i les que fan referència a la marca temporal del succés:
dadesPersones.Descripcio_tipus_persona: Ja s’ha realitzat la sel·lecció del grup d’observacions corresponents als conductors implicats en accidents de trànsit (v. supra).
dadesPersones.Descripcio_causa_vianant: Atès que ja disposem de la variable “Descripcio_lloc_atropellament_vianant” que, conceptualment, ens informa si va haver-hi un atropellament per part d’un vehicle a un vianant, conèixer si l’accident va ser causat per un vianant ens aportaria en aquest cas menys informació atès que un vianant pot haver sigut atropellat sense que el vianant hagi sigut el causant. Per tant, es descartarà aquesta variable.
dadesPersones.Descripcio_sexe: No requereix de tasques de neteja aquesta variable.
dadesPersones.Descripcio_lloc_atropellament_vianant: No requereix de tasques de neteja aquesta variable. En tot cas, sí procedirem a la seva codificació binària (v. infra).
dadesPersones.Descripcio_Motiu_desplacament_conductor: Com ja hem exposat en l’apartat corresponent (v. supra), aquesta variable procedirem a la seva codificació binària (v. infra). En tot cas, procedim a descartar les observacions amb valor “Es desconeix”:
maskEsDesconegut <- dadesConductors$Descripcio_Motiu_desplacament_conductor == "Es desconeix"
esMotiuDesconegut <- dadesConductors[maskEsDesconegut, ]
nMotiuDesconegut <- nrow(esMotiuDesconegut)
dadesConductors_clean <- dadesConductors[!maskEsDesconegut, ]
print(glue("Es descarten {nMotiuDesconegut} conductors de qui és desconeix per quin motiu es desplaçaven."))## Es descarten 2642 conductors de qui és desconeix per quin motiu es desplaçaven.- dadesPersones.Edat: És necessari descartar també aquelles observacions de qui no consti informació sobre la seva edat:
maskDesconegutEdatConductors <- dadesConductors_clean$Edat == "Desconegut"
dadesPersonesEdatConeguda <- dadesPersones[maskDesconegutEdat == FALSE, ]
dadesPersonesEdatConeguda$Edat <- as.integer(dadesPersonesEdatConeguda$Edat)
nPersones_clean <- nrow(dadesConductors_clean)
print(glue("Després de descartar les observacions amb valors nuls es disposen de dades de
{nPersones_clean} persones."))## Després de descartar les observacions amb valors nuls es disposen de dades de
## 3386 persones.- dadesPersones.Desc_Tipus_vehicle_implicat: Trobem oportú descartar els registres corresponents a una de les categories atès que restaria fora de l’objecte d’aquest estudi, que ens centrem en el conductors de vehicles que, normalment, circularien per la calçada. Per tant, la categoria Tren o tramvia no sembla coherent amb aquest criteri. També requerirà de l’estandarització de la més de la desena de grups diferents a només quatre, tot seguint de forma aproximada aquesta classificació de la Dirección General de Tráfico espanyola en funció del tipus de permís i agrupant-los també en funció de si té un caràcter nítidament professional i si són vehicles de dues o quatre rodes: “Vehicles d’ús professional” (VUP) com serien autobusos, taxis o ambulàncies; “Vehicles motoritzats de 4 rodes” (VM4R) com serien turismes o furgonetes i “Vehicles motoritzats de 2 rodes” (VM2R) com ciclomotors i motocicletes, atès que ambdós grups requereixen d’un permís per la seva conducció per la via pública; i un quart grup de “Vehicles sense permís de conducció” que abarcaria bicicletes i tota la resta de vehicles generalment no motoritzats que no requereixen de cap per,ís de conducció, tor codificant-ho en base a aquesta solució del site StackOverflow:
dadesConductors_clean["Tipus_vehicle_estandaritzat"] <- "Vehicles sense permís de conducció"
vehiclesUsProfessional <- c("Camió rígid <= 3,5 tones", "Camió rígid > 3,5 tones", "Tren o tramvia",
"Tractor camió", "Maquinària d'obres i serveis", "Ambulància",
"Autobús articulat", "Autobús", "Taxi")
maskVUP <- dadesConductors_clean$Desc_Tipus_vehicle_implicat %in% vehiclesUsProfessional
dadesConductors_clean$Tipus_vehicle_estandaritzat[maskVUP] = "Vehicles d'Ús Professional"
vehiclesM4R <- c("Furgoneta", "Turisme", "Quadricicle < 75 cc",
"Quadricicle > 75 cc", "Tot terreny")
maskVM4R <- dadesConductors_clean$Desc_Tipus_vehicle_implicat %in% vehiclesM4R
dadesConductors_clean$Tipus_vehicle_estandaritzat[maskVM4R] = "Vehicles motoritzats de quatre rodes"
vehiclesM2R <- c("Motocicleta", "Ciclomotor")
maskVM2R <- dadesConductors_clean$Desc_Tipus_vehicle_implicat %in% vehiclesM2R
dadesConductors_clean$Tipus_vehicle_estandaritzat[maskVM2R] <- "Vehicles motoritzats de 2 rodes"- dadesPersones.Descripcio_victimitzacio: En aquest cas apreciem que és oportú realitzar-ne la seva estandarització fent ús del mètode strsplit() tal i com es suggereix en aquesta solució del site StackOverflow:
dadesConductors_clean["Victimitzacio_est"] <- ""
dadesConductors_clean["Victimitzacio_est"]<- sapply(strsplit(dadesConductors_clean$Descripcio_victimitzacio,
":"), "[", 1)
maskMorts <- grepl("Mort", dadesConductors_clean$Descripcio_victimitzacio)
dadesConductors_clean$Victimitzacio_est[maskMorts] <- "Mort"
colsConductors <- c("Numero_expedient", "Descripcio_sexe", "Edat",
"Descripció_tipus_persona", "Descripcio_Lloc_atropellament_vianant",
"Descripcio_Motiu_desplacament_conductor", "Desc_Tipus_vehicle_implicat",
"Tipus_vehicle_estandaritzat", "Descripcio_victimitzacio", "Victimitzacio_est")
dadesConductors_clean <- dadesConductors_clean[colsConductors]dadesCauses.Descripcio_causa_mediata: Tal i com hem observat en l’apartat anterior (v. supra), optem per descartar aquesta variable.
dadesManiobra.Descripcio_causa_mediata: En aquest cas, cal descartar aquelles observacions que contenen valors categòrics que no aporten valor analític (v. supra) i també descartaremem aquelles observacions duplicades en el seu número d’expedient per, posteriorment, fer l’operació de combinació amb la resta de taules:
causesNoValor <- c("No determinada", "Desconegut", "Altres")
maskCausesNoValor <- dadesManiobra$Descripcio_causa_mediata %in% causesNoValor
dadesManiobra_clean <- dadesManiobra[!maskCausesNoValor, ]
maskDuplicatsManiobra <- duplicated(dadesManiobra_clean$Numero_expedient)
dadesManiobra_clean <- dadesManiobra_clean[!maskDuplicatsManiobra, ]
colsManiobra <- c("Numero_expedient", "Descripcio_causa_mediata")
dadesManiobra_clean <- dadesManiobra_clean[colsManiobra]- dadesVehicles.Antiguitat_carnet: Aquesta serà l’única variable de la que se’n podrà extreure valor atès que, mitjançant una agregació sobre l’atribut del número d’expedient, es pot cercar el valor mínim i crear una variable categòrica binària per comprovar si hi va intervenir un conductor novell que, en aquest estudi, el definirem com aquell amb menys de 5 anys sencers d’antiguitat del seu permís de conducció, tot suprimint les files amb valors nuls amb el mètode drop_na() descrit en la documentació oficial:
aggAntiguitat <- aggregate(dadesVehicles$Antiguitat_carnet,
by=dadesVehicles["Numero_expedient"], FUN=min)
aggAntiguitat <- drop_na(aggAntiguitat)
colnames(aggAntiguitat) <- c("Numero_expedient", "Antiguitat_carnet_min")- dadesVehicles.Descripcio_tipus_vehicle: En relaitzem la seva estandarització per, posteriorment, fer-ne el seu agrupament:
dadesVehicles["Tipus_vehicle_estandaritzat"] <- "Vehicles sense permís de conducció implicats"
dadesVehicles$Tipus_vehicle_estandaritzat[maskVUP] = "Vehicles d'Ús Professional implicats"
dadesVehicles$Tipus_vehicle_estandaritzat[maskVM4R] = "Vehicles motoritzats de quatre rodes implicats"
dadesVehicles$Tipus_vehicle_estandaritzat[maskVM2R] <- "Vehicles motoritzats de 2 rodes implicats"
xx__ <- dadesVehicles %>% count(Numero_expedient, Tipus_vehicle_estandaritzat)
groupbyTipusVehicle_ <- pivot_wider(xx__, names_from = c('Tipus_vehicle_estandaritzat'), values_from = 'n')
groupbyTipusVehicle_ <- groupbyTipusVehicle_ %>%
mutate(across(everything(), replace_na, 0))dadesAccidents.Numero_morts: No requereix de cap tasca de neteja..
dadesAccidents.Numero_lesionats_lleus: No requereix de cap tasca de neteja.
dadesAccidents.Numero_lesionats_greus: No requereix de cap tasca de neteja.
dadesAccidents.Numero_victimes: Descartarem aquelles observacions amb zero víctimes, atès que aquests accidents de trànsit no són d’interès per aquest estudi concret:
maskPlusZeroVictimes <- dadesAccidents$Numero_victimes > 0
dadesAccidents_clean <- dadesAccidents[maskPlusZeroVictimes, ]
colsAccidents <- c("Numero_expedient", "Codi_districte", "Nom_districte", "Codi_barri", "Nom_barri",
"Codi_carrer", "Nom_carrer", "Num_postal.", "Descripcio_dia_setmana", "NK_Any", "Mes_any",
"Nom_mes", "Dia_mes", "Hora_dia", "Descripcio_torn", "Numero_morts",
"Numero_lesionats_lleus", "Numero_lesionats_greus", "Numero_victimes",
"Numero_vehicles_implicats")
dadesAccidents_clean <- dadesAccidents_clean[colsAccidents]- dadesAccidents.Numero_vehicles_implicats: No requereix de cap tasca de neteja.
4 Construcció del conjunt de dades final
En primer lloc, realitzarem les operacions de combinació seguint aquest exemple del site StackOverflow, to comprovant que no s’hagin generat valors nuls:
dades <- merge(x=dadesConductors_clean, y=dadesAccidents_clean, by="Numero_expedient")
dades <- merge(x=dades, y=dadesManiobra_clean, by="Numero_expedient")
dades <- merge(x=dades, y=aggAntiguitat, by="Numero_expedient")
dades <- merge(x=dades, y=groupbyTipusVehicle_, by="Numero_expedient")
print('NA:')## [1] "NA:"colSums(is.na(dades))## Numero_expedient
## 0
## Descripcio_sexe
## 0
## Edat
## 0
## Descripció_tipus_persona
## 0
## Descripcio_Lloc_atropellament_vianant
## 0
## Descripcio_Motiu_desplacament_conductor
## 0
## Desc_Tipus_vehicle_implicat
## 0
## Tipus_vehicle_estandaritzat
## 0
## Descripcio_victimitzacio
## 0
## Victimitzacio_est
## 0
## Codi_districte
## 0
## Nom_districte
## 0
## Codi_barri
## 0
## Nom_barri
## 0
## Codi_carrer
## 0
## Nom_carrer
## 0
## Num_postal.
## 0
## Descripcio_dia_setmana
## 0
## NK_Any
## 0
## Mes_any
## 0
## Nom_mes
## 0
## Dia_mes
## 0
## Hora_dia
## 0
## Descripcio_torn
## 0
## Numero_morts
## 0
## Numero_lesionats_lleus
## 0
## Numero_lesionats_greus
## 0
## Numero_victimes
## 0
## Numero_vehicles_implicats
## 0
## Descripcio_causa_mediata
## 0
## Antiguitat_carnet_min
## 0
## Vehicles motoritzats de 2 rodes implicats
## 0
## Vehicles motoritzats de quatre rodes implicats
## 0
## Vehicles sense permís de conducció implicats
## 0
## Vehicles d'Ús Professional implicats
## 0print('Blancs:')## [1] "Blancs:"colSums(dades=="")## Numero_expedient
## 0
## Descripcio_sexe
## 0
## Edat
## 0
## Descripció_tipus_persona
## 0
## Descripcio_Lloc_atropellament_vianant
## 0
## Descripcio_Motiu_desplacament_conductor
## 0
## Desc_Tipus_vehicle_implicat
## 0
## Tipus_vehicle_estandaritzat
## 0
## Descripcio_victimitzacio
## 0
## Victimitzacio_est
## 0
## Codi_districte
## 0
## Nom_districte
## 0
## Codi_barri
## 0
## Nom_barri
## 0
## Codi_carrer
## 0
## Nom_carrer
## 0
## Num_postal.
## 2
## Descripcio_dia_setmana
## 0
## NK_Any
## 0
## Mes_any
## 0
## Nom_mes
## 0
## Dia_mes
## 0
## Hora_dia
## 0
## Descripcio_torn
## 0
## Numero_morts
## 0
## Numero_lesionats_lleus
## 0
## Numero_lesionats_greus
## 0
## Numero_victimes
## 0
## Numero_vehicles_implicats
## 0
## Descripcio_causa_mediata
## 0
## Antiguitat_carnet_min
## 0
## Vehicles motoritzats de 2 rodes implicats
## 0
## Vehicles motoritzats de quatre rodes implicats
## 0
## Vehicles sense permís de conducció implicats
## 0
## Vehicles d'Ús Professional implicats
## 0nAccidents <- length(unique(dades$Numero_expedient))
print(glue("\n\nDesprés de les tasques de neteja, disposem de {nrow(dades)} observacions de
{nAccidents} accidents de trànsit diferents per bastir el model."))##
## Després de les tasques de neteja, disposem de 2858 observacions de
## 2594 accidents de trànsit diferents per bastir el model.També procedirem, abans d’emprendre les següents fases de preprocessament de les dades, la comprovació de quina és la distribució territorial d’aquest mostreig:
ggplot(data=dadesAccidents, aes(Nom_districte)) +
geom_histogram(stat="count",
fill = "lightblue", color = "black") +
ggtitle(glue("Fig. 15.1. Accidents amb intervenció de Guàrdia Urbana per Districtes
(abans de la neteja de dades).")) +
xlab("Districtes") +
ylab("Nombre d'accidents") + scale_x_discrete(limits = level_districtes) +
theme(axis.text.x = element_text(angle = 290, vjust = 0.6, hjust = 0.1))
ggplot(data=dades, aes(Nom_districte)) +
geom_histogram(stat="count",
fill = "steelblue", color = "black") +
ggtitle(glue("Fig. 15.2. Accidents amb intervenció de Guàrdia Urbana per Districtes
(després de la neteja de les dades).")) +
xlab("Districtes") +
ylab("Nombre d'accidents") + scale_x_discrete(limits = level_districtes) +
theme(axis.text.x = element_text(angle = 290, vjust = 0.6, hjust = 0.1))
Es pot apreciar que en, al menys en aquesta característica, no s’aprecien grans canvis en la distribució territorial abans i després de la neteja de les dades, sent en el districte de Ciutat Vella on s’aprecia visualment la diferència més gran.
4.1 Codificació
- dades.Es_laborable: Cercarem identificar els dies laborables de l’any 2023 tot comptant amb el calendari laboral de Barcelona (SEGURA, 2023) mitjançant dues sucessives iteracions imputar el valor negatiu tants pels festius com pels caps de setmana:
festius <- data.frame(dia = c(6, 7, 10, 1, 13, 11, 12, 1, 6, 8, 25, 26),
mes = c(1, 4, 4, 5, 8, 9, 10, 11, 12, 12, 12, 12))
capsDeSetmana <- c("Dissabte", "Diumenge")
dades["Es_laborable"] <- "Si"
for (i in seq(1, nrow(festius), 1)){
data <- festius[i, ]
mask <- dades$Mes_any == data$mes & dades$Dia_mes == data$dia
dades$Es_laborable[mask] <- "No"
}
for (i in seq(1, length(capsDeSetmana), 1)){
data <- capsDeSetmana[i]
mask <- dades$Descripcio_dia_setmana == data
dades$Es_laborable[mask] <- "No"
}
aggEs_laborable <- aggregate(dades$Numero_expedient,
by=dades["Es_laborable"], FUN=length)
ggplot(aggEs_laborable, aes(x="", y=x, fill=Es_laborable)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(glue("Fig. 16. Diagrama de barres apilades del recompte dels
conductors en funció de si era o no laborable el dia de l'accident.")) +
xlab(glue("Es_laborable")) +
ylab("Nombre")
nNo_Es_laborable <- aggEs_laborable[1, 2]
nSi_Es_laborable <- aggEs_laborable[2, 2]
print(glue("Del conjunt de conductors a estudiar, {nSi_Es_laborable} van tenir l'accident
en un dia laborable i altres {nNo_Es_laborable} no."))## Del conjunt de conductors a estudiar, 2160 van tenir l'accident
## en un dia laborable i altres 698 no.- dades.Es_mon_treball: procedim a la codificació de la variable objerctiu d’aquest estudi a partir de la variable “Descripcio_Motiu_desplacament_conductor”
dades["Es_mon_treball"] <- "Si"
motiusNoMonTreball <- c("Altres activitats", "Oci i entreteniment",
"Anada/tornada de ponts, festius, vacances",
"Estudiant cap a centre d'estudis", "En pràctiques d'autoescola",
"Activitat esportiva particular")
maskMotiusNoMonTreball <- dades$Descripcio_Motiu_desplacament_conductor %in% motiusNoMonTreball
dades$Es_mon_treball[maskMotiusNoMonTreball] <- "No"
aggEs_mon_treball <- aggregate(dades$Numero_expedient,
by=dades["Es_mon_treball"], FUN=length)
ggplot(aggEs_mon_treball, aes(x="", y=x, fill=Es_mon_treball)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(glue("Fig. 17. Diagrama de barres apilades del recompte dels
conductors en funció de si el motiu del seu desplaçament tenia
relació amb el món del treball.")) +
xlab(glue("Es_mon_treball")) +
ylab("Nombre")
nNo_Es_mon_treball <- aggEs_mon_treball[1, 2]
nSi_Es_mon_treball <- aggEs_mon_treball[2, 2]
print(glue("Del conjunt de conductors a estudiar, {nSi_Es_mon_treball} es desplaçaven per algun motiu
relacionat amb el món del treball i altres {nNo_Es_mon_treball} no."))## Del conjunt de conductors a estudiar, 1330 es desplaçaven per algun motiu
## relacionat amb el món del treball i altres 1528 no.- dades.Es_atropellament: En aquest cas, imputarem la classe positiva per tots aquelles classes de la variable “Descripcio_Lloc_atropellament_vianant” que no siguin Desconegut:
dades["Es_atropellament"] <- "No"
unique(dades$Descripcio_Lloc_atropellament_vianant)## [1] "A la vorera / Andana "
## [2] "Desconegut "
## [3] "Altres "
## [4] "En zona peatonal "
## [5] "En pas regulat per semàfor "
## [6] "Fora del pas "
## [7] "En pas sense regular "maskLlocDesconegut <- grepl("Desconegut", dades$Descripcio_Lloc_atropellament_vianant)
dades$Es_atropellament[!maskLlocDesconegut] <- "Si"
aggEs_atropellament<- aggregate(dades$Numero_expedient,
by=dades["Es_atropellament"], FUN=length)
ggplot(aggEs_atropellament, aes(x="", y=x, fill=Es_atropellament)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(glue("Fig. 18. Diagrama de barres apilades del recompte dels
conductors en funció de si l'accident va ser o no un atropellament a
un vianant.")) +
xlab(glue("Es_atropellament")) +
ylab("Nombre")
nNo_Es_atropellament <- aggEs_atropellament[1, 2]
nSi_Es_atropellament <- aggEs_atropellament[2, 2]
print(glue("Del conjunt de conductors a estudiar, {nSi_Es_atropellament} van estar involucrats
en un atropellament i altres {nNo_Es_atropellament} no."))## Del conjunt de conductors a estudiar, 36 van estar involucrats
## en un atropellament i altres 2822 no.Constatem que la classe postiva és molt minoritària en aquest cas, fet lògic atès que la proporció d’accidents identificables com atropellaments ja era molt reduït (v. Figura 11.14, supra).
- dades.Edat_CODIF: Tal i com ja vam assenyalar, classificarem les observacions en funció del rang interquartils (IQR) del conjunt de dades original, tot constatant que no ha patit cap canvi després del procés de neteja de les dades:
iqr <- summary(dades$Edat)
cat("Rang interquartils:\n1r quartil: ", iqr[2], "\nMediana: ", iqr[3], "\n3r quartil: ", iqr[5])## Rang interquartils:
## 1r quartil: 29
## Mediana: 37
## 3r quartil: 49dades["Edat_CODIF"] <- "4. Conductors majors de 49 anys d'edat"
dades$Edat_CODIF[dades$Edat <= iqr[2]] <- "1. Conductors fins 29 anys d'edat"
dades$Edat_CODIF[dades$Edat > iqr[2] & dades$Edat <= iqr[3]] <- "2. Conductors d'entre 30 i 37 anys d'edat"
dades$Edat_CODIF[dades$Edat > iqr[3] & dades$Edat <= iqr[5]] <- "3. Conductors d'entre 38 i 49 anys d'edat"
aggEdat_CODIF <- aggregate(dades$Numero_expedient,
by=dades["Edat_CODIF"], FUN=length)
ggplot(aggEdat_CODIF, aes(x="", y=x, fill=Edat_CODIF)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(glue("Fig. 19. Diagrama de barres apilades del recompte dels
conductors en funció de la seva edat.")) +
xlab(glue("Edat_CODIF")) +
ylab("Nombre")
- dades.Interve_conductor_novell: També classificarem les observacions en una nova variable categòrica binària en funció de si en l’accident hi va haver-hi un conductor novell o no que, en el nostre cas, entenem que el seu permís de conduir té menys de 5 anys complets d’antiguitat:
dades["Interve_conductor_novell"] <- "No"
dades$Interve_conductor_novell[dades$Antiguitat_carnet_min < 5] <- "Si"
aggInterve_conductor_novell <- aggregate(dades$Numero_expedient,
by=dades["Interve_conductor_novell"], FUN=length)
ggplot(aggInterve_conductor_novell, aes(x="", y=x, fill=Interve_conductor_novell)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(glue("Fig. 20. Diagrama de barres apilades del recompte dels
conductors en funció de si en l'accident hi va intervenir-hi un conductor novell.")) +
xlab(glue("Interve_conductor_novell")) +
ylab("Nombre")
nNo_Interve_conductor_novell <- aggInterve_conductor_novell[1, 2]
nSi_Interve_conductor_novell <- aggInterve_conductor_novell[2, 2]
print(glue("Del conjunt de conductors a estudiar, {nSi_Interve_conductor_novell} van estar involucrats
en un accident amb al menys un conductor novell i altres {nNo_Interve_conductor_novell} no."))## Del conjunt de conductors a estudiar, 850 van estar involucrats
## en un accident amb al menys un conductor novell i altres 2008 no.- dades.Lleus_CODIF, dades.Greus_CODIF, dades.Morts_CODIF, dades.Victimes_CODIF, dades.Vehicles_CODIF: També codificarem les variables “Numero_lesionats_lleus”, “Numero_lesionats_greus”, “Numero_morts”, “Numero_victimes” i “Numero_vehicles_implicats” respectivament. Pel cas dels morts i ferits greus, comptabilitzarem si en va haver-hi 1 o més mentre que per la resta de variables comptabilitzarem si va haver-hi més de 2. a fi d’estalviar codi repetitiu, generarem les cinc noves variables mitjançant una iteració:
vars <- cols <- data.frame(b = c("Numero_lesionats_lleus", "Numero_lesionats_greus",
"Numero_morts", "Numero_victimes",
"Numero_vehicles_implicats"),
names = c("Conductors en accidents amb un o més lesionats lleus",
"Conductors en accidents amb un o més lesionats greus",
"Conductors en accidents amb un o més morts",
"Conductors en accidents amb una o més víctimes",
"Conductors en accidents amb més d'un vehicle implicat"),
type = c("lesionats lleus", "lesionats greus", "morts",
"víctimes de tots els tipus", "vehicles"),
mask = c(0, 0, 0, 1, 1),
new_vars = c("Lleus_CODIF", "Greus_CODIF", "Morts_CODIF", "Victimes_CODIF",
"Vehicles_CODIF"))
dades["Lleus_CODIF"] <- "No"
dades["Greus_CODIF"] <- "No"
dades["Morts_CODIF"] <- "No"
dades["Victimes_CODIF"] <- "No"
dades["Vehicles_CODIF"] <- "No"
for (i in seq(1, nrow(cols), 1)){
col <- vars[i, 1]
new_col <- vars[i, 5]
label <- vars[i, 2]
t <- vars[i, 3]
string <- glue("Fig. 21.{i}. Diagrama de barres apilades del recompte dels
conductors en funció del nombre de {t} en l'accident.")
mask <- dades[col] > vars[i, 4]
dades[mask, new_col] <- "Si"
agg <- aggregate(dades$Numero_expedient,
by=dades[new_col], FUN=length)
colnames(agg) <- c("Variable", "x")
print(ggplot(agg, aes(x="", y=x, fill=Variable)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(string) +
xlab(glue("{label}")) +
ylab("Nombre"))
}
- dades.Amb_vehicle_2_rodes, dades.Amb_vehicle_4_rodes, dades.Amb_vehicle_professional, dades.Amb_vehicle_no_permis: Procedim també acodificar les quatres¡ noves variables numèri
dades["VM2R_CODIF"] <- "No"
dades["VM4R_CODIF"] <- "No"
dades["V_no_permis_CODIF"] <- "No"
dades["VUP_CODIF"] <- "No"
varsVehicles <- data.frame(b = c("Vehicles motoritzats de 2 rodes implicats",
"Vehicles motoritzats de quatre rodes implicats",
"Vehicles sense permís de conducció implicats",
"Vehicles d'Ús Professional implicats"),
new_vars = c("VM2R_CODIF", "VM4R_CODIF", "V_no_permis_CODIF", "VUP_CODIF"))
for (i in seq(1, nrow(varsVehicles), 1)){
col <- varsVehicles[i, 1]
new_col <- varsVehicles[i, 2]
label <- varsVehicles[i, 1]
t <- varsVehicles[i, 1]
string <- glue("Fig. 22.{i}. Diagrama de barres apilades del recompte
dels conductors en funció del nombre de
{label} en l'accident.")
mask <- dades[col] > 0
dades[mask, new_col] <- "Si"
agg <- aggregate(dades$Numero_expedient,
by=dades[new_col], FUN=length)
colnames(agg) <- c("Variable", "x")
print(ggplot(agg, aes(x="", y=x, fill=Variable)) +
geom_bar(width = 1, stat = "identity", color = "black") +
ggtitle(string) +
xlab(glue("{label}")) +
ylab("Nombre"))
}
4.2 Discretització
Executarem la discretització de les dades categòriques mitjançant el mètode model.matrix() descrit en l’obra de Peter Bruce, Andrew Bruce i Peter Gedeck (BRUCE, BRUCE i GEDECK, 2022: 161) amb les variables “Tipus_vehicle_estandaritzat”, “Victimitzacio_estandaritzat”, “Descripcio_causa_mediata” i “Edat_CODIF”, tot convertint-les totes aquestes variables en un conjunt de variables binàries i tots ells compten amb quatre o més classes. Entenem que aquest tipus de discretització possibilita l’ús d’algorismes d’aprenentatge automàtic com KNN - K-Nearer Neighbours- (v. BRUCE, BRUCE i GEDECK, 236-237) Només en mostrarem dos exemples a continuació:
dummies_Vehicle_est <- model.matrix(~Tipus_vehicle_estandaritzat, data=dades)
head(dummies_Vehicle_est, 2)## (Intercept) Tipus_vehicle_estandaritzatVehicles motoritzats de 2 rodes
## 1 1 1
## 2 1 1
## Tipus_vehicle_estandaritzatVehicles motoritzats de quatre rodes
## 1 0
## 2 0
## Tipus_vehicle_estandaritzatVehicles sense permís de conducció
## 1 0
## 2 0dummies_Victimitzacio_est <- model.matrix(~Victimitzacio_est, data=dades)
head(dummies_Victimitzacio_est, 2)## (Intercept) Victimitzacio_estFerit lleu Victimitzacio_estMort
## 1 1 1 0
## 2 1 1 05 Procés de SVD
En primer lloc, crearem un nou data frame en R amb les 11 variables numèriques contínues que disposem:
cols_num <- c("Numero_morts", "Numero_victimes", "Numero_lesionats_greus",
"Numero_lesionats_lleus", "Numero_vehicles_implicats",
"Antiguitat_carnet_min", "Edat",
"Vehicles motoritzats de 2 rodes implicats",
"Vehicles motoritzats de quatre rodes implicats",
"Vehicles sense permís de conducció implicats",
"Vehicles d'Ús Professional implicats")
varsNum <- dades[cols_num]I, a continuació, realitzem la normalització d’aquestes dades mitjançant el mètode scale(), tot coneixent-lo després d’haver estudiat la documentació oficial i, tot seguint la proposta de Stats and R, en fem la representació gràfica de la seva correlació:
Xs = scale(varsNum, center=TRUE, scale=TRUE)
corrplot(cor(Xs), method = "number", type = "upper")
CS’observa que l’única correlació forta - quasi perfecta- observable és entre les variables “Numero_victimes” i “Numero_lesionats”, fet que no ens ha de sorprendre si es té en compte que “Numero_victimes” és una agregació del nombre total de víctimes en accident determinat i, tal i com ja es va observar en l’anterior apartat de l’Anàlisi exploratòria (v. supra), l’aclaparadora majoria - el 86.725 %- d’accidents de trànsit estudiats només van comptabilitzar ferits lleus i es va comprovar que en la majoria d’accidents van comptabilitzar al menys 1 ferit lleu (v. Figura 2.3).
A continuació executem l’Anàlisi de descomposició dels components principals (SVD) amb les set variables numèriques, cercant conèixer fins quantes variables són necessàries per explicar al menys el 75% de la covariància:
eigCXs = eigen(cor(Xs))
VALORS = eigCXs$values
e = 0.75
for(ncomp in 1:12){
if (sum(VALORS[1:ncomp]) / sum(VALORS) > e) {
break
}
}
# Calculem quin és percentatge de covariància que obtenim amb el nombre
# de valors que acompleixen la condició del 75%:
e_final <- sum(VALORS[1:ncomp]) / sum(VALORS)
print(glue("Per a retenir una variabilitat al menys del {e*100} %,
el mínim nombre de components necessari és de {ncomp}
i expliquen fins el {round(e_final*100, 3)} % de la variància inicial."))## Per a retenir una variabilitat al menys del 75 %,
## el mínim nombre de components necessari és de 6
## i expliquen fins el 77.471 % de la variància inicial.Aquest primer resultat ens indica que amb les 6 primeres components aportades que inclouen l’agregació “Numero_victimes” s’explicaria ja el 77.471 % de la covariància. Una pregunta que ens podem plantejar a continuació és repetir aquest exercici però eliminant aquesta avraiable:
cols_num_ <- c("Numero_morts", "Numero_lesionats_greus",
"Numero_lesionats_lleus", "Numero_vehicles_implicats",
"Antiguitat_carnet_min", "Edat",
"Vehicles motoritzats de 2 rodes implicats",
"Vehicles motoritzats de quatre rodes implicats",
"Vehicles sense permís de conducció implicats",
"Vehicles d'Ús Professional implicats")
varsNum_ <- dades[cols_num_]
Xs = scale(varsNum_, center=TRUE, scale=TRUE)
eigCXs = eigen(cor(Xs))
VALORS = eigCXs$values
e = 0.75
for(ncomp_ in 1:12){
if (sum(VALORS[1:ncomp_]) / sum(VALORS) > e) {
break
}
}
# Calculem quin és percentatge de covariància que obtenim amb el nombre
# de valors que acompleixen la condició del 75%:
e_final <- sum(VALORS[1:ncomp_]) / sum(VALORS)
print(glue("Per a retenir una variabilitat al menys del {e*100} %,
el mínim nombre de components necessari és de {ncomp_}
i expliquen fins el {round(e_final*100, 3)} % de la variància inicial."))## Per a retenir una variabilitat al menys del 75 %,
## el mínim nombre de components necessari és de 6
## i expliquen fins el 77.361 % de la variància inicial.En aquest cas, s’observa que igualment es continuen necessitant 6 variables però constatant que, molt possiblement, l’aportació de la variable “Numero_victimes” devia ser molt reduït atès que les 6 variables escollides expliquen el 77.361 % de la variància inicial.
Si modifiquem l’ordre en que es comptabilitzen les variables, calculant primer les variables “Antiguitat_carnet_min” i “Edat” comprovem:
cols_num_ <- c("Antiguitat_carnet_min", "Edat", "Numero_morts", "Numero_lesionats_greus",
"Numero_vehicles_implicats", "Vehicles motoritzats de 2 rodes implicats",
"Vehicles motoritzats de quatre rodes implicats",
"Vehicles sense permís de conducció implicats",
"Vehicles d'Ús Professional implicats")
varsNum_ <- dades[cols_num_]
Xs = scale(varsNum_, center=TRUE, scale=TRUE)
eigCXs = eigen(cor(Xs))
VALORS = eigCXs$values
e = 0.75
for(ncomp_ in 1:12){
if (sum(VALORS[1:ncomp_]) / sum(VALORS) > e) {
break
}
}
# Calculem quin és percentatge de covariància que obtenim amb el nombre
# de valors que acompleixen la condició del 75%:
e_final <- sum(VALORS[1:ncomp_]) / sum(VALORS)
print(glue("Per a retenir una variabilitat al menys del {e*100} %,
el mínim nombre de components necessari és de {ncomp_}
i expliquen fins el {round(e_final*100, 3)} % de la variància inicial."))## Per a retenir una variabilitat al menys del 75 %,
## el mínim nombre de components necessari és de 6
## i expliquen fins el 81.556 % de la variància inicial.I constatem una millora sensible del resultat, possiblement per l’aportació que en fa la variable “Antiguitat_carnet_min” amb “Edat”, que és de les correlacions més destacables, tot i que es pot considerar també feble i negativa i divergents entre sí.
I si modifiquem el topall al 85%:
e = 0.85
for(ncomp_ in 1:12){
if (sum(VALORS[1:ncomp_]) / sum(VALORS) > e) {
break
}
}
# Calculem quin és percentatge de covariància que obtenim amb el nombre
# de valors que acompleixen la condició del 75%:
e_final <- sum(VALORS[1:ncomp_]) / sum(VALORS)
print(glue("Per a retenir una variabilitat al menys del {e*100} %,
el mínim nombre de components necessari és de {ncomp_}
i expliquen fins el {round(e_final*100, 3)} % de la variància inicial."))## Per a retenir una variabilitat al menys del 85 %,
## el mínim nombre de components necessari és de 7
## i expliquen fins el 91.806 % de la variància inicial.S’observa una millora encara més gran, ja que s’incorpora auna variable addicional i que abarca ara la correlació, també de les més rellevants, entre el nombre de vehicles de 2 rodes implicats i el nombre de vehicles de 4 rodes implicats, exclosos d’aquest darrer grups els vehicles d’ús professional com serien transports de mercaderies o de passatgers.
6 Interpretació dels resultats
6.1 Taula de resultats
| Índex | Descripció de la mètrica | Mètrica |
|---|---|---|
| 1 | Nombre d’accidents | 7721 |
| 2 | Nombre d’accidents amb al menys un lesionat lleu | 6696 |
| 3 | Proporció (%) del nombre d’accidents amb al menys un lesionat lleu | 86.725 |
| 4 | Nombre d’accidents amb al menys una víctima | 6867 |
| 5 | Proporció (%) del nombre d’accidents amb al menys una víctima | 88.39 |
| 6 | Nombre d’accidents amb al menys un lesionat greu | 211 |
| 7 | Proporció (%) del nombre d’accidents amb al menys un lesionat greu | 2.733 |
| 8 | Nombre d’accidents amb al menys un mort | 21 |
| 9 | Proporció (%) del nombre d’accidents amb al menys un mort | 0.272 |
| 10 | Nombre de vehicles implicats en un accident | 14361 |
| 11 | Nombre de vehicles en els que es desconeixia l’antiguitat del permís de conducció del seu conductor | 2873 |
| 12 | Nombre de registres de conductors descartats per no ser considerats vàlids (errors o edat desconeguda) | 38 |
| 13 | Nombre de vianants implicats en un accident | 962 |
| 14 | Nombre de conductors implicats en un accident | 6028 |
| 15 | Nombre de passatgers implicats en un accident | 1750 |
| 16 | Edat mínima (anys sencers) d’una persona implicada en un accident | 0 |
| 17 | Primer quartil de l’edat de les persones implicades en un accident | 28 |
| 18 | Mediana de l’edat de les persones implicades en un accident | 37 |
| 19 | Mitjana de l’edat de les persones implicades en un accident | 39.1 |
| 20 | Tercer quartil de l’edat de les persones implicades en un accident | 49 |
| 21 | Edat màxima (anys sencers) d’una persona implicada en un accident | 89 |
| 22 | Nombre de conductors dels qui es va desconèixer el motiu per què es desplaçaven | 2642 |
| 23 | Nombre de conductors dels qui es sí va conèixer el motiu per què es desplaçaven | 3386 |
| 24 | Nombre de conductors en el conjunt de dades una vegada realitzada la seva neteja | 2858 |
| 25 | Nombre d’accidents en el conjunt de dades una vegada realitzada la seva neteja | 2594 |
| 26 | Primer quartil de l’edat de les persones implicades en un accident en el conjunt de dades final | 29 |
| 27 | Medianan de l’edat de les persones implicades en un accident en el conjunt de dades final | 37 |
| 28 | Tercer quartil de l’edat de les persones implicades en un accident en el conjunt de dades final | 49 |
| 29 | Nombre de conductors involucrats en un accident en el conjunt de dades final en dia laborable | 2160 |
| 30 | Nombre de conductors involucrats en un accident en el conjunt de dades final en dia no laborable | 698 |
| 31 | Nombre de conductors involucrats en un accident en el conjunt de dades final el qual va ser un atropellament | 36 |
| 32 | Nombre de conductors involucrats en un accident en el conjunt de dades final el qual no va ser un atropellament | 2822 |
| 33 | Nombre de conductors involucrats en un accident en el conjunt de dades final en el que es va veure involucrat un conductor novell (permís de conduir amb menys de 5 anys complets d’antiguitat) | 850 |
| 34 | Nombre de conductors involucrats en un accident en el conjunt de dades final en el que no es va veure involucrat un conductor novell (permís de conduir amb menys de 5 anys complets d’antiguitat) | 2008 |
| 35 | Nombre de conductors accidentats que es desplaçava per un motiu que estava relacionat amb el món del treball | 1330 |
| 36 | Nombre de conductors accidentats que es desplaçava per un motiu que no estava relacionat amb el món del treball | 1528 |
En el nostre anàlisi l’iniciarem proposant quin seria el perfil del conductor típic accidentat en Barcelona durant l’any 2023 i que, generalment per que s’havia requerit de la seva intervenció per que s’havia requerit d’un equip d’emergència sanitària. En aquest accident habitualment s’hi comptabilitzarien 1 persona lesionada lleu (v. Figura 2.3) i també 2 vehicles implicats (v. Figura 3) en el districte de l’Eixample (v. Figura 1); el més probable és que fos al menys una motocicleta algun dels vehicles implicats en el cas que un dels conductors hagi resultat ferit (v. Figura 12.7). Aquest conductor típic seria un home (v. Figura 12.3), d’entre 29 i 37 anys d’edat (v. Figura 11.2 i files 26-27 de la Taula de resultats) i amb 5 o més d’anys d’antiguitat del seu permís de conducció, requerint d’atenció sanitària contínua durant un periode inferior a les 24 hores immediatament posteriors a l’accident (v. Figura 12.6). Generalment, es desconeix el motiu del seu desplaçament (v. Figura 12.5). Cal observar que aquest perfil és coincident per l’any 2023 amb el corresponent perfil de persones mortes o amb lesions greus recopilat per l’Ajuntament de Barcelona, excepte en el fet que el grup d’edat predominant és entre els 45 i 54 anys d’edat (AJUNTAMENT DE BARCELONA, 2024).
Tenint en compte que l’objectiu d’aquest projecte és poder bastir un model predictiu que, precisament, pugui predir si aquest conductor típic que anteriorment descrivíem ho fa per un motiu relacionat amb el món del treball, es a dir, ja sigui desplaçant en l’anada o tornada o bé durant el transcurs del mateix, el fet que es desconegui el motiu del desplaçament de 2642 conductors (v. fila 21 de la Taula de resultats) implicats en aquests accidents de trànsit resultaria, després de fer-ne la seva neteja, un grup d’interès d’aplicació del mateix model analític. En aquest sentit, també cal observar que la variable d’interès plantejada resulta força equilibrada (v. files 35 i 36 de la Taula de resultats); la contradicció aparent amb el resultat de la codificació entre dates dels accidents en laborable o no laborable (v. Figura 15) es pot conciliar raonant que en festiu també es produeixen un nombre substancial de desplaçaments - i accidents- on un dels conductors es desplaçaria per un motiu relacionat amb el món del treball.
Finalment, sobre la rellevància de les variables predictores escollides o codificades, s’observa que mitjançant de l’anàlisi de descomposició del component principal que es podria prescindir de la variable referent al nombre de víctimes implicades en l’accident, fet per altra banda lògic si es té en compte que es tracta d’una agregació d’altres variables numèriques i també que la inmensa majoria d’accidents de trànsit amb intervenció de Guàrdia Urbana només van comptabilitzar ferits lleus; només el 2.733 % (fila 7 de la Taula de resultats) dels accidents van comptabilitzar algun ferit lleu i el 0.272 % (fila 9 de la Taula de resultats) del total un mort. En aquesta línia, també cal apuntar que s’han observat un nombre molt reduït de successos amb valors extrems relacionats amb el nombre total de víctimes o vehicles implicats (v. Figures 2.4 i 3). I, en relació amb l’edat dels conductors, s’ha observat un grup preponderant d’entre 30 i 39 anys d’edat que coincidir també amb el rang entre el primer quartil i la mediana de l’edat, a més que la majoria de conductors ferits són conductors de motocicletes. I caldrà també tenir en compte la interacció entre grups d’aquelles variables que descriuen el tipus de causa immediata dels accidents amb la seva distribució territorial; el fet que el districte de l’Eixample, que es caracteritza en la seva totalitat per vies que estan relacionats amb trajectes urbans i, també, que l’atravessin els dos eixos principals de circulació de la ciutat, com són el carrer Aragó i la Gran Via de les Corts Catalanes (AJUNTAMENT DE BARCELONA, 2024), podrien representar un biaix en el tipus de causes immediates dels accidents recopilades en els atestats preparats pels agents de la Guàrdia Urbana de Barcelona.
7 Bibliografia
AJUNTAMENT DE BARCELONA, 2024. Dades bàsiques de mobilitat. URL. Darrera consulta el 8-V-2024.
BRUCE, P.; BRUCE, A.; i GEDECK, P. 2022. Estadística práctica para ciencia de datos con R y Python, Barcelona: Marcombo (2022).
GIRONÉS ROIG, J. 2021. Gestió de característiques, Primera edició. Barcelona: Fundació Universitat Oberta de Catalunya (2021).
GUÀRDIA URBANA DE BARCELONA 2024a. “Accidents gestionats per la Guàrdia Urbana a la ciutat de Barcelona”, Open Data BCN. URL. Darrera consulta per l’1-V-2024.
GUÀRDIA URBANA DE BARCELONA 2024b. “Persones involucrades en accidents gestionats per la Guàrdia Urbana a la ciutat de Barcelona”, Open Data BCN. URL. Darrera consulta per l’1-V-2024.
GUÀRDIA URBANA DE BARCELONA 2024c. “Vehicles implicats en accidents gestionats per la Guàrdia Urbana a la ciutat de Barcelona”, Open Data BCN. URL. Darrera consulta per l’1-V-2024.
GUÀRDIA URBANA DE BARCELONA 2024d.”Accidents segons causa mediata gestionats per la Guàrdia Urbana a la ciutat de Barcelona”, Open Data BCN. URL. Darrera consulta pel 5-V-2024.
RAMÍREZ JÁVEGA, J.M. 2024. Entrevista oral amb l’agent de la Guàrdia Urbana de Barcelona número 26325, 30-IV-2024. Barcelona.
SALERNO, D. “Handle missing values in categorical features”, Analytics Vidhya, 17-XI-2020. URL. Darrera consulta pel 6-V-2024.
SEGURA, S. 2023. “Festius 2023 a Barcelona i Catalunya: aquest és el calendari laboral amb els ponts pendents de fer”, Betevé, 30-X-2023. URL. Darrera consulta pel 3-V-2024.