#lang scribble/doc @(require scribble/manual scribblings/icons (for-label scheme/base plot/plot "../simulation-with-graphics.ss")) @title[#:tag "control-advanced"]{Simulation Control (Advanced)} @local-table-of-contents[] @section{Example---Harbor Model} @schememod[ scheme (code:comment " Harbor Model") (require (planet williams/simulation/simulation-with-graphics)) (require (planet williams/science/random-distributions)) (code:comment " Data collection variables") (define cycle-time #f) (code:comment " Model definition") (define random-sources (make-random-source-vector 2)) (define dock #f) (define queue #f) (define (scheduler) (let loop () (make-object ship%) (wait (random-exponential (vector-ref random-sources 0) (/ 4.0 3.0))) (loop))) (define-process-class ship% (field (unloading-time (random-flat (vector-ref random-sources 1) 1.0 2.5))) (let ((arrival-time (current-simulation-time))) (when (not (harbor-master this 'arriving)) (set-insert! queue this) (suspend-process)) (work unloading-time) (set-remove! dock this) (set-variable-value! cycle-time (- (current-simulation-time) arrival-time)) (harbor-master this 'leaving))) (define ship-unloading-time (class-field-accessor ship% unloading-time)) (define set-ship-unloading-time! (class-field-mutator ship% unloading-time)) (define (harbor-master ship action) (case action ((arriving) (if (< (set-n dock) 2) (code:comment " Dock is not full") (begin (if (set-empty? dock) (set-ship-unloading-time! ship (/ (ship-unloading-time ship) 2.0)) (let ((other-ship (set-first dock))) (send other-ship interrupt) (send other-ship set-time (* (send other-ship get-time) 2.0)) (send other-ship resume))) (set-insert! dock ship) #t) (code:comment " Dock is full") #f)) ((leaving) (if (set-empty? queue) (when (not (set-empty? dock)) (let ((other-ship (set-first dock))) (send other-ship interrupt) (send other-ship set-time (/ (send other-ship get-time) 2.0)) (send other-ship resume) #t)) (let ((next-ship (set-remove-first! queue))) (set-insert! dock next-ship) (send next-ship resume) #t))) (else (error 'harbor-master "illegal action value ~a" action)))) (define (stop-sim) (printf "Harbor Model - report after ~a simulated days - ~a ships processed~n" (current-simulation-time) (variable-n cycle-time)) (printf "Minimum unload time was ~a~n" (variable-minimum cycle-time)) (printf "Maximum unload time was ~a~n" (variable-maximum cycle-time)) (printf "Average queue of ships waiting to be unloaded was ~a~n" (variable-mean (set-variable-n queue))) (printf "Maximum queue was ~a~n" (variable-maximum (set-variable-n queue))) (write-special (history-plot (variable-history (set-variable-n queue)) "History of Waiting Queue")) (newline) (stop-simulation)) (define (run-simulation) (with-new-simulation-environment (set! cycle-time (make-variable)) (tally (variable-statistics cycle-time)) (set! dock (make-set)) (set! queue (make-set)) (accumulate (variable-history (set-variable-n queue))) (schedule now (scheduler)) (schedule (at 80.0) (stop-sim)) (start-simulation))) (run-simulation) ] The following is the output from the model. @verbatim{ Harbor Model - report after 80.0 simulated days - 65 ships processed Minimum unload time was 0.5656279138989291 Maximum unload time was 3.893379568241123 Average queue of ships waiting to be unloaded was 0.24532233055969996 Maximum queue was 3} @image["scribblings/images/harbor-model.gif"]