On this page:
13.1 Example – Harbor Model
Version: 4.1.3

13 Simulation Control (Advanced)

    13.1 Example – Harbor Model

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