13 Simulation Control (Advanced)

13.1 Example – Harbor Model

#lang scheme

;  Harbor Model

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

(require (planet williams/science/random-distributions))

;  Data collection variables

(define cycle-time #f)

;  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)

;  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)

;  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.

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