Dateien nach "/" hochladen
This commit is contained in:
parent
9a4770360c
commit
90d246ef05
294
Auswertung-OpenBikeSensor.Rmd
Normal file
294
Auswertung-OpenBikeSensor.Rmd
Normal 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'))
|
||||||
|
```
|
||||||
1106
Auswertung-OpenBikeSensor.html
Normal file
1106
Auswertung-OpenBikeSensor.html
Normal file
File diff suppressed because one or more lines are too long
Loading…
Reference in New Issue
Block a user