-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathREADME.Rmd
313 lines (232 loc) · 11.5 KB
/
README.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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
---
output: github_document
bibliography: library.bib
---
<!-- README.md is generated from README.Rmd. Please edit that file -->
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
```
# carfollowingmodels
<!-- badges: start -->
<!-- badges: end -->
The goal of `carfollowingmodels` is to make several car following models available in R for numerical simulation.
## Installation
`carfollowingmodels`is not on CRAN yet. But you can download the development version from GitHub with:
``` r
# install.packages("devtools")
devtools::install_github("durraniu/carfollowingmodels")
```
You need to have Rtools installed which you can download and setup using the [instructions here](https://cran.r-project.org/bin/windows/Rtools/).
## Example
To use any car-following model, you need to provide the lead vehicle data, initial position, speed and/or acceleration of following vehicle(s), and model parameters.
The models used in this package are cited below:
| Model | Citation |
|--------------------------|------------------------------|
| Intelligent Driver Model | @Treiber2013 |
| Gipps Model | @Gipps1981 |
| Wiedemann 74 Model | @Wiedemann1992; @Higgs2011 |
Following shows an example with 5 following vehicles. The lead vehicle is moving at 13.9 m/s at the reference position of 100 m.
```{r example}
# Time
last_time <- 3000 ## s
time_frame <- 0.1 ## s
Time <- seq(from = 0, to = last_time, by = time_frame)
time_length <- length(Time)
## Lead vehicle
vn1_first <- 13.9 ## first speed m/s
xn1_first <- 100 ## position of lead vehicle front center m
bn1_complete <- c(rep(0, 15000),
rep(0.05, 2000),
rep(-1, 3000),
rep(0, 8000),
rep(-5, 2001))
#############################################
### Complete speed trajectory of Lead vehicle
#############################################
vn1_complete <- rep(NA_real_, time_length) ### an empty vector
xn1_complete <- rep(NA_real_, time_length) ### an empty vector
vn1_complete[1] <- vn1_first
xn1_complete[1] <- xn1_first
for (t in 2:time_length) {
### Lead vehicle calculations
vn1_complete[t] <- vn1_complete[t-1] + (bn1_complete[t-1] * time_frame)
vn1_complete[t] <- ifelse(vn1_complete[t] < 0, 0, vn1_complete[t])
xn1_complete[t] <- xn1_complete[t-1] + (vn1_complete[t-1] * time_frame) +
(0.5 * bn1_complete[t-1] * (time_frame)^2)
}
## Lead vehicle data in a dataframe
ldf <- data.frame(Time, bn1_complete, xn1_complete, vn1_complete)
```
## Intelligent Driver Model (IDM)
To predict the trajectories of the 5 following vehicles, you can use any car-following model available in this package. For example, the `simulate_idm()` function uses the Intelligent Driver Model as shown below. For more details on input arguments, type `?simulate_idm`in the console.
```{r exampleCont}
library(carfollowingmodels)
## Run the IDM function:
results_idm <- simulate_idm(
resolution=0.1,
N=5,
dfn1=ldf,
xn1="xn1_complete",
vn1="vn1_complete",
xn_first=list(85, 70, 55, 40, 25),
vn_first=list(12, 12, 12, 12, 12),
ln=list(5, 5, 5, 5, 5),
a=2,
v_0=14.4,
small_delta=1,
s_0=4,
Tg=1,
b=1.5
)
head(results_idm)
```
Now you can plot the results:
```{r plots}
library(tidyverse)
## Position
results_at_time_0_LV <- subset(results_idm, fvn==1 & Time ==0)
results_at_time_0_FV <- subset(results_idm, Time ==0)
ggplot() +
geom_rect(data = results_at_time_0_LV,
aes(xmin = xn1 - ln1,
xmax = xn1,
ymin = 0.628,
ymax = 3.028)) +
geom_rect(data = results_at_time_0_FV,
aes(group = fvn,
fill = as.factor(fvn),
xmin = xn - 5,
xmax = xn,
ymin = 0.628,
ymax = 3.028)) +
geom_hline(yintercept = 3.6, linetype = "longdash") +
coord_fixed(ratio=1) +
theme(legend.title = element_blank())
## Speed
ggplot(data = results_idm) +
geom_line(aes(x = Time, y = vn, color = as.factor(fvn), group=fvn)) +
geom_line(data = subset(results_idm, fvn==1),
aes(x = Time, y = vn1, color = "LV Speed")) +
theme(legend.title = element_blank())
```
## Gipps Model
```{r}
results_gipps <- simulate_gipps(
resolution=0.1,
N=5,
dfn1=ldf,
xn1="xn1_complete",
vn1="vn1_complete",
xn_first=list(85, 70, 55, 40, 25),
vn_first=list(12, 12, 12, 12, 12),
ln=list(6.5, 6.5, 6.5, 6.5, 6.5),
an=2,
Vn=14.4,
tau=0.1,
bn=-1.5,
bcap=-2
)
head(results_gipps)
## Speed
ggplot(data = results_gipps) +
geom_line(aes(x = Time, y = vn, color = as.factor(fvn), group=fvn)) +
geom_line(data = subset(results_gipps, fvn==1),
aes(x = Time, y = vn1, color = "LV Speed")) +
theme(legend.title = element_blank())
```
## Wiedemann 74 Model (individual driver)
```{r}
results_w74d <- simulate_wiedemann74_driver(
resolution=0.1,
N=5,
dfn1=ldf,
xn1="xn1_complete",
vn1="vn1_complete",
bn1="bn1_complete",
xn_first=list(85, 70, 55, 40, 25),
vn_first=list(12, 12, 12, 12, 12),
ln=list(5, 5, 5, 5, 5),
D_MAX=150,
V_MAX=44,
V_DESIRED=14.4,
FAKTORVmult=0.001,
BMAXmult=0.08,
BNULLmult=0.25,
BMIN=-5,
CX=50,
AXadd=2,
BXadd=2,
EXadd=2,
OPDVadd=1.5
)
head(results_w74d)
## Speed
ggplot(data = results_w74d) +
geom_line(aes(x = Time, y = vn, color = as.factor(fvn), group=fvn)) +
geom_line(data = subset(results_w74d, fvn==1),
aes(x = Time, y = vn1, color = "LV Speed")) +
theme(legend.title = element_blank())
```
### Outputs
| Variable | Description | Model |
|--------------|-----------------------------------------------------------------------------------------------------------------------------------------------|-------------|
| fvn | Following vehicle number | Common |
| Time | Time in seconds | Common |
| xn1 | Position of front center of the lead vehicle | Common |
| vn1 | Speed of the lead vehicle | Common |
| ln1 | Length of the lead vehicle | Common |
| bn | Acceleration (positive and negative) of the following vehicle | Common |
| xn | Position of front center of the following vehicle | Common |
| vn | Speed of the following vehicle | Common |
| sn | Spacing between the front bumper of the following vehicle and the front bumper of the lead vehicle (including the length of the lead vehicle) | Common |
| deltav | Speed difference (following vehicle speed - lead vehicle speed) | Common |
| sn_star | Desired spacing | IDM |
| vn_ff | Speed of following vehicle with free-flow equation | Gipps |
| vn_cf | Speed of following vehicle with car-following equation | |
| AX | Standstill spacing | Wiedemann74 |
| BX | Calibration Parameter | Wiedemann74 |
| ABX | Minimum following distance | Wiedemann74 |
| CX | Calibration Parameter | Wiedemann74 |
| SDX | Minimum following distance + drift due to unequal speed difference in opening and closing | Wiedemann74 |
| SDV | Speed difference when driver perceives approaching a slow lead vehicle | Wiedemann74 |
| CLDV | Speed difference when driver perceives closing in to lead vehicle | Wiedemann74 |
| OPDV | Speed difference when driver perceives losing lead vehicle | Wiedemann74 |
| BMAX | Acceleration in Free-driving | Wiedemann74 |
| B_App | Deceleration in Approaching | Wiedemann74 |
| B_Emg | Deceleration in Emergency-braking | Wiedemann74 |
| BNULL | Acceleration (positive and negative) in Following and at desired speed in Free-driving | Wiedemann74 |
| cf_state_sim | Driving state (Free-driving, Approaching, Following, Emergency-braking) | Wiedemann74 |
### Compare Models
Comparing models is difficult as each model has at least a few unique parameters of its own. Nevertheless, following shows the speed of the fifth following vehicle as predicted by different models:
```{r}
results_gipps_fv1 <- results_gipps %>%
filter(fvn == 5)
results_idm_fv1 <- results_idm %>%
filter(fvn == 5)
results_w74d_fv1 <- results_w74d %>%
filter(fvn == 5)
ggplot() +
geom_line(data = results_gipps_fv1 ,
aes(x = Time, y = vn, color = "Gipps Speed")) +
geom_line(data = results_idm_fv1 ,
aes(x = Time, y = vn, color = "IDM Speed")) +
geom_line(data = results_w74d_fv1 ,
aes(x = Time, y = vn, color = "W74 Speed")) +
geom_line(data = ldf ,
aes(x = Time, y = vn1_complete, color = "LV Speed"), linetype = "longdash") +
ggtitle("Speed")
ggplot() +
geom_line(data = results_gipps_fv1 ,
aes(x = Time, y = sn, color = "Gipps")) +
geom_line(data = results_idm_fv1 ,
aes(x = Time, y = sn, color = "IDM")) +
geom_line(data = results_w74d_fv1 ,
aes(x = Time, y = sn, color = "W74")) +
ggtitle("Spacing (including length of lead vehicle)")
```
# References