Dateien nach "/" hochladen

This commit is contained in:
Walter Hupfeld 2024-09-27 14:13:23 +02:00
parent 9a4770360c
commit 90d246ef05
2 changed files with 1400 additions and 0 deletions

View File

@ -0,0 +1,294 @@
---
title: "Auswertung OpenBikeSensor"
author: "Walter Hupfeld, ADFC Hamm"
date: "`r Sys.Date()`"
output: word_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning=FALSE)
library(xtable)
library(knitr)
```
```{r}
data <- read.csv2("obs/data-1726399614864.csv",sep=",")
df=data.frame(data)
df$distance_overtaker <- as.numeric(df$distance_overtaker)
df <- subset(df,df$distance_overtaker>0.30)
# Differnzierung nach außerorts und innerorts
overtaker <- df$distance_overtaker
overtaker_urban <- df$distance_overtaker[df$zone=="urban"]
overtaker_rural <- df$distance_overtaker[df$zone=="rural"]
summe <- length(overtaker)
mean <- round(mean(overtaker,na.rm=TRUE),2)
summe_urban <- length(overtaker_urban)
mean_urban <- round(mean(overtaker_urban,na.rm=TRUE),2)
under_urban <- length(overtaker_urban[overtaker_urban<1.5])
summe_rural <- length(overtaker_rural)
mean_rural <- round(mean(overtaker_rural,na.rm=TRUE),2)
under_rural <- length(overtaker_rural[overtaker_rural<2])
werte <- seq(0, 3, by = 0.1)
farben15 <- ifelse(werte < 1.5, "darkred", "darkgreen")
farben20 <- ifelse(werte < 2, "darkred", "darkgreen")
```
Ausgewertet wurden insgesamt `r summe` Überholvorgänge mit einem Mittelwert von `r mean`. Innerhalb geschlossener Ortschaften wurden `r summe_urban` Überholvorgänge erfasst (Mittelwert `r mean_urban`). Außerhalb geschlossener Ortschaften waren es `r summe_rural` bei einem Mittelwert von `r mean_rural`.
Der Datenexport erfolgte direkt aus der Datenbank des OBS-Portals [obs.adfc-hamm.de](https://obs.adfc-hamm.de) mit folgendem SQL-Statement:
```
select o.id,o.way_id,o.distance_overtaker,distance_stationary,
o.direction_reversed,o.speed,o.time,r.name,r.zone
from overtaking_event o, road r
where o.way_id=r.way_id;
```
### Übersichtstabelle
| Bereich | Gesamt | Mittelwert | Unterschreitungen | Anteil |
|---------------|---------------|:-------------:|:-------------:|:-------------:|
| Gesamt | `r summe` | `r mean` | | |
| Innerorts | `r summe_urban` | `r mean_urban` | `r under_urban` | `r round(under_urban/summe_urban*100,0)` % |
| Außerorts | `r summe_rural` | `r mean_rural` | `r under_rural` | `r round(under_rural/summe_rural*100,0)` % |
### Verteilung der Überholvorgänge innerhalb geschlossener Ortschaften
```{r}
hist(overtaker_urban, breaks = werte,
col = farben15, border = "grey",
main = "Verteilung der Überholvorgänge innerorts",
xlab = "Überholabstand in m", ylab = "Anzahl")
```
### Verteilung der Überholvorgänge außerhalb geschlossener Ortschaften
```{r}
hist(overtaker_rural, breaks = werte,
col = farben20, border = "grey",
main = "Verteilung der Überholvorgänge außerorts",
xlab = "Überholabstand in m", ylab = "Anzahl")
```
### Verteilung insgesamt
```{r}
hist15 <- hist(overtaker_urban, breaks = werte, plot=FALSE)
hist20 <- hist(overtaker_rural, breaks = werte, plot=FALSE)
counts <- rbind(hist15$counts, hist20$counts)
barplot(counts, beside = TRUE, col = c("violet", "blue"),
legend.text = c("Abstände innerorts", "Abstände außerorts"),
args.legend = list(x = "topright"),
main = "Überholabstände von Fahrrädern",
xlab = "Abstand in m", ylab = "Anzahl", names.arg = hist15$mids)
```
## Ausgewählte Straßen
### Lange Straße
Die Lange Straße ist Bestandteil der geplanten Radhauptroute nach Herringen. Zwischen
Wilhelmstraße und Radbodstraße gilt hier Tempo 30, ab Radbodstraße bis Bonifatiusweg Tempo 50.
```{r Strasse}
strasse <- "Lange Strasse"
df_strasse = subset(df,df$name=="Lange Straße")
distance_street <- as.numeric(df_strasse$distance_overtaker,na.rm=TRUE)
speed_street <- as.numeric(df_strasse$speed,na.rm=TRUE)
speed_street <- speed_street * 3.6
# Histogramm
hist(distance_street, breaks = werte,
col = farben15, border = "grey",
main = "Verteilung der Überholvorgänge außerorts",
xlab = "Überholabstand in m", ylab = "Anzahl")
# Erstelle ein Streudiagramm
plot(speed_street, distance_street,
xlab = "Geschwindigkeit (km/h)",
ylab = "Abstand (m)",
main = "Punktwolke: Geschwindigkeit vs. Abstand",
pch = 19, # Punkteform (z.B. 19 = gefüllte Kreise)
col = "blue") # Farbe der Punkte
```
### Römerstraße
```{r Strasse2}
strasse <- "Römerstraße"
df_strasse = subset(df,df$name==strasse)
distance_street <- as.numeric(df_strasse$distance_overtaker,na.rm=TRUE)
speed_street <- as.numeric(df_strasse$speed,na.rm=TRUE)
speed_street <- speed_street * 3.6
# Histogramm
hist(distance_street, breaks = werte,
col = farben15, border = "grey",
main = "Verteilung der Überholvorgänge außerorts",
xlab = "Überholabstand in m", ylab = "Anzahl")
# Erstelle ein Streudiagramm
plot(speed_street, distance_street,
xlab = "Geschwindigkeit (km/h)",
ylab = "Abstand (m)",
main = "Punktwolke: Geschwindigkeit vs. Abstand",
pch = 19, # Punkteform (z.B. 19 = gefüllte Kreise)
col = "blue") # Farbe der Punkte
```
## Gesamtübersicht einzelner Straßen
In den folgenden Tabellen werden ausschließlich Straßen mit mehr als 20 Überholvorgängen dargestellt. Es wird differenziert nach Straßen innerorts und außerhalb geschlossener Ortschaften.
### Straßen innerorts
```{r tabelle_urban}
df_urban <- subset(df,df$zone =="urban" & df$name != "NULL" & df$name != "Gewerbepark")
anzahl <- aggregate(distance_overtaker ~ name, data = df_urban, FUN = function(x) length(na.omit(x)))
names(anzahl)[2] <- "Anzahl"
# Mittelwert pro Straßenname berechnen
mittelwert <- aggregate(distance_overtaker ~ name, data = df_urban, FUN = function(x) round(mean(na.omit(x)),2))
names(mittelwert)[2] <- "Mittelwert"
# Anteil der Überholvorgänge unter 1,5 m
anzahl_eng <- aggregate(distance_overtaker ~ name, data = df_urban,
FUN = function(x) sum(x < 1.5))
names(anzahl_eng)[2] <- "Anzahl < 1.5m"
anteil_eng <- aggregate(distance_overtaker ~ name, data = df_urban,
FUN = function(x) paste(round(sum(x < 1.5) / length(x)*100,0)," %"))
names(anteil_eng)[2] <- "Anteil < 1.5m"
# Tabellen zusammenführen
str_tabelle_local <- merge(anzahl, mittelwert, by = "name")
str_tabelle_local <- merge(str_tabelle_local,anzahl_eng, by= "name")
str_tabelle_local <- merge(str_tabelle_local,anteil_eng, by= "name")
str_tabelle_local_20 <- str_tabelle_local[str_tabelle_local$Anzahl>20,]
# Ergebnis speichern
names(str_tabelle_local_20)[1] <- "Name"
knitr::kable(str_tabelle_local_20, row.names=FALSE, align = c('l', 'r', 'r', 'r','r'))
```
### Boxplots für einzelne Straßen
```{r boxplots_urban}
strassen20 <- str_tabelle_local_20$Name #Straßen mit mehr als 10 Messwerten
strassen20 <- strassen20[strassen20!="NULL"]
strassen <- strassen20
# Anzahl der Straßen pro Grafik festlegen
strassen_pro_plot <- 4
# Boxplots in Gruppen zu je 5 Straßen erstellen
for (i in seq(1, length(strassen), by = strassen_pro_plot)) {
# Straßen für den aktuellen Plot auswählen
aktuelle_strassen <- strassen[i:min(i + strassen_pro_plot - 1, length(strassen))]
# Daten filtern, die zu den ausgewählten Straßen gehören
df_subset <- df[df$name %in% aktuelle_strassen, ]
boxplot(distance_overtaker ~ name,
data = df_subset,
col = "lightblue",
main = paste("Überholabstände"),
xlab = "Straßennamen",
ylab = "Abstand",
cex.lab=1,
cex.axis = 0.8)
}
```
### Straßen außerhalb geschlossener Ortschaften
```{r tabelle_rural}
df_rural <- subset(df,df$zone =="rural")
anzahl <- aggregate(distance_overtaker ~ name, data = df_rural, FUN = function(x) length(na.omit(x)))
names(anzahl)[2] <- "Anzahl"
# Mittelwert pro Straßenname berechnen
mittelwert <- aggregate(distance_overtaker ~ name, data = df_rural, FUN = function(x) round(mean(na.omit(x)),2))
names(mittelwert)[2] <- "Mittelwert"
# Anteil der Überholvorgänge unter 2 m
anzahl_eng <- aggregate(distance_overtaker ~ name, data = df_rural,
FUN = function(x) sum(x < 2))
names(anzahl_eng)[2] <- "Anzahl < 2m"
anteil_eng <- aggregate(distance_overtaker ~ name, data = df_rural,
FUN = function(x) paste(round(sum(x < 2) / length(x)*100,0)," %"))
names(anteil_eng)[2] <- "Anteil < 2m"
# Beide Tabellen zusammenführen
str_tabelle <- merge(anzahl, mittelwert, by = "name")
str_tabelle <- merge(str_tabelle,anzahl_eng, by= "name")
str_tabelle <- merge(str_tabelle,anteil_eng, by= "name")
str_tabelle_20 <- str_tabelle[str_tabelle$Anzahl>20,]
# Ergebnis speichern
names(str_tabelle_20)[1] <- "Name"
knitr::kable(str_tabelle_20, row.names=FALSE,align = c('l', 'r', 'r', 'r','r'))
```
### Boxplots für einzelne Straßen
```{r boxplots}
strassen20 <- str_tabelle_20$Name #Straßen mit mehr als 20 Messwerten
strassen20 <- strassen20[strassen20!="NULL"]
strassen <- strassen20
# Anzahl der Straßen pro Grafik festlegen
strassen_pro_plot <- 5
# Boxplots in Gruppen zu je 5 Straßen erstellen
for (i in seq(1, length(strassen), by = strassen_pro_plot)) {
# Straßen für den aktuellen Plot auswählen
aktuelle_strassen <- strassen[i:min(i + strassen_pro_plot - 1, length(strassen))]
# Daten filtern, die zu den ausgewählten Straßen gehören
df_subset <- df[df$name %in% aktuelle_strassen, ]
boxplot(distance_overtaker ~ name,
data = df_subset,
col = "lightblue",
main = paste("Überholabstände"),
xlab = "Straßennamen",
ylab = "Abstand",
cex.lab=1,
cex.axis = 1)
}
```
## Alle Straßen
Die folgende Tabelle zeigt alle Straßen innerorts mit mehr als 5 Messungen.
```{r table_all}
str_tabelle_local <- str_tabelle_local[str_tabelle_local$Anzahl>5,]
str_tabelle_local <- str_tabelle_local[rev(order(str_tabelle_local$'Anteil < 1.5m')), ]
names(str_tabelle_20)[1] <- "Straße"
knitr::kable(str_tabelle_local, row.names=FALSE, align = c('l', 'r', 'r', 'r','r'))
```

File diff suppressed because one or more lines are too long