plot-histogram.ss
;;; PLT Scheme Science Collection
;;; plot-histogram.ss
;;; Copyright (c) 2004 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.
;;;
;;; -------------------------------------------------------------------
;;;
;;; This code adds histogram plotting to the PLoT collection in PLT
;;; Scheme (lib "plot.ss" "plot").
;;;
;;; Version Date      Description
;;; 0.1.0   08/27/04  This is the initial release of the histogram
;;;                   plotting extension to the PLoT collection in PLT
;;;                   Scheme (Doug Williams)
;;; 1.0.0   09/28/04  Marked as ready for Release 1.0.  (Doug Williams)

(module plot-histogram mzscheme
  
  (require (lib "class.ss")
           (lib "plot-extend.ss" "plot"))
  
  (provide
   histogram)
  
  ;; Draw a bar given the width
  (define (draw-bar-given-width x width width-factor y view)
    (let* ((half-whitespace (/ (* width (- 1.0 width-factor)) 2.0))
           (x1 (+ x half-whitespace))
           (x2 (- (+ x width) half-whitespace)))
      (send view fill
            `(,x1 ,x1 ,x2 ,x2)
            `(0 ,y ,y 0))))
  
  ;; Draw a bar
  (define (draw-bar x1 x2 width-factor y view)
    (let* ((half-whitespace (/ (* (- x2 x1) (- 1.0 width-factor)) 2.0))
           (xx1 (+ x1 half-whitespace))
           (xx2 (- x2 half-whitespace)))
      (send view fill
            `(,xx1 ,xx1 ,xx2 ,xx2)
            `(0 ,y ,y 0))
      ))
  
  ;; Draw a histogram with equal width bins
  (define (draw-histogram-with-equal-width-bins 
           bins x-min x-max width-factor view)
    (let* ((n (vector-length bins))
           (bin-width (/ (- x-max x-min) n)))
      (do ((i 0 (+ i 1)))
          ((= i n) (void))
        (draw-bar-given-width
         (+ x-min (* i bin-width)) bin-width width-factor
         (vector-ref bins i) view))))
  
  ;; Draw a histogram (with specified bin ranges)
  (define (draw-histogram bins x-ranges width-factor view)
    (let ((n (vector-length bins)))
      (do ((i 0 (+ i 1)))
          ((= i n) (void))
        (draw-bar (vector-ref x-ranges i)
                  (vector-ref x-ranges (+ i 1))
                  width-factor
                  (vector-ref bins i)
                  view))))
  
  ;; Define histogram plot type
  ;;
  ;; The histogram data to be plotted may be provided in either of two
  ;; formats:
  ;; 1) A vector of binned data - if a single vector of binned data is
  ;;    given, it is interpreted as n fixed width bins, where n is the
  ;;    the length of the vector, with x ranging from x-min to x-max.
  ;; 2) A list of two vectors - the first contains the binned data and
  ;;    the second contains the x ranges; it is interpreted as n
  ;;    (possibly) variable width bins, where n is the length of the
  ;;    first vector; the x range for the i-th bin are the i-th
  ;;    (lower) and (i+1)-th elements of the second vector; the length
  ;;    of the second vector must be one greater than the length of
  ;;    the first vector.
  (define-plot-type histogram
    data 2dview (x-min x-max) ((color 'black) (width 1.0))
    (begin
      (send 2dview set-line-color color)
      (set! width (max width 0.0))
      (set! width (min width 1.0))
      (cond ((vector? data)
             ;; bin data with equal width bins
             (draw-histogram-with-equal-width-bins
              data x-min x-max width 2dview))
            ((and (list? data)
                  (= (length data) 2)
                  (vector? (car data))
                  (vector? (cadr data))
                  (= (vector-length (cadr data))
                     (+ (vector-length (car data)) 1)))
             ;; bin data and limits data
             (draw-histogram (car data) (cadr data) width 2dview))
            (else
             (error 'plot
                    "histogram plot data error")))))
  
)