Introduction

The goal of this simulation is to build a sufficiently detailed simulation of the Magic Kingdom at Walt Disney World theme park in Orlando, Florida in order to answer a minimum of two what-if questions. We use this simulation to answer the following three (3) what if questions:

  1. Examine how the number of open turnstiles affects the wait time required to enter the park and in so doing, find the optimum number of turnstiles to ensure that no agent waits for more than 10 minutes.

  2. Every guest that enters the park must choose a number of rides. In our simulation, we generate this number from a distribution. Compare the generated values to the theoretic value and confirm that our simulation is producing results in agreement with the theory.

  3. Based upon the number of turnstiles required to assure that no agent waits for more than 10 minutes, show the distribution of time spent in the park.

Author’s Note

This simulation (and accompanying code and documentation) is presented to satisfy the requirements of the final project for CS 6830, taught by Dr. Gallagher, Fall 2018 at Wright State University.

Approach

We begin by building the simulation and then proceed to answer the questions detailed above. We build the model in a modularized fashion, documenting and explaining the code as we proceed. The final product produced is a simulation which can be ran to produce output that can be analyzed to answer the three (3) what if questions described above. This package may be installed and accessed from https://github.com/morgan219/disney.world.sim. The produced output can be retrieved at https://data.world/morgan219/disneyworldsim. An accompanying website is available at http://projects.jamesonmorgan.com/disneyworldsim which offers all the code used within this project as well as the unit testing performed.

Setup

Since we are explaining and documenting our model in a piece-wise-linear fashion, we will introduce code chuncks and visuals throughout this document. The following code is setup code that should be ran to ensure reproducibility.

#set the seed value for the random generator
set.seed(123)

# bring in code scripts
knitr::read_chunk('../../R/modeling_agent_entry.R')
knitr::read_chunk('../../R/simplequeue.R')
knitr::read_chunk('../../R/choose_turnstile.R')
knitr::read_chunk('../../R/modeling_arrivals.R')
knitr::read_chunk('../../R/modeling_arrival_dist.R')
knitr::read_chunk('../../R/event_record.R')
knitr::read_chunk('../../R/theme_park_sim_1.R')
knitr::read_chunk('../../R/agent_arrivals.R')

Modeling: Theme Park

We define a theme park to be geographic region which consists of:

  1. A Single Entrance and Exit,

  2. Attractions (Rides and/or Shows), and

  3. Dining Experiences

The individuals arriving at a theme park are called agents. Agents attend theme parks in order to enjoy the attractions and dining experiences (activities). Because many agents attend the same park and want to enjoy the same attractions and dining experiences, agents must typically wait in lines in order to enjoy these experiences. What experiences are chosen are typically a product of multiple factors, including time of day, desire, and current wait times. When a user leaves a theme park is dependent upon a number of factors, such as additional plans, tiredness of the traveling party, sickness, or injuries, and therefore is unique to each agent. An agent is defined as leaving a theme park when they are no longer within the confines of the geographic region defining the theme park.

Modeling: Agent Behavior

Based upon our definition of a theme park, we can model agent behavior as the following stochastic mechanistic model:

  1. Arrive at Park

  2. Select Activity

  3. Navigate to Activity

  4. Wait to Perform Activity

  5. Perform Activity

  6. Return to Step (ii) or Leave Park

The process is mechanistic as each agent follows the same process. The process is also stochastic as each agent performs these tasks in slightly different ways (as we will see below).

Note, that as mentioned above, because multiple agents want to enjoy the same experiences, agents typically wait in lines prior to enjoying the experience. Therefore, steps (ii), (iii) and (iv) may be a function of the current number of agents within the theme park desiring to have the same experience.

Modeling: Arrivals

As outlined in our theme park definition and agent behavior sections, modeling the arrival of agents to a theme park is the very first step in the simulation. Obviously, due to the proprietary nature of attendance data, theme parks do not release their attendance data in any easy to use, granular form. Thus, for the purposes of this simulation, we do not have direct access to daily (or monthly) attendance totals as most theme parks publish annual approximations [1]. In addition to yearly theme park totals, we do have access to state tourism information [2]. Using both of these data sources, we can obtain the approximate number of agents arriving at a theme park.

