The goal of carfollowingmodels is to make several car following models available in R for numerical simulation.

Installation

carfollowingmodelsis not on CRAN yet. But you can download the development version from GitHub with:

# install.packages("devtools")
devtools::install_github("durraniu/carfollowingmodels")

You need to have Rtools installed which you can download and setup using the instructions here.

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 Treiber and Arne Kesting (2013)
Gipps Model Gipps (1981)
Wiedemann 74 Model Wiedemann and Reiter (1992); Higgs, Abbas, and Medina (2011)

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.

# 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_idmin the console.

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)
#>   fvn Time    xn1  vn1 ln1         bn       xn       vn       sn    deltav
#> 1   1  0.0 100.00 13.9   5 -1.4407191 85.00000 12.00000 15.00000 -1.900000
#> 2   1  0.1 101.39 13.9   5 -1.1565350 86.19280 11.85593 15.19720 -2.044072
#> 3   1  0.2 102.78 13.9   5 -0.9399018 87.37261 11.74027 15.40739 -2.159725
#> 4   1  0.3 104.17 13.9   5 -0.7704464 88.54193 11.64628 15.62807 -2.253716
#> 5   1  0.4 105.56 13.9   5 -0.6351232 89.70271 11.56924 15.85729 -2.330760
#> 6   1  0.5 106.95 13.9   5 -0.5252076 90.85646 11.50573 16.09354 -2.394273
#>    sn_star
#> 1 9.418207
#> 2 8.860068
#> 3 8.420694
#> 4 8.069309
#> 5 7.785079
#> 6 7.553349

Now you can plot the results:

library(tidyverse)
#> Warning: package 'tidyverse' was built under R version 4.0.4
#> -- Attaching packages --------------------------------------- tidyverse 1.3.0 --
#> v ggplot2 3.3.3     v purrr   0.3.4
#> v tibble  3.1.1     v dplyr   1.0.5
#> v tidyr   1.1.3     v stringr 1.4.0
#> v readr   1.4.0     v forcats 0.5.1
#> Warning: package 'tibble' was built under R version 4.0.5
#> Warning: package 'tidyr' was built under R version 4.0.5
#> Warning: package 'dplyr' was built under R version 4.0.5
#> -- Conflicts ------------------------------------------ tidyverse_conflicts() --
#> x dplyr::filter() masks stats::filter()
#> x dplyr::lag()    masks stats::lag()

## 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

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)
#>   fvn Time    xn1  vn1 ln1        bn       xn       vn       sn    deltav
#> 1   1  0.0 100.00 13.9 6.5 0.7815591 85.00000 12.00000 15.00000 -1.900000
#> 2   1  0.1 101.39 13.9 6.5 0.7585004 86.20391 12.07816 15.18609 -1.821844
#> 3   1  0.2 102.78 13.9 6.5 0.7359608 87.41552 12.15401 15.36448 -1.745994
#> 4   1  0.3 104.17 13.9 6.5 0.7139400 88.63460 12.22760 15.53540 -1.672398
#> 5   1  0.4 105.56 13.9 6.5 0.6924367 89.86093 12.29900 15.69907 -1.601004
#> 6   1  0.5 106.95 13.9 6.5 0.6714485 91.09429 12.36824 15.85571 -1.531760
#>      vn_ff    vn_cf
#> 1 12.00000 12.00000
#> 2 12.07816 12.83576
#> 3 12.15401 12.85679
#> 4 12.22760 12.87691
#> 5 12.29900 12.89615
#> 6 12.36824 12.91455


## 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())
#> Warning: Removed 60560 row(s) containing missing values (geom_path).

Wiedemann 74 Model (individual driver)

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)
#>   fvn Time    xn1  vn1 ln1        bn       xn       vn       sn    deltav AX
#> 1   1  0.0 100.00 13.9   5 0.5926839 85.00000 12.00000 15.00000 -1.900000  7
#> 2   1  0.1 101.39 13.9   5 0.5782258 86.20296 12.05927 15.18704 -1.840732  7
#> 3   1  0.2 102.78 13.9   5 0.5641204 87.41178 12.11709 15.36822 -1.782909  7
#> 4   1  0.3 104.17 13.9   5 0.5503591 88.62631 12.17350 15.54369 -1.726497  7
#> 5   1  0.4 105.56 13.9   5 0.5369335 89.84641 12.22854 15.71359 -1.671461  7
#> 6   1  0.5 106.95 13.9   5 0.5238353 91.07195 12.28223 15.87805 -1.617768  7
#>         BX      ABX CX      SDX        SDV      CLDV       OPDV      BMAX B_App
#> 1 6.928203 13.92820 50 20.85641 0.02560000 0.1024000 -0.1536000 0.5926839    NA
#> 2 6.945291 13.94529 50 20.89058 0.02681103 0.1072441 -0.1608662 0.5782258    NA
#> 3 6.961922 13.96192 50 20.92384 0.02801083 0.1120433 -0.1680650 0.5641204    NA
#> 4 6.978109 13.97811 50 20.95622 0.02919785 0.1167914 -0.1751871 0.5503591    NA
#> 5 6.993866 13.99387 50 20.98773 0.03037064 0.1214826 -0.1822238 0.5369335    NA
#> 6 7.009203 14.00920 50 21.01841 0.03152790 0.1261116 -0.1891674 0.5238353    NA
#>   B_Emg BNULL cf_state_sim
#> 1    NA  0.25 free_driving
#> 2    NA  0.25 free_driving
#> 3    NA  0.25 free_driving
#> 4    NA  0.25 free_driving
#> 5    NA  0.25 free_driving
#> 6    NA  0.25 free_driving


## 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:

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")
#> Warning: Removed 12110 row(s) containing missing values (geom_path).


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)")
#> Warning: Removed 12111 row(s) containing missing values (geom_path).

References

Gipps, P G. 1981. “A behavioural car following model for computer simulation.” Transportation Research Part B 15: 101–15.

Higgs, Bryan, MM Abbas, and Alejandra Medina. 2011. “Analysis of the Wiedemann Car Following Model over Different Speeds using Naturalistic Data.” 3rd International Conference on Road Safety and Simulation, 1–22.

Treiber, Martin, and Arne Kesting. 2013. “Traffic flow dynamics.” Traffic Flow Dynamics: Data, Models and Simulation, Springer-Verlag Berlin Heidelberg.

Wiedemann, Reiter, and U Reiter. 1992. “Microscopic traffic simulation: the simulation system MISSION, background and actual state.” Project ICARUS (V1052) Final Report. Brussels, CEC 2: 1–53.