examples/my-resource-3.rkt
#lang racket
;;; Example 3 - Data Collection

(require (planet williams/simulation/simulation-with-graphics))

(define-process* (my-resource (total-units 1))
                 (allocated-variable-n)
  (set-my-resource-allocated-variable-n! self (make-variable 0))
  (let ((allocations (make-hasheq))
        (allocated-units 0))
    (let loop ()
      (select
       ((accept caller (request (units 1))
          (let* ((current-allocation (hash-ref allocations caller 0))
                 (requested-allocation (+ current-allocation units))
                 (available-units (- total-units allocated-units)))
            (when (> requested-allocation total-units)
              (error 'request
                     "Total units requested ~a > total units ~a for ~s"
                     requested-allocation total-units caller))
            (if (<= units available-units)
                (begin
                  (hash-set! allocations caller requested-allocation)
                  (set! allocated-units (+ allocated-units units))
                  (set-variable-value!
                   (my-resource-allocated-variable-n self)
                   allocated-units))
                (requeue)))))
       ((accept caller (relinquish (units 1))
          (let* ((current-allocation (hash-ref allocations caller 0))
                 (remaining-allocation (- current-allocation units)))
            (when (< remaining-allocation 0)
              (error 'relinquish
                     "Units relinquished ~a > units allocated ~a for ~s"
                     units current-allocation caller))
            (if (= remaining-allocation 0)
                (hash-remove! allocations caller)
                (hash-set! allocations caller remaining-allocation))
            (set! allocated-units (- allocated-units units))
            (set-variable-value!
             (my-resource-allocated-variable-n self)
             allocated-units)))))
      (loop))))

(define-syntax-rule (with-my-resource (resource . rest)
                      body ...)
  (begin
    (call resource (request . rest))
    body ...
    (call resource (relinquish . rest))))

;;; n-attendants : exact-nonnegative-integer? = 2
(define n-attendants 2)

;;; attendant : (parameter/c (or/c resource? false/c))
(define attendant (make-parameter #f))

;;; (generator n) -> void?
;;;   n : exact-nonnegative-integer?
(define (generator n)
  (for ((i (in-range n)))
    (wait (random-exponential 4.0))
    (schedule #:in 0.0 (customer i))))

;;; process (customer i) -> void?
;;;   i : exact-nonnegative-integer?
(define-process (customer i)
  (with-my-resource ((attendant))
    (work (random-flat 2.0 10.0))))

;;; (run-simulation n) -> void?
;;;   n : exact-nonnegative-integer?
(define (run-simulation n)
  (with-new-simulation-environment
   (parameterize ((attendant (schedule #:now (my-resource n-attendants))))
     (schedule #:at 0.0 (generator n))
     (accumulate (variable-history (process-queue-variable-n (attendant))))
     (start-simulation)
     (printf "--- Example 3 - Data Collection ---~n")
     (printf "Maximum queue length = ~a~n"
             (variable-maximum (process-queue-variable-n (attendant))))
     (printf "Average queue length = ~a~n"
             (variable-mean (process-queue-variable-n (attendant))))
     (printf "Variance             = ~a~n"
             (variable-variance (process-queue-variable-n (attendant))))
     (printf "Utilization          = ~a~n"
             (variable-mean (my-resource-allocated-variable-n (attendant))))
     (printf "Variance             = ~a~n"
             (variable-variance (my-resource-allocated-variable-n (attendant))))
     (write-special (history-plot (variable-history 
                                   (process-queue-variable-n (attendant)))))
     (newline))))

;;; Run the simulation for 1000 customers.
(run-simulation 1000)