In durraniu/CarFollowingModels: What the Package Does (One Line, Title Case)

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/README-",
  out.width = "100%"
)

carfollowingmodels

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 | @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.

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

Now you can plot the results:

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

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)

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:

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)")