#lang scheme/base
;;; PLT Scheme Simulation Collection
;;; history-graphics.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
;;; 3.0.0    06/28/08  Updated for V4.0.  (Doug Williams)

(provide
 (all-defined-out))

(require (lib "plot.ss" "plot"))
(require (planet "plot-histogram.ss"
                 ("williams" "science.plt")))
(require (planet "discrete-histogram-with-graphics.ss"
                 ("williams" "science.plt")))
(require (planet "histogram-with-graphics.ss"
                 ("williams" "science.plt")))
(require (planet "statistics.ss" ("williams" "science.plt")))
(require "simulation.ss")

(require scheme/mpair)

;; 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 (+ (mlength durations) 1)))
                (y-vector (list->vector (mlist->list 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 (mcar durations)))
               (vector-set! x-vector (+ i 1) x)
               (set! durations (mcdr 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 (mlist->list (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
               (when (not (integer? (vector-ref v i)))
                 (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"))))