#lang racket
(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))))
(define n-attendants 2)
(define attendant (make-parameter #f))
(define (generator n)
(for ((i (in-range n)))
(wait (random-exponential 4.0))
(schedule #:in 0.0 (customer i))))
(define-process (customer i)
(with-my-resource ((attendant))
(work (random-flat 2.0 10.0))))
(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-simulation 1000)