In our case, the Magic Kingdom theme park at the Walt Disney World Resort in Orlando, Florida had a yearly attendance of approximately 20,450,000 agents in the fiscal year 2017 [1]. Dividing this value by 365 days for year 2017, we get an average daily attendance of approximately 56,000 individuals. However, using tourism data from the state of Florida, USA [2], we can determine the number of tourists by quarter. Utilizing both of these data sources, we can determine the approximate number of agents per day. We do so using the following algorithm:

  1. Determine the percentage of Florida tourists that visit the Magic Kingdom; \(mk \approx \frac{total\_disney}{total\_florida}\)

  2. Calculate quarterly totals for Magic Kingdom; \(q_i \approx q_{i, tourism} \cdot mk\) where \(q_{tourism}\) is the quarterly tourism data and \(i\) is the quarter

  3. Approximate the daily average for the Magic Kingdom; \(\frac{q_i}{days(q_i)}\) where \(i\) is the quarter and \(days(\cdot)\) is the number of days in \(\cdot\).

In code, we compute as follows:

#attendance numbers
year_disney_total_2017 <- 20450000
year_tourism_total_2017 <- 118756000
q1_tourism_2017 <- 31891000
q2_tourism_2017 <- 30017000
q3_tourism_2017 <- 27854000
q4_tourism_2017 <- 28993000

#days in quarters
q1 <- 90
q2 <- 91
q3 <- 92
q4 <- 92

#percentage of Florida tourists visiting mk
per_visit_mk <- year_disney_total_2017/year_tourism_total_2017

#quarterly totals
q1_disney_2017 <- q1_tourism_2017 * per_visit_mk
q2_disney_2017 <- q2_tourism_2017 * per_visit_mk
q3_disney_2017 <- q3_tourism_2017 * per_visit_mk
q4_disney_2017 <- q4_tourism_2017 * per_visit_mk

#quarterly daily totals
q1_day_avg_disney_2017 <- as.integer(q1_disney_2017 / q1)
q2_day_avg_disney_2017 <- as.integer(q2_disney_2017 / q2)
q3_day_avg_disney_2017 <- as.integer(q3_disney_2017 / q3)
q4_day_avg_disney_2017 <- as.integer(q4_disney_2017 / q4)

#construct table for display
mk_attendance <- data.frame("quarter" = c(1, 2, 3, 4),
                            "quarterly totals" = c(q1_disney_2017, q2_disney_2017, 
                                                   q3_disney_2017, q4_disney_2017),
                            "quarterly daily" = c(q1_day_avg_disney_2017,
                                                  q2_day_avg_disney_2017,
                                                  q3_day_avg_disney_2017,
                                                  q4_day_avg_disney_2017))

knitr::kable(mk_attendance, caption="Magic Kingdom Attendance", col.names = c("Quarter", "Total", "Daily"))

We now construct a helper function to help retrieve the daily park attendance average.

get_daily_average <- function(quarter){
  #attendance numbers
  year_disney_total_2017 <- 20450000
  year_tourism_total_2017 <- 118756000
  q1_tourism_2017 <- 31891000
  q2_tourism_2017 <- 30017000
  q3_tourism_2017 <- 27854000
  q4_tourism_2017 <- 28993000

  #days in quarters
  q1 <- 90
  q2 <- 91
  q3 <- 92
  q4 <- 92

  #percentage of Florida tourists visiting mk
  per_visit_mk <- year_disney_total_2017/year_tourism_total_2017

  #quarterly totals
  q1_disney_2017 <- q1_tourism_2017 * per_visit_mk
  q2_disney_2017 <- q2_tourism_2017 * per_visit_mk
  q3_disney_2017 <- q3_tourism_2017 * per_visit_mk
  q4_disney_2017 <- q4_tourism_2017 * per_visit_mk

  #quarterly daily totals
  q1_day_avg_disney_2017 <- as.integer(q1_disney_2017 / q1)
  q2_day_avg_disney_2017 <- as.integer(q2_disney_2017 / q2)
  q3_day_avg_disney_2017 <- as.integer(q3_disney_2017 / q3)
  q4_day_avg_disney_2017 <- as.integer(q4_disney_2017 / q4)

  switch(quarter,
         "q1" = return(q1_day_avg_disney_2017),
         "q2" = return(q2_day_avg_disney_2017),
         "q3" = return(q3_day_avg_disney_2017),
         "q4" = return(q4_day_avg_disney_2017))
}

Because each day is not exactly the same, particularly during off-season, we set the park attendance swing to be 10000 agents. In the end, we present a stochastic emperical model governing the number of arrivals during any particular day as \(E[X | q_i] = \mathcal{N}(E[q_i], 10000)\) where \(X\) is a day’s attendance and \(q_i\) is the quarter that \(X\) falls in. The process is stochastic because the arrivals are generated as a random deviate from a Gaussian distribution. The process is also emperical as we are basing this process on observations rather than on explanations which would explain why we are seeing such results. We believe that such a model is reasonable as the Walt Disney World Resort is a major tourist draw so it is not unreasonable to expect that a certain number of individuals are traveling to Florida because of the Magic Kingdom. Our model also spreads attendance across the year, something Disney has tried to do at Disney World [3].

