history-graphics.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.
;;;

(module history-graphics mzscheme
  
  (provide
   (all-defined))

  (require (lib "plot.ss" "plot"))
  (require (planet "plot-histogram.ss"
                   ("williams" "science.plt" 2 0)))
  (require (planet "discrete-histogram-with-graphics.ss"
                   ("williams" "science.plt" 2 0)))
  (require (planet "histogram-with-graphics.ss"
                   ("williams" "science.plt" 2 0)))
  (require (planet "statistics.ss" ("williams" "science.plt" 2 0)))
  (require "simulation.ss")
  
  ;; history-plot: history x string -> snip%
  ;; history-plot: history -> snip%
  (define history-plot
    (case-lambda
      ((history title)
       (if (history-time-dependant? history)
           ;; Time-dependant history
           (let* ((durations (history-durations history))
                  (values (history-values history))
                  (x-vector (make-vector (+ (length durations) 1)))
                  (y-vector (list->vector values)))
             ;; Fill in x points
             (let ((x (history-initial-time history)))
               (vector-set! x-vector 0 x)
               (do ((i 0 (+ i 1)))
                   ((null? durations) (void))
                 (set! x (+ x (car durations)))
                 (vector-set! x-vector (+ i 1) x)
                 (set! durations (cdr durations))))
             (plot (histogram (list y-vector x-vector))
                   (x-min (vector-ref x-vector 0))
                   (x-max (vector-ref x-vector (- (vector-length x-vector) 1)))
                   (x-label "Time")
                   (y-min (minimum y-vector))
                   (y-max (maximum y-vector))
                   (y-label "Value")
                   (title title)))
           ;; Non-time-dependant history
           ;; Plot as a histogram with 40 bins
           (let ((discrete? #t)
                 (v (list->vector (history-values history))))
             ;; Scan the values vector and see if all of the values are
             ;; discrete.
             (do ((i 0 (+ i 1)))
                 ((= i (vector-length v)) (void))
               (let/ec exit
                 (if (not (integer? (vector-ref v i)))
                     (begin
                       (set! discrete? #f)
                       (exit)))))
             ;; Use a discrete histogram if all of the values are
             ;; discrete (i.e., all integers).  Otherwise, use a normal
             ;; histogram with 40 bins.
             (if discrete?
                 (let ((h (make-discrete-histogram)))
                   (do ((i 0 (+ i 1)))
                       ((= i (vector-length v)) (void))
                     (discrete-histogram-increment! h (vector-ref v i)))
                   (discrete-histogram-plot h title))
                 (let ((h (make-histogram 40)))
                   (set-histogram-ranges-uniform! h (minimum v) (maximum v))
                   (do ((i 0 (+ i 1)))
                       ((= i (vector-length v)) (void))
                     (histogram-increment! h (vector-ref v i)))
                   (histogram-plot h title))))))
      ((history)
       (history-plot history "History"))))
  
  )