Analyse Personenschäden PW-Unfälle
Patrick Meier | Tamedia Datenteam
22. Januar 2022
library(sf)
library(leaflet)
library(tidyverse)WORKING_DIR <- "H:/Meine Ablage/Datenteam/Projekte/202109_Pounds"
setwd(WORKING_DIR)Daten
Quelle: Unfalldatenbank des Astra, Stand 2020. Diese Daten sind nicht öffentlich verfügbar, deshalb können wir hier die Rohdaten nicht verlinken.
Unfälle mit genau 2 beteiligten PWs wurden daraus herausgefiltert.
Das Gewicht ist erst seit 2018 erfasst. Entsprechend werden nur die Jahre 2018, 2019, 2020 betrachtet. Bei einigen Einträgen fehlt zudem das Gewicht, diese Fälle werden nicht berücksichtigt.
setwd(WORKING_DIR)
in_2PW <- read_csv("Data_input/suv_analyse_13.12.2021.csv")
in_unf <- read_csv("H:/Meine Ablage/Datenteam/Tools etc/Unfalldaten Astra/Data_output/Unfall_komplett.csv") %>%
filter(Jahr >= 2018)
in_obj <- read_csv("H:/Meine Ablage/Datenteam/Tools etc/Unfalldaten Astra/Data_output/Objekt_komplett.csv") %>%
filter(Jahr >= 2018)Wie viele Opfer in PWs?
in_obj %>% filter(Fahrzeugart == "|001 Personenwagen|") %>%
summarise(Getötet = sum(Getötete),
Schwerverletzte = sum(Schwerverletzte),
Lebensbedrohlich= sum(`lebensbedrohlich Verletzte`),
Erheblich = sum(`erheblich Verletzte`))## # A tibble: 1 x 4
## Getötet Schwerverletzte Lebensbedrohlich Erheblich
## <dbl> <dbl> <dbl> <dbl>
## 1 215 2114 129 1985So viele Unfälle zwischen genau 2 PWs gibt es:
in_2PW %>% group_by(Jahr) %>%
filter(w1_Fahrzeugart == "|001 Personenwagen|",
w2_Fahrzeugart == "|001 Personenwagen|") %>%
mutate(hat_schaden = if_else(schaden_sum != 0, 1, 0),
mit_schwerverletzten = if_else((w1_Getötete + w1_Schwerverletzte +
w2_Getötete + w2_Schwerverletzte) != 0, 1, 0)) %>%
summarise(anz = n(),
mit_schaden = sum(hat_schaden),
mit_schwerverletzten = sum(mit_schwerverletzten))## # A tibble: 3 x 4
## Jahr anz mit_schaden mit_schwerverletzten
## <dbl> <int> <dbl> <dbl>
## 1 2018 12865 3007 228
## 2 2019 12418 3018 185
## 3 2020 10155 2386 161Check Gewicht
Aber nicht bei allen ist das Gewicht bekannt.
So viele Unfälle zwischen 2 PWs mit bekanntem Gewicht:
in_2PW %>% group_by(Jahr) %>%
filter(w1_Fahrzeugart == "|001 Personenwagen|",
w2_Fahrzeugart == "|001 Personenwagen|") %>%
mutate(hat_schaden = if_else(schaden_sum != 0, 1, 0),
mit_schwerverletzten = if_else((w1_Getötete + w1_Schwerverletzte +
w2_Getötete + w2_Schwerverletzte) != 0, 1, 0)) %>%
filter(!is.na(gewicht_diff)) %>%
summarise(anz_mit_gew = n(),
mit_schaden = sum(hat_schaden),
mit_schwerverletzten = sum(mit_schwerverletzten))## # A tibble: 3 x 4
## Jahr anz_mit_gew mit_schaden mit_schwerverletzten
## <dbl> <int> <dbl> <dbl>
## 1 2018 7764 1849 156
## 2 2019 8154 2039 133
## 3 2020 7922 1858 124Analyse
Es werden von nun an nur Unfälle betrachtet bei denen mindestens eine Person schwer verletzt oder getötet wurde. Ansonsten wird das Resultate zu stark “verwässer”, da auch Parkschäden o.ä. enthalten sind, bei denen das Gewicht eine untergeordnete Rolle spielt. Das sind noch 412 Unfälle aus den Jahren 2018, 2019 und 2020.
df_regr <- in_2PW %>% select(-c(schaden_diff, gewicht_diff, gewicht_diff_abs)) %>%
filter(w1_Fahrzeugart == "|001 Personenwagen|",
w2_Fahrzeugart == "|001 Personenwagen|") %>%
mutate(w1_getUNDschwerverletzte = w1_Getötete + w1_Schwerverletzte,
w2_getUNDschwerverletzte = w2_Getötete + w2_Schwerverletzte) %>%
mutate(sum_getUNDschwerverletzte = w1_getUNDschwerverletzte + w2_getUNDschwerverletzte,
sum_gewicht = w1_Gesamtgewicht + w2_Gesamtgewicht,
diff_getUNDschwerverletzte = w2_getUNDschwerverletzte - w1_getUNDschwerverletzte,
diff_gewicht = w1_Gesamtgewicht - w2_Gesamtgewicht,
diff_leistung = w1_Leistung_in_KW - w2_Leistung_in_KW) %>%
mutate(lm_diff_getUNDschwerverletzte = if_else(diff_gewicht < 0, -diff_getUNDschwerverletzte, diff_getUNDschwerverletzte),
lm_diff_gewicht = if_else(diff_gewicht < 0, -diff_gewicht , diff_gewicht),
lm_leichter_gewicht = if_else(diff_gewicht < 0, w1_Gesamtgewicht, w2_Gesamtgewicht),
lm_schwerer_gewicht = if_else(diff_gewicht < 0, w2_Gesamtgewicht, w1_Gesamtgewicht),
lm_leichter_getUNDschwerverletzte = if_else(diff_gewicht < 0, w1_getUNDschwerverletzte, w2_getUNDschwerverletzte),
lm_schwerer_getUNDschwerverletzte = if_else(diff_gewicht < 0, w2_getUNDschwerverletzte, w1_getUNDschwerverletzte)) %>%
rowwise() %>%
mutate(lm_schwächer_leistung = min(w1_Leistung_in_KW, w2_Leistung_in_KW),
lm_stärker_leistung = max(w1_Leistung_in_KW, w2_Leistung_in_KW)) %>%
filter(!is.na(diff_gewicht)) %>%
filter(sum_getUNDschwerverletzte != 0) %>%
filter(diff_gewicht != 0) %>%
left_join(in_unf[, c("Unfall-UID", "Unfalltyp")], by = c("Unfall_UID" = "Unfall-UID"))Übersicht Unfälle nach Gewicht
Alle verunfallten Fahrzeuge nach Gewicht.
## Alle Fahrzeuge die beteiligt sind in eine spalte
df_ub1 <- df_regr %>% select(c(Jahr, Unfall_UID, lm_leichter_gewicht,
lm_leichter_getUNDschwerverletzte, diff_gewicht)) %>%
rename(c("getUNDschwerverletzte" = "lm_leichter_getUNDschwerverletzte",
"Gesamtgewicht" = "lm_leichter_gewicht")) %>%
mutate(kol_partner = "leichter",
diff_gewicht = abs(diff_gewicht))
df_ub2 <- df_regr %>% select(c(Jahr, Unfall_UID, lm_schwerer_gewicht,
lm_schwerer_getUNDschwerverletzte, diff_gewicht)) %>%
rename(c("getUNDschwerverletzte" = "lm_schwerer_getUNDschwerverletzte",
"Gesamtgewicht" = "lm_schwerer_gewicht")) %>%
mutate(kol_partner = "schwerer",
diff_gewicht = abs(diff_gewicht))
df_ub <- bind_rows(df_ub1, df_ub2) %>%
mutate(class = if_else(diff_gewicht > 500, "d_>500",
if_else(diff_gewicht > 100, "d_100-500",
if_else(diff_gewicht > 0, "d_0-100", "NA"))))
rm(df_ub1, df_ub2)
df_ub %>% ggplot(aes(x = Gesamtgewicht, y = getUNDschwerverletzte, color = kol_partner, group = kol_partner)) +
geom_jitter(height = 0.3) +
ggtitle("Alle an einem schweren Unfall beteiligten PWs",
subtitle = str_c(min(df_ub$Jahr), " bis ", max(df_ub$Jahr), ", ", dim(df_regr)[1], " schwere Unfälle")) +
xlab("Fahrzeuggewicht in kg") + ylab("Tote oder Schwervwerletzte im Fahrzeug") +
labs(color = "Kollisions-\npartner")
Tabelle nach Gewicht
dw_ratios <- df_ub %>%
group_by(kol_partner, class) %>% summarise(Anz = sum(getUNDschwerverletzte )) %>%
pivot_wider(id_cols = class, values_from = Anz, names_from = kol_partner) %>%
mutate(ratio = leichter / schwerer)
dw_ratios## # A tibble: 3 x 4
## class leichter schwerer ratio
## <chr> <dbl> <dbl> <dbl>
## 1 d_>500 131 44 2.98
## 2 d_0-100 48 42 1.14
## 3 d_100-500 149 91 1.64# dw_ratios %>% select(-ratio) %>% write_csv("Data_output/dw_ratios.csv")Regression
Es werden nur Unfälle berücksichtigt, bei denen es mindestens einen Schwerverletzten oder Toten gab.
Es wird untersucht, ob eine hohe Gewichtsdifferenz bei einem schweren Unfall zu mehr Verletzen im leichteren Fahrzeug führt.
df_regr %>% filter(diff_gewicht > 0) %>%
ggplot(aes(x = lm_diff_gewicht, y = lm_diff_getUNDschwerverletzte)) +
# geom_point() +
geom_jitter(width = 0, height = 0.2) +
geom_smooth(method = "lm") +
ggtitle("Mehr Verletzte im leichteren Fahrzeug",
subtitle = "Positive Differenz: Mehr Schwerverletzte im leichteren Fahrzeug") +
xlab("Gewichtsdifferenz Unfallpartner in kg") +
ylab("Differenz der Schwerverletzten")
fit2 <- df_regr %>% filter(diff_gewicht > 0) %>%
lm(lm_diff_getUNDschwerverletzte ~ lm_diff_gewicht, data = .)
summary(fit2)##
## Call:
## lm(formula = lm_diff_getUNDschwerverletzte ~ lm_diff_gewicht,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4182 -1.1558 0.4501 0.7002 1.8448
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.1393824 0.0707682 1.970 0.0496 *
## lm_diff_gewicht 0.0005280 0.0001273 4.148 4.09e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9099 on 410 degrees of freedom
## Multiple R-squared: 0.04027, Adjusted R-squared: 0.03793
## F-statistic: 17.2 on 1 and 410 DF, p-value: 4.088e-05Gibt es bei der Kollision von unterschiedlich schweren Fahrzeugen im leichteren Fahrzeug mehr verletzte? –> Dafür gibt es sehr starke Hinweise.
Nach Gewicht
Geographische Verortung
Unfälle zwischen 2 PWs mit mindestens einem schwerverletzten oder Toten sind abgebildet. Nur Unfälle mit mehr als 500kg Gewichtsdifferenz werden gezeigt.
Rot: Mehr Schwerverletze im leichten Wagen
Blau: Mehr Schwerverletze im schweren Wagen
(Tote werden ebenfalls berücksichtigt.)
## Nur mit mehr als 100
df_plot <- in_unf %>%
filter(`Unfall-UID` %in% c(df_regr$Unfall_UID)) %>%
left_join(df_regr[, c("Unfall_UID", "lm_leichter_gewicht", "lm_schwerer_gewicht", "lm_diff_gewicht",
"lm_leichter_getUNDschwerverletzte", "lm_schwerer_getUNDschwerverletzte",
"lm_diff_getUNDschwerverletzte")],
by = c("Unfall-UID" = "Unfall_UID")) %>%
st_as_sf(coords = c("Koordinate E", "Koordinate N"), crs = 2056) %>%
st_transform(4326) %>%
filter(lm_diff_gewicht >=100)
pal <- colorFactor(
palette = 'RdYlBu',
domain = -df_plot$lm_diff_getUNDschwerverletzte)
df_plot %>%
leaflet() %>% addTiles() %>%
addCircleMarkers(popup = ~str_c("Gewicht leichter: ", lm_leichter_gewicht, "kg", "<br>",
"Gewicht schwerer: ", lm_schwerer_gewicht, "kg", "<br>",
"Schwerverletzte leichter: ", lm_leichter_getUNDschwerverletzte, "<br>",
"Schwerverletzte schwerer: ", lm_schwerer_getUNDschwerverletzte, "<br>",
as.character(Datum), ", ", Unfallzeit, "<br>",
"Total Personen: ", `Total Personen`, "<br>",
"Unfall-ID: ", `Unfall-UID`),
radius = 7, opacity = 0.8, weight = 1, color = "black", fillOpacity = 0.6,
fillColor = ~pal(-lm_diff_getUNDschwerverletzte)) %>%
addLegend(pal = pal, values = ~-lm_diff_getUNDschwerverletzte, opacity = 1,
title = "Differenz Schwerverletzte")# df_plot %>% write_csv("liste_schwere_500kgDiff.csv")
# df_plot %>% write_csv("liste_schwere_allegDiff.csv")Fazit
Es zeigt sich, dass bei Kollisionen von unterschiedlich schweren Fahrzeugen es mehr Schwerverletzte im leichteren Fahrzeug gibt. Und zwar ca. 0.5 Verletzte mehr im leichten Fahrzeug pro Tonne Gewichtsdifferenz der Kollisioinspartner. Es gibt jedoch keinen Hinweis, dass die Gesamtanzahl der Schwerverletzten bei einem Unfall zunimmt mit der steigenden Gewichtsdifferenz oder dem steigendem Gesamtgewicht der am Unfall beteiligten Fahrzeuge. Es gibt also eine Verlagerung der Verletzten von den schweren zu den leichten Fahrzeugen.
Anhang
Mit wem kollidieren die leichten Autos?
X Achse: Gewicht des leichteren Autos
Y Achse: Differenz zum kollidierenden Auto
Farbe: Anzahl schwerverletzte im leichteren Auto
df_regr %>% ggplot(aes(x = lm_leichter_gewicht, y = lm_diff_gewicht)) +
geom_point(aes(colour = lm_leichter_getUNDschwerverletzte)) +
scale_colour_gradient(low = "yellow", high = "red", na.value = NA)
Gewichtsverteilung
Verteilung der Gewichte aller PWs
# colnames(in_obj)
in_obj %>% filter(Fahrzeugart == "|001 Personenwagen|") %>%
filter(Gesamtgewicht > 1000, Gesamtgewicht < 3100) %>%
ggplot(aes(x = Gesamtgewicht)) +
geom_histogram(bins = 20, closed = "left")
Verteilung der Gewichte aller PWs in Regression (also Schwere Unfälle zwischen zwei PWs)
# colnames(in_obj)
obj_sven <- in_obj %>% filter(`Unfall-UID` %in% df_regr$Unfall_UID)
obj_sven %>% filter(Fahrzeugart == "|001 Personenwagen|") %>%
filter(Gesamtgewicht > 1000, Gesamtgewicht < 3100) %>%
ggplot(aes(x = Gesamtgewicht)) +
geom_histogram(bins = 20, closed = "left")
Rgeression Absolutes Gewicht
Hat das absolute Gewicht (des leichteren Wagens) auch einen Einfluss?
–> Dafür gibt es keinen Hinweis.
fit5 <- df_regr %>%
lm(lm_diff_getUNDschwerverletzte ~ lm_diff_gewicht + lm_leichter_gewicht, data = .)
summary(fit5)##
## Call:
## lm(formula = lm_diff_getUNDschwerverletzte ~ lm_diff_gewicht +
## lm_leichter_gewicht, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4153 -1.1591 0.4550 0.7017 1.8336
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.951e-02 3.102e-01 0.256 0.798
## lm_diff_gewicht 5.368e-04 1.350e-04 3.977 8.25e-05 ***
## lm_leichter_gewicht 3.339e-05 1.685e-04 0.198 0.843
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9109 on 409 degrees of freedom
## Multiple R-squared: 0.04036, Adjusted R-squared: 0.03567
## F-statistic: 8.6 on 2 and 409 DF, p-value: 0.0002194Rgeression Sum Verletzte / Diff Gewicht
Gibt es bei Kollisionen von unterschiedlich schweren Fahrzeugen allgemein mehr Verletzte?
–> Dafür gibt es keinen Hinweis.
df_regr %>%
ggplot(aes(x = lm_diff_gewicht, y = sum_getUNDschwerverletzte)) +
# geom_point() +
geom_jitter(width = 0, height = 0.2) +
geom_smooth(method = "lm")
fit3 <- df_regr %>%
lm(sum_getUNDschwerverletzte ~ lm_diff_gewicht, data = .)
summary(fit3)##
## Call:
## lm(formula = sum_getUNDschwerverletzte ~ lm_diff_gewicht, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.2450 -0.2366 -0.2241 -0.2017 4.7958
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.245e+00 4.445e-02 28.021 <2e-16 ***
## lm_diff_gewicht -4.595e-05 7.996e-05 -0.575 0.566
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5715 on 410 degrees of freedom
## Multiple R-squared: 0.0008049, Adjusted R-squared: -0.001632
## F-statistic: 0.3303 on 1 and 410 DF, p-value: 0.5658Rgeression Sum Verletzte / Sum Gewicht
Gibt es bei der Kollision von schwereren Fahrzeugen mehr Verletzte?
–> Dafür gibt es keinen Hinweis.
df_regr %>%
ggplot(aes(x = sum_gewicht, y = sum_getUNDschwerverletzte)) +
# geom_point() +
geom_jitter(width = 0, height = 0.2) +
geom_smooth(method = "lm")
fit4 <- df_regr %>%
lm(sum_getUNDschwerverletzte ~ sum_gewicht, data = .)
summary(fit4)##
## Call:
## lm(formula = sum_getUNDschwerverletzte ~ sum_gewicht, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.2422 -0.2291 -0.2248 -0.2173 4.7680
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.267e+00 1.932e-01 6.558 1.64e-10 ***
## sum_gewicht -1.097e-05 5.045e-05 -0.218 0.828
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5717 on 410 degrees of freedom
## Multiple R-squared: 0.0001154, Adjusted R-squared: -0.002323
## F-statistic: 0.04731 on 1 and 410 DF, p-value: 0.8279