quick and dirty attempt at a priority resource queue (#20)

R/RcppExports.R

@@ -65,12 +65,12 @@ get_queue_count_ <- function(sim_, name_) {
     .Call('simmer_get_queue_count_', PACKAGE = 'simmer', sim_, name_)
 }
 
-Seize__new <- function(resource_, amount_) {
-    .Call('simmer_Seize__new', PACKAGE = 'simmer', resource_, amount_)
+Seize__new <- function(resource_, amount_, priority_) {
+    .Call('simmer_Seize__new', PACKAGE = 'simmer', resource_, amount_, priority_)
 }
 
-Seize__new_func <- function(resource_, amount, provide_attrs_) {
-    .Call('simmer_Seize__new_func', PACKAGE = 'simmer', resource_, amount, provide_attrs_)
+Seize__new_func <- function(resource_, amount, provide_attrs_, priority_) {
+    .Call('simmer_Seize__new_func', PACKAGE = 'simmer', resource_, amount, provide_attrs_, priority_)
 }
 
 Release__new <- function(resource_, amount_) {

R/trajectory.R

@@ -29,12 +29,12 @@ Trajectory <- R6Class("Trajectory",
 
     get_n_activities = function() { private$n_activities },
 
-    seize = function(resource, amount=1) {
+    seize = function(resource, amount=1, priority=0) {
       resource <- evaluate_value(resource)
       amount <- evaluate_value(amount)
       if (is.function(amount))
-        private$add_activity(Seize__new_func(resource, amount, needs_attrs(amount)))
-      else private$add_activity(Seize__new(resource, amount))
+        private$add_activity(Seize__new_func(resource, amount, needs_attrs(amount), priority))
+      else private$add_activity(Seize__new(resource, amount, priority))
     },
 
     release = function(resource, amount=1) {
@@ -206,7 +206,7 @@ get_n_activities <- function(traj) traj$get_n_activities()
 #' \link{get_tail}, \link{get_n_activities}, \link{release}, \link{timeout}, 
 #' \link{set_attribute}, \link{branch}, \link{rollback}.
 #' @export
-seize <- function(traj, resource, amount=1) traj$seize(resource, amount)
+seize <- function(traj, resource, amount=1, priority=0) traj$seize(resource, amount, priority)
 
 #' Add a release activity
 #'

src/RcppExports.cpp

@@ -197,27 +197,29 @@ BEGIN_RCPP
 END_RCPP
 }
 // Seize__new
-SEXP Seize__new(SEXP resource_, SEXP amount_);
-RcppExport SEXP simmer_Seize__new(SEXP resource_SEXP, SEXP amount_SEXP) {
+SEXP Seize__new(SEXP resource_, SEXP amount_, SEXP priority_);
+RcppExport SEXP simmer_Seize__new(SEXP resource_SEXP, SEXP amount_SEXP, SEXP priority_SEXP) {
 BEGIN_RCPP
     Rcpp::RObject __result;
     Rcpp::RNGScope __rngScope;
     Rcpp::traits::input_parameter< SEXP >::type resource_(resource_SEXP);
     Rcpp::traits::input_parameter< SEXP >::type amount_(amount_SEXP);
-    __result = Rcpp::wrap(Seize__new(resource_, amount_));
+    Rcpp::traits::input_parameter< SEXP >::type priority_(priority_SEXP);
+    __result = Rcpp::wrap(Seize__new(resource_, amount_, priority_));
     return __result;
 END_RCPP
 }
 // Seize__new_func
-SEXP Seize__new_func(SEXP resource_, Function amount, SEXP provide_attrs_);
-RcppExport SEXP simmer_Seize__new_func(SEXP resource_SEXP, SEXP amountSEXP, SEXP provide_attrs_SEXP) {
+SEXP Seize__new_func(SEXP resource_, Function amount, SEXP provide_attrs_, SEXP priority_);
+RcppExport SEXP simmer_Seize__new_func(SEXP resource_SEXP, SEXP amountSEXP, SEXP provide_attrs_SEXP, SEXP priority_SEXP) {
 BEGIN_RCPP
     Rcpp::RObject __result;
     Rcpp::RNGScope __rngScope;
     Rcpp::traits::input_parameter< SEXP >::type resource_(resource_SEXP);
     Rcpp::traits::input_parameter< Function >::type amount(amountSEXP);
     Rcpp::traits::input_parameter< SEXP >::type provide_attrs_(provide_attrs_SEXP);
-    __result = Rcpp::wrap(Seize__new_func(resource_, amount, provide_attrs_));
+    Rcpp::traits::input_parameter< SEXP >::type priority_(priority_SEXP);
+    __result = Rcpp::wrap(Seize__new_func(resource_, amount, provide_attrs_, priority_));
     return __result;
 END_RCPP
 }

src/activity.h

@@ -17,16 +17,19 @@ class Activity {
   std::string resource;
   bool provide_attrs;
   int n;
+  int priority;
 
   /**
    * Constructor.
    * @param name          the name of the activity
    * @param resource      the resource associated
    * @param provide_attrs whether the activity should expose the arrival's attributes
    */
-  Activity(std::string name, std::string resource, bool provide_attrs): 
+  Activity(std::string name, std::string resource, bool provide_attrs, int priority = 0): 
     name(name), resource(resource), provide_attrs(provide_attrs), 
-    n(1), next(NULL), prev(NULL) {}
+    n(1), priority(priority), next(NULL), prev(NULL)  {}
+
+
   virtual ~Activity(){}
 
   /**
@@ -68,8 +71,8 @@ class Activity {
 template <class T>
 class Seize: public Activity {
 public:
-  Seize(std::string resource, T amount, bool provide_attrs):
-    Activity("Seize", resource, provide_attrs), amount(amount) {}
+  Seize(std::string resource, T amount, bool provide_attrs, int priority):
+    Activity("Seize", resource, provide_attrs, priority), amount(amount) {}
 
   void show(int indent=0);
   double run(Arrival* arrival);

src/entity.cpp

@@ -70,7 +70,7 @@ int Resource::seize(Arrival* arrival, int amount) {
   // enqueue
   else if (room_in_queue(amount)) {
     queue_count += amount;
-    queue.push(std::make_pair(arrival, amount));
+    queue.push((RQItem){arrival, amount, arrival->activity->priority});
     return ENQUEUED;
   }
   // reject
@@ -86,8 +86,8 @@ int Resource::release(Arrival* arrival, int amount) {
 
   // serve from the queue
   if (queue_count) {
-    Arrival* another_arrival = queue.front().first;
-    int another_amount = queue.front().second;
+    Arrival* another_arrival = queue.top().arrival;
+    int another_amount = queue.top().amount;
     queue.pop();
     queue_count -= another_amount;
     server_count += another_amount;

src/entity.h

@@ -52,6 +52,7 @@ class Arrival: public Process {
 public:
   double start_time;    /**< generation time */
   double activity_time; /**< time spent doing something in the system (not waiting in a queue) */
+  Activity* activity; /**< current activity from an R trajectory */
 
   /**
    * Constructor.
@@ -63,6 +64,7 @@ class Arrival: public Process {
   Arrival(Simulator* sim, std::string name, int mon, Activity* first_activity, Generator* gen):
     Process(sim, name, mon), start_time(-1), activity_time(0), activity(first_activity), gen(gen) {}
 
+
   ~Arrival() { attributes.clear(); }
 
   void activate();
@@ -71,7 +73,6 @@ class Arrival: public Process {
   inline Attr* get_attributes() { return &attributes; }
 
 private:
-  Activity* activity; /**< current activity from an R trajectory */
   Generator* gen;     /**< parent generator */
   Attr attributes;    /**< user-defined (key, value) pairs */
 };
@@ -151,7 +152,21 @@ class Generator: public Process {
   AttrStats attr_stats;     /**< attribute statistics */
 };
 
-typedef std::queue<std::pair<Arrival*, int> > Queue;
+struct RQItem{
+  Arrival* arrival;
+  int amount;
+  int priority;
+};
+
+
+struct ResourceOrder {
+  bool operator()(const RQItem lhs, const RQItem rhs) const {
+    return lhs.priority < rhs.priority;
+  }
+};
+
+
+typedef std::priority_queue<RQItem, std::vector<RQItem>, ResourceOrder > RPQueue;
 
 /** 
  *  Generic resource, a passive entity that comprises server + FIFO queue.
@@ -180,7 +195,7 @@ class Resource: public Entity {
     server_count = 0;
     queue_count = 0;
     while (!queue.empty()) {
-      delete queue.front().first;
+      delete queue.top().arrival;
       queue.pop();
     }
     res_stats.clear();
@@ -224,7 +239,7 @@ class Resource: public Entity {
   int queue_size;
   int server_count;     /**< number of arrivals being served */
   int queue_count;      /**< number of arrivals waiting */
-  Queue queue;          /**< queue container */
+  RPQueue queue;          /**< queue container */
   ResStats res_stats;   /**< resource statistics */
 
   inline bool room_in_server(int amount) { 

src/simmer_rcpp.cpp

@@ -154,20 +154,22 @@ int get_queue_count_(SEXP sim_, SEXP name_){
 }
 
 //[[Rcpp::export]]
-SEXP Seize__new(SEXP resource_, SEXP amount_) {
+SEXP Seize__new(SEXP resource_, SEXP amount_, SEXP priority_) {
   std::string resource = as<std::string>(resource_);
   int amount = as<int>(amount_);
+  int priority = as<int>(priority_);
 
-  XPtr<Seize<int> > ptr(new Seize<int>(resource, amount, 0), false);
+  XPtr<Seize<int> > ptr(new Seize<int>(resource, amount, 0, priority), false);
   return ptr;
 }
 
 //[[Rcpp::export]]
-SEXP Seize__new_func(SEXP resource_, Function amount, SEXP provide_attrs_) {
+SEXP Seize__new_func(SEXP resource_, Function amount, SEXP provide_attrs_, SEXP priority_) {
   std::string resource = as<std::string>(resource_);
   bool provide_attrs = as<bool>(provide_attrs_);
+  int priority = as<int>(priority_);
 
-  XPtr<Seize<Function> > ptr(new Seize<Function>(resource, amount, provide_attrs), false);
+  XPtr<Seize<Function> > ptr(new Seize<Function>(resource, amount, provide_attrs, priority), false);
   return ptr;
 }
 

tests/testthat/test-simmer-resource.R

@@ -66,3 +66,50 @@ 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
+  t0 <- create_trajectory("nonprior") %>%
+    seize("server", 1, priority=0) %>%
+    timeout(2) %>%
+    release("server", 1)
+
+  t1 <- create_trajectory("prior") %>%
+    seize("server", 1, priority=1) %>%
+    timeout(2) %>%
+    release("server", 1)
+
+  env <- simmer() %>%
+    add_resource("server", 1) %>%
+    add_generator("__nonprior", t0, at(c(0, 1))) %>%
+    add_generator("__prior", t1, at(1)) %>% # should be served second
+    run()
+
+  resources <-
+    env%>%get_mon_arrivals()
+
+  expect_equal(resources[resources$name=="__prior0",]$end_time, 4) 
+
+    ### second run
+  t0 <- create_trajectory("nonprior") %>%
+    seize("server", 1, priority=0) %>%
+    timeout(2) %>%
+    release("server", 1)
+
+  t1 <- create_trajectory("prior") %>%
+    seize("server", 1, priority=1) %>%
+    timeout(2) %>%
+    release("server", 1)
+
+  env <- simmer() %>%
+    add_resource("server", 1) %>%
+    add_generator("__nonprior", t0, at(c(0, 0))) %>%
+    add_generator("__prior", t1, at(1)) %>% # should be served second
+    run()
+
+  resources <-
+    env%>%get_mon_arrivals()
+
+  expect_equal(resources[resources$name=="__prior0",]$end_time, 4) 
+
+})