private/variable.ss
;;; PLT Scheme Simulation Collection
;;; Copyright (c) 2005 M. Douglas Williams
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 2.1 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free
;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
;;; 02111-1307 USA.
;;;
;;; 08/03/05 Doug Williams Removed default statistics accumulator
;;; 08/03/05 Doug Williams Added monitors

;;; variable structure
;;;   #  slot                    description
;;;   -  ----                    -----------
;;;   0  initial-value           initial value (for reset)
;;;   1  value                   current value
;;;   2  time-last-synchronized  time variable was last synchronized
;;;   3  statistics              statistics collector or #f
;;;   4  history                 history collector or #f
;;;   -------------------------  v-- continuous variable --v
;;;   5  continuous?            
;;;   6  state-index             index into state vector or -1
;;;   -------------------------  v-- monitors -------------v
;;;   7  get-monitors            list of get monitors
;;;   8  set-monitors            list of set monitors

(define-values (struct:variable
                variable-constructor
                variable?
                variable-field-ref
                set-variable-field!)
  (make-struct-type 'variable #f 9 0))

;;; make-variable: real -> variable
;;; make-variable: -> variable
(define make-variable
  (case-lambda
    ((value)
     (variable-constructor value
                           value
                           (current-simulation-time)
                           (make-statistics #t (current-simulation-time))
                           #f
                           #f
                           -1
                           '()
                           '()))
    (()
     (make-variable 'uninitialized))))

;;; make-continuous-variable: real -> variable
;;; make-continuous-variable: -> variable
(define make-continuous-variable
  (case-lambda
    ((value)
     (let ((process (current-simulation-process))
           (cv (variable-constructor value
                                     value
                                     (current-simulation-time)
                                     (make-statistics #t (current-simulation-time))
                                     #f
                                     #t
                                     -1
                                     '()
                                     '())))
       ;; Add variable to list of process continuous variables
       (set-process-continuous-variables!
        process
        (cons cv (process-continuous-variables process)))
       cv))
    (()
     (make-continuous-variable 'uninitialized))))

;;; variable structure, initial-value slot
;;; variable-initial-value: variable -> real or 'uninitialized
;;; set-variable-inirial-variable!: variable x real -> void
(define variable-initial-value
  (make-struct-field-accessor variable-field-ref 0 'initial-value))

(define set-variable-initial-value!
  (make-struct-field-mutator set-variable-field! 0 'initial-value))

;;; variable structure, value slot
;;; variable-value: variable -> real
;;; set-variable-value!: variable x real -> void
(define (variable-value variable)
  (let ((value #f))
    ;; Run before monitors
    (let loop ((monitors (variable-get-monitors variable)))
      (when (not (null? monitors))
        (if (eq? (caar monitors) 'before)
            (apply (cdar monitors)
                   (list variable value)))
        (loop (cdr monitors))))
    ;; Get the variable value
    (if (eq? (variable-field-ref variable 1) 'uninitialized)
        (error 'variable-value "Attempt to reference an uninitialized variable"))
    (if (and (not (= (variable-state-index variable) -1))
             (current-simulation-y))
        ;; Get the value from the state vector
        (set! value (vector-ref
                    (current-simulation-y)
                    (variable-state-index variable)))
        ;; Use the stored value
        (set! value (variable-field-ref variable 1)))
    ;; Run after monitors
    (let loop ((monitors (variable-get-monitors variable)))
      (when (not (null? monitors))
        (if (eq? (caar monitors) 'after)
            (apply (cdar monitors)
                   (list variable value)))
        (loop (cdr monitors))))
    ;; return the value
    value))

(define (set-variable-value! variable value)
  ;; Run before monitors
  (let loop ((monitors (variable-set-monitors variable)))
    (when (not (null? monitors))
      (if (eq? (caar monitors) 'before)
          (apply (cdar monitors)
                 (list variable value)))
      (loop (cdr monitors))))
  ;; Accumulate previous value (synchronize)
  (variable-synchronize! variable)
  ;; Set the new value
  (set-variable-field! variable 1 value)
  ;; Tally new value (statistics and history)
  (if (and (variable-field-ref variable 3)
           (not (statistics-time-dependant?
                 (variable-field-ref variable 3))))
      (statistics-tally! (variable-field-ref variable 3) value))
  (if (and (variable-field-ref variable 4)
           (not (history-time-dependant?
                 (variable-field-ref variable 4))))
      (history-tally! (variable-field-ref variable 4) value))
  ;; Run after monitors
  (let loop ((monitors (variable-set-monitors variable)))
    (when (not (null? monitors))
      (if (eq? (caar monitors) 'after)
          (apply (cdar monitors)
                 (list variable value)))
      (loop (cdr monitors))))
  (void))

;;; variable structure, time-last-synchronized slot
;;; variable-time-last-synchronized: variable -> real
;;; set-variable-time-last-synchronized!: variable x real -> void
(define variable-time-last-synchronized
  (make-struct-field-accessor variable-field-ref 2 'time-last-synchronized))

(define set-variable-time-last-synchronized!
  (make-struct-field-mutator set-variable-field! 2 'time-last-synchronized))

;;; variable structure, statistics slot
;;; variable-statistics: variable -> statistics or #f
;;; set-variable-statistics!: variable x statistics or #f -> void
;;; (define variable-statistics
;;;   (make-struct-field-accessor variable-field-ref 3 'statistics))
(define (variable-statistics variable)
  ;; Accumulate value (synchronize)
  (variable-synchronize! variable)
  (variable-field-ref variable 3))

(define set-variable-statistics!
  (make-struct-field-mutator set-variable-field! 3 'statistics))

;;; variable structure, history slot
;;; variable-history: variable -> history or #f
;;; set-variable-history!: variable x history or #f -> void
;;; (define variable-statistics
;;;   (make-struct-field-accessor variable-field-ref 4 'history))
(define (variable-history variable)
  ;; Accumulate value (synchronize)
  (variable-synchronize! variable)
  (variable-field-ref variable 4))

(define set-variable-history!
  (make-struct-field-mutator set-variable-field! 4 'history))

;;
(define variable-continuous?
  (make-struct-field-accessor variable-field-ref 5 'continuous?))

(define set-variable-continuous?!
  (make-struct-field-mutator set-variable-field! 5 'continuous?))

;;
(define variable-state-index
  (make-struct-field-accessor variable-field-ref 6 'state-index))

(define set-variable-state-index!
  (make-struct-field-mutator set-variable-field! 6 'state-index))

;;; get-monitors field
(define variable-get-monitors
  (make-struct-field-accessor variable-field-ref 7 'get-monitors))

(define set-variable-get-monitors!
  (make-struct-field-mutator set-variable-field! 7 'get-monitors))

;;; set-monitors field
(define variable-set-monitors
  (make-struct-field-accessor variable-field-ref 8 'set-monitors))

(define set-variable-set-monitors!
  (make-struct-field-mutator set-variable-field! 8 'set-monitors))

;;
(define (variable-dt variable)
  (if (and (not (= (variable-state-index variable) -1))
           (current-simulation-dydt))
      (vector-ref
       (current-simulation-dydt)
       (variable-state-index variable))
      (error 'variable-dt
             "There is no active work/continuously using the variable")))

(define (set-variable-dt! variable value)
  (if (and (not (= (variable-state-index variable) -1))
           (current-simulation-dydt))
      (vector-set!
       (current-simulation-dydt)
       (variable-state-index variable)
       value)
      (error 'set-variable-dt!
             "There is no active work/continuously using the variable")))

;; variable-synchronize!: variable
(define (variable-synchronize! variable)
  (let ((duration (- (current-simulation-time)
                     (variable-time-last-synchronized variable))))
    ;; Don't accumulate if duration is zero or if the value is
    ;; uninitialized.
    (if (and (> duration 0.0)
             (not (eq? (variable-field-ref variable 1) 'uninitialized)))
        (begin
          ;; Accumulate statistics
          (if (and (variable-field-ref variable 3)
                   (statistics-time-dependant?
                    (variable-field-ref variable 3)))
              (statistics-accumulate!
               (variable-field-ref variable 3)
               (variable-value variable) duration))
          ;; Accumulate history
          (if (and (variable-field-ref variable 4)
                   (history-time-dependant?
                    (variable-field-ref variable 4)))
              (history-accumulate!
               (variable-field-ref variable 4)
               (variable-value variable) duration))
          ;; Save synchronization time
          (set-variable-time-last-synchronized!
           variable (current-simulation-time))))))

;;; Statistics shortcuts for variables

;;; variable-minimum: variable -> real
(define (variable-minimum variable)
  (statistics-minimum (variable-statistics variable)))

;;; variable-maximum: variable -> real
(define (variable-maximum variable)
  (statistics-maximum (variable-statistics variable)))

;;; variable-n: variable -> real
(define (variable-n variable)
  (statistics-n (variable-statistics variable)))

;;; variable-sum> variable -> real
(define (variable-sum variable)
  (statistics-sum (variable-statistics variable)))

;;; variable-mean: variable -> real
(define (variable-mean variable)
  (statistics-mean (variable-statistics variable)))

(define (variable-variance variable)
  (statistics-variance (variable-statistics variable)))

(define (variable-standard-deviation variable)
  (statistics-standard-deviation (variable-statistics variable)))

;;; (accumulate (variable-statistics variable))
;;; (accumulate (variable-history variable))
(define-syntax accumulate
  (syntax-rules (variable-statistics variable-history)
    ((accumulate (variable-statistics variable))
     (let ((statistics (make-statistics #t (current-simulation-time))))
       (set-variable-statistics! variable statistics)))
    ((accumulate (variable-history variable))
     (let ((history (make-history #t (current-simulation-time))))
       (set-variable-history! variable history)))))

;;; (tally (variable-statistics variable))
;;; (tally (variable-history variable))
(define-syntax tally
  (syntax-rules (variable-statistics variable-history)
    ((tally (variable-statistics variable))
     (let ((statistics (make-statistics #f (current-simulation-time))))
       (if (not (eq? (variable-field-ref variable 1) 'uninitialized))
           (statistics-tally! statistics (variable-field-ref variable 1)))
       (set-variable-statistics! variable statistics)))
    ((tally (variable-history variable))
     (let ((history (make-history #f (current-simulation-time))))
       (if (not (eq? (variable-field-ref variable 1) 'uninitialized))
           (history-tally! history (variable-field-ref variable 1)))
       (set-variable-history! variable history)))))

;;; (define-monitor ...)
(define-syntax define-monitor
  (syntax-rules (before after variable-value set-variable-value!)
    ((define-monitor before (variable-value variable)
       body ...)
     (let ((monitor (cons
                     'before
                     (lambda (variable)
                       body ...))))
       (set-variable-get-monitors!
        variable
        (cons monitor (variable-get-monitors variable)))))
    ((define-monitor after (variable-value variable)
       body ...)
     (let ((monitor (cons
                     'after
                     (lambda (variable)
                       body ...))))
       (set-variable-get-monitors!
        variable
        (cons monitor (variable-get-monitors variable)))))
    ((define-monitor before (set-variable-value! variable value)
       body ...)
     (let ((monitor (cons
                     'before
                     (lambda (variable value)
                       body ...))))
       (set-variable-set-monitors!
        variable
        (cons monitor (variable-set-monitors variable)))))
    ((define-monitor after (set-variable-value! variable value)
       body ...)
     (let ((monitor (cons
                     'after
                     (lambda (variable value)
                       body ...))))
       (set-variable-set-monitors!
        variable
        (cons monitor (variable-set-monitors variable)))))))