We create function get_attendance() which performs this computation.

get_attendance <- function(num_to_sample, quarter){
  sd = 10000
  attendance <- get_daily_average(quarter)
  return(as.integer(rnorm(num_to_sample, attendance, sd)))
}

Testing: No formal testing required as function simply performs division. Ad-hoc testing performed to ensure returned values were correct.

Modeling: Arrival Distribution

Now, we have to model the arrivals of guests throughout the day. Obviously, not all of the agents arrive at the same exact time, so a model must be developed which dictates when the agents arrive throughout the day. Again, theme parks do not publish the distribution of arrivals, but observation and experience provides powerful insights into a reasonable attendance model.

While agents may arrive any time during operating hours, certain hours tend to have more arrivals than others. For example, intuitively (and assuming no special event is occurring), we know that more agents will arrive earlier rather than an hour before closing. What is not quite as intuitive is that at the Magic Kingdom, the crowds tend to be the lowest during the morning hours [4]. This makes sense logically since the agents are on vacation and would opt to arrive in a leisurely fashion rather than wake up early (something which is typically not associated with vacations). From field observations, such a period of low crowds typically exists for the first 3 hours after opening [4]. After this, field observations indicate that crowds tend to build towards mid-afternoon [4]. Rising crowd levels are an indicator that more agents are starting to arrive. For the purposes of simulation, we quantify mid-afternoon as 3:00pm. After this, arrival rates tend to be more flat until an evening parade or show, at which point, arrival rates decrease (i.e. the departure rate increases). For the purposes of simulation, we quantify the evening parade or show as occurring at 9:00pm. Based upon operator published hours of operation, we assume an opening of 9:00am. and a closing of 10:00pm (please note that opening and closing times very and these are just valid times that exist within the range of possible operating times) [5]. Thus, visually speaking, the arrival rate grows until a peak in the mid-afternoon after which the arrival rate slows down to an almost steady-state up until about an hour before closing where the arrival rate become negative.

Setting 9am (park opening) to 0 and 10pm (park closing) to 13 hours (3 hours from 9am-12pm and 10 hours from 12pm-10pm), we define the percentage of arrivals parameter \(\lambda(t)\) as follows:

[ (t) =

\[\begin{cases} 0.15,\ 0 \leq t < 3 \\ 0.70,\ 3 \leq t < 6 \\ 0.14,\ 6 \leq t < 12 \\ 0.01,\ 12 \leq t < 13 \end{cases} \]\]

where \(t\) is the current time. Thus, \(\lambda(t)\) defines a function that provides the percentage of arrivals expected across the simulation. The exact percentages are obviously unknown and therefore \(\lambda(t)\) is based upon experience and field observations. This is a deterministic emperical model. The model is deterministic as the output of the model is not subject to any randomness. The model is also emperical because the output is purely based upon observation. (Please note that we are not arguing that the arrival times generated are deterministic, rather, it is the model dictating the percentage of arrivals which is deterministic.)

Of course, simply knowing the percentage of agents which arrive between a given time window is not enough as this does not actually provide us with arrival times. Therefore, we define a stochastic emperical model that uses a hybrid inverse transform technique to generate the arrival times in accordance with the arrival distribution outlined above. Once again, this model is emperical as it is based upon observation and stochastic because the technique uses randomly generated numbers to produce the desired arrival times.

In code, we define as follows:

generate_arrivals <- function(num_of_arrivals, begin, end, probs){

  #for each time interval, generate the arrival times of the agents
  results <- mapply(function(i){
    sample(begin[i]:end[i], num_of_arrivals*probs[i], replace = TRUE)
  }, 1:length(begin), SIMPLIFY = TRUE)

  #unlist the results to turn it into a vector
  results <- sort(unlist(results))
}

This code operates by selecting an interval and generating the arrival times for the percentage of the agents required within that interval. The interval changes, the percentage of agents to generate changes and a new set of arrival times are computed. This process repeats itself for all valid intervals. Once all intervals have been computed, the sorted concatenation is returned as the arrival times. We call this a hybrid inverse transform as randomly generated values are used to generate the arrival times, but in blocks rather than individually.

We can see the code in action by setting the quarter, retrieving the attendance and generating the arrivals. We define the distribution \(\lambda(t)\) in a linear vector format for easy computation.

#set the operating quarter and grab the attendance
quarter <- "q1"
num_of_arrivals <- get_attendance(1, quarter) #1 indicates we want a single value returned
#set the begin and ending times along with the percentage of agents expected during that interval
begin = c(0, 3, 6, 12) * 60 * 60 #time in seconds
end = c(3, 6, 12, 13) * 60 * 60 #time in seconds
probs = c(0.15, 0.7, 0.14, 0.01)

