close #66: enable set_capacity and set_queue_size

r-simmer · Jun 21, 2016 · e6a49a0 · e6a49a0
1 parent 5666466
commit e6a49a0
Show file tree

Hide file tree

Showing 26 changed files with 235 additions and 59 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -41,6 +41,8 @@ export(seize)
 export(seize_selected)
 export(select)
 export(set_attribute)
+export(set_capacity)
+export(set_queue_size)
 export(simmer)
 export(timeout)
 export(to)

diff --git a/NEWS.md b/NEWS.md
@@ -6,6 +6,7 @@
 * Batched generation: the generation function can return more than one interarrival value at a time (#65).
 * Add the option `queue_size_strict` to `add_resource` to guarantee the queue size limit with preemption (#59).
 * New `select`, `seize_selected` and `release_selected` activities (#52).
+* Modify resources (capacity, queue size) from inside a trajectory (#66).
 
 ## Minor changes and fixes:
 

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -65,10 +65,18 @@ get_n_generated_ <- function(sim_, name_) {
     .Call('simmer_get_n_generated_', PACKAGE = 'simmer', sim_, name_)
 }
 
+set_capacity_ <- function(sim_, name_, value_) {
+    invisible(.Call('simmer_set_capacity_', PACKAGE = 'simmer', sim_, name_, value_))
+}
+
 get_capacity_ <- function(sim_, name_) {
     .Call('simmer_get_capacity_', PACKAGE = 'simmer', sim_, name_)
 }
 
+set_queue_size_ <- function(sim_, name_, value_) {
+    invisible(.Call('simmer_set_queue_size_', PACKAGE = 'simmer', sim_, name_, value_))
+}
+
 get_queue_size_ <- function(sim_, name_) {
     .Call('simmer_get_queue_size_', PACKAGE = 'simmer', sim_, name_)
 }

diff --git a/R/simulator.R b/R/simulator.R
@@ -222,12 +222,28 @@ Simmer <- R6Class("simmer",
       get_n_generated_(private$sim_obj, evaluate_value(name))
     },
 
-    get_capacity = function(name) { 
+    set_capacity = function(name, value) { 
+      name <- evaluate_value(name)
+      value <- evaluate_value(value)
+      value <- replace(value, value==Inf, -1)
+      set_capacity_(private$sim_obj, name, value)
+      self
+    },
+
+    get_capacity = function(name) {
       ret <- get_capacity_(private$sim_obj, evaluate_value(name))
       if (ret < 0) ret <- Inf
       ret
     },
 
+    set_queue_size = function(name, value) { 
+      name <- evaluate_value(name)
+      value <- evaluate_value(value)
+      value <- replace(value, value==Inf, -1)
+      set_queue_size_(private$sim_obj, name, value)
+      self
+    },
+
     get_queue_size = function(name) {
       ret <- get_queue_size_(private$sim_obj, evaluate_value(name))
       if (ret < 0) ret <- Inf
@@ -266,7 +282,7 @@ Simmer <- R6Class("simmer",
 #' \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 #' 
 #' @examples
@@ -307,7 +323,7 @@ simmer <- function(name="anonymous", verbose=FALSE) Simmer$new(name, verbose)
 #' \link{simmer}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 reset <- function(env) env$reset()
 
@@ -322,7 +338,7 @@ reset <- function(env) env$reset()
 #' \link{simmer}, \link{reset}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 now <- function(env) env$now()
 
@@ -339,7 +355,7 @@ now <- function(env) env$now()
 #' \link{simmer}, \link{reset}, \link{now}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 peek <- function(env, steps=1, verbose=FALSE) env$peek(steps, verbose)
 
@@ -354,7 +370,7 @@ peek <- function(env, steps=1, verbose=FALSE) env$peek(steps, verbose)
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 onestep <- function(env) env$step()
 
@@ -370,7 +386,7 @@ onestep <- function(env) env$step()
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 run <- function(env, until=1000) env$run(until)
 
@@ -402,7 +418,7 @@ run <- function(env, until=1000) env$run(until)
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 add_resource <- function(env, name, capacity=1, queue_size=Inf, mon=TRUE, preemptive=FALSE, 
                          preempt_order=c("fifo", "lifo"), queue_size_strict=FALSE)
@@ -424,7 +440,7 @@ add_resource <- function(env, name, capacity=1, queue_size=Inf, mon=TRUE, preemp
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 add_generator <- function(env, name_prefix, trajectory, dist, mon=1)
   env$add_generator(name_prefix, trajectory, dist, mon)
@@ -441,7 +457,7 @@ add_generator <- function(env, name_prefix, trajectory, dist, mon=1)
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 get_mon_arrivals <- function(envs, per_resource=FALSE) 
   envs_apply(envs, "get_mon_arrivals", per_resource)
@@ -457,7 +473,7 @@ get_mon_arrivals <- function(envs, per_resource=FALSE)
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 get_mon_attributes <- function(envs) envs_apply(envs, "get_mon_attributes")
 
@@ -473,7 +489,7 @@ get_mon_attributes <- function(envs) envs_apply(envs, "get_mon_attributes")
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 get_mon_resources <- function(envs, data=c("counts", "limits")) envs_apply(envs, "get_mon_resources", data)
 
@@ -489,13 +505,30 @@ get_mon_resources <- function(envs, data=c("counts", "limits")) envs_apply(envs,
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 get_n_generated <- function(env, name) env$get_n_generated(name)
 
+#' Set the capacity
+#'
+#' Sets a resource's capacity by name.
+#' 
+#' @param env the simulation environment.
+#' @param name the name of the resource.
+#' @param value new capacity.
+#' 
+#' @return Returns the simulation environment.
+#' @seealso Other methods for dealing with a simulation environment:
+#' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
+#' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
+#' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
+#' \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
+#' @export
+set_capacity <- function(env, name, value) env$set_capacity(name, value)
+
 #' Get the capacity
 #'
-#' Gets the capacity of a resource by name.
+#' Gets a resource's capacity by name.
 #' 
 #' @param env the simulation environment.
 #' @param name the name of the resource.
@@ -505,13 +538,30 @@ get_n_generated <- function(env, name) env$get_n_generated(name)
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_queue_size},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 get_capacity <- function(env, name) env$get_capacity(name)
 
+#' Set the queue size
+#'
+#' Sets a resource's queue size by name.
+#' 
+#' @param env the simulation environment.
+#' @param name the name of the resource.
+#' @param value new queue size.
+#' 
+#' @return Returns the simulation environment.
+#' @seealso Other methods for dealing with a simulation environment:
+#' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
+#' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
+#' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
+#' \link{set_capacity}, \link{get_server_count}, \link{get_queue_count}.
+#' @export
+set_queue_size <- function(env, name, value) env$set_queue_size(name, value)
+
 #' Get the queue size
 #'
-#' Gets the queue size of a resource by name.
+#' Gets a resource's queue size by name.
 #' 
 #' @param env the simulation environment.
 #' @param name the name of the resource.
@@ -521,7 +571,7 @@ get_capacity <- function(env, name) env$get_capacity(name)
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity},
-#' \link{get_server_count}, \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}, \link{get_queue_count}.
 #' @export
 get_queue_size <- function(env, name) env$get_queue_size(name)
 
@@ -537,7 +587,7 @@ get_queue_size <- function(env, name) env$get_queue_size(name)
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_queue_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_queue_count}.
 #' @export
 get_server_count <- function(env, name) env$get_server_count(name)
 
@@ -553,6 +603,6 @@ get_server_count <- function(env, name) env$get_server_count(name)
 #' \link{simmer}, \link{reset}, \link{now}, \link{peek}, \link{onestep}, \link{run}, 
 #' \link{add_resource}, \link{add_generator}, \link{get_mon_arrivals}, \link{get_mon_attributes},
 #' \link{get_mon_resources}, \link{get_n_generated}, \link{get_capacity}, \link{get_queue_size},
-#' \link{get_server_count}.
+#' \link{set_capacity}, \link{set_queue_size}, \link{get_server_count}.
 #' @export
 get_queue_count <- function(env, name) env$get_queue_count(name)
diff --git a/TODO b/TODO
@@ -2,7 +2,6 @@
  - split resource into queue and server (release 4.0.0?)
  - split the package into core and graphics (release 4.0.0?)
  - start/stop a generator from inside a trajectory
- - modify resources from inside a trajectory
  - implement a parallel branch activity
  - del_generator, del_resource?
  - add[del]_container (see simpy.resources.container)

diff --git a/man/add_generator.Rd b/man/add_generator.Rd
diff --git a/man/add_resource.Rd b/man/add_resource.Rd
diff --git a/man/get_capacity.Rd b/man/get_capacity.Rd
diff --git a/man/get_mon_arrivals.Rd b/man/get_mon_arrivals.Rd
diff --git a/man/get_mon_attributes.Rd b/man/get_mon_attributes.Rd
diff --git a/man/get_mon_resources.Rd b/man/get_mon_resources.Rd
diff --git a/man/get_n_generated.Rd b/man/get_n_generated.Rd
diff --git a/man/get_queue_count.Rd b/man/get_queue_count.Rd
diff --git a/man/get_queue_size.Rd b/man/get_queue_size.Rd
diff --git a/man/get_server_count.Rd b/man/get_server_count.Rd
diff --git a/man/now.Rd b/man/now.Rd
diff --git a/man/onestep.Rd b/man/onestep.Rd
diff --git a/man/peek.Rd b/man/peek.Rd