In AnthonyEbert/AirportPassengerFlow:

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

AirportPassengerFlow

library(devtools)
install_github("AnthonyEbert/EasyMMD")
install_github("AnthonyEbert/AirportPassengerFlow")

Data

Let's look at all the data. We need data not only to fit parameters, but also to generate realisations - for example we need a flight schedule.

library(AirportPassengerFlow)

flight_level

flight_level_disembark is the same as flight_level with added columns for gamma parameters for disembarkation (Figure 4 in our paper). There are also gate level, nationality level, route level and global parameters.

flight_level_disembark

gate_level

nat_level

route_level

global_level

head(observations)

tail(observations)

route_level contains the service rate parameters since they vary by route and the walking parameters of interest are in global_level . route_level also contains a column called server_imm which is the roster of when servers are available. observations contains all the data used for calculating MMD.

Simulate the passengers

passenger_df <- AirportSimulate1(global_level, flight_level_disembark, gate_level, nat_level, route_level)

passenger_df

The first few columns of this table all look the same since this is flight level information, but the later columns are different for each passenger.

We can change the input in this way.

flight_level2 <- flight_level_disembark
flight_level2$passengers[10] <- 1000

passenger_df_2 <- AirportSimulate1(global_level, flight_level2, gate_level, nat_level, route_level)

A lot happens in this function AirportSimulate1, to get a feel for how this works here's a simpler example with queuecomputer.

library(queuecomputer)

arrivals <- cumsum(rexp(10))
service <- rexp(10)

customers <- data.frame(arrivals, service)

customers

customers$departures <- queue(customers$arrivals, customers$service, servers = 2)

customers

The arrivals and departures from the airport model for immigration are shown below. Notice the big spike before time 500 for the red, since we changed the number of passengers on flight 10.

library(ggplot2)
ggplot(passenger_df) + aes(x = arrive_imm) + geom_freqpoly(breaks = 360:1200) + geom_freqpoly(data = passenger_df_2, breaks = 360:1200, col = "red")

ggplot(passenger_df) + aes(x = depart_imm) + geom_freqpoly(breaks = 360:1200) + geom_freqpoly(data = passenger_df_2, breaks = 360:1200, col = "red")

MMD

Here we find the MMD estimator between samples from normal distributions with different mean parameters.

library(EasyMMD)

x <- rnorm(100, mean = 0, sd = 1)
y <- rnorm(100, mean = 1, sd = 1)

head(x)
head(y)

MMD(x,y)

In the airport case we use vectors of arrival and departure times.

sigma_k <- 20 # Tuning parameter for MMD

MMD(passenger_df$arrive_imm, passenger_df_2$arrive_imm, sigma = sigma_k) +
  MMD(passenger_df$depart_imm, passenger_df_2$depart_imm, sigma = sigma_k)

Performance measures

Suppose we need to generate 20 samples of queue lengths from each model. queuecomputer doesn't generate queue lengths by default because they're not needed in the QDC algorithm. We can back-calculate what they should have been with another function from queuecomputer called queue_lengths.

library(dplyr)
library(ggplot2)
library(queuecomputer)

sim_df <- data.frame(sim_number = c(1:20))

queue_df <- sim_df %>% 
  group_by(sim_number) %>%
  do(AirportPassengerFlow::AirportSimulate1(global_level, flight_level_disembark, gate_level, nat_level, route_level)) %>%
  group_by(route, sim_number) %>%
  do(queue_lengths(.$arrive_imm, .$service_imm, departures = .$depart_imm))

queue_df2 <- sim_df %>% 
  group_by(sim_number) %>%
  do(AirportPassengerFlow::AirportSimulate1(global_level, flight_level2, gate_level, nat_level, route_level)) %>%
  group_by(route, sim_number) %>%
  do(queue_lengths(.$arrive_imm, .$service_imm, departures = .$depart_imm))

ggplot(queue_df) + aes(x = times, y = queuelength, group = factor(sim_number)) + geom_step(alpha = 0.2) + facet_wrap(~route) + geom_step(data = queue_df2, col = "red", alpha = 0.2)