FIFO processing for same priority level

R/trajectory.R

@@ -201,7 +201,7 @@ get_n_activities <- function(traj) traj$get_n_activities()
 #' @param traj the trajectory object.
 #' @param resource the name of the resource.
 #' @param amount the amount to seize.
-#' @oaram the priority of the seize (a higher integer equals higher priority, defaults to 0)
+#' @param the priority of the seize (a higher integer equals higher priority, defaults to 0)
 #' @return The trajectory object.
 #' @seealso Other methods to deal with trajectories:
 #' \link{create_trajectory}, \link{get_head},

src/entity.cpp

@@ -70,7 +70,7 @@ int Resource::seize(Arrival* arrival, int amount, int priority) {
   // enqueue
   else if (room_in_queue(amount)) {
     queue_count += amount;
-    queue.push((RQItem){arrival, amount, priority});
+    queue.push((RQItem){arrival, amount, priority, sim->now()});
     return ENQUEUED;
   }
   // reject

src/entity.h

@@ -154,12 +154,20 @@ struct RQItem{
   Arrival* arrival;
   int amount;
   int priority;
+  double arrived_at;
 };
 
 
 struct ResourceOrder {
   bool operator()(const RQItem lhs, const RQItem rhs) const {
-    return lhs.priority < rhs.priority;
+    if(lhs.priority == rhs.priority)
+    {
+      return lhs.arrived_at > rhs.arrived_at; 
+    }
+    else 
+    {
+      return lhs.priority < rhs.priority;  
+    }
   }
 };
 

tests/testthat/test-simmer-resource.R

@@ -67,8 +67,7 @@ test_that("resources are  correctly monitored", {
   expect_equal(resources[2,]$server, 1) # to be discussed: debatable whether or not it should equal 1 or 0
 })
 
-test_that("priority queues are adhered to", {
-  ### first run
+test_that("priority queues are adhered to (1)", {
   t0 <- create_trajectory("nonprior") %>%
     seize("server", 1, priority=0) %>%
     timeout(2) %>%
@@ -85,12 +84,15 @@ test_that("priority queues are adhered to", {
     add_generator("__prior", t1, at(1)) %>% # should be served second
     run()
 
-  resources <-
+  arrs <-
     env%>%get_mon_arrivals()
 
-  expect_equal(resources[resources$name=="__prior0",]$end_time, 4) 
+  expect_equal(arrs[arrs$name=="__prior0",]$end_time, 4) 
 
-    ### second run
+})
+
+
+test_that("priority queues are adhered to (2)", {
   t0 <- create_trajectory("nonprior") %>%
     seize("server", 1, priority=0) %>%
     timeout(2) %>%
@@ -107,9 +109,40 @@ test_that("priority queues are adhered to", {
     add_generator("__prior", t1, at(1)) %>% # should be served second
     run()
 
-  resources <-
+  arrs <-
     env%>%get_mon_arrivals()
 
-  expect_equal(resources[resources$name=="__prior0",]$end_time, 4) 
+  expect_equal(arrs[arrs$name=="__prior0",]$end_time, 4) 
+
+})
+
+
+
+test_that("priority queues are adhered to and same level priorities are processed FIFO", {
+  t0 <- create_trajectory("_t0_prior") %>%
+    seize("server", 1, priority=1) %>%
+    timeout(2) %>%
+    release("server", 1)
+
+  t1 <- create_trajectory("_t1_prior") %>%
+    seize("server", 1, priority=1) %>%
+    timeout(2) %>%
+    release("server", 1)
+
+  env <- simmer() %>%
+    add_resource("server", 1) %>%
+    add_generator("_t0_prior", t0, at(c(0, 2, 4, 6))) %>%
+    add_generator("_t1_prior", t1, at(c(1, 3, 5, 7))) %>%
+    run()
+
+  arrs <-
+    env%>%get_mon_arrivals()
+
+  arrs_ordered <-
+    arrs[order(arrs$end_time),]
+
+  expect_equal(as.character(arrs_ordered$name), 
+                c("_t0_prior0", "_t1_prior0", "_t0_prior1", "_t1_prior1", 
+                  "_t0_prior2", "_t1_prior2", "_t0_prior3", "_t1_prior3")) 
 
 })