-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathspeedcam.Rmd
executable file
·175 lines (127 loc) · 7.09 KB
/
speedcam.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
---
title: "Speed cam data analysis"
output: rmarkdown::github_document
---
```{r}
library(tidyverse)
library(lubridate)
library(scales)
library(gridExtra)
library(stringr)
cbPalette <- c("#9acd32","#77003c")
df <- read.csv('df_after_prediction.csv',stringsAsFactors = FALSE)
df$datetime <- ymd_hm(paste(df$date,df$hour,df$minute,sep='-'))
print(dim(df))
df <- df[!is.na(df$datetime),]
print(dim(df))
df$interval.datetime.hour <- ymd_h(paste(df$date,df$hour,sep='-'))
datetime.hour.index <- data.frame(datetime.index.hour = seq(min(df$interval.datetime.hour),max(df$interval.datetime.hour),by=60*60))
df <- merge(datetime.hour.index,df,by.x='datetime.index.hour',by.y='interval.datetime.hour',all.x = TRUE)
print(dim(df))
df <- df %>% mutate(type = ifelse(classes==0,'car',ifelse(classes==1,'bike','NA')))
print(head(df$classes))
df <- df %>% mutate(type=ifelse(is.na(speed), 'car', type), speed=ifelse(is.na(speed),0,speed))
print(head(df$type))
df.2 <- df %>% filter(speed==0)
df.2<- df.2 %>% mutate(type='bike')
df<- rbind(df,df.2)
df$week <- week(df$datetime.index.hour)
groupy <-
df %>%
group_by(datetime.index.hour, type) %>%
summarise(vehicles = n(),max.speed = max(speed),av.speed = mean(speed), over.speed.limit = sum(speed>50))
groupy$week <- week(groupy$datetime.index.hour)
groupy$day_week <- ymd(str_c(2018,1,wday(groupy$datetime.index.hour), sep='-'))
groupy$hour <- hour(groupy$datetime.index.hour)
groupy$day_week_hour <- ymd_hms(str_c(groupy$day_week,groupy$hour,0,0,sep=':'))
groupy$date <- date(groupy$datetime.index.hour)
```
## Create a weekday/hour matrix of over speed ratio
```{r}
matrix.over.speed <- groupy %>% filter(type=='car') %>% select(date,over.speed.limit,vehicles,hour) %>% filter(date>ymd('2018-04-27')& date<ymd('2018-05-20'))
matrix.over.speed$weekday <- wday(matrix.over.speed$date)
#matrix.over.speed$ratio <- matrix.over.speed$over.speed.limit/matrix.over.speed$vehicles
matrix.over.speed <- matrix.over.speed %>% filter(hour>=6 & hour<=22)
groupy.matrix <- matrix.over.speed %>% group_by(weekday,hour) %>% summarise(ratio = sum(over.speed.limit)/ sum(vehicles)*100)
groupy.matrix$dayname<- factor(groupy.matrix$weekday, levels=1:7,
labels=c("Sunday", "Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday"))
```
# plot heatmap
```{r}
p<-ggplot(groupy.matrix, aes(dayname, hour )) +
geom_tile(aes(fill = ratio), color = "white") +
scale_fill_gradient(low = "white", high = "#77003c") +
ylab("hour") +
xlab('')+coord_flip()+
theme(legend.title = element_text(size = 10),
legend.text = element_text(size = 12),
plot.title = element_text(size=16),
axis.title=element_text(size=14,face="bold"),
axis.text.x = element_text(angle = 90, hjust = 1)) +
labs(fill = "% Over 50 km/h")
p
ggsave('heatmap.png',p)
```
## Read Wetter Daten
```{r}
df_wetter <- read_table('wetter_berlin.txt')
df_wetter$JJJJMMDD<- ymd(df_wetter$JJJJMMDD)
df_wetter <- df_wetter %>% filter(!is.na(JJJJMMDD))
df_wetter <- df_wetter %>% mutate_at(c('TN','TX','TM'), funs(as.numeric(.)))
```
```{r}
dt <- '2018-05-25'
p1 <- ggplot(df %>% filter(as.Date(datetime)==ymd(dt)),aes(datetime,speed, color=type))+ geom_jitter(alpha=0.2)+geom_smooth()+theme(legend.position="top",legend.title=element_blank(),axis.title.x=element_blank())+scale_colour_manual(values=cbPalette)+theme(legend.position="none")+ggtitle(dt)
p1 <- p1 + facet_wrap( ~ type, nrow = 8)
ggsave(paste0('traffic_',dt,'.png'),p1)
```
## Group by time slots
```{r}
p1 <- ggplot(groupy ,aes(day_week_hour,av.speed,color=type))+geom_line()+theme(axis.text.x = element_text(angle=90))+
scale_x_datetime(date_breaks = "2 days",labels = date_format("%d-%m %H:%M"))+theme(legend.position="top")+ylim(10,35)+theme(legend.position="top",legend.title=element_blank(),axis.title.x=element_blank())+scale_colour_manual(values=cbPalette)
p1 + facet_wrap( ~ week, nrow = 8)
```
```{r}
groupy <- groupy%>% filter(!is.na(type))
p2 <- ggplot(data=groupy, aes(fill=type)) + stat_identity(data = groupy %>%filter(datetime.index.hour>'2018-04-19'
), aes(datetime.index.hour, vehicles), geom = "bar", alpha = 0.8,position = "dodge")+theme(axis.text.x = element_text(angle=90))+
scale_x_datetime(date_breaks = "1 day",labels = date_format("%a"))+theme(legend.position="top",legend.title=element_blank(),axis.title.x=element_blank())+scale_fill_manual(values=cbPalette)
p2 <- p2 + facet_wrap( ~ type, nrow = 2) +ggtitle('Traffic per hour - April-Mai 2018')
p2
ggsave('bike_car.png',p2)
```
```{r}
ggplot(data=groupy, aes(fill=type)) + stat_identity(data = groupy %>% filter(datetime.index.hour>'2018-04-08' & type=='car'), aes(datetime.index.hour, over.speed.limit), geom = "bar", alpha = 0.8,position = "dodge")+theme(axis.text.x = element_text(angle=90))+
scale_x_datetime(date_breaks = "1 day",labels = date_format("%a"))+theme(legend.position="top",legend.title=element_blank(),axis.title.x=element_blank())+scale_fill_manual(values='#77003c')+theme(legend.position="none")+ggtitle("Speed limit breaches per hour") +
theme(plot.title = element_text(lineheight=.8, face="bold"))
```
```{r}
groupy.per.date <- groupy %>% group_by(date) %>% summarise(total.over.speed = sum(over.speed.limit))
groupy.per.date <- merge(groupy.per.date,df_wetter,by.x='date',by.y='JJJJMMDD')
groupy.per.date.bike <- groupy %>% filter(type=='bike') %>% group_by(date) %>% summarise(total.bikes = sum(vehicles))
groupy.per.date.car <- groupy %>% filter(type=='car') %>% group_by(date) %>% summarise(total.cars = sum(vehicles))
groupy.per.date <- merge(groupy.per.date,groupy.per.date.bike,by='date')
groupy.per.date <- merge(groupy.per.date,groupy.per.date.car,by='date')
groupy.per.date$ratio.over.speed <- groupy.per.date$total.over.speed/groupy.per.date$total.cars*100
groupy.per.date.stacked <- groupy.per.date %>% select(ratio.over.speed,total.bikes,TM,date) %>% gather(key,value,-date)
p <- ggplot(groupy.per.date.stacked,aes(date,value))+geom_line(aes(color=key))+scale_color_manual(values=c('#77003c','#c33333',"#9acd32",'red','blue'))+theme(legend.position="top",legend.title=element_blank(),axis.title.x=element_blank())
p <- p + facet_wrap( ~ key, nrow = 3,scales='free_y') +ggtitle('Per day - April-Mai 2018')+theme(legend.position="none")
p
ggsave('speed_temp_bike.png',p)
```
```{r}
df %>% top_n(10,speed) %>% select(Speed_Photo_Path,speed) %>% arrange(desc(speed))
```
```{r}
groupy.model <-groupy.per.date %>% filter(date>=ymd('2018-05-01') & date<ymd('2018-05-20'))
model <- lm( ratio.over.speed ~ TN+total.bikes, data = groupy.model)
summary(model)
```
```{r}
df.per.over.speed <- df %>% filter(speed>50)# %>% group_by('date') %>% summarise()
ggplot(df.per.over.speed,aes(datetime.index.hour,speed))+ geom_point(aes(color=hour))+geom_smooth()+ scale_x_datetime(date_breaks = "1 day",labels = date_format("%a"))+theme(axis.text.x = element_text(size=8,angle=90,hjust=.5,vjust=.5,face="plain"))
```
```{r}
groupy.over.speed <- df.per.over.speed %>% group_by(weekdays(datetime.index.hour)) %>% summarise(mean.over.speed = mean(speed))
```