The following code is the simulation file ran to produce the output that is analyzed to answer the what-if questions. This code was made to run in parallel in order to increase efficiency.

Setup

The following code should be ran to provide reproducibility.

Load Required Code Modules

get_daily_average() function:

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

get_attendance() function:

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

generate_arrivals() function:

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

Generate Agent Arrivals

Next, we setup the agent arrivals.

#set the operating quarter and grab the attendance
quarter <- "q2"
num_of_arrivals <- get_attendance(1, quarter) #1 indicates we want a single value returned

Then we generate the arrivals in accordance with the arrival distribution.

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

Setup Simulation

Now we setup the simulation.

#used for parallel processing
library(doParallel)

#parameters for the generate_route_length() function
route_length_mean = 10 #average number of attractions to visit
route_length_std = 2
required_dining = 1
constant_departure = 10*60 #10 minutes in seconds

#set the simulation end time
simulation_end_time = 13*60*60 #13 hours in seconds (the operating time of the park)

#set the turnstile service time
turnstile_service_time = 10 #10 seconds

#define the number of turnstiles to keep open
max_num_of_turnstiles <- 50
turnstile_rule <- "shortest"

#registers the parallel processor with CPU cores, I used 3 here
doParallel::registerDoParallel(3)

#for each turnstile count perform 2 Monte-Carlo Simulations
foreach (a = 1:max_num_of_turnstiles) %:%
  foreach(b = 1:2, .packages = c("datastructures")) %dopar% {

    #source the files so that the parallel structures have access to them
    source("../../R/simplequeue.R") #queue
    source("../../R/modeling_agent_entry.R") #turnstile
    source("../../R/attraction.R") #attraction
    source("../../R/dining.R") #dining experience
    source("../../R/event_record.R") #the event record and event codes
    source("../../R/line.R") #the line object
    source("../../R/choose_turnstile.R") #choose_turnstile function
    source("../../R/extract_data.R") #functions to generate attractions and dining from data
    source("../../R/modeling_departures.R") #determines how many attractions to visit
    
    #log info
    logging = TRUE
    filepath = file.path("..","..","logs",paste0("sim_log_", a, "_", b, ".txt"))
    
    #instantiate turnstiles
    turnstiles <- mapply(function(i){
    Turnstile$new(i, turnstile_service_time)
    }, 1:a)
    
    #setup master event queue
    master_event_queue <- datastructures::fibonacci_heap("integer")
    
    #load master event queue with the attraction's next pickup of agents (i.e. the duration)
    invisible(
    mapply(function(i){
      event <- Event$new(trigger_time = magic_kingdom_attractions[[i]]$duration,
                         event_type = event_process_attraction,
                         attraction_index = i)
      datastructures::insert(master_event_queue, event$trigger_time, event)
    }, 1:length(magic_kingdom_attractions))
    )
    
    #load master event queue with arrivals
    invisible(
    mapply(function(i){
      datastructures::insert(master_event_queue, as.integer(agent_arrivals[i]),
                             Event$new(agent_id = i,
                                       trigger_time = agent_arrivals[i],
                                       arrive_park = agent_arrivals[i],
                                       event_type = event_arrive_park,
                                       remaining_attractions =
                                         generate_route_length(1, route_length_mean,
                                                               route_length_std),
                                       remaining_dining = required_dining
                             ))
    }, 1:length(agent_arrivals))
    )
    
    #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 output
    write(paste("cur_time", "agent_id", "attr_index","trig_event_type", "next_trigger_time",
              "next_event_type", "turnstile_chosen", "rem_attractions", "rem_dining",
              "attr_visited", "dining_visited", "arrive_park","retired",
              sep = ","), file = filepath)
    
    #perform the simulation until we go past the simulation end time or we run out of simulation events
    #this code comes from the simulation file built but was reproduced here for simplicity
    while (!is.null(cur_time) && (cur_time < simulation_end_time)){
    
      #grab the next event record
      event <- datastructures::pop(master_event_queue)[[1]]
      
      #output the current time so you can know where in the simulation you are
      if (logging){
        #cat(paste("\r\014Current Time:", cur_time))
        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
        event$event_type <- event_enter_park
        event$trigger_time <- event$trigger_time + layover(turnstiles[[shortest_line]], cur_time)
      
        #place the agent into the line
        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
        turnstiles[[event$turnstile_chosen]]$remove_agent()
      
        #schedule next event (immediately upon entry)
        event$event_type <- event_choose_experience
      
      } else if (event$event_type == event_choose_experience){
      
        # if we still have to dine, determine if that time is now
        #experience_chosen = 0: choose attraction experience
        #experience_chosen = 1: choose dining experience
        #experience_chosen = -1: terminate
        if(event$remaining_dining > 0){
          #if we still have attractions remaining to visit, make the dining choice
          #based on a bionomial
          if (event$remaining_attractions > 0){
            #determine whether to visit an attraction or dining experience
            #based on bionomial distribution
            experience_chosen = rbinom(1, 1, 0.5)
          } else {
            #otherwise, all attractions have been visited so the only remaining
            #thing is to eat
            experience_chosen = 1
          }
        } else if (event$remaining_attractions > 0) {
          experience_chosen = 0
        } else {
          experience_chosen = -1
        }
      
        #determine where to send the event
        if (experience_chosen == 0){
          event$event_type <- event_choose_attraction
        } else if (experience_chosen == 1){
          event$event_type <- event_choose_dining
        } else {
          #change the event type as we are now ready to terminate after the constant
          #departure time
          event$event_type <- event_leave_park
          event$trigger_time <- event$trigger_time + constant_departure
        }
      } else if (event$event_type == event_choose_attraction){
      
        #randomly pick an attraction
        attraction_index <- sample.int(length(magic_kingdom_attractions), 1)
      
        #log which attraction we visited
        event$attractions_visited <- attraction_index
      
        #reduce the number of attraction
        event$remaining_attractions <- event$remaining_attractions - 1
      
        #retire the event
        event$retired <- TRUE
        event$trigger_time <- NA
        event$event_type <- event_leave_ride
      
        #add agent to attraction queue
        #note: if the `agent_id` field of the event is defined, the event record
        #doubles as an agent
        magic_kingdom_attractions[[attraction_index]]$line$add_agent(event)
      
      } else if (event$event_type == event_choose_dining){
      
        #randomly pick a dining experience
        dining_index <- sample.int(length(magic_kingdom_dining), 1)
      
        #determine the dining category
        cat_code <- magic_kingdom_dining[[dining_index]]$category_code
      
        #determine whether we have to check capacity
        if (cat_code == "table-service"){
          capacity <- magic_kingdom_dining[[dining_index]]$capacity
          cur_dining <- magic_kingdom_dining[[dining_index]]$currently_dining
          if(cur_dining < capacity){
            #log which dining experience was visited
            event$dining_visited <- dining_index
        
            #reduce the number of dining experiences
            event$remaining_dining <- event$remaining_dining - 1
      
            #add diner
            magic_kingdom_dining[[dining_index]]$add_diner()
      
            #draw service time
            service_time <- magic_kingdom_dining[[dining_index]]$service_time
      
            #set trigger time and next event type
            event$event_type <- event_leave_dining
            event$trigger_time <- event$trigger_time + service_time
          } else {
            #cannot dine at dining experience because of capacity, go back and choose
            #another experience
            event$event_type <- event_choose_experience
          }
        } else if (cat_code == "quick-service"){
          #log which dining experience was visited
          event$dining_visited <- dining_index
            
          #reduce the number of dining experiences
          event$remaining_dining <- event$remaining_dining - 1
      
          #draw service time
          service_time <- magic_kingdom_dining[[dining_index]]$service_time
      
          #set trigger time and next event type
          event$event_type <- event_choose_experience
          event$trigger_time <- event$trigger_time + service_time
        } else {
          stop("Invalid category code!")
        }
      } else if (event$event_type == event_leave_dining){
        #remove the diner
        magic_kingdom_dining[[event$dining_visited]]$remove_diner()
        event$event_type <- event_choose_experience
      } else if (event$event_type == event_leave_park){
        #agent is leaving park so,
      
        event$event_type <- -1
        event$trigger_time <- NA
        event$retired <- TRUE
      
      } else if (event$event_type == event_process_attraction){
        #an attraction needs to be processed so,
      
        #grab the attraction index, attraction batch size and the previous line size
        #(those waiting prior to the attraction departure)
        attraction_index <- event$attraction_index
        batch_size <- magic_kingdom_attractions[[attraction_index]]$batch_size
        previous_line_size <- magic_kingdom_attractions[[attraction_index]]$line$num_of_agents
      
        #simulate the attraction running by removing the waiting agents
        finished_agents <- magic_kingdom_attractions[[attraction_index]]$line$remove_agent(batch_size)
      
        #now, we have to reschedule all the popped off events
        if (length(finished_agents) > 0){
          invisible(mapply(function(i){
      
            #grab the ith event and,
            finished_event <- finished_agents[[i]]
      
            #update the next event type,
            finished_event$event_type <- event_leave_ride
      
            #come out of retirement (for the event gets added to the master event queue),
            finished_event$retired <- FALSE
      
            #set the trigger time for the above event
            #remember, we still have to simulate the ride by incorporating the duration
            #of the ride into the next trigger time
            finished_event$trigger_time <- cur_time +
              (magic_kingdom_attractions[[attraction_index]]$duration)
      
            #insert into master event queue
            datastructures::insert(master_event_queue,
                                   finished_event$trigger_time,
                                   finished_event)
          }, 1:length(finished_agents)))
        }
      
        #schedule the next attraction event
        #this is equal to the current time plus the duration of the ride
        event$trigger_time <- cur_time +
          (magic_kingdom_attractions[[attraction_index]]$duration)
      
      } else if (event$event_type == event_leave_ride){
        #agent has riden the ride, choose another attraction
      
        event$event_type <- event_choose_experience
      } 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, event$attraction_index,
                    triggering_event_type, event$trigger_time,
                    event$event_type, event$turnstile_chosen, event$remaining_attractions,
                    event$remaining_dining,
                    stringi::stri_c(event$attractions_visited, collapse = " "),
                    stringi::stri_c(event$dining_visited, collapse = " "),
                    event$arrive_park, 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
    }
  }