#lang racket/base
;;; Racket Simulation Collection
;;; history-graphics.rkt
;;; Copyright (c) 2005-2011 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
;;; 3.0.0    06/28/08  Updated for V4.0. (MDW)
;;; 3.0.1    11/27/08  Moved to private. (MDW)
;;; 4.0.0    08/18/10  Converted to Racket. (MDW)
;;; 4.1.0    10/10/11  Updated to new plot package. (MDW)

(require racket/mpair
         plot
         plot/utils
         (planet williams/science/discrete-histogram-with-graphics)
         (planet williams/science/histogram-with-graphics)
         (planet williams/science/statistics)
         "history.ss")

;; history-plot: history x string -> snip%
;; history-plot: history -> snip%
(define (history-plot history (title "History"))
  (if (history-time-dependant? history)
      ;; Time-dependant history
      (let-values
          (((x-min x-max y-min y-max prev-v vs)
            (for/fold ((t0 (history-initial-time history))
                       (t1 (history-initial-time history))
                       (v-min +inf.0)
                       (v-max -inf.0)
                       (prev-v #f)
                       (vs '()))
                      ((d (in-mlist (history-durations history)))
                       (v (in-mlist (history-values history))))
              (values
                 t0
                 (+ t1 d)
                 (min v v-min)
                 (max v v-max)
                 v
                 (if (not prev-v)
                     (list (vector t0 v)
                           (vector (+ t1 d) v))
                     (append
                      vs
                      (list (vector t1 v)
                            (vector (+ t1 d) v))))))))
        (plot ;(rectangles rects
              ;            #:color (->pen-color (rectangle-color)))
         (lines vs #:color "blue")
              #:x-min x-min #:x-max x-max #:x-label "Time"
              #:y-min y-min #:y-max y-max #: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))))))

;;; Module Contracts

(provide (all-defined-out))