rsimulationevent-simulation

R simmer: custom logic for selecting server


I am building a simmer simulation for the delivery of vaccines via drone. Pseudocode up to the simulation part is:

  1. Generate N "demand points" in a geography, representing locations needing vaccines. Make into a dataframe. Add arrival times as a dataframe column. Add prioritization column - first come, first served.
  2. Use kmeans clustering to find K drone stations locations, across the geography
  3. Generate a N x K matrix representing travel time from each drone station, to each demand point

In the simulation, vaccine deliveries are arrivals, and drones are resources (server capacity 1, infinite queue capacity). I want the simulation to use this resource selection logic:

  1. When an arrival occurs, determine which drone(s) are available. Of those, select the drone that has the shortest travel time as determined by the travel time matrix.
  2. If all drones are currently utilized, new arrivals get put into a common queue. Whenever any drone becomes available, arrivals in the common queue take priority, with the oldest arrival in the queue taking first priority. This may mean that a vaccine is NOT delivered from the closest drone station.
  3. Once an arrival seize_selected the selected drone, timeout for the travel time, then release_selected that drone.

I'm trying to adapt the logic from Use routing logic when dispatching resources with simmer package (or an alternative) but is not working as anticipated.

Any help is appreciated. The really tricky part here to me, is putting the arrivals into a common queue, THEN selecting the fastest-available drone.
My current simulation code is:

delivery_env <- simmer()
delivery_traj <- trajectory("delivery") %>%

  
  set_attribute(c("min_drone_index", "min_drone_delay"), function() {
    # find available resources
  server_count <- numeric(drone_count)
    
    for (i in 1:length(server_count)){server_count[i] <- get_server_count(delivery_env, paste0("drone", i))   }
  
    #find index of minimum travel time, inclusive of server_count
  #since the capacity of each drone is 1, we want to find the drones
  #that have server_count == 1 and set them "very very far away" from the deliverypoint
  #so the ranking system puts them last
  
  #identify row of traveltime_matrix that corresponds to the delivery point
  #in traveltime_matrix, rows are vaccines, columns are drones
    k <- get_attribute(delivery_env, "arrival_index_index1")
    traveltime_vec <- traveltime_matrix[k, ]
    
    #make the currently-occupied drones, "very very far away"
    traveltime_vec[which(server_count==1)] <- traveltime_vec[which(server_count==1)]+ 9999999999
    
    #identify a single value for the minimum distance - more than 1 drone index may be the minimum
    #identify closest available. randomly sample if more than 1 is closest
    k <- which.min(traveltime_vec)
    min_drone_index <- sample(k,1)
    #the drone (resource) is seized for 2x the one-way travel time, plus time on the ground.
    min_drone_delay <- 2*traveltime_vec[min_drone_index] + delivery_ontheground_time_minutes 

    # take the nearest available resource. 

    return(c(min_drone_index, min_drone_delay))
  }) %>%
  
  simmer::select(function() paste0("drone", get_attribute(delivery_env, "min_drone_index"))) %>%
  seize_selected() %>%
  timeout_from_attribute("min_drone_delay") %>%
  release_selected() %>%
  #release("drone") %>%
  log_("Delivery Finished")
  
  

delivery_env <-
  simmer("drone") %>%
  add_resource(name= paste0("drone",seq(1,drone_count,1)), capacity=1) %>%
  add_dataframe(name_prefix='delivery',trajectory = delivery_traj, data=pointsdf,mon=2,batch=50,col_priority="priority",
  col_time = "absolute_time", time ="absolute",col_attributes = c("longitude","latitude","arrival_index_index1","arrival_index_index0"))
  
sim_out <- delivery_env %>% run()

Solution

  • You need an additional resource on top of that with capacity equal to the number of drones. That's your common queue. If you need your oldest arrival first, that's LIFO. Setting the priority value according to a counter function would achieve exactly that (or, if you set that priority in the source data frame, that works too). Putting everything together:

    prio_counter <- function() {
      i <- 0
      function() {
        i <<- i + 1
        c(i, NA, NA)
      }
    }
    
    delivery_traj <- trajectory("delivery") %>%
      set_prioritization(prio_counter()) %>%
      seize("common_queue") %>%
      set_attribute(c("min_drone_index", "min_drone_delay"), function() {
        ...
      }) %>%
      simmer::select(...) %>%
      seize_selected() %>%
      timeout_from_attribute("min_drone_delay") %>%
      release_selected() %>%
      release("common_queue") %>%
      log_("Delivery Finished")
    

    An aside: get_server_count() (as well as all the other getters) is vectorized, you don't need a loop there.