#generate agent arrivals
agent_arrivals <- generate_arrivals(num_of_arrivals, begin, end, probs)

Testing: No formal testing done as functions are trivial. Eye-test used to check that arrival times generated matched the proposed model (see the histogram below).

hist(agent_arrivals)

Modeling: Agent Entry

Agents may enter the park through any open turnstile. Entry into the park includes picking a turnstile line, waiting to get to the turnstile (i.e. time time required to reach the turnstile) and the service time at the turnstile. We define a deterministic mechanistic model of turnstile operation. Each agent takes ten (10) seconds to scan their ticket and proceed through the turnstile. The wait time to reach a turnstile is equal to the service times of all the agents currently waiting to be served \(\mu \cdot n\) plus the time remaining until the agent currently being served is finished \(t_f - t_c\), where \(t_f\) is the finish time of the agent currently being served and \(t_c\) is the current time within the simulation. Mathematically, \(w(t) = (t_f - t_c) + (\mu \cdot n)\) where \(n\) is the number of agents waiting to be served. Agents will select the queue that currently has the lowest number of waiting agents. This model is deterministic as it is not subject to any stochastic process and is mechanistic as it is based upon how individuals actually enter a park.

In code, we define this model as:

turnstile_service_time = 10 #5 seconds

And we define a turnstile object as follows:

Turnstile <- R6::R6Class(
  "Turnstile",
  inherit = SimpleQueue
)

As one can see, we defined the Turnstile class in terms of the SimpleQueue class since a turnstile is nothing more than a single service queue. The SimpleQueue class is a simulation construct that implements a single server queue. We define such a construct below.

Testing: Since the Turnstile class inherits from the SimpleQueue class, we perform all testing on the SimpleQueue class.

Simulation: SimpleQueue

We define a queue object called SimpleQueue which handles the queuing process. The queue allows you to specify an id and a service time. After instantiation, the queue allows you to add agents, remove agents, and calculate the wait time if you were to enter the queue at the provided time. We define this in code as follows:

SimpleQueue <- R6::R6Class(
  "SimpleQueue",

  public = list(
    initialize = function(id, service_time){

      #initialize with unique turnstile id and zero agents waiting
      private$.id <- id
      private$.service_time <- service_time
      private$.agents_waiting <- 0
    },

    add_agent = function(current_time){
      if(!missing(current_time)){
        private$.agents_waiting <- private$.agents_waiting + 1

        if(is.na(private$.service_complete_at)){
          private$.service_complete_at <- current_time + private$.service_time
        }
      } else {
        stop("Cannot add agent without knowing the current time\n")
      }
      invisible(self)
    },

    remove_agent = function(){

      private$.agents_waiting = private$.agents_waiting - 1
      private$.service_complete_at <- private$.service_complete_at + private$.service_time

      if (private$.agents_waiting <= 0){
        private$.agents_waiting = 0
        private$.service_complete_at <- NA
      }

      invisible(self)
    },

    calculate_wait_time = function(current_time){
      if(missing(current_time)){
        stop("Cannot calculate current wait time without current time\n")
      } else {
        current_wait_time <- (private$.service_time * (private$.agents_waiting - 1)) +
          (private$.service_complete_at - current_time)

        #if we return a negative wait time, that means no one is in line, so
        #replace with zero
        if (is.na(current_wait_time) || current_wait_time < 0){
          current_wait_time <- 0
        }

        return(current_wait_time)
      }
    }
  ),

  active = list(
    id = function(value){
      if(missing(value)){
        private$.id
      } else{
        stop("Cannot set `$turnstile_id` after instantiation\n")
      }
    },

    service_time = function(value){
      if(missing(value)){
        private$.service_time
      } else{
        stop("Cannot change `$service_time` after instantiation\n")
      }
    },

    agents_waiting = function(value){
      if(missing(value)){
        private$.agents_waiting
      } else {
        stop("Cannot set `$agents_waiting`\n")
      }
    },

    service_complete_at = function(value){
      if(missing(value)){
        private$.service_complete_at
      } else{
        stop("cannot set `$service_complete_at`, use `$add_agent\n`")
      }
    }
  ),

  private = list(
    .id = -1,
    .service_time = -1,
    .agents_waiting = -1,
    .service_complete_at = NA
  )
)

