#lang racket/base
;;; Racket Simulation Collection
;;; history.rkt
;;; Copyright (c) 2005-2010 M. Douglas Williams
;;;
;;; This file is part of the Racket Simulation Collection.
;;;
;;; The Racket Simulation Collection 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 3 of the License,
;;; or (at your option) any later version.
;;;
;;; The Racket Simulation Collection 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 the Racket Simulation Collection.  If not, see
;;; <http://www.gnu.org/licenses/>.
;;;
;;; -----------------------------------------------------------------------------
;;;
;;; Version  Date      Description
;;; 1.0.0    07/17/05  Cleaned up initialization code. Added time parameter to
;;;                    the constructor and an initial-time slot. (MDW)
;;; 1.0.1    07/18/05  Changed slot name to reflect storing durations. (MDW)
;;; 3.0.0    06/24/08  Updated for V4.0. (MDW)
;;; 3.0.1    11/27/08  Converted to a module. (MDW)
;;; 4.0.0    08/15/10  Converted to Racket. (MDW)

(struct history (time-dependant?
                 initial-time
                 n
                 values
                 last-value-cell
                 durations
                 last-duration-cell)
  #:mutable)

;;; (make-history time-dependant? time) -? history?
;;;   time-dependant? : boolean?
;;;   time : (>=/c 0.0)
(define (make-history time-dependant? time)
  (history time-dependant? time 0 '() #f '() #f))

;;; (history-accumulate! history value duration) -> void?
;;;   history : history?
;;;   value : real?
;;;   duration : (>=/c 0.0)
;;; 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 value) -> void?
;;;   history : history?
;;;   value : real?
;;; Update a non-time-depandent 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))))

;;; Module Contracts

(provide (all-defined-out))