;;; PLT Scheme Simulation Collection
;;; history.ss
;;; Copyright (c) 2005-2008 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.
;;;
;;; Version  Date      Description
;;; 1.0.0    07/17/05  Cleaned up initialization code. Added time parameter to
;;;                    the constructor and an initial-time slot. (Doug Williams)
;;; 1.0.1    07/18/05  Changed slot name to reflect storing durations.
;;;                    (Doug Williams)
;;; 3.0.0    06/24/08  Updated for V4.0.  (Doug Williams)
  
;;; history sutucture
;;;
;;;  #  slot             description
;;;  -  ----             -----------
;;;  0  time-dependant?  #t if this is a time-dependant collector
;;;  1  initial-time     time the history as created.
;;;  2  n                number of history entries
;;;  3  values           list of history values
;;;  4  last-value-cell  last cell of the values list or #f
;;;  5  durations        list of history durations or '()
;;;  6  last-duration-cell   list cell of the durations list or #f
(define-values (struct:history
                history-constructor
                history?
                history-field-ref
                set-history-field!)
  (make-struct-type 'history #f 7 0))

;;; history structure, time-dependant? slot
;;; history-time-dependant?: history -> boolean
;;; set-history-time-dependant?!: history x boolean -> void
(define history-time-dependant?
  (make-struct-field-accessor history-field-ref 0 'time-dependant?))

(define set-history-time-dependant?!
  (make-struct-field-mutator set-history-field! 0 'time-dependant?))

;;; history structure, initial-time slot
(define history-initial-time
  (make-struct-field-accessor history-field-ref 1 'initial-time))

(define set-history-initial-time!
  (make-struct-field-mutator set-history-field! 1 'initial-time))

;;; history structure, n slot
;;; history-n: history -> natural
;;; set-history-n!: history x natural -> void
(define history-n
  (make-struct-field-accessor history-field-ref 2 'n))

(define set-history-n!
  (make-struct-field-mutator set-history-field! 2 'n))

;;; history structure, values slot
;;; history-values: history -> list of real
;;; set-history-values!: history x list of reals -> void
(define history-values
  (make-struct-field-accessor history-field-ref 3 'values))

(define set-history-values!
  (make-struct-field-mutator set-history-field! 3 'values))

;;; history structure, last-value-cell slot
;;; history-last-value-cell: history -> cons
;;; set-history-last-value-cell!: history x cons -> void
(define history-last-value-cell
  (make-struct-field-accessor history-field-ref 4 'last-value-cell))

(define set-history-last-value-cell!
  (make-struct-field-mutator set-history-field! 4 'last-value-cell))

;;; history structure, durations slot
;;; history-durations: history -> list of real
;;; set-history-durations!: history x list of reals -> void
(define history-durations
  (make-struct-field-accessor history-field-ref 5 'durations))

(define set-history-durations!
  (make-struct-field-mutator set-history-field! 5 'durations))

;;; history structure, last-value-cell slot
;;; history-last-duration-cell: history -> cons
;;; set-history-last-duration-cell!: history x cons -> void
(define history-last-duration-cell
  (make-struct-field-accessor history-field-ref 6 'last-duration-cell))

(define set-history-last-duration-cell!
  (make-struct-field-mutator set-history-field! 6 'last-duration-cell))

;;; make-history: boolean -> history
(define (make-history time-dependant? time)
  (history-constructor time-dependant? time 0 '() #f '() #f))

;;; history-accululate!: history x real x real -> void
;;; Update a time-dependant history with the specified value and duration
;;; (actually, duration).
;;; 06/05/2008 - MDW - Modified the routines to use mutable cons
;;; cells
(define (history-accumulate! history value duration)
  (if (= (history-n history) 0)
      ;; No previous history
      (let ((new-value-cell (mcons value '()))
            (new-duration-cell
             (mcons duration '())))
        (set-history-n! history 1)
        (set-history-values! history new-value-cell)
        (set-history-last-value-cell! history new-value-cell)
        (set-history-durations! history new-duration-cell)
        (set-history-last-duration-cell! history new-duration-cell))
      ;; Previous history exists
      (let ((last-value-cell (history-last-value-cell history))
            (last-duration-cell (history-last-duration-cell history)))
        (if (or (= value (mcar last-value-cell))
                (= 0.0 (mcar last-duration-cell)))
            ;; Update the previous value/duration
            (begin
              (set-mcar! last-value-cell value)
              (set-mcar! last-duration-cell
                        (+ duration (mcar last-duration-cell))))
            ;; New value/duration
            (let ((new-value-cell (mcons value '()))
                  (new-duration-cell (mcons duration '())))
              (set-history-n! history (+ (history-n history) 1))
              (set-mcdr! last-value-cell new-value-cell)
              (set-history-last-value-cell! history new-value-cell)
              (set-mcdr! last-duration-cell new-duration-cell)
              (set-history-last-duration-cell! history new-duration-cell))))))

;;; history-tally!: history x real -> void
;;; Update a non-time-depandant history with the specified value.
(define (history-tally! history value)
  (if (= (history-n history) 0)
      ;; No previous history
      (let ((new-value-cell (mcons value '())))
        (set-history-n! history 1)
        (set-history-values! history new-value-cell)
        (set-history-last-value-cell! history new-value-cell))
      ;; Previous history exists
      (let ((last-value-cell (history-last-value-cell history))
            (new-value-cell (mcons value '())))
        (set-history-n! history (+ (history-n history) 1))
        (set-mcdr! last-value-cell new-value-cell)
        (set-history-last-value-cell! history new-value-cell))))