Testing: Testing for the SimpleQueue class was performed via unit testing the results of which are included as part of the accompanying website (http://projects.jamesonmorgan.com/disneyworldsim/test_simplequeue.html).

Simulation: Master Event Queue

Before we can continue to build our model of a theme park, we must implement some mechanics to assist in the running of the simulation. We proceed to define an event record below.

The Event Record

An event record consists of the information necessary to process any of the events defined by the model. We define a class to handle the event record.

Event <- R6::R6Class(
  "Event",

  public = list(
    initialize = function(agent_id = NA, trigger_time, arrive_park = NA, event_type,
                          remaining_attractions=NA, turnstile_chosen = NA,
                          remaining_dining = NA, attractions_visited = NA,
                          dining_visited = NA, attraction_index = NA){
      private$.agent_id <- agent_id
      private$.event_type <- event_type
      private$.trigger_time <- trigger_time
      private$.arrive_park <- arrive_park
      private$.remaining_attractions <- remaining_attractions
      private$.turnstile_chosen <- turnstile_chosen
      private$.remaining_dining <- remaining_dining
      private$.attractions_visited <- attractions_visited
      private$.dining_visited <- dining_visited
      private$.attraction_index <- attraction_index
      private$.data <- list()
    }
  ),

  active = list(
    agent_id = function(value){
      if(missing(value)){
        private$.agent_id
      } else{
        stop("Cannot set `$agent_id`\n")
      }
    },

    event_type = function(value){
      if(missing(value)){
        private$.event_type
      } else {
        private$.event_type <- value
      }
    },

    trigger_time = function(value){
      if(missing(value)){
        private$.trigger_time
      } else {
        private$.trigger_time <- value
      }
    },

    arrive_park = function(value){
      if(missing(value)){
        private$.arrive_park
      } else{
        stop("Cannot change `$arrive_park` after instantiation\n")
      }
    },

    retired = function(value){
      if(missing(value)){
        private$.retired
      } else{
        private$.retired <- value
      }
    },

    remaining_attractions = function(value){
      if(missing(value)){
        private$.remaining_attractions
      } else {
        private$.remaining_attractions <- value
      }
    },

    turnstile_chosen = function(value){
      if(missing(value)){
        private$.turnstile_chosen
      } else {
        private$.turnstile_chosen <- value
      }
    },

    remaining_dining = function(value){
      if(missing(value)){
        private$.remaining_dining
      } else{
        private$.remaining_dining <- value
      }
    },

    attractions_visited = function(value){
      if(missing(value)){
        Filter(Negate(is.na),private$.attractions_visited)
      } else{
        private$.attractions_visited <- c(private$.attractions_visited, value)
      }
    },

    dining_visited = function(value){
      if(missing(value)){
        Filter(Negate(is.na),private$.dining_visited)
      } else{
        private$.dining_visited <- c(private$.dining_visited, value)
      }
    },

    attraction_index = function(value){
      if(missing(value)){
        private$.attraction_index
      } else{
        private$.attraction_index <- value
      }
    },

    data = function(value){
      if(missing(value)){
        private$.data
      } else{
        private$.data <- append(private$.data, value)
      }
    }
  ),

  private = list(
    .agent_id = -1,
    .event_type = -1,
    .trigger_time = NA,
    .arrive_park = NA,
    .remaining_attractions = -1,
    .retired = FALSE,
    .turnstile_chosen = NA,
    .remaining_dining = NA,
    .attractions_visited = NA,
    .dining_visited = NA,
    .attraction_index = NA,
    .data = NULL
  )
)

As you can see there are a number of fields associated with an event. One such field is the event type. An event type is an integer specifying the kind of event that will be occurring at the trigger time. Going back to the model of a theme park, we define the following event types:

  • event_arrive_park

  • event_enter_park

  • event_leave_park

  • event_leave_dining

  • event_process_attraction

  • event_choose_experience

  • event_choose_attraction

  • event_choose_dining

In code, we assign each event a numeric value (code):

event_arrive_park = 1
event_enter_park = 2
event_leave_park = 30
event_leave_dining = 31
event_leave_ride = 32
event_process_attraction = 40
event_choose_experience = 50
event_choose_attraction = 51
event_choose_dining = 52

The trigger_time field indicates when the event denoted by event_type is triggered. The agent_id field is a unique agent id provided to each agent on arrival and the arrive_park field denotes the arrival time of the agent at the park. The remaining_attractions and remaining_dining fields indicate the number of attractions and dining experiences that an agent still needs to visit, respectively. The attractions_visited and dining_visited fields provide a storage container for the ids of the attractions and dining experiences visited by the agent, respectively. retired indicates whether the event record has been retired (i.e. no longer active). The turnstile_chosen field indicates which turnstile an agent utilized to enter the park. The attraction_index field is used by attractions when creating event records to indicate which attraction they are. The data field is currently unused and is provided for future use.

It is important to note that not every event record will use all of the fields. For example, an agent creating an event record will utilize the arrival time field, however, an attraction scheduling its next departure will not utilize the arrival time field. The event record is simply a storage container for communicating events between time steps with the exact fields used determined by the type of object creating the event.

Testing: No formal testing performed as the Event class is simple a storage container with getter/setter methods.

The Master Event Queue

Now that we have defined the event record, we need a data structure that can hold the event records and allow for easy retrieval of the next event based upon the trigger_time field. We use a priority queue data structure implemented using a min heap (note that we implement the queue as a Fibonacci heap due to its better performance). In code, we implement the master event queue as follows:

master_event_queue <- datastructures::fibonacci_heap("integer")

We now must generate and instantiate the agent arrivals based upon the generated agent arrival times. We do this by placing an event record into the master event queue. In code, we perform the following:

#instantiate a progress bar
pb <- progress::progress_bar$new(total = length(agent_arrivals))

#load master event queue with arrivals
#Event$new(<id>, <trigger_time>, <arrival_time>, <event_type>)
invisible(
  events <- mapply(function(i){
    pb$tick()
    Event$new(agent_id = i, trigger_time = agent_arrivals[i], 
              arrive_park = agent_arrivals[i], 
              event_type = event_arrive_park)
  }, 1:length(agent_arrivals))
)
## [>-----------------------------------------------------------------] 1%
## [>-----------------------------------------------------------------] 2%
## [=>----------------------------------------------------------------] 2%
## [=>----------------------------------------------------------------] 3%
## [=>----------------------------------------------------------------] 4%
## [==>---------------------------------------------------------------] 4%
## [==>---------------------------------------------------------------] 5%
## [===>--------------------------------------------------------------] 5%
## [===>--------------------------------------------------------------] 6%
## [===>--------------------------------------------------------------] 7%
## [====>-------------------------------------------------------------] 7%
## [====>-------------------------------------------------------------] 8%
## [=====>------------------------------------------------------------] 8%
## [=====>------------------------------------------------------------] 9%
## [=====>------------------------------------------------------------] 10%
## [======>-----------------------------------------------------------] 10%
## [======>-----------------------------------------------------------] 11%
## [=======>----------------------------------------------------------] 11%
## [=======>----------------------------------------------------------] 12%
## [=======>----------------------------------------------------------] 13%
## [========>---------------------------------------------------------] 13%
## [========>---------------------------------------------------------] 14%
## [=========>--------------------------------------------------------] 14%
## [=========>--------------------------------------------------------] 15%
## [=========>--------------------------------------------------------] 16%
## [==========>-------------------------------------------------------] 16%
## [==========>-------------------------------------------------------] 17%
## [===========>------------------------------------------------------] 17%
## [===========>------------------------------------------------------] 18%
## [===========>------------------------------------------------------] 19%
## [============>-----------------------------------------------------] 19%
## [============>-----------------------------------------------------] 20%
## [=============>----------------------------------------------------] 20%
## [=============>----------------------------------------------------] 21%
## [=============>----------------------------------------------------] 22%
## [==============>---------------------------------------------------] 22%
## [==============>---------------------------------------------------] 23%
## [===============>--------------------------------------------------] 23%
## [===============>--------------------------------------------------] 24%
## [===============>--------------------------------------------------] 25%
## [================>-------------------------------------------------] 25%
## [================>-------------------------------------------------] 26%
## [================>-------------------------------------------------] 27%
## [=================>------------------------------------------------] 27%
## [=================>------------------------------------------------] 28%
## [==================>-----------------------------------------------] 28%
## [==================>-----------------------------------------------] 29%
## [==================>-----------------------------------------------] 30%
## [===================>----------------------------------------------] 30%
## [===================>----------------------------------------------] 31%
## [====================>---------------------------------------------] 31%
## [====================>---------------------------------------------] 32%
## [====================>---------------------------------------------] 33%
## [=====================>--------------------------------------------] 33%
## [=====================>--------------------------------------------] 34%
## [======================>-------------------------------------------] 34%
## [======================>-------------------------------------------] 35%
## [======================>-------------------------------------------] 36%
## [=======================>------------------------------------------] 36%
## [=======================>------------------------------------------] 37%
## [========================>-----------------------------------------] 37%
## [========================>-----------------------------------------] 38%
## [========================>-----------------------------------------] 39%
## [=========================>----------------------------------------] 39%
## [=========================>----------------------------------------] 40%
## [==========================>---------------------------------------] 40%
## [==========================>---------------------------------------] 41%
## [==========================>---------------------------------------] 42%
## [===========================>--------------------------------------] 42%
## [===========================>--------------------------------------] 43%
## [============================>-------------------------------------] 43%
## [============================>-------------------------------------] 44%
## [============================>-------------------------------------] 45%
## [=============================>------------------------------------] 45%
## [=============================>------------------------------------] 46%
## [==============================>-----------------------------------] 46%
## [==============================>-----------------------------------] 47%
## [==============================>-----------------------------------] 48%
## [===============================>----------------------------------] 48%
## [===============================>----------------------------------] 49%
## [================================>---------------------------------] 49%
## [================================>---------------------------------] 50%
## [================================>---------------------------------] 51%
## [=================================>--------------------------------] 51%
## [=================================>--------------------------------] 52%
## [==================================>-------------------------------] 52%
## [==================================>-------------------------------] 53%
## [==================================>-------------------------------] 54%
## [===================================>------------------------------] 54%
## [===================================>------------------------------] 55%
## [====================================>-----------------------------] 55%
## [====================================>-----------------------------] 56%
## [====================================>-----------------------------] 57%
## [=====================================>----------------------------] 57%
## [=====================================>----------------------------] 58%
## [======================================>---------------------------] 58%
## [======================================>---------------------------] 59%
## [======================================>---------------------------] 60%
## [=======================================>--------------------------] 60%
## [=======================================>--------------------------] 61%
## [========================================>-------------------------] 61%
## [========================================>-------------------------] 62%
## [========================================>-------------------------] 63%
## [=========================================>------------------------] 63%
## [=========================================>------------------------] 64%
## [==========================================>-----------------------] 64%
## [==========================================>-----------------------] 65%
## [==========================================>-----------------------] 66%
## [===========================================>----------------------] 66%
## [===========================================>----------------------] 67%
## [============================================>---------------------] 67%
## [============================================>---------------------] 68%
## [============================================>---------------------] 69%
## [=============================================>--------------------] 69%
## [=============================================>--------------------] 70%
## [==============================================>-------------------] 70%
## [==============================================>-------------------] 71%
## [==============================================>-------------------] 72%
## [===============================================>------------------] 72%
## [===============================================>------------------] 73%
## [================================================>-----------------] 73%
## [================================================>-----------------] 74%
## [================================================>-----------------] 75%
## [=================================================>----------------] 75%
## [=================================================>----------------] 76%
## [=================================================>----------------] 77%
## [==================================================>---------------] 77%
## [==================================================>---------------] 78%
## [===================================================>--------------] 78%
## [===================================================>--------------] 79%
## [===================================================>--------------] 80%
## [====================================================>-------------] 80%
## [====================================================>-------------] 81%
## [=====================================================>------------] 81%
## [=====================================================>------------] 82%
## [=====================================================>------------] 83%
## [======================================================>-----------] 83%
## [======================================================>-----------] 84%
## [=======================================================>----------] 84%
## [=======================================================>----------] 85%
## [=======================================================>----------] 86%
## [========================================================>---------] 86%
## [========================================================>---------] 87%
## [=========================================================>--------] 87%
## [=========================================================>--------] 88%
## [=========================================================>--------] 89%
## [==========================================================>-------] 89%
## [==========================================================>-------] 90%
## [===========================================================>------] 90%
## [===========================================================>------] 91%
## [===========================================================>------] 92%
## [============================================================>-----] 92%
## [============================================================>-----] 93%
## [=============================================================>----] 93%
## [=============================================================>----] 94%
## [=============================================================>----] 95%
## [==============================================================>---] 95%
## [==============================================================>---] 96%
## [===============================================================>--] 96%
## [===============================================================>--] 97%
## [===============================================================>--] 98%
## [================================================================>-] 98%
## [================================================================>-] 99%
## [=================================================================>] 99%
## [=================================================================>] 100%
## [==================================================================] 100%
invisible(
  #insert objects into priority queue
  datastructures::insert(master_event_queue, as.integer(agent_arrivals), events)
)

#no longer need the events list, they are stored in the master_event_queue
rm(events)

Testing: No formal testing performed on priority queue as we utilized the datastructures package within R to create the min heap. Ad-hoc testing performed to ensure that the trigger times of the items added to the queue matched the arrival times.

Simulation: 1st Pass at Processing Events

We now implement the simulation code to handle the simulation of the theme park. As of now, the only events we have built into the model are the arrival of agents, the processing of agents through turnstiles and the departure of agents from the park. Of course, this is not the complete simulation, but we start with the above and will expand it to handle the additional cases of the simulation as we build them into our model. Before creating the model, we define a few helper functions to assist us during the simulation.

First, we define a utility function that helps choose the turnstile an agent should enter.

choose_turnstile <- function(turnstiles, rule){
  if (rule == "shortest"){
    shortest <- 1 #index into turnstiles, not necessarily turnstile id
    line_length <- turnstiles[[shortest]]$agents_waiting

    #find the first shortest line
    for (i in 1:length(turnstiles)){
      if (turnstiles[[i]]$agents_waiting < line_length){
        shortest <- i
        line_length <- turnstiles[[i]]$agents_waiting
      }
    }

    return(shortest)
  }
}

Testing: The choose_turnstile() function is unit tested and the results can be found on the accompanying website (http://projects.jamesonmorgan.com/disneyworldsim/test_choose_turnstile.html).

We also define a utility function that helps us determine the layover for an agent (time spent waiting to be serviced plus the service time).

layover <- function(turnstile, time){
  return(turnstile$calculate_wait_time(time) + turnstile$service_time)
}

Testing: No formal testing performed as function performs trivial addition.

Finally, we design the simulation as follows:

#define the endtime of the simulation
simulation_end_time = 10 * 60#10 minutes

#define the number of turnstiles to keep open and the rule
num_of_turnstiles <- 1
turnstile_rule <- "shortest"

#log info
logging = TRUE
filepath = file.path("..","..","logs","sim_log.txt")
write(NULL,filepath) #clears log file

#static departure time 
#right now as soon as the agent gets into the park it waits for the time specified below
#until it leaves
static_departure_time = 1.2 * 60#1.2 minutes

#instantiate turnstiles
turnstiles <- mapply(function(i){
    Turnstile$new(i, turnstile_service_time)
  }, 1:num_of_turnstiles)

We run the simulation below.

#instantiate current time by setting it equal to the very first item in the master event queue
cur_time = datastructures::peek(master_event_queue)[[1]]$trigger_time

#setup header
write(paste("cur_time", "agent_id", "trig_event_type", "next_trigger_time", "next_event_type","arrive_park",
            "turnstile_chosen","rem_attractions", "retired", sep = ","), file = filepath)

#perform the simulation until we go past the simulation end time or we run out of simulation events
while (!is.null(cur_time) && cur_time < simulation_end_time){

  #output the current time so you can know where in the simulation you are
  if (logging){
    cat(paste("\r\014Current Time:", cur_time))
  }

  #grab the next event record and save the triggering event for logging purposes
  event <- datastructures::pop(master_event_queue)[[1]]

  if (logging){
    triggering_event_type <- event$event_type
  }

  if (event$event_type == event_arrive_park){
    #agent has arrived at park so,

    #pick the shortest line and add it to the event record
    shortest_line <- choose_turnstile(turnstiles, turnstile_rule)
    event$turnstile_chosen <- shortest_line

    #schedule next event -> what time is it now + layover
    event$event_type <- event_enter_park
    event$trigger_time <- event$trigger_time + layover(turnstiles[[shortest_line]], cur_time)

    #place the agent into the line at the current time
    turnstiles[[shortest_line]]$add_agent(cur_time)

  } else if (event$event_type == event_enter_park){
    #agent has entered park so,

    #remove agent from turnstile line (we know the turnstile used based upon event record)
    turnstiles[[event$turnstile_chosen]]$remove_agent()

    #schedule next event
    #at the moment it uses a static departure time
    event$event_type <- event_leave_park
    event$trigger_time <- event$trigger_time + static_departure_time

  } else if (event$event_type == event_leave_park){
    #agent is leaving park so,

    #set the next event and trigger time to NA, retire the event record
    event$event_type <- -1
    event$trigger_time <- NA
    event$retired <- TRUE

  } else{
    stop("Unknown event type\n")
  }

  #outputs the contents of the event record if logging is enabled
  if (logging){
    write(paste(cur_time, event$agent_id, triggering_event_type, event$trigger_time,
                event$event_type, event$arrive_park, event$turnstile_chosen,
                event$remaining_attractions, event$retired,
                sep = ","),
          file=filepath, append = TRUE)
  }

  #add the event record back to the priority queue if the event has not been
  #retired (i.e. the agent has left)
  if(!event$retired){
    datastructures::insert(master_event_queue, as.integer(event$trigger_time), event)
  }

  #advance time to the next event epoch
  cur_time <- datastructures::peek(master_event_queue)[[1]]$trigger_time

}

Results

Below are the results after running the simulation.

results <- read.csv("../../logs/sim_log.txt")
DT::datatable(results, colnames = c("Cur. Time", "Agent Id", "Trig. Event Type",
                                    "Next Trig. Time", " Next Event Type", 
                                    "Arrival @ Park", "Turnstile Chosen", 
                                    "Rem. Attractions", "Retired"))