examples/open-closed-loop-graphical.rkt
#lang racket/gui

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

(require mrlib/bitmap-label)

;;; Simulation parameters
(define n-runs (make-variable))
(define n-customers (make-variable))
(define mode 'open-loop)
(define n-attendants (make-variable))
(define customer-interarrival-time 4.0)
(define attendant-minimum-service-time 2.0)
(define attendant-maximum-service-time 10.0)
(define progress (make-variable))

;;; Simulation model
(define attendant #f)

(define (generator n)
  (for ((i (in-range n)))
    (wait (random-exponential customer-interarrival-time))
    (schedule #:now (customer i))))

(define-process (customer i)
  (with-resource (attendant)
    (wait/work (random-flat attendant-minimum-service-time
                            attendant-maximum-service-time))))

(define (run-simulation)
  (parameterize
      ((current-output-port (open-output-text-editor text)))
    (with-new-simulation-environment
     ;; Initialize graphics
     (begin-busy-cursor)
     (send run-button enable #f)
     (set-variable-value! progress 0)
     (send text lock #f)
     ;; Execute simulation model
     (case mode
       ((open-loop)
        ;; Open loop processing
        (let ((max-attendants (make-variable)))
          (tally (variable-statistics max-attendants))
          (tally (variable-history max-attendants))
          (for ((i (in-range (variable-value n-runs))))
            (with-new-simulation-environment
             (set! attendant (make-resource +inf.0))
             (schedule #:at 0.0 (generator (variable-value n-customers)))
             (start-simulation)
             (set-variable-value!
              max-attendants
              (variable-maximum (resource-satisfied-variable-n attendant)))
             (send text erase)
             (printf "Open loop processing~n")
             (printf "Number of runs = ~a~n"
                     (variable-n max-attendants))
             (printf "Minimum maximum attendants = ~a~n"
                     (variable-minimum max-attendants))
             (printf "Maximum maximum attendants = ~a~n"
                     (variable-maximum max-attendants))
             (set-variable-value! progress i)))
          (printf "Mean maximum attendants = ~a~n"
                  (variable-mean max-attendants))
          (printf "Variance maximum attendants = ~a~n"
                  (variable-variance max-attendants))
          (write-special
           (history-plot (variable-history max-attendants)
                         "Maximum Attendants"))
          (newline)))
       ((closed-loop)
        ;; Closed loop processing
        (let ((avg-queue-length (make-variable)))
          (tally (variable-statistics avg-queue-length))
          (tally (variable-history avg-queue-length))
          (for ((i (in-range (variable-value n-runs))))
            (with-new-simulation-environment
             (set! attendant (make-resource (variable-value n-attendants)))
             (schedule #:at 0.0 (generator (variable-value n-customers)))
             (start-simulation)
             (set-variable-value!
              avg-queue-length
              (variable-mean (resource-queue-variable-n attendant)))
             (send text erase)
             (printf "Closed loop processing~n")
             (printf "Number of runs = ~a~n"
                     (variable-n avg-queue-length))
             (printf "Minimum average queue length = ~a~n"
                     (variable-minimum avg-queue-length))
             (printf "Maximum average queue length = ~a~n"
                     (variable-maximum avg-queue-length))
             (set-variable-value! progress i)))
          (printf "Mean average queue length = ~a~n"
                  (variable-mean avg-queue-length))
          (printf "Variance average queue length = ~a~n"
                  (variable-variance avg-queue-length))
          (write-special
           (history-plot (variable-history avg-queue-length)
                         "Average Queue Length"))
          (newline)          (flush-output))))
     (send text lock #t)
     (send run-button enable #t)
     (end-busy-cursor))))

;; Simulation graphics
(define frame
  (instantiate frame%
    ("Open Loop/Closed Loop Analysis")))

(define menu-bar
  (instantiate menu-bar%
    (frame)))

(define file-menu
  (instantiate menu%
    ("&File" menu-bar)))

(define exit-menu-item
  (instantiate menu-item%
    ("E&xit" file-menu)
    (callback
     (lambda (menu-item event)
       (exit)))))

(define edit-menu
  (instantiate menu%
    ("&Edit" menu-bar)))

(define options-menu-item
  (instantiate menu-item%
    ("Options..." edit-menu)
    (callback
     (lambda (menu-item event)
       (case mode
         ((open-loop)
          (send radio-box set-selection 0)
          (send slider-3 enable #f))
         ((closed-loop)
          (send radio-box set-selection 1)
          (send slider-3 enable #t)))
       ;(send slider-3 set-value n-attendants)
       (send text-field-1 set-value
             (format "~a" customer-interarrival-time))
       (send text-field-2 set-value
             (format "~a" attendant-minimum-service-time))
       (send text-field-3 set-value
             (format "~a" attendant-maximum-service-time))
       (send dialog show #t)))))

(define panel-1
  (instantiate horizontal-panel%
    (frame)
    (alignment '(right center))))

(define run-button
  (instantiate button%
    ((make-bitmap-label "Run" "images/run.png") panel-1)
    (horiz-margin 4)
    (callback
     (lambda (button event)
       (run-simulation)))))

(define stop-button
  (instantiate button%
    ((make-bitmap-label "Stop" "images/break.png") panel-1)
    (horiz-margin 4)
    (callback
     (lambda (button event)
       (stop-simulation)))))

(define n-runs-slider
  (instantiate variable-slider%
    ("Number of runs" 1 1000 frame)
    (variable n-runs)
    (init-value 100)
    (style '(horizontal vertical-label))))

(define n-customers-slider
  (instantiate variable-slider%
    ("Number of customers per run" 1 1000 frame)
    (variable n-customers)
    (init-value 500)
    (style '(horizontal vertical-label))))

(define canvas
  (instantiate editor-canvas%
    (frame)
    (min-width 500)
    (min-height 500)))
(define text (instantiate text% ()))
(send canvas set-editor text)
(send text lock #t)

(define gauge
  (instantiate variable-gauge%
    ("Progress" n-runs frame)
    (variable progress)))

(define dialog
  (instantiate dialog%
    ("Options" frame)))

(define group-box-panel-1
  (instantiate group-box-panel%
    ("Mode" dialog)
    (alignment '(left top))))

(define radio-box
  (instantiate radio-box%
    (#f '("Open loop" "Closed loop") group-box-panel-1)
    (style '(vertical vertical-label))
    (callback
     (lambda (radio-box event)
       (case (send radio-box get-selection)
         ((0)
          (send slider-3 enable #f))
         ((1)
          (send slider-3 enable #t)))))))

(define slider-3
  (instantiate variable-slider%
    ("Number of attendants" 1 100 dialog)
    (variable n-attendants)
    (init-value 2)
    (style '(horizontal vertical-label))))

(define group-box-panel-2
  (instantiate group-box-panel%
    ("Customer" dialog)))

(define text-field-1
  (instantiate text-field%
    ("Interarrival time" group-box-panel-2)))

(define group-box-panel-3
  (instantiate group-box-panel%
    ("Attendant" dialog)))

(define text-field-2
  (instantiate text-field%
    ("Minimum service time" group-box-panel-3)))

(define text-field-3
  (instantiate text-field%
    ("Maximum service time" group-box-panel-3)))

(define panel-3
  (instantiate horizontal-panel%
    (dialog)
    (alignment '(center center))))

(define cancel-button
  (instantiate button%
    ("Cancel" panel-3)
    (callback
     (lambda (button event)
       (send dialog show #f)))))

(define ok-button
  (instantiate button%
    ("Ok" panel-3)
    (callback
     (lambda (button event)
       (case (send radio-box get-selection)
         ((0)
          (set! mode 'open-loop))
         ((1)
          (set! mode 'closed-loop)))
;       (set! n-attendants
;             (send slider-3 get-value))
       (set! customer-interarrival-time
             (string->number (send text-field-1 get-value)))
       (set! attendant-minimum-service-time
             (string->number (send text-field-2 get-value)))
       (set! attendant-maximum-service-time
             (string->number (send text-field-3 get-value)))
       (send dialog show #f)))))

(send frame show #t)